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