1 ;;; nndb.el --- nndb access for Gnus
2 ;; Copyright (C) 1997,98 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
6 ;; Joe Hildebrand <joe.hildebrand@ilg.com>
7 ;; David Blacka <davidb@rwhois.net>
10 ;; This file is NOT part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;;; This was based upon Kai Grossjohan's shamessly snarfed code and
30 ;;; further modified by Joe Hildebrand. It has been updated for Red
35 ;; * Fix bug where server connection can be lost and impossible to regain
36 ;; This hasn't happened to me in a while; think it was fixed in Rgnus
38 ;; * make it handle different nndb servers seemlessly
40 ;; * Optimize expire if FORCE
42 ;; * Optimize move (only expire once)
44 ;; * Deal with add/deletion of groups
46 ;; * make the backend TOUCH an article when marked as expireable (will
47 ;; make article expire 'expiry' days after that moment).
50 ;; Register nndb with known select methods.
52 (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
59 (eval-when-compile (require 'cl))
62 (unless (fboundp 'open-network-stream)
65 (eval-when-compile (require 'cl))
68 (autoload 'news-setup "rnewspost")
69 (autoload 'news-reply-mode "rnewspost")
70 (autoload 'cancel-timer "timer")
71 (autoload 'telnet "telnet" nil t)
72 (autoload 'telnet-send-input "telnet" nil t)
73 (autoload 'timezone-parse-date "timezone")
74 (autoload 'gnus-declare-backend "gnus-start"))
76 ;; Declare nndb as derived from nntp
78 (nnoo-declare nndb nntp)
80 ;; Variables specific to nndb
82 ;;- currently not used but just in case...
83 (defvoo nndb-deliver-program "nndel"
84 "*The program used to put a message in an NNDB group.")
86 (defvoo nndb-server-side-expiry nil
87 "If t, expiry calculation will occur on the server side")
89 (defvoo nndb-set-expire-date-on-mark nil
90 "If t, the expiry date for a given article will be set to the time
91 it was marked as expireable; otherwise the date will be the time the
92 article was posted to nndb")
94 ;; Variables copied from nntp
96 (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
97 "Like nntp-server-opened-hook."
98 nntp-server-opened-hook)
100 (defvoo nndb-address "localhost"
101 "*The name of the NNDB server."
104 (defvoo nndb-port-number 9000
105 "*Port number to connect to."
108 ;; change to 'news if you are actually using nndb for news
109 (defvoo nndb-article-type 'mail)
111 (defvoo nndb-status-string nil "" nntp-status-string)
115 (defconst nndb-version "nndb 0.7"
116 "Version numbers of this version of NNDB.")
119 ;;; Interface functions.
121 (nnoo-define-basics nndb)
123 ;;------------------------------------------------------------------
125 ;; this function turns the lisp list into a string list. There is
126 ;; probably a more efficient way to do this.
127 (defun nndb-build-article-string (articles)
128 (let (art-string art)
130 (setq art (pop articles))
131 (setq art-string (concat art-string art " ")))
134 (defun nndb-build-expire-rest-list (total expire)
137 (setq art (pop total))
138 (if (memq art expire)
145 (deffoo nndb-request-type (group &optional article)
148 ;; nndb-request-update-info does not exist and is not needed
150 ;; nndb-request-update-mark does not exist; it should be used to TOUCH
151 ;; articles as they are marked exipirable
152 (defun nndb-touch-article (group article)
153 (nntp-send-command nil "X-TOUCH" article))
155 (deffoo nndb-request-update-mark
157 "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
158 (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
159 (nndb-touch-article group article))
162 ;; nndb-request-create-group -- currently this isn't necessary; nndb
163 ;; creates groups on demand.
165 ;; todo -- use some other time than the creation time of the article
166 ;; best is time since article has been marked as expirable
168 (defun nndb-request-expire-articles-local
169 (articles &optional group server force)
170 "Let gnus do the date check and issue the delete commands."
171 (let (msg art delete-list (num-delete 0) rest)
172 (nntp-possibly-change-group group server)
174 (setq art (pop articles))
175 (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
176 (setq msg (nndb-status-message))
177 (if (string-match "^423" msg)
179 (or (string-match "'\\(.+\\)'" msg)
180 (error "Not a valid response for X-DATE command: %s"
182 (if (nnmail-expired-article-p
185 (substring msg (match-beginning 1) (match-end 1)))
188 (setq delete-list (concat delete-list " " (int-to-string art)))
189 (setq num-delete (1+ num-delete)))
191 (if (> (length delete-list) 0)
193 (nnheader-message 5 "Deleting %s article(s) from %s"
194 (int-to-string num-delete) group)
195 (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
198 (nnheader-message 5 "")
199 (nconc rest articles)))
201 (defun nndb-get-remote-expire-response ()
203 (set-buffer nntp-server-buffer)
204 (goto-char (point-min))
205 (if (looking-at "^[34]")
206 ;; x-expire returned error--presume no articles were expirable)
208 ;; otherwise, pull all of the following numbers into the list
209 (re-search-forward "follows\r?\n?" nil t)
210 (while (re-search-forward "^[0-9]+$" nil t)
211 (push (string-to-int (match-string 0)) list)))
214 (defun nndb-request-expire-articles-remote
215 (articles &optional group server force)
216 "Let the nndb backend expire articles"
217 (let (days art-string delete-list (num-delete 0))
218 (nntp-possibly-change-group group server)
220 ;; first calculate the wait period in days
221 (setq days (or (and nnmail-expiry-wait-function
222 (funcall nnmail-expiry-wait-function group))
224 ;; now handle the special cases
228 ;; This isn't an expirable group.
230 ((eq days 'immediate)
234 ;; build article string
235 (setq art-string (concat days " " (nndb-build-article-string articles)))
236 (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
238 (setq delete-list (nndb-get-remote-expire-response))
239 (setq num-delete (length delete-list))
241 (nnheader-message 5 "Deleting %s article(s) from %s"
242 (int-to-string num-delete) group))
244 (nndb-build-expire-rest-list articles delete-list)))
246 (deffoo nndb-request-expire-articles
247 (articles &optional group server force)
248 "Expires ARTICLES from GROUP on SERVER.
249 If FORCE, delete regardless of exiration date, otherwise use normal
251 (if nndb-server-side-expiry
252 (nndb-request-expire-articles-remote articles group server force)
253 (nndb-request-expire-articles-local articles group server force)))
255 (deffoo nndb-request-move-article
256 (article group server accept-form &optional last)
257 "Move ARTICLE (a number) from GROUP on SERVER.
258 Evals ACCEPT-FORM in current buffer, where the article is.
259 Optional LAST is ignored."
260 ;; we guess that the second arg in accept-form is the new group,
261 ;; which it will be for nndb, which is all that matters anyway
262 (let ((new-group (nth 1 accept-form)) result)
263 (nntp-possibly-change-group group server)
265 ;; use the move command for nndb-to-nndb moves
266 (if (string-match "^nndb" new-group)
267 (let ((new-group-name (gnus-group-real-name new-group)))
268 (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
269 (cons new-group article))
270 ;; else move normally
271 (let ((artbuf (get-buffer-create " *nndb move*")))
273 (nndb-request-article article group server artbuf)
276 (insert-buffer-substring nntp-server-buffer)
277 (setq result (eval accept-form))
278 (kill-buffer (current-buffer))
280 (nndb-request-expire-articles (list article)
287 (deffoo nndb-request-accept-article (group server &optional last)
288 "The article in the current buffer is put into GROUP."
289 (nntp-possibly-change-group group server)
291 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
293 (nntp-send-buffer "^[23].*\n"))
295 (set-buffer nntp-server-buffer)
296 (setq msg (buffer-string (point-min) (point-max)))
297 (or (string-match "^\\([0-9]+\\)" msg)
298 (error "nndb: %s" msg))
299 (setq art (substring msg (match-beginning 1) (match-end 1)))
300 (nnheader-message 5 "nndb: accepted %s" art)
303 (deffoo nndb-request-replace-article (article group buffer)
304 "ARTICLE is the number of the article in GROUP to be replaced
305 with the contents of the BUFFER."
307 (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
309 (nntp-send-buffer "^[23.*\n")
310 (list (int-to-string article))))
312 ; nndb-request-delete-group does not exist
313 ; todo -- maybe later
315 ; nndb-request-rename-group does not exist
316 ; todo -- maybe later
318 ;; -- standard compatability functions
320 (deffoo nndb-status-message (&optional server)
321 "Return server status as a string."
322 (set-buffer nntp-server-buffer)
323 (buffer-string (point-min) (point-max)))
325 ;; Import stuff from nntp