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