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