lisp/gnus/nntp.el

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