New feature: toggle visibility of mime buttons.
[more-wl.git] / elmo / elmo-nntp.el
blobf297f9518238f662a2652e9bc5a09cea9f04316d
1 ;;; elmo-nntp.el --- NNTP Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
5 ;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
8 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
9 ;; Kenichi OKADA <okada@opaopa.org>
10 ;; Keywords: mail, net news
12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
14 ;; This program 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)
17 ;; any later version.
19 ;; This program 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., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
30 ;;; Commentary:
33 ;;; Code:
35 (eval-when-compile (require 'cl))
37 (require 'elmo-vars)
38 (require 'elmo-util)
39 (require 'elmo-date)
40 (require 'elmo-msgdb)
41 (require 'elmo-cache)
42 (require 'elmo)
43 (require 'elmo-net)
45 (defvar elmo-nntp-overview-fetch-chop-length 200
46 "*Number of overviews to fetch in one request in nntp.")
48 (defvar elmo-nntp-use-cache t
49 "Use cache in nntp folder.")
51 (defvar elmo-nntp-max-number-precedes-list-active nil
52 "Non-nil means max number of msgdb is set as the max number of `list active'.
53 \(Needed for inn 2.3 or later?\).")
55 (defvar elmo-nntp-group-coding-system nil
56 "A coding system for newsgroup string.")
58 (defconst elmo-nntp-folder-name-syntax `(group
59 (?: [user "^\\([A-Za-z]\\|$\\)"])
60 ,@elmo-net-folder-name-syntax))
62 (defsubst elmo-nntp-encode-group-string (string)
63 (if elmo-nntp-group-coding-system
64 (encode-coding-string string elmo-nntp-group-coding-system)
65 string))
67 (defsubst elmo-nntp-decode-group-string (string)
68 (if elmo-nntp-group-coding-system
69 (decode-coding-string string elmo-nntp-group-coding-system)
70 string))
72 ;; For debugging.
73 (defvar elmo-nntp-debug nil
74 "Non-nil forces NNTP folder as debug mode.
75 Debug information is inserted in the buffer \"*NNTP DEBUG*\"")
77 ;;; Debug
78 (defsubst elmo-nntp-debug (message &rest args)
79 (if elmo-nntp-debug
80 (let ((biff (string-match "BIFF-" (buffer-name)))
81 pos)
82 (with-current-buffer (get-buffer-create (concat "*NNTP DEBUG*"
83 (if biff "BIFF")))
84 (goto-char (point-max))
85 (setq pos (point))
86 (insert (apply 'format message args) "\n")))))
88 ;;; ELMO NNTP folder
89 (eval-and-compile
90 (luna-define-class elmo-nntp-folder (elmo-net-folder)
91 (group temp-crosses reads))
92 (luna-define-internal-accessors 'elmo-nntp-folder))
94 (luna-define-method elmo-folder-initialize ((folder elmo-nntp-folder) name)
95 (let ((elmo-network-stream-type-alist
96 (if elmo-nntp-stream-type-alist
97 (setq elmo-network-stream-type-alist
98 (append elmo-nntp-stream-type-alist
99 elmo-network-stream-type-alist))
100 elmo-network-stream-type-alist))
101 tokens)
102 (setq tokens (car (elmo-parse-separated-tokens
103 name
104 elmo-nntp-folder-name-syntax)))
105 ;; group
106 (elmo-nntp-folder-set-group-internal folder
107 (elmo-nntp-encode-group-string
108 (cdr (assq 'group tokens))))
109 ;; user
110 (elmo-net-folder-set-user-internal folder
111 (let ((user (cdr (assq 'user tokens))))
112 (if user
113 (and (> (length user) 0) user)
114 elmo-nntp-default-user)))
115 ;; network
116 (elmo-net-folder-set-parameters
117 folder
118 tokens
119 (list :server elmo-nntp-default-server
120 :port elmo-nntp-default-port
121 :stream-type
122 (elmo-get-network-stream-type elmo-nntp-default-stream-type)))
123 folder))
125 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
126 (convert-standard-filename
127 (expand-file-name
128 (elmo-nntp-folder-group-internal folder)
129 (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere")
130 (expand-file-name "nntp"
131 elmo-msgdb-directory)))))
133 (luna-define-method elmo-folder-newsgroups ((folder elmo-nntp-folder))
134 (list (elmo-nntp-folder-group-internal folder)))
136 ;;; NNTP Session
137 (eval-and-compile
138 (luna-define-class elmo-nntp-session (elmo-network-session)
139 (current-group))
140 (luna-define-internal-accessors 'elmo-nntp-session))
143 ;; internal variables
146 (defvar elmo-nntp-connection-cache nil
147 "Cache of NNTP connection.")
148 ;; buffer local variable
150 (defvar elmo-nntp-list-folders-use-cache 600
151 "*Time to cache of list folders, as the number of seconds.
152 Don't cache if nil.")
154 (defvar elmo-nntp-list-folders-cache nil)
156 (defvar elmo-nntp-groups-async nil)
157 (defvar elmo-nntp-header-fetch-chop-length 200)
159 (defvar elmo-nntp-read-point 0)
161 (defvar elmo-nntp-send-mode-reader t)
163 (defvar elmo-nntp-opened-hook nil)
165 (defvar elmo-nntp-get-folders-securely nil)
167 (defvar elmo-nntp-default-use-xover t)
169 (defvar elmo-nntp-default-use-listgroup t)
171 (defvar elmo-nntp-default-use-list-active t)
173 (defvar elmo-nntp-default-use-xhdr t)
175 (defvar elmo-nntp-server-command-alist nil)
178 (defconst elmo-nntp-server-command-index '((xover . 0)
179 (listgroup . 1)
180 (list-active . 2)
181 (xhdr . 3)))
183 (defmacro elmo-nntp-get-server-command (session)
184 `(assoc (cons (elmo-network-session-server-internal ,session)
185 (elmo-network-session-port-internal ,session))
186 elmo-nntp-server-command-alist))
188 (defmacro elmo-nntp-set-server-command (session com value)
189 `(let (entry)
190 (unless (setq entry (cdr (elmo-nntp-get-server-command
191 ,session)))
192 (setq elmo-nntp-server-command-alist
193 (nconc elmo-nntp-server-command-alist
194 (list (cons
195 (cons
196 (elmo-network-session-server-internal ,session)
197 (elmo-network-session-port-internal ,session))
198 (setq entry
199 (vector
200 elmo-nntp-default-use-xover
201 elmo-nntp-default-use-listgroup
202 elmo-nntp-default-use-list-active
203 elmo-nntp-default-use-xhdr)))))))
204 (aset entry
205 (cdr (assq ,com elmo-nntp-server-command-index))
206 ,value)))
208 (defmacro elmo-nntp-xover-p (session)
209 `(let ((entry (elmo-nntp-get-server-command ,session)))
210 (if entry
211 (aref (cdr entry)
212 (cdr (assq 'xover elmo-nntp-server-command-index)))
213 elmo-nntp-default-use-xover)))
215 (defmacro elmo-nntp-set-xover (session value)
216 `(elmo-nntp-set-server-command ,session 'xover ,value))
218 (defmacro elmo-nntp-listgroup-p (session)
219 `(let ((entry (elmo-nntp-get-server-command ,session)))
220 (if entry
221 (aref (cdr entry)
222 (cdr (assq 'listgroup elmo-nntp-server-command-index)))
223 elmo-nntp-default-use-listgroup)))
225 (defmacro elmo-nntp-set-listgroup (session value)
226 `(elmo-nntp-set-server-command ,session 'listgroup ,value))
228 (defmacro elmo-nntp-list-active-p (session)
229 `(let ((entry (elmo-nntp-get-server-command ,session)))
230 (if entry
231 (aref (cdr entry)
232 (cdr (assq 'list-active elmo-nntp-server-command-index)))
233 elmo-nntp-default-use-list-active)))
235 (defmacro elmo-nntp-set-list-active (session value)
236 `(elmo-nntp-set-server-command ,session 'list-active ,value))
238 (defmacro elmo-nntp-xhdr-p (session)
239 `(let ((entry (elmo-nntp-get-server-command ,session)))
240 (if entry
241 (aref (cdr entry)
242 (cdr (assq 'xhdr elmo-nntp-server-command-index)))
243 elmo-nntp-default-use-xhdr)))
245 (defmacro elmo-nntp-set-xhdr (session value)
246 `(elmo-nntp-set-server-command ,session 'xhdr ,value))
248 (defsubst elmo-nntp-max-number-precedes-list-active-p ()
249 elmo-nntp-max-number-precedes-list-active)
251 (defsubst elmo-nntp-folder-postfix (user server port type)
252 (concat
253 (and user (concat ":" user))
254 (if (and server
255 (null (string= server elmo-nntp-default-server)))
256 (concat "@" server))
257 (if (and port
258 (null (eq port elmo-nntp-default-port)))
259 (concat ":" (if (numberp port)
260 (int-to-string port) port)))
261 (unless (eq (elmo-network-stream-type-symbol type)
262 elmo-nntp-default-stream-type)
263 (elmo-network-stream-type-spec-string type))))
265 (defun elmo-nntp-get-session (folder &optional if-exists)
266 (elmo-network-get-session
267 'elmo-nntp-session
268 (concat
269 (if (elmo-folder-biff-internal folder)
270 "BIFF-")
271 "NNTP")
272 folder
273 if-exists))
275 (luna-define-method elmo-network-initialize-session ((session
276 elmo-nntp-session))
277 (let ((process (elmo-network-session-process-internal session))
278 response)
279 (set-process-filter (elmo-network-session-process-internal session)
280 'elmo-nntp-process-filter)
281 (with-current-buffer (elmo-network-session-buffer session)
282 (setq elmo-nntp-read-point (point-min))
283 ;; Skip garbage output from process before greeting.
284 (while (and (memq (process-status process) '(open run))
285 (goto-char (point-max))
286 (forward-line -1)
287 (not (looking-at "^[2-5][0-9][0-9]")))
288 (accept-process-output process 1))
289 (setq elmo-nntp-read-point (point))
290 (setq response (elmo-nntp-read-response session t t))
291 (unless (car response)
292 (signal 'elmo-open-error (list (cdr response))))
293 (if elmo-nntp-send-mode-reader
294 (elmo-nntp-send-mode-reader session))
295 (when (eq (elmo-network-stream-type-symbol
296 (elmo-network-session-stream-type-internal session))
297 'starttls)
298 (elmo-nntp-send-command session "starttls")
299 (or (elmo-nntp-read-response session)
300 (error "Cannot open starttls session"))
301 (starttls-negotiate process)))))
303 (luna-define-method elmo-network-authenticate-session ((session
304 elmo-nntp-session))
305 (with-current-buffer (elmo-network-session-buffer session)
306 (when (elmo-network-session-user-internal session)
307 (elmo-nntp-send-command session
308 (format "authinfo user %s"
309 (elmo-network-session-user-internal
310 session))
312 'no-log)
313 (or (elmo-nntp-read-response session)
314 (signal 'elmo-authenticate-error '(authinfo)))
315 (elmo-nntp-send-command
316 session
317 (format "authinfo pass %s"
318 (elmo-get-passwd (elmo-network-session-password-key session)))
320 'no-log)
321 (or (elmo-nntp-read-response session)
322 (signal 'elmo-authenticate-error '(authinfo))))))
324 (luna-define-method elmo-network-setup-session ((session
325 elmo-nntp-session))
326 (run-hooks 'elmo-nntp-opened-hook))
328 (defun elmo-nntp-process-filter (process output)
329 (when (buffer-live-p (process-buffer process))
330 (with-current-buffer (process-buffer process)
331 (goto-char (point-max))
332 (insert output)
333 (elmo-nntp-debug "RECEIVED: %s\n" output))))
335 (defun elmo-nntp-send-mode-reader (session)
336 (elmo-nntp-send-command session "mode reader")
337 (if (null (elmo-nntp-read-response session t))
338 (message "Mode reader failed")))
340 (defun elmo-nntp-send-command (session command &optional noerase no-log)
341 (with-current-buffer (elmo-network-session-buffer session)
342 (unless noerase
343 (erase-buffer)
344 (goto-char (point-min)))
345 (setq elmo-nntp-read-point (point))
346 (elmo-nntp-debug "SEND: %s\n" (if no-log "<NO LOGGING>" command))
347 (process-send-string (elmo-network-session-process-internal
348 session) command)
349 (process-send-string (elmo-network-session-process-internal
350 session) "\r\n")))
352 (defun elmo-nntp-read-response (session &optional not-command error-msg)
353 (with-current-buffer (elmo-network-session-buffer session)
354 (let ((process (elmo-network-session-process-internal session))
355 (case-fold-search nil)
356 (response-string nil)
357 (response-continue t)
358 response match-end)
359 (while response-continue
360 (goto-char elmo-nntp-read-point)
361 (while (not (search-forward "\r\n" nil t))
362 (accept-process-output process)
363 (goto-char elmo-nntp-read-point))
364 (setq match-end (point))
365 (setq response-string
366 (buffer-substring elmo-nntp-read-point (- match-end 2)))
367 (goto-char elmo-nntp-read-point)
368 (if (looking-at "[23][0-9]+ .*$")
369 (progn (setq response-continue nil)
370 (setq elmo-nntp-read-point match-end)
371 (setq response
372 (if response
373 (concat response "\n" response-string)
374 response-string)))
375 (if (looking-at "[^23][0-9]+ .*$")
376 (progn (setq response-continue nil)
377 (setq elmo-nntp-read-point match-end)
378 (setq response nil))
379 (setq elmo-nntp-read-point match-end)
380 (if not-command
381 (setq response-continue nil))
382 (setq response
383 (if response
384 (concat response "\n" response-string)
385 response-string)))
386 (setq elmo-nntp-read-point match-end)))
387 (if error-msg
388 (cons response response-string)
389 response))))
391 (defun elmo-nntp-read-raw-response (session)
392 (with-current-buffer (elmo-network-session-buffer session)
393 (goto-char elmo-nntp-read-point)
394 (while (not (search-forward "\r\n" nil t))
395 (accept-process-output (elmo-network-session-process-internal
396 session))
397 (goto-char elmo-nntp-read-point))
398 (buffer-substring elmo-nntp-read-point (- (point) 2))))
400 (defun elmo-nntp-read-contents (session)
401 (with-current-buffer (elmo-network-session-buffer session)
402 (goto-char elmo-nntp-read-point)
403 (while (not (re-search-forward "^\\.\r\n" nil t))
404 (accept-process-output (elmo-network-session-process-internal
405 session))
406 (goto-char elmo-nntp-read-point))
407 (elmo-delete-cr
408 (buffer-substring elmo-nntp-read-point
409 (- (point) 3)))))
411 (defun elmo-nntp-read-body (session outbuf)
412 (with-current-buffer (elmo-network-session-buffer session)
413 (goto-char elmo-nntp-read-point)
414 (while (not (re-search-forward "^\\.\r\n" nil t))
415 (accept-process-output (elmo-network-session-process-internal session))
416 (goto-char elmo-nntp-read-point))
417 (let ((start elmo-nntp-read-point)
418 (end (point)))
419 (with-current-buffer outbuf
420 (erase-buffer)
421 (insert-buffer-substring (elmo-network-session-buffer session)
422 start (- end 3))
423 (elmo-delete-cr-buffer)))
426 (defun elmo-nntp-select-group (session group &optional force)
427 (let (response)
428 (when (or force
429 (not (string= (elmo-nntp-session-current-group-internal session)
430 group)))
431 (unwind-protect
432 (progn
433 (elmo-nntp-send-command session (format "group %s" group))
434 (setq response (elmo-nntp-read-response session)))
435 (elmo-nntp-session-set-current-group-internal session
436 (and response group))
437 response))))
439 (defun elmo-nntp-list-folders-get-cache (group server buf)
440 (when (and elmo-nntp-list-folders-use-cache
441 elmo-nntp-list-folders-cache
442 (string-match (concat "^"
443 (regexp-quote
445 (nth 1 elmo-nntp-list-folders-cache)
446 "")))
447 (or group ""))
448 (string-match (concat "^"
449 (regexp-quote
451 (nth 2 elmo-nntp-list-folders-cache)
452 "")))
453 (or server "")))
454 (let* ((cache-time (car elmo-nntp-list-folders-cache)))
455 (unless (elmo-time-expire cache-time
456 elmo-nntp-list-folders-use-cache)
457 (save-excursion
458 (set-buffer buf)
459 (erase-buffer)
460 (insert (nth 3 elmo-nntp-list-folders-cache))
461 (goto-char (point-min))
462 (or (string= group "")
463 (and group
464 (keep-lines (concat "^" (regexp-quote group) "\\."))))
466 )))))
468 (defsubst elmo-nntp-catchup-msgdb (msgdb max-number)
469 (let ((numbers (elmo-msgdb-list-messages msgdb))
470 msgdb-max)
471 (setq msgdb-max (if numbers (apply #'max numbers) 0))
472 (when (and msgdb-max
473 max-number
474 (< msgdb-max max-number))
475 (let ((i (1+ msgdb-max))
476 killed)
477 (while (<= i max-number)
478 (setq killed (cons i killed))
479 (incf i))
480 (nreverse killed)))))
482 (luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder)
483 &optional one-level)
484 (elmo-nntp-folder-list-subfolders folder one-level))
486 (defun elmo-nntp-folder-list-subfolders (folder one-level)
487 (let ((session (elmo-nntp-get-session folder))
488 (case-fold-search nil)
489 response ret-val top-ng username append-serv use-list-active start)
490 (with-temp-buffer
491 (set-buffer-multibyte nil)
492 (if (and (elmo-nntp-folder-group-internal folder)
493 (elmo-nntp-select-group
494 session
495 (elmo-nntp-folder-group-internal folder)))
496 ;; add top newsgroups
497 (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
498 (unless (setq response (elmo-nntp-list-folders-get-cache
499 (elmo-nntp-folder-group-internal folder)
500 (elmo-net-folder-server-internal folder)
501 (current-buffer)))
502 (when (setq use-list-active (elmo-nntp-list-active-p session))
503 (elmo-nntp-send-command
504 session
505 (concat "list"
506 (if (and (elmo-nntp-folder-group-internal folder)
507 (not (string= (elmo-nntp-folder-group-internal
508 folder) "")))
509 (concat " active"
510 (format
511 " %s.*"
512 (elmo-nntp-folder-group-internal folder))))))
513 (if (elmo-nntp-read-response session t)
514 (if (null (setq response (elmo-nntp-read-contents session)))
515 (error "NNTP List folders failed")
516 (when elmo-nntp-list-folders-use-cache
517 (setq elmo-nntp-list-folders-cache
518 (list (current-time)
519 (elmo-nntp-folder-group-internal folder)
520 (elmo-net-folder-server-internal folder)
521 response)))
522 (erase-buffer)
523 (insert response))
524 (elmo-nntp-set-list-active session nil)
525 (setq use-list-active nil)))
526 (when (null use-list-active)
527 (elmo-nntp-send-command session "list")
528 (if (null (and (elmo-nntp-read-response session t)
529 (setq response (elmo-nntp-read-contents session))))
530 (error "NNTP List folders failed"))
531 (when elmo-nntp-list-folders-use-cache
532 (setq elmo-nntp-list-folders-cache
533 (list (current-time) nil nil response)))
534 (erase-buffer)
535 (setq start nil)
536 (while (string-match (concat "^"
537 (regexp-quote
539 (elmo-nntp-folder-group-internal
540 folder)
541 "")) ".*$")
542 response start)
543 (insert (match-string 0 response) "\n")
544 (setq start (match-end 0)))))
545 (goto-char (point-min))
546 (elmo-with-progress-display
547 (elmo-nntp-parse-active (count-lines (point-min) (point-max)))
548 "Parsing active"
549 (if one-level
550 (let ((regexp
551 (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
552 (if (and (elmo-nntp-folder-group-internal folder)
553 (null (string=
554 (elmo-nntp-folder-group-internal
555 folder) "")))
556 (concat (elmo-nntp-folder-group-internal
557 folder)
558 "\\.")
559 ""))))
560 (while (looking-at regexp)
561 (setq top-ng (elmo-match-buffer 1))
562 (if (string= (elmo-match-buffer 2) " ")
563 (if (not (or (member top-ng ret-val)
564 (assoc top-ng ret-val)))
565 (setq ret-val (nconc ret-val (list top-ng))))
566 (if (member top-ng ret-val)
567 (setq ret-val (delete top-ng ret-val)))
568 (if (not (assoc top-ng ret-val))
569 (setq ret-val (nconc ret-val (list (list top-ng))))))
570 (elmo-progress-notify 'elmo-nntp-parse-active)
571 (forward-line 1)))
572 (while (re-search-forward "\\([^ ]+\\) .*\n" nil t)
573 (setq ret-val (nconc ret-val
574 (list (elmo-match-buffer 1))))
575 (elmo-progress-notify 'elmo-nntp-parse-active)))))
577 (setq username (or (elmo-net-folder-user-internal folder) ""))
578 (unless (string= username (or elmo-nntp-default-user ""))
579 (setq append-serv (concat append-serv
580 ":" (elmo-quote-syntactical-element
581 username
582 'user elmo-nntp-folder-name-syntax))))
583 (unless (string= (elmo-net-folder-server-internal folder)
584 elmo-nntp-default-server)
585 (setq append-serv (concat append-serv
586 "@" (elmo-net-folder-server-internal folder))))
587 (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
588 (setq append-serv (concat append-serv
589 ":" (int-to-string
590 (elmo-net-folder-port-internal folder)))))
591 (unless (eq (elmo-network-stream-type-symbol
592 (elmo-net-folder-stream-type-internal folder))
593 elmo-nntp-default-stream-type)
594 (setq append-serv
595 (concat append-serv
596 (elmo-network-stream-type-spec-string
597 (elmo-net-folder-stream-type-internal folder)))))
598 (mapcar (lambda (fld)
599 (if (consp fld)
600 (list (concat "-" (elmo-nntp-decode-group-string (car fld))
601 append-serv))
602 (concat "-" (elmo-nntp-decode-group-string fld) append-serv)))
603 ret-val)))
605 (defun elmo-nntp-make-msglist (beg-str end-str)
606 (elmo-make-number-list (string-to-number beg-str)
607 (string-to-number end-str)))
609 (luna-define-method elmo-folder-list-messages-plugged ((folder
610 elmo-nntp-folder)
611 &optional nohide)
612 (let ((session (elmo-nntp-get-session folder))
613 (group (elmo-nntp-folder-group-internal folder))
614 response numbers use-listgroup)
615 (save-excursion
616 (when (setq use-listgroup (elmo-nntp-listgroup-p session))
617 (elmo-nntp-send-command session
618 (format "listgroup %s" group))
619 (if (not (elmo-nntp-read-response session t))
620 (progn
621 (elmo-nntp-set-listgroup session nil)
622 (setq use-listgroup nil))
623 (if (null (setq response (elmo-nntp-read-contents session)))
624 (error "Fetching listgroup failed"))
625 (setq numbers (elmo-string-to-list response))
626 (elmo-nntp-session-set-current-group-internal session
627 group)))
628 (unless use-listgroup
629 (elmo-nntp-send-command session (format "group %s" group))
630 (if (null (setq response (elmo-nntp-read-response session)))
631 (error "Select group failed"))
632 (when (and
633 (string-match
634 "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
635 response)
636 (> (string-to-number (elmo-match-string 1 response)) 0))
637 (setq numbers (elmo-nntp-make-msglist
638 (elmo-match-string 2 response)
639 (elmo-match-string 3 response)))))
640 numbers)))
642 (luna-define-method elmo-folder-status ((folder elmo-nntp-folder))
643 (elmo-nntp-folder-status folder))
645 (defun elmo-nntp-folder-status (folder)
646 (let ((killed-list (elmo-msgdb-killed-list-load
647 (elmo-folder-msgdb-path folder)))
648 end-num entry)
649 (if elmo-nntp-groups-async
650 (if (setq entry
651 (elmo-get-hash-val
652 (concat (elmo-nntp-folder-group-internal folder)
653 (elmo-nntp-folder-postfix
654 (elmo-net-folder-user-internal folder)
655 (elmo-net-folder-server-internal folder)
656 (elmo-net-folder-port-internal folder)
657 (elmo-net-folder-stream-type-internal folder)))
658 elmo-newsgroups-hashtb))
659 (progn
660 (setq end-num (nth 2 entry))
661 (when (and killed-list
662 (elmo-number-set-member end-num killed-list))
663 ;; Max is killed.
664 (setq end-num nil))
665 (cons end-num (car entry)))
666 (error "No such newsgroup \"%s\""
667 (elmo-nntp-folder-group-internal folder)))
668 (let ((session (elmo-nntp-get-session folder))
669 response e-num)
670 (if (null session)
671 (error "Connection failed"))
672 (save-excursion
673 (elmo-nntp-send-command session
674 (format
675 "group %s"
676 (elmo-nntp-folder-group-internal folder)))
677 (setq response (elmo-nntp-read-response session))
678 (if (and response
679 (string-match
680 "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
681 response))
682 (progn
683 (setq end-num (string-to-number
684 (elmo-match-string 3 response)))
685 (setq e-num (string-to-number
686 (elmo-match-string 1 response)))
687 (when (and killed-list
688 (elmo-number-set-member end-num killed-list))
689 ;; Max is killed.
690 (setq end-num nil))
691 (cons end-num e-num))
692 (if (null response)
693 (error "Selecting newsgroup \"%s\" failed"
694 (elmo-nntp-folder-group-internal folder))
695 nil)))))))
697 (defconst elmo-nntp-overview-index
698 '(("number" . 0)
699 ("subject" . 1)
700 ("from" . 2)
701 ("date" . 3)
702 ("message-id" . 4)
703 ("references" . 5)
704 ("size" . 6)
705 ("lines" . 7)
706 ("xref" . 8)))
708 (defun elmo-nntp-create-msgdb-from-overview-string (folder
710 flag-table
711 &optional numlist)
712 (let ((new-msgdb (elmo-make-msgdb))
713 ov-list message-id entity
714 ov-entity num
715 field field-index flags)
716 (setq ov-list (elmo-nntp-parse-overview-string str))
717 (while ov-list
718 (setq ov-entity (car ov-list))
719 ;;; INN bug??
720 ;;; (if (or (> (setq num (string-to-int (aref ov-entity 0)))
721 ;;; 99999)
722 ;;; (<= num 0))
723 ;;; (setq num 0))
724 ;;; (setq num (int-to-string num))
725 (setq num (string-to-number (aref ov-entity 0)))
726 (when (or (null numlist)
727 (memq num numlist))
728 (setq entity (elmo-msgdb-make-message-entity
729 (elmo-msgdb-message-entity-handler new-msgdb)
730 :message-id (aref ov-entity 4)
731 :number num
732 :references (elmo-msgdb-get-last-message-id
733 (aref ov-entity 5))
734 :from (elmo-with-enable-multibyte
735 (eword-decode-string
736 (elmo-delete-char ?\"
737 (or (aref ov-entity 2)
738 elmo-no-from))))
739 :subject (or (elmo-with-enable-multibyte
740 (eword-decode-string
741 (aref ov-entity 1)))
742 elmo-no-subject)
743 :date (aref ov-entity 3)
744 :size (string-to-number (aref ov-entity 6))))
745 (dolist (extra elmo-msgdb-extra-fields)
746 (setq extra (downcase extra))
747 (when (and (setq field-index
748 (cdr (assoc extra elmo-nntp-overview-index)))
749 (> (length ov-entity) field-index))
750 (setq field (aref ov-entity field-index))
751 (when (eq field-index 8) ;; xref
752 (setq field (elmo-msgdb-remove-field-string field)))
753 (elmo-message-entity-set-field entity (intern extra) field)))
754 (setq message-id (elmo-message-entity-field entity 'message-id)
755 flags (elmo-flag-table-get flag-table message-id))
756 (elmo-global-flags-set flags folder num message-id)
757 (elmo-msgdb-append-entity new-msgdb entity flags))
758 (setq ov-list (cdr ov-list)))
759 new-msgdb))
761 (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
762 numbers flag-table)
763 (elmo-nntp-folder-msgdb-create folder numbers flag-table))
765 (defun elmo-nntp-folder-msgdb-create (folder numbers flag-table)
766 (let ((filter numbers)
767 (session (elmo-nntp-get-session folder))
768 (new-msgdb (elmo-make-msgdb))
769 beg-num end-num cur length
770 new-msgdb ov-str use-xover dir)
771 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal
772 folder))
773 (when (setq use-xover (elmo-nntp-xover-p session))
774 (setq beg-num (car numbers)
775 cur beg-num
776 end-num (nth (1- (length numbers)) numbers)
777 length (+ (- end-num beg-num) 1))
778 (elmo-with-progress-display (elmo-retrieve-overview length)
779 "Getting overview"
780 (while (<= cur end-num)
781 (elmo-nntp-send-command
782 session
783 (format
784 "xover %s-%s"
785 (int-to-string cur)
786 (int-to-string
787 (+ cur
788 elmo-nntp-overview-fetch-chop-length))))
789 (with-current-buffer (elmo-network-session-buffer session)
790 (if ov-str
791 (elmo-msgdb-append
792 new-msgdb
793 (elmo-nntp-create-msgdb-from-overview-string
794 folder
795 ov-str
796 flag-table
797 filter))))
798 (if (null (elmo-nntp-read-response session t))
799 (progn
800 (setq cur end-num);; exit while loop
801 (elmo-nntp-set-xover session nil)
802 (setq use-xover nil))
803 (if (null (setq ov-str (elmo-nntp-read-contents session)))
804 (error "Fetching overview failed")))
805 (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
806 (elmo-progress-notify 'elmo-retrieve-overview
807 :set (+ (- (min cur end-num) beg-num) 1)))))
808 (if (not use-xover)
809 (setq new-msgdb (elmo-nntp-msgdb-create-by-header
810 session numbers flag-table))
811 (with-current-buffer (elmo-network-session-buffer session)
812 (if ov-str
813 (elmo-msgdb-append
814 new-msgdb
815 (elmo-nntp-create-msgdb-from-overview-string
816 folder
817 ov-str
818 flag-table
819 filter)))))
820 (elmo-folder-set-killed-list-internal
821 folder
822 (nconc
823 (elmo-folder-killed-list-internal folder)
824 (car (elmo-list-diff
825 numbers
826 (elmo-msgdb-list-messages new-msgdb)))))
827 ;; If there are canceled messages, overviews are not obtained
828 ;; to max-number(inn 2.3?).
829 (when (and (elmo-nntp-max-number-precedes-list-active-p)
830 (elmo-nntp-list-active-p session))
831 (elmo-nntp-send-command session
832 (format "list active %s"
833 (elmo-nntp-folder-group-internal
834 folder)))
835 (if (null (elmo-nntp-read-response session))
836 (progn
837 (elmo-nntp-set-list-active session nil)
838 (error "NNTP list command failed")))
839 (let ((killed (elmo-nntp-catchup-msgdb
840 new-msgdb
841 (nth 1 (read (concat "(" (elmo-nntp-read-contents
842 session) ")"))))))
843 (when killed
844 (elmo-folder-kill-messages folder killed))))
845 new-msgdb))
847 (luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder))
848 (when (elmo-nntp-max-number-precedes-list-active-p)
849 (let ((session (elmo-nntp-get-session folder)))
850 (when (elmo-nntp-list-active-p session)
851 (let ((numbers (elmo-folder-list-messages folder nil 'in-msgdb))
852 msgdb-max max-number)
853 ;; If there are canceled messages, overviews are not obtained
854 ;; to max-number(inn 2.3?).
855 (elmo-nntp-select-group session
856 (elmo-nntp-folder-group-internal folder))
857 (elmo-nntp-send-command session
858 (format "list active %s"
859 (elmo-nntp-folder-group-internal
860 folder)))
861 (if (null (elmo-nntp-read-response session))
862 (error "NNTP list command failed"))
863 (setq max-number
864 (nth 1 (read (concat "(" (elmo-nntp-read-contents
865 session) ")"))))
866 (setq msgdb-max (if numbers (apply #'max numbers) 0))
867 (when (and msgdb-max
868 max-number
869 (< msgdb-max max-number))
870 (let ((i (1+ msgdb-max))
871 killed)
872 (while (<= i max-number)
873 (setq killed (cons i killed))
874 (incf i))
875 (elmo-folder-kill-messages folder (nreverse killed)))))))))
877 (defun elmo-nntp-msgdb-create-by-header (session numbers flag-table)
878 (with-temp-buffer
879 (elmo-nntp-retrieve-headers session (current-buffer) numbers)
880 (elmo-nntp-msgdb-create-message
881 (length numbers) flag-table)))
883 (defun elmo-nntp-parse-xhdr-response (string)
884 (let (response)
885 (with-temp-buffer
886 (insert string)
887 (goto-char (point-min))
888 (while (not (eobp))
889 (if (looking-at "^\\([0-9]+\\) \\(.*\\)$")
890 (setq response (cons (cons (string-to-number (elmo-match-buffer 1))
891 (elmo-match-buffer 2))
892 response)))
893 (forward-line 1)))
894 (nreverse response)))
896 (defun elmo-nntp-parse-overview-string (string)
897 (save-excursion
898 (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))
899 ret-list ret-val beg)
900 (set-buffer tmp-buffer)
901 (erase-buffer)
902 (set-buffer-multibyte nil)
903 (insert string)
904 (goto-char (point-min))
905 (setq beg (point))
906 (while (not (eobp))
907 (end-of-line)
908 (setq ret-list (save-match-data
909 (apply 'vector (split-string
910 (buffer-substring beg (point))
911 "\t"))))
912 (beginning-of-line)
913 (forward-line 1)
914 (setq beg (point))
915 (setq ret-val (nconc ret-val (list ret-list))))
916 ;;; (kill-buffer tmp-buffer)
917 ret-val)))
919 (defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port type)
920 "Get nntp header string."
921 (save-excursion
922 (let ((session (elmo-nntp-get-session
923 (luna-make-entity
924 'elmo-nntp-folder
925 :user user
926 :server server
927 :port port
928 :stream-type type))))
929 (elmo-nntp-send-command session
930 (format "head %s" msgid))
931 (if (elmo-nntp-read-response session)
932 (elmo-nntp-read-contents session))
933 (with-current-buffer (elmo-network-session-buffer session)
934 (std11-field-body "Newsgroups")))))
936 (luna-define-method elmo-message-fetch :around
937 ((folder elmo-nntp-folder) number strategy &optional unread section)
938 (when (luna-call-next-method)
939 (elmo-nntp-setup-crosspost-buffer folder number)
940 (unless unread
941 (elmo-nntp-folder-update-crosspost-message-alist
942 folder (list number)))
945 (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
946 number strategy
947 &optional section outbuf
948 unread)
949 (elmo-nntp-message-fetch folder number strategy section outbuf unread))
951 (defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
952 (let ((session (elmo-nntp-get-session folder))
953 newsgroups)
954 (with-current-buffer (elmo-network-session-buffer session)
955 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
956 (elmo-nntp-send-command session (format "article %s" number))
957 (if (null (elmo-nntp-read-response session t))
958 (progn
959 (with-current-buffer outbuf (erase-buffer))
960 (message "Fetching message failed")
961 nil)
962 (prog1 (elmo-nntp-read-body session outbuf)
963 (with-current-buffer outbuf
964 (goto-char (point-min))
965 (while (re-search-forward "^\\." nil t)
966 (replace-match "")
967 (forward-line))
968 (elmo-nntp-setup-crosspost-buffer folder number)
969 (unless unread
970 (elmo-nntp-folder-update-crosspost-message-alist
971 folder (list number)))))))))
973 (defun elmo-nntp-post (hostname content-buf)
974 (let ((session (elmo-nntp-get-session
975 (luna-make-entity
976 'elmo-nntp-folder
977 :user elmo-nntp-default-user
978 :server hostname
979 :port elmo-nntp-default-port
980 :stream-type
981 (elmo-get-network-stream-type
982 elmo-nntp-default-stream-type))))
983 response has-message-id)
984 (save-excursion
985 (set-buffer content-buf)
986 (goto-char (point-min))
987 (if (search-forward mail-header-separator nil t)
988 (delete-region (match-beginning 0)(match-end 0)))
989 (setq has-message-id (std11-field-body "message-id"))
990 (elmo-nntp-send-command session "post")
991 (if (string-match "^340" (setq response
992 (elmo-nntp-read-raw-response session)))
993 (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
994 (unless has-message-id
995 (goto-char (point-min))
996 (insert (concat "Message-ID: "
997 (elmo-match-string 1 response)
998 "\n"))))
999 (error "POST failed"))
1000 (run-hooks 'elmo-nntp-post-pre-hook)
1001 (elmo-nntp-send-buffer session content-buf)
1002 (elmo-nntp-send-command session ".")
1003 ;;; (elmo-nntp-read-response buffer process t)
1004 (if (not (string-match
1005 "^2" (setq response (elmo-nntp-read-raw-response
1006 session))))
1007 (error "NNTP error: %s" response)))))
1009 (defsubst elmo-nntp-send-data-line (session line)
1010 "Send LINE to SESSION."
1011 ;; Escape "." at start of a line
1012 (if (eq (string-to-char line) ?.)
1013 (process-send-string (elmo-network-session-process-internal
1014 session) "."))
1015 (process-send-string (elmo-network-session-process-internal
1016 session) line)
1017 (process-send-string (elmo-network-session-process-internal
1018 session) "\r\n"))
1020 (defun elmo-nntp-send-buffer (session databuf)
1021 "Send data content of DATABUF to SESSION."
1022 (let ((data-continue t)
1023 line bol)
1024 (with-current-buffer databuf
1025 (goto-char (point-min))
1026 (while data-continue
1027 (beginning-of-line)
1028 (setq bol (point))
1029 (end-of-line)
1030 (setq line (buffer-substring bol (point)))
1031 (unless (eq (forward-line 1) 0) (setq data-continue nil))
1032 (elmo-nntp-send-data-line session line)))))
1034 (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
1035 numbers)
1036 (elmo-folder-kill-messages folder numbers)
1039 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder))
1040 (let ((session (elmo-nntp-get-session folder)))
1041 (elmo-nntp-send-command
1042 session
1043 (format "group %s"
1044 (elmo-nntp-folder-group-internal folder)))
1045 (elmo-nntp-read-response session)))
1047 (defun elmo-nntp-retrieve-field (spec field from-msgs)
1048 "Retrieve FIELD values from FROM-MSGS.
1049 Returns a list of cons cells like (NUMBER . VALUE)"
1050 (let ((session (elmo-nntp-get-session spec)))
1051 (if (elmo-nntp-xhdr-p session)
1052 (progn
1053 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
1054 (elmo-nntp-send-command session
1055 (format "xhdr %s %s"
1056 field
1057 (if from-msgs
1058 (format
1059 "%d-%d"
1060 (car from-msgs)
1061 (nth
1062 (max
1063 (- (length from-msgs) 1) 0)
1064 from-msgs))
1065 "0-")))
1066 (if (elmo-nntp-read-response session t)
1067 (elmo-nntp-parse-xhdr-response
1068 (elmo-nntp-read-contents session))
1069 (elmo-nntp-set-xhdr session nil)
1070 (error "NNTP XHDR command failed"))))))
1072 (defun elmo-nntp-search-primitive (spec condition &optional from-msgs)
1073 (let ((search-key (elmo-filter-key condition)))
1074 (cond
1075 ((string= "last" search-key)
1076 (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
1077 (nthcdr (max (- (length numbers)
1078 (string-to-number (elmo-filter-value condition)))
1080 numbers)))
1081 ((string= "first" search-key)
1082 (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
1083 (rest (nthcdr (string-to-number (elmo-filter-value condition) )
1084 numbers)))
1085 (mapcar '(lambda (x) (delete x numbers)) rest)
1086 numbers))
1087 ((or (string= "since" search-key)
1088 (string= "before" search-key))
1089 (let* ((specified-date (elmo-date-make-sortable-string
1090 (elmo-date-get-datevec (elmo-filter-value
1091 condition))))
1092 (since (string= "since" search-key))
1093 field-date result)
1094 (if (eq (elmo-filter-type condition) 'unmatch)
1095 (setq since (not since)))
1096 (setq result
1097 (delq nil
1098 (mapcar
1099 (lambda (pair)
1100 (setq field-date
1101 (elmo-date-make-sortable-string
1102 (timezone-fix-time
1103 (cdr pair)
1104 (current-time-zone) nil)))
1105 (if (if since
1106 (or (string= specified-date field-date)
1107 (string< specified-date field-date))
1108 (string< field-date
1109 specified-date))
1110 (car pair)))
1111 (elmo-nntp-retrieve-field spec "date" from-msgs))))
1112 (if from-msgs
1113 (elmo-list-filter from-msgs result)
1114 result)))
1115 ((string= "body" search-key)
1116 nil)
1118 (let ((val (elmo-filter-value condition))
1119 (negative (eq (elmo-filter-type condition) 'unmatch))
1120 (case-fold-search t)
1121 result)
1122 (setq result
1123 (delq nil
1124 (mapcar
1125 (lambda (pair)
1126 (if (string-match val
1127 (eword-decode-string
1128 (decode-mime-charset-string
1129 (cdr pair) elmo-mime-charset)))
1130 (unless negative (car pair))
1131 (if negative (car pair))))
1132 (elmo-nntp-retrieve-field spec search-key
1133 from-msgs))))
1134 (if from-msgs
1135 (elmo-list-filter from-msgs result)
1136 result))))))
1138 (defun elmo-nntp-search-internal (folder condition from-msgs)
1139 (let (result)
1140 (cond
1141 ((vectorp condition)
1142 (setq result (elmo-nntp-search-primitive
1143 folder condition from-msgs)))
1144 ((eq (car condition) 'and)
1145 (setq result (elmo-nntp-search-internal folder
1146 (nth 1 condition)
1147 from-msgs)
1148 result (elmo-list-filter result
1149 (elmo-nntp-search-internal
1150 folder (nth 2 condition)
1151 from-msgs))))
1152 ((eq (car condition) 'or)
1153 (setq result (elmo-nntp-search-internal folder
1154 (nth 1 condition)
1155 from-msgs)
1156 result (elmo-uniq-list
1157 (nconc result
1158 (elmo-nntp-search-internal folder
1159 (nth 2 condition)
1160 from-msgs)))
1161 result (sort result '<))))))
1163 (defun elmo-nntp-use-server-search-p (condition)
1164 (if (vectorp condition)
1165 (not (string= "body" (elmo-filter-key condition)))
1166 (and (elmo-nntp-use-server-search-p (nth 1 condition))
1167 (elmo-nntp-use-server-search-p (nth 2 condition)))))
1169 (luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
1170 condition &optional from-msgs)
1171 (if (and (elmo-folder-plugged-p folder)
1172 (elmo-nntp-use-server-search-p condition))
1173 (elmo-nntp-search-internal folder condition from-msgs)
1174 (luna-call-next-method)))
1176 (defun elmo-nntp-get-folders-info-prepare (folder session-keys)
1177 (condition-case ()
1178 (let ((session (elmo-nntp-get-session folder))
1179 key count)
1180 (with-current-buffer (elmo-network-session-buffer session)
1181 (unless (setq key (assoc session session-keys))
1182 (erase-buffer)
1183 (setq key (cons session
1184 (vector 0
1185 (elmo-net-folder-server-internal folder)
1186 (elmo-net-folder-user-internal folder)
1187 (elmo-net-folder-port-internal folder)
1188 (elmo-net-folder-stream-type-internal
1189 folder))))
1190 (setq session-keys (nconc session-keys (list key))))
1191 (elmo-nntp-send-command session
1192 (format "group %s"
1193 (elmo-nntp-folder-group-internal
1194 folder))
1195 'noerase)
1196 (if elmo-nntp-get-folders-securely
1197 (accept-process-output
1198 (elmo-network-session-process-internal session)
1200 (setq count (aref (cdr key) 0))
1201 (aset (cdr key) 0 (1+ count))))
1202 (error
1203 (when elmo-auto-change-plugged
1204 (sit-for 1))
1205 nil))
1206 session-keys)
1208 (defun elmo-nntp-get-folders-info (session-keys)
1209 (let ((sessions session-keys)
1210 (cur (get-buffer-create " *ELMO NNTP Temp*")))
1211 (while sessions
1212 (let* ((session (caar sessions))
1213 (key (cdar sessions))
1214 (count (aref key 0))
1215 (server (aref key 1))
1216 (user (aref key 2))
1217 (port (aref key 3))
1218 (type (aref key 4))
1219 (hashtb (or elmo-newsgroups-hashtb
1220 (setq elmo-newsgroups-hashtb
1221 (elmo-make-hash count)))))
1222 (save-excursion
1223 (elmo-nntp-groups-read-response session cur count)
1224 (set-buffer cur)
1225 (goto-char (point-min))
1226 (let ((case-replace nil)
1227 (postfix (elmo-nntp-folder-postfix user server port type)))
1228 (if (not (string= postfix ""))
1229 (save-excursion
1230 (while (re-search-forward "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\)\\(.*\\)$" nil t)
1231 (replace-match (concat (match-string 1)
1232 (elmo-replace-in-string
1233 postfix
1234 "\\\\" "\\\\\\\\\\\\\\\\")))))))
1235 (let (len min max group)
1236 (while (not (eobp))
1237 (condition-case ()
1238 (when (= (following-char) ?2)
1239 (read cur)
1240 (setq len (read cur)
1241 min (read cur)
1242 max (read cur))
1243 (set (setq group (let ((obarray hashtb)) (read cur)))
1244 (list len min max)))
1245 (error (and group (symbolp group) (set group nil))))
1246 (forward-line 1))))
1247 (setq sessions (cdr sessions))))
1248 (kill-buffer cur)))
1250 ;; original is 'nntp-retrieve-groups [Gnus]
1251 (defun elmo-nntp-groups-read-response (session outbuf count)
1252 (let* ((received 0)
1253 (last-point (point-min)))
1254 (with-current-buffer (elmo-network-session-buffer session)
1255 (accept-process-output
1256 (elmo-network-session-process-internal session) 1)
1257 (discard-input)
1258 ;; Wait for all replies.
1259 (elmo-with-progress-display (elmo-nntp-groups-read-response count)
1260 "Getting folders info"
1261 (while (progn
1262 (goto-char last-point)
1263 ;; Count replies.
1264 (while (re-search-forward "^[0-9]" nil t)
1265 (setq received (1+ received)))
1266 (setq last-point (point))
1267 (< received count))
1268 (accept-process-output
1269 (elmo-network-session-process-internal session)
1271 (discard-input)
1272 (elmo-progress-notify 'elmo-nntp-groups-read-response :set received)))
1273 ;; Wait for the reply from the final command.
1274 (goto-char (point-max))
1275 (re-search-backward "^[0-9]" nil t)
1276 (when (looking-at "^[23]")
1277 (while (progn
1278 (goto-char (point-max))
1279 (not (re-search-backward "\r?\n" (- (point) 3) t)))
1280 (accept-process-output
1281 (elmo-network-session-process-internal session) 1)
1282 (discard-input)))
1283 ;; Now all replies are received. We remove CRs.
1284 (goto-char (point-min))
1285 (while (search-forward "\r" nil t)
1286 (replace-match "" t t))
1287 (copy-to-buffer outbuf (point-min) (point-max)))))
1289 ;; from nntp.el [Gnus]
1291 (defsubst elmo-nntp-next-result-arrived-p ()
1292 (cond
1293 ((eq (following-char) ?2)
1294 (if (re-search-forward "\n\\.\r?\n" nil t)
1296 nil))
1297 ((looking-at "[34]")
1298 (if (search-forward "\n" nil t)
1300 nil))
1302 nil)))
1304 (defun elmo-nntp-retrieve-headers (session outbuf articles)
1305 "Retrieve the headers of ARTICLES."
1306 (with-current-buffer (elmo-network-session-buffer session)
1307 (erase-buffer)
1308 (let ((number (length articles))
1309 (count 0)
1310 (received 0)
1311 (last-point (point-min))
1312 article)
1313 (elmo-with-progress-display (elmo-retrieve-header number)
1314 "Getting headers"
1315 ;; Send HEAD commands.
1316 (while (setq article (pop articles))
1317 (elmo-nntp-send-command session
1318 (format "head %s" article)
1319 'noerase)
1320 (setq count (1+ count))
1321 ;; Every 200 requests we have to read the stream in
1322 ;; order to avoid deadlocks.
1323 (when (or (null articles) ;All requests have been sent.
1324 (zerop (% count elmo-nntp-header-fetch-chop-length)))
1325 (accept-process-output
1326 (elmo-network-session-process-internal session) 1)
1327 (discard-input)
1328 (while (progn
1329 (goto-char last-point)
1330 ;; Count replies.
1331 (while (elmo-nntp-next-result-arrived-p)
1332 (setq last-point (point))
1333 (setq received (1+ received)))
1334 (< received count))
1335 (elmo-progress-notify 'elmo-retrieve-header :set received)
1336 (accept-process-output
1337 (elmo-network-session-process-internal session) 1)
1338 (discard-input)))))
1339 ;; Replace all CRLF with LF.
1340 (elmo-delete-cr-buffer)
1341 (copy-to-buffer outbuf (point-min) (point-max)))))
1343 ;; end of from Gnus
1345 (defun elmo-nntp-msgdb-create-message (len flag-table)
1346 (save-excursion
1347 (let ((new-msgdb (elmo-make-msgdb))
1348 beg entity num message-id)
1349 (set-buffer-multibyte nil)
1350 (goto-char (point-min))
1351 (elmo-with-progress-display (elmo-folder-msgdb-create len)
1352 "Creating msgdb"
1353 (while (not (eobp))
1354 (setq beg (save-excursion (forward-line 1) (point)))
1355 (setq num
1356 (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
1357 (string-to-number
1358 (elmo-match-buffer 1))))
1359 (elmo-nntp-next-result-arrived-p)
1360 (when num
1361 (save-excursion
1362 (forward-line -1)
1363 (save-restriction
1364 (narrow-to-region beg (point))
1365 (setq entity
1366 (elmo-msgdb-create-message-entity-from-buffer
1367 (elmo-msgdb-message-entity-handler new-msgdb) num))
1368 (when entity
1369 (setq message-id
1370 (elmo-message-entity-field entity 'message-id))
1371 (elmo-msgdb-append-entity
1372 new-msgdb
1373 entity
1374 (elmo-flag-table-get flag-table message-id))))))
1375 (elmo-progress-notify 'elmo-folder-msgdb-create)))
1376 new-msgdb)))
1378 (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
1379 elmo-nntp-use-cache)
1381 (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
1382 (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
1383 ngs)
1384 (if (not subscribe-only)
1385 nglist
1386 (dolist (ng nglist)
1387 (if (intern-soft ng elmo-newsgroups-hashtb)
1388 (setq ngs (cons ng ngs))))
1389 ngs)))
1391 ;;; Crosspost processing.
1393 ;; 1. setup crosspost alist.
1394 ;; 1.1. When message is fetched and is crossposted message,
1395 ;; it is remembered in `temp-crosses' slot.
1396 ;; temp-crosses slot is a list of cons cell:
1397 ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1398 ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1399 ;; 1.3. In elmo-folder-flag-as-read, move crosspost entry
1400 ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1402 ;; 2. process crosspost alist.
1403 ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1404 ;; `elmo-crosspost-message-alist'.
1405 ;; 2.2. remove crosspost entry for current newsgroup from
1406 ;; `elmo-crosspost-message-alist'.
1407 ;; 2.3. elmo-folder-list-unreads return unread message list according to
1408 ;; `reads' slot.
1409 ;; (There's a problem that if `elmo-folder-list-unreads'
1410 ;; never executed, crosspost information is thrown away.)
1411 ;; 2.4. In elmo-folder-close, `read' slot is cleared,
1413 (defun elmo-nntp-setup-crosspost-buffer (folder number)
1414 ;; 1.1. When message is fetched and is crossposted message,
1415 ;; it is remembered in `temp-crosses' slot.
1416 ;; temp-crosses slot is a list of cons cell:
1417 ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1418 (let (newsgroups crosspost-newsgroups message-id)
1419 (save-restriction
1420 (std11-narrow-to-header)
1421 (setq newsgroups (std11-fetch-field "newsgroups")
1422 message-id (std11-msg-id-string
1423 (car (std11-parse-msg-id-string
1424 (std11-fetch-field "message-id"))))))
1425 (when newsgroups
1426 (when (setq crosspost-newsgroups
1427 (delete
1428 (elmo-nntp-folder-group-internal folder)
1429 (elmo-nntp-parse-newsgroups newsgroups t)))
1430 (unless (assq number
1431 (elmo-nntp-folder-temp-crosses-internal folder))
1432 (elmo-nntp-folder-set-temp-crosses-internal
1433 folder
1434 (cons (cons number (list message-id crosspost-newsgroups 'ng))
1435 (elmo-nntp-folder-temp-crosses-internal folder))))))))
1437 (luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
1438 ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1439 (elmo-nntp-folder-set-temp-crosses-internal folder nil)
1440 (elmo-nntp-folder-set-reads-internal folder nil)
1443 (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
1444 ;; 1.3. In elmo-folder-flag-as-read, move crosspost entry
1445 ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1446 (let (elem)
1447 (dolist (number numbers)
1448 (when (setq elem (assq number
1449 (elmo-nntp-folder-temp-crosses-internal folder)))
1450 (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
1451 (setq elmo-crosspost-message-alist
1452 (cons (cdr elem) elmo-crosspost-message-alist)))
1453 (elmo-nntp-folder-set-temp-crosses-internal
1454 folder
1455 (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
1457 (luna-define-method elmo-folder-set-flag :before ((folder elmo-nntp-folder)
1458 numbers
1459 flag
1460 &optional is-local)
1461 (when (eq flag 'read)
1462 (elmo-nntp-folder-update-crosspost-message-alist folder numbers)))
1464 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-nntp-folder)
1465 numbers
1466 flag
1467 &optional is-local)
1468 (when (eq flag 'unread)
1469 (elmo-nntp-folder-update-crosspost-message-alist folder numbers)))
1471 (defsubst elmo-nntp-folder-process-crosspost (folder)
1472 ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1473 ;; `elmo-crosspost-message-alist'.
1474 ;; 2.2. remove crosspost entry for current newsgroup from
1475 ;; `elmo-crosspost-message-alist'.
1476 (let (cross-deletes reads entity ngs)
1477 (dolist (cross elmo-crosspost-message-alist)
1478 (when (setq entity (elmo-message-entity folder (nth 0 cross)))
1479 (setq reads (cons (elmo-message-entity-number entity) reads)))
1480 (when entity
1481 (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
1482 (nth 1 cross)))
1483 (setcar (cdr cross) ngs)
1484 (setq cross-deletes (cons cross cross-deletes)))
1485 (setq elmo-crosspost-message-alist-modified t)))
1486 (dolist (dele cross-deletes)
1487 (setq elmo-crosspost-message-alist (delq
1488 dele
1489 elmo-crosspost-message-alist)))
1490 (elmo-nntp-folder-set-reads-internal folder reads)))
1492 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder))
1493 (elmo-nntp-folder-process-crosspost folder))
1495 (luna-define-method elmo-folder-list-flagged :around ((folder elmo-nntp-folder)
1496 flag &optional in-msgdb)
1497 ;; 2.3. elmo-folder-list-unreads return unread message list according to
1498 ;; `reads' slot.
1499 (let ((msgs (luna-call-next-method)))
1500 (if in-msgdb
1501 msgs
1502 (case flag
1503 (unread
1504 (elmo-living-messages msgs (elmo-nntp-folder-reads-internal folder)))
1505 ;; Should consider read, digest and any flag?
1506 (otherwise
1507 msgs)))))
1509 (require 'product)
1510 (product-provide (provide 'elmo-nntp) (require 'elmo-version))
1512 ;;; elmo-nntp.el ends here