code.delx.au - gnu-emacs/blob - lisp/gnus/nntp.el

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