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