|
659
|
1 ;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs
|
|
|
2
|
|
2843
|
3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc.
|
|
846
|
4
|
|
790
|
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
|
|
814
|
6 ;; Keywords: news
|
|
790
|
7
|
|
87
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
882
|
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.
|
|
87
|
14
|
|
882
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
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
|
|
87
|
24
|
|
790
|
25 ;;; Commentary:
|
|
|
26
|
|
87
|
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
|
|
10127
|
35 ;; a problems with it, set the variable `nntp-buggy-select' to t.
|
|
87
|
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
|
|
790
|
49 ;;; Code:
|
|
|
50
|
|
87
|
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
|
|
7639
|
57 \(setq nntp-server-hook
|
|
2843
|
58 (function
|
|
|
59 (lambda ()
|
|
87
|
60 ;; Server's Kanji code is EUC (NEmacs hack).
|
|
|
61 (make-local-variable 'kanji-fileio-code)
|
|
2843
|
62 (setq kanji-fileio-code 0))))
|
|
87
|
63
|
|
|
64 If you'd like to change something depending on the server in this
|
|
|
65 hook, use the variable `nntp-server-name'.")
|
|
|
66
|
|
2843
|
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
|
|
10127
|
72
|
|
|
73 (defvar nntp-buggy-select (memq system-type '(fujitsu-uts))
|
|
|
74 "*Non-nil if your select routine is buggy.
|
|
87
|
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
|
|
10127
|
77 case of Fujitsu UTS, it is set to t since `accept-process-output'
|
|
87
|
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
|
|
2843
|
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.")
|
|
87
|
88
|
|
|
89
|
|
2843
|
90 (defconst nntp-version "NNTP 3.12"
|
|
87
|
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
|
|
2843
|
104 (defvar nntp-status-string nil
|
|
87
|
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)
|
|
2843
|
172 "Return references (or in-reply-to) in HEADER."
|
|
87
|
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] ...)'.
|
|
2843
|
183 If there is no References: field, In-Reply-To: field is used instead.
|
|
87
|
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'.
|
|
2843
|
186 Newsgroup must be selected before calling this."
|
|
87
|
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))
|
|
2843
|
226 (message "NNTP: Receiving headers... %d%%"
|
|
87
|
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)
|
|
2843
|
241 (message "NNTP: Receiving headers... done"))
|
|
87
|
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))))
|
|
2843
|
273 (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
|
|
87
|
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))
|
|
2843
|
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))
|
|
87
|
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)"))
|
|
2843
|
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)))
|
|
87
|
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
|
|
|
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))
|
|
2843
|
336 (setq nntp-status-string "")
|
|
87
|
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
|
|
9582
|
342 (progn (set-process-sentinel nntp-server-process
|
|
|
343 'nntp-default-sentinel)
|
|
|
344 (nntp-send-command "^[25].*\r$" "MODE" "READER"))
|
|
87
|
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)
|
|
2843
|
350 (setq nntp-status-string "NNTP server is not specified."))
|
|
87
|
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."
|
|
2843
|
381 (if (and nntp-status-string
|
|
87
|
382 ;; NNN MESSAGE
|
|
|
383 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
|
|
2843
|
384 nntp-status-string))
|
|
|
385 (substring nntp-status-string (match-beginning 1) (match-end 1))
|
|
87
|
386 ;; Empty message if nothing.
|
|
|
387 ""
|
|
|
388 ))
|
|
|
389
|
|
|
390 (defun nntp-request-article (id)
|
|
|
391 "Select article by message ID (or number)."
|
|
11143
|
392 (if (numberp id)
|
|
|
393 (setq id (number-to-string id)))
|
|
87
|
394 (prog1
|
|
|
395 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
|
|
|
396 (nntp-send-command "^\\.\r$" "ARTICLE" id)
|
|
|
397 (nntp-decode-text)
|
|
|
398 ))
|
|
|
399
|
|
|
400 (defun nntp-request-body (id)
|
|
|
401 "Select article body by message ID (or number)."
|
|
|
402 (prog1
|
|
|
403 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
|
|
|
404 (nntp-send-command "^\\.\r$" "BODY" id)
|
|
|
405 (nntp-decode-text)
|
|
|
406 ))
|
|
|
407
|
|
|
408 (defun nntp-request-head (id)
|
|
|
409 "Select article head by message ID (or number)."
|
|
|
410 (prog1
|
|
|
411 (nntp-send-command "^\\.\r$" "HEAD" id)
|
|
|
412 (nntp-decode-text)
|
|
|
413 ))
|
|
|
414
|
|
|
415 (defun nntp-request-stat (id)
|
|
|
416 "Select article by message ID (or number)."
|
|
|
417 (nntp-send-command "^[23].*\r$" "STAT" id))
|
|
|
418
|
|
|
419 (defun nntp-request-group (group)
|
|
|
420 "Select news GROUP."
|
|
|
421 ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
|
|
|
422 ;; end of the status message.
|
|
|
423 (nntp-send-command "^[23].*$" "GROUP" group))
|
|
|
424
|
|
|
425 (defun nntp-request-list ()
|
|
2843
|
426 "List active newsgroups."
|
|
87
|
427 (prog1
|
|
|
428 (nntp-send-command "^\\.\r$" "LIST")
|
|
|
429 (nntp-decode-text)
|
|
|
430 ))
|
|
|
431
|
|
2843
|
432 (defun nntp-request-list-newsgroups ()
|
|
|
433 "List newsgroups (defined in NNTP2)."
|
|
|
434 (prog1
|
|
|
435 (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
|
|
|
436 (nntp-decode-text)
|
|
|
437 ))
|
|
|
438
|
|
|
439 (defun nntp-request-list-distributions ()
|
|
|
440 "List distributions (defined in NNTP2)."
|
|
|
441 (prog1
|
|
|
442 (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
|
|
|
443 (nntp-decode-text)
|
|
|
444 ))
|
|
|
445
|
|
87
|
446 (defun nntp-request-last ()
|
|
2843
|
447 "Set current article pointer to the previous article
|
|
|
448 in the current news group."
|
|
87
|
449 (nntp-send-command "^[23].*\r$" "LAST"))
|
|
|
450
|
|
|
451 (defun nntp-request-next ()
|
|
|
452 "Advance current article pointer."
|
|
|
453 (nntp-send-command "^[23].*\r$" "NEXT"))
|
|
|
454
|
|
|
455 (defun nntp-request-post ()
|
|
|
456 "Post a new news in current buffer."
|
|
|
457 (if (nntp-send-command "^[23].*\r$" "POST")
|
|
|
458 (progn
|
|
|
459 (nntp-encode-text)
|
|
|
460 (nntp-send-region-to-server (point-min) (point-max))
|
|
|
461 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
|
|
|
462 ;; appended to end of the status message.
|
|
|
463 (nntp-wait-for-response "^[23].*$")
|
|
|
464 )))
|
|
|
465
|
|
|
466 (defun nntp-default-sentinel (proc status)
|
|
|
467 "Default sentinel function for NNTP server process."
|
|
|
468 (if (and nntp-server-process
|
|
|
469 (not (nntp-server-opened)))
|
|
|
470 (error "NNTP: Connection closed.")
|
|
|
471 ))
|
|
|
472
|
|
|
473 ;; Encoding and decoding of NNTP text.
|
|
|
474
|
|
|
475 (defun nntp-decode-text ()
|
|
|
476 "Decode text transmitted by NNTP.
|
|
|
477 0. Delete status line.
|
|
|
478 1. Delete `^M' at end of line.
|
|
|
479 2. Delete `.' at end of buffer (end of text mark).
|
|
|
480 3. Delete `.' at beginning of line."
|
|
|
481 (save-excursion
|
|
|
482 (set-buffer nntp-server-buffer)
|
|
|
483 ;; Insert newline at end of buffer.
|
|
|
484 (goto-char (point-max))
|
|
|
485 (if (not (bolp))
|
|
|
486 (insert "\n"))
|
|
|
487 ;; Delete status line.
|
|
|
488 (goto-char (point-min))
|
|
|
489 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
490 ;; Delete `^M' at end of line.
|
|
|
491 ;; (replace-regexp "\r$" "")
|
|
|
492 (while (not (eobp))
|
|
|
493 (end-of-line)
|
|
|
494 (if (= (preceding-char) ?\r)
|
|
|
495 (delete-char -1))
|
|
|
496 (forward-line 1)
|
|
|
497 )
|
|
|
498 ;; Delete `.' at end of buffer (end of text mark).
|
|
|
499 (goto-char (point-max))
|
|
|
500 (forward-line -1) ;(beginning-of-line)
|
|
|
501 (if (looking-at "^\\.$")
|
|
|
502 (delete-region (point) (progn (forward-line 1) (point))))
|
|
|
503 ;; Replace `..' at beginning of line with `.'.
|
|
|
504 (goto-char (point-min))
|
|
|
505 ;; (replace-regexp "^\\.\\." ".")
|
|
|
506 (while (search-forward "\n.." nil t)
|
|
|
507 (delete-char -1))
|
|
|
508 ))
|
|
|
509
|
|
|
510 (defun nntp-encode-text ()
|
|
|
511 "Encode text in current buffer for NNTP transmission.
|
|
|
512 1. Insert `.' at beginning of line.
|
|
|
513 2. Insert `.' at end of buffer (end of text mark)."
|
|
|
514 (save-excursion
|
|
|
515 ;; Insert newline at end of buffer.
|
|
|
516 (goto-char (point-max))
|
|
|
517 (if (not (bolp))
|
|
|
518 (insert "\n"))
|
|
|
519 ;; Replace `.' at beginning of line with `..'.
|
|
|
520 (goto-char (point-min))
|
|
|
521 ;; (replace-regexp "^\\." "..")
|
|
|
522 (while (search-forward "\n." nil t)
|
|
|
523 (insert "."))
|
|
|
524 ;; Insert `.' at end of buffer (end of text mark).
|
|
|
525 (goto-char (point-max))
|
|
5042
|
526 (insert ".\r\n")
|
|
87
|
527 ))
|
|
|
528
|
|
|
529
|
|
|
530 ;;;
|
|
|
531 ;;; Synchronous Communication with NNTP Server.
|
|
|
532 ;;;
|
|
|
533
|
|
|
534 (defun nntp-send-command (response cmd &rest args)
|
|
|
535 "Wait for server RESPONSE after sending CMD and optional ARGS to server."
|
|
|
536 (save-excursion
|
|
|
537 ;; Clear communication buffer.
|
|
|
538 (set-buffer nntp-server-buffer)
|
|
|
539 (erase-buffer)
|
|
|
540 (apply 'nntp-send-strings-to-server cmd args)
|
|
|
541 (if response
|
|
|
542 (nntp-wait-for-response response)
|
|
|
543 t)
|
|
|
544 ))
|
|
|
545
|
|
|
546 (defun nntp-wait-for-response (regexp)
|
|
|
547 "Wait for server response which matches REGEXP."
|
|
|
548 (save-excursion
|
|
|
549 (let ((status t)
|
|
2843
|
550 (wait t)
|
|
|
551 (dotnum 0) ;Number of "." being displayed.
|
|
|
552 (dotsize ;How often "." displayed.
|
|
|
553 (if (numberp nntp-debug-read) nntp-debug-read 10000)))
|
|
87
|
554 (set-buffer nntp-server-buffer)
|
|
|
555 ;; Wait for status response (RFC977).
|
|
|
556 ;; 1xx - Informative message.
|
|
|
557 ;; 2xx - Command ok.
|
|
|
558 ;; 3xx - Command ok so far, send the rest of it.
|
|
|
559 ;; 4xx - Command was correct, but couldn't be performed for some
|
|
|
560 ;; reason.
|
|
|
561 ;; 5xx - Command unimplemented, or incorrect, or a serious
|
|
|
562 ;; program error occurred.
|
|
|
563 (nntp-accept-response)
|
|
|
564 (while wait
|
|
|
565 (goto-char (point-min))
|
|
|
566 (cond ((looking-at "[23]")
|
|
|
567 (setq wait nil))
|
|
|
568 ((looking-at "[45]")
|
|
|
569 (setq status nil)
|
|
|
570 (setq wait nil))
|
|
|
571 (t (nntp-accept-response))
|
|
|
572 ))
|
|
|
573 ;; Save status message.
|
|
|
574 (end-of-line)
|
|
2843
|
575 (setq nntp-status-string
|
|
87
|
576 (buffer-substring (point-min) (point)))
|
|
|
577 (if status
|
|
|
578 (progn
|
|
|
579 (setq wait t)
|
|
|
580 (while wait
|
|
|
581 (goto-char (point-max))
|
|
|
582 (forward-line -1) ;(beginning-of-line)
|
|
|
583 ;;(message (buffer-substring
|
|
|
584 ;; (point)
|
|
|
585 ;; (save-excursion (end-of-line) (point))))
|
|
|
586 (if (looking-at regexp)
|
|
|
587 (setq wait nil)
|
|
2843
|
588 (if nntp-debug-read
|
|
|
589 (let ((newnum (/ (buffer-size) dotsize)))
|
|
|
590 (if (not (= dotnum newnum))
|
|
|
591 (progn
|
|
|
592 (setq dotnum newnum)
|
|
|
593 (message "NNTP: Reading %s"
|
|
|
594 (make-string dotnum ?.))))))
|
|
87
|
595 (nntp-accept-response)
|
|
2843
|
596 ;;(if nntp-debug-read (message ""))
|
|
87
|
597 ))
|
|
2843
|
598 ;; Remove "...".
|
|
|
599 (if (and nntp-debug-read (> dotnum 0))
|
|
|
600 (message ""))
|
|
87
|
601 ;; Successfully received server response.
|
|
|
602 t
|
|
|
603 ))
|
|
|
604 )))
|
|
|
605
|
|
|
606
|
|
|
607 ;;;
|
|
|
608 ;;; Low-Level Interface to NNTP Server.
|
|
|
609 ;;;
|
|
|
610
|
|
|
611 (defun nntp-send-strings-to-server (&rest strings)
|
|
|
612 "Send list of STRINGS to news server as command and its arguments."
|
|
|
613 (let ((cmd (car strings))
|
|
|
614 (strings (cdr strings)))
|
|
3591
|
615 ;; Command and each argument must be separated by one or more spaces.
|
|
87
|
616 (while strings
|
|
|
617 (setq cmd (concat cmd " " (car strings)))
|
|
|
618 (setq strings (cdr strings)))
|
|
|
619 ;; Command line must be terminated by a CR-LF.
|
|
2843
|
620 (process-send-string nntp-server-process (concat cmd "\r\n"))
|
|
87
|
621 ))
|
|
|
622
|
|
|
623 (defun nntp-send-region-to-server (begin end)
|
|
|
624 "Send current buffer region (from BEGIN to END) to news server."
|
|
|
625 (save-excursion
|
|
|
626 ;; We have to work in the buffer associated with NNTP server
|
|
|
627 ;; process because of NEmacs hack.
|
|
|
628 (copy-to-buffer nntp-server-buffer begin end)
|
|
|
629 (set-buffer nntp-server-buffer)
|
|
9066
|
630 (process-send-region nntp-server-process (point-min) (point-max))
|
|
87
|
631 ;; We cannot erase buffer, because reply may be received.
|
|
|
632 (delete-region begin end)
|
|
|
633 ))
|
|
|
634
|
|
|
635 (defun nntp-open-server-internal (host &optional service)
|
|
|
636 "Open connection to news server on HOST by SERVICE (default is nntp)."
|
|
|
637 (save-excursion
|
|
|
638 ;; Use TCP/IP stream emulation package if needed.
|
|
|
639 (or (fboundp 'open-network-stream)
|
|
|
640 (require 'tcp))
|
|
|
641 ;; Initialize communication buffer.
|
|
|
642 (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
|
|
|
643 (set-buffer nntp-server-buffer)
|
|
|
644 (buffer-flush-undo (current-buffer))
|
|
|
645 (erase-buffer)
|
|
|
646 (kill-all-local-variables)
|
|
|
647 (setq case-fold-search t) ;Should ignore case.
|
|
|
648 (setq nntp-server-process
|
|
|
649 (open-network-stream "nntpd" (current-buffer)
|
|
|
650 host (or service "nntp")))
|
|
|
651 (setq nntp-server-name host)
|
|
|
652 ;; It is possible to change kanji-fileio-code in this hook.
|
|
|
653 (run-hooks 'nntp-server-hook)
|
|
|
654 ;; Return the server process.
|
|
|
655 nntp-server-process
|
|
|
656 ))
|
|
|
657
|
|
|
658 (defun nntp-close-server-internal ()
|
|
|
659 "Close connection to news server."
|
|
|
660 (if nntp-server-process
|
|
|
661 (delete-process nntp-server-process))
|
|
|
662 (if nntp-server-buffer
|
|
|
663 (kill-buffer nntp-server-buffer))
|
|
|
664 (setq nntp-server-buffer nil)
|
|
|
665 (setq nntp-server-process nil))
|
|
|
666
|
|
|
667 (defun nntp-accept-response ()
|
|
|
668 "Read response of server.
|
|
|
669 It is well-known that the communication speed will be much improved by
|
|
|
670 defining this function as macro."
|
|
|
671 ;; To deal with server process exiting before
|
|
|
672 ;; accept-process-output is called.
|
|
|
673 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
|
|
|
674 ;; This is a copy of `nntp-default-sentinel'.
|
|
|
675 (or (memq (process-status nntp-server-process) '(open run))
|
|
|
676 (error "NNTP: Connection closed."))
|
|
|
677 (if nntp-buggy-select
|
|
|
678 (progn
|
|
|
679 ;; We cannot use `accept-process-output'.
|
|
|
680 ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
|
|
|
681 (message "NNTP: Reading...")
|
|
|
682 (sleep-for 1)
|
|
|
683 (message ""))
|
|
|
684 (condition-case errorcode
|
|
|
685 (accept-process-output nntp-server-process)
|
|
|
686 (error
|
|
|
687 (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
|
|
|
688 ;; Ignore select error.
|
|
|
689 nil
|
|
|
690 )
|
|
|
691 (t
|
|
|
692 (signal (car errorcode) (cdr errorcode))))
|
|
|
693 ))
|
|
|
694 ))
|
|
584
|
695
|
|
|
696 (provide 'nntp)
|
|
|
697
|
|
659
|
698 ;;; nntp.el ends here
|
