Mercurial > emacs
annotate lisp/nntp.el @ 15197:a97349b06c2c
Comment changes.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 09 May 1996 23:21:54 +0000 |
parents | 4db721fba60b |
children | 530d0d516a42 |
rev | line source |
---|---|
13401 | 1 ;;; nntp.el --- nntp access for Gnus |
14169 | 2 |
14531
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
3 ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. |
13401 | 4 |
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
6 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
7 ;; Keywords: news | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
14169 | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
13401 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;;; Code: | |
29 | |
30 (require 'rnews) | |
31 (require 'sendmail) | |
32 (require 'nnheader) | |
33 | |
34 (eval-when-compile (require 'cl)) | |
35 | |
36 (eval-and-compile | |
37 (autoload 'news-setup "rnewspost") | |
38 (autoload 'news-reply-mode "rnewspost") | |
39 (autoload 'nnmail-request-post-buffer "nnmail") | |
40 (autoload 'cancel-timer "timer") | |
41 (autoload 'telnet "telnet" nil t) | |
42 (autoload 'telnet-send-input "telnet" nil t) | |
43 (autoload 'timezone-parse-date "timezone")) | |
44 | |
45 (defvar nntp-server-hook nil | |
46 "*Hooks for the NNTP server. | |
47 If the kanji code of the NNTP server is different from the local kanji | |
48 code, the correct kanji code of the buffer associated with the NNTP | |
49 server must be specified as follows: | |
50 | |
51 \(setq nntp-server-hook | |
52 (function | |
53 (lambda () | |
54 ;; Server's Kanji code is EUC (NEmacs hack). | |
55 (make-local-variable 'kanji-fileio-code) | |
56 (setq kanji-fileio-code 0)))) | |
57 | |
58 If you'd like to change something depending on the server in this | |
59 hook, use the variable `nntp-address'.") | |
60 | |
61 (defvar nntp-server-opened-hook nil | |
62 "*Hook used for sending commands to the server at startup. | |
63 The default value is `nntp-send-mode-reader', which makes an innd | |
64 server spawn an nnrpd server. Another useful function to put in this | |
65 hook might be `nntp-send-authinfo', which will prompt for a password | |
66 to allow posting from the server. Note that this is only necessary to | |
67 do on servers that use strict access control.") | |
68 (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) | |
69 | |
70 (defvar nntp-open-server-function 'nntp-open-network-stream | |
71 "*Function used for connecting to a remote system. | |
72 It will be called with the address of the remote system. | |
73 | |
74 Two pre-made functions are `nntp-open-network-stream', which is the | |
75 default, and simply connects to some port or other on the remote | |
76 system (see nntp-port-number). The other is `nntp-open-rlogin', which | |
77 does an rlogin on the remote system, and then does a telnet to the | |
78 NNTP server available there (see nntp-rlogin-parameters).") | |
79 | |
80 (defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") | |
81 "*Parameters to `nntp-open-login'. | |
82 That function may be used as `nntp-open-server-function'. In that | |
83 case, this list will be used as the parameter list given to rsh.") | |
84 | |
85 (defvar nntp-rlogin-user-name nil | |
86 "*User name on remote system when using the rlogin connect method.") | |
87 | |
88 (defvar nntp-address nil | |
89 "*The name of the NNTP server.") | |
90 | |
91 (defvar nntp-port-number "nntp" | |
92 "*Port number to connect to.") | |
93 | |
94 (defvar nntp-large-newsgroup 50 | |
95 "*The number of the articles which indicates a large newsgroup. | |
96 If the number of the articles is greater than the value, verbose | |
97 messages will be shown to indicate the current status.") | |
98 | |
99 (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) | |
100 "*t if your select routine is buggy. | |
101 If the select routine signals error or fall into infinite loop while | |
102 waiting for the server response, the variable must be set to t. In | |
103 case of Fujitsu UTS, it is set to T since `accept-process-output' | |
104 doesn't work properly.") | |
105 | |
106 (defvar nntp-maximum-request 400 | |
107 "*The maximum number of the requests sent to the NNTP server at one time. | |
108 If Emacs hangs up while retrieving headers, set the variable to a | |
109 lower value.") | |
110 | |
111 (defvar nntp-debug-read 10000 | |
112 "*Display '...' every 10Kbytes of a message being received if it is non-nil. | |
113 If it is a number, dots are displayed per the number.") | |
114 | |
115 (defvar nntp-nov-is-evil nil | |
116 "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") | |
117 | |
118 (defvar nntp-xover-commands '("XOVER" "XOVERVIEW") | |
119 "*List of strings that are used as commands to fetch NOV lines from a server. | |
120 The strings are tried in turn until a positive response is gotten. If | |
121 none of the commands are successful, nntp will just grab headers one | |
122 by one.") | |
123 | |
124 (defvar nntp-nov-gap 20 | |
125 "*Maximum allowed gap between two articles. | |
126 If the gap between two consecutive articles is bigger than this | |
127 variable, split the XOVER request into two requests.") | |
128 | |
129 (defvar nntp-connection-timeout nil | |
130 "*Number of seconds to wait before an nntp connection times out. | |
131 If this variable is nil, which is the default, no timers are set.") | |
132 | |
133 (defvar nntp-news-default-headers nil | |
134 "*If non-nil, override `mail-default-headers' when posting news.") | |
135 | |
136 (defvar nntp-prepare-server-hook nil | |
137 "*Hook run before a server is opened. | |
138 If can be used to set up a server remotely, for instance. Say you | |
139 have an account at the machine \"other.machine\". This machine has | |
140 access to an NNTP server that you can't access locally. You could | |
141 then use this hook to rsh to the remote machine and start a proxy NNTP | |
142 server there that you can connect to.") | |
143 | |
144 (defvar nntp-async-number 5 | |
145 "*How many articles should be prefetched when in asynchronous mode.") | |
146 | |
147 | |
148 | |
149 | |
150 (defconst nntp-version "nntp 4.0" | |
151 "Version numbers of this version of NNTP.") | |
152 | |
153 (defvar nntp-server-buffer nil | |
154 "Buffer associated with the NNTP server process.") | |
155 | |
156 (defvar nntp-server-process nil | |
157 "The NNTP server process. | |
158 You'd better not use this variable in NNTP front-end program, but | |
159 instead use `nntp-server-buffer'.") | |
160 | |
161 (defvar nntp-status-string nil | |
162 "Save the server response message. | |
163 You'd better not use this variable in NNTP front-end program but | |
164 instead call function `nntp-status-message' to get status message.") | |
165 | |
166 (defvar nntp-opened-connections nil | |
167 "All (possibly) opened connections.") | |
168 | |
169 (defvar nntp-server-xover 'try) | |
170 (defvar nntp-server-list-active-group 'try) | |
171 (defvar nntp-current-group "") | |
172 (defvar nntp-timeout-servers nil) | |
173 | |
174 (defvar nntp-async-process nil) | |
175 (defvar nntp-async-buffer nil) | |
176 (defvar nntp-async-articles nil) | |
177 (defvar nntp-async-fetched nil) | |
178 (defvar nntp-async-group-alist nil) | |
179 | |
180 | |
181 | |
182 (defvar nntp-current-server nil) | |
183 (defvar nntp-server-alist nil) | |
184 (defvar nntp-server-variables | |
185 (list | |
186 (list 'nntp-server-hook nntp-server-hook) | |
187 (list 'nntp-server-opened-hook nntp-server-opened-hook) | |
188 (list 'nntp-port-number nntp-port-number) | |
189 (list 'nntp-address nntp-address) | |
190 (list 'nntp-large-newsgroup nntp-large-newsgroup) | |
191 (list 'nntp-buggy-select nntp-buggy-select) | |
192 (list 'nntp-maximum-request nntp-maximum-request) | |
193 (list 'nntp-debug-read nntp-debug-read) | |
194 (list 'nntp-nov-is-evil nntp-nov-is-evil) | |
195 (list 'nntp-xover-commands nntp-xover-commands) | |
196 (list 'nntp-connection-timeout nntp-connection-timeout) | |
197 (list 'nntp-news-default-headers nntp-news-default-headers) | |
198 (list 'nntp-prepare-server-hook nntp-prepare-server-hook) | |
199 (list 'nntp-async-number nntp-async-number) | |
200 '(nntp-async-process nil) | |
201 '(nntp-async-buffer nil) | |
202 '(nntp-async-articles nil) | |
203 '(nntp-async-fetched nil) | |
204 '(nntp-async-group-alist nil) | |
205 '(nntp-server-process nil) | |
206 '(nntp-status-string nil) | |
207 '(nntp-server-xover try) | |
208 '(nntp-server-list-active-group try) | |
209 '(nntp-current-group ""))) | |
210 | |
211 | |
212 ;;; Interface functions. | |
213 | |
214 (defun nntp-retrieve-headers (sequence &optional newsgroup server) | |
215 "Retrieve the headers to the articles in SEQUENCE." | |
216 (nntp-possibly-change-server newsgroup server) | |
217 (save-excursion | |
218 (set-buffer nntp-server-buffer) | |
219 (erase-buffer) | |
220 (if (and (not gnus-nov-is-evil) | |
221 (not nntp-nov-is-evil) | |
222 (nntp-retrieve-headers-with-xover sequence)) | |
223 'nov | |
224 (let ((number (length sequence)) | |
225 (count 0) | |
226 (received 0) | |
227 (last-point (point-min))) | |
228 ;; Send HEAD command. | |
229 (while sequence | |
230 (nntp-send-strings-to-server | |
231 "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence)) | |
232 (car sequence))) | |
233 (setq sequence (cdr sequence) | |
234 count (1+ count)) | |
235 ;; Every 400 header requests we have to read stream in order | |
236 ;; to avoid deadlock. | |
237 (if (or (null sequence) ;All requests have been sent. | |
238 (zerop (% count nntp-maximum-request))) | |
239 (progn | |
240 (nntp-accept-response) | |
241 (while (progn | |
242 (goto-char last-point) | |
243 ;; Count replies. | |
244 (while (re-search-forward "^[0-9]" nil t) | |
245 (setq received (1+ received))) | |
246 (setq last-point (point)) | |
247 (< received count)) | |
248 ;; If number of headers is greater than 100, give | |
249 ;; informative messages. | |
250 (and (numberp nntp-large-newsgroup) | |
251 (> number nntp-large-newsgroup) | |
252 (zerop (% received 20)) | |
253 (message "NNTP: Receiving headers... %d%%" | |
254 (/ (* received 100) number))) | |
255 (nntp-accept-response))))) | |
256 ;; Wait for text of last command. | |
257 (goto-char (point-max)) | |
258 (re-search-backward "^[0-9]" nil t) | |
259 (if (looking-at "^[23]") | |
260 (while (progn | |
261 (goto-char (- (point-max) 3)) | |
262 (not (looking-at "^\\.\r?\n"))) | |
263 (nntp-accept-response))) | |
264 (and (numberp nntp-large-newsgroup) | |
265 (> number nntp-large-newsgroup) | |
266 (message "NNTP: Receiving headers...done")) | |
267 | |
268 ;; Now all of replies are received. | |
269 (setq received number) | |
270 ;; First, fold continuation lines. | |
271 (goto-char (point-min)) | |
272 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
273 (replace-match " ")) | |
274 ;; Remove all "\r"'s | |
275 (goto-char (point-min)) | |
276 (while (search-forward "\r" nil t) | |
277 (replace-match "")) | |
278 'headers)))) | |
279 | |
280 | |
281 (defun nntp-retrieve-groups (groups &optional server) | |
282 (nntp-possibly-change-server nil server) | |
283 (save-excursion | |
284 (set-buffer nntp-server-buffer) | |
285 (and (eq nntp-server-list-active-group 'try) | |
286 (nntp-try-list-active (car groups))) | |
287 (erase-buffer) | |
288 (let ((count 0) | |
289 (received 0) | |
290 (last-point (point-min)) | |
291 (command (if nntp-server-list-active-group | |
292 "LIST ACTIVE" "GROUP"))) | |
293 (while groups | |
294 (nntp-send-strings-to-server command (car groups)) | |
295 (setq groups (cdr groups)) | |
296 (setq count (1+ count)) | |
297 ;; Every 400 requests we have to read the stream in | |
298 ;; order to avoid deadlocks. | |
299 (if (or (null groups) ;All requests have been sent. | |
300 (zerop (% count nntp-maximum-request))) | |
301 (progn | |
302 (nntp-accept-response) | |
303 (while (progn | |
304 (goto-char last-point) | |
305 ;; Count replies. | |
306 (while (re-search-forward "^[0-9]" nil t) | |
307 (setq received (1+ received))) | |
308 (setq last-point (point)) | |
309 (< received count)) | |
310 (nntp-accept-response))))) | |
311 | |
312 ;; Wait for the reply from the final command. | |
313 (if nntp-server-list-active-group | |
314 (progn | |
315 (goto-char (point-max)) | |
316 (re-search-backward "^[0-9]" nil t) | |
317 (if (looking-at "^[23]") | |
318 (while (progn | |
319 (goto-char (- (point-max) 3)) | |
320 (not (looking-at "^\\.\r?\n"))) | |
321 (nntp-accept-response))))) | |
322 | |
323 ;; Now all replies are received. We remove CRs. | |
324 (goto-char (point-min)) | |
325 (while (search-forward "\r" nil t) | |
326 (replace-match "" t t)) | |
327 | |
328 (if nntp-server-list-active-group | |
329 (progn | |
330 ;; We have read active entries, so we just delete the | |
14040 | 331 ;; superfluous gunk. |
13401 | 332 (goto-char (point-min)) |
333 (while (re-search-forward "^[.2-5]" nil t) | |
334 (delete-region (match-beginning 0) | |
335 (progn (forward-line 1) (point)))) | |
336 'active) | |
337 'group)))) | |
338 | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
339 (defun nntp-open-server (server &optional defs connectionless) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
340 "Open the virtual server SERVER. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
341 If CONNECTIONLESS is non-nil, don't attempt to connect to any physical |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
342 servers." |
13401 | 343 (nnheader-init-server-buffer) |
344 (if (nntp-server-opened server) | |
345 t | |
346 (if (or (stringp (car defs)) | |
347 (numberp (car defs))) | |
348 (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) | |
349 (or (assq 'nntp-address defs) | |
350 (setq defs (append defs (list (list 'nntp-address server))))) | |
351 (if (and nntp-current-server | |
352 (not (equal server nntp-current-server))) | |
353 (setq nntp-server-alist | |
354 (cons (list nntp-current-server | |
355 (nnheader-save-variables nntp-server-variables)) | |
356 nntp-server-alist))) | |
357 (let ((state (assoc server nntp-server-alist))) | |
358 (if state | |
359 (progn | |
360 (nnheader-restore-variables (nth 1 state)) | |
361 (setq nntp-server-alist (delq state nntp-server-alist))) | |
362 (nnheader-set-init-variables nntp-server-variables defs))) | |
363 (setq nntp-current-server server) | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
364 ;; We have now changed to the proper virtual server. We then |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
365 ;; check that the physical server is opened. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
366 (if (or (nntp-server-opened server) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
367 connectionless) |
13741
9b68e9a5cae1
* nntp.el (nntp-open-server): Enable successful "connectionless"
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
13588
diff
changeset
|
368 t |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
369 (if (member nntp-address nntp-timeout-servers) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
370 nil |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
371 ;; We open a connection to the physical nntp server. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
372 (run-hooks 'nntp-prepare-server-hook) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
373 (nntp-open-server-semi-internal nntp-address nntp-port-number))))) |
13401 | 374 |
375 (defun nntp-close-server (&optional server) | |
376 "Close connection to SERVER." | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
377 (nntp-possibly-change-server nil server t) |
13401 | 378 (unwind-protect |
379 (progn | |
380 ;; Un-set default sentinel function before closing connection. | |
381 (and nntp-server-process | |
382 (eq 'nntp-default-sentinel | |
383 (process-sentinel nntp-server-process)) | |
384 (set-process-sentinel nntp-server-process nil)) | |
385 ;; We cannot send QUIT command unless the process is running. | |
386 (if (nntp-server-opened) | |
387 (nntp-send-command nil "QUIT"))) | |
388 (nntp-close-server-internal server) | |
389 (setq nntp-timeout-servers (delete server nntp-timeout-servers)))) | |
390 | |
391 (defalias 'nntp-request-quit (symbol-function 'nntp-close-server)) | |
392 | |
393 (defun nntp-request-close () | |
394 "Close all server connections." | |
395 (let (proc) | |
396 (while nntp-opened-connections | |
397 (setq proc (pop nntp-opened-connections)) | |
398 (and proc (delete-process proc))) | |
399 (and nntp-async-buffer | |
400 (get-buffer nntp-async-buffer) | |
401 (kill-buffer nntp-async-buffer)) | |
402 (while nntp-server-alist | |
403 (and (setq proc (nth 1 (assq 'nntp-async-buffer | |
404 (car nntp-server-alist)))) | |
405 (buffer-name proc) | |
406 (kill-buffer proc)) | |
407 (setq nntp-server-alist (cdr nntp-server-alist))) | |
408 (setq nntp-current-server nil | |
409 nntp-timeout-servers nil | |
410 nntp-async-group-alist nil))) | |
411 | |
412 (defun nntp-server-opened (&optional server) | |
413 "Say whether a connection to SERVER has been opened." | |
414 (and (equal server nntp-current-server) | |
415 nntp-server-buffer | |
416 (buffer-name nntp-server-buffer) | |
417 nntp-server-process | |
418 (memq (process-status nntp-server-process) '(open run)))) | |
419 | |
420 (defun nntp-status-message (&optional server) | |
421 "Return server status as a string." | |
422 (if (and nntp-status-string | |
423 ;; NNN MESSAGE | |
424 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" | |
425 nntp-status-string)) | |
426 (substring nntp-status-string (match-beginning 1) (match-end 1)) | |
427 ;; Empty message if nothing. | |
428 (or nntp-status-string ""))) | |
429 | |
430 (defun nntp-request-article (id &optional newsgroup server buffer) | |
431 "Request article ID (message-id or number)." | |
432 (nntp-possibly-change-server newsgroup server) | |
433 | |
434 (let (found) | |
435 | |
436 ;; First we see whether we can get the article from the async buffer. | |
437 (if (and (numberp id) | |
438 nntp-async-articles | |
439 (memq id nntp-async-fetched)) | |
440 (save-excursion | |
441 (set-buffer nntp-async-buffer) | |
442 (let ((opoint (point)) | |
443 (art (if (numberp id) (int-to-string id) id)) | |
444 beg end) | |
445 (if (and (or (re-search-forward (concat "^2.. +" art) nil t) | |
446 (progn | |
447 (goto-char (point-min)) | |
448 (re-search-forward (concat "^2.. +" art) opoint t))) | |
449 (progn | |
450 (beginning-of-line) | |
451 (setq beg (point) | |
452 end (re-search-forward "^\\.\r?\n" nil t)))) | |
453 (progn | |
454 (setq found t) | |
455 (save-excursion | |
456 (set-buffer (or buffer nntp-server-buffer)) | |
457 (erase-buffer) | |
458 (insert-buffer-substring nntp-async-buffer beg end) | |
459 (let ((nntp-server-buffer (current-buffer))) | |
460 (nntp-decode-text))) | |
461 (delete-region beg end) | |
462 (and nntp-async-articles | |
463 (nntp-async-fetch-articles id))))))) | |
464 | |
465 (if found | |
466 t | |
467 ;; The article was not in the async buffer, so we fetch it now. | |
468 (unwind-protect | |
469 (progn | |
470 (if buffer (set-process-buffer nntp-server-process buffer)) | |
471 (let ((nntp-server-buffer (or buffer nntp-server-buffer)) | |
472 (art (or (and (numberp id) (int-to-string id)) id))) | |
473 ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
474 (prog1 | |
475 (nntp-send-command "^\\.\r?\n" "ARTICLE" art) | |
476 (nntp-decode-text) | |
477 (and nntp-async-articles (nntp-async-fetch-articles id))))) | |
478 (if buffer (set-process-buffer | |
479 nntp-server-process nntp-server-buffer)))))) | |
480 | |
481 (defun nntp-request-body (id &optional newsgroup server) | |
482 "Request body of article ID (message-id or number)." | |
483 (nntp-possibly-change-server newsgroup server) | |
484 (prog1 | |
485 ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
486 (nntp-send-command | |
487 "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) | |
488 (nntp-decode-text))) | |
489 | |
490 (defun nntp-request-head (id &optional newsgroup server) | |
491 "Request head of article ID (message-id or number)." | |
492 (nntp-possibly-change-server newsgroup server) | |
493 (prog1 | |
494 (nntp-send-command | |
495 "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id)) | |
496 (nntp-decode-text))) | |
497 | |
498 (defun nntp-request-stat (id &optional newsgroup server) | |
499 "Request STAT of article ID (message-id or number)." | |
500 (nntp-possibly-change-server newsgroup server) | |
501 (nntp-send-command | |
502 "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) | |
503 | |
504 (defun nntp-request-group (group &optional server dont-check) | |
505 "Select GROUP." | |
506 (nntp-send-command "^.*\r?\n" "GROUP" group) | |
507 (setq nntp-current-group group) | |
508 (save-excursion | |
509 (set-buffer nntp-server-buffer) | |
510 (goto-char (point-min)) | |
511 (looking-at "[23]"))) | |
512 | |
513 (defun nntp-request-asynchronous (group &optional server articles) | |
514 (and nntp-async-articles (nntp-async-request-group group)) | |
515 (and | |
516 nntp-async-number | |
517 (if (not (or (nntp-async-server-opened) | |
518 (nntp-async-open-server))) | |
519 (progn | |
520 (message "Can't open second connection to %s" nntp-address) | |
521 (ding) | |
522 (setq nntp-async-articles nil) | |
523 (sit-for 2)) | |
524 (setq nntp-async-articles articles) | |
525 (setq nntp-async-fetched nil) | |
526 (save-excursion | |
527 (set-buffer nntp-async-buffer) | |
528 (erase-buffer)) | |
529 (nntp-async-send-strings "GROUP" group) | |
530 t))) | |
531 | |
532 (defun nntp-list-active-group (group &optional server) | |
533 (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) | |
534 | |
535 (defun nntp-request-group-description (group &optional server) | |
536 "Get description of GROUP." | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
537 (nntp-possibly-change-server nil server) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
538 (prog1 |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
539 (nntp-send-command "^.*\r?\n" "XGTITLE" group) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
540 (nntp-decode-text))) |
13401 | 541 |
542 (defun nntp-close-group (group &optional server) | |
543 (setq nntp-current-group nil) | |
544 t) | |
545 | |
546 (defun nntp-request-list (&optional server) | |
547 "List active groups." | |
548 (nntp-possibly-change-server nil server) | |
549 (prog1 | |
550 (nntp-send-command "^\\.\r?\n" "LIST") | |
551 (nntp-decode-text))) | |
552 | |
553 (defun nntp-request-list-newsgroups (&optional server) | |
554 "List groups." | |
555 (nntp-possibly-change-server nil server) | |
556 (prog1 | |
557 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") | |
558 (nntp-decode-text))) | |
559 | |
560 (defun nntp-request-newgroups (date &optional server) | |
561 "List new groups." | |
562 (nntp-possibly-change-server nil server) | |
563 (let* ((date (timezone-parse-date date)) | |
564 (time-string | |
565 (format "%s%02d%02d %s%s%s" | |
566 (substring (aref date 0) 2) (string-to-int (aref date 1)) | |
567 (string-to-int (aref date 2)) (substring (aref date 3) 0 2) | |
568 (substring | |
569 (aref date 3) 3 5) (substring (aref date 3) 6 8)))) | |
570 (prog1 | |
571 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) | |
572 (nntp-decode-text)))) | |
573 | |
574 (defun nntp-request-list-distributions (&optional server) | |
575 "List distributions." | |
576 (nntp-possibly-change-server nil server) | |
577 (prog1 | |
578 (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") | |
579 (nntp-decode-text))) | |
580 | |
581 (defun nntp-request-last (&optional newsgroup server) | |
582 "Decrease the current article pointer." | |
583 (nntp-possibly-change-server newsgroup server) | |
584 (nntp-send-command "^[23].*\r?\n" "LAST")) | |
585 | |
586 (defun nntp-request-next (&optional newsgroup server) | |
587 "Advance the current article pointer." | |
588 (nntp-possibly-change-server newsgroup server) | |
589 (nntp-send-command "^[23].*\r?\n" "NEXT")) | |
590 | |
591 (defun nntp-request-post (&optional server) | |
592 "Post the current buffer." | |
593 (nntp-possibly-change-server nil server) | |
14654
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
594 (save-excursion |
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
595 (set-buffer nntp-server-buffer) |
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
596 (erase-buffer)) |
13401 | 597 (if (nntp-send-command "^[23].*\r?\n" "POST") |
598 (progn | |
14654
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
599 (save-excursion |
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
600 (set-buffer nntp-server-buffer) |
4db721fba60b
* nntp.el (nntp-request-post): Clear the server buffer before
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
14531
diff
changeset
|
601 (erase-buffer)) |
13401 | 602 (nntp-encode-text) |
603 (nntp-send-region-to-server (point-min) (point-max)) | |
604 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not | |
605 ;; appended to end of the status message. | |
606 (nntp-wait-for-response "^[23].*\n")))) | |
607 | |
608 (defun nntp-request-post-buffer | |
609 (post group subject header article-buffer info follow-to respect-poster) | |
610 "Request a buffer suitable for composing an article. | |
611 If POST, this is an original article; otherwise it's a followup. | |
612 GROUP is the group to be posted to, the article should have subject | |
613 SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the | |
614 article being followed up. INFO is a Gnus info list. If FOLLOW-TO, | |
615 post to this group instead. If RESPECT-POSTER, heed the special | |
616 \"poster\" value of the Followup-to header." | |
617 (if (assq 'to-address (nth 5 info)) | |
618 (nnmail-request-post-buffer | |
619 post group subject header article-buffer info follow-to respect-poster) | |
620 (let ((mail-default-headers | |
621 (or nntp-news-default-headers mail-default-headers)) | |
622 from date to followup-to newsgroups message-of | |
623 references distribution message-id) | |
624 (save-excursion | |
625 (set-buffer (get-buffer-create "*post-news*")) | |
626 (news-reply-mode) | |
627 (if (and (buffer-modified-p) | |
628 (> (buffer-size) 0) | |
629 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
630 () | |
631 (erase-buffer) | |
632 (if post | |
633 (news-setup nil subject nil group nil) | |
634 (save-excursion | |
635 (set-buffer article-buffer) | |
636 (goto-char (point-min)) | |
637 (narrow-to-region (point-min) | |
638 (progn (search-forward "\n\n") (point))) | |
639 (setq from (mail-header-from header)) | |
640 (setq date (mail-header-date header)) | |
641 (and from | |
642 (let ((stop-pos | |
643 (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
644 (setq | |
645 message-of | |
646 (concat (if stop-pos (substring from 0 stop-pos) from) | |
647 "'s message of " date)))) | |
648 (setq subject (or subject (mail-header-subject header))) | |
649 (or (string-match "^[Rr][Ee]:" subject) | |
650 (setq subject (concat "Re: " subject))) | |
651 (setq followup-to (mail-fetch-field "followup-to")) | |
652 (if (or (null respect-poster) ;Ignore followup-to: field. | |
653 (string-equal "" followup-to) ;Bogus header. | |
654 (string-equal "poster" followup-to);Poster | |
655 (and (eq respect-poster 'ask) | |
656 followup-to | |
657 (not (y-or-n-p (concat "Followup to " | |
658 followup-to "? "))))) | |
659 (setq followup-to nil)) | |
660 (setq newsgroups | |
661 (or follow-to followup-to (mail-fetch-field "newsgroups"))) | |
662 (setq references (mail-header-references header)) | |
663 (setq distribution (mail-fetch-field "distribution")) | |
664 ;; Remove bogus distribution. | |
665 (and (stringp distribution) | |
666 (string-match "world" distribution) | |
667 (setq distribution nil)) | |
668 (setq message-id (mail-header-id header)) | |
669 (widen)) | |
670 (setq news-reply-yank-from from) | |
671 (setq news-reply-yank-message-id message-id) | |
672 (news-setup to subject message-of | |
673 (if (stringp newsgroups) newsgroups "") | |
674 article-buffer) | |
675 (if (and newsgroups (listp newsgroups)) | |
676 (progn | |
677 (goto-char (point-min)) | |
678 (while newsgroups | |
679 (insert (car (car newsgroups)) ": " | |
680 (cdr (car newsgroups)) "\n") | |
681 (setq newsgroups (cdr newsgroups))))) | |
682 (nnheader-insert-references references message-id) | |
683 (if distribution | |
684 (progn | |
685 (mail-position-on-field "Distribution") | |
686 (insert distribution))))) | |
687 (current-buffer))))) | |
688 | |
689 ;;; Internal functions. | |
690 | |
691 (defun nntp-send-mode-reader () | |
692 "Send the MODE READER command to the nntp server. | |
693 This function is supposed to be called from `nntp-server-opened-hook'. | |
694 It will make innd servers spawn an nnrpd process to allow actual article | |
695 reading." | |
696 (nntp-send-command "^.*\r?\n" "MODE READER")) | |
697 | |
698 (defun nntp-send-authinfo () | |
699 "Send the AUTHINFO to the nntp server. | |
700 This function is supposed to be called from `nntp-server-opened-hook'. | |
701 It will prompt for a password." | |
702 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) | |
703 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" | |
704 (read-string "NNTP password: "))) | |
705 | |
706 (defun nntp-send-authinfo-from-file () | |
707 "Send the AUTHINFO to the nntp server. | |
708 This function is supposed to be called from `nntp-server-opened-hook'. | |
709 It will prompt for a password." | |
710 (and (file-exists-p "~/.nntp-authinfo") | |
711 (save-excursion | |
712 (set-buffer (get-buffer-create " *tull*")) | |
713 (insert-file-contents "~/.nntp-authinfo") | |
714 (goto-char (point-min)) | |
715 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) | |
716 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" | |
717 (buffer-substring (point) | |
718 (progn (end-of-line) (point)))) | |
719 (kill-buffer (current-buffer))))) | |
720 | |
721 (defun nntp-default-sentinel (proc status) | |
722 "Default sentinel function for NNTP server process." | |
723 (let ((servers nntp-server-alist) | |
724 server) | |
725 ;; Go through the alist of server names and find the name of the | |
726 ;; server that the process that sent the signal is connected to. | |
727 ;; If you get my drift. | |
728 (if (equal proc nntp-server-process) | |
729 (setq server nntp-address) | |
730 (while (and servers | |
731 (not (equal proc (nth 1 (assq 'nntp-server-process | |
732 (car servers)))))) | |
733 (setq servers (cdr servers))) | |
734 (setq server (car (car servers)))) | |
735 (and server | |
736 (progn | |
737 (message "nntp: Connection closed to server %s" server) | |
738 (ding))))) | |
739 | |
740 (defun nntp-kill-connection (server) | |
741 (let ((proc (nth 1 (assq 'nntp-server-process | |
742 (assoc server nntp-server-alist))))) | |
743 (and proc (delete-process (process-name proc))) | |
744 (nntp-close-server server) | |
745 (setq nntp-timeout-servers (cons server nntp-timeout-servers)) | |
746 (setq nntp-status-string | |
747 (message "Connection timed out to server %s." server)) | |
748 (ding) | |
749 (sit-for 1))) | |
750 | |
751 ;; Encoding and decoding of NNTP text. | |
752 | |
753 (defun nntp-decode-text () | |
754 "Decode text transmitted by NNTP. | |
755 0. Delete status line. | |
756 1. Delete `^M' at end of line. | |
757 2. Delete `.' at end of buffer (end of text mark). | |
758 3. Delete `.' at beginning of line." | |
759 (save-excursion | |
760 (set-buffer nntp-server-buffer) | |
761 ;; Insert newline at end of buffer. | |
762 (goto-char (point-max)) | |
763 (or (bolp) (insert "\n")) | |
764 ;; Delete status line. | |
765 (goto-char (point-min)) | |
766 (delete-region (point) (progn (forward-line 1) (point))) | |
767 ;; Delete `^M' at the end of lines. | |
768 (while (not (eobp)) | |
769 (end-of-line) | |
770 (and (= (preceding-char) ?\r) | |
771 (delete-char -1)) | |
772 (forward-line 1)) | |
773 ;; Delete `.' at end of the buffer (end of text mark). | |
774 (goto-char (point-max)) | |
775 (forward-line -1) | |
776 (if (looking-at "^\\.\n") | |
777 (delete-region (point) (progn (forward-line 1) (point)))) | |
778 ;; Replace `..' at beginning of line with `.'. | |
779 (goto-char (point-min)) | |
780 ;; (replace-regexp "^\\.\\." ".") | |
781 (while (search-forward "\n.." nil t) | |
782 (delete-char -1)))) | |
783 | |
784 (defun nntp-encode-text () | |
785 "Encode text in current buffer for NNTP transmission. | |
786 1. Insert `.' at beginning of line. | |
787 2. Insert `.' at end of buffer (end of text mark)." | |
788 (save-excursion | |
789 ;; Insert newline at end of buffer. | |
790 (goto-char (point-max)) | |
791 (or (bolp) (insert "\n")) | |
792 ;; Replace `.' at beginning of line with `..'. | |
793 (goto-char (point-min)) | |
794 ;; (replace-regexp "^\\." "..") | |
795 (while (search-forward "\n." nil t) | |
796 (insert ".")) | |
797 ;; Insert `.' at end of buffer (end of text mark). | |
798 (goto-char (point-max)) | |
799 (insert ".\r\n"))) | |
800 | |
801 | |
802 ;;; | |
803 ;;; Synchronous Communication with NNTP Server. | |
804 ;;; | |
805 | |
806 (defun nntp-send-command (response cmd &rest args) | |
807 "Wait for server RESPONSE after sending CMD and optional ARGS to server." | |
808 (save-excursion | |
809 ;; Clear communication buffer. | |
810 (set-buffer nntp-server-buffer) | |
811 (erase-buffer) | |
812 (apply 'nntp-send-strings-to-server cmd args) | |
813 (if response | |
814 (nntp-wait-for-response response) | |
815 t))) | |
816 | |
817 (defun nntp-wait-for-response (regexp &optional slow) | |
818 "Wait for server response which matches REGEXP." | |
819 (save-excursion | |
820 (let ((status t) | |
821 (wait t) | |
822 (dotnum 0) ;Number of "." being displayed. | |
823 (dotsize ;How often "." displayed. | |
824 (if (numberp nntp-debug-read) nntp-debug-read 10000))) | |
825 (set-buffer nntp-server-buffer) | |
826 ;; Wait for status response (RFC977). | |
827 ;; 1xx - Informative message. | |
828 ;; 2xx - Command ok. | |
829 ;; 3xx - Command ok so far, send the rest of it. | |
830 ;; 4xx - Command was correct, but couldn't be performed for some | |
831 ;; reason. | |
832 ;; 5xx - Command unimplemented, or incorrect, or a serious | |
833 ;; program error occurred. | |
834 (nntp-accept-response) | |
835 (while wait | |
836 (goto-char (point-min)) | |
837 (if slow | |
838 (progn | |
839 (cond ((re-search-forward "^[23][0-9][0-9]" nil t) | |
840 (setq wait nil)) | |
841 ((re-search-forward "^[45][0-9][0-9]" nil t) | |
842 (setq status nil) | |
843 (setq wait nil)) | |
844 (t (nntp-accept-response))) | |
845 (if (not wait) (delete-region (point-min) | |
846 (progn (beginning-of-line) | |
847 (point))))) | |
848 (cond ((looking-at "[23]") | |
849 (setq wait nil)) | |
850 ((looking-at "[45]") | |
851 (setq status nil) | |
852 (setq wait nil)) | |
853 (t (nntp-accept-response))))) | |
854 ;; Save status message. | |
855 (end-of-line) | |
856 (setq nntp-status-string | |
857 (buffer-substring (point-min) (point))) | |
858 (if status | |
859 (progn | |
860 (setq wait t) | |
861 (while wait | |
862 (goto-char (point-max)) | |
863 (forward-line -1) ;(beginning-of-line) | |
864 ;;(message (buffer-substring | |
865 ;; (point) | |
866 ;; (save-excursion (end-of-line) (point)))) | |
867 (if (looking-at regexp) | |
868 (setq wait nil) | |
869 (if nntp-debug-read | |
870 (let ((newnum (/ (buffer-size) dotsize))) | |
871 (if (not (= dotnum newnum)) | |
872 (progn | |
873 (setq dotnum newnum) | |
874 (message "NNTP: Reading %s" | |
875 (make-string dotnum ?.)))))) | |
876 (nntp-accept-response))) | |
877 ;; Remove "...". | |
878 (if (and nntp-debug-read (> dotnum 0)) | |
879 (message "")) | |
880 ;; Successfully received server response. | |
881 t))))) | |
882 | |
883 | |
884 | |
885 ;;; | |
886 ;;; Low-Level Interface to NNTP Server. | |
887 ;;; | |
888 | |
889 (defun nntp-retrieve-headers-with-xover (sequence) | |
890 (erase-buffer) | |
891 (cond | |
892 | |
893 ;; This server does not talk NOV. | |
894 ((not nntp-server-xover) | |
895 nil) | |
896 | |
897 ;; We don't care about gaps. | |
898 ((not nntp-nov-gap) | |
899 (nntp-send-xover-command | |
900 (car sequence) (nntp-last-element sequence) 'wait) | |
901 | |
902 (goto-char (point-min)) | |
903 (if (looking-at "[1-5][0-9][0-9] ") | |
904 (delete-region (point) (progn (forward-line 1) (point)))) | |
905 (while (search-forward "\r" nil t) | |
906 (replace-match "" t t)) | |
907 (goto-char (point-max)) | |
908 (forward-line -1) | |
909 (if (looking-at "\\.") | |
910 (delete-region (point) (progn (forward-line 1) (point))))) | |
911 | |
912 ;; We do it the hard way. For each gap, an XOVER command is sent | |
913 ;; to the server. We do not wait for a reply from the server, we | |
914 ;; just send them off as fast as we can. That means that we have | |
915 ;; to count the number of responses we get back to find out when we | |
916 ;; have gotten all we asked for. | |
917 ((numberp nntp-nov-gap) | |
918 (let ((count 0) | |
919 (received 0) | |
920 (last-point (point-min)) | |
921 (buf (current-buffer)) | |
922 first) | |
923 ;; We have to check `nntp-server-xover'. If it gets set to nil, | |
924 ;; that means that the server does not understand XOVER, but we | |
925 ;; won't know that until we try. | |
926 (while (and nntp-server-xover sequence) | |
927 (setq first (car sequence)) | |
928 ;; Search forward until we find a gap, or until we run out of | |
929 ;; articles. | |
930 (while (and (cdr sequence) | |
931 (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap)) | |
932 (setq sequence (cdr sequence))) | |
933 | |
934 (if (not (nntp-send-xover-command first (car sequence))) | |
935 () | |
936 (setq sequence (cdr sequence) | |
937 count (1+ count)) | |
938 | |
939 ;; Every 400 requests we have to read the stream in | |
940 ;; order to avoid deadlocks. | |
941 (if (or (null sequence) ;All requests have been sent. | |
942 (zerop (% count nntp-maximum-request))) | |
943 (progn | |
944 (accept-process-output) | |
945 ;; On some Emacs versions the preceding function has | |
946 ;; a tendency to change the buffer. Perhaps. It's | |
14040 | 947 ;; quite difficult to reproduce, because it only |
13401 | 948 ;; seems to happen once in a blue moon. |
949 (set-buffer buf) | |
950 (while (progn | |
951 (goto-char last-point) | |
952 ;; Count replies. | |
953 (while (re-search-forward "^[0-9][0-9][0-9] " nil t) | |
954 (setq received (1+ received))) | |
955 (setq last-point (point)) | |
956 (< received count)) | |
957 (accept-process-output) | |
958 (set-buffer buf)))))) | |
959 | |
960 (if (not nntp-server-xover) | |
961 () | |
962 ;; Wait for the reply from the final command. | |
963 (goto-char (point-max)) | |
964 (re-search-backward "^[0-9][0-9][0-9] " nil t) | |
965 (if (looking-at "^[23]") | |
966 (while (progn | |
967 (goto-char (point-max)) | |
968 (forward-line -1) | |
969 (not (looking-at "^\\.\r?\n"))) | |
970 (nntp-accept-response))) | |
971 | |
972 ;; We remove any "." lines and status lines. | |
973 (goto-char (point-min)) | |
974 (while (search-forward "\r" nil t) | |
975 (delete-char -1)) | |
976 (goto-char (point-min)) | |
977 (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))))) | |
978 | |
979 nntp-server-xover) | |
980 | |
981 (defun nntp-send-xover-command (beg end &optional wait-for-reply) | |
982 (let ((range (format "%d-%d" beg end))) | |
983 (if (stringp nntp-server-xover) | |
984 ;; If `nntp-server-xover' is a string, then we just send this | |
985 ;; command. | |
986 (if wait-for-reply | |
987 (nntp-send-command "^\\.\r?\n" nntp-server-xover range) | |
988 ;; We do not wait for the reply. | |
989 (progn | |
990 (nntp-send-strings-to-server nntp-server-xover range) | |
991 t)) | |
992 (let ((commands nntp-xover-commands)) | |
993 ;; `nntp-xover-commands' is a list of possible XOVER commands. | |
994 ;; We try them all until we get at positive response. | |
995 (while (and commands (eq nntp-server-xover 'try)) | |
996 (nntp-send-command "^\\.\r?\n" (car commands) range) | |
997 (save-excursion | |
998 (set-buffer nntp-server-buffer) | |
999 (goto-char (point-min)) | |
1000 (and (looking-at "[23]") ; No error message. | |
1001 ;; We also have to look at the lines. Some buggy | |
1002 ;; servers give back simple lines with just the | |
1003 ;; article number. How... helpful. | |
1004 (progn | |
1005 (forward-line 1) | |
1006 (looking-at "[0-9]+\t...")) ; More text after number. | |
1007 (setq nntp-server-xover (car commands)))) | |
1008 (setq commands (cdr commands))) | |
1009 ;; If none of the commands worked, we disable XOVER. | |
1010 (if (eq nntp-server-xover 'try) | |
1011 (save-excursion | |
1012 (set-buffer nntp-server-buffer) | |
1013 (erase-buffer) | |
1014 (setq nntp-server-xover nil))) | |
1015 nntp-server-xover)))) | |
1016 | |
1017 (defun nntp-send-strings-to-server (&rest strings) | |
1018 "Send list of STRINGS to news server as command and its arguments." | |
1019 (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) | |
1020 ;; We open the nntp server if it is down. | |
1021 (or (nntp-server-opened nntp-current-server) | |
1022 (nntp-open-server nntp-current-server) | |
14428
165a13220edc
(nntp-send-strings-to-server, nntp-async-send-strings): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents:
14196
diff
changeset
|
1023 (error "%s" (nntp-status-message))) |
13401 | 1024 ;; Send the strings. |
1025 (process-send-string nntp-server-process cmd))) | |
1026 | |
1027 (defun nntp-send-region-to-server (begin end) | |
14531
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1028 "Send the current buffer region (from BEGIN to END) to the server." |
13401 | 1029 (save-excursion |
14531
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1030 (let ((cur (current-buffer))) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1031 ;; Copy the buffer over to the send buffer. |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1032 (set-buffer (get-buffer-create " *nntp send*")) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1033 (buffer-disable-undo (current-buffer)) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1034 (erase-buffer) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1035 (insert-buffer-substring cur begin end) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1036 (save-excursion |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1037 (set-buffer cur) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1038 (erase-buffer)) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1039 ;; `process-send-region' does not work if the text to be sent is very |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1040 ;; large, so we send it piecemeal. |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1041 (let ((last (point-min)) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1042 (size 100)) ;Size of text sent at once. |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1043 (while (/= last (point-max)) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1044 (process-send-region |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1045 nntp-server-process |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1046 last (setq last (min (+ last size) (point-max)))) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1047 ;; Read any output from the server. May be unnecessary. |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1048 (accept-process-output))) |
47ced2dc4bf6
(nntp-send-region-to-server): Use a temporary buffer to
Richard M. Stallman <rms@gnu.org>
parents:
14428
diff
changeset
|
1049 (kill-buffer (current-buffer))))) |
13401 | 1050 |
1051 (defun nntp-open-server-semi-internal (server &optional service) | |
1052 "Open SERVER. | |
1053 If SERVER is nil, use value of environment variable `NNTPSERVER'. | |
1054 If SERVICE, this this as the port number." | |
1055 (let ((server (or server (getenv "NNTPSERVER"))) | |
1056 (status nil) | |
1057 (timer | |
1058 (and nntp-connection-timeout | |
1059 (cond | |
1060 ((fboundp 'run-at-time) | |
1061 (run-at-time nntp-connection-timeout | |
1062 nil 'nntp-kill-connection server)) | |
1063 ((fboundp 'start-itimer) | |
1064 ;; Not sure if this will work or not, only one way to | |
1065 ;; find out | |
1066 (eval '(start-itimer "nntp-timeout" | |
1067 (lambda () | |
1068 (nntp-kill-connection server)) | |
1069 nntp-connection-timeout nil))))))) | |
1070 (save-excursion | |
1071 (set-buffer nntp-server-buffer) | |
1072 (setq nntp-status-string "") | |
1073 (message "nntp: Connecting to server on %s..." server) | |
1074 (cond ((and server (nntp-open-server-internal server service)) | |
1075 (setq nntp-address server) | |
1076 (setq status | |
1077 (condition-case nil | |
1078 (nntp-wait-for-response "^[23].*\r?\n" 'slow) | |
1079 (error nil) | |
1080 (quit nil))) | |
1081 (or status (nntp-close-server-internal server)) | |
1082 (and nntp-server-process | |
1083 (progn | |
1084 (set-process-sentinel | |
1085 nntp-server-process 'nntp-default-sentinel) | |
1086 ;; You can send commands at startup like AUTHINFO here. | |
1087 ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no> | |
1088 (run-hooks 'nntp-server-opened-hook)))) | |
1089 ((null server) | |
1090 (setq nntp-status-string "NNTP server is not specified.")) | |
1091 (t ; We couldn't open the server. | |
1092 (setq nntp-status-string | |
1093 (buffer-substring (point-min) (point-max))) | |
1094 (setq nntp-timeout-servers (cons server nntp-timeout-servers)))) | |
1095 (and timer (cancel-timer timer)) | |
1096 (message "") | |
1097 (or status | |
1098 (setq nntp-current-server nil | |
1099 nntp-async-number nil)) | |
1100 status))) | |
1101 | |
1102 (defun nntp-open-server-internal (server &optional service) | |
1103 "Open connection to news server on SERVER by SERVICE (default is nntp)." | |
1104 (let (proc) | |
1105 (save-excursion | |
1106 ;; Use TCP/IP stream emulation package if needed. | |
1107 (or (fboundp 'open-network-stream) | |
1108 (require 'tcp)) | |
1109 ;; Initialize communication buffer. | |
1110 (nnheader-init-server-buffer) | |
1111 (set-buffer nntp-server-buffer) | |
1112 (if (setq proc | |
1113 (condition-case nil | |
1114 (funcall nntp-open-server-function server) | |
1115 (error nil))) | |
1116 (progn | |
1117 (setq nntp-server-process proc) | |
1118 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
1119 (process-kill-without-query proc) | |
1120 (setq nntp-address server) | |
1121 ;; It is possible to change kanji-fileio-code in this hook. | |
1122 (run-hooks 'nntp-server-hook) | |
1123 (push proc nntp-opened-connections) | |
1124 nntp-server-process))))) | |
1125 | |
1126 (defun nntp-open-network-stream (server) | |
1127 (open-network-stream | |
1128 "nntpd" nntp-server-buffer server nntp-port-number)) | |
1129 | |
1130 (defun nntp-open-rlogin (server) | |
1131 (let ((proc (start-process "nntpd" nntp-server-buffer "rsh" server))) | |
1132 (process-send-string proc (mapconcat 'identity nntp-rlogin-parameters | |
1133 " ")) | |
1134 (process-send-string proc "\n"))) | |
1135 | |
1136 (defun nntp-telnet-to-machine () | |
1137 (let (b) | |
1138 (telnet "localhost") | |
1139 (goto-char (point-min)) | |
1140 (while (not (re-search-forward "^login: *" nil t)) | |
1141 (sit-for 1) | |
1142 (goto-char (point-min))) | |
1143 (goto-char (point-max)) | |
1144 (insert "larsi") | |
1145 (telnet-send-input) | |
1146 (setq b (point)) | |
1147 (while (not (re-search-forward ">" nil t)) | |
1148 (sit-for 1) | |
1149 (goto-char b)) | |
1150 (goto-char (point-max)) | |
1151 (insert "ls") | |
1152 (telnet-send-input))) | |
1153 | |
1154 (defun nntp-close-server-internal (&optional server) | |
1155 "Close connection to news server." | |
1156 (nntp-possibly-change-server nil server) | |
1157 (if nntp-server-process | |
1158 (delete-process nntp-server-process)) | |
1159 (setq nntp-server-process nil) | |
1160 (setq nntp-address "")) | |
1161 | |
1162 (defun nntp-accept-response () | |
1163 "Read response of server. | |
1164 It is well-known that the communication speed will be much improved by | |
1165 defining this function as macro." | |
1166 ;; To deal with server process exiting before | |
1167 ;; accept-process-output is called. | |
1168 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>. | |
1169 ;; This is a copy of `nntp-default-sentinel'. | |
1170 (let ((buf (current-buffer))) | |
1171 (prog1 | |
1172 (if (or (not nntp-server-process) | |
1173 (not (memq (process-status nntp-server-process) '(open run)))) | |
1174 (error "nntp: Process connection closed; %s" (nntp-status-message)) | |
1175 (if nntp-buggy-select | |
1176 (progn | |
1177 ;; We cannot use `accept-process-output'. | |
1178 ;; Fujitsu UTS requires messages during sleep-for. | |
1179 ;; I don't know why. | |
1180 (message "NNTP: Reading...") | |
1181 (sleep-for 1) | |
1182 (message "")) | |
1183 (condition-case errorcode | |
14196
abbc35e39b11
(nntp-accept-response): Add a timeout parameter to `accept-process-output'.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1184 (accept-process-output nntp-server-process 1) |
13401 | 1185 (error |
1186 (cond ((string-equal "select error: Invalid argument" | |
1187 (nth 1 errorcode)) | |
1188 ;; Ignore select error. | |
1189 nil) | |
1190 (t | |
1191 (signal (car errorcode) (cdr errorcode)))))))) | |
1192 (set-buffer buf)))) | |
1193 | |
1194 (defun nntp-last-element (list) | |
1195 "Return last element of LIST." | |
1196 (while (cdr list) | |
1197 (setq list (cdr list))) | |
1198 (car list)) | |
1199 | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1200 (defun nntp-possibly-change-server (newsgroup server &optional connectionless) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1201 "Check whether the virtual server needs changing." |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1202 (if (and server |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1203 (not (nntp-server-opened server))) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1204 ;; This virtual server isn't open, so we (re)open it here. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1205 (nntp-open-server server nil t)) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1206 (if (and newsgroup |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1207 (not (equal newsgroup nntp-current-group))) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1208 ;; Set the proper current group. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1209 (nntp-request-group newsgroup server))) |
13401 | 1210 |
1211 (defun nntp-try-list-active (group) | |
1212 (nntp-list-active-group group) | |
1213 (save-excursion | |
1214 (set-buffer nntp-server-buffer) | |
1215 (goto-char (point-min)) | |
1216 (cond ((looking-at "5[0-9]+") | |
1217 (setq nntp-server-list-active-group nil)) | |
1218 (t | |
1219 (setq nntp-server-list-active-group t))))) | |
1220 | |
1221 (defun nntp-async-server-opened () | |
1222 (and nntp-async-process | |
1223 (memq (process-status nntp-async-process) '(open run)))) | |
1224 | |
1225 (defun nntp-async-open-server () | |
1226 (save-excursion | |
1227 (set-buffer (generate-new-buffer " *async-nntp*")) | |
1228 (setq nntp-async-buffer (current-buffer)) | |
1229 (buffer-disable-undo (current-buffer))) | |
1230 (let ((nntp-server-process nil) | |
1231 (nntp-server-buffer nntp-async-buffer)) | |
1232 (nntp-open-server-semi-internal nntp-address nntp-port-number) | |
1233 (if (not (setq nntp-async-process nntp-server-process)) | |
1234 (progn | |
1235 (setq nntp-async-number nil)) | |
1236 (set-process-buffer nntp-async-process nntp-async-buffer)))) | |
1237 | |
1238 (defun nntp-async-fetch-articles (article) | |
1239 (if (stringp article) | |
1240 () | |
1241 (let ((articles (cdr (memq (assq article nntp-async-articles) | |
1242 nntp-async-articles))) | |
1243 (max (cond ((numberp nntp-async-number) | |
1244 nntp-async-number) | |
1245 ((eq nntp-async-number t) | |
1246 (length nntp-async-articles)) | |
1247 (t 0))) | |
1248 nart) | |
1249 (while (and (>= (setq max (1- max)) 0) | |
1250 articles) | |
1251 (or (memq (setq nart (car (car articles))) nntp-async-fetched) | |
1252 (progn | |
1253 (nntp-async-send-strings "ARTICLE " (int-to-string nart)) | |
1254 (setq nntp-async-fetched (cons nart nntp-async-fetched)))) | |
1255 (setq articles (cdr articles)))))) | |
1256 | |
1257 (defun nntp-async-send-strings (&rest strings) | |
1258 (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) | |
1259 (or (nntp-async-server-opened) | |
1260 (nntp-async-open-server) | |
14428
165a13220edc
(nntp-send-strings-to-server, nntp-async-send-strings): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents:
14196
diff
changeset
|
1261 (error "%s" (nntp-status-message))) |
13401 | 1262 (process-send-string nntp-async-process cmd))) |
1263 | |
1264 (defun nntp-async-request-group (group) | |
1265 (if (equal group nntp-current-group) | |
1266 () | |
1267 (let ((asyncs (assoc group nntp-async-group-alist))) | |
1268 ;; A new group has been selected, so we push the current state | |
1269 ;; of async articles on an alist, and pull the old state off. | |
1270 (setq nntp-async-group-alist | |
1271 (cons (list nntp-current-group | |
1272 nntp-async-articles nntp-async-fetched | |
1273 nntp-async-process) | |
1274 (delq asyncs nntp-async-group-alist))) | |
1275 (and asyncs | |
1276 (progn | |
1277 (setq nntp-async-articles (nth 1 asyncs)) | |
1278 (setq nntp-async-fetched (nth 2 asyncs)) | |
1279 (setq nntp-async-process (nth 3 asyncs))))))) | |
1280 | |
1281 (provide 'nntp) | |
1282 | |
1283 ;;; nntp.el ends here |