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