Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; nntp.el --- nntp access for Gnus |
b578f267 | 2 | |
cb4c9483 | 3 | ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. |
3a801d0c | 4 | |
c2c2f720 | 5 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
41487370 | 6 | ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> |
d7b4d18f | 7 | ;; Keywords: news |
c2c2f720 | 8 | |
05328297 | 9 | ;; This file is part of GNU Emacs. |
10 | ||
4da31937 RS |
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 | ||
05328297 | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
4da31937 RS |
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 | |
b578f267 EN |
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. | |
4da31937 | 25 | |
c2c2f720 ER |
26 | ;;; Commentary: |
27 | ||
c2c2f720 ER |
28 | ;;; Code: |
29 | ||
41487370 LMI |
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 | ||
05328297 | 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 | ||
a4e104bf | 51 | \(setq nntp-server-hook |
b027f415 RS |
52 | (function |
53 | (lambda () | |
05328297 | 54 | ;; Server's Kanji code is EUC (NEmacs hack). |
55 | (make-local-variable 'kanji-fileio-code) | |
b027f415 | 56 | (setq kanji-fileio-code 0)))) |
05328297 | 57 | |
58 | If you'd like to change something depending on the server in this | |
41487370 LMI |
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.") | |
05328297 | 93 | |
b027f415 RS |
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 | ||
884d69bd | 99 | (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) |
41487370 | 100 | "*t if your select routine is buggy. |
05328297 | 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 | |
41487370 | 103 | case of Fujitsu UTS, it is set to T since `accept-process-output' |
05328297 | 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 | ||
b027f415 RS |
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.") | |
05328297 | 114 | |
41487370 LMI |
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 | ||
05328297 | 148 | \f |
05328297 | 149 | |
41487370 LMI |
150 | (defconst nntp-version "nntp 4.0" |
151 | "Version numbers of this version of NNTP.") | |
05328297 | 152 | |
153 | (defvar nntp-server-buffer nil | |
41487370 | 154 | "Buffer associated with the NNTP server process.") |
05328297 | 155 | |
156 | (defvar nntp-server-process nil | |
157 | "The NNTP server process. | |
41487370 | 158 | You'd better not use this variable in NNTP front-end program, but |
05328297 | 159 | instead use `nntp-server-buffer'.") |
160 | ||
b027f415 | 161 | (defvar nntp-status-string nil |
05328297 | 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 | ||
41487370 LMI |
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 | \f | |
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 | \f | |
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) | |
05328297 | 217 | (save-excursion |
218 | (set-buffer nntp-server-buffer) | |
219 | (erase-buffer) | |
41487370 LMI |
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) | |
05328297 | 289 | (received 0) |
41487370 LMI |
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)) | |
05328297 | 296 | (setq count (1+ count)) |
41487370 LMI |
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. | |
05328297 | 300 | (zerop (% count nntp-maximum-request))) |
301 | (progn | |
41487370 | 302 | (nntp-accept-response) |
05328297 | 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)) | |
41487370 LMI |
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. | |
05328297 | 324 | (goto-char (point-min)) |
41487370 LMI |
325 | (while (search-forward "\r" nil t) |
326 | (replace-match "" t t)) | |
05328297 | 327 | |
41487370 LMI |
328 | (if nntp-server-list-active-group |
329 | (progn | |
330 | ;; We have read active entries, so we just delete the | |
a7acbbe4 | 331 | ;; superfluous gunk. |
41487370 LMI |
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 | ||
b2b9d575 RS |
339 | (defun nntp-open-server (server &optional defs connectionless) |
340 | "Open the virtual server SERVER. | |
341 | If CONNECTIONLESS is non-nil, don't attempt to connect to any physical | |
342 | servers." | |
41487370 LMI |
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) | |
b2b9d575 RS |
364 | ;; We have now changed to the proper virtual server. We then |
365 | ;; check that the physical server is opened. | |
366 | (if (or (nntp-server-opened server) | |
367 | connectionless) | |
ddc2544e | 368 | t |
b2b9d575 RS |
369 | (if (member nntp-address nntp-timeout-servers) |
370 | nil | |
371 | ;; We open a connection to the physical nntp server. | |
372 | (run-hooks 'nntp-prepare-server-hook) | |
373 | (nntp-open-server-semi-internal nntp-address nntp-port-number))))) | |
05328297 | 374 | |
41487370 LMI |
375 | (defun nntp-close-server (&optional server) |
376 | "Close connection to SERVER." | |
b2b9d575 | 377 | (nntp-possibly-change-server nil server t) |
05328297 | 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) | |
41487370 LMI |
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 | |
05328297 | 418 | (memq (process-status nntp-server-process) '(open run)))) |
419 | ||
41487370 LMI |
420 | (defun nntp-status-message (&optional server) |
421 | "Return server status as a string." | |
b027f415 | 422 | (if (and nntp-status-string |
05328297 | 423 | ;; NNN MESSAGE |
424 | (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" | |
b027f415 RS |
425 | nntp-status-string)) |
426 | (substring nntp-status-string (match-beginning 1) (match-end 1)) | |
05328297 | 427 | ;; Empty message if nothing. |
41487370 LMI |
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) | |
05328297 | 484 | (prog1 |
485 | ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
41487370 LMI |
486 | (nntp-send-command |
487 | "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) | |
488 | (nntp-decode-text))) | |
05328297 | 489 | |
41487370 LMI |
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) | |
05328297 | 493 | (prog1 |
41487370 LMI |
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." | |
b2b9d575 RS |
537 | (nntp-possibly-change-server nil server) |
538 | (prog1 | |
539 | (nntp-send-command "^.*\r?\n" "XGTITLE" group) | |
540 | (nntp-decode-text))) | |
41487370 LMI |
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) | |
05328297 | 549 | (prog1 |
41487370 LMI |
550 | (nntp-send-command "^\\.\r?\n" "LIST") |
551 | (nntp-decode-text))) | |
05328297 | 552 | |
41487370 LMI |
553 | (defun nntp-request-list-newsgroups (&optional server) |
554 | "List groups." | |
555 | (nntp-possibly-change-server nil server) | |
b027f415 | 556 | (prog1 |
41487370 LMI |
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) | |
b027f415 | 577 | (prog1 |
41487370 LMI |
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) | |
11d4e02f LMI |
594 | (save-excursion |
595 | (set-buffer nntp-server-buffer) | |
596 | (erase-buffer)) | |
41487370 | 597 | (if (nntp-send-command "^[23].*\r?\n" "POST") |
05328297 | 598 | (progn |
11d4e02f LMI |
599 | (save-excursion |
600 | (set-buffer nntp-server-buffer) | |
601 | (erase-buffer)) | |
05328297 | 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. | |
41487370 LMI |
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))))) | |
05328297 | 720 | |
721 | (defun nntp-default-sentinel (proc status) | |
722 | "Default sentinel function for NNTP server process." | |
41487370 LMI |
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))) | |
05328297 | 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)) | |
41487370 | 763 | (or (bolp) (insert "\n")) |
05328297 | 764 | ;; Delete status line. |
765 | (goto-char (point-min)) | |
766 | (delete-region (point) (progn (forward-line 1) (point))) | |
41487370 | 767 | ;; Delete `^M' at the end of lines. |
05328297 | 768 | (while (not (eobp)) |
769 | (end-of-line) | |
41487370 LMI |
770 | (and (= (preceding-char) ?\r) |
771 | (delete-char -1)) | |
772 | (forward-line 1)) | |
773 | ;; Delete `.' at end of the buffer (end of text mark). | |
05328297 | 774 | (goto-char (point-max)) |
41487370 LMI |
775 | (forward-line -1) |
776 | (if (looking-at "^\\.\n") | |
05328297 | 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) | |
41487370 | 782 | (delete-char -1)))) |
05328297 | 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)) | |
41487370 | 791 | (or (bolp) (insert "\n")) |
05328297 | 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)) | |
41487370 | 799 | (insert ".\r\n"))) |
05328297 | 800 | |
801 | \f | |
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) | |
41487370 | 815 | t))) |
05328297 | 816 | |
41487370 | 817 | (defun nntp-wait-for-response (regexp &optional slow) |
05328297 | 818 | "Wait for server response which matches REGEXP." |
819 | (save-excursion | |
820 | (let ((status t) | |
b027f415 RS |
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))) | |
05328297 | 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)) | |
41487370 LMI |
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))))) | |
05328297 | 854 | ;; Save status message. |
855 | (end-of-line) | |
b027f415 | 856 | (setq nntp-status-string |
05328297 | 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) | |
b027f415 RS |
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 ?.)))))) | |
41487370 | 876 | (nntp-accept-response))) |
b027f415 RS |
877 | ;; Remove "...". |
878 | (if (and nntp-debug-read (> dotnum 0)) | |
879 | (message "")) | |
05328297 | 880 | ;; Successfully received server response. |
41487370 | 881 | t))))) |
05328297 | 882 | |
883 | \f | |
41487370 | 884 | |
05328297 | 885 | ;;; |
886 | ;;; Low-Level Interface to NNTP Server. | |
887 | ;;; | |
888 | ||
41487370 LMI |
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 | |
a7acbbe4 | 947 | ;; quite difficult to reproduce, because it only |
41487370 LMI |
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 | ||
05328297 | 1017 | (defun nntp-send-strings-to-server (&rest strings) |
1018 | "Send list of STRINGS to news server as command and its arguments." | |
41487370 LMI |
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) | |
ea0bb97f | 1023 | (error "%s" (nntp-status-message))) |
41487370 LMI |
1024 | ;; Send the strings. |
1025 | (process-send-string nntp-server-process cmd))) | |
05328297 | 1026 | |
1027 | (defun nntp-send-region-to-server (begin end) | |
cb4c9483 | 1028 | "Send the current buffer region (from BEGIN to END) to the server." |
05328297 | 1029 | (save-excursion |
cb4c9483 RS |
1030 | (let ((cur (current-buffer))) |
1031 | ;; Copy the buffer over to the send buffer. | |
1032 | (set-buffer (get-buffer-create " *nntp send*")) | |
1033 | (buffer-disable-undo (current-buffer)) | |
1034 | (erase-buffer) | |
1035 | (insert-buffer-substring cur begin end) | |
1036 | (save-excursion | |
1037 | (set-buffer cur) | |
1038 | (erase-buffer)) | |
1039 | ;; `process-send-region' does not work if the text to be sent is very | |
1040 | ;; large, so we send it piecemeal. | |
1041 | (let ((last (point-min)) | |
1042 | (size 100)) ;Size of text sent at once. | |
1043 | (while (/= last (point-max)) | |
1044 | (process-send-region | |
1045 | nntp-server-process | |
1046 | last (setq last (min (+ last size) (point-max)))) | |
1047 | ;; Read any output from the server. May be unnecessary. | |
1048 | (accept-process-output))) | |
1049 | (kill-buffer (current-buffer))))) | |
41487370 LMI |
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))) | |
05328297 | 1153 | |
41487370 | 1154 | (defun nntp-close-server-internal (&optional server) |
05328297 | 1155 | "Close connection to news server." |
41487370 | 1156 | (nntp-possibly-change-server nil server) |
05328297 | 1157 | (if nntp-server-process |
1158 | (delete-process nntp-server-process)) | |
41487370 LMI |
1159 | (setq nntp-server-process nil) |
1160 | (setq nntp-address "")) | |
05328297 | 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'. | |
41487370 LMI |
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 | |
e9bd11e5 | 1184 | (accept-process-output nntp-server-process 1) |
41487370 LMI |
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 | ||
b2b9d575 RS |
1200 | (defun nntp-possibly-change-server (newsgroup server &optional connectionless) |
1201 | "Check whether the virtual server needs changing." | |
1202 | (if (and server | |
1203 | (not (nntp-server-opened server))) | |
1204 | ;; This virtual server isn't open, so we (re)open it here. | |
1205 | (nntp-open-server server nil t)) | |
1206 | (if (and newsgroup | |
1207 | (not (equal newsgroup nntp-current-group))) | |
1208 | ;; Set the proper current group. | |
1209 | (nntp-request-group newsgroup server))) | |
41487370 LMI |
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) | |
ea0bb97f | 1261 | (error "%s" (nntp-status-message))) |
41487370 LMI |
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))))))) | |
49116ac0 JB |
1280 | |
1281 | (provide 'nntp) | |
1282 | ||
6594deb0 | 1283 | ;;; nntp.el ends here |