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