1 ;;; nnspool.el --- spool access using NNTP for GNU Emacs
3 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
4 ;; Last-Modified: 16 Mar 1992
7 ;; $Header: nnspool.el,v 1.10 90/03/23 13:25:25 umerin Locked $
9 ;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
10 ;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY. No author or distributor
16 ;; accepts responsibility to anyone for the consequences of using it
17 ;; or for whether it serves any particular purpose or works at all,
18 ;; unless he says so in writing. Refer to the GNU Emacs General Public
19 ;; License for full details.
21 ;; Everyone is granted permission to copy, modify and redistribute
22 ;; GNU Emacs, but only under the conditions described in the
23 ;; GNU Emacs General Public License. A copy of this license is
24 ;; supposed to have been given to you along with GNU Emacs so you
25 ;; can know your rights and responsibilities. It should be in a
26 ;; file named COPYING. Among other things, the copyright notice
27 ;; and this notice must be preserved on all copies.
33 (defvar nnspool-inews-program news-inews-program
34 "*Program to post news.")
36 (defvar nnspool-inews-switches
'("-h")
37 "*Switches for nnspool-request-post to pass to `inews' for posting news.")
39 (defvar nnspool-spool-directory news-path
40 "*Local news spool directory.")
42 (defvar nnspool-active-file
"/usr/lib/news/active"
43 "*Local news active file.")
45 (defvar nnspool-history-file
"/usr/lib/news/history"
46 "*Local news history file.")
50 (defconst nnspool-version
"NNSPOOL 1.10"
51 "Version numbers of this version of NNSPOOL.")
53 (defvar nnspool-current-directory nil
54 "Current news group directory.")
57 ;;; Replacement of Extended Command for retrieving many headers.
60 (defun nnspool-retrieve-headers (sequence)
61 "Return list of article headers specified by SEQUENCE of article id.
63 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
64 Reader macros for the vector are defined as `nntp-header-FIELD'.
65 Writer macros for the vector are defined as `nntp-set-header-FIELD'.
66 News group must be selected before calling me."
68 (set-buffer nntp-server-buffer
)
71 (number (length sequence
))
73 (headers nil
) ;Result list.
83 ;;(nntp-send-strings-to-server "HEAD" (car sequence))
84 (setq article
(car sequence
))
86 (concat nnspool-current-directory
(prin1-to-string article
)))
87 (if (and (file-exists-p file
)
88 (not (file-directory-p file
)))
91 (insert-file-contents file
)
92 ;; Make message body invisible.
93 (goto-char (point-min))
94 (search-forward "\n\n" nil
'move
)
95 (narrow-to-region (point-min) (point))
96 ;; Fold continuation lines.
97 (goto-char (point-min))
98 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t
)
99 (replace-match " " t t
))
100 ;; Make it possible to search for `\nFIELD'.
101 (goto-char (point-min))
104 (goto-char (point-min))
105 (if (search-forward "\nFrom: " nil t
)
106 (setq from
(buffer-substring
108 (save-excursion (end-of-line) (point))))
109 (setq from
"(Unknown User)"))
111 (goto-char (point-min))
112 (if (search-forward "\nSubject: " nil t
)
113 (setq subject
(buffer-substring
115 (save-excursion (end-of-line) (point))))
116 (setq subject
"(None)"))
117 ;; Extract Message-ID:
118 (goto-char (point-min))
119 (if (search-forward "\nMessage-ID: " nil t
)
120 (setq message-id
(buffer-substring
122 (save-excursion (end-of-line) (point))))
123 (setq message-id nil
))
125 (goto-char (point-min))
126 (if (search-forward "\nDate: " nil t
)
127 (setq date
(buffer-substring
129 (save-excursion (end-of-line) (point))))
132 (goto-char (point-min))
133 (if (search-forward "\nLines: " nil t
)
134 (setq lines
(string-to-int
137 (save-excursion (end-of-line) (point)))))
140 (goto-char (point-min))
141 (if (search-forward "\nXref: " nil t
)
142 (setq xref
(buffer-substring
144 (save-excursion (end-of-line) (point))))
146 ;; Extract References:
147 (goto-char (point-min))
148 (if (search-forward "\nReferences: " nil t
)
149 (setq references
(buffer-substring
151 (save-excursion (end-of-line) (point))))
152 (setq references nil
))
154 (cons (vector article subject from
156 message-id references
) headers
))
158 (setq sequence
(cdr sequence
))
159 (setq count
(1+ count
))
160 (and (numberp nntp-large-newsgroup
)
161 (> number nntp-large-newsgroup
)
163 (message "NNSPOOL: %d%% of headers received."
164 (/ (* count
100) number
)))
166 (and (numberp nntp-large-newsgroup
)
167 (> number nntp-large-newsgroup
)
168 (message "NNSPOOL: 100%% of headers received."))
174 ;;; Replacement of NNTP Raw Interface.
177 (defun nnspool-open-server (host &optional service
)
178 "Open news server on HOST.
179 If HOST is nil, use value of environment variable `NNTPSERVER'.
180 If optional argument SERVICE is non-nil, open by the service name."
181 (let ((host (or host
(getenv "NNTPSERVER")))
183 (setq nntp-status-message-string
"")
184 (cond ((and (file-directory-p nnspool-spool-directory
)
185 (file-exists-p nnspool-active-file
)
186 (string-equal host
(system-name)))
187 (setq status
(nnspool-open-server-internal host service
)))
188 ((string-equal host
(system-name))
189 (setq nntp-status-message-string
190 (format "%s has no news spool. Goodbye." host
)))
192 (setq nntp-status-message-string
"NNTP server is not specified."))
194 (setq nntp-status-message-string
195 (format "NNSPOOL: cannot talk to %s." host
)))
200 (defun nnspool-close-server ()
202 (nnspool-close-server-internal))
204 (fset 'nnspool-request-quit
(symbol-function 'nnspool-close-server
))
206 (defun nnspool-server-opened ()
207 "Return server process status, T or NIL.
208 If the stream is opened, return T, otherwise return NIL."
209 (and nntp-server-buffer
210 (get-buffer nntp-server-buffer
)))
212 (defun nnspool-status-message ()
213 "Return server status response as string."
214 nntp-status-message-string
217 (defun nnspool-request-article (id)
218 "Select article by message ID (or number)."
219 (let ((file (if (stringp id
)
220 (nnspool-find-article-by-message-id id
)
221 (concat nnspool-current-directory
(prin1-to-string id
)))))
222 (if (and (stringp file
)
224 (not (file-directory-p file
)))
226 (nnspool-find-file file
)))
229 (defun nnspool-request-body (id)
230 "Select article body by message ID (or number)."
231 (if (nnspool-request-article id
)
233 (set-buffer nntp-server-buffer
)
234 (goto-char (point-min))
235 (if (search-forward "\n\n" nil t
)
236 (delete-region (point-min) (point)))
241 (defun nnspool-request-head (id)
242 "Select article head by message ID (or number)."
243 (if (nnspool-request-article id
)
245 (set-buffer nntp-server-buffer
)
246 (goto-char (point-min))
247 (if (search-forward "\n\n" nil t
)
248 (delete-region (1- (point)) (point-max)))
253 (defun nnspool-request-stat (id)
254 "Select article by message ID (or number)."
255 (error "NNSPOOL: STAT is not implemented."))
257 (defun nnspool-request-group (group)
259 (let ((pathname (nnspool-article-pathname
260 (nnspool-replace-chars-in-string group ?. ?
/))))
261 (if (file-directory-p pathname
)
262 (setq nnspool-current-directory pathname
))
265 (defun nnspool-request-list ()
266 "List valid newsgoups."
268 (nnspool-find-file nnspool-active-file
)))
270 (defun nnspool-request-last ()
271 "Set current article pointer to the previous article in the current news group."
272 (error "NNSPOOL: LAST is not implemented."))
274 (defun nnspool-request-next ()
275 "Advance current article pointer."
276 (error "NNSPOOL: NEXT is not implemented."))
278 (defun nnspool-request-post ()
279 "Post a new news in current buffer."
281 ;; We have to work in the server buffer because of NEmacs hack.
282 (copy-to-buffer nntp-server-buffer
(point-min) (point-max))
283 (set-buffer nntp-server-buffer
)
284 (apply 'call-process-region
285 (point-min) (point-max)
286 nnspool-inews-program
'delete t nil nnspool-inews-switches
)
288 (or (zerop (buffer-size))
289 ;; If inews returns strings, it must be error message
290 ;; unless SPOOLNEWS is defined.
291 ;; This condition is very weak, but there is no good rule
292 ;; identifying errors when SPOOLNEWS is defined.
293 ;; Suggested by ohm@kaba.junet.
294 (string-match "spooled" (buffer-string)))
295 ;; Make status message by unfolding lines.
296 (subst-char-in-region (point-min) (point-max) ?
\n ?
\\ 'noundo
)
297 (setq nntp-status-message-string
(buffer-string))
303 ;;; Replacement of Low-Level Interface to NNTP Server.
306 (defun nnspool-open-server-internal (host &optional service
)
307 "Open connection to news server on HOST by SERVICE (default is nntp)."
309 (if (not (string-equal host
(system-name)))
310 (error "NNSPOOL: cannot talk to %s." host
))
311 ;; Initialize communication buffer.
312 (setq nntp-server-buffer
(get-buffer-create " *nntpd*"))
313 (set-buffer nntp-server-buffer
)
314 (buffer-flush-undo (current-buffer))
316 (kill-all-local-variables)
317 (setq case-fold-search t
) ;Should ignore case.
318 (setq nntp-server-process nil
)
319 (setq nntp-server-name host
)
320 ;; It is possible to change kanji-fileio-code in this hook.
321 (run-hooks 'nntp-server-hook
)
325 (defun nnspool-close-server-internal ()
326 "Close connection to news server."
327 (if (get-file-buffer nnspool-history-file
)
328 (kill-buffer (get-file-buffer nnspool-history-file
)))
329 (if nntp-server-buffer
330 (kill-buffer nntp-server-buffer
))
331 (setq nntp-server-buffer nil
)
332 (setq nntp-server-process nil
))
334 (defun nnspool-find-article-by-message-id (id)
335 "Return full pathname of an article identified by message-ID."
337 (let ((buffer (get-file-buffer nnspool-history-file
)))
340 ;; Finding history file may take lots of time.
341 (message "Reading history file...")
342 (set-buffer (find-file-noselect nnspool-history-file
))
343 (message "Reading history file... done")))
344 ;; Search from end of the file. I think this is much faster than
345 ;; do from the beginning of the file.
346 (goto-char (point-max))
347 (if (re-search-backward
348 (concat "^" (regexp-quote id
)
349 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t
)
350 (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
351 (number (buffer-substring (match-beginning 2) (match-end 2))))
352 (concat (nnspool-article-pathname
353 (nnspool-replace-chars-in-string group ?. ?
/))
357 (defun nnspool-find-file (file)
358 "Insert FILE in server buffer safely."
359 (set-buffer nntp-server-buffer
)
362 (progn (insert-file-contents file
) t
)
366 (defun nnspool-article-pathname (group)
367 "Make pathname for GROUP."
368 (concat (file-name-as-directory nnspool-spool-directory
) group
"/"))
370 (defun nnspool-replace-chars-in-string (string from to
)
371 "Replace characters in STRING from FROM to TO."
372 (let ((string (substring string
0)) ;Copy string.
373 (len (length string
))
375 ;; Replace all occurence of FROM with TO.
377 (if (= (aref string idx
) from
)
378 (aset string idx to
))
385 ;;; nnspool.el ends here