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