1 ;;; nnspool.el --- spool access using NNTP for GNU Emacs
3 ;; Copyright (C) 1988, 1989, 1990, 1993, 1994 Free Software Foundation, Inc.
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Lars Ingebrigtsen <larsi@ifi.uio.no>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27 ;; All the Gnus backends have the same interface, and should return
28 ;; data in a similar format. Below is and overview of what functions
29 ;; these packages must supply and what result they should return.
33 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
36 ;; Functions for the imaginary backend `choke':
38 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
39 ;; Should return all headers for all ARTICLES, or return NOV lines for
42 ;; `choke-request-group GROUP &optional SERVER DISCARD'
43 ;; Switch to GROUP. If DISCARD is nil, active information on the group
46 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
47 ;; Return ARTICLE, which is either an article number or id.
49 ;; `choke-request-list SERVER'
50 ;; Return a list of all active newsgroups on SERVER.
52 ;; `choke-request-list-newsgroups SERVER'
53 ;; Return a list of descriptions of all newsgroups on SERVER.
55 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
56 ;; Should return a buffer that is suitable for "posting". nnspool and
57 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
58 ;; buffer. This function should fill out the appropriate header
61 ;; `choke-request-post &optional SERVER'
62 ;; Function that will be called from a buffer to be posted.
64 ;; `choke-open-server SERVER &optional ARGUMENT'
65 ;; Open a connection to SERVER.
67 ;; `choke-close-server &optional SERVER'
68 ;; Close the connection to server.
70 ;; `choke-server-opened &optional SERVER'
71 ;; Whether the server is opened or not.
73 ;; `choke-server-status &optional SERVER'
74 ;; Should return a status string (not in nntp buffer, but as the
75 ;; result of the function).
77 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
78 ;; Should expire (according to some aging scheme) all ARTICLES. Most
79 ;; backends will not be able to expire articles. Should return a list
80 ;; of all articles that were not expired.
82 ;; All these functions must return nil if they couldn't service the
83 ;; request. If the optional arguments are not supplied, some "current"
84 ;; or "default" values should be used. In short, one should emulate an
85 ;; NNTP server, in a way. All results should be returned in the NNTP
86 ;; format. (See RFC977).
93 (defvar nnspool-inews-program news-inews-program
94 "*Program to post news.")
96 (defvar nnspool-inews-switches '("-h")
97 "*Switches for nnspool-request-post to pass to `inews' for posting news.")
99 (defvar nnspool-spool-directory news-path
100 "*Local news spool directory.")
102 (defvar nnspool-active-file "/usr/lib/news/active"
103 "*Local news active file.")
105 (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups"
106 "*Local news newsgroups file.")
108 (defvar nnspool-distributions-file "/usr/lib/news/distributions"
109 "*Local news distributions file.")
111 (defvar nnspool-history-file "/usr/lib/news/history"
112 "*Local news history file.")
114 (defvar nnspool-large-newsgroup 50
115 "*The number of the articles which indicates a large newsgroup.
116 If the number of the articles is greater than the value, verbose
117 messages will be shown to indicate the current status.")
121 (defconst nnspool-version "nnspool 2.0"
122 "Version numbers of this version of NNSPOOL.")
124 (defvar nnspool-current-directory nil
125 "Current news group directory.")
127 (defvar nnspool-status-string "")
131 ;;; Interface functions.
133 (defun nnspool-retrieve-headers (sequence &optional newsgroup server)
134 "Retrieve the headers for the articles in SEQUENCE.
135 Newsgroup must be selected before calling this function."
137 (set-buffer nntp-server-buffer)
139 (let* ((number (length sequence))
141 (do-message (and (numberp nnspool-large-newsgroup)
142 (> number nnspool-large-newsgroup)))
144 (nnspool-possibly-change-directory newsgroup)
146 (setq article (car sequence))
148 (concat nnspool-current-directory (prin1-to-string article)))
149 (if (file-exists-p file)
151 (insert (format "221 %d Article retrieved.\n" article))
153 (insert-file-contents file)
155 (search-forward "\n\n" nil t)
158 (delete-region (point) (point-max))))
159 (setq sequence (cdr sequence))
162 (zerop (% (setq count (1+ count)) 20))
163 (message "NNSPOOL: Receiving headers... %d%%"
164 (/ (* count 100) number))))
166 (if do-message (message "NNSPOOL: Receiving headers... done"))
168 ;; Fold continuation lines.
170 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
171 (replace-match " " t t))
174 (defun nnspool-open-server (host &optional service)
176 (setq nnspool-status-string "")
177 (cond ((and (file-directory-p nnspool-spool-directory)
178 (file-exists-p nnspool-active-file))
179 (nnspool-open-server-internal host service))
181 (setq nnspool-status-string
182 (format "NNSPOOL: cannot talk to %s." host))
185 (defun nnspool-close-server (&optional server)
187 (nnspool-close-server-internal))
189 (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
191 (defun nnspool-server-opened (&optional server)
192 "Return server process status, T or NIL.
193 If the stream is opened, return T, otherwise return NIL."
194 (and nntp-server-buffer
195 (get-buffer nntp-server-buffer)))
197 (defun nnspool-status-message ()
198 "Return server status response as string."
199 nnspool-status-string)
201 (defun nnspool-request-article (id &optional newsgroup server buffer)
202 "Select article by message ID (or number)."
203 (nnspool-possibly-change-directory newsgroup)
204 (let ((file (if (stringp id)
205 (nnspool-find-article-by-message-id id)
206 (concat nnspool-current-directory (prin1-to-string id))))
207 (nntp-server-buffer (or buffer nntp-server-buffer)))
208 (if (and (stringp file)
210 (not (file-directory-p file)))
212 (nnspool-find-file file)))))
214 (defun nnspool-request-body (id &optional newsgroup server)
215 "Select article body by message ID (or number)."
216 (nnspool-possibly-change-directory newsgroup)
217 (if (nnspool-request-article id)
219 (set-buffer nntp-server-buffer)
220 (goto-char (point-min))
221 (if (search-forward "\n\n" nil t)
222 (delete-region (point-min) (point)))
225 (defun nnspool-request-head (id &optional newsgroup server)
226 "Select article head by message ID (or number)."
227 (nnspool-possibly-change-directory newsgroup)
228 (if (nnspool-request-article id)
230 (set-buffer nntp-server-buffer)
231 (goto-char (point-min))
232 (if (search-forward "\n\n" nil t)
233 (delete-region (1- (point)) (point-max)))
236 (defun nnspool-request-group (group &optional server dont-check)
238 (let ((pathname (nnspool-article-pathname
239 (nnspool-replace-chars-in-string group ?. ?/)))
241 (if (file-directory-p pathname)
243 (setq nnspool-current-directory pathname)
246 (setq dir (directory-files pathname nil "^[0-9]+$" t))
247 ;; yes, completely empty spool directories *are* possible
248 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
255 (string-to-int name)))
259 (set-buffer nntp-server-buffer)
263 (format "211 %d %d %d %s\n" (length dir) (car dir)
264 (progn (while (cdr dir) (setq dir (cdr dir)))
267 (insert (format "211 0 0 0 %s\n" group))))))
270 (defun nnspool-request-list (&optional server)
271 "List active newsgoups."
273 (nnspool-find-file nnspool-active-file)))
275 (defun nnspool-request-list-newsgroups (&optional server)
276 "List newsgroups (defined in NNTP2)."
278 (nnspool-find-file nnspool-newsgroups-file)))
280 (defun nnspool-request-list-distributions (&optional server)
281 "List distributions (defined in NNTP2)."
283 (nnspool-find-file nnspool-distributions-file)))
285 (defun nnspool-request-post (&optional server)
286 "Post a new news in current buffer."
288 ;; We have to work in the server buffer because of NEmacs hack.
289 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
290 (set-buffer nntp-server-buffer)
291 (apply (function call-process-region)
292 (point-min) (point-max)
293 nnspool-inews-program 'delete t nil nnspool-inews-switches)
295 (or (zerop (buffer-size))
296 ;; If inews returns strings, it must be error message
297 ;; unless SPOOLNEWS is defined.
298 ;; This condition is very weak, but there is no good rule
299 ;; identifying errors when SPOOLNEWS is defined.
300 ;; Suggested by ohm@kaba.junet.
301 (string-match "spooled" (buffer-string)))
302 ;; Make status message by unfolding lines.
303 (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
304 (setq nnspool-status-string (buffer-string))
307 (fset 'nnspool-request-post-buffer 'nntp-request-post-buffer)
310 ;;; Low-Level Interface.
312 (defun nnspool-open-server-internal (host &optional service)
313 "Open connection to news server on HOST by SERVICE (default is nntp)."
315 (if (not (string-equal host (system-name)))
316 (error "NNSPOOL: cannot talk to %s." host))
317 ;; Initialize communication buffer.
318 (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
319 (set-buffer nntp-server-buffer)
320 (buffer-disable-undo (current-buffer))
322 (kill-all-local-variables)
323 (setq case-fold-search t) ;Should ignore case.
326 (defun nnspool-close-server-internal ()
327 "Close connection to news server."
328 (if (get-file-buffer nnspool-history-file)
329 (kill-buffer (get-file-buffer nnspool-history-file))))
331 (defun nnspool-find-article-by-message-id (id)
332 "Return full pathname of an article identified by message-ID."
334 (let ((buffer (get-file-buffer nnspool-history-file)))
337 ;; Finding history file may take lots of time.
338 (message "Reading history file...")
339 (set-buffer (find-file-noselect nnspool-history-file))
340 (message "Reading history file... done")))
341 ;; Search from end of the file. I think this is much faster than
342 ;; do from the beginning of the file.
343 (goto-char (point-max))
344 (if (re-search-backward
345 (concat "^" (regexp-quote id)
346 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
347 (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
348 (number (buffer-substring (match-beginning 2) (match-end 2))))
349 (concat (nnspool-article-pathname
350 (nnspool-replace-chars-in-string group ?. ?/))
353 (defun nnspool-find-file (file)
354 "Insert FILE in server buffer safely."
355 (set-buffer nntp-server-buffer)
358 (progn (insert-file-contents file) t)
361 (defun nnspool-possibly-change-directory (newsgroup)
363 (let ((pathname (nnspool-article-pathname
364 (nnspool-replace-chars-in-string newsgroup ?. ?/))))
365 (if (file-directory-p pathname)
366 (setq nnspool-current-directory pathname)
367 (error "No such newsgroup: %s" newsgroup)))))
369 (defun nnspool-article-pathname (group)
370 "Make pathname for GROUP."
371 (concat (file-name-as-directory nnspool-spool-directory) group "/"))
373 (defun nnspool-replace-chars-in-string (string from to)
374 "Replace characters in STRING from FROM to TO."
375 (let ((string (substring string 0)) ;Copy string.
376 (len (length string))
378 ;; Replace all occurrences of FROM with TO.
380 (if (= (aref string idx) from)
381 (aset string idx to))
387 ;;; nnspool.el ends here