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