1 ;;; nnspool.el --- spool access for GNU Emacs
2 ;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Ingebrigtsen <larsi@ifi.uio.no>
8 ;; This file is part of GNU Emacs.
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)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
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.
26 ;; All the Gnus backends have the same interface, and should return
27 ;; data in a similar format. Below is an overview of what functions
28 ;; these packages must supply and what results they should return.
32 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
35 ;; Functions for the imaginary backend `choke':
37 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
38 ;; Should return all headers for all ARTICLES, or return NOV lines for
41 ;; `choke-request-group GROUP &optional SERVER DISCARD'
42 ;; Switch to GROUP. If DISCARD is nil, active information on the group
45 ;; `choke-close-group GROUP &optional SERVER'
46 ;; Close group. Most backends won't have to do anything with this
47 ;; call, but it is an opportunity to clean up, if that is needed. It
48 ;; is called when Gnus exits a group.
50 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
51 ;; Return ARTICLE, which is either an article number or
52 ;; message-id. Note that not all backends can return articles based on
55 ;; `choke-request-list SERVER'
56 ;; Return a list of all active newsgroups on SERVER.
58 ;; `choke-request-list-newsgroups SERVER'
59 ;; Return a list of descriptions of all newsgroups on SERVER.
61 ;; `choke-request-newgroups DATE &optional SERVER'
62 ;; Return a list of all groups that have arrived after DATE on
63 ;; SERVER. Note that the date doesn't have to be respected - Gnus will
64 ;; always check whether the groups are old or not. Backends that do
65 ;; not store date information may just return the entire list of
68 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
69 ;; Should return a buffer that is suitable for "posting". nnspool and
70 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
71 ;; buffer. This function should fill out the appropriate headers.
73 ;; `choke-request-post &optional SERVER'
74 ;; Function that will be called from a buffer to be posted.
76 ;; `choke-open-server SERVER &optional ARGUMENT'
77 ;; Open a connection to SERVER.
79 ;; `choke-close-server &optional SERVER'
80 ;; Close the connection to SERVER.
82 ;; `choke-server-opened &optional SERVER'
83 ;; Whether the conenction to SERVER is opened or not.
85 ;; `choke-server-status &optional SERVER'
86 ;; Should return a status string (not in the nntp buffer, but as the
87 ;; result of the function).
89 ;; The following functions are optional and apply only to backends
90 ;; that are able to control the contents of their groups totally
91 ;; (ie. mail backends.) Backends that aren't able to do that
92 ;; shouldn't define these functions at all. Gnus will check for their
93 ;; presence before attempting to call them.
95 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
96 ;; Should expire (according to some aging scheme) all ARTICLES. Most
97 ;; backends will not be able to expire articles. Should return a list
98 ;; of all articles that were not expired.
100 ;; `choke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM'
101 ;; Should move ARTICLE from GROUP on SERVER by using ACCEPT-FORM.
102 ;; Removes any information it has added to the article (extra headers,
103 ;; whatever - make it as clean as possible), and then passes the
104 ;; article on by evaling ACCEPT-FORM, which is normally a call to the
105 ;; function described below. If the ACCEPT-FORM returns a non-nil
106 ;; value, the article should then be deleted.
108 ;; `choke-request-accept-article GROUP'
109 ;; The contents of the current buffer will be put into GROUP. There
110 ;; should, of course, be an article in the current buffer. This
111 ;; function is normally only called by the function described above.
113 ;; `choke-request-replace-article ARTICLE GROUP BUFFER'
114 ;; Replace ARTICLE in GROUP with the contents of BUFFER.
115 ;; This provides an easy interface for allowing editing of
116 ;; articles. Note that even headers may be edited, so the backend has
117 ;; to update any tables (nov buffers, etc) that it maintains after
118 ;; replacing the article.
120 ;; All these functions must return nil if they couldn't service the
121 ;; request. If the optional arguments are not supplied, some "current"
122 ;; or "default" values should be used. In short, one should emulate an
123 ;; NNTP server, in a way.
125 ;; If you want to write a new backend, you just have to supply the
126 ;; functions listed above. In addition, you must enter the new backend
127 ;; into the list of valid select methods:
128 ;; (setq gnus-valid-select-methods
129 ;; (cons '("choke" mail) gnus-valid-select-methods))
130 ;; The first element in this list is the name of the backend. Other
131 ;; elemnets may be `mail' (for mail groups), `post' (for news
132 ;; groups), `none' (neither), `respool' (for groups that can control
140 (defvar nnspool-inews-program news-inews-program
141 "Program to post news.")
143 (defvar nnspool-inews-switches '("-h")
144 "Switches for nnspool-request-post to pass to `inews' for posting news.")
146 (defvar nnspool-spool-directory news-path
147 "Local news spool directory.")
149 (defvar nnspool-lib-dir "/usr/lib/news/"
150 "Where the local news library files are stored.")
152 (defvar nnspool-active-file (concat nnspool-lib-dir "active")
153 "Local news active file.")
155 (defvar nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups")
156 "Local news newsgroups file.")
158 (defvar nnspool-distributions-file (concat nnspool-lib-dir "distributions")
159 "Local news distributions file.")
161 (defvar nnspool-history-file (concat nnspool-lib-dir "history")
162 "Local news history file.")
164 (defvar nnspool-active-times-file (concat nnspool-lib-dir "active.times")
165 "Local news active date file.")
167 (defvar nnspool-large-newsgroup 50
168 "The number of the articles which indicates a large newsgroup.
169 If the number of the articles is greater than the value, verbose
170 messages will be shown to indicate the current status.")
172 (defvar nnspool-nov-is-evil nil
173 "Non-nil means that nnspool will never return NOV lines instead of headers.")
177 (defconst nnspool-version "nnspool 2.0"
178 "Version numbers of this version of NNSPOOL.")
180 (defvar nnspool-current-directory nil
181 "Current news group directory.")
183 (defvar nnspool-status-string "")
187 ;;; Interface functions.
189 (defun nnspool-retrieve-headers (sequence &optional newsgroup server)
190 "Retrieve the headers for the articles in SEQUENCE.
191 Newsgroup must be selected before calling this function."
193 (set-buffer nntp-server-buffer)
195 (let* ((number (length sequence))
197 (do-message (and (numberp nnspool-large-newsgroup)
198 (> number nnspool-large-newsgroup)))
200 (nnspool-possibly-change-directory newsgroup)
201 (if (nnspool-retrieve-headers-with-nov sequence)
204 (setq article (car sequence))
205 (setq file (concat nnspool-current-directory
206 (int-to-string article)))
207 (and (file-exists-p file)
209 (insert (format "221 %d Article retrieved.\n" article))
211 (insert-file-contents file)
213 (search-forward "\n\n" nil t)
216 (delete-region (point) (point-max))))
217 (setq sequence (cdr sequence))
220 (zerop (% (setq count (1+ count)) 20))
221 (message "NNSPOOL: Receiving headers... %d%%"
222 (/ (* count 100) number))))
224 (and do-message (message "NNSPOOL: Receiving headers... done"))
226 ;; Fold continuation lines.
228 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
229 (replace-match " " t t))
232 (defun nnspool-open-server (host &optional service)
234 (setq nnspool-status-string "")
235 (cond ((and (file-directory-p nnspool-spool-directory)
236 (file-exists-p nnspool-active-file))
237 (nnheader-init-server-buffer))
239 (setq nnspool-status-string
240 (format "NNSPOOL: cannot talk to %s." host))
243 (defun nnspool-close-server (&optional server)
247 (defun nnspool-server-opened (&optional server)
248 "Return server process status, T or NIL.
249 If the stream is opened, return T, otherwise return NIL."
250 (and nntp-server-buffer
251 (get-buffer nntp-server-buffer)))
253 (defun nnspool-status-message ()
254 "Return server status response as string."
255 nnspool-status-string)
257 (defun nnspool-request-article (id &optional newsgroup server buffer)
258 "Select article by message ID (or number)."
259 (nnspool-possibly-change-directory newsgroup)
260 (let ((file (if (stringp id)
261 (nnspool-find-article-by-message-id id)
262 (concat nnspool-current-directory (prin1-to-string id))))
263 (nntp-server-buffer (or buffer nntp-server-buffer)))
264 (if (and (stringp file)
266 (not (file-directory-p file)))
268 (nnspool-find-file file)))))
270 (defun nnspool-request-body (id &optional newsgroup server)
271 "Select article body by message ID (or number)."
272 (nnspool-possibly-change-directory newsgroup)
273 (if (nnspool-request-article id)
275 (set-buffer nntp-server-buffer)
276 (goto-char (point-min))
277 (if (search-forward "\n\n" nil t)
278 (delete-region (point-min) (point)))
281 (defun nnspool-request-head (id &optional newsgroup server)
282 "Select article head by message ID (or number)."
283 (nnspool-possibly-change-directory newsgroup)
284 (if (nnspool-request-article id)
286 (set-buffer nntp-server-buffer)
287 (goto-char (point-min))
288 (if (search-forward "\n\n" nil t)
289 (delete-region (1- (point)) (point-max)))
292 (defun nnspool-request-group (group &optional server dont-check)
294 (let ((pathname (nnspool-article-pathname
295 (nnspool-replace-chars-in-string group ?. ?/)))
297 (if (file-directory-p pathname)
299 (setq nnspool-current-directory pathname)
302 (setq dir (directory-files pathname nil "^[0-9]+$" t))
303 ;; yes, completely empty spool directories *are* possible
304 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
311 (string-to-int name)))
315 (set-buffer nntp-server-buffer)
319 (format "211 %d %d %d %s\n" (length dir) (car dir)
320 (progn (while (cdr dir) (setq dir (cdr dir)))
323 (insert (format "211 0 0 0 %s\n" group))))))
326 (defun nnspool-close-group (group &optional server)
329 (defun nnspool-request-list (&optional server)
330 "List active newsgoups."
332 (nnspool-find-file nnspool-active-file)))
334 (defun nnspool-request-list-newsgroups (&optional server)
335 "List newsgroups (defined in NNTP2)."
337 (nnspool-find-file nnspool-newsgroups-file)))
339 (defun nnspool-request-list-distributions (&optional server)
340 "List distributions (defined in NNTP2)."
342 (nnspool-find-file nnspool-distributions-file)))
344 (defun nnspool-request-newgroups (date &optional server)
345 "List groups created after DATE."
347 (nnspool-find-file nnspool-active-times-file)
348 (setq nnspool-status-string "NEWGROUPS is not supported.")
351 (defun nnspool-request-post (&optional server)
352 "Post a new news in current buffer."
354 ;; We have to work in the server buffer because of NEmacs hack.
355 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
356 (set-buffer nntp-server-buffer)
357 (apply (function call-process-region)
358 (point-min) (point-max)
359 nnspool-inews-program 'delete t nil nnspool-inews-switches)
361 (or (zerop (buffer-size))
362 ;; If inews returns strings, it must be error message
363 ;; unless SPOOLNEWS is defined.
364 ;; This condition is very weak, but there is no good rule
365 ;; identifying errors when SPOOLNEWS is defined.
366 ;; Suggested by ohm@kaba.junet.
367 (string-match "spooled" (buffer-string)))
368 ;; Make status message by unfolding lines.
369 (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
370 (setq nnspool-status-string (buffer-string))
373 (fset 'nnspool-request-post-buffer 'nntp-request-post-buffer)
376 ;;; Internal functions.
378 (defun nnspool-retrieve-headers-with-nov (articles)
379 (if (or gnus-nov-is-evil nnspool-nov-is-evil)
381 (let ((nov (concat nnspool-current-directory ".overview"))
383 (if (file-exists-p nov)
385 (set-buffer nntp-server-buffer)
387 (insert-file-contents nov)
388 ;; First we find the first wanted line. We issue a number
389 ;; of search-forwards - the first article we are lookign
390 ;; for may be expired, so we have to go on searching until
391 ;; we find one of the articles we want.
393 (setq article (concat (int-to-string
394 (car articles) "\t")))
395 (not (or (looking-at article)
396 (search-forward (concat "\n" article)
398 (setq articles (cdr articles)))
402 (delete-region (point-min) (point))
403 ;; Then we find the last wanted line. We go to the end
404 ;; of the buffer and search backward much the same way
405 ;; we did to find the first article.
406 ;; !!! Perhaps it would be better just to do a (last articles),
407 ;; and go forward successively over each line and
408 ;; compare to avoid this (reverse), like this:
409 ;; (while (and (>= last (read nntp-server-buffer)))
410 ;; (zerop (forward-line 1))))
411 (setq articles (reverse articles))
412 (goto-char (point-max))
414 (not (search-backward
415 (concat "\n" (int-to-string (car articles))
417 (setq articles (cdr articles)))
421 (delete-region (point) (point-max)))))
422 (or articles (progn (erase-buffer) nil)))))))
424 (defun nnspool-find-article-by-message-id (id)
425 "Return full pathname of an article identified by message-ID."
427 (set-buffer nntp-server-buffer)
429 (call-process "grep" nil t nil id nnspool-history-file)
430 (goto-char (point-min))
431 (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\(.*\\)$")
432 (concat nnspool-spool-directory
433 (nnspool-replace-chars-in-string
434 (buffer-substring (match-beginning 1) (match-end 1))
437 (defun nnspool-find-file (file)
438 "Insert FILE in server buffer safely."
439 (set-buffer nntp-server-buffer)
442 (progn (insert-file-contents file) t)
445 (defun nnspool-possibly-change-directory (newsgroup)
447 (let ((pathname (nnspool-article-pathname
448 (nnspool-replace-chars-in-string newsgroup ?. ?/))))
449 (if (file-directory-p pathname)
450 (setq nnspool-current-directory pathname)
451 (error "No such newsgroup: %s" newsgroup)))))
453 (defun nnspool-article-pathname (group)
454 "Make pathname for GROUP."
455 (concat (file-name-as-directory nnspool-spool-directory) group "/"))
457 (defun nnspool-replace-chars-in-string (string from to)
458 "Replace characters in STRING from FROM to TO."
459 (let ((string (substring string 0)) ;Copy string.
460 (len (length string))
462 ;; Replace all occurrences of FROM with TO.
464 (if (= (aref string idx) from)
465 (aset string idx to))
471 ;;; nnspool.el ends here