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