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