13401
|
1 ;;; nntp.el --- nntp access for Gnus
|
14531
|
2 ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
|
13401
|
3
|
|
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
|
|
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
6 ;; Keywords: news
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
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
|
|
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
|
14169
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
23 ;; Boston, MA 02111-1307, USA.
|
13401
|
24
|
|
25 ;;; Commentary:
|
|
26
|
|
27 ;;; Code:
|
|
28
|
|
29 (require 'nnheader)
|
15511
|
30 (require 'nnoo)
|
|
31 (eval-when-compile (require 'cl))
|
|
32
|
|
33 (nnoo-declare nntp)
|
|
34
|
|
35 (eval-and-compile
|
|
36 (unless (fboundp 'open-network-stream)
|
|
37 (require 'tcp)))
|
13401
|
38
|
|
39 (eval-when-compile (require 'cl))
|
|
40
|
|
41 (eval-and-compile
|
|
42 (autoload 'cancel-timer "timer")
|
|
43 (autoload 'telnet "telnet" nil t)
|
|
44 (autoload 'telnet-send-input "telnet" nil t)
|
|
45 (autoload 'timezone-parse-date "timezone"))
|
|
46
|
15511
|
47 (defvoo nntp-server-hook nil
|
13401
|
48 "*Hooks for the NNTP server.
|
|
49 If the kanji code of the NNTP server is different from the local kanji
|
|
50 code, the correct kanji code of the buffer associated with the NNTP
|
|
51 server must be specified as follows:
|
|
52
|
|
53 \(setq nntp-server-hook
|
|
54 (function
|
|
55 (lambda ()
|
|
56 ;; Server's Kanji code is EUC (NEmacs hack).
|
|
57 (make-local-variable 'kanji-fileio-code)
|
|
58 (setq kanji-fileio-code 0))))
|
|
59
|
|
60 If you'd like to change something depending on the server in this
|
|
61 hook, use the variable `nntp-address'.")
|
|
62
|
15511
|
63 (defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
|
13401
|
64 "*Hook used for sending commands to the server at startup.
|
|
65 The default value is `nntp-send-mode-reader', which makes an innd
|
|
66 server spawn an nnrpd server. Another useful function to put in this
|
|
67 hook might be `nntp-send-authinfo', which will prompt for a password
|
|
68 to allow posting from the server. Note that this is only necessary to
|
|
69 do on servers that use strict access control.")
|
|
70 (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
|
|
71
|
15511
|
72 (defvoo nntp-server-action-alist
|
|
73 '(("nntpd 1\\.5\\.11t"
|
|
74 (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
|
|
75 "Alist of regexps to match on server types and actions to be taken.
|
|
76 For instance, if you want Gnus to beep every time you connect
|
|
77 to innd, you could say something like:
|
|
78
|
|
79 \(setq nntp-server-action-alist
|
|
80 '((\"innd\" (ding))))
|
|
81
|
|
82 You probably don't want to do that, though.")
|
|
83
|
|
84 (defvoo nntp-open-server-function 'nntp-open-network-stream
|
13401
|
85 "*Function used for connecting to a remote system.
|
|
86 It will be called with the address of the remote system.
|
|
87
|
|
88 Two pre-made functions are `nntp-open-network-stream', which is the
|
|
89 default, and simply connects to some port or other on the remote
|
|
90 system (see nntp-port-number). The other is `nntp-open-rlogin', which
|
|
91 does an rlogin on the remote system, and then does a telnet to the
|
|
92 NNTP server available there (see nntp-rlogin-parameters).")
|
|
93
|
15511
|
94 (defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
|
13401
|
95 "*Parameters to `nntp-open-login'.
|
|
96 That function may be used as `nntp-open-server-function'. In that
|
|
97 case, this list will be used as the parameter list given to rsh.")
|
|
98
|
15511
|
99 (defvoo nntp-rlogin-user-name nil
|
13401
|
100 "*User name on remote system when using the rlogin connect method.")
|
|
101
|
15511
|
102 (defvoo nntp-address nil
|
13401
|
103 "*The name of the NNTP server.")
|
|
104
|
15511
|
105 (defvoo nntp-port-number "nntp"
|
13401
|
106 "*Port number to connect to.")
|
|
107
|
15511
|
108 (defvoo nntp-end-of-line "\r\n"
|
|
109 "String to use on the end of lines when talking to the NNTP server.
|
|
110 This is \"\\r\\n\" by default, but should be \"\\n\" when
|
|
111 using rlogin to communicate with the server.")
|
|
112
|
|
113 (defvoo nntp-large-newsgroup 50
|
13401
|
114 "*The number of the articles which indicates a large newsgroup.
|
|
115 If the number of the articles is greater than the value, verbose
|
|
116 messages will be shown to indicate the current status.")
|
|
117
|
15511
|
118 (defvoo nntp-buggy-select (memq system-type '(fujitsu-uts))
|
13401
|
119 "*t if your select routine is buggy.
|
|
120 If the select routine signals error or fall into infinite loop while
|
|
121 waiting for the server response, the variable must be set to t. In
|
|
122 case of Fujitsu UTS, it is set to T since `accept-process-output'
|
|
123 doesn't work properly.")
|
|
124
|
15511
|
125 (defvoo nntp-maximum-request 400
|
13401
|
126 "*The maximum number of the requests sent to the NNTP server at one time.
|
|
127 If Emacs hangs up while retrieving headers, set the variable to a
|
|
128 lower value.")
|
|
129
|
15511
|
130 (defvoo nntp-debug-read 10000
|
13401
|
131 "*Display '...' every 10Kbytes of a message being received if it is non-nil.
|
|
132 If it is a number, dots are displayed per the number.")
|
|
133
|
15511
|
134 (defvoo nntp-nov-is-evil nil
|
13401
|
135 "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
|
|
136
|
15511
|
137 (defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
|
13401
|
138 "*List of strings that are used as commands to fetch NOV lines from a server.
|
|
139 The strings are tried in turn until a positive response is gotten. If
|
|
140 none of the commands are successful, nntp will just grab headers one
|
|
141 by one.")
|
|
142
|
15511
|
143 (defvoo nntp-nov-gap 20
|
13401
|
144 "*Maximum allowed gap between two articles.
|
|
145 If the gap between two consecutive articles is bigger than this
|
|
146 variable, split the XOVER request into two requests.")
|
|
147
|
15511
|
148 (defvoo nntp-connection-timeout nil
|
13401
|
149 "*Number of seconds to wait before an nntp connection times out.
|
|
150 If this variable is nil, which is the default, no timers are set.")
|
|
151
|
15511
|
152 (defvoo nntp-command-timeout nil
|
|
153 "*Number of seconds to wait for a response when sending a command.
|
|
154 If this variable is nil, which is the default, no timers are set.")
|
|
155
|
|
156 (defvoo nntp-retry-on-break nil
|
|
157 "*If non-nil, re-send the command when the user types `C-g'.")
|
|
158
|
|
159 (defvoo nntp-news-default-headers nil
|
13401
|
160 "*If non-nil, override `mail-default-headers' when posting news.")
|
|
161
|
15511
|
162 (defvoo nntp-prepare-server-hook nil
|
13401
|
163 "*Hook run before a server is opened.
|
|
164 If can be used to set up a server remotely, for instance. Say you
|
|
165 have an account at the machine \"other.machine\". This machine has
|
|
166 access to an NNTP server that you can't access locally. You could
|
|
167 then use this hook to rsh to the remote machine and start a proxy NNTP
|
|
168 server there that you can connect to.")
|
|
169
|
15511
|
170 (defvoo nntp-async-number 5
|
13401
|
171 "*How many articles should be prefetched when in asynchronous mode.")
|
|
172
|
15511
|
173 (defvoo nntp-warn-about-losing-connection t
|
|
174 "*If non-nil, beep when a server closes connection.")
|
13401
|
175
|
|
176
|
|
177
|
|
178 (defconst nntp-version "nntp 4.0"
|
|
179 "Version numbers of this version of NNTP.")
|
|
180
|
|
181 (defvar nntp-server-buffer nil
|
|
182 "Buffer associated with the NNTP server process.")
|
|
183
|
15511
|
184 (defvoo nntp-server-process nil
|
13401
|
185 "The NNTP server process.
|
|
186 You'd better not use this variable in NNTP front-end program, but
|
|
187 instead use `nntp-server-buffer'.")
|
|
188
|
15511
|
189 (defvoo nntp-status-string nil
|
|
190 "Save the server response message.")
|
13401
|
191
|
|
192 (defvar nntp-opened-connections nil
|
|
193 "All (possibly) opened connections.")
|
|
194
|
15511
|
195 (defvoo nntp-server-xover 'try)
|
|
196 (defvoo nntp-server-list-active-group 'try)
|
|
197 (defvoo nntp-current-group "")
|
|
198 (defvoo nntp-server-type nil)
|
13401
|
199
|
15511
|
200 (defvoo nntp-async-process nil)
|
|
201 (defvoo nntp-async-buffer nil)
|
|
202 (defvoo nntp-async-articles nil)
|
|
203 (defvoo nntp-async-fetched nil)
|
|
204 (defvoo nntp-async-group-alist nil)
|
13401
|
205
|
|
206
|
|
207 ;;; Interface functions.
|
|
208
|
15511
|
209 (nnoo-define-basics nntp)
|
|
210
|
|
211 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
|
|
212 "Retrieve the headers of ARTICLES."
|
|
213 (nntp-possibly-change-server group server)
|
13401
|
214 (save-excursion
|
|
215 (set-buffer nntp-server-buffer)
|
|
216 (erase-buffer)
|
|
217 (if (and (not gnus-nov-is-evil)
|
|
218 (not nntp-nov-is-evil)
|
15511
|
219 (nntp-retrieve-headers-with-xover articles fetch-old))
|
|
220 ;; We successfully retrieved the headers via XOVER.
|
13401
|
221 'nov
|
15511
|
222 ;; XOVER didn't work, so we do it the hard, slow and inefficient
|
|
223 ;; way.
|
|
224 (let ((number (length articles))
|
13401
|
225 (count 0)
|
|
226 (received 0)
|
15511
|
227 (message-log-max nil)
|
13401
|
228 (last-point (point-min)))
|
|
229 ;; Send HEAD command.
|
15511
|
230 (while articles
|
13401
|
231 (nntp-send-strings-to-server
|
15511
|
232 "HEAD" (if (numberp (car articles))
|
|
233 (int-to-string (car articles))
|
|
234 ;; `articles' is either a list of article numbers
|
|
235 ;; or a list of article IDs.
|
|
236 (car articles)))
|
|
237 (setq articles (cdr articles)
|
13401
|
238 count (1+ count))
|
15511
|
239 ;; Every 400 header requests we have to read the stream in
|
|
240 ;; order to avoid deadlocks.
|
|
241 (when (or (null articles) ;All requests have been sent.
|
|
242 (zerop (% count nntp-maximum-request)))
|
|
243 (nntp-accept-response)
|
|
244 (while (progn
|
|
245 (goto-char last-point)
|
|
246 ;; Count replies.
|
|
247 (while (re-search-forward "^[0-9]" nil t)
|
|
248 (setq received (1+ received)))
|
|
249 (setq last-point (point))
|
|
250 (< received count))
|
|
251 ;; If number of headers is greater than 100, give
|
|
252 ;; informative messages.
|
|
253 (and (numberp nntp-large-newsgroup)
|
|
254 (> number nntp-large-newsgroup)
|
|
255 (zerop (% received 20))
|
|
256 (nnheader-message 7 "NNTP: Receiving headers... %d%%"
|
|
257 (/ (* received 100) number)))
|
|
258 (nntp-accept-response))))
|
13401
|
259 ;; Wait for text of last command.
|
|
260 (goto-char (point-max))
|
|
261 (re-search-backward "^[0-9]" nil t)
|
15511
|
262 (when (looking-at "^[23]")
|
|
263 (while (progn
|
|
264 (goto-char (- (point-max) 3))
|
|
265 (not (looking-at "^\\.\r?\n")))
|
|
266 (nntp-accept-response)))
|
13401
|
267 (and (numberp nntp-large-newsgroup)
|
|
268 (> number nntp-large-newsgroup)
|
15511
|
269 (nnheader-message 7 "NNTP: Receiving headers...done"))
|
13401
|
270
|
15511
|
271 ;; Now all of replies are received. Fold continuation lines.
|
|
272 (nnheader-fold-continuation-lines)
|
|
273 ;; Remove all "\r"'s.
|
13401
|
274 (goto-char (point-min))
|
|
275 (while (search-forward "\r" nil t)
|
15511
|
276 (replace-match "" t t))
|
13401
|
277 'headers))))
|
|
278
|
|
279
|
15511
|
280 (deffoo nntp-retrieve-groups (groups &optional server)
|
|
281 "Retrieve group info on GROUPS."
|
13401
|
282 (nntp-possibly-change-server nil server)
|
|
283 (save-excursion
|
|
284 (set-buffer nntp-server-buffer)
|
15511
|
285 ;; The first time this is run, this variable is `try'. So we
|
|
286 ;; try.
|
|
287 (when (eq nntp-server-list-active-group 'try)
|
|
288 (nntp-try-list-active (car groups)))
|
13401
|
289 (erase-buffer)
|
|
290 (let ((count 0)
|
|
291 (received 0)
|
|
292 (last-point (point-min))
|
15511
|
293 (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
|
13401
|
294 (while groups
|
15511
|
295 ;; Send the command to the server.
|
13401
|
296 (nntp-send-strings-to-server command (car groups))
|
|
297 (setq groups (cdr groups))
|
|
298 (setq count (1+ count))
|
|
299 ;; Every 400 requests we have to read the stream in
|
|
300 ;; order to avoid deadlocks.
|
15511
|
301 (when (or (null groups) ;All requests have been sent.
|
|
302 (zerop (% count nntp-maximum-request)))
|
|
303 (nntp-accept-response)
|
|
304 (while (progn
|
|
305 (goto-char last-point)
|
|
306 ;; Count replies.
|
|
307 (while (re-search-forward "^[0-9]" nil t)
|
|
308 (setq received (1+ received)))
|
|
309 (setq last-point (point))
|
|
310 (< received count))
|
|
311 (nntp-accept-response))))
|
13401
|
312
|
|
313 ;; Wait for the reply from the final command.
|
15511
|
314 (when nntp-server-list-active-group
|
|
315 (goto-char (point-max))
|
|
316 (re-search-backward "^[0-9]" nil t)
|
|
317 (when (looking-at "^[23]")
|
|
318 (while (progn
|
|
319 (goto-char (- (point-max) 3))
|
|
320 (not (looking-at "^\\.\r?\n")))
|
|
321 (nntp-accept-response))))
|
13401
|
322
|
|
323 ;; Now all replies are received. We remove CRs.
|
|
324 (goto-char (point-min))
|
|
325 (while (search-forward "\r" nil t)
|
|
326 (replace-match "" t t))
|
|
327
|
15511
|
328 (if (not nntp-server-list-active-group)
|
|
329 'group
|
|
330 ;; We have read active entries, so we just delete the
|
|
331 ;; superfluos gunk.
|
|
332 (goto-char (point-min))
|
|
333 (while (re-search-forward "^[.2-5]" nil t)
|
|
334 (delete-region (match-beginning 0)
|
|
335 (progn (forward-line 1) (point))))
|
|
336 'active))))
|
13401
|
337
|
15511
|
338 (deffoo nntp-open-server (server &optional defs connectionless)
|
13588
|
339 "Open the virtual server SERVER.
|
|
340 If CONNECTIONLESS is non-nil, don't attempt to connect to any physical
|
|
341 servers."
|
15511
|
342 ;; Called with just a port number as the defs.
|
|
343 (when (or (stringp (car defs))
|
|
344 (numberp (car defs)))
|
|
345 (setq defs `((nntp-port-number ,(car defs)))))
|
|
346 (unless (assq 'nntp-address defs)
|
|
347 (setq defs (append defs `((nntp-address ,server)))))
|
|
348 (nnoo-change-server 'nntp server defs)
|
13401
|
349 (if (nntp-server-opened server)
|
|
350 t
|
15511
|
351 (or (nntp-server-opened server)
|
|
352 connectionless
|
|
353 (prog2
|
|
354 (run-hooks 'nntp-prepare-server-hook)
|
|
355 (nntp-open-server-semi-internal nntp-address nntp-port-number)
|
|
356 (nnheader-insert "")))))
|
13401
|
357
|
15511
|
358 (deffoo nntp-close-server (&optional server)
|
13401
|
359 "Close connection to SERVER."
|
13588
|
360 (nntp-possibly-change-server nil server t)
|
13401
|
361 (unwind-protect
|
|
362 (progn
|
|
363 ;; Un-set default sentinel function before closing connection.
|
|
364 (and nntp-server-process
|
|
365 (eq 'nntp-default-sentinel
|
|
366 (process-sentinel nntp-server-process))
|
|
367 (set-process-sentinel nntp-server-process nil))
|
|
368 ;; We cannot send QUIT command unless the process is running.
|
15511
|
369 (when (nntp-server-opened server)
|
|
370 (nntp-send-command nil "QUIT")
|
|
371 ;; Give the QUIT time to arrive.
|
|
372 (sleep-for 1)))
|
|
373 (nntp-close-server-internal server)))
|
13401
|
374
|
15511
|
375 (deffoo nntp-request-close ()
|
13401
|
376 "Close all server connections."
|
|
377 (let (proc)
|
|
378 (while nntp-opened-connections
|
15511
|
379 (when (setq proc (pop nntp-opened-connections))
|
|
380 ;; Un-set default sentinel function before closing connection.
|
|
381 (when (eq 'nntp-default-sentinel (process-sentinel proc))
|
|
382 (set-process-sentinel proc nil))
|
|
383 (condition-case ()
|
|
384 (process-send-string proc (concat "QUIT" nntp-end-of-line))
|
|
385 (error nil))
|
|
386 ;; Give the QUIT time to reach the server before we close
|
|
387 ;; down the process.
|
|
388 (sleep-for 1)
|
|
389 (delete-process proc)))
|
13401
|
390 (and nntp-async-buffer
|
15511
|
391 (buffer-name nntp-async-buffer)
|
13401
|
392 (kill-buffer nntp-async-buffer))
|
15511
|
393 (let ((alist (cddr (assq 'nntp nnoo-state-alist)))
|
|
394 entry)
|
|
395 (while (setq entry (pop alist))
|
|
396 (and (setq proc (cdr (assq 'nntp-async-buffer entry)))
|
|
397 (buffer-name proc)
|
|
398 (kill-buffer proc))))
|
|
399 (nnoo-close-server 'nntp)
|
|
400 (setq nntp-async-group-alist nil
|
|
401 nntp-async-articles nil)))
|
13401
|
402
|
15511
|
403 (deffoo nntp-server-opened (&optional server)
|
13401
|
404 "Say whether a connection to SERVER has been opened."
|
15511
|
405 (and (nnoo-current-server-p 'nntp server)
|
13401
|
406 nntp-server-buffer
|
|
407 (buffer-name nntp-server-buffer)
|
|
408 nntp-server-process
|
|
409 (memq (process-status nntp-server-process) '(open run))))
|
|
410
|
15511
|
411 (deffoo nntp-status-message (&optional server)
|
13401
|
412 "Return server status as a string."
|
|
413 (if (and nntp-status-string
|
|
414 ;; NNN MESSAGE
|
|
415 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
|
|
416 nntp-status-string))
|
|
417 (substring nntp-status-string (match-beginning 1) (match-end 1))
|
|
418 ;; Empty message if nothing.
|
|
419 (or nntp-status-string "")))
|
|
420
|
15511
|
421 (deffoo nntp-request-article (id &optional group server buffer)
|
|
422 "Request article ID (Message-ID or number)."
|
|
423 (nntp-possibly-change-server group server)
|
13401
|
424
|
|
425 (let (found)
|
|
426
|
|
427 ;; First we see whether we can get the article from the async buffer.
|
15511
|
428 (when (and (numberp id)
|
|
429 nntp-async-articles
|
|
430 (memq id nntp-async-fetched))
|
|
431 (save-excursion
|
|
432 (set-buffer nntp-async-buffer)
|
|
433 (let ((opoint (point))
|
|
434 (art (if (numberp id) (int-to-string id) id))
|
|
435 beg end)
|
|
436 (when (and (or (re-search-forward (concat "^2.. +" art) nil t)
|
13401
|
437 (progn
|
|
438 (goto-char (point-min))
|
|
439 (re-search-forward (concat "^2.. +" art) opoint t)))
|
|
440 (progn
|
|
441 (beginning-of-line)
|
|
442 (setq beg (point)
|
|
443 end (re-search-forward "^\\.\r?\n" nil t))))
|
15511
|
444 (setq found t)
|
|
445 (save-excursion
|
|
446 (set-buffer (or buffer nntp-server-buffer))
|
|
447 (erase-buffer)
|
|
448 (insert-buffer-substring nntp-async-buffer beg end)
|
|
449 (let ((nntp-server-buffer (current-buffer)))
|
|
450 (nntp-decode-text)))
|
|
451 (delete-region beg end)
|
|
452 (when nntp-async-articles
|
|
453 (nntp-async-fetch-articles id))))))
|
13401
|
454
|
|
455 (if found
|
15511
|
456 id
|
13401
|
457 ;; The article was not in the async buffer, so we fetch it now.
|
|
458 (unwind-protect
|
|
459 (progn
|
|
460 (if buffer (set-process-buffer nntp-server-process buffer))
|
|
461 (let ((nntp-server-buffer (or buffer nntp-server-buffer))
|
|
462 (art (or (and (numberp id) (int-to-string id)) id)))
|
|
463 (prog1
|
15511
|
464 (and (nntp-send-command
|
|
465 ;; A bit odd regexp to ensure working over rlogin.
|
|
466 "^\\.\r?\n" "ARTICLE" art)
|
|
467 (if (numberp id)
|
|
468 (cons nntp-current-group id)
|
|
469 ;; We find out what the article number was.
|
|
470 (nntp-find-group-and-number)))
|
13401
|
471 (nntp-decode-text)
|
|
472 (and nntp-async-articles (nntp-async-fetch-articles id)))))
|
15511
|
473 (when buffer
|
|
474 (set-process-buffer nntp-server-process nntp-server-buffer))))))
|
13401
|
475
|
15511
|
476 (deffoo nntp-request-body (id &optional group server)
|
|
477 "Request body of article ID (Message-ID or number)."
|
|
478 (nntp-possibly-change-server group server)
|
13401
|
479 (prog1
|
|
480 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
|
|
481 (nntp-send-command
|
|
482 "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
|
|
483 (nntp-decode-text)))
|
|
484
|
15511
|
485 (deffoo nntp-request-head (id &optional group server)
|
|
486 "Request head of article ID (Message-ID or number)."
|
|
487 (nntp-possibly-change-server group server)
|
13401
|
488 (prog1
|
15511
|
489 (when (nntp-send-command
|
|
490 "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id))
|
|
491 (if (numberp id) id
|
|
492 ;; We find out what the article number was.
|
|
493 (nntp-find-group-and-number)))
|
|
494 (nntp-decode-text)
|
|
495 (save-excursion
|
|
496 (set-buffer nntp-server-buffer)
|
|
497 (nnheader-fold-continuation-lines))))
|
13401
|
498
|
15511
|
499 (deffoo nntp-request-stat (id &optional group server)
|
|
500 "Request STAT of article ID (Message-ID or number)."
|
|
501 (nntp-possibly-change-server group server)
|
13401
|
502 (nntp-send-command
|
|
503 "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
|
|
504
|
15511
|
505 (deffoo nntp-request-type (group &optional article)
|
|
506 'news)
|
|
507
|
|
508 (deffoo nntp-request-group (group &optional server dont-check)
|
13401
|
509 "Select GROUP."
|
15511
|
510 (nntp-possibly-change-server nil server)
|
|
511 (setq nntp-current-group
|
|
512 (when (nntp-send-command "^2.*\r?\n" "GROUP" group)
|
|
513 group)))
|
13401
|
514
|
15511
|
515 (deffoo nntp-request-asynchronous (group &optional server articles)
|
|
516 "Enable pre-fetch in GROUP."
|
|
517 (when nntp-async-articles
|
|
518 (nntp-async-request-group group))
|
|
519 (when nntp-async-number
|
|
520 (if (not (or (nntp-async-server-opened)
|
|
521 (nntp-async-open-server)))
|
|
522 ;; Couldn't open the second connection
|
|
523 (progn
|
|
524 (message "Can't open second connection to %s" nntp-address)
|
|
525 (ding)
|
|
526 (setq nntp-async-articles nil)
|
|
527 (sit-for 2))
|
|
528 ;; We opened the second connection (or it was opened already).
|
|
529 (setq nntp-async-articles articles)
|
|
530 (setq nntp-async-fetched nil)
|
|
531 ;; Clear any old data.
|
|
532 (save-excursion
|
|
533 (set-buffer nntp-async-buffer)
|
|
534 (erase-buffer))
|
|
535 ;; Select the correct current group on this server.
|
|
536 (nntp-async-send-strings "GROUP" group)
|
|
537 t)))
|
13401
|
538
|
15511
|
539 (deffoo nntp-list-active-group (group &optional server)
|
|
540 "Return the active info on GROUP (which can be a regexp."
|
|
541 (nntp-possibly-change-server group server)
|
13401
|
542 (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
|
|
543
|
15511
|
544 (deffoo nntp-request-group-description (group &optional server)
|
|
545 "Get the description of GROUP."
|
13588
|
546 (nntp-possibly-change-server nil server)
|
|
547 (prog1
|
|
548 (nntp-send-command "^.*\r?\n" "XGTITLE" group)
|
|
549 (nntp-decode-text)))
|
13401
|
550
|
15511
|
551 (deffoo nntp-close-group (group &optional server)
|
|
552 "Close GROUP."
|
13401
|
553 (setq nntp-current-group nil)
|
|
554 t)
|
|
555
|
15511
|
556 (deffoo nntp-request-list (&optional server)
|
|
557 "List all active groups."
|
13401
|
558 (nntp-possibly-change-server nil server)
|
|
559 (prog1
|
|
560 (nntp-send-command "^\\.\r?\n" "LIST")
|
|
561 (nntp-decode-text)))
|
|
562
|
15511
|
563 (deffoo nntp-request-list-newsgroups (&optional server)
|
|
564 "Get descriptions on all groups on SERVER."
|
13401
|
565 (nntp-possibly-change-server nil server)
|
|
566 (prog1
|
|
567 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS")
|
|
568 (nntp-decode-text)))
|
|
569
|
15511
|
570 (deffoo nntp-request-newgroups (date &optional server)
|
|
571 "List groups that have arrived since DATE."
|
13401
|
572 (nntp-possibly-change-server nil server)
|
|
573 (let* ((date (timezone-parse-date date))
|
|
574 (time-string
|
|
575 (format "%s%02d%02d %s%s%s"
|
|
576 (substring (aref date 0) 2) (string-to-int (aref date 1))
|
|
577 (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
|
|
578 (substring
|
|
579 (aref date 3) 3 5) (substring (aref date 3) 6 8))))
|
|
580 (prog1
|
|
581 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
|
|
582 (nntp-decode-text))))
|
|
583
|
15511
|
584 (deffoo nntp-request-list-distributions (&optional server)
|
13401
|
585 "List distributions."
|
|
586 (nntp-possibly-change-server nil server)
|
|
587 (prog1
|
|
588 (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS")
|
|
589 (nntp-decode-text)))
|
|
590
|
15511
|
591 (deffoo nntp-request-last (&optional group server)
|
13401
|
592 "Decrease the current article pointer."
|
15511
|
593 (nntp-possibly-change-server group server)
|
13401
|
594 (nntp-send-command "^[23].*\r?\n" "LAST"))
|
|
595
|
15511
|
596 (deffoo nntp-request-next (&optional group server)
|
13401
|
597 "Advance the current article pointer."
|
15511
|
598 (nntp-possibly-change-server group server)
|
13401
|
599 (nntp-send-command "^[23].*\r?\n" "NEXT"))
|
|
600
|
15511
|
601 (deffoo nntp-request-post (&optional server)
|
13401
|
602 "Post the current buffer."
|
|
603 (nntp-possibly-change-server nil server)
|
15511
|
604 (when (nntp-send-command "^[23].*\r?\n" "POST")
|
|
605 (nnheader-insert "")
|
|
606 (nntp-encode-text)
|
|
607 (nntp-send-region-to-server (point-min) (point-max))
|
|
608 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
|
|
609 ;; appended to end of the status message.
|
|
610 (nntp-wait-for-response "^[23].*\n")))
|
13401
|
611
|
|
612 ;;; Internal functions.
|
|
613
|
|
614 (defun nntp-send-mode-reader ()
|
|
615 "Send the MODE READER command to the nntp server.
|
|
616 This function is supposed to be called from `nntp-server-opened-hook'.
|
|
617 It will make innd servers spawn an nnrpd process to allow actual article
|
|
618 reading."
|
|
619 (nntp-send-command "^.*\r?\n" "MODE READER"))
|
|
620
|
15511
|
621 (defun nntp-send-nosy-authinfo ()
|
|
622 "Send the AUTHINFO to the nntp server.
|
|
623 This function is supposed to be called from `nntp-server-opened-hook'.
|
|
624 It will prompt for a password."
|
|
625 (nntp-send-command "^.*\r?\n" "AUTHINFO USER"
|
|
626 (read-string "NNTP user name: "))
|
|
627 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
|
|
628 (read-string "NNTP password: ")))
|
|
629
|
13401
|
630 (defun nntp-send-authinfo ()
|
|
631 "Send the AUTHINFO to the nntp server.
|
|
632 This function is supposed to be called from `nntp-server-opened-hook'.
|
|
633 It will prompt for a password."
|
|
634 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
|
|
635 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
|
|
636 (read-string "NNTP password: ")))
|
|
637
|
|
638 (defun nntp-send-authinfo-from-file ()
|
|
639 "Send the AUTHINFO to the nntp server.
|
|
640 This function is supposed to be called from `nntp-server-opened-hook'.
|
|
641 It will prompt for a password."
|
15511
|
642 (when (file-exists-p "~/.nntp-authinfo")
|
|
643 (save-excursion
|
|
644 (set-buffer (get-buffer-create " *authinfo*"))
|
|
645 (buffer-disable-undo (current-buffer))
|
|
646 (erase-buffer)
|
|
647 (insert-file-contents "~/.nntp-authinfo")
|
|
648 (goto-char (point-min))
|
|
649 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
|
|
650 (nntp-send-command
|
|
651 "^.*\r?\n" "AUTHINFO PASS"
|
|
652 (buffer-substring (point) (progn (end-of-line) (point))))
|
|
653 (kill-buffer (current-buffer)))))
|
13401
|
654
|
|
655 (defun nntp-default-sentinel (proc status)
|
|
656 "Default sentinel function for NNTP server process."
|
15511
|
657 (let ((servers (cddr (assq 'nntp nnoo-state-alist)))
|
13401
|
658 server)
|
|
659 ;; Go through the alist of server names and find the name of the
|
|
660 ;; server that the process that sent the signal is connected to.
|
|
661 ;; If you get my drift.
|
|
662 (if (equal proc nntp-server-process)
|
|
663 (setq server nntp-address)
|
|
664 (while (and servers
|
15511
|
665 (not (equal proc (cdr (assq 'nntp-server-process
|
|
666 (car servers))))))
|
13401
|
667 (setq servers (cdr servers)))
|
15511
|
668 (setq server (caar servers)))
|
|
669 (when (and server
|
|
670 nntp-warn-about-losing-connection)
|
|
671 (nnheader-message 3 "nntp: Connection closed to server %s" server)
|
|
672 (setq nntp-current-group "")
|
|
673 (ding))))
|
13401
|
674
|
|
675 (defun nntp-kill-connection (server)
|
15511
|
676 "Choke the connection to SERVER."
|
|
677 (let ((proc (cdr (assq 'nntp-server-process
|
|
678 (assoc server (cddr
|
|
679 (assq 'nntp nnoo-state-alist)))))))
|
|
680 (when proc
|
|
681 (delete-process (process-name proc)))
|
13401
|
682 (nntp-close-server server)
|
15511
|
683 (nnheader-report
|
|
684 'nntp (message "Connection timed out to server %s" server))
|
13401
|
685 (ding)
|
|
686 (sit-for 1)))
|
|
687
|
|
688 ;; Encoding and decoding of NNTP text.
|
|
689
|
|
690 (defun nntp-decode-text ()
|
|
691 "Decode text transmitted by NNTP.
|
|
692 0. Delete status line.
|
|
693 1. Delete `^M' at end of line.
|
|
694 2. Delete `.' at end of buffer (end of text mark).
|
|
695 3. Delete `.' at beginning of line."
|
|
696 (save-excursion
|
|
697 (set-buffer nntp-server-buffer)
|
|
698 ;; Insert newline at end of buffer.
|
|
699 (goto-char (point-max))
|
|
700 (or (bolp) (insert "\n"))
|
|
701 ;; Delete status line.
|
15511
|
702 (delete-region (goto-char (point-min)) (progn (forward-line 1) (point)))
|
|
703 ;; Delete `^M's.
|
|
704 (while (search-forward "\r" nil t)
|
|
705 (replace-match "" t t))
|
13401
|
706 ;; Delete `.' at end of the buffer (end of text mark).
|
|
707 (goto-char (point-max))
|
|
708 (forward-line -1)
|
15511
|
709 (when (looking-at "^\\.\n")
|
|
710 (delete-region (point) (progn (forward-line 1) (point))))
|
13401
|
711 ;; Replace `..' at beginning of line with `.'.
|
|
712 (goto-char (point-min))
|
|
713 ;; (replace-regexp "^\\.\\." ".")
|
|
714 (while (search-forward "\n.." nil t)
|
|
715 (delete-char -1))))
|
|
716
|
|
717 (defun nntp-encode-text ()
|
|
718 "Encode text in current buffer for NNTP transmission.
|
|
719 1. Insert `.' at beginning of line.
|
|
720 2. Insert `.' at end of buffer (end of text mark)."
|
|
721 (save-excursion
|
|
722 ;; Replace `.' at beginning of line with `..'.
|
|
723 (goto-char (point-min))
|
|
724 (while (search-forward "\n." nil t)
|
|
725 (insert "."))
|
15511
|
726 (goto-char (point-max))
|
|
727 ;; Insert newline at end of buffer.
|
|
728 (or (bolp) (insert "\n"))
|
13401
|
729 ;; Insert `.' at end of buffer (end of text mark).
|
15511
|
730 (insert "." nntp-end-of-line)))
|
13401
|
731
|
|
732
|
|
733 ;;;
|
15511
|
734 ;;; Synchronous Communication with NNTP servers.
|
13401
|
735 ;;;
|
|
736
|
15511
|
737 (defvar nntp-retry-command)
|
|
738
|
13401
|
739 (defun nntp-send-command (response cmd &rest args)
|
|
740 "Wait for server RESPONSE after sending CMD and optional ARGS to server."
|
15511
|
741 (let ((timer
|
|
742 (and nntp-command-timeout
|
|
743 (nnheader-run-at-time
|
|
744 nntp-command-timeout nil 'nntp-kill-command
|
|
745 (nnoo-current-server 'nntp))))
|
|
746 (nntp-retry-command t)
|
|
747 result)
|
|
748 (unwind-protect
|
|
749 (save-excursion
|
|
750 (while nntp-retry-command
|
|
751 (setq nntp-retry-command nil)
|
|
752 ;; Clear communication buffer.
|
|
753 (set-buffer nntp-server-buffer)
|
|
754 (widen)
|
|
755 (erase-buffer)
|
|
756 (if nntp-retry-on-break
|
|
757 (condition-case ()
|
|
758 (progn
|
|
759 (apply 'nntp-send-strings-to-server cmd args)
|
|
760 (setq result
|
|
761 (if response
|
|
762 (nntp-wait-for-response response)
|
|
763 t)))
|
|
764 (quit (setq nntp-retry-command t)))
|
|
765 (apply 'nntp-send-strings-to-server cmd args)
|
|
766 (setq result
|
|
767 (if response
|
|
768 (nntp-wait-for-response response)
|
|
769 t))))
|
|
770 result)
|
|
771 (when timer
|
|
772 (nnheader-cancel-timer timer)))))
|
|
773
|
|
774 (defun nntp-kill-command (server)
|
|
775 "Kill and restart the connection to SERVER."
|
|
776 (let ((proc (cdr (assq
|
|
777 'nntp-server-process
|
|
778 (assoc server (cddr (assq 'nntp nnoo-state-alist)))))))
|
|
779 (when proc
|
|
780 (delete-process (process-name proc)))
|
|
781 (nntp-close-server server)
|
|
782 (nntp-open-server server)
|
|
783 (when nntp-current-group
|
|
784 (nntp-request-group nntp-current-group))
|
|
785 (setq nntp-retry-command t)))
|
|
786
|
|
787 (defun nntp-send-command-old (response cmd &rest args)
|
|
788 "Wait for server RESPONSE after sending CMD and optional ARGS to server."
|
13401
|
789 (save-excursion
|
|
790 ;; Clear communication buffer.
|
|
791 (set-buffer nntp-server-buffer)
|
|
792 (erase-buffer)
|
|
793 (apply 'nntp-send-strings-to-server cmd args)
|
|
794 (if response
|
|
795 (nntp-wait-for-response response)
|
|
796 t)))
|
|
797
|
|
798 (defun nntp-wait-for-response (regexp &optional slow)
|
|
799 "Wait for server response which matches REGEXP."
|
|
800 (save-excursion
|
|
801 (let ((status t)
|
|
802 (wait t)
|
|
803 (dotnum 0) ;Number of "." being displayed.
|
|
804 (dotsize ;How often "." displayed.
|
|
805 (if (numberp nntp-debug-read) nntp-debug-read 10000)))
|
|
806 (set-buffer nntp-server-buffer)
|
|
807 ;; Wait for status response (RFC977).
|
|
808 ;; 1xx - Informative message.
|
|
809 ;; 2xx - Command ok.
|
|
810 ;; 3xx - Command ok so far, send the rest of it.
|
|
811 ;; 4xx - Command was correct, but couldn't be performed for some
|
|
812 ;; reason.
|
|
813 ;; 5xx - Command unimplemented, or incorrect, or a serious
|
|
814 ;; program error occurred.
|
|
815 (nntp-accept-response)
|
|
816 (while wait
|
|
817 (goto-char (point-min))
|
|
818 (if slow
|
|
819 (progn
|
|
820 (cond ((re-search-forward "^[23][0-9][0-9]" nil t)
|
|
821 (setq wait nil))
|
|
822 ((re-search-forward "^[45][0-9][0-9]" nil t)
|
|
823 (setq status nil)
|
|
824 (setq wait nil))
|
|
825 (t (nntp-accept-response)))
|
|
826 (if (not wait) (delete-region (point-min)
|
|
827 (progn (beginning-of-line)
|
|
828 (point)))))
|
|
829 (cond ((looking-at "[23]")
|
|
830 (setq wait nil))
|
|
831 ((looking-at "[45]")
|
|
832 (setq status nil)
|
|
833 (setq wait nil))
|
|
834 (t (nntp-accept-response)))))
|
|
835 ;; Save status message.
|
|
836 (end-of-line)
|
|
837 (setq nntp-status-string
|
15511
|
838 (nnheader-replace-chars-in-string
|
|
839 (buffer-substring (point-min) (point)) ?\r ? ))
|
|
840 (when status
|
|
841 (setq wait t)
|
|
842 (while wait
|
|
843 (goto-char (point-max))
|
|
844 (if (bolp) (forward-line -1) (beginning-of-line))
|
|
845 (if (looking-at regexp)
|
|
846 (setq wait nil)
|
|
847 (when nntp-debug-read
|
|
848 (let ((newnum (/ (buffer-size) dotsize))
|
|
849 (message-log-max nil))
|
|
850 (unless (= dotnum newnum)
|
|
851 (setq dotnum newnum)
|
|
852 (nnheader-message 7 "NNTP: Reading %s"
|
|
853 (make-string dotnum ?.)))))
|
|
854 (nntp-accept-response)))
|
|
855 ;; Remove "...".
|
|
856 (when (and nntp-debug-read (> dotnum 0))
|
|
857 (message ""))
|
|
858 ;; Successfully received server response.
|
|
859 t))))
|
13401
|
860
|
|
861
|
|
862
|
|
863 ;;;
|
|
864 ;;; Low-Level Interface to NNTP Server.
|
|
865 ;;;
|
|
866
|
15511
|
867 (defun nntp-find-group-and-number ()
|
|
868 (save-excursion
|
|
869 (save-restriction
|
|
870 (set-buffer nntp-server-buffer)
|
|
871 (narrow-to-region (goto-char (point-min))
|
|
872 (or (search-forward "\n\n" nil t) (point-max)))
|
|
873 (goto-char (point-min))
|
|
874 ;; We first find the number by looking at the status line.
|
|
875 (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
|
|
876 (string-to-int
|
|
877 (buffer-substring (match-beginning 1)
|
|
878 (match-end 1)))))
|
|
879 group newsgroups xref)
|
|
880 (and number (zerop number) (setq number nil))
|
|
881 ;; Then we find the group name.
|
|
882 (setq group
|
|
883 (cond
|
|
884 ;; If there is only one group in the Newsgroups header,
|
|
885 ;; then it seems quite likely that this article comes
|
|
886 ;; from that group, I'd say.
|
|
887 ((and (setq newsgroups (mail-fetch-field "newsgroups"))
|
|
888 (not (string-match "," newsgroups)))
|
|
889 newsgroups)
|
|
890 ;; If there is more than one group in the Newsgroups
|
|
891 ;; header, then the Xref header should be filled out.
|
|
892 ;; We hazard a guess that the group that has this
|
|
893 ;; article number in the Xref header is the one we are
|
|
894 ;; looking for. This might very well be wrong if this
|
|
895 ;; article happens to have the same number in several
|
|
896 ;; groups, but that's life.
|
|
897 ((and (setq xref (mail-fetch-field "xref"))
|
|
898 number
|
|
899 (string-match (format "\\([^ :]+\\):%d" number) xref))
|
|
900 (substring xref (match-beginning 1) (match-end 1)))
|
|
901 (t "")))
|
|
902 (when (string-match "\r" group)
|
|
903 (setq group (substring group 0 (match-beginning 0))))
|
|
904 (cons group number)))))
|
|
905
|
|
906 (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
|
13401
|
907 (erase-buffer)
|
|
908 (cond
|
|
909
|
|
910 ;; This server does not talk NOV.
|
|
911 ((not nntp-server-xover)
|
|
912 nil)
|
|
913
|
|
914 ;; We don't care about gaps.
|
15511
|
915 ((or (not nntp-nov-gap)
|
|
916 fetch-old)
|
13401
|
917 (nntp-send-xover-command
|
15511
|
918 (if fetch-old
|
|
919 (if (numberp fetch-old)
|
|
920 (max 1 (- (car articles) fetch-old))
|
|
921 1)
|
|
922 (car articles))
|
|
923 (nntp-last-element articles) 'wait)
|
13401
|
924
|
|
925 (goto-char (point-min))
|
15511
|
926 (when (looking-at "[1-5][0-9][0-9] ")
|
|
927 (delete-region (point) (progn (forward-line 1) (point))))
|
13401
|
928 (while (search-forward "\r" nil t)
|
|
929 (replace-match "" t t))
|
|
930 (goto-char (point-max))
|
|
931 (forward-line -1)
|
15511
|
932 (when (looking-at "\\.")
|
|
933 (delete-region (point) (progn (forward-line 1) (point)))))
|
13401
|
934
|
|
935 ;; We do it the hard way. For each gap, an XOVER command is sent
|
|
936 ;; to the server. We do not wait for a reply from the server, we
|
|
937 ;; just send them off as fast as we can. That means that we have
|
|
938 ;; to count the number of responses we get back to find out when we
|
|
939 ;; have gotten all we asked for.
|
|
940 ((numberp nntp-nov-gap)
|
|
941 (let ((count 0)
|
|
942 (received 0)
|
|
943 (last-point (point-min))
|
|
944 (buf (current-buffer))
|
|
945 first)
|
|
946 ;; We have to check `nntp-server-xover'. If it gets set to nil,
|
|
947 ;; that means that the server does not understand XOVER, but we
|
|
948 ;; won't know that until we try.
|
15511
|
949 (while (and nntp-server-xover articles)
|
|
950 (setq first (car articles))
|
13401
|
951 ;; Search forward until we find a gap, or until we run out of
|
|
952 ;; articles.
|
15511
|
953 (while (and (cdr articles)
|
|
954 (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
|
|
955 (setq articles (cdr articles)))
|
13401
|
956
|
15511
|
957 (when (nntp-send-xover-command first (car articles))
|
|
958 (setq articles (cdr articles)
|
13401
|
959 count (1+ count))
|
|
960
|
|
961 ;; Every 400 requests we have to read the stream in
|
|
962 ;; order to avoid deadlocks.
|
15511
|
963 (when (or (null articles) ;All requests have been sent.
|
|
964 (zerop (% count nntp-maximum-request)))
|
|
965 (accept-process-output)
|
|
966 ;; On some Emacs versions the preceding function has
|
|
967 ;; a tendency to change the buffer. Perhaps. It's
|
|
968 ;; quite difficult to reproduce, because it only
|
|
969 ;; seems to happen once in a blue moon.
|
|
970 (set-buffer buf)
|
|
971 (while (progn
|
|
972 (goto-char last-point)
|
|
973 ;; Count replies.
|
|
974 (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
|
|
975 (setq received (1+ received)))
|
|
976 (setq last-point (point))
|
|
977 (< received count))
|
|
978 (accept-process-output)
|
|
979 (set-buffer buf)))))
|
13401
|
980
|
15511
|
981 (when nntp-server-xover
|
13401
|
982 ;; Wait for the reply from the final command.
|
|
983 (goto-char (point-max))
|
|
984 (re-search-backward "^[0-9][0-9][0-9] " nil t)
|
15511
|
985 (when (looking-at "^[23]")
|
|
986 (while (progn
|
|
987 (goto-char (point-max))
|
|
988 (forward-line -1)
|
|
989 (not (looking-at "^\\.\r?\n")))
|
|
990 (nntp-accept-response)))
|
13401
|
991
|
|
992 ;; We remove any "." lines and status lines.
|
|
993 (goto-char (point-min))
|
|
994 (while (search-forward "\r" nil t)
|
|
995 (delete-char -1))
|
|
996 (goto-char (point-min))
|
|
997 (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")))))
|
|
998
|
|
999 nntp-server-xover)
|
|
1000
|
|
1001 (defun nntp-send-xover-command (beg end &optional wait-for-reply)
|
15511
|
1002 "Send the XOVER command to the server."
|
|
1003 (let ((range (format "%d-%d" (or beg 1) (or end beg 1))))
|
13401
|
1004 (if (stringp nntp-server-xover)
|
|
1005 ;; If `nntp-server-xover' is a string, then we just send this
|
|
1006 ;; command.
|
|
1007 (if wait-for-reply
|
|
1008 (nntp-send-command "^\\.\r?\n" nntp-server-xover range)
|
|
1009 ;; We do not wait for the reply.
|
15511
|
1010 (nntp-send-strings-to-server nntp-server-xover range))
|
13401
|
1011 (let ((commands nntp-xover-commands))
|
|
1012 ;; `nntp-xover-commands' is a list of possible XOVER commands.
|
|
1013 ;; We try them all until we get at positive response.
|
|
1014 (while (and commands (eq nntp-server-xover 'try))
|
|
1015 (nntp-send-command "^\\.\r?\n" (car commands) range)
|
|
1016 (save-excursion
|
|
1017 (set-buffer nntp-server-buffer)
|
|
1018 (goto-char (point-min))
|
|
1019 (and (looking-at "[23]") ; No error message.
|
|
1020 ;; We also have to look at the lines. Some buggy
|
|
1021 ;; servers give back simple lines with just the
|
|
1022 ;; article number. How... helpful.
|
|
1023 (progn
|
|
1024 (forward-line 1)
|
|
1025 (looking-at "[0-9]+\t...")) ; More text after number.
|
|
1026 (setq nntp-server-xover (car commands))))
|
|
1027 (setq commands (cdr commands)))
|
|
1028 ;; If none of the commands worked, we disable XOVER.
|
15511
|
1029 (when (eq nntp-server-xover 'try)
|
|
1030 (save-excursion
|
|
1031 (set-buffer nntp-server-buffer)
|
|
1032 (erase-buffer)
|
|
1033 (setq nntp-server-xover nil)))
|
13401
|
1034 nntp-server-xover))))
|
|
1035
|
|
1036 (defun nntp-send-strings-to-server (&rest strings)
|
15511
|
1037 "Send STRINGS to the server."
|
|
1038 (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
|
13401
|
1039 ;; We open the nntp server if it is down.
|
15511
|
1040 (or (nntp-server-opened (nnoo-current-server 'nntp))
|
|
1041 (nntp-open-server (nnoo-current-server 'nntp))
|
|
1042 (error (nntp-status-message)))
|
13401
|
1043 ;; Send the strings.
|
15511
|
1044 (process-send-string nntp-server-process cmd)
|
|
1045 t))
|
13401
|
1046
|
|
1047 (defun nntp-send-region-to-server (begin end)
|
14531
|
1048 "Send the current buffer region (from BEGIN to END) to the server."
|
13401
|
1049 (save-excursion
|
14531
|
1050 (let ((cur (current-buffer)))
|
|
1051 ;; Copy the buffer over to the send buffer.
|
15511
|
1052 (nnheader-set-temp-buffer " *nntp send*")
|
14531
|
1053 (insert-buffer-substring cur begin end)
|
|
1054 (save-excursion
|
|
1055 (set-buffer cur)
|
|
1056 (erase-buffer))
|
|
1057 ;; `process-send-region' does not work if the text to be sent is very
|
|
1058 ;; large, so we send it piecemeal.
|
|
1059 (let ((last (point-min))
|
|
1060 (size 100)) ;Size of text sent at once.
|
15511
|
1061 (while (and (/= last (point-max))
|
|
1062 (memq (process-status nntp-server-process) '(open run)))
|
14531
|
1063 (process-send-region
|
|
1064 nntp-server-process
|
|
1065 last (setq last (min (+ last size) (point-max))))
|
|
1066 ;; Read any output from the server. May be unnecessary.
|
|
1067 (accept-process-output)))
|
|
1068 (kill-buffer (current-buffer)))))
|
13401
|
1069
|
|
1070 (defun nntp-open-server-semi-internal (server &optional service)
|
|
1071 "Open SERVER.
|
|
1072 If SERVER is nil, use value of environment variable `NNTPSERVER'.
|
|
1073 If SERVICE, this this as the port number."
|
15511
|
1074 (nnheader-insert "")
|
13401
|
1075 (let ((server (or server (getenv "NNTPSERVER")))
|
|
1076 (status nil)
|
|
1077 (timer
|
|
1078 (and nntp-connection-timeout
|
15511
|
1079 (nnheader-run-at-time nntp-connection-timeout
|
|
1080 nil 'nntp-kill-connection server))))
|
13401
|
1081 (save-excursion
|
|
1082 (set-buffer nntp-server-buffer)
|
|
1083 (setq nntp-status-string "")
|
15511
|
1084 (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address)
|
13401
|
1085 (cond ((and server (nntp-open-server-internal server service))
|
|
1086 (setq nntp-address server)
|
|
1087 (setq status
|
|
1088 (condition-case nil
|
|
1089 (nntp-wait-for-response "^[23].*\r?\n" 'slow)
|
|
1090 (error nil)
|
|
1091 (quit nil)))
|
15511
|
1092 (unless status
|
|
1093 (nntp-close-server-internal server)
|
|
1094 (nnheader-report
|
|
1095 'nntp "Couldn't open connection to %s"
|
|
1096 (if (and nntp-address
|
|
1097 (not (equal nntp-address "")))
|
|
1098 nntp-address server)))
|
|
1099 (when nntp-server-process
|
|
1100 (set-process-sentinel
|
|
1101 nntp-server-process 'nntp-default-sentinel)
|
|
1102 ;; You can send commands at startup like AUTHINFO here.
|
|
1103 ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
|
|
1104 (run-hooks 'nntp-server-opened-hook)))
|
13401
|
1105 ((null server)
|
15511
|
1106 (nnheader-report 'nntp "NNTP server is not specified."))
|
13401
|
1107 (t ; We couldn't open the server.
|
15511
|
1108 (nnheader-report
|
|
1109 'nntp (buffer-substring (point-min) (point-max)))))
|
|
1110 (when timer
|
|
1111 (nnheader-cancel-timer timer))
|
13401
|
1112 (message "")
|
15511
|
1113 (unless status
|
|
1114 (nnoo-close-server 'nntp server)
|
|
1115 (setq nntp-async-number nil))
|
13401
|
1116 status)))
|
|
1117
|
15511
|
1118 (defvar nntp-default-directories '("~" "/tmp" "/")
|
|
1119 "Directories to as current directory in the nntp server buffer.")
|
|
1120
|
13401
|
1121 (defun nntp-open-server-internal (server &optional service)
|
|
1122 "Open connection to news server on SERVER by SERVICE (default is nntp)."
|
|
1123 (let (proc)
|
|
1124 (save-excursion
|
|
1125 (set-buffer nntp-server-buffer)
|
15511
|
1126 ;; Make sure we have a valid current directory for the
|
|
1127 ;; nntp server buffer.
|
|
1128 (unless (file-exists-p default-directory)
|
|
1129 (let ((dirs nntp-default-directories))
|
|
1130 (while dirs
|
|
1131 (when (file-exists-p (car dirs))
|
|
1132 (setq default-directory (car dirs)
|
|
1133 dirs nil))
|
|
1134 (setq dirs (cdr dirs)))))
|
|
1135 (cond
|
|
1136 ((and (setq proc
|
|
1137 (condition-case nil
|
|
1138 (funcall nntp-open-server-function server)
|
|
1139 (error nil)))
|
|
1140 (memq (process-status proc) '(open run)))
|
|
1141 (setq nntp-server-process proc)
|
|
1142 (setq nntp-address server)
|
|
1143 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
|
|
1144 (process-kill-without-query proc)
|
|
1145 (run-hooks 'nntp-server-hook)
|
|
1146 (push proc nntp-opened-connections)
|
|
1147 (condition-case ()
|
|
1148 (nntp-read-server-type)
|
|
1149 (error
|
|
1150 (nnheader-report 'nntp "Couldn't open server %s" server)
|
|
1151 (nntp-close-server)))
|
|
1152 nntp-server-process)
|
|
1153 (t
|
|
1154 (nnheader-report 'nntp "Couldn't open server %s" server))))))
|
|
1155
|
|
1156 (defun nntp-read-server-type ()
|
|
1157 "Find out what the name of the server we have connected to is."
|
|
1158 ;; Wait for the status string to arrive.
|
|
1159 (nntp-wait-for-response "^.*\n" t)
|
|
1160 (setq nntp-server-type (buffer-string))
|
|
1161 (let ((alist nntp-server-action-alist)
|
|
1162 entry)
|
|
1163 ;; Run server-specific commmands.
|
|
1164 (while alist
|
|
1165 (setq entry (pop alist))
|
|
1166 (when (string-match (car entry) nntp-server-type)
|
|
1167 (if (and (listp (cadr entry))
|
|
1168 (not (eq 'lambda (caadr entry))))
|
|
1169 (eval (cadr entry))
|
|
1170 (funcall (cadr entry)))))))
|
13401
|
1171
|
|
1172 (defun nntp-open-network-stream (server)
|
|
1173 (open-network-stream
|
|
1174 "nntpd" nntp-server-buffer server nntp-port-number))
|
|
1175
|
|
1176 (defun nntp-open-rlogin (server)
|
15511
|
1177 (let ((proc (if nntp-rlogin-user-name
|
|
1178 (start-process
|
|
1179 "nntpd" nntp-server-buffer "rsh"
|
|
1180 "-l" nntp-rlogin-user-name server
|
|
1181 (mapconcat 'identity
|
|
1182 nntp-rlogin-parameters " "))
|
|
1183 (start-process
|
|
1184 "nntpd" nntp-server-buffer "rsh" server
|
|
1185 (mapconcat 'identity
|
|
1186 nntp-rlogin-parameters " ")))))
|
|
1187 proc))
|
13401
|
1188
|
|
1189 (defun nntp-telnet-to-machine ()
|
|
1190 (let (b)
|
|
1191 (telnet "localhost")
|
|
1192 (goto-char (point-min))
|
|
1193 (while (not (re-search-forward "^login: *" nil t))
|
|
1194 (sit-for 1)
|
|
1195 (goto-char (point-min)))
|
|
1196 (goto-char (point-max))
|
|
1197 (insert "larsi")
|
|
1198 (telnet-send-input)
|
|
1199 (setq b (point))
|
|
1200 (while (not (re-search-forward ">" nil t))
|
|
1201 (sit-for 1)
|
|
1202 (goto-char b))
|
|
1203 (goto-char (point-max))
|
|
1204 (insert "ls")
|
|
1205 (telnet-send-input)))
|
|
1206
|
|
1207 (defun nntp-close-server-internal (&optional server)
|
|
1208 "Close connection to news server."
|
|
1209 (nntp-possibly-change-server nil server)
|
|
1210 (if nntp-server-process
|
|
1211 (delete-process nntp-server-process))
|
|
1212 (setq nntp-server-process nil)
|
|
1213 (setq nntp-address ""))
|
|
1214
|
|
1215 (defun nntp-accept-response ()
|
|
1216 "Read response of server.
|
|
1217 It is well-known that the communication speed will be much improved by
|
|
1218 defining this function as macro."
|
|
1219 ;; To deal with server process exiting before
|
|
1220 ;; accept-process-output is called.
|
|
1221 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
|
|
1222 ;; This is a copy of `nntp-default-sentinel'.
|
|
1223 (let ((buf (current-buffer)))
|
|
1224 (prog1
|
|
1225 (if (or (not nntp-server-process)
|
|
1226 (not (memq (process-status nntp-server-process) '(open run))))
|
|
1227 (error "nntp: Process connection closed; %s" (nntp-status-message))
|
|
1228 (if nntp-buggy-select
|
|
1229 (progn
|
|
1230 ;; We cannot use `accept-process-output'.
|
|
1231 ;; Fujitsu UTS requires messages during sleep-for.
|
|
1232 ;; I don't know why.
|
15511
|
1233 (nnheader-message 5 "NNTP: Reading...")
|
13401
|
1234 (sleep-for 1)
|
15511
|
1235 (nnheader-message 5 ""))
|
13401
|
1236 (condition-case errorcode
|
14196
abbc35e39b11
(nntp-accept-response): Add a timeout parameter to `accept-process-output'.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1237 (accept-process-output nntp-server-process 1)
|
13401
|
1238 (error
|
|
1239 (cond ((string-equal "select error: Invalid argument"
|
|
1240 (nth 1 errorcode))
|
|
1241 ;; Ignore select error.
|
|
1242 nil)
|
|
1243 (t
|
|
1244 (signal (car errorcode) (cdr errorcode))))))))
|
|
1245 (set-buffer buf))))
|
|
1246
|
|
1247 (defun nntp-last-element (list)
|
|
1248 "Return last element of LIST."
|
|
1249 (while (cdr list)
|
|
1250 (setq list (cdr list)))
|
|
1251 (car list))
|
|
1252
|
13588
|
1253 (defun nntp-possibly-change-server (newsgroup server &optional connectionless)
|
|
1254 "Check whether the virtual server needs changing."
|
15511
|
1255 (when (and server
|
|
1256 (not (nntp-server-opened server)))
|
|
1257 ;; This virtual server isn't open, so we (re)open it here.
|
|
1258 (nntp-open-server server nil t))
|
|
1259 (when (and newsgroup
|
|
1260 (not (equal newsgroup nntp-current-group)))
|
|
1261 ;; Set the proper current group.
|
|
1262 (nntp-request-group newsgroup server)))
|
|
1263
|
13401
|
1264 (defun nntp-try-list-active (group)
|
|
1265 (nntp-list-active-group group)
|
|
1266 (save-excursion
|
|
1267 (set-buffer nntp-server-buffer)
|
|
1268 (goto-char (point-min))
|
|
1269 (cond ((looking-at "5[0-9]+")
|
|
1270 (setq nntp-server-list-active-group nil))
|
|
1271 (t
|
|
1272 (setq nntp-server-list-active-group t)))))
|
|
1273
|
|
1274 (defun nntp-async-server-opened ()
|
|
1275 (and nntp-async-process
|
|
1276 (memq (process-status nntp-async-process) '(open run))))
|
|
1277
|
|
1278 (defun nntp-async-open-server ()
|
|
1279 (save-excursion
|
|
1280 (set-buffer (generate-new-buffer " *async-nntp*"))
|
|
1281 (setq nntp-async-buffer (current-buffer))
|
|
1282 (buffer-disable-undo (current-buffer)))
|
|
1283 (let ((nntp-server-process nil)
|
|
1284 (nntp-server-buffer nntp-async-buffer))
|
|
1285 (nntp-open-server-semi-internal nntp-address nntp-port-number)
|
|
1286 (if (not (setq nntp-async-process nntp-server-process))
|
|
1287 (progn
|
|
1288 (setq nntp-async-number nil))
|
|
1289 (set-process-buffer nntp-async-process nntp-async-buffer))))
|
|
1290
|
|
1291 (defun nntp-async-fetch-articles (article)
|
|
1292 (if (stringp article)
|
|
1293 ()
|
|
1294 (let ((articles (cdr (memq (assq article nntp-async-articles)
|
|
1295 nntp-async-articles)))
|
|
1296 (max (cond ((numberp nntp-async-number)
|
|
1297 nntp-async-number)
|
|
1298 ((eq nntp-async-number t)
|
|
1299 (length nntp-async-articles))
|
|
1300 (t 0)))
|
|
1301 nart)
|
|
1302 (while (and (>= (setq max (1- max)) 0)
|
|
1303 articles)
|
15511
|
1304 (or (memq (setq nart (caar articles)) nntp-async-fetched)
|
13401
|
1305 (progn
|
|
1306 (nntp-async-send-strings "ARTICLE " (int-to-string nart))
|
|
1307 (setq nntp-async-fetched (cons nart nntp-async-fetched))))
|
|
1308 (setq articles (cdr articles))))))
|
|
1309
|
|
1310 (defun nntp-async-send-strings (&rest strings)
|
15511
|
1311 (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
|
13401
|
1312 (or (nntp-async-server-opened)
|
|
1313 (nntp-async-open-server)
|
15511
|
1314 (error (nntp-status-message)))
|
13401
|
1315 (process-send-string nntp-async-process cmd)))
|
|
1316
|
|
1317 (defun nntp-async-request-group (group)
|
|
1318 (if (equal group nntp-current-group)
|
|
1319 ()
|
|
1320 (let ((asyncs (assoc group nntp-async-group-alist)))
|
|
1321 ;; A new group has been selected, so we push the current state
|
|
1322 ;; of async articles on an alist, and pull the old state off.
|
|
1323 (setq nntp-async-group-alist
|
|
1324 (cons (list nntp-current-group
|
|
1325 nntp-async-articles nntp-async-fetched
|
|
1326 nntp-async-process)
|
|
1327 (delq asyncs nntp-async-group-alist)))
|
|
1328 (and asyncs
|
|
1329 (progn
|
|
1330 (setq nntp-async-articles (nth 1 asyncs))
|
|
1331 (setq nntp-async-fetched (nth 2 asyncs))
|
|
1332 (setq nntp-async-process (nth 3 asyncs)))))))
|
|
1333
|
|
1334 (provide 'nntp)
|
|
1335
|
|
1336 ;;; nntp.el ends here
|