1 ;;; nndb.el --- nndb access for Gnus
3 ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009, 2010 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 3 of the License, or
17 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
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).
53 (unless (fboundp 'declare-function
) (defmacro declare-function
(&rest r
))))
56 ;; Register nndb with known select methods.
59 (unless (assoc "nndb" gnus-valid-select-methods
)
60 (gnus-declare-backend "nndb" 'mail
'respool
'address
'prompt-address
))
65 (eval-when-compile (require 'cl
))
67 ;; Declare nndb as derived from nntp
69 (nnoo-declare nndb nntp
)
71 ;; Variables specific to nndb
73 ;;- currently not used but just in case...
74 (defvoo nndb-deliver-program
"nndel"
75 "*The program used to put a message in an NNDB group.")
77 (defvoo nndb-server-side-expiry nil
78 "If t, expiry calculation will occur on the server side.")
80 (defvoo nndb-set-expire-date-on-mark nil
81 "If t, the expiry date for a given article will be set to the time
82 it was marked as expireable; otherwise the date will be the time the
83 article was posted to nndb")
85 ;; Variables copied from nntp
87 (defvoo nndb-server-opened-hook
'(nntp-send-authinfo-from-file)
88 "Like nntp-server-opened-hook."
89 nntp-server-opened-hook
)
91 (defvoo nndb-address
"localhost"
92 "*The name of the NNDB server."
95 (defvoo nndb-port-number
9000
96 "*Port number to connect to."
99 ;; change to 'news if you are actually using nndb for news
100 (defvoo nndb-article-type
'mail
)
102 (defvoo nndb-status-string nil
"" nntp-status-string
)
106 (defconst nndb-version
"nndb 0.7"
107 "Version numbers of this version of NNDB.")
110 ;;; Interface functions.
112 (nnoo-define-basics nndb
)
114 ;;------------------------------------------------------------------
116 ;; this function turns the lisp list into a string list. There is
117 ;; probably a more efficient way to do this.
118 (defun nndb-build-article-string (articles)
119 (let (art-string art
)
121 (setq art
(pop articles
))
122 (setq art-string
(concat art-string art
" ")))
125 (defun nndb-build-expire-rest-list (total expire
)
128 (setq art
(pop total
))
129 (if (memq art expire
)
136 (deffoo nndb-request-type
(group &optional article
)
139 ;; nndb-request-update-info does not exist and is not needed
141 ;; nndb-request-update-mark does not exist; it should be used to TOUCH
142 ;; articles as they are marked exipirable
143 (defun nndb-touch-article (group article
)
144 (nntp-send-command nil
"X-TOUCH" article
))
146 (deffoo nndb-request-update-mark
148 "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
149 (if (and nndb-set-expire-date-on-mark
(string-equal mark
"E"))
150 (nndb-touch-article group article
))
153 ;; nndb-request-create-group -- currently this isn't necessary; nndb
154 ;; creates groups on demand.
156 ;; todo -- use some other time than the creation time of the article
157 ;; best is time since article has been marked as expirable
159 (defun nndb-request-expire-articles-local
160 (articles &optional group server force
)
161 "Let gnus do the date check and issue the delete commands."
162 (let (msg art delete-list
(num-delete 0) rest
)
163 (nntp-possibly-change-group group server
)
165 (setq art
(pop articles
))
166 (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art
)
167 (setq msg
(nndb-status-message))
168 (if (string-match "^423" msg
)
170 (or (string-match "'\\(.+\\)'" msg
)
171 (error "Not a valid response for X-DATE command: %s"
173 (if (nnmail-expired-article-p
175 (date-to-time (substring msg
(match-beginning 1) (match-end 1)))
178 (setq delete-list
(concat delete-list
" " (int-to-string art
)))
179 (setq num-delete
(1+ num-delete
)))
181 (if (> (length delete-list
) 0)
183 (nnheader-message 5 "Deleting %s article(s) from %s"
184 (int-to-string num-delete
) group
)
185 (nntp-send-command "^[23].*\n" "X-DELETE" delete-list
))
188 (nnheader-message 5 "")
189 (nconc rest articles
)))
191 (defun nndb-get-remote-expire-response ()
193 (set-buffer nntp-server-buffer
)
194 (goto-char (point-min))
195 (if (looking-at "^[34]")
196 ;; x-expire returned error--presume no articles were expirable)
198 ;; otherwise, pull all of the following numbers into the list
199 (re-search-forward "follows\r?\n?" nil t
)
200 (while (re-search-forward "^[0-9]+$" nil t
)
201 (push (string-to-number (match-string 0)) list
)))
204 (defun nndb-request-expire-articles-remote
205 (articles &optional group server force
)
206 "Let the nndb backend expire articles"
207 (let (days art-string delete-list
(num-delete 0))
208 (nntp-possibly-change-group group server
)
210 ;; first calculate the wait period in days
211 (setq days
(or (and nnmail-expiry-wait-function
212 (funcall nnmail-expiry-wait-function group
))
214 ;; now handle the special cases
218 ;; This isn't an expirable group.
220 ((eq days
'immediate
)
224 ;; build article string
225 (setq art-string
(concat days
" " (nndb-build-article-string articles
)))
226 (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string
)
228 (setq delete-list
(nndb-get-remote-expire-response))
229 (setq num-delete
(length delete-list
))
231 (nnheader-message 5 "Deleting %s article(s) from %s"
232 (int-to-string num-delete
) group
))
234 (nndb-build-expire-rest-list articles delete-list
)))
236 (deffoo nndb-request-expire-articles
237 (articles &optional group server force
)
238 "Expires ARTICLES from GROUP on SERVER.
239 If FORCE, delete regardless of exiration date, otherwise use normal
241 (if nndb-server-side-expiry
242 (nndb-request-expire-articles-remote articles group server force
)
243 (nndb-request-expire-articles-local articles group server force
)))
245 ;; _Something_ defines it...
246 (declare-function nndb-request-article
"nndb" t t
)
248 (deffoo nndb-request-move-article
249 (article group server accept-form
&optional last move-is-internal
)
250 "Move ARTICLE (a number) from GROUP on SERVER.
251 Evals ACCEPT-FORM in current buffer, where the article is.
252 Optional LAST is ignored."
253 ;; we guess that the second arg in accept-form is the new group,
254 ;; which it will be for nndb, which is all that matters anyway
255 (let ((new-group (nth 1 accept-form
)) result
)
256 (nntp-possibly-change-group group server
)
258 ;; use the move command for nndb-to-nndb moves
259 (if (string-match "^nndb" new-group
)
260 (let ((new-group-name (gnus-group-real-name new-group
)))
261 (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name
)
262 (cons new-group article
))
263 ;; else move normally
264 (let ((artbuf (get-buffer-create " *nndb move*")))
266 (nndb-request-article article group server artbuf
)
269 (insert-buffer-substring nntp-server-buffer
)
270 (setq result
(eval accept-form
))
271 (kill-buffer (current-buffer))
273 (nndb-request-expire-articles (list article
)
280 (deffoo nndb-request-accept-article
(group server
&optional last
)
281 "The article in the current buffer is put into GROUP."
282 (nntp-possibly-change-group group server
)
284 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group
)
286 (nntp-send-buffer "^[23].*\n"))
288 (set-buffer nntp-server-buffer
)
289 (setq msg
(buffer-string))
290 (or (string-match "^\\([0-9]+\\)" msg
)
291 (error "nndb: %s" msg
))
292 (setq art
(substring msg
(match-beginning 1) (match-end 1)))
293 (nnheader-message 5 "nndb: accepted %s" art
)
296 (deffoo nndb-request-replace-article
(article group buffer
)
297 "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
299 (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article
))
301 (nntp-send-buffer "^[23.*\n")
302 (list (int-to-string article
))))
304 ; nndb-request-delete-group does not exist
305 ; todo -- maybe later
307 ; nndb-request-rename-group does not exist
308 ; todo -- maybe later
310 ;; -- standard compatibility functions
312 (deffoo nndb-status-message
(&optional server
)
313 "Return server status as a string."
314 (set-buffer nntp-server-buffer
)
317 ;; Import stuff from nntp
324 ;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
325 ;;; nndb.el ends here