/[emacs]/emacs/lisp/gnus/nntp.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nntp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19.4.2 by miles, Tue Jun 29 16:45:23 2004 UTC revision 1.19.4.3 by miles, Thu Sep 9 09:36:26 2004 UTC
# Line 9  Line 9 
9  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
10    
11  ;; GNU Emacs is free software; you can redistribute it and/or modify  ;; 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  ;; it under the terms of the GNU General Public License as published
13  ;; the Free Software Foundation; either version 2, or (at your option)  ;; by the Free Software Foundation; either version 2, or (at your
14  ;; any later version.  ;; option) any later version.
15    
16  ;; GNU Emacs is distributed in the hope that it will be useful,  ;; GNU Emacs is distributed in the hope that it will be useful, but
17  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of  ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19  ;; GNU General Public License for more details.  ;; General Public License for more details.
20    
21  ;; You should have received a copy of the GNU General Public License  ;; 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  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
23  ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24    
25  ;;; Commentary:  ;;; Commentary:
26    
# Line 34  Line 34 
34    
35  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
36    
37    (defgroup nntp nil
38      "NNTP access for Gnus."
39      :group 'gnus)
40    
41  (defvoo nntp-address nil  (defvoo nntp-address nil
42    "Address of the physical nntp server.")    "Address of the physical nntp server.")
43    
# Line 65  You probably don't want to do that, thou Line 69  You probably don't want to do that, thou
69    
70  (defvoo nntp-open-connection-function 'nntp-open-network-stream  (defvoo nntp-open-connection-function 'nntp-open-network-stream
71    "*Function used for connecting to a remote system.    "*Function used for connecting to a remote system.
72  It will be called with the buffer to output in.  It will be called with the buffer to output in as argument.
   
 Two pre-made functions are `nntp-open-network-stream', which is the  
 default, and simply connects to some port or other on the remote  
 system (see nntp-port-number).  The other are `nntp-open-rlogin',  
 which does an rlogin on the remote system, and then does a telnet to  
 the NNTP server available there (see nntp-rlogin-parameters) and  
 `nntp-open-telnet' which telnets to a remote system, logs in and does  
 the same.")  
   
 (defvoo nntp-rlogin-program "rsh"  
   "*Program used to log in on remote machines.  
 The default is \"rsh\", but \"ssh\" is a popular alternative.")  
   
 (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")  
   "*Parameters to `nntp-open-rlogin'.  
 That function may be used as `nntp-open-connection-function'.  In that  
 case, this list will be used as the parameter list given to rsh.")  
73    
74  (defvoo nntp-rlogin-user-name nil  Currently, five such functions are provided (please refer to their
75    "*User name on remote system when using the rlogin connect method.")  respective doc string for more information), three of them establishing
76    direct connections to the nntp server, and two of them using an indirect
77  (defvoo nntp-telnet-parameters  host.
78      '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")  
79    "*Parameters to `nntp-open-telnet'.  Direct connections:
80  That function may be used as `nntp-open-connection-function'.  In that  - `nntp-open-network-stream' (the default),
81  case, this list will be executed as a command after logging in  - `nntp-open-ssl-stream',
82  via telnet.")  - `nntp-open-tls-stream',
83    - `nntp-open-telnet-stream'.
84  (defvoo nntp-telnet-user-name nil  
85    "User name to log in via telnet with.")  Indirect connections:
86    - `nntp-open-via-rlogin-and-telnet',
87  (defvoo nntp-telnet-passwd nil  - `nntp-open-via-telnet-and-telnet'.")
88    "Password to use to log in via telnet with.")  
89    (defvoo nntp-pre-command nil
90  (defvoo nntp-open-telnet-envuser nil    "*Pre-command to use with the various nntp-open-via-* methods.
91    "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")  This is where you would put \"runsocks\" or stuff like that.")
   
 (defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"  
   "*Regular expression to match the shell prompt on the remote machine.")  
92    
93  (defvoo nntp-telnet-command "telnet"  (defvoo nntp-telnet-command "telnet"
94    "Command used to start telnet.")    "*Telnet command used to connect to the nntp server.
95    This command is used by the various nntp-open-via-* methods.")
96    
97  (defvoo nntp-telnet-switches '("-8")  (defvoo nntp-telnet-switches '("-8")
98    "Switches given to the telnet command.")    "*Switches given to the telnet command `nntp-telnet-command'.")
99    
100  (defvoo nntp-end-of-line "\r\n"  (defvoo nntp-end-of-line "\r\n"
101    "String to use on the end of lines when talking to the NNTP server.    "*String to use on the end of lines when talking to the NNTP server.
102  This is \"\\r\\n\" by default, but should be \"\\n\" when  This is \"\\r\\n\" by default, but should be \"\\n\" when
103  using rlogin or telnet to communicate with the server.")  using and indirect connection method (nntp-open-via-*).")
104    
105    (defvoo nntp-via-rlogin-command "rsh"
106      "*Rlogin command used to connect to an intermediate host.
107    This command is used by the `nntp-open-via-rlogin-and-telnet' method.
108    The default is \"rsh\", but \"ssh\" is a popular alternative.")
109    
110    (defvoo nntp-via-rlogin-command-switches nil
111      "*Switches given to the rlogin command `nntp-via-rlogin-command'.
112    If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
113    \(\"-C\") in order to compress all data connections, otherwise set this
114    to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
115    command requires a pseudo-tty allocation on an intermediate host.")
116    
117    (defvoo nntp-via-telnet-command "telnet"
118      "*Telnet command used to connect to an intermediate host.
119    This command is used by the `nntp-open-via-telnet-and-telnet' method.")
120    
121    (defvoo nntp-via-telnet-switches '("-8")
122      "*Switches given to the telnet command `nntp-via-telnet-command'.")
123    
124    (defvoo nntp-via-user-name nil
125      "*User name 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-user-password nil
129      "*Password to use to log in on an intermediate host with.
130    This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
131    
132    (defvoo nntp-via-address nil
133      "*Address of an intermediate host to connect to.
134    This variable is used by the `nntp-open-via-rlogin-and-telnet' and
135    `nntp-open-via-telnet-and-telnet' methods.")
136    
137    (defvoo nntp-via-envuser nil
138      "*Whether both telnet client and server support the ENVIRON option.
139    If non-nil, there will be no prompt for a login name.")
140    
141    (defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
142      "*Regular expression to match the shell prompt on an intermediate host.
143    This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
144    
145  (defvoo nntp-large-newsgroup 50  (defvoo nntp-large-newsgroup 50
146    "*The number of the articles which indicates a large newsgroup.    "*The number of articles which indicates a large newsgroup.
147  If the number of the articles is greater than the value, verbose  If the number of articles is greater than the value, verbose
148  messages will be shown to indicate the current status.")  messages will be shown to indicate the current status.")
149    
150  (defvoo nntp-maximum-request 400  (defvoo nntp-maximum-request 400
# Line 161  server there that you can connect to.  S Line 186  server there that you can connect to.  S
186    
187  (defcustom nntp-authinfo-file "~/.authinfo"  (defcustom nntp-authinfo-file "~/.authinfo"
188    ".netrc-like file that holds nntp authinfo passwords."    ".netrc-like file that holds nntp authinfo passwords."
189      :group 'nntp
190    :type    :type
191    '(choice file    '(choice file
192             (repeat :tag "Entries"             (repeat :tag "Entries"
# Line 174  server there that you can connect to.  S Line 200  server there that you can connect to.  S
200                                            (string :format "Login: %v"))                                            (string :format "Login: %v"))
201                                      (cons :format "%v"                                      (cons :format "%v"
202                                            (const :format "" "password")                                            (const :format "" "password")
203                                            (string :format "Password: %v"))))))                                            (string :format "Password: %v")))))))
   :group 'nntp)  
204    
205    
206    
# Line 184  server there that you can connect to.  S Line 209  server there that you can connect to.  S
209  If this variable is nil, which is the default, no timers are set.  If this variable is nil, which is the default, no timers are set.
210  NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")  NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
211    
212    (defvoo nntp-prepare-post-hook nil
213      "*Hook run just before posting an article.  It is supposed to be used
214    to insert Cancel-Lock headers.")
215    
216  ;;; Internal variables.  ;;; Internal variables.
217    
218  (defvar nntp-record-commands nil  (defvar nntp-record-commands nil
# Line 224  noticing asynchronous data.") Line 253  noticing asynchronous data.")
253  (defvar nntp-async-timer nil)  (defvar nntp-async-timer nil)
254  (defvar nntp-async-process-list nil)  (defvar nntp-async-process-list nil)
255    
256  (defvar nntp-ssl-program  (defvar nntp-ssl-program
257    "openssl s_client -quiet -ssl3 -connect %s:%p"    "openssl s_client -quiet -ssl3 -connect %s:%p"
258  "A string containing commands for SSL connections.  "A string containing commands for SSL connections.
259  Within a string, %s is replaced with the server address and %p with  Within a string, %s is replaced with the server address and %p with
260  port number on server.  The program should accept IMAP commands on  port number on server.  The program should accept IMAP commands on
261  stdin and return responses to stdout.")  stdin and return responses to stdout.")
262    
 (eval-and-compile  
   (autoload 'mail-source-read-passwd "mail-source"))  
   
263    
264    
265  ;;; Internal functions.  ;;; Internal functions.
# Line 247  stdin and return responses to stdout.") Line 273  stdin and return responses to stdout.")
273          nntp-last-command string)          nntp-last-command string)
274    (when nntp-record-commands    (when nntp-record-commands
275      (nntp-record-command string))      (nntp-record-command string))
276    (process-send-string process (concat string nntp-end-of-line)))    (process-send-string process (concat string nntp-end-of-line))
277      (or (memq (process-status process) '(open run))
278          (nntp-report "Server closed connection")))
279    
280  (defun nntp-record-command (string)  (defun nntp-record-command (string)
281    "Record the command STRING."    "Record the command STRING."
# Line 259  stdin and return responses to stdout.") Line 287  stdin and return responses to stdout.")
287                "." (format "%03d" (/ (nth 2 time) 1000))                "." (format "%03d" (/ (nth 2 time) 1000))
288                " " nntp-address " " string "\n"))))                " " nntp-address " " string "\n"))))
289    
290    (defun nntp-report (&rest args)
291      "Report an error from the nntp backend.  The first string in ARGS
292    can be a format string.  For some commands, the failed command may be
293    retried once before actually displaying the error report."
294    
295      (when nntp-record-commands
296        (nntp-record-command "*** CALLED nntp-report ***"))
297    
298      (nnheader-report 'nntp args)
299    
300      (apply 'error args))
301    
302    (defun nntp-report-1 (&rest args)
303      "Throws out to nntp-with-open-group-error so that the connection may
304    be restored and the command retried."
305    
306      (when nntp-record-commands
307        (nntp-record-command "*** CONNECTION LOST ***"))
308    
309      (throw 'nntp-with-open-group-error t))
310    
311  (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)  (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
312    "Wait for WAIT-FOR to arrive from PROCESS."    "Wait for WAIT-FOR to arrive from PROCESS."
313    (save-excursion    (save-excursion
# Line 269  stdin and return responses to stdout.") Line 318  stdin and return responses to stdout.")
318                  (memq (process-status process) '(open run)))                  (memq (process-status process) '(open run)))
319        (when (looking-at "480")        (when (looking-at "480")
320          (nntp-handle-authinfo process))          (nntp-handle-authinfo process))
321          (when (looking-at "^.*\n")
322            (delete-region (point) (progn (forward-line 1) (point))))
323        (nntp-accept-process-output process)        (nntp-accept-process-output process)
324        (goto-char (point-min)))        (goto-char (point-min)))
325      (prog1      (prog1
# Line 278  stdin and return responses to stdout.") Line 329  stdin and return responses to stdout.")
329              (nntp-snarf-error-message)              (nntp-snarf-error-message)
330              nil))              nil))
331           ((not (memq (process-status process) '(open run)))           ((not (memq (process-status process) '(open run)))
332            (nnheader-report 'nntp "Server closed connection"))            (nntp-report "Server closed connection"))
333           (t           (t
334            (goto-char (point-max))            (goto-char (point-max))
335            (let ((limit (point-min)))            (let ((limit (point-min))
336                    response)
337              (while (not (re-search-backward wait-for limit t))              (while (not (re-search-backward wait-for limit t))
338                (nntp-accept-process-output process)                (nntp-accept-process-output process)
339                ;; We assume that whatever we wait for is less than 1000                ;; We assume that whatever we wait for is less than 1000
340                ;; characters long.                ;; characters long.
341                (setq limit (max (- (point-max) 1000) (point-min)))                (setq limit (max (- (point-max) 1000) (point-min)))
342                (goto-char (point-max))))                (goto-char (point-max)))
343                (setq response (match-string 0))
344                (with-current-buffer nntp-server-buffer
345                  (setq nntp-process-response response)))
346            (nntp-decode-text (not decode))            (nntp-decode-text (not decode))
347            (unless discard            (unless discard
348              (save-excursion              (save-excursion
349                (set-buffer buffer)                (set-buffer buffer)
350                (goto-char (point-max))                (goto-char (point-max))
351                (insert-buffer-substring (process-buffer process))                (insert-buffer-substring (process-buffer process))
352                ;; Nix out "nntp reading...." message.                ;; Nix out "nntp reading...." message.
353                (when nntp-have-messaged                (when nntp-have-messaged
354                  (setq nntp-have-messaged nil)                  (setq nntp-have-messaged nil)
355                  (nnheader-message 5 ""))                  (nnheader-message 5 ""))))
356                t))))            t))
357        (unless discard        (unless discard
358          (erase-buffer)))))          (erase-buffer)))))
359    
# Line 312  stdin and return responses to stdout.") Line 367  stdin and return responses to stdout.")
367    (let ((alist nntp-connection-alist)    (let ((alist nntp-connection-alist)
368          (buffer (if (stringp buffer) (get-buffer buffer) buffer))          (buffer (if (stringp buffer) (get-buffer buffer) buffer))
369          process entry)          process entry)
370      (while (setq entry (pop alist))      (while (and alist (setq entry (pop alist)))
371        (when (eq buffer (cadr entry))        (when (eq buffer (cadr entry))
372          (setq process (car entry)          (setq process (car entry)
373                alist nil)))                alist nil)))
# Line 338  stdin and return responses to stdout.") Line 393  stdin and return responses to stdout.")
393    "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."    "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
394    (let ((process (or (nntp-find-connection buffer)    (let ((process (or (nntp-find-connection buffer)
395                       (nntp-open-connection buffer))))                       (nntp-open-connection buffer))))
396      (if (not process)      (if process
397          (nnheader-report 'nntp "Couldn't open connection to %s" address)          (progn
398        (unless (or nntp-inhibit-erase nnheader-callback-function)            (unless (or nntp-inhibit-erase nnheader-callback-function)
399          (save-excursion              (save-excursion
400            (set-buffer (process-buffer process))                (set-buffer (process-buffer process))
401            (erase-buffer)))                (erase-buffer)))
402        (condition-case err            (condition-case err
403            (progn                (progn
404              (when command                  (when command
405                (nntp-send-string process command))                    (nntp-send-string process command))
406              (cond                  (cond
407               ((eq callback 'ignore)                   ((eq callback 'ignore)
408                t)                    t)
409               ((and callback wait-for)                   ((and callback wait-for)
410                (nntp-async-wait process wait-for buffer decode callback)                    (nntp-async-wait process wait-for buffer decode callback)
411                t)                    t)
412               (wait-for                   (wait-for
413                (nntp-wait-for process wait-for buffer decode))                    (nntp-wait-for process wait-for buffer decode))
414               (t t)))                   (t t)))
415          (error              (error
416           (nnheader-report 'nntp "Couldn't open connection to %s: %s"               (nnheader-report 'nntp "Couldn't open connection to %s: %s"
417                            address err))                                address err))
418          (quit              (quit
419           (message "Quit retrieving data from nntp")               (message "Quit retrieving data from nntp")
420           (signal 'quit nil)               (signal 'quit nil)
421           nil)))))               nil)))
422          (nnheader-report 'nntp "Couldn't open connection to %s" address))))
423    
424  (defsubst nntp-send-command (wait-for &rest strings)  (defsubst nntp-send-command (wait-for &rest strings)
425    "Send STRINGS to server and wait until WAIT-FOR returns."    "Send STRINGS to server and wait until WAIT-FOR returns."
# Line 372  stdin and return responses to stdout.") Line 428  stdin and return responses to stdout.")
428      (save-excursion      (save-excursion
429        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
430        (erase-buffer)))        (erase-buffer)))
431    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
432     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
433     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
434     wait-for nnheader-callback-function))           (pos (and buffer (with-current-buffer buffer (point)))))
435        (if process
436            (prog1
437                (nntp-retrieve-data command
438                                    nntp-address nntp-port-number
439                                    nntp-server-buffer
440                                    wait-for nnheader-callback-function)
441              ;; If nothing to wait for, still remove possibly echo'ed commands.
442              ;; We don't have echos if nntp-open-connection-function
443              ;; is `nntp-open-network-stream', so we skip this in that case.
444              (unless (or wait-for
445                          (equal nntp-open-connection-function
446                                 'nntp-open-network-stream))
447                (nntp-accept-response)
448                (save-excursion
449                  (set-buffer buffer)
450                  (goto-char pos)
451                  (if (looking-at (regexp-quote command))
452                      (delete-region pos (progn (forward-line 1)
453                                                (gnus-point-at-bol))))
454                  )))
455          (nnheader-report 'nntp "Couldn't open connection to %s."
456                           nntp-address))))
457    
458  (defun nntp-send-command-nodelete (wait-for &rest strings)  (defun nntp-send-command-nodelete (wait-for &rest strings)
459    "Send STRINGS to server and wait until WAIT-FOR returns."    "Send STRINGS to server and wait until WAIT-FOR returns."
460    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
461     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
462     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
463     wait-for nnheader-callback-function))           (pos (and buffer (with-current-buffer buffer (point)))))
464        (if process
465            (prog1
466                (nntp-retrieve-data command
467                                    nntp-address nntp-port-number
468                                    nntp-server-buffer
469                                    wait-for nnheader-callback-function)
470              ;; If nothing to wait for, still remove possibly echo'ed commands
471              (unless wait-for
472                (nntp-accept-response)
473                (save-excursion
474                  (set-buffer buffer)
475                  (goto-char pos)
476                  (if (looking-at (regexp-quote command))
477                      (delete-region pos (progn (forward-line 1)
478                                                (gnus-point-at-bol)))))))
479          (nnheader-report 'nntp "Couldn't open connection to %s."
480                           nntp-address))))
481    
482  (defun nntp-send-command-and-decode (wait-for &rest strings)  (defun nntp-send-command-and-decode (wait-for &rest strings)
483    "Send STRINGS to server and wait until WAIT-FOR returns."    "Send STRINGS to server and wait until WAIT-FOR returns."
# Line 391  stdin and return responses to stdout.") Line 486  stdin and return responses to stdout.")
486      (save-excursion      (save-excursion
487        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
488        (erase-buffer)))        (erase-buffer)))
489    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
490     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
491     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
492     wait-for nnheader-callback-function t))           (pos (and buffer (with-current-buffer buffer (point)))))
493        (if process
494            (prog1
495                (nntp-retrieve-data command
496                                    nntp-address nntp-port-number
497                                    nntp-server-buffer
498                                    wait-for nnheader-callback-function t)
499              ;; If nothing to wait for, still remove possibly echo'ed commands
500              (unless wait-for
501                (nntp-accept-response)
502                (save-excursion
503              (set-buffer buffer)
504              (goto-char pos)
505              (if (looking-at (regexp-quote command))
506                  (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
507              )))
508          (nnheader-report 'nntp "Couldn't open connection to %s."
509                           nntp-address))))
510    
511    
512  (defun nntp-send-buffer (wait-for)  (defun nntp-send-buffer (wait-for)
513    "Send the current buffer to server and wait until WAIT-FOR returns."    "Send the current buffer to server and wait until WAIT-FOR returns."
# Line 436  stdin and return responses to stdout.") Line 549  stdin and return responses to stdout.")
549     (t     (t
550      nil)))      nil)))
551    
552    (eval-when-compile
553      (defvar nntp-with-open-group-internal nil)
554      (defvar nntp-report-n nil))
555    
556    (defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
557      "Protect against servers that don't like clients that keep idle connections opens.
558    The problem being that these servers may either close a connection or
559    simply ignore any further requests on a connection.  Closed
560    connections are not detected until accept-process-output has updated
561    the process-status.  Dropped connections are not detected until the
562    connection timeouts (which may be several minutes) or
563    nntp-connection-timeout has expired.  When these occur
564    nntp-with-open-group, opens a new connection then re-issues the NNTP
565    command whose response triggered the error."
566      (when (and (listp connectionless)
567                 (not (eq connectionless nil)))
568        (setq forms (cons connectionless forms)
569              connectionless nil))
570      `(letf ((nntp-report-n (symbol-function 'nntp-report))
571              ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
572              (nntp-with-open-group-internal nil))
573         (while (catch 'nntp-with-open-group-error
574                  ;; Open the connection to the server
575                  ;; NOTE: Existing connections are NOT tested.
576                  (nntp-possibly-change-group ,group ,server ,connectionless)
577    
578                  (let ((timer
579                         (and nntp-connection-timeout
580                              (nnheader-run-at-time
581                               nntp-connection-timeout nil
582                               '(lambda ()
583                                  (let ((process (nntp-find-connection
584                                                  nntp-server-buffer))
585                                        (buffer  (and process
586                                                      (process-buffer process))))
587                                    ;; When I an able to identify the
588                                    ;; connection to the server AND I've
589                                    ;; received NO reponse for
590                                    ;; nntp-connection-timeout seconds.
591                                    (when (and buffer (eq 0 (buffer-size buffer)))
592                                      ;; Close the connection.  Take no
593                                      ;; other action as the accept input
594                                      ;; code will handle the closed
595                                      ;; connection.
596                                      (nntp-kill-buffer buffer))))))))
597                    (unwind-protect
598                        (setq nntp-with-open-group-internal
599                              (condition-case nil
600                                  (progn ,@forms)
601                                (quit
602                                 (nntp-close-server)
603                                 (signal 'quit nil))))
604                      (when timer
605                        (nnheader-cancel-timer timer)))
606                    nil))
607           (setf (symbol-function 'nntp-report) nntp-report-n))
608         nntp-with-open-group-internal))
609    
610  (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)  (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
611    "Retrieve the headers of ARTICLES."    "Retrieve the headers of ARTICLES."
612    (nntp-possibly-change-group group server)    (nntp-with-open-group
613    (save-excursion     group server
614      (set-buffer (nntp-find-connection-buffer nntp-server-buffer))     (save-excursion
615      (erase-buffer)       (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
616      (if (and (not gnus-nov-is-evil)       (erase-buffer)
617               (not nntp-nov-is-evil)       (if (and (not gnus-nov-is-evil)
618               (nntp-retrieve-headers-with-xover articles fetch-old))                (not nntp-nov-is-evil)
619          ;; We successfully retrieved the headers via XOVER.                (nntp-retrieve-headers-with-xover articles fetch-old))
620          'nov           ;; We successfully retrieved the headers via XOVER.
621        ;; XOVER didn't work, so we do it the hard, slow and inefficient           'nov
622        ;; way.         ;; XOVER didn't work, so we do it the hard, slow and inefficient
623        (let ((number (length articles))         ;; way.
624              (count 0)         (let ((number (length articles))
625              (received 0)               (articles articles)
626              (last-point (point-min))               (count 0)
627              (buf (nntp-find-connection-buffer nntp-server-buffer))               (received 0)
628              (nntp-inhibit-erase t)               (last-point (point-min))
629              article)               (buf (nntp-find-connection-buffer nntp-server-buffer))
630          ;; Send HEAD commands.               (nntp-inhibit-erase t)
631          (while (setq article (pop articles))               article)
632            (nntp-send-command           ;; Send HEAD commands.
633             nil           (while (setq article (pop articles))
634             "HEAD" (if (numberp article)             (nntp-send-command
635                        (int-to-string article)              nil
636                      ;; `articles' is either a list of article numbers              "HEAD" (if (numberp article)
637                      ;; or a list of article IDs.                         (int-to-string article)
638                      article))                       ;; `articles' is either a list of article numbers
639            (incf count)                       ;; or a list of article IDs.
640            ;; Every 400 requests we have to read the stream in                       article))
641            ;; order to avoid deadlocks.             (incf count)
642            (when (or (null articles)     ;All requests have been sent.             ;; Every 400 requests we have to read the stream in
643                      (zerop (% count nntp-maximum-request)))             ;; order to avoid deadlocks.
644              (nntp-accept-response)             (when (or (null articles)    ;All requests have been sent.
645              (while (progn                       (zerop (% count nntp-maximum-request)))
646                       (set-buffer buf)               (nntp-accept-response)
647                       (goto-char last-point)               (while (progn
648                       ;; Count replies.                        (set-buffer buf)
649                       (while (nntp-next-result-arrived-p)                        (goto-char last-point)
650                         (setq last-point (point))                        ;; Count replies.
651                         (incf received))                        (while (nntp-next-result-arrived-p)
652                       (< received count))                          (setq last-point (point))
653                ;; If number of headers is greater than 100, give                          (incf received))
654                ;;  informative messages.                        (< received count))
655                (and (numberp nntp-large-newsgroup)                 ;; If number of headers is greater than 100, give
656                     (> number nntp-large-newsgroup)                 ;;  informative messages.
657                     (zerop (% received 20))                 (and (numberp nntp-large-newsgroup)
658                     (nnheader-message 6 "NNTP: Receiving headers... %d%%"                      (> number nntp-large-newsgroup)
659                                       (/ (* received 100) number)))                      (zerop (% received 20))
660                (nntp-accept-response))))                      (nnheader-message 6 "NNTP: Receiving headers... %d%%"
661          (and (numberp nntp-large-newsgroup)                                        (/ (* received 100) number)))
662               (> number nntp-large-newsgroup)                 (nntp-accept-response))))
663               (nnheader-message 6 "NNTP: Receiving headers...done"))           (and (numberp nntp-large-newsgroup)
664                  (> number nntp-large-newsgroup)
665          ;; Now all of replies are received.  Fold continuation lines.                (nnheader-message 6 "NNTP: Receiving headers...done"))
666          (nnheader-fold-continuation-lines)  
667          ;; Remove all "\r"'s.           ;; Now all of replies are received.  Fold continuation lines.
668          (nnheader-strip-cr)           (nnheader-fold-continuation-lines)
669          (copy-to-buffer nntp-server-buffer (point-min) (point-max))           ;; Remove all "\r"'s.
670          'headers))))           (nnheader-strip-cr)
671             (copy-to-buffer nntp-server-buffer (point-min) (point-max))
672             'headers)))))
673    
674  (deffoo nntp-retrieve-groups (groups &optional server)  (deffoo nntp-retrieve-groups (groups &optional server)
675    "Retrieve group info on GROUPS."    "Retrieve group info on GROUPS."
676    (nntp-possibly-change-group nil server)    (nntp-with-open-group
677    (when (nntp-find-connection-buffer nntp-server-buffer)     nil server
678      (save-excursion     (when (nntp-find-connection-buffer nntp-server-buffer)
679        ;; Erase nntp-server-buffer before nntp-inhibit-erase.       (catch 'done
680        (set-buffer nntp-server-buffer)         (save-excursion
681        (erase-buffer)           ;; Erase nntp-server-buffer before nntp-inhibit-erase.
682        (set-buffer (nntp-find-connection-buffer nntp-server-buffer))           (set-buffer nntp-server-buffer)
683        ;; The first time this is run, this variable is `try'.  So we           (erase-buffer)
684        ;; try.           (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
685        (when (eq nntp-server-list-active-group 'try)           ;; The first time this is run, this variable is `try'.  So we
686          (nntp-try-list-active (car groups)))           ;; try.
687        (erase-buffer)           (when (eq nntp-server-list-active-group 'try)
688        (let ((count 0)             (nntp-try-list-active (car groups)))
689              (received 0)           (erase-buffer)
690              (last-point (point-min))           (let ((count 0)
691              (nntp-inhibit-erase t)                 (groups groups)
692              (buf (nntp-find-connection-buffer nntp-server-buffer))                 (received 0)
693              (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))                 (last-point (point-min))
694          (while groups                 (nntp-inhibit-erase t)
695            ;; Send the command to the server.                 (buf (nntp-find-connection-buffer nntp-server-buffer))
696            (nntp-send-command nil command (pop groups))                 (command (if nntp-server-list-active-group
697            (incf count)                              "LIST ACTIVE" "GROUP")))
698            ;; Every 400 requests we have to read the stream in             (while groups
699            ;; order to avoid deadlocks.               ;; Timeout may have killed the buffer.
700            (when (or (null groups)       ;All requests have been sent.               (unless (gnus-buffer-live-p buf)
701                      (zerop (% count nntp-maximum-request)))                 (nnheader-report 'nntp "Connection to %s is closed." server)
702              (nntp-accept-response)                 (throw 'done nil))
703              (while (progn               ;; Send the command to the server.
704                       ;; Search `blue moon' in this file for the               (nntp-send-command nil command (pop groups))
705                       ;; reason why set-buffer here.               (incf count)
706                       (set-buffer buf)               ;; Every 400 requests we have to read the stream in
707                       (goto-char last-point)               ;; order to avoid deadlocks.
708                       ;; Count replies.               (when (or (null groups)    ;All requests have been sent.
709                       (while (re-search-forward "^[0-9]" nil t)                         (zerop (% count nntp-maximum-request)))
710                         (incf received))                 (nntp-accept-response)
711                       (setq last-point (point))                 (while (and (gnus-buffer-live-p buf)
712                       (< received count))                             (progn
713                (nntp-accept-response))))                               ;; Search `blue moon' in this file for the
714                                 ;; reason why set-buffer here.
715          ;; Wait for the reply from the final command.                               (set-buffer buf)
716          (set-buffer buf)                               (goto-char last-point)
717          (goto-char (point-max))                               ;; Count replies.
718          (re-search-backward "^[0-9]" nil t)                               (while (re-search-forward "^[0-9]" nil t)
719          (when (looking-at "^[23]")                                 (incf received))
720            (while (progn                               (setq last-point (point))
721                     (set-buffer buf)                               (< received count)))
722                     (goto-char (point-max))                   (nntp-accept-response))))
723                     (if (not nntp-server-list-active-group)  
724                         (not (re-search-backward "\r?\n" (- (point) 3) t))             ;; Wait for the reply from the final command.
725                       (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))             (unless (gnus-buffer-live-p buf)
726              (nntp-accept-response)))               (nnheader-report 'nntp "Connection to %s is closed." server)
727                 (throw 'done nil))
728          ;; Now all replies are received.  We remove CRs.             (set-buffer buf)
729          (set-buffer buf)             (goto-char (point-max))
730          (goto-char (point-min))             (re-search-backward "^[0-9]" nil t)
731          (while (search-forward "\r" nil t)             (when (looking-at "^[23]")
732            (replace-match "" t t))               (while (and (gnus-buffer-live-p buf)
733                             (progn
734          (if (not nntp-server-list-active-group)                             (set-buffer buf)
735              (progn                             (goto-char (point-max))
736                (copy-to-buffer nntp-server-buffer (point-min) (point-max))                             (if (not nntp-server-list-active-group)
737                'group)                                 (not (re-search-backward "\r?\n"
738            ;; We have read active entries, so we just delete the                                                          (- (point) 3) t))
739            ;; superfluous gunk.                               (not (re-search-backward "^\\.\r?\n"
740            (goto-char (point-min))                                                        (- (point) 4) t)))))
741            (while (re-search-forward "^[.2-5]" nil t)                 (nntp-accept-response)))
742              (delete-region (match-beginning 0)  
743                             (progn (forward-line 1) (point))))             ;; Now all replies are received.  We remove CRs.
744            (copy-to-buffer nntp-server-buffer (point-min) (point-max))             (unless (gnus-buffer-live-p buf)
745            'active)))))               (nnheader-report 'nntp "Connection to %s is closed." server)
746                 (throw 'done nil))
747               (set-buffer buf)
748               (goto-char (point-min))
749               (while (search-forward "\r" nil t)
750                 (replace-match "" t t))
751    
752               (if (not nntp-server-list-active-group)
753                   (progn
754                     (copy-to-buffer nntp-server-buffer (point-min) (point-max))
755                     'group)
756                 ;; We have read active entries, so we just delete the
757                 ;; superfluous gunk.
758                 (goto-char (point-min))
759                 (while (re-search-forward "^[.2-5]" nil t)
760                   (delete-region (match-beginning 0)
761                                  (progn (forward-line 1) (point))))
762                 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
763                 'active)))))))
764    
765  (deffoo nntp-retrieve-articles (articles &optional group server)  (deffoo nntp-retrieve-articles (articles &optional group server)
766    (nntp-possibly-change-group group server)    (nntp-with-open-group
767    (save-excursion      group server
768      (let ((number (length articles))     (save-excursion
769            (count 0)       (let ((number (length articles))
770            (received 0)             (articles articles)
771            (last-point (point-min))             (count 0)
772            (buf (nntp-find-connection-buffer nntp-server-buffer))             (received 0)
773            (nntp-inhibit-erase t)             (last-point (point-min))
774            (map (apply 'vector articles))             (buf (nntp-find-connection-buffer nntp-server-buffer))
775            (point 1)             (nntp-inhibit-erase t)
776            article)             (map (apply 'vector articles))
777        (set-buffer buf)             (point 1)
778        (erase-buffer)             article)
779        ;; Send ARTICLE command.         (set-buffer buf)
780        (while (setq article (pop articles))         (erase-buffer)
781          (nntp-send-command         ;; Send ARTICLE command.
782           nil         (while (setq article (pop articles))
783           "ARTICLE" (if (numberp article)           (nntp-send-command
784                         (int-to-string article)            nil
785                       ;; `articles' is either a list of article numbers            "ARTICLE" (if (numberp article)
786                       ;; or a list of article IDs.                          (int-to-string article)
787                       article))                        ;; `articles' is either a list of article numbers
788          (incf count)                        ;; or a list of article IDs.
789          ;; Every 400 requests we have to read the stream in                        article))
790          ;; order to avoid deadlocks.           (incf count)
791          (when (or (null articles)       ;All requests have been sent.           ;; Every 400 requests we have to read the stream in
792                    (zerop (% count nntp-maximum-request)))           ;; order to avoid deadlocks.
793            (nntp-accept-response)           (when (or (null articles)      ;All requests have been sent.
794            (while (progn                     (zerop (% count nntp-maximum-request)))
795                     (set-buffer buf)             (nntp-accept-response)
796                     (goto-char last-point)             (while (progn
797                     ;; Count replies.                      (set-buffer buf)
798                     (while (nntp-next-result-arrived-p)                      (goto-char last-point)
799                       (aset map received (cons (aref map received) (point)))                      ;; Count replies.
800                       (setq last-point (point))                      (while (nntp-next-result-arrived-p)
801                       (incf received))                        (aset map received (cons (aref map received) (point)))
802                     (< received count))                        (setq last-point (point))
803              ;; If number of headers is greater than 100, give                        (incf received))
804              ;;  informative messages.                      (< received count))
805              (and (numberp nntp-large-newsgroup)               ;; If number of headers is greater than 100, give
806                   (> number nntp-large-newsgroup)               ;;  informative messages.
807                   (zerop (% received 20))               (and (numberp nntp-large-newsgroup)
808                   (nnheader-message 6 "NNTP: Receiving articles... %d%%"                    (> number nntp-large-newsgroup)
809                                     (/ (* received 100) number)))                    (zerop (% received 20))
810              (nntp-accept-response))))                    (nnheader-message 6 "NNTP: Receiving articles... %d%%"
811        (and (numberp nntp-large-newsgroup)                                      (/ (* received 100) number)))
812             (> number nntp-large-newsgroup)               (nntp-accept-response))))
813             (nnheader-message 6 "NNTP: Receiving articles...done"))         (and (numberp nntp-large-newsgroup)
814                (> number nntp-large-newsgroup)
815        ;; Now we have all the responses.  We go through the results,              (nnheader-message 6 "NNTP: Receiving articles...done"))
816        ;; wash it and copy it over to the server buffer.  
817        (set-buffer nntp-server-buffer)         ;; Now we have all the responses.  We go through the results,
818        (erase-buffer)         ;; wash it and copy it over to the server buffer.
819        (setq last-point (point-min))         (set-buffer nntp-server-buffer)
820        (mapcar         (erase-buffer)
821         (lambda (entry)         (setq last-point (point-min))
822           (narrow-to-region         (mapcar
823            (setq point (goto-char (point-max)))          (lambda (entry)
824            (progn            (narrow-to-region
825              (insert-buffer-substring buf last-point (cdr entry))             (setq point (goto-char (point-max)))
826              (point-max)))             (progn
827           (setq last-point (cdr entry))               (insert-buffer-substring buf last-point (cdr entry))
828           (nntp-decode-text)               (point-max)))
829           (widen)            (setq last-point (cdr entry))
830           (cons (car entry) point))            (nntp-decode-text)
831         map))))            (widen)
832              (cons (car entry) point))
833            map)))))
834    
835  (defun nntp-try-list-active (group)  (defun nntp-try-list-active (group)
836    (nntp-list-active-group group)    (nntp-list-active-group group)
# Line 652  stdin and return responses to stdout.") Line 845  stdin and return responses to stdout.")
845    
846  (deffoo nntp-list-active-group (group &optional server)  (deffoo nntp-list-active-group (group &optional server)
847    "Return the active info on GROUP (which can be a regexp)."    "Return the active info on GROUP (which can be a regexp)."
848    (nntp-possibly-change-group nil server)    (nntp-with-open-group
849    (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))     nil server
850       (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)))
851    
852  (deffoo nntp-request-group-articles (group &optional server)  (deffoo nntp-request-group-articles (group &optional server)
853    "Return the list of existing articles in GROUP."    "Return the list of existing articles in GROUP."
854    (nntp-possibly-change-group nil server)    (nntp-with-open-group
855    (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))     nil server
856       (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)))
857    
858  (deffoo nntp-request-article (article &optional group server buffer command)  (deffoo nntp-request-article (article &optional group server buffer command)
859    (nntp-possibly-change-group group server)    (nntp-with-open-group
860    (when (nntp-send-command-and-decode      group server
861           "\r?\n\\.\r?\n" "ARTICLE"      (when (nntp-send-command-and-decode
862           (if (numberp article) (int-to-string article) article))             "\r?\n\\.\r?\n" "ARTICLE"
863      (if (and buffer             (if (numberp article) (int-to-string article) article))
864               (not (equal buffer nntp-server-buffer)))        (if (and buffer
865          (save-excursion                 (not (equal buffer nntp-server-buffer)))
866            (set-buffer nntp-server-buffer)            (save-excursion
867            (copy-to-buffer buffer (point-min) (point-max))              (set-buffer nntp-server-buffer)
868            (nntp-find-group-and-number))              (copy-to-buffer buffer (point-min) (point-max))
869        (nntp-find-group-and-number))))              (nntp-find-group-and-number group))
870            (nntp-find-group-and-number group)))))
871    
872  (deffoo nntp-request-head (article &optional group server)  (deffoo nntp-request-head (article &optional group server)
873    (nntp-possibly-change-group group server)    (nntp-with-open-group
874    (when (nntp-send-command     group server
875           "\r?\n\\.\r?\n" "HEAD"     (when (nntp-send-command
876           (if (numberp article) (int-to-string article) article))            "\r?\n\\.\r?\n" "HEAD"
877      (prog1            (if (numberp article) (int-to-string article) article))
878          (nntp-find-group-and-number)       (prog1
879        (nntp-decode-text))))           (nntp-find-group-and-number group)
880           (nntp-decode-text)))))
881    
882  (deffoo nntp-request-body (article &optional group server)  (deffoo nntp-request-body (article &optional group server)
883    (nntp-possibly-change-group group server)    (nntp-with-open-group
884    (nntp-send-command-and-decode     group server
885     "\r?\n\\.\r?\n" "BODY"     (nntp-send-command-and-decode
886     (if (numberp article) (int-to-string article) article)))      "\r?\n\\.\r?\n" "BODY"
887        (if (numberp article) (int-to-string article) article))))
888    
889  (deffoo nntp-request-group (group &optional server dont-check)  (deffoo nntp-request-group (group &optional server dont-check)
890    (nntp-possibly-change-group nil server)    (nntp-with-open-group
891    (when (nntp-send-command "^[245].*\n" "GROUP" group)      nil server
892      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))      (when (nntp-send-command "^[245].*\n" "GROUP" group)
893        (setcar (cddr entry) group))))        (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
894            (setcar (cddr entry) group)))))
895    
896  (deffoo nntp-close-group (group &optional server)  (deffoo nntp-close-group (group &optional server)
897    t)    t)
# Line 750  stdin and return responses to stdout.") Line 949  stdin and return responses to stdout.")
949        (nntp-kill-buffer (process-buffer process)))))        (nntp-kill-buffer (process-buffer process)))))
950    
951  (deffoo nntp-request-list (&optional server)  (deffoo nntp-request-list (&optional server)
952    (nntp-possibly-change-group nil server)    (nntp-with-open-group
953    (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))     nil server
954       (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")))
955    
956  (deffoo nntp-request-list-newsgroups (&optional server)  (deffoo nntp-request-list-newsgroups (&optional server)
957    (nntp-possibly-change-group nil server)    (nntp-with-open-group
958    (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))     nil server
959       (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")))
960    
961  (deffoo nntp-request-newgroups (date &optional server)  (deffoo nntp-request-newgroups (date &optional server)
962    (nntp-possibly-change-group nil server)    (nntp-with-open-group
963    (save-excursion     nil server
964      (set-buffer nntp-server-buffer)     (save-excursion
965      (let* ((time (date-to-time date))       (set-buffer nntp-server-buffer)
966             (ls (- (cadr time) (nth 8 (decode-time time)))))       (let* ((time (date-to-time date))
967        (cond ((< ls 0)              (ls (- (cadr time) (nth 8 (decode-time time)))))
968               (setcar time (1- (car time)))         (cond ((< ls 0)
969               (setcar (cdr time) (+ ls 65536)))                (setcar time (1- (car time)))
970              ((>= ls 65536)                (setcar (cdr time) (+ ls 65536)))
971               (setcar time (1+ (car time)))               ((>= ls 65536)
972               (setcar (cdr time) (- ls 65536)))                (setcar time (1+ (car time)))
973              (t                (setcar (cdr time) (- ls 65536)))
974               (setcar (cdr time) ls)))               (t
975        (prog1                (setcar (cdr time) ls)))
976            (nntp-send-command         (prog1
977             "^\\.\r?\n" "NEWGROUPS"             (nntp-send-command
978             (format-time-string "%y%m%d %H%M%S" time)              "^\\.\r?\n" "NEWGROUPS"
979             "GMT")              (format-time-string "%y%m%d %H%M%S" time)
980          (nntp-decode-text)))))              "GMT")
981             (nntp-decode-text))))))
982    
983  (deffoo nntp-request-post (&optional server)  (deffoo nntp-request-post (&optional server)
984    (nntp-possibly-change-group nil server)    (nntp-with-open-group
985    (when (nntp-send-command "^[23].*\r?\n" "POST")     nil server
986      (nntp-send-buffer "^[23].*\n")))     (when (nntp-send-command "^[23].*\r?\n" "POST")
987         (let ((response (with-current-buffer nntp-server-buffer
988                           nntp-process-response))
989               server-id)
990           (when (and response
991                      (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
992                                    response))
993             (setq server-id (match-string 1 response))
994             (narrow-to-region (goto-char (point-min))
995                               (if (search-forward "\n\n" nil t)
996                                   (1- (point))
997                                 (point-max)))
998             (unless (mail-fetch-field "Message-ID")
999               (goto-char (point-min))
1000               (insert "Message-ID: " server-id "\n"))
1001             (widen))
1002           (run-hooks 'nntp-prepare-post-hook)
1003           (nntp-send-buffer "^[23].*\n")))))
1004    
1005  (deffoo nntp-request-type (group article)  (deffoo nntp-request-type (group article)
1006    'news)    'news)
# Line 824  If SEND-IF-FORCE, only send authinfo to Line 1043  If SEND-IF-FORCE, only send authinfo to
1043             (or passwd             (or passwd
1044                 nntp-authinfo-password                 nntp-authinfo-password
1045                 (setq nntp-authinfo-password                 (setq nntp-authinfo-password
1046                       (mail-source-read-passwd                       (read-passwd (format "NNTP (%s@%s) password: "
1047                        (format "NNTP (%s@%s) password: "                                            user nntp-address))))))))))
                               user nntp-address))))))))))  
1048    
1049  (defun nntp-send-nosy-authinfo ()  (defun nntp-send-nosy-authinfo ()
1050    "Send the AUTHINFO to the nntp server."    "Send the AUTHINFO to the nntp server."
# Line 835  If SEND-IF-FORCE, only send authinfo to Line 1053  If SEND-IF-FORCE, only send authinfo to
1053        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
1054        (when t                           ;???Should check if AUTHINFO succeeded        (when t                           ;???Should check if AUTHINFO succeeded
1055          (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"          (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
1056                             (mail-source-read-passwd "NNTP (%s@%s) password: "                             (read-passwd (format "NNTP (%s@%s) password: "
1057                                                      user nntp-address))))))                                                  user nntp-address)))))))
1058    
1059  (defun nntp-send-authinfo-from-file ()  (defun nntp-send-authinfo-from-file ()
1060    "Send the AUTHINFO to the nntp server.    "Send the AUTHINFO to the nntp server.
# Line 850  password contained in '~/.nntp-authinfo' Line 1068  password contained in '~/.nntp-authinfo'
1068        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
1069        (nntp-send-command        (nntp-send-command
1070         "^2.*\r?\n" "AUTHINFO PASS"         "^2.*\r?\n" "AUTHINFO PASS"
1071         (buffer-substring (point) (progn (end-of-line) (point)))))))         (buffer-substring (point) (gnus-point-at-eol))))))
1072    
1073  ;;; Internal functions.  ;;; Internal functions.
1074    
# Line 895  password contained in '~/.nntp-authinfo' Line 1113  password contained in '~/.nntp-authinfo'
1113           (process           (process
1114            (condition-case ()            (condition-case ()
1115                (let ((coding-system-for-read nntp-coding-system-for-read)                (let ((coding-system-for-read nntp-coding-system-for-read)
1116                      (coding-system-for-write nntp-coding-system-for-write))                      (coding-system-for-write nntp-coding-system-for-write))
1117                  (funcall nntp-open-connection-function pbuffer))                  (funcall nntp-open-connection-function pbuffer))
1118              (error nil)              (error nil)
1119              (quit              (quit
# Line 905  password contained in '~/.nntp-authinfo' Line 1123  password contained in '~/.nntp-authinfo'
1123               nil))))               nil))))
1124      (when timer      (when timer
1125        (nnheader-cancel-timer timer))        (nnheader-cancel-timer timer))
1126        (unless process
1127          (nntp-kill-buffer pbuffer))
1128      (when (and (buffer-name pbuffer)      (when (and (buffer-name pbuffer)
1129                 process)                 process)
1130        (process-kill-without-query process)        (process-kill-without-query process)
1131        (nntp-wait-for process "^.*\n" buffer nil t)        (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
1132        (if (memq (process-status process) '(open run))                 (memq (process-status process) '(open run)))
1133            (prog1            (prog1
1134                (caar (push (list process buffer nil) nntp-connection-alist))                (caar (push (list process buffer nil) nntp-connection-alist))
1135              (push process nntp-connection-list)              (push process nntp-connection-list)
# Line 927  password contained in '~/.nntp-authinfo' Line 1147  password contained in '~/.nntp-authinfo'
1147  (defun nntp-open-network-stream (buffer)  (defun nntp-open-network-stream (buffer)
1148    (open-network-stream "nntpd" buffer nntp-address nntp-port-number))    (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
1149    
1150    (autoload 'format-spec "format")
1151    (autoload 'format-spec-make "format")
1152    (autoload 'open-tls-stream "tls")
1153    
1154  (defun nntp-open-ssl-stream (buffer)  (defun nntp-open-ssl-stream (buffer)
1155    (let* ((process-connection-type nil)    (let* ((process-connection-type nil)
1156           (proc (start-process "nntpd" buffer           (proc (start-process "nntpd" buffer
1157                                shell-file-name                                shell-file-name
1158                                shell-command-switch                                shell-command-switch
1159                                (format-spec nntp-ssl-program                                (format-spec nntp-ssl-program
1160                                             (format-spec-make                                             (format-spec-make
1161                                              ?s nntp-address                                              ?s nntp-address
1162                                              ?p nntp-port-number)))))                                              ?p nntp-port-number)))))
1163      (process-kill-without-query proc)      (process-kill-without-query proc)
1164      (save-excursion      (save-excursion
1165        (set-buffer buffer)        (set-buffer buffer)
1166        (nntp-wait-for-string "^\r*20[01]")        (let ((nntp-connection-alist (list proc buffer nil)))
1167            (nntp-wait-for-string "^\r*20[01]"))
1168          (beginning-of-line)
1169          (delete-region (point-min) (point))
1170          proc)))
1171    
1172    (defun nntp-open-tls-stream (buffer)
1173      (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
1174        (process-kill-without-query proc)
1175        (save-excursion
1176          (set-buffer buffer)
1177          (let ((nntp-connection-alist (list proc buffer nil)))
1178            (nntp-wait-for-string "^\r*20[01]"))
1179        (beginning-of-line)        (beginning-of-line)
1180        (delete-region (point-min) (point))        (delete-region (point-min) (point))
1181        proc)))        proc)))
# Line 1027  password contained in '~/.nntp-authinfo' Line 1263  password contained in '~/.nntp-authinfo'
1263          (goto-char (point-max))          (goto-char (point-max))
1264          (when (re-search-backward          (when (re-search-backward
1265                 nntp-process-wait-for nntp-process-start-point t)                 nntp-process-wait-for nntp-process-start-point t)
1266              (let ((response (match-string 0)))
1267                (with-current-buffer nntp-server-buffer
1268                  (setq nntp-process-response response)))
1269            (nntp-async-stop process)            (nntp-async-stop process)
1270            ;; convert it.            ;; convert it.
1271            (when (gnus-buffer-exists-p nntp-process-to-buffer)            (when (gnus-buffer-exists-p nntp-process-to-buffer)
# Line 1060  password contained in '~/.nntp-authinfo' Line 1299  password contained in '~/.nntp-authinfo'
1299      (nnheader-report 'nntp message)      (nnheader-report 'nntp message)
1300      message))      message))
1301    
1302  (defun nntp-accept-process-output (process &optional timeout)  (defun nntp-accept-process-output (process)
1303    "Wait for output from PROCESS and message some dots."    "Wait for output from PROCESS and message some dots."
1304    (save-excursion    (save-excursion
1305      (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)      (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
# Line 1070  password contained in '~/.nntp-authinfo' Line 1309  password contained in '~/.nntp-authinfo'
1309        (unless (< len 10)        (unless (< len 10)
1310          (setq nntp-have-messaged t)          (setq nntp-have-messaged t)
1311          (nnheader-message 7 "nntp read: %dk" len)))          (nnheader-message 7 "nntp read: %dk" len)))
1312      (accept-process-output process (or timeout 1))))      (nnheader-accept-process-output process)
1313        ;; accept-process-output may update status of process to indicate
1314        ;; that the server has closed the connection.  This MUST be
1315        ;; handled here as the buffer restored by the save-excursion may
1316        ;; be the process's former output buffer (i.e. now killed)
1317        (or (and process
1318                 (memq (process-status process) '(open run)))
1319            (nntp-report "Server closed connection"))))
1320    
1321  (defun nntp-accept-response ()  (defun nntp-accept-response ()
1322    "Wait for output from the process that outputs to BUFFER."    "Wait for output from the process that outputs to BUFFER."
# Line 1088  password contained in '~/.nntp-authinfo' Line 1334  password contained in '~/.nntp-authinfo'
1334    
1335    (when group    (when group
1336      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
1337        (when (not (equal group (caddr entry)))        (cond ((not entry)
1338          (save-excursion               (nntp-report "Server closed connection"))
1339            (set-buffer (process-buffer (car entry)))              ((not (equal group (caddr entry)))
1340            (erase-buffer)               (save-excursion
1341            (nntp-send-command "^[245].*\n" "GROUP" group)                 (set-buffer (process-buffer (car entry)))
1342            (setcar (cddr entry) group)                 (erase-buffer)
1343            (erase-buffer))))))                 (nntp-send-command "^[245].*\n" "GROUP" group)
1344                   (setcar (cddr entry) group)
1345                   (erase-buffer)
1346                   (save-excursion
1347                     (set-buffer nntp-server-buffer)
1348                     (erase-buffer))))))))
1349    
1350  (defun nntp-decode-text (&optional cr-only)  (defun nntp-decode-text (&optional cr-only)
1351    "Decode the text in the current buffer."    "Decode the text in the current buffer."
# Line 1178  password contained in '~/.nntp-authinfo' Line 1429  password contained in '~/.nntp-authinfo'
1429            in-process-buffer-p            in-process-buffer-p
1430            (buf nntp-server-buffer)            (buf nntp-server-buffer)
1431            (process-buffer (nntp-find-connection-buffer nntp-server-buffer))            (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
1432            first)            first last status)
1433        ;; We have to check `nntp-server-xover'.  If it gets set to nil,        ;; We have to check `nntp-server-xover'.  If it gets set to nil,
1434        ;; that means that the server does not understand XOVER, but we        ;; that means that the server does not understand XOVER, but we
1435        ;; won't know that until we try.        ;; won't know that until we try.
# Line 1191  password contained in '~/.nntp-authinfo' Line 1442  password contained in '~/.nntp-authinfo'
1442            (setq articles (cdr articles)))            (setq articles (cdr articles)))
1443    
1444          (setq in-process-buffer-p (stringp nntp-server-xover))          (setq in-process-buffer-p (stringp nntp-server-xover))
1445          (nntp-send-xover-command first (car articles))          (nntp-send-xover-command first (setq last (car articles)))
1446          (setq articles (cdr articles))          (setq articles (cdr articles))
1447    
1448          (when (and nntp-server-xover in-process-buffer-p)          (when (and nntp-server-xover in-process-buffer-p)
1449            ;; Don't count tried request.            ;; Don't count tried request.
# Line 1201  password contained in '~/.nntp-authinfo' Line 1452  password contained in '~/.nntp-authinfo'
1452            ;; Every 400 requests we have to read the stream in            ;; Every 400 requests we have to read the stream in
1453            ;; order to avoid deadlocks.            ;; order to avoid deadlocks.
1454            (when (or (null articles)     ;All requests have been sent.            (when (or (null articles)     ;All requests have been sent.
1455                      (zerop (% count nntp-maximum-request)))                      (= 1 (% count nntp-maximum-request)))
1456    
1457              (nntp-accept-response)              (nntp-accept-response)
1458              ;; On some Emacs versions the preceding function has a              ;; On some Emacs versions the preceding function has a
# Line 1212  password contained in '~/.nntp-authinfo' Line 1463  password contained in '~/.nntp-authinfo'
1463              (while (progn              (while (progn
1464                       (goto-char (or last-point (point-min)))                       (goto-char (or last-point (point-min)))
1465                       ;; Count replies.                       ;; Count replies.
1466                       (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)                       (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
1467                         (incf received))                                                 nil t)
1468                           (incf received)
1469                           (setq status (match-string 1))
1470                           (if (string-match "^[45]" status)
1471                               (setq status 'error)
1472                             (setq status 'ok)))
1473                       (setq last-point (point))                       (setq last-point (point))
1474                       (< received count))                       (or (< received count)
1475                             (if (eq status 'error)
1476                                 nil
1477                               ;; I haven't started reading the final response
1478                               (progn
1479                                 (goto-char (point-max))
1480                                 (forward-line -1)
1481                                 (not (looking-at "^\\.\r?\n"))))))
1482                  ;; I haven't read the end of the final response
1483                (nntp-accept-response)                (nntp-accept-response)
1484                (set-buffer process-buffer))                (set-buffer process-buffer))))
1485              (set-buffer buf))))  
1486            ;; Some nntp servers seem to have an extension to the XOVER
1487            ;; extension.  On these servers, requesting an article range
1488            ;; preceeding the active range does not return an error as
1489            ;; specified in the RFC.  What we instead get is the NOV entry
1490            ;; for the first available article.  Obviously, a client can
1491            ;; use that entry to avoid making unnecessary requests.  The
1492            ;; only problem is for a client that assumes that the response
1493            ;; will always be within the requested ranage.  For such a
1494            ;; client, we can get N copies of the same entry (one for each
1495            ;; XOVER command sent to the server).
1496    
1497            (when (<= count 1)
1498              (goto-char (point-min))
1499              (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
1500                (let ((low-limit (string-to-int
1501                                  (buffer-substring (match-beginning 1)
1502                                                    (match-end 1)))))
1503                  (while (and articles (<= (car articles) low-limit))
1504                    (setq articles (cdr articles))))))
1505            (set-buffer buf))
1506    
1507        (when nntp-server-xover        (when nntp-server-xover
1508          (when in-process-buffer-p          (when in-process-buffer-p
           (set-buffer process-buffer)  
           ;; Wait for the reply from the final command.  
           (goto-char (point-max))  
           (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))  
             (nntp-accept-response)  
             (set-buffer process-buffer)  
             (goto-char (point-max)))  
           (when (looking-at "^[23]")  
             (while (progn  
                      (goto-char (point-max))  
                      (forward-line -1)  
                      (not (looking-at "^\\.\r?\n")))  
               (nntp-accept-response)  
               (set-buffer process-buffer)))  
1509            (set-buffer buf)            (set-buffer buf)
1510            (goto-char (point-max))            (goto-char (point-max))
1511            (insert-buffer-substring process-buffer)            (insert-buffer-substring process-buffer)
# Line 1288  password contained in '~/.nntp-authinfo' Line 1558  password contained in '~/.nntp-authinfo'
1558              (set-buffer nntp-server-buffer)              (set-buffer nntp-server-buffer)
1559              (erase-buffer)              (erase-buffer)
1560              (setq nntp-server-xover nil)))              (setq nntp-server-xover nil)))
1561          nntp-server-xover))))          nntp-server-xover))))
1562    
1563  ;;; Alternative connection methods.  (defun nntp-find-group-and-number (&optional group)
1564      (save-excursion
1565        (save-restriction
1566          (set-buffer nntp-server-buffer)
1567          (narrow-to-region (goto-char (point-min))
1568                            (or (search-forward "\n\n" nil t) (point-max)))
1569          (goto-char (point-min))
1570          ;; We first find the number by looking at the status line.
1571          (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
1572                             (string-to-int
1573                              (buffer-substring (match-beginning 1)
1574                                                (match-end 1)))))
1575                newsgroups xref)
1576            (and number (zerop number) (setq number nil))
1577            (if number
1578                ;; Then we find the group name.
1579                (setq group
1580                      (cond
1581                       ;; If there is only one group in the Newsgroups
1582                       ;; header, then it seems quite likely that this
1583                       ;; article comes from that group, I'd say.
1584                       ((and (setq newsgroups
1585                                   (mail-fetch-field "newsgroups"))
1586                             (not (string-match "," newsgroups)))
1587                        newsgroups)
1588                       ;; If there is more than one group in the
1589                       ;; Newsgroups header, then the Xref header should
1590                       ;; be filled out.  We hazard a guess that the group
1591                       ;; that has this article number in the Xref header
1592                       ;; is the one we are looking for.  This might very
1593                       ;; well be wrong if this article happens to have
1594                       ;; the same number in several groups, but that's
1595                       ;; life.
1596                       ((and (setq xref (mail-fetch-field "xref"))
1597                             number
1598                             (string-match
1599                              (format "\\([^ :]+\\):%d" number) xref))
1600                        (match-string 1 xref))
1601                       (t "")))
1602              (cond
1603               ((and (setq xref (mail-fetch-field "xref"))
1604                     (string-match
1605                      (if group
1606                          (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
1607                        "\\([^ :]+\\):\\([0-9]+\\)")
1608                      xref))
1609                (setq group (match-string 1 xref)
1610                      number (string-to-int (match-string 2 xref))))
1611               ((and (setq newsgroups
1612                           (mail-fetch-field "newsgroups"))
1613                     (not (string-match "," newsgroups)))
1614                (setq group newsgroups))
1615               (group)
1616               (t (setq group ""))))
1617            (when (string-match "\r" group)
1618              (setq group (substring group 0 (match-beginning 0))))
1619            (cons group number)))))
1620    
1621  (defun nntp-wait-for-string (regexp)  (defun nntp-wait-for-string (regexp)
1622    "Wait until string arrives in the buffer."    "Wait until string arrives in the buffer."
1623    (let ((buf (current-buffer)))    (let ((buf (current-buffer))
1624            proc)
1625      (goto-char (point-min))      (goto-char (point-min))
1626      (while (not (re-search-forward regexp nil t))      (while (and (setq proc (get-buffer-process buf))
1627        (accept-process-output (nntp-find-connection nntp-server-buffer))                  (memq (process-status proc) '(open run))
1628                    (not (re-search-forward regexp nil t)))
1629          (accept-process-output proc)
1630        (set-buffer buf)        (set-buffer buf)
1631        (goto-char (point-min)))))        (goto-char (point-min)))))
1632    
1633    
1634    ;; ==========================================================================
1635    ;; Obsolete nntp-open-* connection methods -- drv
1636    ;; ==========================================================================
1637    
1638    (defvoo nntp-open-telnet-envuser nil
1639      "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
1640    
1641    (defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
1642      "*Regular expression to match the shell prompt on the remote machine.")
1643    
1644    (defvoo nntp-rlogin-program "rsh"
1645      "*Program used to log in on remote machines.
1646    The default is \"rsh\", but \"ssh\" is a popular alternative.")
1647    
1648    (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
1649      "*Parameters to `nntp-open-rlogin'.
1650    That function may be used as `nntp-open-connection-function'.  In that
1651    case, this list will be used as the parameter list given to rsh.")
1652    
1653    (defvoo nntp-rlogin-user-name nil
1654      "*User name on remote system when using the rlogin connect method.")
1655    
1656    (defvoo nntp-telnet-parameters
1657        '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
1658      "*Parameters to `nntp-open-telnet'.
1659    That function may be used as `nntp-open-connection-function'.  In that
1660    case, this list will be executed as a command after logging in
1661    via telnet.")
1662    
1663    (defvoo nntp-telnet-user-name nil
1664      "User name to log in via telnet with.")
1665    
1666    (defvoo nntp-telnet-passwd nil
1667      "Password to use to log in via telnet with.")
1668    
1669  (defun nntp-open-telnet (buffer)  (defun nntp-open-telnet (buffer)
1670    (save-excursion    (save-excursion
1671      (set-buffer buffer)      (set-buffer buffer)
# Line 1331  password contained in '~/.nntp-authinfo' Line 1696  password contained in '~/.nntp-authinfo'
1696           proc (concat           proc (concat
1697                 (or nntp-telnet-passwd                 (or nntp-telnet-passwd
1698                     (setq nntp-telnet-passwd                     (setq nntp-telnet-passwd
1699                           (mail-source-read-passwd "Password: ")))                           (read-passwd "Password: ")))
1700                 "\n"))                 "\n"))
1701          (nntp-wait-for-string nntp-telnet-shell-prompt)          (nntp-wait-for-string nntp-telnet-shell-prompt)
1702          (process-send-string          (process-send-string
# Line 1366  password contained in '~/.nntp-authinfo' Line 1731  password contained in '~/.nntp-authinfo'
1731        (delete-region (point-min) (point))        (delete-region (point-min) (point))
1732        proc)))        proc)))
1733    
1734  (defun nntp-find-group-and-number ()  
1735    (save-excursion  ;; ==========================================================================
1736      (save-restriction  ;; Replacements for the nntp-open-* functions -- drv
1737        (set-buffer nntp-server-buffer)  ;; ==========================================================================
1738        (narrow-to-region (goto-char (point-min))  
1739                          (or (search-forward "\n\n" nil t) (point-max)))  (defun nntp-open-telnet-stream (buffer)
1740      "Open a nntp connection by telnet'ing the news server.
1741    
1742    Please refer to the following variables to customize the connection:
1743    - `nntp-pre-command',
1744    - `nntp-telnet-command',
1745    - `nntp-telnet-switches',
1746    - `nntp-address',
1747    - `nntp-port-number',
1748    - `nntp-end-of-line'."
1749      (let ((command `(,nntp-telnet-command
1750                       ,@nntp-telnet-switches
1751                       ,nntp-address ,nntp-port-number))
1752            proc)
1753        (and nntp-pre-command
1754             (push nntp-pre-command command))
1755        (setq proc (apply 'start-process "nntpd" buffer command))
1756        (save-excursion
1757          (set-buffer buffer)
1758          (nntp-wait-for-string "^\r*20[01]")
1759          (beginning-of-line)
1760          (delete-region (point-min) (point))
1761          proc)))
1762    
1763    (defun nntp-open-via-rlogin-and-telnet (buffer)
1764      "Open a connection to an nntp server through an intermediate host.
1765    First rlogin to the remote host, and then telnet the real news server
1766    from there.
1767    
1768    Please refer to the following variables to customize the connection:
1769    - `nntp-pre-command',
1770    - `nntp-via-rlogin-command',
1771    - `nntp-via-rlogin-command-switches',
1772    - `nntp-via-user-name',
1773    - `nntp-via-address',
1774    - `nntp-telnet-command',
1775    - `nntp-telnet-switches',
1776    - `nntp-address',
1777    - `nntp-port-number',
1778    - `nntp-end-of-line'."
1779      (let ((command `(,nntp-via-address
1780                       ,nntp-telnet-command
1781                       ,@nntp-telnet-switches))
1782            proc)
1783        (when nntp-via-user-name
1784          (setq command `("-l" ,nntp-via-user-name ,@command)))
1785        (when nntp-via-rlogin-command-switches
1786          (setq command (append nntp-via-rlogin-command-switches command)))
1787        (push nntp-via-rlogin-command command)
1788        (and nntp-pre-command
1789             (push nntp-pre-command command))
1790        (setq proc (apply 'start-process "nntpd" buffer command))
1791        (save-excursion
1792          (set-buffer buffer)
1793          (nntp-wait-for-string "^r?telnet")
1794          (process-send-string proc (concat "open " nntp-address
1795                                            " " nntp-port-number "\n"))
1796          (nntp-wait-for-string "^\r*20[01]")
1797          (beginning-of-line)
1798          (delete-region (point-min) (point))
1799          (process-send-string proc "\^]")
1800          (nntp-wait-for-string "^r?telnet")
1801          (process-send-string proc "mode character\n")
1802          (accept-process-output proc 1)
1803          (sit-for 1)
1804        (goto-char (point-min))        (goto-char (point-min))
1805        ;; We first find the number by looking at the status line.        (forward-line 1)
1806        (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")        (delete-region (point) (point-max)))
1807                           (string-to-int      proc))
1808                            (buffer-substring (match-beginning 1)  
1809                                              (match-end 1)))))  (defun nntp-open-via-telnet-and-telnet (buffer)
1810              group newsgroups xref)    "Open a connection to an nntp server through an intermediate host.
1811          (and number (zerop number) (setq number nil))  First telnet the remote host, and then telnet the real news server
1812          ;; Then we find the group name.  from there.
1813          (setq group  
1814                (cond  Please refer to the following variables to customize the connection:
1815                 ;; If there is only one group in the Newsgroups header,  - `nntp-pre-command',
1816                 ;; then it seems quite likely that this article comes  - `nntp-via-telnet-command',
1817                 ;; from that group, I'd say.  - `nntp-via-telnet-switches',
1818                 ((and (setq newsgroups (mail-fetch-field "newsgroups"))  - `nntp-via-address',
1819                       (not (string-match "," newsgroups)))  - `nntp-via-envuser',
1820                  newsgroups)  - `nntp-via-user-name',
1821                 ;; If there is more than one group in the Newsgroups  - `nntp-via-user-password',
1822                 ;; header, then the Xref header should be filled out.  - `nntp-via-shell-prompt',
1823                 ;; We hazard a guess that the group that has this  - `nntp-telnet-command',
1824                 ;; article number in the Xref header is the one we are  - `nntp-telnet-switches',
1825                 ;; looking for.  This might very well be wrong if this  - `nntp-address',
1826                 ;; article happens to have the same number in several  - `nntp-port-number',
1827                 ;; groups, but that's life.  - `nntp-end-of-line'."
1828                 ((and (setq xref (mail-fetch-field "xref"))    (save-excursion
1829                       number      (set-buffer buffer)
1830                       (string-match (format "\\([^ :]+\\):%d" number) xref))      (erase-buffer)
1831                  (substring xref (match-beginning 1) (match-end 1)))      (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
1832                 (t "")))            (case-fold-search t)
1833          (when (string-match "\r" group)            proc)
1834            (setq group (substring group 0 (match-beginning 0))))        (and nntp-pre-command (push nntp-pre-command command))
1835          (cons group number)))))        (setq proc (apply 'start-process "nntpd" buffer command))
1836          (when (memq (process-status proc) '(open run))
1837            (nntp-wait-for-string "^r?telnet")
1838            (process-send-string proc "set escape \^X\n")
1839            (cond
1840             ((and nntp-via-envuser nntp-via-user-name)
1841              (process-send-string proc (concat "open " "-l" nntp-via-user-name
1842                                                nntp-via-address "\n")))
1843             (t
1844              (process-send-string proc (concat "open " nntp-via-address
1845                                                "\n"))))
1846            (when (not nntp-via-envuser)
1847              (nntp-wait-for-string "^\r*.?login:")
1848              (process-send-string proc
1849                                   (concat
1850                                    (or nntp-via-user-name
1851                                        (setq nntp-via-user-name
1852                                              (read-string "login: ")))
1853                                    "\n")))
1854            (nntp-wait-for-string "^\r*.?password:")
1855            (process-send-string proc
1856                                 (concat
1857                                  (or nntp-via-user-password
1858                                      (setq nntp-via-user-password
1859                                            (read-passwd "Password: ")))
1860                                  "\n"))
1861            (nntp-wait-for-string nntp-via-shell-prompt)
1862            (let ((real-telnet-command `("exec"
1863                                         ,nntp-telnet-command
1864                                         ,@nntp-telnet-switches
1865                                         ,nntp-address
1866                                         ,nntp-port-number)))
1867              (process-send-string proc
1868                                   (concat (mapconcat 'identity
1869                                                      real-telnet-command " ")
1870                                           "\n")))
1871            (nntp-wait-for-string "^\r*20[01]")
1872            (beginning-of-line)
1873            (delete-region (point-min) (point))
1874            (process-send-string proc "\^]")
1875            (nntp-wait-for-string "^r?telnet")
1876            (process-send-string proc "mode character\n")
1877            (accept-process-output proc 1)
1878            (sit-for 1)
1879            (goto-char (point-min))
1880            (forward-line 1)
1881            (delete-region (point) (point-max)))
1882          proc)))
1883    
1884  (provide 'nntp)  (provide 'nntp)
1885    

Legend:
Removed from v.1.19.4.2  
changed lines
  Added in v.1.19.4.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26