Commit | Line | Data |
---|---|---|
6594deb0 ER |
1 | ;;; nnspool.el --- spool access using NNTP for GNU Emacs |
2 | ||
b027f415 | 3 | ;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. |
3a801d0c | 4 | |
c2c2f720 | 5 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
d7b4d18f | 6 | ;; Keywords: news |
c2c2f720 | 7 | |
05328297 | 8 | ;; This file is part of GNU Emacs. |
9 | ||
4da31937 RS |
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 | ||
05328297 | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
4da31937 RS |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
05328297 | 23 | |
c2c2f720 ER |
24 | ;;; Code: |
25 | ||
05328297 | 26 | (require 'nntp) |
27 | ||
28 | (defvar nnspool-inews-program news-inews-program | |
29 | "*Program to post news.") | |
30 | ||
31 | (defvar nnspool-inews-switches '("-h") | |
32 | "*Switches for nnspool-request-post to pass to `inews' for posting news.") | |
33 | ||
34 | (defvar nnspool-spool-directory news-path | |
35 | "*Local news spool directory.") | |
36 | ||
37 | (defvar nnspool-active-file "/usr/lib/news/active" | |
38 | "*Local news active file.") | |
39 | ||
b027f415 RS |
40 | (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups" |
41 | "*Local news newsgroups file.") | |
42 | ||
43 | (defvar nnspool-distributions-file "/usr/lib/news/distributions" | |
44 | "*Local news distributions file.") | |
45 | ||
05328297 | 46 | (defvar nnspool-history-file "/usr/lib/news/history" |
47 | "*Local news history file.") | |
48 | ||
49 | \f | |
50 | ||
b027f415 | 51 | (defconst nnspool-version "NNSPOOL 1.12" |
05328297 | 52 | "Version numbers of this version of NNSPOOL.") |
53 | ||
54 | (defvar nnspool-current-directory nil | |
55 | "Current news group directory.") | |
56 | ||
57 | ;;; | |
58 | ;;; Replacement of Extended Command for retrieving many headers. | |
59 | ;;; | |
60 | ||
61 | (defun nnspool-retrieve-headers (sequence) | |
62 | "Return list of article headers specified by SEQUENCE of article id. | |
63 | The format of list is | |
64 | `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. | |
b027f415 | 65 | If there is no References: field, In-Reply-To: field is used instead. |
05328297 | 66 | Reader macros for the vector are defined as `nntp-header-FIELD'. |
67 | Writer macros for the vector are defined as `nntp-set-header-FIELD'. | |
b027f415 | 68 | Newsgroup must be selected before calling this." |
05328297 | 69 | (save-excursion |
70 | (set-buffer nntp-server-buffer) | |
71 | ;;(erase-buffer) | |
72 | (let ((file nil) | |
73 | (number (length sequence)) | |
74 | (count 0) | |
75 | (headers nil) ;Result list. | |
76 | (article 0) | |
77 | (subject nil) | |
78 | (message-id nil) | |
79 | (from nil) | |
80 | (xref nil) | |
81 | (lines 0) | |
82 | (date nil) | |
83 | (references nil)) | |
84 | (while sequence | |
85 | ;;(nntp-send-strings-to-server "HEAD" (car sequence)) | |
86 | (setq article (car sequence)) | |
87 | (setq file | |
88 | (concat nnspool-current-directory (prin1-to-string article))) | |
89 | (if (and (file-exists-p file) | |
90 | (not (file-directory-p file))) | |
91 | (progn | |
92 | (erase-buffer) | |
93 | (insert-file-contents file) | |
94 | ;; Make message body invisible. | |
95 | (goto-char (point-min)) | |
96 | (search-forward "\n\n" nil 'move) | |
97 | (narrow-to-region (point-min) (point)) | |
98 | ;; Fold continuation lines. | |
99 | (goto-char (point-min)) | |
100 | (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
101 | (replace-match " " t t)) | |
102 | ;; Make it possible to search for `\nFIELD'. | |
103 | (goto-char (point-min)) | |
104 | (insert "\n") | |
105 | ;; Extract From: | |
106 | (goto-char (point-min)) | |
107 | (if (search-forward "\nFrom: " nil t) | |
108 | (setq from (buffer-substring | |
109 | (point) | |
110 | (save-excursion (end-of-line) (point)))) | |
111 | (setq from "(Unknown User)")) | |
112 | ;; Extract Subject: | |
113 | (goto-char (point-min)) | |
114 | (if (search-forward "\nSubject: " nil t) | |
115 | (setq subject (buffer-substring | |
116 | (point) | |
117 | (save-excursion (end-of-line) (point)))) | |
118 | (setq subject "(None)")) | |
119 | ;; Extract Message-ID: | |
120 | (goto-char (point-min)) | |
121 | (if (search-forward "\nMessage-ID: " nil t) | |
122 | (setq message-id (buffer-substring | |
123 | (point) | |
124 | (save-excursion (end-of-line) (point)))) | |
125 | (setq message-id nil)) | |
126 | ;; Extract Date: | |
127 | (goto-char (point-min)) | |
128 | (if (search-forward "\nDate: " nil t) | |
129 | (setq date (buffer-substring | |
130 | (point) | |
131 | (save-excursion (end-of-line) (point)))) | |
132 | (setq date nil)) | |
133 | ;; Extract Lines: | |
134 | (goto-char (point-min)) | |
135 | (if (search-forward "\nLines: " nil t) | |
136 | (setq lines (string-to-int | |
137 | (buffer-substring | |
138 | (point) | |
139 | (save-excursion (end-of-line) (point))))) | |
140 | (setq lines 0)) | |
141 | ;; Extract Xref: | |
142 | (goto-char (point-min)) | |
143 | (if (search-forward "\nXref: " nil t) | |
144 | (setq xref (buffer-substring | |
145 | (point) | |
146 | (save-excursion (end-of-line) (point)))) | |
147 | (setq xref nil)) | |
148 | ;; Extract References: | |
b027f415 | 149 | ;; If no References: field, use In-Reply-To: field instead. |
05328297 | 150 | (goto-char (point-min)) |
b027f415 RS |
151 | (if (or (search-forward "\nReferences: " nil t) |
152 | (search-forward "\nIn-Reply-To: " nil t)) | |
05328297 | 153 | (setq references (buffer-substring |
154 | (point) | |
155 | (save-excursion (end-of-line) (point)))) | |
156 | (setq references nil)) | |
b027f415 RS |
157 | ;; Collect valid article only. |
158 | (and article | |
159 | message-id | |
160 | (setq headers | |
161 | (cons (vector article subject from | |
162 | xref lines date | |
163 | message-id references) headers))) | |
05328297 | 164 | )) |
165 | (setq sequence (cdr sequence)) | |
166 | (setq count (1+ count)) | |
167 | (and (numberp nntp-large-newsgroup) | |
168 | (> number nntp-large-newsgroup) | |
169 | (zerop (% count 20)) | |
b027f415 | 170 | (message "NNSPOOL: Receiving headers... %d%%" |
05328297 | 171 | (/ (* count 100) number))) |
172 | ) | |
173 | (and (numberp nntp-large-newsgroup) | |
174 | (> number nntp-large-newsgroup) | |
b027f415 | 175 | (message "NNSPOOL: Receiving headers... done")) |
05328297 | 176 | (nreverse headers) |
177 | ))) | |
178 | ||
179 | \f | |
180 | ;;; | |
181 | ;;; Replacement of NNTP Raw Interface. | |
182 | ;;; | |
183 | ||
184 | (defun nnspool-open-server (host &optional service) | |
185 | "Open news server on HOST. | |
186 | If HOST is nil, use value of environment variable `NNTPSERVER'. | |
187 | If optional argument SERVICE is non-nil, open by the service name." | |
188 | (let ((host (or host (getenv "NNTPSERVER"))) | |
189 | (status nil)) | |
b027f415 | 190 | (setq nntp-status-string "") |
05328297 | 191 | (cond ((and (file-directory-p nnspool-spool-directory) |
192 | (file-exists-p nnspool-active-file) | |
193 | (string-equal host (system-name))) | |
194 | (setq status (nnspool-open-server-internal host service))) | |
195 | ((string-equal host (system-name)) | |
b027f415 | 196 | (setq nntp-status-string |
05328297 | 197 | (format "%s has no news spool. Goodbye." host))) |
198 | ((null host) | |
b027f415 | 199 | (setq nntp-status-string "NNTP server is not specified.")) |
05328297 | 200 | (t |
b027f415 | 201 | (setq nntp-status-string |
05328297 | 202 | (format "NNSPOOL: cannot talk to %s." host))) |
203 | ) | |
204 | status | |
205 | )) | |
206 | ||
207 | (defun nnspool-close-server () | |
208 | "Close news server." | |
209 | (nnspool-close-server-internal)) | |
210 | ||
211 | (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) | |
212 | ||
213 | (defun nnspool-server-opened () | |
214 | "Return server process status, T or NIL. | |
215 | If the stream is opened, return T, otherwise return NIL." | |
216 | (and nntp-server-buffer | |
217 | (get-buffer nntp-server-buffer))) | |
218 | ||
219 | (defun nnspool-status-message () | |
220 | "Return server status response as string." | |
b027f415 | 221 | nntp-status-string |
05328297 | 222 | ) |
223 | ||
224 | (defun nnspool-request-article (id) | |
225 | "Select article by message ID (or number)." | |
226 | (let ((file (if (stringp id) | |
227 | (nnspool-find-article-by-message-id id) | |
228 | (concat nnspool-current-directory (prin1-to-string id))))) | |
229 | (if (and (stringp file) | |
230 | (file-exists-p file) | |
231 | (not (file-directory-p file))) | |
232 | (save-excursion | |
233 | (nnspool-find-file file))) | |
234 | )) | |
235 | ||
236 | (defun nnspool-request-body (id) | |
237 | "Select article body by message ID (or number)." | |
238 | (if (nnspool-request-article id) | |
239 | (save-excursion | |
240 | (set-buffer nntp-server-buffer) | |
241 | (goto-char (point-min)) | |
242 | (if (search-forward "\n\n" nil t) | |
243 | (delete-region (point-min) (point))) | |
244 | t | |
245 | ) | |
246 | )) | |
247 | ||
248 | (defun nnspool-request-head (id) | |
249 | "Select article head by message ID (or number)." | |
250 | (if (nnspool-request-article id) | |
251 | (save-excursion | |
252 | (set-buffer nntp-server-buffer) | |
253 | (goto-char (point-min)) | |
254 | (if (search-forward "\n\n" nil t) | |
255 | (delete-region (1- (point)) (point-max))) | |
256 | t | |
257 | ) | |
258 | )) | |
259 | ||
260 | (defun nnspool-request-stat (id) | |
261 | "Select article by message ID (or number)." | |
b027f415 RS |
262 | (setq nntp-status-string "NNSPOOL: STAT is not implemented.") |
263 | nil | |
264 | ) | |
05328297 | 265 | |
266 | (defun nnspool-request-group (group) | |
267 | "Select news GROUP." | |
268 | (let ((pathname (nnspool-article-pathname | |
269 | (nnspool-replace-chars-in-string group ?. ?/)))) | |
270 | (if (file-directory-p pathname) | |
271 | (setq nnspool-current-directory pathname)) | |
272 | )) | |
273 | ||
274 | (defun nnspool-request-list () | |
b027f415 | 275 | "List active newsgoups." |
05328297 | 276 | (save-excursion |
277 | (nnspool-find-file nnspool-active-file))) | |
278 | ||
b027f415 RS |
279 | (defun nnspool-request-list-newsgroups () |
280 | "List newsgroups (defined in NNTP2)." | |
281 | (save-excursion | |
282 | (nnspool-find-file nnspool-newsgroups-file))) | |
283 | ||
284 | (defun nnspool-request-list-distributions () | |
285 | "List distributions (defined in NNTP2)." | |
286 | (save-excursion | |
287 | (nnspool-find-file nnspool-distributions-file))) | |
288 | ||
05328297 | 289 | (defun nnspool-request-last () |
b027f415 RS |
290 | "Set current article pointer to the previous article |
291 | in the current news group." | |
292 | (setq nntp-status-string "NNSPOOL: LAST is not implemented.") | |
293 | nil | |
294 | ) | |
05328297 | 295 | |
296 | (defun nnspool-request-next () | |
297 | "Advance current article pointer." | |
b027f415 RS |
298 | (setq nntp-status-string "NNSPOOL: NEXT is not implemented.") |
299 | nil | |
300 | ) | |
05328297 | 301 | |
302 | (defun nnspool-request-post () | |
303 | "Post a new news in current buffer." | |
304 | (save-excursion | |
305 | ;; We have to work in the server buffer because of NEmacs hack. | |
306 | (copy-to-buffer nntp-server-buffer (point-min) (point-max)) | |
307 | (set-buffer nntp-server-buffer) | |
b027f415 | 308 | (apply (function call-process-region) |
05328297 | 309 | (point-min) (point-max) |
310 | nnspool-inews-program 'delete t nil nnspool-inews-switches) | |
311 | (prog1 | |
312 | (or (zerop (buffer-size)) | |
313 | ;; If inews returns strings, it must be error message | |
314 | ;; unless SPOOLNEWS is defined. | |
315 | ;; This condition is very weak, but there is no good rule | |
316 | ;; identifying errors when SPOOLNEWS is defined. | |
317 | ;; Suggested by ohm@kaba.junet. | |
318 | (string-match "spooled" (buffer-string))) | |
319 | ;; Make status message by unfolding lines. | |
320 | (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) | |
b027f415 | 321 | (setq nntp-status-string (buffer-string)) |
05328297 | 322 | (erase-buffer)) |
323 | )) | |
324 | ||
325 | \f | |
326 | ;;; | |
327 | ;;; Replacement of Low-Level Interface to NNTP Server. | |
328 | ;;; | |
329 | ||
330 | (defun nnspool-open-server-internal (host &optional service) | |
331 | "Open connection to news server on HOST by SERVICE (default is nntp)." | |
332 | (save-excursion | |
333 | (if (not (string-equal host (system-name))) | |
334 | (error "NNSPOOL: cannot talk to %s." host)) | |
335 | ;; Initialize communication buffer. | |
336 | (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
337 | (set-buffer nntp-server-buffer) | |
338 | (buffer-flush-undo (current-buffer)) | |
339 | (erase-buffer) | |
340 | (kill-all-local-variables) | |
341 | (setq case-fold-search t) ;Should ignore case. | |
342 | (setq nntp-server-process nil) | |
343 | (setq nntp-server-name host) | |
344 | ;; It is possible to change kanji-fileio-code in this hook. | |
345 | (run-hooks 'nntp-server-hook) | |
346 | t | |
347 | )) | |
348 | ||
349 | (defun nnspool-close-server-internal () | |
350 | "Close connection to news server." | |
351 | (if (get-file-buffer nnspool-history-file) | |
352 | (kill-buffer (get-file-buffer nnspool-history-file))) | |
353 | (if nntp-server-buffer | |
354 | (kill-buffer nntp-server-buffer)) | |
355 | (setq nntp-server-buffer nil) | |
356 | (setq nntp-server-process nil)) | |
357 | ||
358 | (defun nnspool-find-article-by-message-id (id) | |
eb8c3be9 | 359 | "Return full pathname of an article identified by message-ID." |
05328297 | 360 | (save-excursion |
361 | (let ((buffer (get-file-buffer nnspool-history-file))) | |
362 | (if buffer | |
363 | (set-buffer buffer) | |
364 | ;; Finding history file may take lots of time. | |
365 | (message "Reading history file...") | |
366 | (set-buffer (find-file-noselect nnspool-history-file)) | |
367 | (message "Reading history file... done"))) | |
368 | ;; Search from end of the file. I think this is much faster than | |
369 | ;; do from the beginning of the file. | |
370 | (goto-char (point-max)) | |
371 | (if (re-search-backward | |
372 | (concat "^" (regexp-quote id) | |
373 | "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) | |
374 | (let ((group (buffer-substring (match-beginning 1) (match-end 1))) | |
375 | (number (buffer-substring (match-beginning 2) (match-end 2)))) | |
376 | (concat (nnspool-article-pathname | |
377 | (nnspool-replace-chars-in-string group ?. ?/)) | |
378 | number)) | |
379 | ))) | |
380 | ||
381 | (defun nnspool-find-file (file) | |
382 | "Insert FILE in server buffer safely." | |
383 | (set-buffer nntp-server-buffer) | |
384 | (erase-buffer) | |
385 | (condition-case () | |
386 | (progn (insert-file-contents file) t) | |
387 | (file-error nil) | |
388 | )) | |
389 | ||
390 | (defun nnspool-article-pathname (group) | |
391 | "Make pathname for GROUP." | |
392 | (concat (file-name-as-directory nnspool-spool-directory) group "/")) | |
393 | ||
394 | (defun nnspool-replace-chars-in-string (string from to) | |
395 | "Replace characters in STRING from FROM to TO." | |
396 | (let ((string (substring string 0)) ;Copy string. | |
397 | (len (length string)) | |
398 | (idx 0)) | |
eb8c3be9 | 399 | ;; Replace all occurrences of FROM with TO. |
05328297 | 400 | (while (< idx len) |
401 | (if (= (aref string idx) from) | |
402 | (aset string idx to)) | |
403 | (setq idx (1+ idx))) | |
404 | string | |
405 | )) | |
49116ac0 JB |
406 | |
407 | (provide 'nnspool) | |
6594deb0 ER |
408 | |
409 | ;;; nnspool.el ends here |