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