Commit | Line | Data |
---|---|---|
23f87bed MB |
1 | ;;; nndb.el --- nndb access for Gnus |
2 | ||
e84b4b86 | 3 | ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, |
e3fe4da0 | 4 | ;; 2005, 2006, 2007, 2008 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 | ||
43ec1709 GM |
51 | ;;; Code: |
52 | ||
53 | ;; For Emacs < 22.2. | |
54 | (eval-and-compile | |
55 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | |
56 | ||
23f87bed MB |
57 | ;;- |
58 | ;; Register nndb with known select methods. | |
59 | ||
8654e13a MB |
60 | (require 'gnus-start) |
61 | (unless (assoc "nndb" gnus-valid-select-methods) | |
62 | (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) | |
23f87bed | 63 | |
23f87bed MB |
64 | (require 'nnmail) |
65 | (require 'nnheader) | |
66 | (require 'nntp) | |
67 | (eval-when-compile (require 'cl)) | |
68 | ||
23f87bed MB |
69 | ;; Declare nndb as derived from nntp |
70 | ||
71 | (nnoo-declare nndb nntp) | |
72 | ||
73 | ;; Variables specific to nndb | |
74 | ||
75 | ;;- currently not used but just in case... | |
76 | (defvoo nndb-deliver-program "nndel" | |
77 | "*The program used to put a message in an NNDB group.") | |
78 | ||
79 | (defvoo nndb-server-side-expiry nil | |
80 | "If t, expiry calculation will occur on the server side.") | |
81 | ||
82 | (defvoo nndb-set-expire-date-on-mark nil | |
83 | "If t, the expiry date for a given article will be set to the time | |
84 | it was marked as expireable; otherwise the date will be the time the | |
85 | article was posted to nndb") | |
86 | ||
87 | ;; Variables copied from nntp | |
88 | ||
89 | (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) | |
90 | "Like nntp-server-opened-hook." | |
91 | nntp-server-opened-hook) | |
92 | ||
93 | (defvoo nndb-address "localhost" | |
94 | "*The name of the NNDB server." | |
95 | nntp-address) | |
96 | ||
97 | (defvoo nndb-port-number 9000 | |
98 | "*Port number to connect to." | |
99 | nntp-port-number) | |
100 | ||
101 | ;; change to 'news if you are actually using nndb for news | |
102 | (defvoo nndb-article-type 'mail) | |
103 | ||
104 | (defvoo nndb-status-string nil "" nntp-status-string) | |
105 | ||
106 | \f | |
107 | ||
108 | (defconst nndb-version "nndb 0.7" | |
109 | "Version numbers of this version of NNDB.") | |
110 | ||
111 | \f | |
112 | ;;; Interface functions. | |
113 | ||
114 | (nnoo-define-basics nndb) | |
115 | ||
116 | ;;------------------------------------------------------------------ | |
117 | ||
118 | ;; this function turns the lisp list into a string list. There is | |
119 | ;; probably a more efficient way to do this. | |
120 | (defun nndb-build-article-string (articles) | |
121 | (let (art-string art) | |
122 | (while articles | |
123 | (setq art (pop articles)) | |
124 | (setq art-string (concat art-string art " "))) | |
125 | art-string)) | |
126 | ||
127 | (defun nndb-build-expire-rest-list (total expire) | |
128 | (let (art rest) | |
129 | (while total | |
130 | (setq art (pop total)) | |
131 | (if (memq art expire) | |
132 | () | |
133 | (push art rest))) | |
134 | rest)) | |
135 | ||
136 | ||
137 | ;; | |
138 | (deffoo nndb-request-type (group &optional article) | |
139 | nndb-article-type) | |
140 | ||
141 | ;; nndb-request-update-info does not exist and is not needed | |
142 | ||
143 | ;; nndb-request-update-mark does not exist; it should be used to TOUCH | |
144 | ;; articles as they are marked exipirable | |
145 | (defun nndb-touch-article (group article) | |
146 | (nntp-send-command nil "X-TOUCH" article)) | |
147 | ||
148 | (deffoo nndb-request-update-mark | |
149 | (group article mark) | |
150 | "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" | |
151 | (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) | |
152 | (nndb-touch-article group article)) | |
153 | mark) | |
154 | ||
155 | ;; nndb-request-create-group -- currently this isn't necessary; nndb | |
156 | ;; creates groups on demand. | |
157 | ||
158 | ;; todo -- use some other time than the creation time of the article | |
159 | ;; best is time since article has been marked as expirable | |
160 | ||
161 | (defun nndb-request-expire-articles-local | |
162 | (articles &optional group server force) | |
163 | "Let gnus do the date check and issue the delete commands." | |
164 | (let (msg art delete-list (num-delete 0) rest) | |
165 | (nntp-possibly-change-group group server) | |
166 | (while articles | |
167 | (setq art (pop articles)) | |
168 | (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) | |
169 | (setq msg (nndb-status-message)) | |
170 | (if (string-match "^423" msg) | |
171 | () | |
172 | (or (string-match "'\\(.+\\)'" msg) | |
173 | (error "Not a valid response for X-DATE command: %s" | |
174 | msg)) | |
175 | (if (nnmail-expired-article-p | |
176 | group | |
177 | (date-to-time (substring msg (match-beginning 1) (match-end 1))) | |
178 | force) | |
179 | (progn | |
180 | (setq delete-list (concat delete-list " " (int-to-string art))) | |
181 | (setq num-delete (1+ num-delete))) | |
182 | (push art rest)))) | |
183 | (if (> (length delete-list) 0) | |
184 | (progn | |
185 | (nnheader-message 5 "Deleting %s article(s) from %s" | |
186 | (int-to-string num-delete) group) | |
187 | (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) | |
188 | ) | |
189 | ||
190 | (nnheader-message 5 "") | |
191 | (nconc rest articles))) | |
192 | ||
193 | (defun nndb-get-remote-expire-response () | |
194 | (let (list) | |
195 | (set-buffer nntp-server-buffer) | |
196 | (goto-char (point-min)) | |
197 | (if (looking-at "^[34]") | |
198 | ;; x-expire returned error--presume no articles were expirable) | |
199 | (setq list nil) | |
200 | ;; otherwise, pull all of the following numbers into the list | |
201 | (re-search-forward "follows\r?\n?" nil t) | |
202 | (while (re-search-forward "^[0-9]+$" nil t) | |
e9bd5782 | 203 | (push (string-to-number (match-string 0)) list))) |
23f87bed MB |
204 | list)) |
205 | ||
206 | (defun nndb-request-expire-articles-remote | |
207 | (articles &optional group server force) | |
208 | "Let the nndb backend expire articles" | |
209 | (let (days art-string delete-list (num-delete 0)) | |
210 | (nntp-possibly-change-group group server) | |
211 | ||
212 | ;; first calculate the wait period in days | |
213 | (setq days (or (and nnmail-expiry-wait-function | |
214 | (funcall nnmail-expiry-wait-function group)) | |
215 | nnmail-expiry-wait)) | |
216 | ;; now handle the special cases | |
217 | (cond (force | |
218 | (setq days 0)) | |
219 | ((eq days 'never) | |
220 | ;; This isn't an expirable group. | |
221 | (setq days -1)) | |
222 | ((eq days 'immediate) | |
223 | (setq days 0))) | |
224 | ||
225 | ||
226 | ;; build article string | |
227 | (setq art-string (concat days " " (nndb-build-article-string articles))) | |
228 | (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) | |
229 | ||
230 | (setq delete-list (nndb-get-remote-expire-response)) | |
231 | (setq num-delete (length delete-list)) | |
232 | (if (> num-delete 0) | |
233 | (nnheader-message 5 "Deleting %s article(s) from %s" | |
234 | (int-to-string num-delete) group)) | |
235 | ||
236 | (nndb-build-expire-rest-list articles delete-list))) | |
237 | ||
238 | (deffoo nndb-request-expire-articles | |
239 | (articles &optional group server force) | |
240 | "Expires ARTICLES from GROUP on SERVER. | |
241 | If FORCE, delete regardless of exiration date, otherwise use normal | |
242 | expiry mechanism." | |
243 | (if nndb-server-side-expiry | |
244 | (nndb-request-expire-articles-remote articles group server force) | |
245 | (nndb-request-expire-articles-local articles group server force))) | |
246 | ||
43ec1709 GM |
247 | ;; _Something_ defines it... |
248 | (declare-function nndb-request-article "nndb" t t) | |
249 | ||
23f87bed | 250 | (deffoo nndb-request-move-article |
01c52d31 | 251 | (article group server accept-form &optional last move-is-internal) |
23f87bed MB |
252 | "Move ARTICLE (a number) from GROUP on SERVER. |
253 | Evals ACCEPT-FORM in current buffer, where the article is. | |
254 | Optional LAST is ignored." | |
255 | ;; we guess that the second arg in accept-form is the new group, | |
256 | ;; which it will be for nndb, which is all that matters anyway | |
257 | (let ((new-group (nth 1 accept-form)) result) | |
258 | (nntp-possibly-change-group group server) | |
259 | ||
260 | ;; use the move command for nndb-to-nndb moves | |
261 | (if (string-match "^nndb" new-group) | |
262 | (let ((new-group-name (gnus-group-real-name new-group))) | |
263 | (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) | |
264 | (cons new-group article)) | |
265 | ;; else move normally | |
266 | (let ((artbuf (get-buffer-create " *nndb move*"))) | |
267 | (and | |
268 | (nndb-request-article article group server artbuf) | |
269 | (save-excursion | |
270 | (set-buffer artbuf) | |
271 | (insert-buffer-substring nntp-server-buffer) | |
272 | (setq result (eval accept-form)) | |
273 | (kill-buffer (current-buffer)) | |
274 | result) | |
275 | (nndb-request-expire-articles (list article) | |
276 | group | |
277 | server | |
278 | t)) | |
279 | result) | |
280 | ))) | |
281 | ||
282 | (deffoo nndb-request-accept-article (group server &optional last) | |
283 | "The article in the current buffer is put into GROUP." | |
284 | (nntp-possibly-change-group group server) | |
285 | (let (art msg) | |
286 | (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) | |
287 | (nnheader-insert "") | |
288 | (nntp-send-buffer "^[23].*\n")) | |
289 | ||
290 | (set-buffer nntp-server-buffer) | |
291 | (setq msg (buffer-string)) | |
292 | (or (string-match "^\\([0-9]+\\)" msg) | |
293 | (error "nndb: %s" msg)) | |
294 | (setq art (substring msg (match-beginning 1) (match-end 1))) | |
295 | (nnheader-message 5 "nndb: accepted %s" art) | |
296 | (list art))) | |
297 | ||
298 | (deffoo nndb-request-replace-article (article group buffer) | |
299 | "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." | |
300 | (set-buffer buffer) | |
301 | (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) | |
302 | (nnheader-insert "") | |
303 | (nntp-send-buffer "^[23.*\n") | |
304 | (list (int-to-string article)))) | |
305 | ||
306 | ; nndb-request-delete-group does not exist | |
307 | ; todo -- maybe later | |
308 | ||
309 | ; nndb-request-rename-group does not exist | |
310 | ; todo -- maybe later | |
311 | ||
312 | ;; -- standard compatability functions | |
313 | ||
314 | (deffoo nndb-status-message (&optional server) | |
315 | "Return server status as a string." | |
316 | (set-buffer nntp-server-buffer) | |
317 | (buffer-string)) | |
318 | ||
319 | ;; Import stuff from nntp | |
320 | ||
321 | (nnoo-import nndb | |
322 | (nntp)) | |
323 | ||
324 | (provide 'nndb) | |
325 | ||
cbee283d | 326 | ;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a |
23f87bed | 327 | ;;; nndb.el ends here |