/[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.21 by kfstorm, Tue Jun 29 12:49:35 2004 UTC revision 1.22 by miles, Sat Sep 4 13:13:44 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 65  You probably don't want to do that, thou Line 65  You probably don't want to do that, thou
65    
66  (defvoo nntp-open-connection-function 'nntp-open-network-stream  (defvoo nntp-open-connection-function 'nntp-open-network-stream
67    "*Function used for connecting to a remote system.    "*Function used for connecting to a remote system.
68  It will be called with the buffer to output in.  It will be called with the buffer to output in as argument.
69    
70  Two pre-made functions are `nntp-open-network-stream', which is the  Currently, five such functions are provided (please refer to their
71  default, and simply connects to some port or other on the remote  respective doc string for more information), three of them establishing
72  system (see nntp-port-number).  The other are `nntp-open-rlogin',  direct connections to the nntp server, and two of them using an indirect
73  which does an rlogin on the remote system, and then does a telnet to  host.
74  the NNTP server available there (see nntp-rlogin-parameters) and  
75  `nntp-open-telnet' which telnets to a remote system, logs in and does  Direct connections:
76  the same.")  - `nntp-open-network-stream' (the default),
77    - `nntp-open-ssl-stream',
78  (defvoo nntp-rlogin-program "rsh"  - `nntp-open-tls-stream',
79    "*Program used to log in on remote machines.  - `nntp-open-telnet-stream'.
80  The default is \"rsh\", but \"ssh\" is a popular alternative.")  
81    Indirect connections:
82  (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")  - `nntp-open-via-rlogin-and-telnet',
83    "*Parameters to `nntp-open-rlogin'.  - `nntp-open-via-telnet-and-telnet'.")
84  That function may be used as `nntp-open-connection-function'.  In that  
85  case, this list will be used as the parameter list given to rsh.")  (defvoo nntp-pre-command nil
86      "*Pre-command to use with the various nntp-open-via-* methods.
87  (defvoo nntp-rlogin-user-name nil  This is where you would put \"runsocks\" or stuff like that.")
   "*User name on remote system when using the rlogin connect method.")  
   
 (defvoo nntp-telnet-parameters  
     '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")  
   "*Parameters to `nntp-open-telnet'.  
 That function may be used as `nntp-open-connection-function'.  In that  
 case, this list will be executed as a command after logging in  
 via telnet.")  
   
 (defvoo nntp-telnet-user-name nil  
   "User name to log in via telnet with.")  
   
 (defvoo nntp-telnet-passwd nil  
   "Password to use to log in via telnet with.")  
   
 (defvoo nntp-open-telnet-envuser nil  
   "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")  
   
 (defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"  
   "*Regular expression to match the shell prompt on the remote machine.")  
88    
89  (defvoo nntp-telnet-command "telnet"  (defvoo nntp-telnet-command "telnet"
90    "Command used to start telnet.")    "*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")  (defvoo nntp-telnet-switches '("-8")
94    "Switches given to the telnet command.")    "*Switches given to the telnet command `nntp-telnet-command'.")
95    
96  (defvoo nntp-end-of-line "\r\n"  (defvoo nntp-end-of-line "\r\n"
97    "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.
98  This is \"\\r\\n\" by default, but should be \"\\n\" when  This is \"\\r\\n\" by default, but should be \"\\n\" when
99  using rlogin or telnet to communicate with the server.")  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  (defvoo nntp-large-newsgroup 50
142    "*The number of the articles which indicates a large newsgroup.    "*The number of articles which indicates a large newsgroup.
143  If the number of the articles is greater than the value, verbose  If the number of articles is greater than the value, verbose
144  messages will be shown to indicate the current status.")  messages will be shown to indicate the current status.")
145    
146  (defvoo nntp-maximum-request 400  (defvoo nntp-maximum-request 400
# Line 174  server there that you can connect to.  S Line 195  server there that you can connect to.  S
195                                            (string :format "Login: %v"))                                            (string :format "Login: %v"))
196                                      (cons :format "%v"                                      (cons :format "%v"
197                                            (const :format "" "password")                                            (const :format "" "password")
198                                            (string :format "Password: %v"))))))                                            (string :format "Password: %v")))))))
   :group 'nntp)  
199    
200    
201    
# Line 184  server there that you can connect to.  S Line 204  server there that you can connect to.  S
204  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.
205  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.")
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.  ;;; Internal variables.
212    
213  (defvar nntp-record-commands nil  (defvar nntp-record-commands nil
# Line 224  noticing asynchronous data.") Line 248  noticing asynchronous data.")
248  (defvar nntp-async-timer nil)  (defvar nntp-async-timer nil)
249  (defvar nntp-async-process-list nil)  (defvar nntp-async-process-list nil)
250    
251  (defvar nntp-ssl-program  (defvar nntp-ssl-program
252    "openssl s_client -quiet -ssl3 -connect %s:%p"    "openssl s_client -quiet -ssl3 -connect %s:%p"
253  "A string containing commands for SSL connections.  "A string containing commands for SSL connections.
254  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
255  port number on server.  The program should accept IMAP commands on  port number on server.  The program should accept IMAP commands on
256  stdin and return responses to stdout.")  stdin and return responses to stdout.")
257    
 (eval-and-compile  
   (autoload 'mail-source-read-passwd "mail-source"))  
   
258    
259    
260  ;;; Internal functions.  ;;; Internal functions.
# Line 247  stdin and return responses to stdout.") Line 268  stdin and return responses to stdout.")
268          nntp-last-command string)          nntp-last-command string)
269    (when nntp-record-commands    (when nntp-record-commands
270      (nntp-record-command string))      (nntp-record-command string))
271    (process-send-string process (concat string nntp-end-of-line)))    (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)  (defun nntp-record-command (string)
276    "Record the command STRING."    "Record the command STRING."
# Line 259  stdin and return responses to stdout.") Line 282  stdin and return responses to stdout.")
282                "." (format "%03d" (/ (nth 2 time) 1000))                "." (format "%03d" (/ (nth 2 time) 1000))
283                " " nntp-address " " string "\n"))))                " " 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)  (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
307    "Wait for WAIT-FOR to arrive from PROCESS."    "Wait for WAIT-FOR to arrive from PROCESS."
308    (save-excursion    (save-excursion
# Line 269  stdin and return responses to stdout.") Line 313  stdin and return responses to stdout.")
313                  (memq (process-status process) '(open run)))                  (memq (process-status process) '(open run)))
314        (when (looking-at "480")        (when (looking-at "480")
315          (nntp-handle-authinfo process))          (nntp-handle-authinfo process))
316          (when (looking-at "^.*\n")
317            (delete-region (point) (progn (forward-line 1) (point))))
318        (nntp-accept-process-output process)        (nntp-accept-process-output process)
319        (goto-char (point-min)))        (goto-char (point-min)))
320      (prog1      (prog1
# Line 278  stdin and return responses to stdout.") Line 324  stdin and return responses to stdout.")
324              (nntp-snarf-error-message)              (nntp-snarf-error-message)
325              nil))              nil))
326           ((not (memq (process-status process) '(open run)))           ((not (memq (process-status process) '(open run)))
327            (nnheader-report 'nntp "Server closed connection"))            (nntp-report "Server closed connection"))
328           (t           (t
329            (goto-char (point-max))            (goto-char (point-max))
330            (let ((limit (point-min)))            (let ((limit (point-min))
331                    response)
332              (while (not (re-search-backward wait-for limit t))              (while (not (re-search-backward wait-for limit t))
333                (nntp-accept-process-output process)                (nntp-accept-process-output process)
334                ;; We assume that whatever we wait for is less than 1000                ;; We assume that whatever we wait for is less than 1000
335                ;; characters long.                ;; characters long.
336                (setq limit (max (- (point-max) 1000) (point-min)))                (setq limit (max (- (point-max) 1000) (point-min)))
337                (goto-char (point-max))))                (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))            (nntp-decode-text (not decode))
342            (unless discard            (unless discard
343              (save-excursion              (save-excursion
344                (set-buffer buffer)                (set-buffer buffer)
345                (goto-char (point-max))                (goto-char (point-max))
346                (insert-buffer-substring (process-buffer process))                (insert-buffer-substring (process-buffer process))
347                ;; Nix out "nntp reading...." message.                ;; Nix out "nntp reading...." message.
348                (when nntp-have-messaged                (when nntp-have-messaged
349                  (setq nntp-have-messaged nil)                  (setq nntp-have-messaged nil)
350                  (nnheader-message 5 ""))                  (nnheader-message 5 ""))))
351                t))))            t))
352        (unless discard        (unless discard
353          (erase-buffer)))))          (erase-buffer)))))
354    
# Line 312  stdin and return responses to stdout.") Line 362  stdin and return responses to stdout.")
362    (let ((alist nntp-connection-alist)    (let ((alist nntp-connection-alist)
363          (buffer (if (stringp buffer) (get-buffer buffer) buffer))          (buffer (if (stringp buffer) (get-buffer buffer) buffer))
364          process entry)          process entry)
365      (while (setq entry (pop alist))      (while (and alist (setq entry (pop alist)))
366        (when (eq buffer (cadr entry))        (when (eq buffer (cadr entry))
367          (setq process (car entry)          (setq process (car entry)
368                alist nil)))                alist nil)))
# Line 338  stdin and return responses to stdout.") Line 388  stdin and return responses to stdout.")
388    "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."    "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
389    (let ((process (or (nntp-find-connection buffer)    (let ((process (or (nntp-find-connection buffer)
390                       (nntp-open-connection buffer))))                       (nntp-open-connection buffer))))
391      (if (not process)      (if process
392          (nnheader-report 'nntp "Couldn't open connection to %s" address)          (progn
393        (unless (or nntp-inhibit-erase nnheader-callback-function)            (unless (or nntp-inhibit-erase nnheader-callback-function)
394          (save-excursion              (save-excursion
395            (set-buffer (process-buffer process))                (set-buffer (process-buffer process))
396            (erase-buffer)))                (erase-buffer)))
397        (condition-case err            (condition-case err
398            (progn                (progn
399              (when command                  (when command
400                (nntp-send-string process command))                    (nntp-send-string process command))
401              (cond                  (cond
402               ((eq callback 'ignore)                   ((eq callback 'ignore)
403                t)                    t)
404               ((and callback wait-for)                   ((and callback wait-for)
405                (nntp-async-wait process wait-for buffer decode callback)                    (nntp-async-wait process wait-for buffer decode callback)
406                t)                    t)
407               (wait-for                   (wait-for
408                (nntp-wait-for process wait-for buffer decode))                    (nntp-wait-for process wait-for buffer decode))
409               (t t)))                   (t t)))
410          (error              (error
411           (nnheader-report 'nntp "Couldn't open connection to %s: %s"               (nnheader-report 'nntp "Couldn't open connection to %s: %s"
412                            address err))                                address err))
413          (quit              (quit
414           (message "Quit retrieving data from nntp")               (message "Quit retrieving data from nntp")
415           (signal 'quit nil)               (signal 'quit nil)
416           nil)))))               nil)))
417          (nnheader-report 'nntp "Couldn't open connection to %s" address))))
418    
419  (defsubst nntp-send-command (wait-for &rest strings)  (defsubst nntp-send-command (wait-for &rest strings)
420    "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 423  stdin and return responses to stdout.")
423      (save-excursion      (save-excursion
424        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
425        (erase-buffer)))        (erase-buffer)))
426    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
427     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
428     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
429     wait-for nnheader-callback-function))           (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                                                (gnus-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)  (defun nntp-send-command-nodelete (wait-for &rest strings)
454    "Send STRINGS to server and wait until WAIT-FOR returns."    "Send STRINGS to server and wait until WAIT-FOR returns."
455    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
456     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
457     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
458     wait-for nnheader-callback-function))           (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                                                (gnus-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)  (defun nntp-send-command-and-decode (wait-for &rest strings)
478    "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 481  stdin and return responses to stdout.")
481      (save-excursion      (save-excursion
482        (set-buffer nntp-server-buffer)        (set-buffer nntp-server-buffer)
483        (erase-buffer)))        (erase-buffer)))
484    (nntp-retrieve-data    (let* ((command (mapconcat 'identity strings " "))
485     (mapconcat 'identity strings " ")           (process (nntp-find-connection nntp-server-buffer))
486     nntp-address nntp-port-number nntp-server-buffer           (buffer (and process (process-buffer process)))
487     wait-for nnheader-callback-function t))           (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) (gnus-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)  (defun nntp-send-buffer (wait-for)
508    "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 544  stdin and return responses to stdout.")
544     (t     (t
545      nil)))      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)  (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
606    "Retrieve the headers of ARTICLES."    "Retrieve the headers of ARTICLES."
607    (nntp-possibly-change-group group server)    (nntp-with-open-group
608    (save-excursion     group server
609      (set-buffer (nntp-find-connection-buffer nntp-server-buffer))     (save-excursion
610      (erase-buffer)       (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
611      (if (and (not gnus-nov-is-evil)       (erase-buffer)
612               (not nntp-nov-is-evil)       (if (and (not gnus-nov-is-evil)
613               (nntp-retrieve-headers-with-xover articles fetch-old))                (not nntp-nov-is-evil)
614          ;; We successfully retrieved the headers via XOVER.                (nntp-retrieve-headers-with-xover articles fetch-old))
615          'nov           ;; We successfully retrieved the headers via XOVER.
616        ;; XOVER didn't work, so we do it the hard, slow and inefficient           'nov
617        ;; way.         ;; XOVER didn't work, so we do it the hard, slow and inefficient
618        (let ((number (length articles))         ;; way.
619              (count 0)         (let ((number (length articles))
620              (received 0)               (articles articles)
621              (last-point (point-min))               (count 0)
622              (buf (nntp-find-connection-buffer nntp-server-buffer))               (received 0)
623              (nntp-inhibit-erase t)               (last-point (point-min))
624              article)               (buf (nntp-find-connection-buffer nntp-server-buffer))
625          ;; Send HEAD commands.               (nntp-inhibit-erase t)
626          (while (setq article (pop articles))               article)
627            (nntp-send-command           ;; Send HEAD commands.
628             nil           (while (setq article (pop articles))
629             "HEAD" (if (numberp article)             (nntp-send-command
630                        (int-to-string article)              nil
631                      ;; `articles' is either a list of article numbers              "HEAD" (if (numberp article)
632                      ;; or a list of article IDs.                         (int-to-string article)
633                      article))                       ;; `articles' is either a list of article numbers
634            (incf count)                       ;; or a list of article IDs.
635            ;; Every 400 requests we have to read the stream in                       article))
636            ;; order to avoid deadlocks.             (incf count)
637            (when (or (null articles)     ;All requests have been sent.             ;; Every 400 requests we have to read the stream in
638                      (zerop (% count nntp-maximum-request)))             ;; order to avoid deadlocks.
639              (nntp-accept-response)             (when (or (null articles)    ;All requests have been sent.
640              (while (progn                       (zerop (% count nntp-maximum-request)))
641                       (set-buffer buf)               (nntp-accept-response)
642                       (goto-char last-point)               (while (progn
643                       ;; Count replies.                        (set-buffer buf)
644                       (while (nntp-next-result-arrived-p)                        (goto-char last-point)
645                         (setq last-point (point))                        ;; Count replies.
646                         (incf received))                        (while (nntp-next-result-arrived-p)
647                       (< received count))                          (setq last-point (point))
648                ;; If number of headers is greater than 100, give                          (incf received))
649                ;;  informative messages.                        (< received count))
650                (and (numberp nntp-large-newsgroup)                 ;; If number of headers is greater than 100, give
651                     (> number nntp-large-newsgroup)                 ;;  informative messages.
652                     (zerop (% received 20))                 (and (numberp nntp-large-newsgroup)
653                     (nnheader-message 6 "NNTP: Receiving headers... %d%%"                      (> number nntp-large-newsgroup)
654                                       (/ (* received 100) number)))                      (zerop (% received 20))
655                (nntp-accept-response))))                      (nnheader-message 6 "NNTP: Receiving headers... %d%%"
656          (and (numberp nntp-large-newsgroup)                                        (/ (* received 100) number)))
657               (> number nntp-large-newsgroup)                 (nntp-accept-response))))
658               (nnheader-message 6 "NNTP: Receiving headers...done"))           (and (numberp nntp-large-newsgroup)
659                  (> number nntp-large-newsgroup)
660          ;; Now all of replies are received.  Fold continuation lines.                (nnheader-message 6 "NNTP: Receiving headers...done"))
661          (nnheader-fold-continuation-lines)  
662          ;; Remove all "\r"'s.           ;; Now all of replies are received.  Fold continuation lines.
663          (nnheader-strip-cr)           (nnheader-fold-continuation-lines)
664          (copy-to-buffer nntp-server-buffer (point-min) (point-max))           ;; Remove all "\r"'s.
665          'headers))))           (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)  (deffoo nntp-retrieve-groups (groups &optional server)
670    "Retrieve group info on GROUPS."    "Retrieve group info on GROUPS."
671    (nntp-possibly-change-group nil server)    (nntp-with-open-group
672    (when (nntp-find-connection-buffer nntp-server-buffer)     nil server
673      (save-excursion     (when (nntp-find-connection-buffer nntp-server-buffer)
674        ;; Erase nntp-server-buffer before nntp-inhibit-erase.       (catch 'done
675        (set-buffer nntp-server-buffer)         (save-excursion
676        (erase-buffer)           ;; Erase nntp-server-buffer before nntp-inhibit-erase.
677        (set-buffer (nntp-find-connection-buffer nntp-server-buffer))           (set-buffer nntp-server-buffer)
678        ;; The first time this is run, this variable is `try'.  So we           (erase-buffer)
679        ;; try.           (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
680        (when (eq nntp-server-list-active-group 'try)           ;; The first time this is run, this variable is `try'.  So we
681          (nntp-try-list-active (car groups)))           ;; try.
682        (erase-buffer)           (when (eq nntp-server-list-active-group 'try)
683        (let ((count 0)             (nntp-try-list-active (car groups)))
684              (received 0)           (erase-buffer)
685              (last-point (point-min))           (let ((count 0)
686              (nntp-inhibit-erase t)                 (groups groups)
687              (buf (nntp-find-connection-buffer nntp-server-buffer))                 (received 0)
688              (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))                 (last-point (point-min))
689          (while groups                 (nntp-inhibit-erase t)
690            ;; Send the command to the server.                 (buf (nntp-find-connection-buffer nntp-server-buffer))
691            (nntp-send-command nil command (pop groups))                 (command (if nntp-server-list-active-group
692            (incf count)                              "LIST ACTIVE" "GROUP")))
693            ;; Every 400 requests we have to read the stream in             (while groups
694            ;; order to avoid deadlocks.               ;; Timeout may have killed the buffer.
695            (when (or (null groups)       ;All requests have been sent.               (unless (gnus-buffer-live-p buf)
696                      (zerop (% count nntp-maximum-request)))                 (nnheader-report 'nntp "Connection to %s is closed." server)
697              (nntp-accept-response)                 (throw 'done nil))
698              (while (progn               ;; Send the command to the server.
699                       ;; Search `blue moon' in this file for the               (nntp-send-command nil command (pop groups))
700                       ;; reason why set-buffer here.               (incf count)
701                       (set-buffer buf)               ;; Every 400 requests we have to read the stream in
702                       (goto-char last-point)               ;; order to avoid deadlocks.
703                       ;; Count replies.               (when (or (null groups)    ;All requests have been sent.
704                       (while (re-search-forward "^[0-9]" nil t)                         (zerop (% count nntp-maximum-request)))
705                         (incf received))                 (nntp-accept-response)
706                       (setq last-point (point))                 (while (and (gnus-buffer-live-p buf)
707                       (< received count))                             (progn
708                (nntp-accept-response))))                               ;; Search `blue moon' in this file for the
709                                 ;; reason why set-buffer here.
710          ;; Wait for the reply from the final command.                               (set-buffer buf)
711          (set-buffer buf)                               (goto-char last-point)
712          (goto-char (point-max))                               ;; Count replies.
713          (re-search-backward "^[0-9]" nil t)                               (while (re-search-forward "^[0-9]" nil t)
714          (when (looking-at "^[23]")                                 (incf received))
715            (while (progn                               (setq last-point (point))
716                     (set-buffer buf)                               (< received count)))
717                     (goto-char (point-max))                   (nntp-accept-response))))
718                     (if (not nntp-server-list-active-group)  
719                         (not (re-search-backward "\r?\n" (- (point) 3) t))             ;; Wait for the reply from the final command.
720                       (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))             (unless (gnus-buffer-live-p buf)
721              (nntp-accept-response)))               (nnheader-report 'nntp "Connection to %s is closed." server)
722                 (throw 'done nil))
723          ;; Now all replies are received.  We remove CRs.             (set-buffer buf)
724          (set-buffer buf)             (goto-char (point-max))
725          (goto-char (point-min))             (re-search-backward "^[0-9]" nil t)
726          (while (search-forward "\r" nil t)             (when (looking-at "^[23]")
727            (replace-match "" t t))               (while (and (gnus-buffer-live-p buf)
728                             (progn
729          (if (not nntp-server-list-active-group)                             (set-buffer buf)
730              (progn                             (goto-char (point-max))
731                (copy-to-buffer nntp-server-buffer (point-min) (point-max))                             (if (not nntp-server-list-active-group)
732                'group)                                 (not (re-search-backward "\r?\n"
733            ;; We have read active entries, so we just delete the                                                          (- (point) 3) t))
734            ;; superfluous gunk.                               (not (re-search-backward "^\\.\r?\n"
735            (goto-char (point-min))                                                        (- (point) 4) t)))))
736            (while (re-search-forward "^[.2-5]" nil t)                 (nntp-accept-response)))
737              (delete-region (match-beginning 0)  
738                             (progn (forward-line 1) (point))))             ;; Now all replies are received.  We remove CRs.
739            (copy-to-buffer nntp-server-buffer (point-min) (point-max))             (unless (gnus-buffer-live-p buf)
740            'active)))))               (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)  (deffoo nntp-retrieve-articles (articles &optional group server)
761    (nntp-possibly-change-group group server)    (nntp-with-open-group
762    (save-excursion      group server
763      (let ((number (length articles))     (save-excursion
764            (count 0)       (let ((number (length articles))
765            (received 0)             (articles articles)
766            (last-point (point-min))             (count 0)
767            (buf (nntp-find-connection-buffer nntp-server-buffer))             (received 0)
768            (nntp-inhibit-erase t)             (last-point (point-min))
769            (map (apply 'vector articles))             (buf (nntp-find-connection-buffer nntp-server-buffer))
770            (point 1)             (nntp-inhibit-erase t)
771            article)             (map (apply 'vector articles))
772        (set-buffer buf)             (point 1)
773        (erase-buffer)             article)
774        ;; Send ARTICLE command.         (set-buffer buf)
775        (while (setq article (pop articles))         (erase-buffer)
776          (nntp-send-command         ;; Send ARTICLE command.
777           nil         (while (setq article (pop articles))
778           "ARTICLE" (if (numberp article)           (nntp-send-command
779                         (int-to-string article)            nil
780                       ;; `articles' is either a list of article numbers            "ARTICLE" (if (numberp article)
781                       ;; or a list of article IDs.                          (int-to-string article)
782                       article))                        ;; `articles' is either a list of article numbers
783          (incf count)                        ;; or a list of article IDs.
784          ;; Every 400 requests we have to read the stream in                        article))
785          ;; order to avoid deadlocks.           (incf count)
786          (when (or (null articles)       ;All requests have been sent.           ;; Every 400 requests we have to read the stream in
787                    (zerop (% count nntp-maximum-request)))           ;; order to avoid deadlocks.
788            (nntp-accept-response)           (when (or (null articles)      ;All requests have been sent.
789            (while (progn                     (zerop (% count nntp-maximum-request)))
790                     (set-buffer buf)             (nntp-accept-response)
791                     (goto-char last-point)             (while (progn
792                     ;; Count replies.                      (set-buffer buf)
793                     (while (nntp-next-result-arrived-p)                      (goto-char last-point)
794                       (aset map received (cons (aref map received) (point)))                      ;; Count replies.
795                       (setq last-point (point))                      (while (nntp-next-result-arrived-p)
796                       (incf received))                        (aset map received (cons (aref map received) (point)))
797                     (< received count))                        (setq last-point (point))
798              ;; If number of headers is greater than 100, give                        (incf received))
799              ;;  informative messages.                      (< received count))
800              (and (numberp nntp-large-newsgroup)               ;; If number of headers is greater than 100, give
801                   (> number nntp-large-newsgroup)               ;;  informative messages.
802                   (zerop (% received 20))               (and (numberp nntp-large-newsgroup)
803                   (nnheader-message 6 "NNTP: Receiving articles... %d%%"                    (> number nntp-large-newsgroup)
804                                     (/ (* received 100) number)))                    (zerop (% received 20))
805              (nntp-accept-response))))                    (nnheader-message 6 "NNTP: Receiving articles... %d%%"
806        (and (numberp nntp-large-newsgroup)                                      (/ (* received 100) number)))
807             (> number nntp-large-newsgroup)               (nntp-accept-response))))
808             (nnheader-message 6 "NNTP: Receiving articles...done"))         (and (numberp nntp-large-newsgroup)
809                (> number nntp-large-newsgroup)
810        ;; Now we have all the responses.  We go through the results,              (nnheader-message 6 "NNTP: Receiving articles...done"))
811        ;; wash it and copy it over to the server buffer.  
812        (set-buffer nntp-server-buffer)         ;; Now we have all the responses.  We go through the results,
813        (erase-buffer)         ;; wash it and copy it over to the server buffer.
814        (setq last-point (point-min))         (set-buffer nntp-server-buffer)
815        (mapcar         (erase-buffer)
816         (lambda (entry)         (setq last-point (point-min))
817           (narrow-to-region         (mapcar
818            (setq point (goto-char (point-max)))          (lambda (entry)
819            (progn            (narrow-to-region
820              (insert-buffer-substring buf last-point (cdr entry))             (setq point (goto-char (point-max)))
821              (point-max)))             (progn
822           (setq last-point (cdr entry))               (insert-buffer-substring buf last-point (cdr entry))
823           (nntp-decode-text)               (point-max)))
824           (widen)            (setq last-point (cdr entry))
825           (cons (car entry) point))            (nntp-decode-text)
826         map))))            (widen)
827              (cons (car entry) point))
828            map)))))
829    
830  (defun nntp-try-list-active (group)  (defun nntp-try-list-active (group)
831    (nntp-list-active-group group)    (nntp-list-active-group group)
# Line 652  stdin and return responses to stdout.") Line 840  stdin and return responses to stdout.")
840    
841  (deffoo nntp-list-active-group (group &optional server)  (deffoo nntp-list-active-group (group &optional server)
842    "Return the active info on GROUP (which can be a regexp)."    "Return the active info on GROUP (which can be a regexp)."
843    (nntp-possibly-change-group nil server)    (nntp-with-open-group
844    (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))     nil server
845       (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)))
846    
847  (deffoo nntp-request-group-articles (group &optional server)  (deffoo nntp-request-group-articles (group &optional server)
848    "Return the list of existing articles in GROUP."    "Return the list of existing articles in GROUP."
849    (nntp-possibly-change-group nil server)    (nntp-with-open-group
850    (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))     nil server
851       (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)))
852    
853  (deffoo nntp-request-article (article &optional group server buffer command)  (deffoo nntp-request-article (article &optional group server buffer command)
854    (nntp-possibly-change-group group server)    (nntp-with-open-group
855    (when (nntp-send-command-and-decode      group server
856           "\r?\n\\.\r?\n" "ARTICLE"      (when (nntp-send-command-and-decode
857           (if (numberp article) (int-to-string article) article))             "\r?\n\\.\r?\n" "ARTICLE"
858      (if (and buffer             (if (numberp article) (int-to-string article) article))
859               (not (equal buffer nntp-server-buffer)))        (if (and buffer
860          (save-excursion                 (not (equal buffer nntp-server-buffer)))
861            (set-buffer nntp-server-buffer)            (save-excursion
862            (copy-to-buffer buffer (point-min) (point-max))              (set-buffer nntp-server-buffer)
863            (nntp-find-group-and-number))              (copy-to-buffer buffer (point-min) (point-max))
864        (nntp-find-group-and-number))))              (nntp-find-group-and-number group))
865            (nntp-find-group-and-number group)))))
866    
867  (deffoo nntp-request-head (article &optional group server)  (deffoo nntp-request-head (article &optional group server)
868    (nntp-possibly-change-group group server)    (nntp-with-open-group
869    (when (nntp-send-command     group server
870           "\r?\n\\.\r?\n" "HEAD"     (when (nntp-send-command
871           (if (numberp article) (int-to-string article) article))            "\r?\n\\.\r?\n" "HEAD"
872      (prog1            (if (numberp article) (int-to-string article) article))
873          (nntp-find-group-and-number)       (prog1
874        (nntp-decode-text))))           (nntp-find-group-and-number group)
875           (nntp-decode-text)))))
876    
877  (deffoo nntp-request-body (article &optional group server)  (deffoo nntp-request-body (article &optional group server)
878    (nntp-possibly-change-group group server)    (nntp-with-open-group
879    (nntp-send-command-and-decode     group server
880     "\r?\n\\.\r?\n" "BODY"     (nntp-send-command-and-decode
881     (if (numberp article) (int-to-string article) article)))      "\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)  (deffoo nntp-request-group (group &optional server dont-check)
885    (nntp-possibly-change-group nil server)    (nntp-with-open-group
886    (when (nntp-send-command "^[245].*\n" "GROUP" group)      nil server
887      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))      (when (nntp-send-command "^[245].*\n" "GROUP" group)
888        (setcar (cddr entry) group))))        (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
889            (setcar (cddr entry) group)))))
890    
891  (deffoo nntp-close-group (group &optional server)  (deffoo nntp-close-group (group &optional server)
892    t)    t)
# Line 750  stdin and return responses to stdout.") Line 944  stdin and return responses to stdout.")
944        (nntp-kill-buffer (process-buffer process)))))        (nntp-kill-buffer (process-buffer process)))))
945    
946  (deffoo nntp-request-list (&optional server)  (deffoo nntp-request-list (&optional server)
947    (nntp-possibly-change-group nil server)    (nntp-with-open-group
948    (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))     nil server
949       (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")))
950    
951  (deffoo nntp-request-list-newsgroups (&optional server)  (deffoo nntp-request-list-newsgroups (&optional server)
952    (nntp-possibly-change-group nil server)    (nntp-with-open-group
953    (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))     nil server
954       (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")))
955    
956  (deffoo nntp-request-newgroups (date &optional server)  (deffoo nntp-request-newgroups (date &optional server)
957    (nntp-possibly-change-group nil server)    (nntp-with-open-group
958    (save-excursion     nil server
959      (set-buffer nntp-server-buffer)     (save-excursion
960      (let* ((time (date-to-time date))       (set-buffer nntp-server-buffer)
961             (ls (- (cadr time) (nth 8 (decode-time time)))))       (let* ((time (date-to-time date))
962        (cond ((< ls 0)              (ls (- (cadr time) (nth 8 (decode-time time)))))
963               (setcar time (1- (car time)))         (cond ((< ls 0)
964               (setcar (cdr time) (+ ls 65536)))                (setcar time (1- (car time)))
965              ((>= ls 65536)                (setcar (cdr time) (+ ls 65536)))
966               (setcar time (1+ (car time)))               ((>= ls 65536)
967               (setcar (cdr time) (- ls 65536)))                (setcar time (1+ (car time)))
968              (t                (setcar (cdr time) (- ls 65536)))
969               (setcar (cdr time) ls)))               (t
970        (prog1                (setcar (cdr time) ls)))
971            (nntp-send-command         (prog1
972             "^\\.\r?\n" "NEWGROUPS"             (nntp-send-command
973             (format-time-string "%y%m%d %H%M%S" time)              "^\\.\r?\n" "NEWGROUPS"
974             "GMT")              (format-time-string "%y%m%d %H%M%S" time)
975          (nntp-decode-text)))))              "GMT")
976             (nntp-decode-text))))))
977    
978  (deffoo nntp-request-post (&optional server)  (deffoo nntp-request-post (&optional server)
979    (nntp-possibly-change-group nil server)    (nntp-with-open-group
980    (when (nntp-send-command "^[23].*\r?\n" "POST")     nil server
981      (nntp-send-buffer "^[23].*\n")))     (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)  (deffoo nntp-request-type (group article)
1001    'news)    'news)
# Line 824  If SEND-IF-FORCE, only send authinfo to Line 1038  If SEND-IF-FORCE, only send authinfo to
1038             (or passwd             (or passwd
1039                 nntp-authinfo-password                 nntp-authinfo-password
1040                 (setq nntp-authinfo-password                 (setq nntp-authinfo-password
1041                       (mail-source-read-passwd                       (read-passwd (format "NNTP (%s@%s) password: "
1042                        (format "NNTP (%s@%s) password: "                                            user nntp-address))))))))))
                               user nntp-address))))))))))  
1043    
1044  (defun nntp-send-nosy-authinfo ()  (defun nntp-send-nosy-authinfo ()
1045    "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 1048  If SEND-IF-FORCE, only send authinfo to
1048        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
1049        (when t                           ;???Should check if AUTHINFO succeeded        (when t                           ;???Should check if AUTHINFO succeeded
1050          (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"          (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
1051                             (mail-source-read-passwd "NNTP (%s@%s) password: "                             (read-passwd (format "NNTP (%s@%s) password: "
1052                                                      user nntp-address))))))                                                  user nntp-address)))))))
1053    
1054  (defun nntp-send-authinfo-from-file ()  (defun nntp-send-authinfo-from-file ()
1055    "Send the AUTHINFO to the nntp server.    "Send the AUTHINFO to the nntp server.
# Line 850  password contained in '~/.nntp-authinfo' Line 1063  password contained in '~/.nntp-authinfo'
1063        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
1064        (nntp-send-command        (nntp-send-command
1065         "^2.*\r?\n" "AUTHINFO PASS"         "^2.*\r?\n" "AUTHINFO PASS"
1066         (buffer-substring (point) (progn (end-of-line) (point)))))))         (buffer-substring (point) (gnus-point-at-eol))))))
1067    
1068  ;;; Internal functions.  ;;; Internal functions.
1069    
# Line 895  password contained in '~/.nntp-authinfo' Line 1108  password contained in '~/.nntp-authinfo'
1108           (process           (process
1109            (condition-case ()            (condition-case ()
1110                (let ((coding-system-for-read nntp-coding-system-for-read)                (let ((coding-system-for-read nntp-coding-system-for-read)
1111                      (coding-system-for-write nntp-coding-system-for-write))                      (coding-system-for-write nntp-coding-system-for-write))
1112                  (funcall nntp-open-connection-function pbuffer))                  (funcall nntp-open-connection-function pbuffer))
1113              (error nil)              (error nil)
1114              (quit              (quit
# Line 905  password contained in '~/.nntp-authinfo' Line 1118  password contained in '~/.nntp-authinfo'
1118               nil))))               nil))))
1119      (when timer      (when timer
1120        (nnheader-cancel-timer timer))        (nnheader-cancel-timer timer))
1121        (unless process
1122          (nntp-kill-buffer pbuffer))
1123      (when (and (buffer-name pbuffer)      (when (and (buffer-name pbuffer)
1124                 process)                 process)
1125        (process-kill-without-query process)        (process-kill-without-query process)
1126        (nntp-wait-for process "^.*\n" buffer nil t)        (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
1127        (if (memq (process-status process) '(open run))                 (memq (process-status process) '(open run)))
1128            (prog1            (prog1
1129                (caar (push (list process buffer nil) nntp-connection-alist))                (caar (push (list process buffer nil) nntp-connection-alist))
1130              (push process nntp-connection-list)              (push process nntp-connection-list)
# Line 927  password contained in '~/.nntp-authinfo' Line 1142  password contained in '~/.nntp-authinfo'
1142  (defun nntp-open-network-stream (buffer)  (defun nntp-open-network-stream (buffer)
1143    (open-network-stream "nntpd" buffer nntp-address nntp-port-number))    (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)  (defun nntp-open-ssl-stream (buffer)
1150    (let* ((process-connection-type nil)    (let* ((process-connection-type nil)
1151           (proc (start-process "nntpd" buffer           (proc (start-process "nntpd" buffer
1152                                shell-file-name                                shell-file-name
1153                                shell-command-switch                                shell-command-switch
1154                                (format-spec nntp-ssl-program                                (format-spec nntp-ssl-program
1155                                             (format-spec-make                                             (format-spec-make
1156                                              ?s nntp-address                                              ?s nntp-address
1157                                              ?p nntp-port-number)))))                                              ?p nntp-port-number)))))
1158      (process-kill-without-query proc)      (process-kill-without-query proc)
1159      (save-excursion      (save-excursion
1160        (set-buffer buffer)        (set-buffer buffer)
1161        (nntp-wait-for-string "^\r*20[01]")        (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)        (beginning-of-line)
1175        (delete-region (point-min) (point))        (delete-region (point-min) (point))
1176        proc)))        proc)))
# Line 1027  password contained in '~/.nntp-authinfo' Line 1258  password contained in '~/.nntp-authinfo'
1258          (goto-char (point-max))          (goto-char (point-max))
1259          (when (re-search-backward          (when (re-search-backward
1260                 nntp-process-wait-for nntp-process-start-point t)                 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)            (nntp-async-stop process)
1265            ;; convert it.            ;; convert it.
1266            (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 1294  password contained in '~/.nntp-authinfo'
1294      (nnheader-report 'nntp message)      (nnheader-report 'nntp message)
1295      message))      message))
1296    
1297  (defun nntp-accept-process-output (process &optional timeout)  (defun nntp-accept-process-output (process)
1298    "Wait for output from PROCESS and message some dots."    "Wait for output from PROCESS and message some dots."
1299    (save-excursion    (save-excursion
1300      (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 1304  password contained in '~/.nntp-authinfo'
1304        (unless (< len 10)        (unless (< len 10)
1305          (setq nntp-have-messaged t)          (setq nntp-have-messaged t)
1306          (nnheader-message 7 "nntp read: %dk" len)))          (nnheader-message 7 "nntp read: %dk" len)))
1307      (accept-process-output process (or timeout 1))))      (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 ()  (defun nntp-accept-response ()
1317    "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 1329  password contained in '~/.nntp-authinfo'
1329    
1330    (when group    (when group
1331      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))      (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
1332        (when (not (equal group (caddr entry)))        (cond ((not entry)
1333          (save-excursion               (nntp-report "Server closed connection"))
1334            (set-buffer (process-buffer (car entry)))              ((not (equal group (caddr entry)))
1335            (erase-buffer)               (save-excursion
1336            (nntp-send-command "^[245].*\n" "GROUP" group)                 (set-buffer (process-buffer (car entry)))
1337            (setcar (cddr entry) group)                 (erase-buffer)
1338            (erase-buffer))))))                 (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)  (defun nntp-decode-text (&optional cr-only)
1346    "Decode the text in the current buffer."    "Decode the text in the current buffer."
# Line 1178  password contained in '~/.nntp-authinfo' Line 1424  password contained in '~/.nntp-authinfo'
1424            in-process-buffer-p            in-process-buffer-p
1425            (buf nntp-server-buffer)            (buf nntp-server-buffer)
1426            (process-buffer (nntp-find-connection-buffer nntp-server-buffer))            (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
1427            first)            first last status)
1428        ;; 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,
1429        ;; that means that the server does not understand XOVER, but we        ;; that means that the server does not understand XOVER, but we
1430        ;; won't know that until we try.        ;; won't know that until we try.
# Line 1191  password contained in '~/.nntp-authinfo' Line 1437  password contained in '~/.nntp-authinfo'
1437            (setq articles (cdr articles)))            (setq articles (cdr articles)))
1438    
1439          (setq in-process-buffer-p (stringp nntp-server-xover))          (setq in-process-buffer-p (stringp nntp-server-xover))
1440          (nntp-send-xover-command first (car articles))          (nntp-send-xover-command first (setq last (car articles)))
1441          (setq articles (cdr articles))          (setq articles (cdr articles))
1442    
1443          (when (and nntp-server-xover in-process-buffer-p)          (when (and nntp-server-xover in-process-buffer-p)
1444            ;; Don't count tried request.            ;; Don't count tried request.
# Line 1201  password contained in '~/.nntp-authinfo' Line 1447  password contained in '~/.nntp-authinfo'
1447            ;; Every 400 requests we have to read the stream in            ;; Every 400 requests we have to read the stream in
1448            ;; order to avoid deadlocks.            ;; order to avoid deadlocks.
1449            (when (or (null articles)     ;All requests have been sent.            (when (or (null articles)     ;All requests have been sent.
1450                      (zerop (% count nntp-maximum-request)))                      (= 1 (% count nntp-maximum-request)))
1451    
1452              (nntp-accept-response)              (nntp-accept-response)
1453              ;; 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 1458  password contained in '~/.nntp-authinfo'
1458              (while (progn              (while (progn
1459                       (goto-char (or last-point (point-min)))                       (goto-char (or last-point (point-min)))
1460                       ;; Count replies.                       ;; Count replies.
1461                       (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)                       (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
1462                         (incf received))                                                 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))                       (setq last-point (point))
1469                       (< received count))                       (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)                (nntp-accept-response)
1479                (set-buffer process-buffer))                (set-buffer process-buffer))))
1480              (set-buffer buf))))  
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        (when nntp-server-xover
1503          (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)))  
1504            (set-buffer buf)            (set-buffer buf)
1505            (goto-char (point-max))            (goto-char (point-max))
1506            (insert-buffer-substring process-buffer)            (insert-buffer-substring process-buffer)
# Line 1288  password contained in '~/.nntp-authinfo' Line 1553  password contained in '~/.nntp-authinfo'
1553              (set-buffer nntp-server-buffer)              (set-buffer nntp-server-buffer)
1554              (erase-buffer)              (erase-buffer)
1555              (setq nntp-server-xover nil)))              (setq nntp-server-xover nil)))
1556          nntp-server-xover))))          nntp-server-xover))))
1557    
1558  ;;; Alternative connection methods.  (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)  (defun nntp-wait-for-string (regexp)
1617    "Wait until string arrives in the buffer."    "Wait until string arrives in the buffer."
1618    (let ((buf (current-buffer)))    (let ((buf (current-buffer))
1619            proc)
1620      (goto-char (point-min))      (goto-char (point-min))
1621      (while (not (re-search-forward regexp nil t))      (while (and (setq proc (get-buffer-process buf))
1622        (accept-process-output (nntp-find-connection nntp-server-buffer))                  (memq (process-status proc) '(open run))
1623                    (not (re-search-forward regexp nil t)))
1624          (accept-process-output proc)
1625        (set-buffer buf)        (set-buffer buf)
1626        (goto-char (point-min)))))        (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)  (defun nntp-open-telnet (buffer)
1665    (save-excursion    (save-excursion
1666      (set-buffer buffer)      (set-buffer buffer)
# Line 1331  password contained in '~/.nntp-authinfo' Line 1691  password contained in '~/.nntp-authinfo'
1691           proc (concat           proc (concat
1692                 (or nntp-telnet-passwd                 (or nntp-telnet-passwd
1693                     (setq nntp-telnet-passwd                     (setq nntp-telnet-passwd
1694                           (mail-source-read-passwd "Password: ")))                           (read-passwd "Password: ")))
1695                 "\n"))                 "\n"))
1696          (nntp-wait-for-string nntp-telnet-shell-prompt)          (nntp-wait-for-string nntp-telnet-shell-prompt)
1697          (process-send-string          (process-send-string
# Line 1366  password contained in '~/.nntp-authinfo' Line 1726  password contained in '~/.nntp-authinfo'
1726        (delete-region (point-min) (point))        (delete-region (point-min) (point))
1727        proc)))        proc)))
1728    
1729  (defun nntp-find-group-and-number ()  
1730    (save-excursion  ;; ==========================================================================
1731      (save-restriction  ;; Replacements for the nntp-open-* functions -- drv
1732        (set-buffer nntp-server-buffer)  ;; ==========================================================================
1733        (narrow-to-region (goto-char (point-min))  
1734                          (or (search-forward "\n\n" nil t) (point-max)))  (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))        (goto-char (point-min))
1800        ;; We first find the number by looking at the status line.        (forward-line 1)
1801        (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")        (delete-region (point) (point-max)))
1802                           (string-to-int      proc))
1803                            (buffer-substring (match-beginning 1)  
1804                                              (match-end 1)))))  (defun nntp-open-via-telnet-and-telnet (buffer)
1805              group newsgroups xref)    "Open a connection to an nntp server through an intermediate host.
1806          (and number (zerop number) (setq number nil))  First telnet the remote host, and then telnet the real news server
1807          ;; Then we find the group name.  from there.
1808          (setq group  
1809                (cond  Please refer to the following variables to customize the connection:
1810                 ;; If there is only one group in the Newsgroups header,  - `nntp-pre-command',
1811                 ;; then it seems quite likely that this article comes  - `nntp-via-telnet-command',
1812                 ;; from that group, I'd say.  - `nntp-via-telnet-switches',
1813                 ((and (setq newsgroups (mail-fetch-field "newsgroups"))  - `nntp-via-address',
1814                       (not (string-match "," newsgroups)))  - `nntp-via-envuser',
1815                  newsgroups)  - `nntp-via-user-name',
1816                 ;; If there is more than one group in the Newsgroups  - `nntp-via-user-password',
1817                 ;; header, then the Xref header should be filled out.  - `nntp-via-shell-prompt',
1818                 ;; We hazard a guess that the group that has this  - `nntp-telnet-command',
1819                 ;; article number in the Xref header is the one we are  - `nntp-telnet-switches',
1820                 ;; looking for.  This might very well be wrong if this  - `nntp-address',
1821                 ;; article happens to have the same number in several  - `nntp-port-number',
1822                 ;; groups, but that's life.  - `nntp-end-of-line'."
1823                 ((and (setq xref (mail-fetch-field "xref"))    (save-excursion
1824                       number      (set-buffer buffer)
1825                       (string-match (format "\\([^ :]+\\):%d" number) xref))      (erase-buffer)
1826                  (substring xref (match-beginning 1) (match-end 1)))      (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
1827                 (t "")))            (case-fold-search t)
1828          (when (string-match "\r" group)            proc)
1829            (setq group (substring group 0 (match-beginning 0))))        (and nntp-pre-command (push nntp-pre-command command))
1830          (cons group number)))))        (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)  (provide 'nntp)
1880    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

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