1 ;;; NNTP (RFC977) Interface for GNU Emacs
2 ;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
3 ;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
4 ;; $Header: nntp.el,v 3.10 90/03/23 13:25:27 umerin Locked $
6 ;; This file is part of GNU Emacs.
8 ;; GNU Emacs is distributed in the hope that it will be useful,
9 ;; but WITHOUT ANY WARRANTY. No author or distributor
10 ;; accepts responsibility to anyone for the consequences of using it
11 ;; or for whether it serves any particular purpose or works at all,
12 ;; unless he says so in writing. Refer to the GNU Emacs General Public
13 ;; License for full details.
15 ;; Everyone is granted permission to copy, modify and redistribute
16 ;; GNU Emacs, but only under the conditions described in the
17 ;; GNU Emacs General Public License. A copy of this license is
18 ;; supposed to have been given to you along with GNU Emacs so you
19 ;; can know your rights and responsibilities. It should be in a
20 ;; file named COPYING. Among other things, the copyright notice
21 ;; and this notice must be preserved on all copies.
23 ;; This implementation is tested on both 1.2a and 1.5 version of the
26 ;; Troubleshooting of NNTP
28 ;; (1) Select routine may signal an error or fall into infinite loop
29 ;; while waiting for the server response. In this case, you'd better
30 ;; not use byte-compiled codes but original source. If you still have
31 ;; a problems with it, set the variable `nntp-buggy-select' to T.
33 ;; (2) Emacs may hang up while retrieving headers since too many
34 ;; requests have been sent to the NNTP server without reading their
35 ;; replies. In this case, reduce the number of the requests sent to
36 ;; the server at one time by setting the variable
37 ;; `nntp-maximum-request' to a lower value.
39 ;; (3) If the TCP/IP stream (open-network-stream) is not supported by
40 ;; emacs, compile and install `tcp.el' and `tcp.c' which is an
41 ;; emulation program of the stream. If you modified `tcp.c' for your
42 ;; system, please send me the diffs. I'll include some of them in the
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:
51 (setq nntp-server-hook
53 ;; Server's Kanji code is EUC (NEmacs hack).
54 (make-local-variable 'kanji-fileio-code)
55 (setq kanji-fileio-code 0)))
57 If you'd like to change something depending on the server in this
58 hook, use the variable `nntp-server-name'.")
60 (defvar nntp-buggy-select
(memq system-type
'(usg-unix-v fujitsu-uts
))
61 "*T if your select routine is buggy.
62 If the select routine signals error or fall into infinite loop while
63 waiting for the server response, the variable must be set to t. In
64 case of Fujitsu UTS, it is set to T since `accept-process-output'
65 doesn't work properly.")
67 (defvar nntp-maximum-request
400
68 "*The maximum number of the requests sent to the NNTP server at one time.
69 If Emacs hangs up while retrieving headers, set the variable to a
72 (defvar nntp-large-newsgroup
50
73 "*The number of the articles which indicates a large newsgroup.
74 If the number of the articles is greater than the value, verbose
75 messages will be shown to indicate the current status.")
78 (defconst nntp-version
"NNTP 3.10"
79 "Version numbers of this version of NNTP.")
81 (defvar nntp-server-name nil
82 "The name of the host running NNTP server.")
84 (defvar nntp-server-buffer nil
85 "Buffer associated with NNTP server process.")
87 (defvar nntp-server-process nil
88 "The NNTP server process.
89 You'd better not use this variable in NNTP front-end program but
90 instead use `nntp-server-buffer'.")
92 (defvar nntp-status-message-string nil
93 "Save the server response message.
94 You'd better not use this variable in NNTP front-end program but
95 instead call function `nntp-status-message' to get status message.")
98 ;;; Extended Command for retrieving many headers.
100 ;; Retrieving lots of headers by sending command asynchronously.
101 ;; Access functions to headers are defined as macro.
103 (defmacro nntp-header-number
(header)
104 "Return article number in HEADER."
105 (` (aref (, header
) 0)))
107 (defmacro nntp-set-header-number
(header number
)
108 "Set article number of HEADER to NUMBER."
109 (` (aset (, header
) 0 (, number
))))
111 (defmacro nntp-header-subject
(header)
112 "Return subject string in HEADER."
113 (` (aref (, header
) 1)))
115 (defmacro nntp-set-header-subject
(header subject
)
116 "Set article subject of HEADER to SUBJECT."
117 (` (aset (, header
) 1 (, subject
))))
119 (defmacro nntp-header-from
(header)
120 "Return author string in HEADER."
121 (` (aref (, header
) 2)))
123 (defmacro nntp-set-header-from
(header from
)
124 "Set article author of HEADER to FROM."
125 (` (aset (, header
) 2 (, from
))))
127 (defmacro nntp-header-xref
(header)
128 "Return xref string in HEADER."
129 (` (aref (, header
) 3)))
131 (defmacro nntp-set-header-xref
(header xref
)
132 "Set article xref of HEADER to xref."
133 (` (aset (, header
) 3 (, xref
))))
135 (defmacro nntp-header-lines
(header)
136 "Return lines in HEADER."
137 (` (aref (, header
) 4)))
139 (defmacro nntp-set-header-lines
(header lines
)
140 "Set article lines of HEADER to LINES."
141 (` (aset (, header
) 4 (, lines
))))
143 (defmacro nntp-header-date
(header)
144 "Return date in HEADER."
145 (` (aref (, header
) 5)))
147 (defmacro nntp-set-header-date
(header date
)
148 "Set article date of HEADER to DATE."
149 (` (aset (, header
) 5 (, date
))))
151 (defmacro nntp-header-id
(header)
152 "Return Id in HEADER."
153 (` (aref (, header
) 6)))
155 (defmacro nntp-set-header-id
(header id
)
156 "Set article Id of HEADER to ID."
157 (` (aset (, header
) 6 (, id
))))
159 (defmacro nntp-header-references
(header)
160 "Return references in HEADER."
161 (` (aref (, header
) 7)))
163 (defmacro nntp-set-header-references
(header ref
)
164 "Set article references of HEADER to REF."
165 (` (aset (, header
) 7 (, ref
))))
167 (defun nntp-retrieve-headers (sequence)
168 "Return list of article headers specified by SEQUENCE of article id.
169 The format of list is
170 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
171 Reader macros for the vector are defined as `nntp-header-FIELD'.
172 Writer macros for the vector are defined as `nntp-set-header-FIELD'.
173 News group must be selected before calling me."
175 (set-buffer nntp-server-buffer
)
177 (let ((number (length sequence
))
178 (last-point (point-min))
181 (headers nil
) ;Result list.
190 ;; Send HEAD command.
192 (nntp-send-strings-to-server "HEAD" (car sequence
))
193 (setq sequence
(cdr sequence
))
194 (setq count
(1+ count
))
195 ;; Every 400 header requests we have to read stream in order
196 ;; to avoid deadlock.
197 (if (or (null sequence
) ;All requests have been sent.
198 (zerop (% count nntp-maximum-request
)))
200 (accept-process-output)
202 (goto-char last-point
)
204 (while (re-search-forward "^[0-9]" nil t
)
205 (setq received
(1+ received
)))
206 (setq last-point
(point))
208 ;; If number of headers is greater than 100, give
209 ;; informative messages.
210 (and (numberp nntp-large-newsgroup
)
211 (> number nntp-large-newsgroup
)
212 (zerop (% received
20))
213 (message "NNTP: %d%% of headers received."
214 (/ (* received
100) number
)))
215 (nntp-accept-response))
218 ;; Wait for text of last command.
219 (goto-char (point-max))
220 (re-search-backward "^[0-9]" nil t
)
221 (if (looking-at "^[23]")
223 (goto-char (- (point-max) 3))
224 (not (looking-at "^\\.\r$")))
225 (nntp-accept-response)))
226 (and (numberp nntp-large-newsgroup
)
227 (> number nntp-large-newsgroup
)
228 (message "NNTP: 100%% of headers received."))
229 ;; Now all of replies are received.
230 (setq received number
)
231 ;; First, fold continuation lines.
232 (goto-char (point-min))
233 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t
)
234 (replace-match " " t t
))
235 ;;(delete-non-matching-lines
236 ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]")
237 (and (numberp nntp-large-newsgroup
)
238 (> number nntp-large-newsgroup
)
239 (message "NNTP: Parsing headers..."))
240 ;; Then examines replies.
241 (goto-char (point-min))
243 (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)")
246 (buffer-substring (match-beginning 1) (match-end 1))))
248 (buffer-substring (match-beginning 2) (match-end 2)))
250 ;; Set default value.
256 (setq references nil
)
257 ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
258 (while (and (not (eobp))
259 (not (memq (following-char) '(?
2 ?
3))))
260 (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
261 (let ((s (buffer-substring
262 (match-beginning 2) (match-end 2)))
263 (c (char-after (match-beginning 0))))
264 ;; We don't have to worry about letter case.
265 (cond ((char-equal c ?F
) ;From:
267 ((char-equal c ?S
) ;Subject:
269 ((char-equal c ?D
) ;Date:
271 ((char-equal c ?L
) ;Lines:
272 (setq lines
(string-to-int s
)))
273 ((char-equal c ?X
) ;Xref:
275 ((char-equal c ?R
) ;References:
279 ;; Finished to parse one header.
281 (setq subject
"(None)"))
283 (setq from
"(Unknown User)"))
285 (cons (vector article subject from
287 message-id references
) headers
))
291 (setq received
(1- received
))
292 (and (numberp nntp-large-newsgroup
)
293 (> number nntp-large-newsgroup
)
294 (zerop (% received
20))
295 (message "NNTP: Parsing headers... %d%%"
296 (/ (* received
100) number
)))
298 (and (numberp nntp-large-newsgroup
)
299 (> number nntp-large-newsgroup
)
300 (message "NNTP: Parsing headers... done"))
306 ;;; Raw Interface to Network News Transfer Protocol (RFC977).
309 (defun nntp-open-server (host &optional service
)
310 "Open news server on HOST.
311 If HOST is nil, use value of environment variable `NNTPSERVER'.
312 If optional argument SERVICE is non-nil, open by the service name."
313 (let ((host (or host
(getenv "NNTPSERVER")))
315 (setq nntp-status-message-string
"")
316 (cond ((and host
(nntp-open-server-internal host service
))
317 (setq status
(nntp-wait-for-response "^[23].*\r$"))
318 ;; Do check unexpected close of connection.
319 ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
321 (set-process-sentinel nntp-server-process
322 'nntp-default-sentinel
)
323 ;; We have to close connection here, since function
324 ;; `nntp-server-opened' may return incorrect status.
325 (nntp-close-server-internal)
328 (setq nntp-status-message-string
"NNTP server is not specified."))
333 (defun nntp-close-server ()
337 ;; Un-set default sentinel function before closing connection.
338 (and nntp-server-process
339 (eq 'nntp-default-sentinel
340 (process-sentinel nntp-server-process
))
341 (set-process-sentinel nntp-server-process nil
))
342 ;; We cannot send QUIT command unless the process is running.
343 (if (nntp-server-opened)
344 (nntp-send-command nil
"QUIT"))
346 (nntp-close-server-internal)
349 (fset 'nntp-request-quit
(symbol-function 'nntp-close-server
))
351 (defun nntp-server-opened ()
352 "Return server process status, T or NIL.
353 If the stream is opened, return T, otherwise return NIL."
354 (and nntp-server-process
355 (memq (process-status nntp-server-process
) '(open run
))))
357 (defun nntp-status-message ()
358 "Return server status response as string."
359 (if (and nntp-status-message-string
361 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
362 nntp-status-message-string
))
363 (substring nntp-status-message-string
(match-beginning 1) (match-end 1))
364 ;; Empty message if nothing.
368 (defun nntp-request-article (id)
369 "Select article by message ID (or number)."
371 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
372 (nntp-send-command "^\\.\r$" "ARTICLE" id
)
376 (defun nntp-request-body (id)
377 "Select article body by message ID (or number)."
379 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
380 (nntp-send-command "^\\.\r$" "BODY" id
)
384 (defun nntp-request-head (id)
385 "Select article head by message ID (or number)."
387 (nntp-send-command "^\\.\r$" "HEAD" id
)
391 (defun nntp-request-stat (id)
392 "Select article by message ID (or number)."
393 (nntp-send-command "^[23].*\r$" "STAT" id
))
395 (defun nntp-request-group (group)
397 ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
398 ;; end of the status message.
399 (nntp-send-command "^[23].*$" "GROUP" group
))
401 (defun nntp-request-list ()
402 "List valid newsgoups."
404 (nntp-send-command "^\\.\r$" "LIST")
408 (defun nntp-request-last ()
409 "Set current article pointer to the previous article in the current news group."
410 (nntp-send-command "^[23].*\r$" "LAST"))
412 (defun nntp-request-next ()
413 "Advance current article pointer."
414 (nntp-send-command "^[23].*\r$" "NEXT"))
416 (defun nntp-request-post ()
417 "Post a new news in current buffer."
418 (if (nntp-send-command "^[23].*\r$" "POST")
421 (nntp-send-region-to-server (point-min) (point-max))
422 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
423 ;; appended to end of the status message.
424 (nntp-wait-for-response "^[23].*$")
427 (defun nntp-default-sentinel (proc status
)
428 "Default sentinel function for NNTP server process."
429 (if (and nntp-server-process
430 (not (nntp-server-opened)))
431 (error "NNTP: Connection closed.")
434 ;; Encoding and decoding of NNTP text.
436 (defun nntp-decode-text ()
437 "Decode text transmitted by NNTP.
438 0. Delete status line.
439 1. Delete `^M' at end of line.
440 2. Delete `.' at end of buffer (end of text mark).
441 3. Delete `.' at beginning of line."
443 (set-buffer nntp-server-buffer
)
444 ;; Insert newline at end of buffer.
445 (goto-char (point-max))
448 ;; Delete status line.
449 (goto-char (point-min))
450 (delete-region (point) (progn (forward-line 1) (point)))
451 ;; Delete `^M' at end of line.
452 ;; (replace-regexp "\r$" "")
455 (if (= (preceding-char) ?
\r)
459 ;; Delete `.' at end of buffer (end of text mark).
460 (goto-char (point-max))
461 (forward-line -
1) ;(beginning-of-line)
462 (if (looking-at "^\\.$")
463 (delete-region (point) (progn (forward-line 1) (point))))
464 ;; Replace `..' at beginning of line with `.'.
465 (goto-char (point-min))
466 ;; (replace-regexp "^\\.\\." ".")
467 (while (search-forward "\n.." nil t
)
471 (defun nntp-encode-text ()
472 "Encode text in current buffer for NNTP transmission.
473 1. Insert `.' at beginning of line.
474 2. Insert `.' at end of buffer (end of text mark)."
476 ;; Insert newline at end of buffer.
477 (goto-char (point-max))
480 ;; Replace `.' at beginning of line with `..'.
481 (goto-char (point-min))
482 ;; (replace-regexp "^\\." "..")
483 (while (search-forward "\n." nil t
)
485 ;; Insert `.' at end of buffer (end of text mark).
486 (goto-char (point-max))
492 ;;; Synchronous Communication with NNTP Server.
495 (defun nntp-send-command (response cmd
&rest args
)
496 "Wait for server RESPONSE after sending CMD and optional ARGS to server."
498 ;; Clear communication buffer.
499 (set-buffer nntp-server-buffer
)
501 (apply 'nntp-send-strings-to-server cmd args
)
503 (nntp-wait-for-response response
)
507 (defun nntp-wait-for-response (regexp)
508 "Wait for server response which matches REGEXP."
512 (set-buffer nntp-server-buffer
)
513 ;; Wait for status response (RFC977).
514 ;; 1xx - Informative message.
516 ;; 3xx - Command ok so far, send the rest of it.
517 ;; 4xx - Command was correct, but couldn't be performed for some
519 ;; 5xx - Command unimplemented, or incorrect, or a serious
520 ;; program error occurred.
521 (nntp-accept-response)
523 (goto-char (point-min))
524 (cond ((looking-at "[23]")
529 (t (nntp-accept-response))
531 ;; Save status message.
533 (setq nntp-status-message-string
534 (buffer-substring (point-min) (point)))
539 (goto-char (point-max))
540 (forward-line -
1) ;(beginning-of-line)
541 ;;(message (buffer-substring
543 ;; (save-excursion (end-of-line) (point))))
544 (if (looking-at regexp
)
546 (message "NNTP: Reading...")
547 (nntp-accept-response)
550 ;; Successfully received server response.
557 ;;; Low-Level Interface to NNTP Server.
560 (defun nntp-send-strings-to-server (&rest strings
)
561 "Send list of STRINGS to news server as command and its arguments."
562 (let ((cmd (car strings
))
563 (strings (cdr strings
)))
564 ;; Command and each argument must be separeted by one or more spaces.
566 (setq cmd
(concat cmd
" " (car strings
)))
567 (setq strings
(cdr strings
)))
568 ;; Command line must be terminated by a CR-LF.
569 (process-send-string nntp-server-process
(concat cmd
"\n"))
572 (defun nntp-send-region-to-server (begin end
)
573 "Send current buffer region (from BEGIN to END) to news server."
575 ;; We have to work in the buffer associated with NNTP server
576 ;; process because of NEmacs hack.
577 (copy-to-buffer nntp-server-buffer begin end
)
578 (set-buffer nntp-server-buffer
)
579 (setq begin
(point-min))
580 (setq end
(point-max))
581 ;; `process-send-region' does not work if text to be sent is very
582 ;; large. I don't know maximum size of text sent correctly.
584 (size 100)) ;Size of text sent at once.
586 (narrow-to-region begin end
)
589 ;;(setq last (min end (+ (point) size)))
590 ;; NEmacs gets confused if character at `last' is Kanji.
591 (setq last
(save-excursion
592 (goto-char (min end
(+ (point) size
)))
593 (or (eobp) (forward-char 1)) ;Adjust point
595 (process-send-region nntp-server-process
(point) last
)
596 ;; I don't know whether the next codes solve the known
597 ;; problem of communication error of GNU Emacs.
598 (accept-process-output)
602 ;; We cannot erase buffer, because reply may be received.
603 (delete-region begin end
)
606 (defun nntp-open-server-internal (host &optional service
)
607 "Open connection to news server on HOST by SERVICE (default is nntp)."
609 ;; Use TCP/IP stream emulation package if needed.
610 (or (fboundp 'open-network-stream
)
612 ;; Initialize communication buffer.
613 (setq nntp-server-buffer
(get-buffer-create " *nntpd*"))
614 (set-buffer nntp-server-buffer
)
615 (buffer-flush-undo (current-buffer))
617 (kill-all-local-variables)
618 (setq case-fold-search t
) ;Should ignore case.
619 (setq nntp-server-process
620 (open-network-stream "nntpd" (current-buffer)
621 host
(or service
"nntp")))
622 (setq nntp-server-name host
)
623 ;; It is possible to change kanji-fileio-code in this hook.
624 (run-hooks 'nntp-server-hook
)
625 ;; Return the server process.
629 (defun nntp-close-server-internal ()
630 "Close connection to news server."
631 (if nntp-server-process
632 (delete-process nntp-server-process
))
633 (if nntp-server-buffer
634 (kill-buffer nntp-server-buffer
))
635 (setq nntp-server-buffer nil
)
636 (setq nntp-server-process nil
))
638 (defun nntp-accept-response ()
639 "Read response of server.
640 It is well-known that the communication speed will be much improved by
641 defining this function as macro."
642 ;; To deal with server process exiting before
643 ;; accept-process-output is called.
644 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
645 ;; This is a copy of `nntp-default-sentinel'.
646 (or (memq (process-status nntp-server-process
) '(open run
))
647 (error "NNTP: Connection closed."))
648 (if nntp-buggy-select
650 ;; We cannot use `accept-process-output'.
651 ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
652 (message "NNTP: Reading...")
655 (condition-case errorcode
656 (accept-process-output nntp-server-process
)
658 (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode
))
659 ;; Ignore select error.
663 (signal (car errorcode
) (cdr errorcode
))))