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