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