cgit.sxemacs.org Git - gnus/blob - lisp/nntp.el

   1 ;;; nntp.el --- nntp access for Gnus
   2
   3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
   4 ;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published
  13 ;; by the Free Software Foundation; either version 2, or (at your
  14 ;; option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'nnheader)
  30 (require 'nnoo)
  31 (require 'gnus-util)
  32
  33 (nnoo-declare nntp)
  34
  35 (eval-when-compile (require 'cl))
  36
  37 (defvoo nntp-address nil
  38   "Address of the physical nntp server.")
  39
  40 (defvoo nntp-port-number "nntp"
  41   "Port number on the physical nntp server.")
  42
  43 (defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
  44   "*Hook used for sending commands to the server at startup.
  45 The default value is `nntp-send-mode-reader', which makes an innd
  46 server spawn an nnrpd server.")
  47
  48 (defvoo nntp-authinfo-function 'nntp-send-authinfo
  49   "Function used to send AUTHINFO to the server.
  50 It is called with no parameters.")
  51
  52 (defvoo nntp-server-action-alist
  53     '(("nntpd 1\\.5\\.11t"
  54        (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
  55       ("NNRP server Netscape"
  56        (setq nntp-server-list-active-group nil)))
  57   "Alist of regexps to match on server types and actions to be taken.
  58 For instance, if you want Gnus to beep every time you connect
  59 to innd, you could say something like:
  60
  61 \(setq nntp-server-action-alist
  62        '((\"innd\" (ding))))
  63
  64 You probably don't want to do that, though.")
  65
  66 (defvoo nntp-open-connection-function 'nntp-open-network-stream
  67   "*Function used for connecting to a remote system.
  68 It will be called with the buffer to output in as argument.
  69
  70 Currently, five such functions are provided (please refer to their
  71 respective doc string for more information), three of them establishing
  72 direct connections to the nntp server, and two of them using an indirect
  73 host.
  74
  75 Direct connections:
  76 - `nntp-open-network-stream' (the default),
  77 - `nntp-open-ssl-stream',
  78 - `nntp-open-telnet-stream'.
  79
  80 Indirect connections:
  81 - `nntp-open-via-rlogin-and-telnet',
  82 - `nntp-open-via-telnet-and-telnet'.")
  83
  84 (defvoo nntp-pre-command nil
  85   "*Pre-command to use with the various nntp-open-via-* methods.
  86 This is where you would put \"runsocks\" or stuff like that.")
  87
  88 (defvoo nntp-telnet-command "telnet"
  89   "*Telnet command used to connect to the nntp server.
  90 This command is used by the various nntp-open-via-* methods.")
  91
  92 (defvoo nntp-telnet-switches '("-8")
  93   "*Switches given to the telnet command `nntp-telnet-command'.")
  94
  95 (defvoo nntp-end-of-line "\r\n"
  96   "*String to use on the end of lines when talking to the NNTP server.
  97 This is \"\\r\\n\" by default, but should be \"\\n\" when
  98 using and indirect connection method (nntp-open-via-*).")
  99
 100 (defvoo nntp-via-rlogin-command "rsh"
 101   "*Rlogin command used to connect to an intermediate host.
 102 This command is used by the `nntp-open-via-rlogin-and-telnet' method.
 103 The default is \"rsh\", but \"ssh\" is a popular alternative.")
 104
 105 (defvoo nntp-via-rlogin-command-switches nil
 106   "*Switches given to the rlogin command `nntp-via-rlogin-command'.
 107 If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
 108 \(\"-C\") in order to compress all data connections, otherwise set this
 109 to \(\"-t\") or (\"-C\" \"-t\") if the telnet command requires a pseudo-tty
 110 allocation on an intermediate host.")
 111
 112 (defvoo nntp-via-telnet-command "telnet"
 113   "*Telnet command used to connect to an intermediate host.
 114 This command is used by the `nntp-open-via-telnet-and-telnet' method.")
 115
 116 (defvoo nntp-via-telnet-switches '("-8")
 117   "*Switches given to the telnet command `nntp-via-telnet-command'.")
 118
 119 (defvoo nntp-via-user-name nil
 120   "*User name to log in on an intermediate host with.
 121 This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
 122
 123 (defvoo nntp-via-user-password nil
 124   "*Password to use to log in on an intermediate host with.
 125 This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
 126
 127 (defvoo nntp-via-address nil
 128   "*Address of an intermediate host to connect to.
 129 This variable is used by the `nntp-open-via-rlogin-and-telnet' and
 130 `nntp-open-via-telnet-and-telnet' methods.")
 131
 132 (defvoo nntp-via-envuser nil
 133   "*Whether both telnet client and server support the ENVIRON option.
 134 If non-nil, there will be no prompt for a login name.")
 135
 136 (defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
 137   "*Regular expression to match the shell prompt on an intermediate host.
 138 This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
 139
 140 (defvoo nntp-large-newsgroup 50
 141   "*The number of the articles which indicates a large newsgroup.
 142 If the number of the articles is greater than the value, verbose
 143 messages will be shown to indicate the current status.")
 144
 145 (defvoo nntp-maximum-request 400
 146   "*The maximum number of the requests sent to the NNTP server at one time.
 147 If Emacs hangs up while retrieving headers, set the variable to a
 148 lower value.")
 149
 150 (defvoo nntp-nov-is-evil nil
 151   "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
 152
 153 (defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
 154   "*List of strings that are used as commands to fetch NOV lines from a server.
 155 The strings are tried in turn until a positive response is gotten.  If
 156 none of the commands are successful, nntp will just grab headers one
 157 by one.")
 158
 159 (defvoo nntp-nov-gap 5
 160   "*Maximum allowed gap between two articles.
 161 If the gap between two consecutive articles is bigger than this
 162 variable, split the XOVER request into two requests.")
 163
 164 (defvoo nntp-prepare-server-hook nil
 165   "*Hook run before a server is opened.
 166 If can be used to set up a server remotely, for instance.  Say you
 167 have an account at the machine \"other.machine\".  This machine has
 168 access to an NNTP server that you can't access locally.  You could
 169 then use this hook to rsh to the remote machine and start a proxy NNTP
 170 server there that you can connect to.  See also
 171 `nntp-open-connection-function'")
 172
 173 (defvoo nntp-warn-about-losing-connection t
 174   "*If non-nil, beep when a server closes connection.")
 175
 176 (defvoo nntp-coding-system-for-read 'binary
 177   "*Coding system to read from NNTP.")
 178
 179 (defvoo nntp-coding-system-for-write 'binary
 180   "*Coding system to write to NNTP.")
 181
 182 (defcustom nntp-authinfo-file "~/.authinfo"
 183   ".netrc-like file that holds nntp authinfo passwords."
 184   :type
 185   '(choice file
 186            (repeat :tag "Entries"
 187                    :menu-tag "Inline"
 188                    (list :format "%v"
 189                          :value ("" ("login" . "") ("password" . ""))
 190                          (string :tag "Host")
 191                          (checklist :inline t
 192                                     (cons :format "%v"
 193                                           (const :format "" "login")
 194                                           (string :format "Login: %v"))
 195                                     (cons :format "%v"
 196                                           (const :format "" "password")
 197                                           (string :format "Password: %v")))))))
 198
 199 \f
 200
 201 (defvoo nntp-connection-timeout nil
 202   "*Number of seconds to wait before an nntp connection times out.
 203 If this variable is nil, which is the default, no timers are set.
 204 NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
 205
 206 (defvoo nntp-prepare-post-hook nil
 207   "*Hook run just before posting an article.  It is supposed to be used
 208 to insert Cancel-Lock headers.")
 209
 210 ;;; Internal variables.
 211
 212 (defvar nntp-record-commands nil
 213   "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
 214
 215 (defvar nntp-have-messaged nil)
 216
 217 (defvar nntp-process-wait-for nil)
 218 (defvar nntp-process-to-buffer nil)
 219 (defvar nntp-process-callback nil)
 220 (defvar nntp-process-decode nil)
 221 (defvar nntp-process-start-point nil)
 222 (defvar nntp-inside-change-function nil)
 223 (defvoo nntp-last-command-time nil)
 224 (defvoo nntp-last-command nil)
 225 (defvoo nntp-authinfo-password nil)
 226 (defvoo nntp-authinfo-user nil)
 227
 228 (defvar nntp-connection-list nil)
 229
 230 (defvoo nntp-server-type nil)
 231 (defvoo nntp-connection-alist nil)
 232 (defvoo nntp-status-string "")
 233 (defconst nntp-version "nntp 5.0")
 234 (defvoo nntp-inhibit-erase nil)
 235 (defvoo nntp-inhibit-output nil)
 236
 237 (defvoo nntp-server-xover 'try)
 238 (defvoo nntp-server-list-active-group 'try)
 239
 240 (defvar nntp-async-needs-kluge
 241   (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
 242   "*When non-nil, nntp will poll asynchronous connections
 243 once a second.  By default, this is turned on only for Emacs
 244 20.3, which has a bug that breaks nntp's normal method of
 245 noticing asynchronous data.")
 246
 247 (defvar nntp-async-timer nil)
 248 (defvar nntp-async-process-list nil)
 249
 250 (eval-and-compile
 251   (autoload 'mail-source-read-passwd "mail-source")
 252   (autoload 'open-ssl-stream "ssl"))
 253
 254 \f
 255
 256 ;;; Internal functions.
 257
 258 (defsubst nntp-send-string (process string)
 259   "Send STRING to PROCESS."
 260   ;; We need to store the time to provide timeouts, and
 261   ;; to store the command so the we can replay the command
 262   ;; if the server gives us an AUTHINFO challenge.
 263   (setq nntp-last-command-time (current-time)
 264         nntp-last-command string)
 265   (when nntp-record-commands
 266     (nntp-record-command string))
 267   (process-send-string process (concat string nntp-end-of-line)))
 268
 269 (defun nntp-record-command (string)
 270   "Record the command STRING."
 271   (save-excursion
 272     (set-buffer (get-buffer-create "*nntp-log*"))
 273     (goto-char (point-max))
 274     (let ((time (current-time)))
 275       (insert (format-time-string "%Y%m%dT%H%M%S" time)
 276               "." (format "%03d" (/ (nth 2 time) 1000))
 277               " " nntp-address " " string "\n"))))
 278
 279 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
 280   "Wait for WAIT-FOR to arrive from PROCESS."
 281   (save-excursion
 282     (set-buffer (process-buffer process))
 283     (goto-char (point-min))
 284     (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
 285                     (looking-at "480"))
 286                 (memq (process-status process) '(open run)))
 287       (when (looking-at "480")
 288         (nntp-handle-authinfo process))
 289       (when (looking-at "^.*\n")
 290         (delete-region (point) (progn (forward-line 1) (point))))
 291       (nntp-accept-process-output process)
 292       (goto-char (point-min)))
 293     (prog1
 294         (cond
 295          ((looking-at "[45]")
 296           (progn
 297             (nntp-snarf-error-message)
 298             nil))
 299          ((not (memq (process-status process) '(open run)))
 300           (nntp-report "Server closed connection"))
 301          (t
 302           (goto-char (point-max))
 303           (let ((limit (point-min))
 304                 response)
 305             (while (not (re-search-backward wait-for limit t))
 306               (nntp-accept-process-output process)
 307               ;; We assume that whatever we wait for is less than 1000
 308               ;; characters long.
 309               (setq limit (max (- (point-max) 1000) (point-min)))
 310               (goto-char (point-max)))
 311             (setq response (match-string 0))
 312             (with-current-buffer nntp-server-buffer
 313               (setq nntp-process-response response)))
 314           (nntp-decode-text (not decode))
 315           (unless discard
 316             (save-excursion
 317               (set-buffer buffer)
 318               (goto-char (point-max))
 319               (insert-buffer-substring (process-buffer process))
 320               ;; Nix out "nntp reading...." message.
 321               (when nntp-have-messaged
 322                 (setq nntp-have-messaged nil)
 323                 (nnheader-message 5 ""))))
 324           t))
 325       (unless discard
 326         (erase-buffer)))))
 327
 328 (defun nntp-kill-buffer (buffer)
 329   (when (buffer-name buffer)
 330     (kill-buffer buffer)
 331     (nnheader-init-server-buffer)))
 332
 333 (defsubst nntp-find-connection (buffer)
 334   "Find the connection delivering to BUFFER."
 335   (let ((alist nntp-connection-alist)
 336         (buffer (if (stringp buffer) (get-buffer buffer) buffer))
 337         process entry)
 338     (while (and alist (setq entry (pop alist)))
 339       (when (eq buffer (cadr entry))
 340         (setq process (car entry)
 341               alist nil)))
 342     (when process
 343       (if (memq (process-status process) '(open run))
 344           process
 345         (nntp-kill-buffer (process-buffer process))
 346         (setq nntp-connection-alist (delq entry nntp-connection-alist))
 347         nil))))
 348
 349 (defsubst nntp-find-connection-entry (buffer)
 350   "Return the entry for the connection to BUFFER."
 351   (assq (nntp-find-connection buffer) nntp-connection-alist))
 352
 353 (defun nntp-find-connection-buffer (buffer)
 354   "Return the process connection buffer tied to BUFFER."
 355   (let ((process (nntp-find-connection buffer)))
 356     (when process
 357       (process-buffer process))))
 358
 359 (defsubst nntp-retrieve-data (command address port buffer
 360                                       &optional wait-for callback decode)
 361   "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
 362   (let ((process (or (nntp-find-connection buffer)
 363                      (nntp-open-connection buffer))))
 364     (if (not process)
 365         (nnheader-report 'nntp "Couldn't open connection to %s" address)
 366       (unless (or nntp-inhibit-erase nnheader-callback-function)
 367         (save-excursion
 368           (set-buffer (process-buffer process))
 369           (erase-buffer)))
 370       (condition-case err
 371           (progn
 372             (when command
 373               (nntp-send-string process command))
 374             (cond
 375              ((eq callback 'ignore)
 376               t)
 377              ((and callback wait-for)
 378               (nntp-async-wait process wait-for buffer decode callback)
 379               t)
 380              (wait-for
 381               (nntp-wait-for process wait-for buffer decode))
 382              (t t)))
 383         (error
 384          (nnheader-report 'nntp "Couldn't open connection to %s: %s"
 385                           address err))
 386         (quit
 387          (message "Quit retrieving data from nntp")
 388          (signal 'quit nil)
 389          nil)))))
 390
 391 (defsubst nntp-send-command (wait-for &rest strings)
 392   "Send STRINGS to server and wait until WAIT-FOR returns."
 393   (when (and (not nnheader-callback-function)
 394              (not nntp-inhibit-output))
 395     (save-excursion
 396       (set-buffer nntp-server-buffer)
 397       (erase-buffer)))
 398   (let* ((command (mapconcat 'identity strings " "))
 399          (process (nntp-find-connection nntp-server-buffer))
 400          (buffer (and process (process-buffer process)))
 401          (pos (and buffer (with-current-buffer buffer (point)))))
 402     (if process
 403         (prog1
 404             (nntp-retrieve-data command
 405                                 nntp-address nntp-port-number
 406                                 nntp-server-buffer
 407                                 wait-for nnheader-callback-function)
 408           ;; If nothing to wait for, still remove possibly echo'ed commands.
 409           ;; We don't have echos if nntp-open-connection-function
 410           ;; is `nntp-open-network-stream', so we skip this in that case.
 411           (unless (or wait-for
 412                       (equal nntp-open-connection-function
 413                              'nntp-open-network-stream))
 414             (nntp-accept-response)
 415             (save-excursion
 416               (set-buffer buffer)
 417               (goto-char pos)
 418               (if (looking-at (regexp-quote command))
 419                   (delete-region pos (progn (forward-line 1)
 420                                             (gnus-point-at-bol))))
 421               )))
 422       (nnheader-report 'nntp "Couldn't open connection to %s."
 423                        nntp-address))))
 424
 425 (defun nntp-send-command-nodelete (wait-for &rest strings)
 426   "Send STRINGS to server and wait until WAIT-FOR returns."
 427   (let* ((command (mapconcat 'identity strings " "))
 428          (process (nntp-find-connection nntp-server-buffer))
 429          (buffer (and process (process-buffer process)))
 430          (pos (and buffer (with-current-buffer buffer (point)))))
 431     (if process
 432         (prog1
 433             (nntp-retrieve-data command
 434                                 nntp-address nntp-port-number
 435                                 nntp-server-buffer
 436                                 wait-for nnheader-callback-function)
 437           ;; If nothing to wait for, still remove possibly echo'ed commands
 438           (unless wait-for
 439             (nntp-accept-response)
 440             (save-excursion
 441               (set-buffer buffer)
 442               (goto-char pos)
 443               (if (looking-at (regexp-quote command))
 444                   (delete-region pos (progn (forward-line 1)
 445                                             (gnus-point-at-bol))))
 446               )))
 447       (nnheader-report 'nntp "Couldn't open connection to %s."
 448                        nntp-address))))
 449
 450 (defun nntp-send-command-and-decode (wait-for &rest strings)
 451   "Send STRINGS to server and wait until WAIT-FOR returns."
 452   (when (and (not nnheader-callback-function)
 453              (not nntp-inhibit-output))
 454     (save-excursion
 455       (set-buffer nntp-server-buffer)
 456       (erase-buffer)))
 457   (let* ((command (mapconcat 'identity strings " "))
 458          (process (nntp-find-connection nntp-server-buffer))
 459          (buffer (and process (process-buffer process)))
 460          (pos (and buffer (with-current-buffer buffer (point)))))
 461     (if process
 462         (prog1
 463             (nntp-retrieve-data command
 464                                 nntp-address nntp-port-number
 465                                 nntp-server-buffer
 466                                 wait-for nnheader-callback-function t)
 467           ;; If nothing to wait for, still remove possibly echo'ed commands
 468           (unless wait-for
 469             (nntp-accept-response)
 470             (save-excursion
 471           (set-buffer buffer)
 472           (goto-char pos)
 473           (if (looking-at (regexp-quote command))
 474               (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
 475           )))
 476       (nnheader-report 'nntp "Couldn't open connection to %s."
 477                        nntp-address))))
 478
 479
 480 (defun nntp-send-buffer (wait-for)
 481   "Send the current buffer to server and wait until WAIT-FOR returns."
 482   (when (and (not nnheader-callback-function)
 483              (not nntp-inhibit-output))
 484     (save-excursion
 485       (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
 486       (erase-buffer)))
 487   (nntp-encode-text)
 488   (mm-with-unibyte-current-buffer
 489     ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
 490     (process-send-region (nntp-find-connection nntp-server-buffer)
 491                          (point-min) (point-max)))
 492   (nntp-retrieve-data
 493    nil nntp-address nntp-port-number nntp-server-buffer
 494    wait-for nnheader-callback-function))
 495
 496 \f
 497
 498 ;;; Interface functions.
 499
 500 (nnoo-define-basics nntp)
 501
 502 (defsubst nntp-next-result-arrived-p ()
 503   (cond
 504    ;; A result that starts with a 2xx code is terminated by
 505    ;; a line with only a "." on it.
 506    ((eq (char-after) ?2)
 507     (if (re-search-forward "\n\\.\r?\n" nil t)
 508         t
 509       nil))
 510    ;; A result that starts with a 3xx or 4xx code is terminated
 511    ;; by a newline.
 512    ((looking-at "[34]")
 513     (if (search-forward "\n" nil t)
 514         t
 515       nil))
 516    ;; No result here.
 517    (t
 518     nil)))
 519
 520 (eval-when-compile
 521   (defvar nntp-with-open-group-first-pass nil))
 522
 523 (defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
 524   "Protect against servers that don't like clients that keep idle connections opens.  The problem
 525 being that these servers may either close a connection or simply ignore any further requests on a
 526 connection.  Closed connections are not detected until accept-process-output has updated the
 527 process-status.  Dropped connections are not detected until the connection timeouts (which may be
 528 several minutes) or nntp-connection-timeout has expired.  When these occur nntp-with-open-group,
 529 opens a new connection then re-issues the NNTP command whose response triggered the error."
 530   (when (and (listp connectionless)
 531              (not (eq connectionless nil)))
 532     (setq forms (cons connectionless forms)
 533           connectionless))
 534   `(let ((nntp-with-open-group-first-pass t)
 535          nntp-with-open-group-internal)
 536      (while (catch 'nntp-with-open-group-error
 537               ;; Open the connection to the server
 538               ;; NOTE: Existing connections are NOT tested.
 539               (nntp-possibly-change-group ,group ,server ,connectionless)
 540
 541               (let ((timer
 542                      (and nntp-connection-timeout
 543                           (nnheader-run-at-time
 544                            nntp-connection-timeout nil
 545                            '(lambda ()
 546                               (let ((process (nntp-find-connection nntp-server-buffer))
 547                                     (buffer  (and process (process-buffer process))))
 548                                         ; when I an able to identify the connection to the server AND I've received NO
 549                                         ; reponse for nntp-connection-timeout seconds.
 550                                 (when (and buffer (eq 0 (buffer-size buffer)))
 551                                         ; Close the connection.  Take no other action as the accept input code will
 552                                         ; handle the closed connection.
 553                                   (nntp-kill-buffer buffer))))))))
 554                 (unwind-protect
 555                     (setq nntp-with-open-group-internal (progn ,@forms))
 556                   (when timer
 557                     (nnheader-cancel-timer timer)))
 558                 nil))
 559        (message "Appears to have caught nntp-with-open-group-error throw.")
 560        (debug)
 561        (setq nntp-with-open-group-first-pass nil))
 562      nntp-with-open-group-internal))
 563
 564 (defsubst nntp-report (&rest args)
 565   "Report an error from the nntp backend.
 566 The first string in ARGS can be a format string.
 567 For some commands, the failed command may be retried once before actually displaying the error report."
 568
 569   (if nntp-with-open-group-first-pass
 570       (throw 'nntp-with-open-group-error t))
 571
 572   (nnheader-report 'nntp args)
 573   )
 574
 575 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
 576   "Retrieve the headers of ARTICLES."
 577   (nntp-with-open-group
 578     group server
 579     (save-excursion
 580       (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
 581       (erase-buffer)
 582       (if (and (not gnus-nov-is-evil)
 583                (not nntp-nov-is-evil)
 584                (nntp-retrieve-headers-with-xover articles fetch-old))
 585           ;; We successfully retrieved the headers via XOVER.
 586           'nov
 587         ;; XOVER didn't work, so we do it the hard, slow and inefficient
 588         ;; way.
 589         (let ((number (length articles))
 590               (count 0)
 591               (received 0)
 592               (last-point (point-min))
 593               (buf (nntp-find-connection-buffer nntp-server-buffer))
 594               (nntp-inhibit-erase t)
 595               article)
 596           ;; Send HEAD commands.
 597           (while (setq article (pop articles))
 598             (nntp-send-command
 599              nil
 600              "HEAD" (if (numberp article)
 601                         (int-to-string article)
 602                       ;; `articles' is either a list of article numbers
 603                       ;; or a list of article IDs.
 604                       article))
 605             (incf count)
 606             ;; Every 400 requests we have to read the stream in
 607             ;; order to avoid deadlocks.
 608             (when (or (null articles)   ;All requests have been sent.
 609                       (zerop (% count nntp-maximum-request)))
 610               (nntp-accept-response)
 611               (while (progn
 612                        (set-buffer buf)
 613                        (goto-char last-point)
 614                        ;; Count replies.
 615                        (while (nntp-next-result-arrived-p)
 616                          (setq last-point (point))
 617                          (incf received))
 618                        (< received count))
 619                 ;; If number of headers is greater than 100, give
 620                 ;;  informative messages.
 621                 (and (numberp nntp-large-newsgroup)
 622                      (> number nntp-large-newsgroup)
 623                      (zerop (% received 20))
 624                      (nnheader-message 6 "NNTP: Receiving headers... %d%%"
 625                                        (/ (* received 100) number)))
 626                 (nntp-accept-response))))
 627           (and (numberp nntp-large-newsgroup)
 628                (> number nntp-large-newsgroup)
 629                (nnheader-message 6 "NNTP: Receiving headers...done"))
 630
 631           ;; Now all of replies are received.  Fold continuation lines.
 632           (nnheader-fold-continuation-lines)
 633           ;; Remove all "\r"'s.
 634           (nnheader-strip-cr)
 635           (copy-to-buffer nntp-server-buffer (point-min) (point-max))
 636           'headers)))))
 637
 638 (deffoo nntp-retrieve-groups (groups &optional server)
 639   "Retrieve group info on GROUPS."
 640   (nntp-possibly-change-group nil server)
 641   (when (nntp-find-connection-buffer nntp-server-buffer)
 642     (catch 'done
 643       (save-excursion
 644         ;; Erase nntp-server-buffer before nntp-inhibit-erase.
 645         (set-buffer nntp-server-buffer)
 646         (erase-buffer)
 647         (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
 648         ;; The first time this is run, this variable is `try'.  So we
 649         ;; try.
 650         (when (eq nntp-server-list-active-group 'try)
 651           (nntp-try-list-active (car groups)))
 652         (erase-buffer)
 653         (let ((count 0)
 654               (received 0)
 655               (last-point (point-min))
 656               (nntp-inhibit-erase t)
 657               (buf (nntp-find-connection-buffer nntp-server-buffer))
 658               (command (if nntp-server-list-active-group
 659                            "LIST ACTIVE" "GROUP")))
 660           (while groups
 661             ;; Timeout may have killed the buffer.
 662             (unless (gnus-buffer-live-p buf)
 663               (nnheader-report 'nntp "Connection to %s is closed." server)
 664               (throw 'done nil))
 665             ;; Send the command to the server.
 666             (nntp-send-command nil command (pop groups))
 667             (incf count)
 668             ;; Every 400 requests we have to read the stream in
 669             ;; order to avoid deadlocks.
 670             (when (or (null groups)     ;All requests have been sent.
 671                       (zerop (% count nntp-maximum-request)))
 672               (nntp-accept-response)
 673               (while (and (gnus-buffer-live-p buf)
 674                           (progn
 675                             ;; Search `blue moon' in this file for the
 676                             ;; reason why set-buffer here.
 677                             (set-buffer buf)
 678                             (goto-char last-point)
 679                             ;; Count replies.
 680                             (while (re-search-forward "^[0-9]" nil t)
 681                               (incf received))
 682                             (setq last-point (point))
 683                             (< received count)))
 684                 (nntp-accept-response))))
 685
 686           ;; Wait for the reply from the final command.
 687           (unless (gnus-buffer-live-p buf)
 688             (nnheader-report 'nntp "Connection to %s is closed." server)
 689             (throw 'done nil))
 690           (set-buffer buf)
 691           (goto-char (point-max))
 692           (re-search-backward "^[0-9]" nil t)
 693           (when (looking-at "^[23]")
 694             (while (and (gnus-buffer-live-p buf)
 695                         (progn
 696                           (set-buffer buf)
 697                           (goto-char (point-max))
 698                           (if (not nntp-server-list-active-group)
 699                               (not (re-search-backward "\r?\n" (- (point) 3) t))
 700                             (not (re-search-backward "^\\.\r?\n"
 701                                                      (- (point) 4) t)))))
 702               (nntp-accept-response)))
 703
 704           ;; Now all replies are received.  We remove CRs.
 705           (unless (gnus-buffer-live-p buf)
 706             (nnheader-report 'nntp "Connection to %s is closed." server)
 707             (throw 'done nil))
 708           (set-buffer buf)
 709           (goto-char (point-min))
 710           (while (search-forward "\r" nil t)
 711             (replace-match "" t t))
 712
 713           (if (not nntp-server-list-active-group)
 714               (progn
 715                 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
 716                 'group)
 717             ;; We have read active entries, so we just delete the
 718             ;; superfluous gunk.
 719             (goto-char (point-min))
 720             (while (re-search-forward "^[.2-5]" nil t)
 721               (delete-region (match-beginning 0)
 722                              (progn (forward-line 1) (point))))
 723             (copy-to-buffer nntp-server-buffer (point-min) (point-max))
 724             'active))))))
 725
 726 (deffoo nntp-retrieve-articles (articles &optional group server)
 727   (nntp-with-open-group
 728     group server
 729    (save-excursion
 730      (let ((number (length articles))
 731            (count 0)
 732            (received 0)
 733            (last-point (point-min))
 734            (buf (nntp-find-connection-buffer nntp-server-buffer))
 735            (nntp-inhibit-erase t)
 736            (map (apply 'vector articles))
 737            (point 1)
 738            article)
 739        (set-buffer buf)
 740        (erase-buffer)
 741        ;; Send ARTICLE command.
 742        (while (setq article (pop articles))
 743          (nntp-send-command
 744           nil
 745           "ARTICLE" (if (numberp article)
 746                         (int-to-string article)
 747                       ;; `articles' is either a list of article numbers
 748                       ;; or a list of article IDs.
 749                       article))
 750          (incf count)
 751          ;; Every 400 requests we have to read the stream in
 752          ;; order to avoid deadlocks.
 753          (when (or (null articles)      ;All requests have been sent.
 754                    (zerop (% count nntp-maximum-request)))
 755            (nntp-accept-response)
 756            (while (progn
 757                     (set-buffer buf)
 758                     (goto-char last-point)
 759                     ;; Count replies.
 760                     (while (nntp-next-result-arrived-p)
 761                       (aset map received (cons (aref map received) (point)))
 762                       (setq last-point (point))
 763                       (incf received))
 764                     (< received count))
 765              ;; If number of headers is greater than 100, give
 766              ;;  informative messages.
 767              (and (numberp nntp-large-newsgroup)
 768                   (> number nntp-large-newsgroup)
 769                   (zerop (% received 20))
 770                   (nnheader-message 6 "NNTP: Receiving articles... %d%%"
 771                                     (/ (* received 100) number)))
 772              (nntp-accept-response))))
 773        (and (numberp nntp-large-newsgroup)
 774             (> number nntp-large-newsgroup)
 775             (nnheader-message 6 "NNTP: Receiving articles...done"))
 776
 777        ;; Now we have all the responses.  We go through the results,
 778        ;; wash it and copy it over to the server buffer.
 779        (set-buffer nntp-server-buffer)
 780        (erase-buffer)
 781        (setq last-point (point-min))
 782        (mapcar
 783         (lambda (entry)
 784           (narrow-to-region
 785            (setq point (goto-char (point-max)))
 786            (progn
 787              (insert-buffer-substring buf last-point (cdr entry))
 788              (point-max)))
 789           (setq last-point (cdr entry))
 790           (nntp-decode-text)
 791           (widen)
 792           (cons (car entry) point))
 793         map)))))
 794
 795 (defun nntp-try-list-active (group)
 796   (nntp-list-active-group group)
 797   (save-excursion
 798     (set-buffer nntp-server-buffer)
 799     (goto-char (point-min))
 800     (cond ((or (eobp)
 801                (looking-at "5[0-9]+"))
 802            (setq nntp-server-list-active-group nil))
 803           (t
 804            (setq nntp-server-list-active-group t)))))
 805
 806 (deffoo nntp-list-active-group (group &optional server)
 807   "Return the active info on GROUP (which can be a regexp)."
 808   (nntp-possibly-change-group nil server)
 809   (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))
 810
 811 (deffoo nntp-request-group-articles (group &optional server)
 812   "Return the list of existing articles in GROUP."
 813   (nntp-possibly-change-group nil server)
 814   (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))
 815
 816 (deffoo nntp-request-article (article &optional group server buffer command)
 817   (nntp-with-open-group
 818     group server
 819     (when (nntp-send-command-and-decode
 820            "\r?\n\\.\r?\n" "ARTICLE"
 821            (if (numberp article) (int-to-string article) article))
 822       (if (and buffer
 823                (not (equal buffer nntp-server-buffer)))
 824           (save-excursion
 825             (set-buffer nntp-server-buffer)
 826             (copy-to-buffer buffer (point-min) (point-max))
 827             (nntp-find-group-and-number group))
 828         (nntp-find-group-and-number group)))))
 829
 830 (deffoo nntp-request-head (article &optional group server)
 831   (nntp-possibly-change-group group server)
 832   (when (nntp-send-command
 833          "\r?\n\\.\r?\n" "HEAD"
 834          (if (numberp article) (int-to-string article) article))
 835     (prog1
 836         (nntp-find-group-and-number group)
 837       (nntp-decode-text))))
 838
 839 (deffoo nntp-request-body (article &optional group server)
 840   (nntp-possibly-change-group group server)
 841   (nntp-send-command-and-decode
 842    "\r?\n\\.\r?\n" "BODY"
 843    (if (numberp article) (int-to-string article) article)))
 844
 845 (deffoo nntp-request-group (group &optional server dont-check)
 846   (nntp-with-open-group
 847     nil server
 848     (when (nntp-send-command "^[245].*\n" "GROUP" group)
 849       (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
 850         (setcar (cddr entry) group)))))
 851
 852 (deffoo nntp-close-group (group &optional server)
 853   t)
 854
 855 (deffoo nntp-server-opened (&optional server)
 856   "Say whether a connection to SERVER has been opened."
 857   (and (nnoo-current-server-p 'nntp server)
 858        nntp-server-buffer
 859        (gnus-buffer-live-p nntp-server-buffer)
 860        (nntp-find-connection nntp-server-buffer)))
 861
 862 (deffoo nntp-open-server (server &optional defs connectionless)
 863   (nnheader-init-server-buffer)
 864   (if (nntp-server-opened server)
 865       t
 866     (when (or (stringp (car defs))
 867               (numberp (car defs)))
 868       (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
 869     (unless (assq 'nntp-address defs)
 870       (setq defs (append defs (list (list 'nntp-address server)))))
 871     (nnoo-change-server 'nntp server defs)
 872     (unless connectionless
 873       (or (nntp-find-connection nntp-server-buffer)
 874           (nntp-open-connection nntp-server-buffer)))))
 875
 876 (deffoo nntp-close-server (&optional server)
 877   (nntp-possibly-change-group nil server t)
 878   (let ((process (nntp-find-connection nntp-server-buffer)))
 879     (while process
 880       (when (memq (process-status process) '(open run))
 881         (ignore-errors
 882           (nntp-send-string process "QUIT")
 883           (unless (eq nntp-open-connection-function 'nntp-open-network-stream)
 884             ;; Ok, this is evil, but when using telnet and stuff
 885             ;; as the connection method, it's important that the
 886             ;; QUIT command actually is sent out before we kill
 887             ;; the process.
 888             (sleep-for 1))))
 889       (nntp-kill-buffer (process-buffer process))
 890       (setq process (car (pop nntp-connection-alist))))
 891     (nnoo-close-server 'nntp)))
 892
 893 (deffoo nntp-request-close ()
 894   (let (process)
 895     (while (setq process (pop nntp-connection-list))
 896       (when (memq (process-status process) '(open run))
 897         (ignore-errors
 898           (nntp-send-string process "QUIT")
 899           (unless (eq nntp-open-connection-function 'nntp-open-network-stream)
 900             ;; Ok, this is evil, but when using telnet and stuff
 901             ;; as the connection method, it's important that the
 902             ;; QUIT command actually is sent out before we kill
 903             ;; the process.
 904             (sleep-for 1))))
 905       (nntp-kill-buffer (process-buffer process)))))
 906
 907 (deffoo nntp-request-list (&optional server)
 908   (nntp-possibly-change-group nil server)
 909   (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
 910
 911 (deffoo nntp-request-list-newsgroups (&optional server)
 912   (nntp-possibly-change-group nil server)
 913   (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
 914
 915 (deffoo nntp-request-newgroups (date &optional server)
 916   (nntp-possibly-change-group nil server)
 917   (save-excursion
 918     (set-buffer nntp-server-buffer)
 919     (let* ((time (date-to-time date))
 920            (ls (- (cadr time) (nth 8 (decode-time time)))))
 921       (cond ((< ls 0)
 922              (setcar time (1- (car time)))
 923              (setcar (cdr time) (+ ls 65536)))
 924             ((>= ls 65536)
 925              (setcar time (1+ (car time)))
 926              (setcar (cdr time) (- ls 65536)))
 927             (t
 928              (setcar (cdr time) ls)))
 929       (prog1
 930           (nntp-send-command
 931            "^\\.\r?\n" "NEWGROUPS"
 932            (format-time-string "%y%m%d %H%M%S" time)
 933            "GMT")
 934         (nntp-decode-text)))))
 935
 936 (deffoo nntp-request-post (&optional server)
 937   (nntp-possibly-change-group nil server)
 938   (when (nntp-send-command "^[23].*\r?\n" "POST")
 939     (let ((response (with-current-buffer nntp-server-buffer
 940                       nntp-process-response))
 941           server-id)
 942       (when (and response
 943                  (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
 944                                response))
 945         (setq server-id (match-string 1 response))
 946         (narrow-to-region (goto-char (point-min))
 947                           (if (search-forward "\n\n" nil t)
 948                               (1- (point))
 949                             (point-max)))
 950         (unless (mail-fetch-field "Message-ID")
 951           (goto-char (point-min))
 952           (insert "Message-ID: " server-id "\n"))
 953         (widen))
 954       (run-hooks 'nntp-prepare-post-hook)
 955       (nntp-send-buffer "^[23].*\n"))))
 956
 957 (deffoo nntp-request-type (group article)
 958   'news)
 959
 960 (deffoo nntp-asynchronous-p ()
 961   t)
 962
 963 ;;; Hooky functions.
 964
 965 (defun nntp-send-mode-reader ()
 966   "Send the MODE READER command to the nntp server.
 967 This function is supposed to be called from `nntp-server-opened-hook'.
 968 It will make innd servers spawn an nnrpd process to allow actual article
 969 reading."
 970   (nntp-send-command "^.*\n" "MODE READER"))
 971
 972 (defun nntp-send-authinfo (&optional send-if-force)
 973   "Send the AUTHINFO to the nntp server.
 974 It will look in the \"~/.authinfo\" file for matching entries.  If
 975 nothing suitable is found there, it will prompt for a user name
 976 and a password.
 977
 978 If SEND-IF-FORCE, only send authinfo to the server if the
 979 .authinfo file has the FORCE token."
 980   (let* ((list (gnus-parse-netrc nntp-authinfo-file))
 981          (alist (gnus-netrc-machine list nntp-address "nntp"))
 982          (force (gnus-netrc-get alist "force"))
 983          (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
 984          (passwd (gnus-netrc-get alist "password")))
 985     (when (or (not send-if-force)
 986               force)
 987       (unless user
 988         (setq user (read-string (format "NNTP (%s) user name: " nntp-address))
 989               nntp-authinfo-user user))
 990       (unless (member user '(nil ""))
 991         (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
 992         (when t                         ;???Should check if AUTHINFO succeeded
 993           (nntp-send-command
 994            "^2.*\r?\n" "AUTHINFO PASS"
 995            (or passwd
 996                nntp-authinfo-password
 997                (setq nntp-authinfo-password
 998                      (mail-source-read-passwd
 999                       (format "NNTP (%s@%s) password: "
1000                               user nntp-address))))))))))
1001
1002 (defun nntp-send-nosy-authinfo ()
1003   "Send the AUTHINFO to the nntp server."
1004   (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
1005     (unless (member user '(nil ""))
1006       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
1007       (when t                           ;???Should check if AUTHINFO succeeded
1008         (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
1009                            (mail-source-read-passwd "NNTP (%s@%s) password: "
1010                                                     user nntp-address))))))
1011
1012 (defun nntp-send-authinfo-from-file ()
1013   "Send the AUTHINFO to the nntp server.
1014
1015 The authinfo login name is taken from the user's login name and the
1016 password contained in '~/.nntp-authinfo'."
1017   (when (file-exists-p "~/.nntp-authinfo")
1018     (with-temp-buffer
1019       (insert-file-contents "~/.nntp-authinfo")
1020       (goto-char (point-min))
1021       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
1022       (nntp-send-command
1023        "^2.*\r?\n" "AUTHINFO PASS"
1024        (buffer-substring (point) (progn (end-of-line) (point)))))))
1025
1026 ;;; Internal functions.
1027
1028 (defun nntp-handle-authinfo (process)
1029   "Take care of an authinfo response from the server."
1030   (let ((last nntp-last-command))
1031     (funcall nntp-authinfo-function)
1032     ;; We have to re-send the function that was interrupted by
1033     ;; the authinfo request.
1034     (save-excursion
1035       (set-buffer nntp-server-buffer)
1036       (erase-buffer))
1037     (nntp-send-string process last)))
1038
1039 (defun nntp-make-process-buffer (buffer)
1040   "Create a new, fresh buffer usable for nntp process connections."
1041   (save-excursion
1042     (set-buffer
1043      (generate-new-buffer
1044       (format " *server %s %s %s*"
1045               nntp-address nntp-port-number
1046               (gnus-buffer-exists-p buffer))))
1047     (mm-enable-multibyte)
1048     (set (make-local-variable 'after-change-functions) nil)
1049     (set (make-local-variable 'nntp-process-wait-for) nil)
1050     (set (make-local-variable 'nntp-process-callback) nil)
1051     (set (make-local-variable 'nntp-process-to-buffer) nil)
1052     (set (make-local-variable 'nntp-process-start-point) nil)
1053     (set (make-local-variable 'nntp-process-decode) nil)
1054     (current-buffer)))
1055
1056 (defun nntp-open-connection (buffer)
1057   "Open a connection to PORT on ADDRESS delivering output to BUFFER."
1058   (run-hooks 'nntp-prepare-server-hook)
1059   (let* ((pbuffer (nntp-make-process-buffer buffer))
1060          (timer
1061           (and nntp-connection-timeout
1062                (nnheader-run-at-time
1063                 nntp-connection-timeout nil
1064                 `(lambda ()
1065                    (nntp-kill-buffer ,pbuffer)))))
1066          (process
1067           (condition-case ()
1068               (let ((coding-system-for-read nntp-coding-system-for-read)
1069                     (coding-system-for-write nntp-coding-system-for-write))
1070                 (funcall nntp-open-connection-function pbuffer))
1071             (error nil)
1072             (quit
1073              (message "Quit opening connection")
1074              (nntp-kill-buffer pbuffer)
1075              (signal 'quit nil)
1076              nil))))
1077     (when timer
1078       (nnheader-cancel-timer timer))
1079     (unless process
1080       (nntp-kill-buffer pbuffer))
1081     (when (and (buffer-name pbuffer)
1082                process)
1083       (process-kill-without-query process)
1084       (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
1085                (memq (process-status process) '(open run)))
1086           (prog1
1087               (caar (push (list process buffer nil) nntp-connection-alist))
1088             (push process nntp-connection-list)
1089             (save-excursion
1090               (set-buffer pbuffer)
1091               (nntp-read-server-type)
1092               (erase-buffer)
1093               (set-buffer nntp-server-buffer)
1094               (let ((nnheader-callback-function nil))
1095                 (run-hooks 'nntp-server-opened-hook)
1096                 (nntp-send-authinfo t))))
1097         (nntp-kill-buffer (process-buffer process))
1098         nil))))
1099
1100 (defun nntp-open-network-stream (buffer)
1101   (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
1102
1103 (defun nntp-open-ssl-stream (buffer)
1104   (let ((proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
1105     (save-excursion
1106       (set-buffer buffer)
1107       (nntp-wait-for-string "^\r*20[01]")
1108       (beginning-of-line)
1109       (delete-region (point-min) (point))
1110       proc)))
1111
1112 (defun nntp-read-server-type ()
1113   "Find out what the name of the server we have connected to is."
1114   ;; Wait for the status string to arrive.
1115   (setq nntp-server-type (buffer-string))
1116   (let ((alist nntp-server-action-alist)
1117         (case-fold-search t)
1118         entry)
1119     ;; Run server-specific commands.
1120     (while alist
1121       (setq entry (pop alist))
1122       (when (string-match (car entry) nntp-server-type)
1123         (if (and (listp (cadr entry))
1124                  (not (eq 'lambda (caadr entry))))
1125             (eval (cadr entry))
1126           (funcall (cadr entry)))))))
1127
1128 (defun nntp-async-wait (process wait-for buffer decode callback)
1129   (save-excursion
1130     (set-buffer (process-buffer process))
1131     (unless nntp-inside-change-function
1132       (erase-buffer))
1133     (setq nntp-process-wait-for wait-for
1134           nntp-process-to-buffer buffer
1135           nntp-process-decode decode
1136           nntp-process-callback callback
1137           nntp-process-start-point (point-max))
1138     (setq after-change-functions '(nntp-after-change-function))
1139     (if nntp-async-needs-kluge
1140         (nntp-async-kluge process))))
1141
1142 (defun nntp-async-kluge (process)
1143   ;; emacs 20.3 bug: process output with encoding 'binary
1144   ;; doesn't trigger after-change-functions.
1145   (unless nntp-async-timer
1146     (setq nntp-async-timer
1147           (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
1148   (add-to-list 'nntp-async-process-list process))
1149
1150 (defun nntp-async-timer-handler ()
1151   (mapcar
1152    (lambda (proc)
1153      (if (memq (process-status proc) '(open run))
1154          (nntp-async-trigger proc)
1155        (nntp-async-stop proc)))
1156    nntp-async-process-list))
1157
1158 (defun nntp-async-stop (proc)
1159   (setq nntp-async-process-list (delq proc nntp-async-process-list))
1160   (when (and nntp-async-timer (not nntp-async-process-list))
1161     (nnheader-cancel-timer nntp-async-timer)
1162     (setq nntp-async-timer nil)))
1163
1164 (defun nntp-after-change-function (beg end len)
1165   (unwind-protect
1166       ;; we only care about insertions at eob
1167       (when (and (eq 0 len) (eq (point-max) end))
1168         (save-match-data
1169           (let ((proc (get-buffer-process (current-buffer))))
1170             (when proc
1171               (nntp-async-trigger proc)))))
1172     ;; any throw from after-change-functions will leave it
1173     ;; set to nil.  so we reset it here, if necessary.
1174     (when quit-flag
1175       (setq after-change-functions '(nntp-after-change-function)))))
1176
1177 (defun nntp-async-trigger (process)
1178   (save-excursion
1179     (set-buffer (process-buffer process))
1180     (when nntp-process-callback
1181       ;; do we have an error message?
1182       (goto-char nntp-process-start-point)
1183       (if (memq (following-char) '(?4 ?5))
1184           ;; wants credentials?
1185           (if (looking-at "480")
1186               (nntp-handle-authinfo process)
1187             ;; report error message.
1188             (nntp-snarf-error-message)
1189             (nntp-do-callback nil))
1190
1191         ;; got what we expect?
1192         (goto-char (point-max))
1193         (when (re-search-backward
1194                nntp-process-wait-for nntp-process-start-point t)
1195           (let ((response (match-string 0)))
1196             (with-current-buffer nntp-server-buffer
1197               (setq nntp-process-response response)))
1198           (nntp-async-stop process)
1199           ;; convert it.
1200           (when (gnus-buffer-exists-p nntp-process-to-buffer)
1201             (let ((buf (current-buffer))
1202                   (start nntp-process-start-point)
1203                   (decode nntp-process-decode))
1204               (save-excursion
1205                 (set-buffer nntp-process-to-buffer)
1206                 (goto-char (point-max))
1207                 (save-restriction
1208                   (narrow-to-region (point) (point))
1209                   (insert-buffer-substring buf start)
1210                   (when decode
1211                     (nntp-decode-text))))))
1212           ;; report it.
1213           (goto-char (point-max))
1214           (nntp-do-callback
1215            (buffer-name (get-buffer nntp-process-to-buffer))))))))
1216
1217 (defun nntp-do-callback (arg)
1218   (let ((callback nntp-process-callback)
1219         (nntp-inside-change-function t))
1220     (setq nntp-process-callback nil)
1221     (funcall callback arg)))
1222
1223 (defun nntp-snarf-error-message ()
1224   "Save the error message in the current buffer."
1225   (let ((message (buffer-string)))
1226     (while (string-match "[\r\n]+" message)
1227       (setq message (replace-match " " t t message)))
1228     (nnheader-report 'nntp message)
1229     message))
1230
1231 (defun nntp-accept-process-output (process &optional timeout)
1232   "Wait for output from PROCESS and message some dots."
1233   (save-excursion
1234     (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
1235                     nntp-server-buffer))
1236     (let ((len (/ (point-max) 1024))
1237           message-log-max)
1238       (unless (< len 10)
1239         (setq nntp-have-messaged t)
1240         (nnheader-message 7 "nntp read: %dk" len)))
1241     (accept-process-output process (or timeout 1))
1242     ;; accept-process-output may update status of process to indicate that the server has closed the
1243     ;; connection.  This MUST be handled here as the buffer restored by the save-excursion may be the
1244     ;; process's former output buffer (i.e. now killed)
1245     (or (memq (process-status process) '(open run))
1246         (nntp-report "Server closed connection"))))
1247
1248 (defun nntp-accept-response ()
1249   "Wait for output from the process that outputs to BUFFER."
1250   (nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
1251
1252 (defun nntp-possibly-change-group (group server &optional connectionless)
1253   (let ((nnheader-callback-function nil))
1254     (when server
1255       (or (nntp-server-opened server)
1256           (nntp-open-server server nil connectionless)))
1257
1258     (unless connectionless
1259       (or (nntp-find-connection nntp-server-buffer)
1260           (nntp-open-connection nntp-server-buffer))))
1261
1262   (when group
1263     (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
1264       (when (not (equal group (caddr entry)))
1265         (save-excursion
1266           (set-buffer (process-buffer (car entry)))
1267           (erase-buffer)
1268           (nntp-send-command "^[245].*\n" "GROUP" group)
1269           (setcar (cddr entry) group)
1270           (erase-buffer)
1271           (save-excursion
1272             (set-buffer nntp-server-buffer)
1273             (erase-buffer)))))))
1274
1275 (defun nntp-decode-text (&optional cr-only)
1276   "Decode the text in the current buffer."
1277   (goto-char (point-min))
1278   (while (search-forward "\r" nil t)
1279     (delete-char -1))
1280   (unless cr-only
1281     ;; Remove trailing ".\n" end-of-transfer marker.
1282     (goto-char (point-max))
1283     (forward-line -1)
1284     (when (looking-at ".\n")
1285       (delete-char 2))
1286     ;; Delete status line.
1287     (goto-char (point-min))
1288     (while (looking-at "[1-5][0-9][0-9] .*\n")
1289       ;; For some unknown reason, there is more than one status line.
1290       (delete-region (point) (progn (forward-line 1) (point))))
1291     ;; Remove "." -> ".." encoding.
1292     (while (search-forward "\n.." nil t)
1293       (delete-char -1))))
1294
1295 (defun nntp-encode-text ()
1296   "Encode the text in the current buffer."
1297   (save-excursion
1298     ;; Replace "." at beginning of line with "..".
1299     (goto-char (point-min))
1300     (while (re-search-forward "^\\." nil t)
1301       (insert "."))
1302     (goto-char (point-max))
1303     ;; Insert newline at the end of the buffer.
1304     (unless (bolp)
1305       (insert "\n"))
1306     ;; Insert `.' at end of buffer (end of text mark).
1307     (goto-char (point-max))
1308     (insert ".\n")
1309     (goto-char (point-min))
1310     (while (not (eobp))
1311       (end-of-line)
1312       (delete-char 1)
1313       (insert nntp-end-of-line))))
1314
1315 (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
1316   (set-buffer nntp-server-buffer)
1317   (erase-buffer)
1318   (cond
1319
1320    ;; This server does not talk NOV.
1321    ((not nntp-server-xover)
1322     nil)
1323
1324    ;; We don't care about gaps.
1325    ((or (not nntp-nov-gap)
1326         fetch-old)
1327     (nntp-send-xover-command
1328      (if fetch-old
1329          (if (numberp fetch-old)
1330              (max 1 (- (car articles) fetch-old))
1331            1)
1332        (car articles))
1333      (car (last articles)) 'wait)
1334
1335     (goto-char (point-min))
1336     (when (looking-at "[1-5][0-9][0-9] .*\n")
1337       (delete-region (point) (progn (forward-line 1) (point))))
1338     (while (search-forward "\r" nil t)
1339       (replace-match "" t t))
1340     (goto-char (point-max))
1341     (forward-line -1)
1342     (when (looking-at "\\.")
1343       (delete-region (point) (progn (forward-line 1) (point)))))
1344
1345    ;; We do it the hard way.  For each gap, an XOVER command is sent
1346    ;; to the server.  We do not wait for a reply from the server, we
1347    ;; just send them off as fast as we can.  That means that we have
1348    ;; to count the number of responses we get back to find out when we
1349    ;; have gotten all we asked for.
1350    ((numberp nntp-nov-gap)
1351     (let ((count 0)
1352           (received 0)
1353           last-point
1354           in-process-buffer-p
1355           (buf nntp-server-buffer)
1356           (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
1357           first
1358           last)
1359       ;; We have to check `nntp-server-xover'.  If it gets set to nil,
1360       ;; that means that the server does not understand XOVER, but we
1361       ;; won't know that until we try.
1362       (while (and nntp-server-xover articles)
1363         (setq first (car articles))
1364         ;; Search forward until we find a gap, or until we run out of
1365         ;; articles.
1366         (while (and (cdr articles)
1367                     (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
1368           (setq articles (cdr articles)))
1369
1370         (setq in-process-buffer-p (stringp nntp-server-xover))
1371         (nntp-send-xover-command first (setq last (car articles)))
1372         (setq articles (cdr articles))
1373
1374         (when (and nntp-server-xover in-process-buffer-p)
1375           ;; Don't count tried request.
1376           (setq count (1+ count))
1377
1378           ;; Every 400 requests we have to read the stream in
1379           ;; order to avoid deadlocks.
1380           (when (or (null articles)     ;All requests have been sent.
1381                     (= 1 (% count nntp-maximum-request)))
1382
1383             (nntp-accept-response)
1384             ;; On some Emacs versions the preceding function has a
1385             ;; tendency to change the buffer.  Perhaps.  It's quite
1386             ;; difficult to reproduce, because it only seems to happen
1387             ;; once in a blue moon.
1388             (set-buffer process-buffer)
1389             (while (progn
1390                      (goto-char (or last-point (point-min)))
1391                      ;; Count replies.
1392                      (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
1393                        (incf received))
1394                      (setq last-point (point))
1395                      (or (< received count) ;; I haven't started reading the final response
1396                          (progn
1397                            (goto-char (point-max))
1398                            (forward-line -1)
1399                            (not (looking-at "^\\.\r?\n"))) ;; I haven't read the end of the final response
1400                          ))
1401               (nntp-accept-response)
1402               (set-buffer process-buffer))))
1403
1404         ;; Some nntp servers seem to have an extension to the XOVER extension.  On these
1405         ;; servers, requesting an article range preceeding the active range does not return an
1406         ;; error as specified in the RFC.  What we instead get is the NOV entry for the first
1407         ;; available article.  Obviously, a client can use that entry to avoid making unnecessary
1408         ;; requests.  The only problem is for a client that assumes that the response will always be
1409         ;; within the requested ranage.  For such a client, we can get N copies of the same entry
1410         ;; (one for each XOVER command sent to the server).
1411
1412         (when (<= count 1)
1413           (goto-char (point-min))
1414           (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
1415             (let ((low-limit (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))
1416               (while (and articles (<= (car articles) low-limit))
1417                 (setq articles (cdr articles))))))
1418         (set-buffer buf))
1419
1420       (when nntp-server-xover
1421         (when in-process-buffer-p
1422           (set-buffer buf)
1423           (goto-char (point-max))
1424           (insert-buffer-substring process-buffer)
1425           (set-buffer process-buffer)
1426           (erase-buffer)
1427           (set-buffer buf))
1428
1429         ;; We remove any "." lines and status lines.
1430         (goto-char (point-min))
1431         (while (search-forward "\r" nil t)
1432           (delete-char -1))
1433         (goto-char (point-min))
1434         (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
1435         t))))
1436
1437   nntp-server-xover)
1438
1439 (defun nntp-send-xover-command (beg end &optional wait-for-reply)
1440   "Send the XOVER command to the server."
1441   (let ((range (format "%d-%d" beg end))
1442         (nntp-inhibit-erase t))
1443     (if (stringp nntp-server-xover)
1444         ;; If `nntp-server-xover' is a string, then we just send this
1445         ;; command.
1446         (if wait-for-reply
1447             (nntp-send-command-nodelete
1448              "\r?\n\\.\r?\n" nntp-server-xover range)
1449           ;; We do not wait for the reply.
1450           (nntp-send-command-nodelete nil nntp-server-xover range))
1451       (let ((commands nntp-xover-commands))
1452         ;; `nntp-xover-commands' is a list of possible XOVER commands.
1453         ;; We try them all until we get at positive response.
1454         (while (and commands (eq nntp-server-xover 'try))
1455           (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
1456           (save-excursion
1457             (set-buffer nntp-server-buffer)
1458             (goto-char (point-min))
1459             (and (looking-at "[23]")    ; No error message.
1460                  ;; We also have to look at the lines.  Some buggy
1461                  ;; servers give back simple lines with just the
1462                  ;; article number.  How... helpful.
1463                  (progn
1464                    (forward-line 1)
1465                    (looking-at "[0-9]+\t...")) ; More text after number.
1466                  (setq nntp-server-xover (car commands))))
1467           (setq commands (cdr commands)))
1468         ;; If none of the commands worked, we disable XOVER.
1469         (when (eq nntp-server-xover 'try)
1470           (save-excursion
1471             (set-buffer nntp-server-buffer)
1472             (erase-buffer)
1473             (setq nntp-server-xover nil)))
1474         nntp-server-xover))))
1475
1476 (defun nntp-find-group-and-number (&optional group)
1477   (save-excursion
1478     (save-restriction
1479       (set-buffer nntp-server-buffer)
1480       (narrow-to-region (goto-char (point-min))
1481                         (or (search-forward "\n\n" nil t) (point-max)))
1482       (goto-char (point-min))
1483       ;; We first find the number by looking at the status line.
1484       (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
1485                          (string-to-int
1486                           (buffer-substring (match-beginning 1)
1487                                             (match-end 1)))))
1488             newsgroups xref)
1489         (and number (zerop number) (setq number nil))
1490         (if number
1491             ;; Then we find the group name.
1492             (setq group
1493                   (cond
1494                    ;; If there is only one group in the Newsgroups
1495                    ;; header, then it seems quite likely that this
1496                    ;; article comes from that group, I'd say.
1497                    ((and (setq newsgroups
1498                                (mail-fetch-field "newsgroups"))
1499                          (not (string-match "," newsgroups)))
1500                     newsgroups)
1501                    ;; If there is more than one group in the
1502                    ;; Newsgroups header, then the Xref header should
1503                    ;; be filled out.  We hazard a guess that the group
1504                    ;; that has this article number in the Xref header
1505                    ;; is the one we are looking for.  This might very
1506                    ;; well be wrong if this article happens to have
1507                    ;; the same number in several groups, but that's
1508                    ;; life.
1509                    ((and (setq xref (mail-fetch-field "xref"))
1510                          number
1511                          (string-match
1512                           (format "\\([^ :]+\\):%d" number) xref))
1513                     (match-string 1 xref))
1514                    (t "")))
1515           (cond
1516            ((and (setq xref (mail-fetch-field "xref"))
1517                  (string-match
1518                   (if group
1519                       (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
1520                     "\\([^ :]+\\):\\([0-9]+\\)")
1521                   xref))
1522             (setq group (match-string 1 xref)
1523                   number (string-to-int (match-string 2 xref))))
1524            ((and (setq newsgroups
1525                        (mail-fetch-field "newsgroups"))
1526                  (not (string-match "," newsgroups)))
1527             (setq group newsgroups))
1528            (group)
1529            (t (setq group ""))))
1530         (when (string-match "\r" group)
1531           (setq group (substring group 0 (match-beginning 0))))
1532         (cons group number)))))
1533
1534 (defun nntp-wait-for-string (regexp)
1535   "Wait until string arrives in the buffer."
1536   (let ((buf (current-buffer))
1537         proc)
1538     (goto-char (point-min))
1539     (while (and (setq proc (get-buffer-process buf))
1540                 (memq (process-status proc) '(open run))
1541                 (not (re-search-forward regexp nil t)))
1542       (accept-process-output proc)
1543       (set-buffer buf)
1544       (goto-char (point-min)))))
1545
1546
1547 ;; ==========================================================================
1548 ;; Obsolete nntp-open-* connection methods -- drv
1549 ;; ==========================================================================
1550
1551 (defvoo nntp-open-telnet-envuser nil
1552   "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
1553
1554 (defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
1555   "*Regular expression to match the shell prompt on the remote machine.")
1556
1557 (defvoo nntp-rlogin-program "rsh"
1558   "*Program used to log in on remote machines.
1559 The default is \"rsh\", but \"ssh\" is a popular alternative.")
1560
1561 (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
1562   "*Parameters to `nntp-open-rlogin'.
1563 That function may be used as `nntp-open-connection-function'.  In that
1564 case, this list will be used as the parameter list given to rsh.")
1565
1566 (defvoo nntp-rlogin-user-name nil
1567   "*User name on remote system when using the rlogin connect method.")
1568
1569 (defvoo nntp-telnet-parameters
1570     '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
1571   "*Parameters to `nntp-open-telnet'.
1572 That function may be used as `nntp-open-connection-function'.  In that
1573 case, this list will be executed as a command after logging in
1574 via telnet.")
1575
1576 (defvoo nntp-telnet-user-name nil
1577   "User name to log in via telnet with.")
1578
1579 (defvoo nntp-telnet-passwd nil
1580   "Password to use to log in via telnet with.")
1581
1582 (defun nntp-open-telnet (buffer)
1583   (save-excursion
1584     (set-buffer buffer)
1585     (erase-buffer)
1586     (let ((proc (apply
1587                  'start-process
1588                  "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
1589           (case-fold-search t))
1590       (when (memq (process-status proc) '(open run))
1591         (nntp-wait-for-string "^r?telnet")
1592         (process-send-string proc "set escape \^X\n")
1593         (cond
1594          ((and nntp-open-telnet-envuser nntp-telnet-user-name)
1595           (process-send-string proc (concat "open " "-l" nntp-telnet-user-name
1596                                             nntp-address "\n")))
1597          (t
1598           (process-send-string proc (concat "open " nntp-address "\n"))))
1599         (cond
1600          ((not nntp-open-telnet-envuser)
1601           (nntp-wait-for-string "^\r*.?login:")
1602           (process-send-string
1603            proc (concat
1604                  (or nntp-telnet-user-name
1605                      (setq nntp-telnet-user-name (read-string "login: ")))
1606                  "\n"))))
1607         (nntp-wait-for-string "^\r*.?password:")
1608         (process-send-string
1609          proc (concat
1610                (or nntp-telnet-passwd
1611                    (setq nntp-telnet-passwd
1612                          (mail-source-read-passwd "Password: ")))
1613                "\n"))
1614         (nntp-wait-for-string nntp-telnet-shell-prompt)
1615         (process-send-string
1616          proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n"))
1617         (nntp-wait-for-string "^\r*20[01]")
1618         (beginning-of-line)
1619         (delete-region (point-min) (point))
1620         (process-send-string proc "\^]")
1621         (nntp-wait-for-string "^r?telnet")
1622         (process-send-string proc "mode character\n")
1623         (accept-process-output proc 1)
1624         (sit-for 1)
1625         (goto-char (point-min))
1626         (forward-line 1)
1627         (delete-region (point) (point-max)))
1628       proc)))
1629
1630 (defun nntp-open-rlogin (buffer)
1631   "Open a connection to SERVER using rsh."
1632   (let ((proc (if nntp-rlogin-user-name
1633                   (apply 'start-process
1634                          "nntpd" buffer nntp-rlogin-program
1635                          nntp-address "-l" nntp-rlogin-user-name
1636                          nntp-rlogin-parameters)
1637                 (apply 'start-process
1638                        "nntpd" buffer nntp-rlogin-program nntp-address
1639                        nntp-rlogin-parameters))))
1640     (save-excursion
1641       (set-buffer buffer)
1642       (nntp-wait-for-string "^\r*20[01]")
1643       (beginning-of-line)
1644       (delete-region (point-min) (point))
1645       proc)))
1646
1647
1648 ;; ==========================================================================
1649 ;; Replacements for the nntp-open-* functions -- drv
1650 ;; ==========================================================================
1651
1652 (defun nntp-open-telnet-stream (buffer)
1653   "Open a nntp connection by telnet'ing the news server.
1654
1655 Please refer to the following variables to customize the connection:
1656 - `nntp-pre-command',
1657 - `nntp-telnet-command',
1658 - `nntp-telnet-switches',
1659 - `nntp-address',
1660 - `nntp-port-number',
1661 - `nntp-end-of-line'."
1662   (let ((command `(,nntp-telnet-command
1663                    ,@nntp-telnet-switches
1664                    ,nntp-address ,nntp-port-number))
1665         proc)
1666     (and nntp-pre-command
1667          (push nntp-pre-command command))
1668     (setq proc (apply 'start-process "nntpd" buffer command))
1669     (save-excursion
1670       (set-buffer buffer)
1671       (nntp-wait-for-string "^\r*20[01]")
1672       (beginning-of-line)
1673       (delete-region (point-min) (point))
1674       proc)))
1675
1676 (defun nntp-open-via-rlogin-and-telnet (buffer)
1677   "Open a connection to an nntp server through an intermediate host.
1678 First rlogin to the remote host, and then telnet the real news server
1679 from there.
1680
1681 Please refer to the following variables to customize the connection:
1682 - `nntp-pre-command',
1683 - `nntp-via-rlogin-command',
1684 - `nntp-via-rlogin-command-switches',
1685 - `nntp-via-user-name',
1686 - `nntp-via-address',
1687 - `nntp-telnet-command',
1688 - `nntp-telnet-switches',
1689 - `nntp-address',
1690 - `nntp-port-number',
1691 - `nntp-end-of-line'."
1692   (let ((command `(,nntp-via-address
1693                    ,nntp-telnet-command
1694                    ,@nntp-telnet-switches))
1695         proc)
1696     (when nntp-via-user-name
1697       (setq command `("-l" ,nntp-via-user-name ,@command)))
1698     (when nntp-via-rlogin-command-switches
1699       (setq command (append nntp-via-rlogin-command-switches command)))
1700     (push nntp-via-rlogin-command command)
1701     (and nntp-pre-command
1702          (push nntp-pre-command command))
1703     (setq proc (apply 'start-process "nntpd" buffer command))
1704     (save-excursion
1705       (set-buffer buffer)
1706       (nntp-wait-for-string "^r?telnet")
1707       (process-send-string proc (concat "open " nntp-address
1708                                         " " nntp-port-number "\n"))
1709       (nntp-wait-for-string "^\r*20[01]")
1710       (beginning-of-line)
1711       (delete-region (point-min) (point))
1712       proc)))
1713
1714 (defun nntp-open-via-telnet-and-telnet (buffer)
1715   "Open a connection to an nntp server through an intermediate host.
1716 First telnet the remote host, and then telnet the real news server
1717 from there.
1718
1719 Please refer to the following variables to customize the connection:
1720 - `nntp-pre-command',
1721 - `nntp-via-telnet-command',
1722 - `nntp-via-telnet-switches',
1723 - `nntp-via-address',
1724 - `nntp-via-envuser',
1725 - `nntp-via-user-name',
1726 - `nntp-via-user-password',
1727 - `nntp-via-shell-prompt',
1728 - `nntp-telnet-command',
1729 - `nntp-telnet-switches',
1730 - `nntp-address',
1731 - `nntp-port-number',
1732 - `nntp-end-of-line'."
1733   (save-excursion
1734     (set-buffer buffer)
1735     (erase-buffer)
1736     (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
1737           (case-fold-search t)
1738           proc)
1739       (and nntp-pre-command (push nntp-pre-command command))
1740       (setq proc (apply 'start-process "nntpd" buffer command))
1741       (when (memq (process-status proc) '(open run))
1742         (nntp-wait-for-string "^r?telnet")
1743         (process-send-string proc "set escape \^X\n")
1744         (cond
1745          ((and nntp-via-envuser nntp-via-user-name)
1746           (process-send-string proc (concat "open " "-l" nntp-via-user-name
1747                                             nntp-via-address "\n")))
1748          (t
1749           (process-send-string proc (concat "open " nntp-via-address
1750                                             "\n"))))
1751         (when (not nntp-via-envuser)
1752           (nntp-wait-for-string "^\r*.?login:")
1753           (process-send-string proc
1754                                (concat
1755                                 (or nntp-via-user-name
1756                                     (setq nntp-via-user-name
1757                                           (read-string "login: ")))
1758                                 "\n")))
1759         (nntp-wait-for-string "^\r*.?password:")
1760         (process-send-string proc
1761                              (concat
1762                               (or nntp-via-user-password
1763                                   (setq nntp-via-user-password
1764                                         (mail-source-read-passwd
1765                                          "Password: ")))
1766                               "\n"))
1767         (nntp-wait-for-string nntp-via-shell-prompt)
1768         (let ((real-telnet-command `("exec"
1769                                      ,nntp-telnet-command
1770                                      ,@nntp-telnet-switches
1771                                      ,nntp-address
1772                                      ,nntp-port-number)))
1773           (process-send-string proc
1774                                (concat (mapconcat 'identity
1775                                                   real-telnet-command " ")
1776                                        "\n")))
1777         (nntp-wait-for-string "^\r*20[01]")
1778         (beginning-of-line)
1779         (delete-region (point-min) (point))
1780         (process-send-string proc "\^]")
1781         (nntp-wait-for-string "^r?telnet")
1782         (process-send-string proc "mode character\n")
1783         (accept-process-output proc 1)
1784         (sit-for 1)
1785         (goto-char (point-min))
1786         (forward-line 1)
1787         (delete-region (point) (point-max)))
1788       proc)))
1789
1790 (provide 'nntp)
1791
1792 ;;; nntp.el ends here