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