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