git.chise.org Git - elisp/gnus.git-/blob - lisp/nntp.el

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