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