1 ;;; nndb.el --- nndb access for Gnus
3 ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
7 ;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
8 ;; Joe Hildebrand <joe.hildebrand@ilg.com>
9 ;; David Blacka <davidb@rwhois.net>
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;;; This was based upon Kai Grossjohan's shamessly snarfed code and
32 ;;; further modified by Joe Hildebrand. It has been updated for Red
37 ;; * Fix bug where server connection can be lost and impossible to regain
38 ;; This hasn't happened to me in a while; think it was fixed in Rgnus
40 ;; * make it handle different nndb servers seemlessly
42 ;; * Optimize expire if FORCE
44 ;; * Optimize move (only expire once)
46 ;; * Deal with add/deletion of groups
48 ;; * make the backend TOUCH an article when marked as expireable (will
49 ;; make article expire 'expiry' days after that moment).
52 ;; Register nndb with known select methods.
55 (unless (assoc "nndb" gnus-valid-select-methods
)
56 (gnus-declare-backend "nndb" 'mail
'respool
'address
'prompt-address
))
63 (eval-when-compile (require 'cl
))
65 ;; Declare nndb as derived from nntp
67 (nnoo-declare nndb nntp
)
69 ;; Variables specific to nndb
71 ;;- currently not used but just in case...
72 (defvoo nndb-deliver-program
"nndel"
73 "*The program used to put a message in an NNDB group.")
75 (defvoo nndb-server-side-expiry nil
76 "If t, expiry calculation will occur on the server side.")
78 (defvoo nndb-set-expire-date-on-mark nil
79 "If t, the expiry date for a given article will be set to the time
80 it was marked as expireable; otherwise the date will be the time the
81 article was posted to nndb")
83 ;; Variables copied from nntp
85 (defvoo nndb-server-opened-hook
'(nntp-send-authinfo-from-file)
86 "Like nntp-server-opened-hook."
87 nntp-server-opened-hook
)
89 (defvoo nndb-address
"localhost"
90 "*The name of the NNDB server."
93 (defvoo nndb-port-number
9000
94 "*Port number to connect to."
97 ;; change to 'news if you are actually using nndb for news
98 (defvoo nndb-article-type
'mail
)
100 (defvoo nndb-status-string nil
"" nntp-status-string
)
104 (defconst nndb-version
"nndb 0.7"
105 "Version numbers of this version of NNDB.")
108 ;;; Interface functions.
110 (nnoo-define-basics nndb
)
112 ;;------------------------------------------------------------------
114 ;; this function turns the lisp list into a string list. There is
115 ;; probably a more efficient way to do this.
116 (defun nndb-build-article-string (articles)
117 (let (art-string art
)
119 (setq art
(pop articles
))
120 (setq art-string
(concat art-string art
" ")))
123 (defun nndb-build-expire-rest-list (total expire
)
126 (setq art
(pop total
))
127 (if (memq art expire
)
134 (deffoo nndb-request-type
(group &optional article
)
137 ;; nndb-request-update-info does not exist and is not needed
139 ;; nndb-request-update-mark does not exist; it should be used to TOUCH
140 ;; articles as they are marked exipirable
141 (defun nndb-touch-article (group article
)
142 (nntp-send-command nil
"X-TOUCH" article
))
144 (deffoo nndb-request-update-mark
146 "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
147 (if (and nndb-set-expire-date-on-mark
(string-equal mark
"E"))
148 (nndb-touch-article group article
))
151 ;; nndb-request-create-group -- currently this isn't necessary; nndb
152 ;; creates groups on demand.
154 ;; todo -- use some other time than the creation time of the article
155 ;; best is time since article has been marked as expirable
157 (defun nndb-request-expire-articles-local
158 (articles &optional group server force
)
159 "Let gnus do the date check and issue the delete commands."
160 (let (msg art delete-list
(num-delete 0) rest
)
161 (nntp-possibly-change-group group server
)
163 (setq art
(pop articles
))
164 (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art
)
165 (setq msg
(nndb-status-message))
166 (if (string-match "^423" msg
)
168 (or (string-match "'\\(.+\\)'" msg
)
169 (error "Not a valid response for X-DATE command: %s"
171 (if (nnmail-expired-article-p
173 (date-to-time (substring msg
(match-beginning 1) (match-end 1)))
176 (setq delete-list
(concat delete-list
" " (int-to-string art
)))
177 (setq num-delete
(1+ num-delete
)))
179 (if (> (length delete-list
) 0)
181 (nnheader-message 5 "Deleting %s article(s) from %s"
182 (int-to-string num-delete
) group
)
183 (nntp-send-command "^[23].*\n" "X-DELETE" delete-list
))
186 (nnheader-message 5 "")
187 (nconc rest articles
)))
189 (defun nndb-get-remote-expire-response ()
191 (set-buffer nntp-server-buffer
)
192 (goto-char (point-min))
193 (if (looking-at "^[34]")
194 ;; x-expire returned error--presume no articles were expirable)
196 ;; otherwise, pull all of the following numbers into the list
197 (re-search-forward "follows\r?\n?" nil t
)
198 (while (re-search-forward "^[0-9]+$" nil t
)
199 (push (string-to-number (match-string 0)) list
)))
202 (defun nndb-request-expire-articles-remote
203 (articles &optional group server force
)
204 "Let the nndb backend expire articles"
205 (let (days art-string delete-list
(num-delete 0))
206 (nntp-possibly-change-group group server
)
208 ;; first calculate the wait period in days
209 (setq days
(or (and nnmail-expiry-wait-function
210 (funcall nnmail-expiry-wait-function group
))
212 ;; now handle the special cases
216 ;; This isn't an expirable group.
218 ((eq days
'immediate
)
222 ;; build article string
223 (setq art-string
(concat days
" " (nndb-build-article-string articles
)))
224 (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string
)
226 (setq delete-list
(nndb-get-remote-expire-response))
227 (setq num-delete
(length delete-list
))
229 (nnheader-message 5 "Deleting %s article(s) from %s"
230 (int-to-string num-delete
) group
))
232 (nndb-build-expire-rest-list articles delete-list
)))
234 (deffoo nndb-request-expire-articles
235 (articles &optional group server force
)
236 "Expires ARTICLES from GROUP on SERVER.
237 If FORCE, delete regardless of exiration date, otherwise use normal
239 (if nndb-server-side-expiry
240 (nndb-request-expire-articles-remote articles group server force
)
241 (nndb-request-expire-articles-local articles group server force
)))
243 (deffoo nndb-request-move-article
244 (article group server accept-form
&optional last
)
245 "Move ARTICLE (a number) from GROUP on SERVER.
246 Evals ACCEPT-FORM in current buffer, where the article is.
247 Optional LAST is ignored."
248 ;; we guess that the second arg in accept-form is the new group,
249 ;; which it will be for nndb, which is all that matters anyway
250 (let ((new-group (nth 1 accept-form
)) result
)
251 (nntp-possibly-change-group group server
)
253 ;; use the move command for nndb-to-nndb moves
254 (if (string-match "^nndb" new-group
)
255 (let ((new-group-name (gnus-group-real-name new-group
)))
256 (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name
)
257 (cons new-group article
))
258 ;; else move normally
259 (let ((artbuf (get-buffer-create " *nndb move*")))
261 (nndb-request-article article group server artbuf
)
264 (insert-buffer-substring nntp-server-buffer
)
265 (setq result
(eval accept-form
))
266 (kill-buffer (current-buffer))
268 (nndb-request-expire-articles (list article
)
275 (deffoo nndb-request-accept-article
(group server
&optional last
)
276 "The article in the current buffer is put into GROUP."
277 (nntp-possibly-change-group group server
)
279 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group
)
281 (nntp-send-buffer "^[23].*\n"))
283 (set-buffer nntp-server-buffer
)
284 (setq msg
(buffer-string))
285 (or (string-match "^\\([0-9]+\\)" msg
)
286 (error "nndb: %s" msg
))
287 (setq art
(substring msg
(match-beginning 1) (match-end 1)))
288 (nnheader-message 5 "nndb: accepted %s" art
)
291 (deffoo nndb-request-replace-article
(article group buffer
)
292 "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
294 (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article
))
296 (nntp-send-buffer "^[23.*\n")
297 (list (int-to-string article
))))
299 ; nndb-request-delete-group does not exist
300 ; todo -- maybe later
302 ; nndb-request-rename-group does not exist
303 ; todo -- maybe later
305 ;; -- standard compatability functions
307 (deffoo nndb-status-message
(&optional server
)
308 "Return server status as a string."
309 (set-buffer nntp-server-buffer
)
312 ;; Import stuff from nntp
319 ;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
320 ;;; nndb.el ends here