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