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 |
|
|
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 |
|
|
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 |
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" |
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 |
|
|
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 |
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. |
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." |
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 |
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 |
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 |
|
|
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))) |
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." |
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." |
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." |
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) |
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) |
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) |
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." |
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. |
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 |
|
|
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 |
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) |
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))) |
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) |
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) |
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." |
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." |
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. |
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. |
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 |
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) |
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) |
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 |
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 |
|
|