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