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