Commit | Line | Data |
---|---|---|
6594deb0 ER |
1 | ;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs |
2 | ||
b027f415 | 3 | ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc. |
3a801d0c | 4 | |
c2c2f720 | 5 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
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 | ||
05328297 | 24 | |
c2c2f720 ER |
25 | ;;; Commentary: |
26 | ||
05328297 | 27 | ;; This implementation is tested on both 1.2a and 1.5 version of the |
28 | ;; NNTP package. | |
29 | ||
30 | ;; Troubleshooting of NNTP | |
31 | ;; | |
32 | ;; (1) Select routine may signal an error or fall into infinite loop | |
33 | ;; while waiting for the server response. In this case, you'd better | |
34 | ;; not use byte-compiled codes but original source. If you still have | |
884d69bd | 35 | ;; a problems with it, set the variable `nntp-buggy-select' to t. |
05328297 | 36 | ;; |
37 | ;; (2) Emacs may hang up while retrieving headers since too many | |
38 | ;; requests have been sent to the NNTP server without reading their | |
39 | ;; replies. In this case, reduce the number of the requests sent to | |
40 | ;; the server at one time by setting the variable | |
41 | ;; `nntp-maximum-request' to a lower value. | |
42 | ;; | |
43 | ;; (3) If the TCP/IP stream (open-network-stream) is not supported by | |
44 | ;; emacs, compile and install `tcp.el' and `tcp.c' which is an | |
45 | ;; emulation program of the stream. If you modified `tcp.c' for your | |
46 | ;; system, please send me the diffs. I'll include some of them in the | |
47 | ;; future releases. | |
48 | ||
c2c2f720 ER |
49 | ;;; Code: |
50 | ||
05328297 | 51 | (defvar nntp-server-hook nil |
52 | "*Hooks for the NNTP server. | |
53 | If the kanji code of the NNTP server is different from the local kanji | |
54 | code, the correct kanji code of the buffer associated with the NNTP | |
55 | server must be specified as follows: | |
56 | ||
a4e104bf | 57 | \(setq nntp-server-hook |
b027f415 RS |
58 | (function |
59 | (lambda () | |
05328297 | 60 | ;; Server's Kanji code is EUC (NEmacs hack). |
61 | (make-local-variable 'kanji-fileio-code) | |
b027f415 | 62 | (setq kanji-fileio-code 0)))) |
05328297 | 63 | |
64 | If you'd like to change something depending on the server in this | |
65 | hook, use the variable `nntp-server-name'.") | |
66 | ||
b027f415 RS |
67 | (defvar nntp-large-newsgroup 50 |
68 | "*The number of the articles which indicates a large newsgroup. | |
69 | If the number of the articles is greater than the value, verbose | |
70 | messages will be shown to indicate the current status.") | |
71 | ||
884d69bd RS |
72 | |
73 | (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) | |
74 | "*Non-nil if your select routine is buggy. | |
05328297 | 75 | If the select routine signals error or fall into infinite loop while |
76 | waiting for the server response, the variable must be set to t. In | |
884d69bd | 77 | case of Fujitsu UTS, it is set to t since `accept-process-output' |
05328297 | 78 | doesn't work properly.") |
79 | ||
80 | (defvar nntp-maximum-request 400 | |
81 | "*The maximum number of the requests sent to the NNTP server at one time. | |
82 | If Emacs hangs up while retrieving headers, set the variable to a | |
83 | lower value.") | |
84 | ||
b027f415 RS |
85 | (defvar nntp-debug-read 10000 |
86 | "*Display '...' every 10Kbytes of a message being received if it is non-nil. | |
87 | If it is a number, dots are displayed per the number.") | |
05328297 | 88 | |
89 | \f | |
b027f415 | 90 | (defconst nntp-version "NNTP 3.12" |
05328297 | 91 | "Version numbers of this version of NNTP.") |
92 | ||
93 | (defvar nntp-server-name nil | |
94 | "The name of the host running NNTP server.") | |
95 | ||
96 | (defvar nntp-server-buffer nil | |
97 | "Buffer associated with NNTP server process.") | |
98 | ||
99 | (defvar nntp-server-process nil | |
100 | "The NNTP server process. | |
101 | You'd better not use this variable in NNTP front-end program but | |
102 | instead use `nntp-server-buffer'.") | |
103 | ||
b027f415 | 104 | (defvar nntp-status-string nil |
05328297 | 105 | "Save the server response message. |
106 | You'd better not use this variable in NNTP front-end program but | |
107 | instead call function `nntp-status-message' to get status message.") | |
108 | ||
109 | ;;; | |
110 | ;;; Extended Command for retrieving many headers. | |
111 | ;;; | |
112 | ;; Retrieving lots of headers by sending command asynchronously. | |
113 | ;; Access functions to headers are defined as macro. | |
114 | ||
115 | (defmacro nntp-header-number (header) | |
116 | "Return article number in HEADER." | |
117 | (` (aref (, header) 0))) | |
118 | ||
119 | (defmacro nntp-set-header-number (header number) | |
120 | "Set article number of HEADER to NUMBER." | |
121 | (` (aset (, header) 0 (, number)))) | |
122 | ||
123 | (defmacro nntp-header-subject (header) | |
124 | "Return subject string in HEADER." | |
125 | (` (aref (, header) 1))) | |
126 | ||
127 | (defmacro nntp-set-header-subject (header subject) | |
128 | "Set article subject of HEADER to SUBJECT." | |
129 | (` (aset (, header) 1 (, subject)))) | |
130 | ||
131 | (defmacro nntp-header-from (header) | |
132 | "Return author string in HEADER." | |
133 | (` (aref (, header) 2))) | |
134 | ||
135 | (defmacro nntp-set-header-from (header from) | |
136 | "Set article author of HEADER to FROM." | |
137 | (` (aset (, header) 2 (, from)))) | |
138 | ||
139 | (defmacro nntp-header-xref (header) | |
140 | "Return xref string in HEADER." | |
141 | (` (aref (, header) 3))) | |
142 | ||
143 | (defmacro nntp-set-header-xref (header xref) | |
144 | "Set article xref of HEADER to xref." | |
145 | (` (aset (, header) 3 (, xref)))) | |
146 | ||
147 | (defmacro nntp-header-lines (header) | |
148 | "Return lines in HEADER." | |
149 | (` (aref (, header) 4))) | |
150 | ||
151 | (defmacro nntp-set-header-lines (header lines) | |
152 | "Set article lines of HEADER to LINES." | |
153 | (` (aset (, header) 4 (, lines)))) | |
154 | ||
155 | (defmacro nntp-header-date (header) | |
156 | "Return date in HEADER." | |
157 | (` (aref (, header) 5))) | |
158 | ||
159 | (defmacro nntp-set-header-date (header date) | |
160 | "Set article date of HEADER to DATE." | |
161 | (` (aset (, header) 5 (, date)))) | |
162 | ||
163 | (defmacro nntp-header-id (header) | |
164 | "Return Id in HEADER." | |
165 | (` (aref (, header) 6))) | |
166 | ||
167 | (defmacro nntp-set-header-id (header id) | |
168 | "Set article Id of HEADER to ID." | |
169 | (` (aset (, header) 6 (, id)))) | |
170 | ||
171 | (defmacro nntp-header-references (header) | |
b027f415 | 172 | "Return references (or in-reply-to) in HEADER." |
05328297 | 173 | (` (aref (, header) 7))) |
174 | ||
175 | (defmacro nntp-set-header-references (header ref) | |
176 | "Set article references of HEADER to REF." | |
177 | (` (aset (, header) 7 (, ref)))) | |
178 | ||
179 | (defun nntp-retrieve-headers (sequence) | |
180 | "Return list of article headers specified by SEQUENCE of article id. | |
181 | The format of list is | |
182 | `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. | |
b027f415 | 183 | If there is no References: field, In-Reply-To: field is used instead. |
05328297 | 184 | Reader macros for the vector are defined as `nntp-header-FIELD'. |
185 | Writer macros for the vector are defined as `nntp-set-header-FIELD'. | |
b027f415 | 186 | Newsgroup must be selected before calling this." |
05328297 | 187 | (save-excursion |
188 | (set-buffer nntp-server-buffer) | |
189 | (erase-buffer) | |
190 | (let ((number (length sequence)) | |
191 | (last-point (point-min)) | |
192 | (received 0) | |
193 | (count 0) | |
194 | (headers nil) ;Result list. | |
195 | (article 0) | |
196 | (subject nil) | |
197 | (message-id) | |
198 | (from nil) | |
199 | (xref nil) | |
200 | (lines 0) | |
201 | (date nil) | |
202 | (references nil)) | |
203 | ;; Send HEAD command. | |
204 | (while sequence | |
205 | (nntp-send-strings-to-server "HEAD" (car sequence)) | |
206 | (setq sequence (cdr sequence)) | |
207 | (setq count (1+ count)) | |
208 | ;; Every 400 header requests we have to read stream in order | |
209 | ;; to avoid deadlock. | |
210 | (if (or (null sequence) ;All requests have been sent. | |
211 | (zerop (% count nntp-maximum-request))) | |
212 | (progn | |
213 | (accept-process-output) | |
214 | (while (progn | |
215 | (goto-char last-point) | |
216 | ;; Count replies. | |
217 | (while (re-search-forward "^[0-9]" nil t) | |
218 | (setq received (1+ received))) | |
219 | (setq last-point (point)) | |
220 | (< received count)) | |
221 | ;; If number of headers is greater than 100, give | |
222 | ;; informative messages. | |
223 | (and (numberp nntp-large-newsgroup) | |
224 | (> number nntp-large-newsgroup) | |
225 | (zerop (% received 20)) | |
b027f415 | 226 | (message "NNTP: Receiving headers... %d%%" |
05328297 | 227 | (/ (* received 100) number))) |
228 | (nntp-accept-response)) | |
229 | )) | |
230 | ) | |
231 | ;; Wait for text of last command. | |
232 | (goto-char (point-max)) | |
233 | (re-search-backward "^[0-9]" nil t) | |
234 | (if (looking-at "^[23]") | |
235 | (while (progn | |
236 | (goto-char (- (point-max) 3)) | |
237 | (not (looking-at "^\\.\r$"))) | |
238 | (nntp-accept-response))) | |
239 | (and (numberp nntp-large-newsgroup) | |
240 | (> number nntp-large-newsgroup) | |
b027f415 | 241 | (message "NNTP: Receiving headers... done")) |
05328297 | 242 | ;; Now all of replies are received. |
243 | (setq received number) | |
244 | ;; First, fold continuation lines. | |
245 | (goto-char (point-min)) | |
246 | (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
247 | (replace-match " " t t)) | |
248 | ;;(delete-non-matching-lines | |
249 | ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]") | |
250 | (and (numberp nntp-large-newsgroup) | |
251 | (> number nntp-large-newsgroup) | |
252 | (message "NNTP: Parsing headers...")) | |
253 | ;; Then examines replies. | |
254 | (goto-char (point-min)) | |
255 | (while (not (eobp)) | |
256 | (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)") | |
257 | (setq article | |
258 | (string-to-int | |
259 | (buffer-substring (match-beginning 1) (match-end 1)))) | |
260 | (setq message-id | |
261 | (buffer-substring (match-beginning 2) (match-end 2))) | |
262 | (forward-line 1) | |
263 | ;; Set default value. | |
264 | (setq subject nil) | |
265 | (setq xref nil) | |
266 | (setq from nil) | |
267 | (setq lines 0) | |
268 | (setq date nil) | |
269 | (setq references nil) | |
270 | ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik) | |
271 | (while (and (not (eobp)) | |
272 | (not (memq (following-char) '(?2 ?3)))) | |
b027f415 | 273 | (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$") |
05328297 | 274 | (let ((s (buffer-substring |
275 | (match-beginning 2) (match-end 2))) | |
276 | (c (char-after (match-beginning 0)))) | |
277 | ;; We don't have to worry about letter case. | |
278 | (cond ((char-equal c ?F) ;From: | |
279 | (setq from s)) | |
280 | ((char-equal c ?S) ;Subject: | |
281 | (setq subject s)) | |
282 | ((char-equal c ?D) ;Date: | |
283 | (setq date s)) | |
284 | ((char-equal c ?L) ;Lines: | |
285 | (setq lines (string-to-int s))) | |
286 | ((char-equal c ?X) ;Xref: | |
287 | (setq xref s)) | |
288 | ((char-equal c ?R) ;References: | |
289 | (setq references s)) | |
b027f415 RS |
290 | ;; In-Reply-To: should be used only when |
291 | ;; there is no References: field. | |
292 | ((and (char-equal c ?I) ;In-Reply-To: | |
293 | (null references)) | |
294 | (setq references s)) | |
05328297 | 295 | ))) |
296 | (forward-line 1)) | |
297 | ;; Finished to parse one header. | |
298 | (if (null subject) | |
299 | (setq subject "(None)")) | |
300 | (if (null from) | |
301 | (setq from "(Unknown User)")) | |
b027f415 RS |
302 | ;; Collect valid article only. |
303 | (and article | |
304 | message-id | |
305 | (setq headers | |
306 | (cons (vector article subject from | |
307 | xref lines date | |
308 | message-id references) headers))) | |
05328297 | 309 | ) |
310 | (t (forward-line 1)) | |
311 | ) | |
312 | (setq received (1- received)) | |
313 | (and (numberp nntp-large-newsgroup) | |
314 | (> number nntp-large-newsgroup) | |
315 | (zerop (% received 20)) | |
316 | (message "NNTP: Parsing headers... %d%%" | |
317 | (/ (* received 100) number))) | |
318 | ) | |
319 | (and (numberp nntp-large-newsgroup) | |
320 | (> number nntp-large-newsgroup) | |
321 | (message "NNTP: Parsing headers... done")) | |
322 | (nreverse headers) | |
323 | ))) | |
324 | ||
325 | \f | |
326 | ;;; | |
327 | ;;; Raw Interface to Network News Transfer Protocol (RFC977). | |
328 | ;;; | |
329 | ||
330 | (defun nntp-open-server (host &optional service) | |
331 | "Open news server on HOST. | |
332 | If HOST is nil, use value of environment variable `NNTPSERVER'. | |
333 | If optional argument SERVICE is non-nil, open by the service name." | |
334 | (let ((host (or host (getenv "NNTPSERVER"))) | |
335 | (status nil)) | |
b027f415 | 336 | (setq nntp-status-string "") |
05328297 | 337 | (cond ((and host (nntp-open-server-internal host service)) |
338 | (setq status (nntp-wait-for-response "^[23].*\r$")) | |
339 | ;; Do check unexpected close of connection. | |
340 | ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet. | |
341 | (if status | |
332ad7ce RS |
342 | (progn (set-process-sentinel nntp-server-process |
343 | 'nntp-default-sentinel) | |
344 | (nntp-send-command "^[25].*\r$" "MODE" "READER")) | |
05328297 | 345 | ;; We have to close connection here, since function |
346 | ;; `nntp-server-opened' may return incorrect status. | |
347 | (nntp-close-server-internal) | |
348 | )) | |
349 | ((null host) | |
b027f415 | 350 | (setq nntp-status-string "NNTP server is not specified.")) |
05328297 | 351 | ) |
352 | status | |
353 | )) | |
354 | ||
355 | (defun nntp-close-server () | |
356 | "Close news server." | |
357 | (unwind-protect | |
358 | (progn | |
359 | ;; Un-set default sentinel function before closing connection. | |
360 | (and nntp-server-process | |
361 | (eq 'nntp-default-sentinel | |
362 | (process-sentinel nntp-server-process)) | |
363 | (set-process-sentinel nntp-server-process nil)) | |
364 | ;; We cannot send QUIT command unless the process is running. | |
365 | (if (nntp-server-opened) | |
366 | (nntp-send-command nil "QUIT")) | |
367 | ) | |
368 | (nntp-close-server-internal) | |
369 | )) | |
370 | ||
371 | (fset 'nntp-request-quit (symbol-function 'nntp-close-server)) | |
372 | ||
373 | (defun nntp-server-opened () | |
374 | "Return server process status, T or NIL. | |
375 | If the stream is opened, return T, otherwise return NIL." | |
376 | (and nntp-server-process | |
377 | (memq (process-status nntp-server-process) '(open run)))) | |
378 | ||
379 | (defun nntp-status-message () | |
380 | "Return server status response as string." | |
b027f415 | 381 | (if (and nntp-status-string |
05328297 | 382 | ;; NNN MESSAGE |
383 | (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" | |
b027f415 RS |
384 | nntp-status-string)) |
385 | (substring nntp-status-string (match-beginning 1) (match-end 1)) | |
05328297 | 386 | ;; Empty message if nothing. |
387 | "" | |
388 | )) | |
389 | ||
390 | (defun nntp-request-article (id) | |
391 | "Select article by message ID (or number)." | |
392 | (prog1 | |
393 | ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
394 | (nntp-send-command "^\\.\r$" "ARTICLE" id) | |
395 | (nntp-decode-text) | |
396 | )) | |
397 | ||
398 | (defun nntp-request-body (id) | |
399 | "Select article body by message ID (or number)." | |
400 | (prog1 | |
401 | ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
402 | (nntp-send-command "^\\.\r$" "BODY" id) | |
403 | (nntp-decode-text) | |
404 | )) | |
405 | ||
406 | (defun nntp-request-head (id) | |
407 | "Select article head by message ID (or number)." | |
408 | (prog1 | |
409 | (nntp-send-command "^\\.\r$" "HEAD" id) | |
410 | (nntp-decode-text) | |
411 | )) | |
412 | ||
413 | (defun nntp-request-stat (id) | |
414 | "Select article by message ID (or number)." | |
415 | (nntp-send-command "^[23].*\r$" "STAT" id)) | |
416 | ||
417 | (defun nntp-request-group (group) | |
418 | "Select news GROUP." | |
419 | ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to | |
420 | ;; end of the status message. | |
421 | (nntp-send-command "^[23].*$" "GROUP" group)) | |
422 | ||
423 | (defun nntp-request-list () | |
b027f415 | 424 | "List active newsgroups." |
05328297 | 425 | (prog1 |
426 | (nntp-send-command "^\\.\r$" "LIST") | |
427 | (nntp-decode-text) | |
428 | )) | |
429 | ||
b027f415 RS |
430 | (defun nntp-request-list-newsgroups () |
431 | "List newsgroups (defined in NNTP2)." | |
432 | (prog1 | |
433 | (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS") | |
434 | (nntp-decode-text) | |
435 | )) | |
436 | ||
437 | (defun nntp-request-list-distributions () | |
438 | "List distributions (defined in NNTP2)." | |
439 | (prog1 | |
440 | (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS") | |
441 | (nntp-decode-text) | |
442 | )) | |
443 | ||
05328297 | 444 | (defun nntp-request-last () |
b027f415 RS |
445 | "Set current article pointer to the previous article |
446 | in the current news group." | |
05328297 | 447 | (nntp-send-command "^[23].*\r$" "LAST")) |
448 | ||
449 | (defun nntp-request-next () | |
450 | "Advance current article pointer." | |
451 | (nntp-send-command "^[23].*\r$" "NEXT")) | |
452 | ||
453 | (defun nntp-request-post () | |
454 | "Post a new news in current buffer." | |
455 | (if (nntp-send-command "^[23].*\r$" "POST") | |
456 | (progn | |
457 | (nntp-encode-text) | |
458 | (nntp-send-region-to-server (point-min) (point-max)) | |
459 | ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not | |
460 | ;; appended to end of the status message. | |
461 | (nntp-wait-for-response "^[23].*$") | |
462 | ))) | |
463 | ||
464 | (defun nntp-default-sentinel (proc status) | |
465 | "Default sentinel function for NNTP server process." | |
466 | (if (and nntp-server-process | |
467 | (not (nntp-server-opened))) | |
468 | (error "NNTP: Connection closed.") | |
469 | )) | |
470 | ||
471 | ;; Encoding and decoding of NNTP text. | |
472 | ||
473 | (defun nntp-decode-text () | |
474 | "Decode text transmitted by NNTP. | |
475 | 0. Delete status line. | |
476 | 1. Delete `^M' at end of line. | |
477 | 2. Delete `.' at end of buffer (end of text mark). | |
478 | 3. Delete `.' at beginning of line." | |
479 | (save-excursion | |
480 | (set-buffer nntp-server-buffer) | |
481 | ;; Insert newline at end of buffer. | |
482 | (goto-char (point-max)) | |
483 | (if (not (bolp)) | |
484 | (insert "\n")) | |
485 | ;; Delete status line. | |
486 | (goto-char (point-min)) | |
487 | (delete-region (point) (progn (forward-line 1) (point))) | |
488 | ;; Delete `^M' at end of line. | |
489 | ;; (replace-regexp "\r$" "") | |
490 | (while (not (eobp)) | |
491 | (end-of-line) | |
492 | (if (= (preceding-char) ?\r) | |
493 | (delete-char -1)) | |
494 | (forward-line 1) | |
495 | ) | |
496 | ;; Delete `.' at end of buffer (end of text mark). | |
497 | (goto-char (point-max)) | |
498 | (forward-line -1) ;(beginning-of-line) | |
499 | (if (looking-at "^\\.$") | |
500 | (delete-region (point) (progn (forward-line 1) (point)))) | |
501 | ;; Replace `..' at beginning of line with `.'. | |
502 | (goto-char (point-min)) | |
503 | ;; (replace-regexp "^\\.\\." ".") | |
504 | (while (search-forward "\n.." nil t) | |
505 | (delete-char -1)) | |
506 | )) | |
507 | ||
508 | (defun nntp-encode-text () | |
509 | "Encode text in current buffer for NNTP transmission. | |
510 | 1. Insert `.' at beginning of line. | |
511 | 2. Insert `.' at end of buffer (end of text mark)." | |
512 | (save-excursion | |
513 | ;; Insert newline at end of buffer. | |
514 | (goto-char (point-max)) | |
515 | (if (not (bolp)) | |
516 | (insert "\n")) | |
517 | ;; Replace `.' at beginning of line with `..'. | |
518 | (goto-char (point-min)) | |
519 | ;; (replace-regexp "^\\." "..") | |
520 | (while (search-forward "\n." nil t) | |
521 | (insert ".")) | |
522 | ;; Insert `.' at end of buffer (end of text mark). | |
523 | (goto-char (point-max)) | |
1df45374 | 524 | (insert ".\r\n") |
05328297 | 525 | )) |
526 | ||
527 | \f | |
528 | ;;; | |
529 | ;;; Synchronous Communication with NNTP Server. | |
530 | ;;; | |
531 | ||
532 | (defun nntp-send-command (response cmd &rest args) | |
533 | "Wait for server RESPONSE after sending CMD and optional ARGS to server." | |
534 | (save-excursion | |
535 | ;; Clear communication buffer. | |
536 | (set-buffer nntp-server-buffer) | |
537 | (erase-buffer) | |
538 | (apply 'nntp-send-strings-to-server cmd args) | |
539 | (if response | |
540 | (nntp-wait-for-response response) | |
541 | t) | |
542 | )) | |
543 | ||
544 | (defun nntp-wait-for-response (regexp) | |
545 | "Wait for server response which matches REGEXP." | |
546 | (save-excursion | |
547 | (let ((status t) | |
b027f415 RS |
548 | (wait t) |
549 | (dotnum 0) ;Number of "." being displayed. | |
550 | (dotsize ;How often "." displayed. | |
551 | (if (numberp nntp-debug-read) nntp-debug-read 10000))) | |
05328297 | 552 | (set-buffer nntp-server-buffer) |
553 | ;; Wait for status response (RFC977). | |
554 | ;; 1xx - Informative message. | |
555 | ;; 2xx - Command ok. | |
556 | ;; 3xx - Command ok so far, send the rest of it. | |
557 | ;; 4xx - Command was correct, but couldn't be performed for some | |
558 | ;; reason. | |
559 | ;; 5xx - Command unimplemented, or incorrect, or a serious | |
560 | ;; program error occurred. | |
561 | (nntp-accept-response) | |
562 | (while wait | |
563 | (goto-char (point-min)) | |
564 | (cond ((looking-at "[23]") | |
565 | (setq wait nil)) | |
566 | ((looking-at "[45]") | |
567 | (setq status nil) | |
568 | (setq wait nil)) | |
569 | (t (nntp-accept-response)) | |
570 | )) | |
571 | ;; Save status message. | |
572 | (end-of-line) | |
b027f415 | 573 | (setq nntp-status-string |
05328297 | 574 | (buffer-substring (point-min) (point))) |
575 | (if status | |
576 | (progn | |
577 | (setq wait t) | |
578 | (while wait | |
579 | (goto-char (point-max)) | |
580 | (forward-line -1) ;(beginning-of-line) | |
581 | ;;(message (buffer-substring | |
582 | ;; (point) | |
583 | ;; (save-excursion (end-of-line) (point)))) | |
584 | (if (looking-at regexp) | |
585 | (setq wait nil) | |
b027f415 RS |
586 | (if nntp-debug-read |
587 | (let ((newnum (/ (buffer-size) dotsize))) | |
588 | (if (not (= dotnum newnum)) | |
589 | (progn | |
590 | (setq dotnum newnum) | |
591 | (message "NNTP: Reading %s" | |
592 | (make-string dotnum ?.)))))) | |
05328297 | 593 | (nntp-accept-response) |
b027f415 | 594 | ;;(if nntp-debug-read (message "")) |
05328297 | 595 | )) |
b027f415 RS |
596 | ;; Remove "...". |
597 | (if (and nntp-debug-read (> dotnum 0)) | |
598 | (message "")) | |
05328297 | 599 | ;; Successfully received server response. |
600 | t | |
601 | )) | |
602 | ))) | |
603 | ||
604 | \f | |
605 | ;;; | |
606 | ;;; Low-Level Interface to NNTP Server. | |
607 | ;;; | |
608 | ||
609 | (defun nntp-send-strings-to-server (&rest strings) | |
610 | "Send list of STRINGS to news server as command and its arguments." | |
611 | (let ((cmd (car strings)) | |
612 | (strings (cdr strings))) | |
eb8c3be9 | 613 | ;; Command and each argument must be separated by one or more spaces. |
05328297 | 614 | (while strings |
615 | (setq cmd (concat cmd " " (car strings))) | |
616 | (setq strings (cdr strings))) | |
617 | ;; Command line must be terminated by a CR-LF. | |
b027f415 | 618 | (process-send-string nntp-server-process (concat cmd "\r\n")) |
05328297 | 619 | )) |
620 | ||
621 | (defun nntp-send-region-to-server (begin end) | |
622 | "Send current buffer region (from BEGIN to END) to news server." | |
623 | (save-excursion | |
624 | ;; We have to work in the buffer associated with NNTP server | |
625 | ;; process because of NEmacs hack. | |
626 | (copy-to-buffer nntp-server-buffer begin end) | |
627 | (set-buffer nntp-server-buffer) | |
7084ad04 | 628 | (process-send-region nntp-server-process (point-min) (point-max)) |
05328297 | 629 | ;; We cannot erase buffer, because reply may be received. |
630 | (delete-region begin end) | |
631 | )) | |
632 | ||
633 | (defun nntp-open-server-internal (host &optional service) | |
634 | "Open connection to news server on HOST by SERVICE (default is nntp)." | |
635 | (save-excursion | |
636 | ;; Use TCP/IP stream emulation package if needed. | |
637 | (or (fboundp 'open-network-stream) | |
638 | (require 'tcp)) | |
639 | ;; Initialize communication buffer. | |
640 | (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
641 | (set-buffer nntp-server-buffer) | |
642 | (buffer-flush-undo (current-buffer)) | |
643 | (erase-buffer) | |
644 | (kill-all-local-variables) | |
645 | (setq case-fold-search t) ;Should ignore case. | |
646 | (setq nntp-server-process | |
647 | (open-network-stream "nntpd" (current-buffer) | |
648 | host (or service "nntp"))) | |
649 | (setq nntp-server-name host) | |
650 | ;; It is possible to change kanji-fileio-code in this hook. | |
651 | (run-hooks 'nntp-server-hook) | |
652 | ;; Return the server process. | |
653 | nntp-server-process | |
654 | )) | |
655 | ||
656 | (defun nntp-close-server-internal () | |
657 | "Close connection to news server." | |
658 | (if nntp-server-process | |
659 | (delete-process nntp-server-process)) | |
660 | (if nntp-server-buffer | |
661 | (kill-buffer nntp-server-buffer)) | |
662 | (setq nntp-server-buffer nil) | |
663 | (setq nntp-server-process nil)) | |
664 | ||
665 | (defun nntp-accept-response () | |
666 | "Read response of server. | |
667 | It is well-known that the communication speed will be much improved by | |
668 | defining this function as macro." | |
669 | ;; To deal with server process exiting before | |
670 | ;; accept-process-output is called. | |
671 | ;; Suggested by Jason Venner <jason@violet.berkeley.edu>. | |
672 | ;; This is a copy of `nntp-default-sentinel'. | |
673 | (or (memq (process-status nntp-server-process) '(open run)) | |
674 | (error "NNTP: Connection closed.")) | |
675 | (if nntp-buggy-select | |
676 | (progn | |
677 | ;; We cannot use `accept-process-output'. | |
678 | ;; Fujitsu UTS requires messages during sleep-for. I don't know why. | |
679 | (message "NNTP: Reading...") | |
680 | (sleep-for 1) | |
681 | (message "")) | |
682 | (condition-case errorcode | |
683 | (accept-process-output nntp-server-process) | |
684 | (error | |
685 | (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) | |
686 | ;; Ignore select error. | |
687 | nil | |
688 | ) | |
689 | (t | |
690 | (signal (car errorcode) (cdr errorcode)))) | |
691 | )) | |
692 | )) | |
49116ac0 JB |
693 | |
694 | (provide 'nntp) | |
695 | ||
6594deb0 | 696 | ;;; nntp.el ends here |