Commit | Line | Data |
---|---|---|
23f87bed MB |
1 | ;;; nndb.el --- nndb access for Gnus |
2 | ||
e84b4b86 | 3 | ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, |
d7a0267c | 4 | ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
23f87bed MB |
5 | |
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> | |
10 | ;; Keywords: news | |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
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 | |
5a9dffec | 16 | ;; the Free Software Foundation; either version 3, or (at your option) |
23f87bed MB |
17 | ;; any later version. |
18 | ||
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. | |
23 | ||
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 | |
3a35cf56 LK |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 | ;; Boston, MA 02110-1301, USA. | |
23f87bed MB |
28 | |
29 | ;;; Commentary: | |
30 | ||
31 | ;;; This was based upon Kai Grossjohan's shamessly snarfed code and | |
32 | ;;; further modified by Joe Hildebrand. It has been updated for Red | |
33 | ;;; Gnus. | |
34 | ||
35 | ;; TODO: | |
36 | ;; | |
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 | |
39 | ;; | |
40 | ;; * make it handle different nndb servers seemlessly | |
41 | ;; | |
42 | ;; * Optimize expire if FORCE | |
43 | ;; | |
44 | ;; * Optimize move (only expire once) | |
45 | ;; | |
46 | ;; * Deal with add/deletion of groups | |
47 | ;; | |
48 | ;; * make the backend TOUCH an article when marked as expireable (will | |
49 | ;; make article expire 'expiry' days after that moment). | |
50 | ||
51 | ;;- | |
52 | ;; Register nndb with known select methods. | |
53 | ||
8654e13a MB |
54 | (require 'gnus-start) |
55 | (unless (assoc "nndb" gnus-valid-select-methods) | |
56 | (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) | |
23f87bed MB |
57 | |
58 | ;;; Code: | |
59 | ||
60 | (require 'nnmail) | |
61 | (require 'nnheader) | |
62 | (require 'nntp) | |
63 | (eval-when-compile (require 'cl)) | |
64 | ||
23f87bed MB |
65 | ;; Declare nndb as derived from nntp |
66 | ||
67 | (nnoo-declare nndb nntp) | |
68 | ||
69 | ;; Variables specific to nndb | |
70 | ||
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.") | |
74 | ||
75 | (defvoo nndb-server-side-expiry nil | |
76 | "If t, expiry calculation will occur on the server side.") | |
77 | ||
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") | |
82 | ||
83 | ;; Variables copied from nntp | |
84 | ||
85 | (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) | |
86 | "Like nntp-server-opened-hook." | |
87 | nntp-server-opened-hook) | |
88 | ||
89 | (defvoo nndb-address "localhost" | |
90 | "*The name of the NNDB server." | |
91 | nntp-address) | |
92 | ||
93 | (defvoo nndb-port-number 9000 | |
94 | "*Port number to connect to." | |
95 | nntp-port-number) | |
96 | ||
97 | ;; change to 'news if you are actually using nndb for news | |
98 | (defvoo nndb-article-type 'mail) | |
99 | ||
100 | (defvoo nndb-status-string nil "" nntp-status-string) | |
101 | ||
102 | \f | |
103 | ||
104 | (defconst nndb-version "nndb 0.7" | |
105 | "Version numbers of this version of NNDB.") | |
106 | ||
107 | \f | |
108 | ;;; Interface functions. | |
109 | ||
110 | (nnoo-define-basics nndb) | |
111 | ||
112 | ;;------------------------------------------------------------------ | |
113 | ||
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) | |
118 | (while articles | |
119 | (setq art (pop articles)) | |
120 | (setq art-string (concat art-string art " "))) | |
121 | art-string)) | |
122 | ||
123 | (defun nndb-build-expire-rest-list (total expire) | |
124 | (let (art rest) | |
125 | (while total | |
126 | (setq art (pop total)) | |
127 | (if (memq art expire) | |
128 | () | |
129 | (push art rest))) | |
130 | rest)) | |
131 | ||
132 | ||
133 | ;; | |
134 | (deffoo nndb-request-type (group &optional article) | |
135 | nndb-article-type) | |
136 | ||
137 | ;; nndb-request-update-info does not exist and is not needed | |
138 | ||
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)) | |
143 | ||
144 | (deffoo nndb-request-update-mark | |
145 | (group article 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)) | |
149 | mark) | |
150 | ||
151 | ;; nndb-request-create-group -- currently this isn't necessary; nndb | |
152 | ;; creates groups on demand. | |
153 | ||
154 | ;; todo -- use some other time than the creation time of the article | |
155 | ;; best is time since article has been marked as expirable | |
156 | ||
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) | |
162 | (while articles | |
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) | |
167 | () | |
168 | (or (string-match "'\\(.+\\)'" msg) | |
169 | (error "Not a valid response for X-DATE command: %s" | |
170 | msg)) | |
171 | (if (nnmail-expired-article-p | |
172 | group | |
173 | (date-to-time (substring msg (match-beginning 1) (match-end 1))) | |
174 | force) | |
175 | (progn | |
176 | (setq delete-list (concat delete-list " " (int-to-string art))) | |
177 | (setq num-delete (1+ num-delete))) | |
178 | (push art rest)))) | |
179 | (if (> (length delete-list) 0) | |
180 | (progn | |
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)) | |
184 | ) | |
185 | ||
186 | (nnheader-message 5 "") | |
187 | (nconc rest articles))) | |
188 | ||
189 | (defun nndb-get-remote-expire-response () | |
190 | (let (list) | |
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) | |
195 | (setq list nil) | |
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) | |
e9bd5782 | 199 | (push (string-to-number (match-string 0)) list))) |
23f87bed MB |
200 | list)) |
201 | ||
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) | |
207 | ||
208 | ;; first calculate the wait period in days | |
209 | (setq days (or (and nnmail-expiry-wait-function | |
210 | (funcall nnmail-expiry-wait-function group)) | |
211 | nnmail-expiry-wait)) | |
212 | ;; now handle the special cases | |
213 | (cond (force | |
214 | (setq days 0)) | |
215 | ((eq days 'never) | |
216 | ;; This isn't an expirable group. | |
217 | (setq days -1)) | |
218 | ((eq days 'immediate) | |
219 | (setq days 0))) | |
220 | ||
221 | ||
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) | |
225 | ||
226 | (setq delete-list (nndb-get-remote-expire-response)) | |
227 | (setq num-delete (length delete-list)) | |
228 | (if (> num-delete 0) | |
229 | (nnheader-message 5 "Deleting %s article(s) from %s" | |
230 | (int-to-string num-delete) group)) | |
231 | ||
232 | (nndb-build-expire-rest-list articles delete-list))) | |
233 | ||
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 | |
238 | expiry mechanism." | |
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))) | |
242 | ||
243 | (deffoo nndb-request-move-article | |
01c52d31 | 244 | (article group server accept-form &optional last move-is-internal) |
23f87bed MB |
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) | |
252 | ||
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*"))) | |
260 | (and | |
261 | (nndb-request-article article group server artbuf) | |
262 | (save-excursion | |
263 | (set-buffer artbuf) | |
264 | (insert-buffer-substring nntp-server-buffer) | |
265 | (setq result (eval accept-form)) | |
266 | (kill-buffer (current-buffer)) | |
267 | result) | |
268 | (nndb-request-expire-articles (list article) | |
269 | group | |
270 | server | |
271 | t)) | |
272 | result) | |
273 | ))) | |
274 | ||
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) | |
278 | (let (art msg) | |
279 | (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) | |
280 | (nnheader-insert "") | |
281 | (nntp-send-buffer "^[23].*\n")) | |
282 | ||
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) | |
289 | (list art))) | |
290 | ||
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." | |
293 | (set-buffer buffer) | |
294 | (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) | |
295 | (nnheader-insert "") | |
296 | (nntp-send-buffer "^[23.*\n") | |
297 | (list (int-to-string article)))) | |
298 | ||
299 | ; nndb-request-delete-group does not exist | |
300 | ; todo -- maybe later | |
301 | ||
302 | ; nndb-request-rename-group does not exist | |
303 | ; todo -- maybe later | |
304 | ||
305 | ;; -- standard compatability functions | |
306 | ||
307 | (deffoo nndb-status-message (&optional server) | |
308 | "Return server status as a string." | |
309 | (set-buffer nntp-server-buffer) | |
310 | (buffer-string)) | |
311 | ||
312 | ;; Import stuff from nntp | |
313 | ||
314 | (nnoo-import nndb | |
315 | (nntp)) | |
316 | ||
317 | (provide 'nndb) | |
318 | ||
319 | ;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a | |
320 | ;;; nndb.el ends here |