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 folder 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 ((folder elmo-nntp-folder)
 969                                         number strategy
 970                                         &optional section
 971                                         outbuf
 972                                         unread)
 973   (if (elmo-folder-plugged-p folder)
 974       (let ((cache-file (elmo-file-cache-expand-path
 975                          (elmo-fetch-strategy-cache-path strategy)
 976                          section)))
 977         (if (and (elmo-fetch-strategy-use-cache strategy)
 978                  (file-exists-p cache-file))
 979             (if outbuf
 980                 (with-current-buffer outbuf
 981                   (insert-file-contents-as-binary cache-file)
 982                   (elmo-nntp-setup-crosspost-buffer folder number)
 983                   (unless unread
 984                     (elmo-nntp-folder-update-crosspost-message-alist
 985                      folder (list number)))
 986                   t)
 987               (with-temp-buffer
 988                 (insert-file-contents-as-binary cache-file)
 989                 (elmo-nntp-setup-crosspost-buffer folder number)
 990                 (unless unread
 991                   (elmo-nntp-folder-update-crosspost-message-alist
 992                    folder (list number)))
 993                 (buffer-string)))
 994           (if outbuf
 995               (with-current-buffer outbuf
 996                 (elmo-folder-send folder 'elmo-message-fetch-plugged
 997                                   number strategy section
 998                                   (current-buffer) unread)
 999                 (elmo-delete-cr-buffer)
1000                 (when (and (> (buffer-size) 0)
1001                            (elmo-fetch-strategy-save-cache strategy))
1002                   (elmo-file-cache-save
1003                    (elmo-fetch-strategy-cache-path strategy)
1004                    section))
1005                 t)
1006             (with-temp-buffer
1007               (elmo-folder-send folder 'elmo-message-fetch-plugged
1008                                 number strategy section
1009                                 (current-buffer) unread)
1010               (elmo-delete-cr-buffer)
1011               (when (and (> (buffer-size) 0)
1012                          (elmo-fetch-strategy-save-cache strategy))
1013                 (elmo-file-cache-save
1014                  (elmo-fetch-strategy-cache-path strategy)
1015                  section))
1016               (buffer-string)))))
1017     (elmo-folder-send folder 'elmo-message-fetch-unplugged
1018                       number strategy section outbuf unread)))
1019
1020 (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
1021                                                 number strategy
1022                                                 &optional section outbuf
1023                                                 unread)
1024   (elmo-nntp-message-fetch folder number strategy section outbuf unread))
1025
1026 (luna-define-method elmo-message-fetch-unplugged ((folder elmo-nntp-folder)
1027                                                   number strategy
1028                                                   &optional section outbuf
1029                                                   unread)
1030   (if (elmo-fetch-strategy-use-cache strategy)
1031       (if outbuf
1032           (with-current-buffer outbuf
1033             (insert-file-contents-as-binary
1034              (elmo-file-cache-expand-path
1035               (elmo-fetch-strategy-cache-path strategy)
1036               section))
1037             (elmo-nntp-setup-crosspost-buffer folder number)
1038             (unless unread
1039               (elmo-nntp-folder-update-crosspost-message-alist
1040                folder (list number)))
1041             t)
1042         (with-temp-buffer
1043           (insert-file-contents-as-binary
1044            (elmo-file-cache-expand-path
1045             (elmo-fetch-strategy-cache-path strategy)
1046             section))
1047           (elmo-nntp-setup-crosspost-buffer folder number)
1048           (unless unread
1049             (elmo-nntp-folder-update-crosspost-message-alist
1050              folder (list number)))
1051           (buffer-string)))
1052     (error "Unplugged")))
1053
1054 (defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
1055   (let ((session (elmo-nntp-get-session folder))
1056         newsgroups)
1057     (with-current-buffer (elmo-network-session-buffer session)
1058       (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
1059       (elmo-nntp-send-command session (format "article %s" number))
1060       (if (null (elmo-nntp-read-response session t))
1061           (progn
1062             (with-current-buffer outbuf (erase-buffer))
1063             (message "Fetching message failed")
1064             nil)
1065         (prog1 (elmo-nntp-read-body session outbuf)
1066           (with-current-buffer outbuf
1067             (goto-char (point-min))
1068             (while (re-search-forward "^\\." nil t)
1069               (replace-match "")
1070               (forward-line))
1071             (elmo-nntp-setup-crosspost-buffer folder number)
1072             (unless unread
1073               (elmo-nntp-folder-update-crosspost-message-alist
1074                folder (list number)))))))))
1075
1076 (defun elmo-nntp-post (hostname content-buf)
1077   (let ((session (elmo-nntp-get-session
1078                   (luna-make-entity
1079                    'elmo-nntp-folder
1080                    :user elmo-nntp-default-user
1081                    :server hostname
1082                    :port elmo-nntp-default-port
1083                    :stream-type elmo-nntp-default-stream-type)))
1084         response has-message-id)
1085     (save-excursion
1086       (set-buffer content-buf)
1087       (goto-char (point-min))
1088       (if (search-forward mail-header-separator nil t)
1089           (delete-region (match-beginning 0)(match-end 0)))
1090       (setq has-message-id (std11-field-body "message-id"))
1091       (elmo-nntp-send-command session "post")
1092       (if (string-match "^340" (setq response
1093                                      (elmo-nntp-read-raw-response session)))
1094           (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
1095               (unless has-message-id
1096                 (goto-char (point-min))
1097                 (insert (concat "Message-ID: "
1098                                 (elmo-match-string 1 response)
1099                                 "\n"))))
1100         (error "POST failed"))
1101       (run-hooks 'elmo-nntp-post-pre-hook)
1102       (elmo-nntp-send-buffer session content-buf)
1103       (elmo-nntp-send-command session ".")
1104 ;;;   (elmo-nntp-read-response buffer process t)
1105       (if (not (string-match
1106                 "^2" (setq response (elmo-nntp-read-raw-response
1107                                      session))))
1108           (error (concat "NNTP error: " response))))))
1109
1110 (defsubst elmo-nntp-send-data-line (session line)
1111   "Send LINE to SESSION."
1112   ;; Escape "." at start of a line
1113   (if (eq (string-to-char line) ?.)
1114       (process-send-string (elmo-network-session-process-internal
1115                             session) "."))
1116   (process-send-string (elmo-network-session-process-internal
1117                         session) line)
1118   (process-send-string (elmo-network-session-process-internal
1119                         session) "\r\n"))
1120
1121 (defun elmo-nntp-send-buffer (session databuf)
1122   "Send data content of DATABUF to SESSION."
1123   (let ((data-continue t)
1124         line bol)
1125     (with-current-buffer databuf
1126       (goto-char (point-min))
1127       (while data-continue
1128         (beginning-of-line)
1129         (setq bol (point))
1130         (end-of-line)
1131         (setq line (buffer-substring bol (point)))
1132         (unless (eq (forward-line 1) 0) (setq data-continue nil))
1133         (elmo-nntp-send-data-line session line)))))
1134
1135 (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
1136                                                  numbers)
1137   (elmo-nntp-folder-delete-messages folder numbers))
1138
1139 (defun elmo-nntp-folder-delete-messages (folder numbers)
1140   (let ((killed-list (elmo-folder-killed-list-internal folder)))
1141     (dolist (number numbers)
1142       (setq killed-list
1143             (elmo-msgdb-set-as-killed killed-list number)))
1144     (elmo-folder-set-killed-list-internal folder killed-list))
1145   t)
1146
1147 (luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder))
1148   (let ((session (elmo-nntp-get-session folder)))
1149     (if (elmo-folder-plugged-p folder)
1150         (progn
1151           (elmo-nntp-send-command
1152            session
1153            (format "group %s"
1154                    (elmo-nntp-folder-group-internal folder)))
1155           (elmo-nntp-read-response session))
1156       t)))
1157
1158 (defun elmo-nntp-retrieve-field (spec field from-msgs)
1159   "Retrieve FIELD values from FROM-MSGS.
1160 Returns a list of cons cells like (NUMBER . VALUE)"
1161   (let ((session (elmo-nntp-get-session spec)))
1162     (if (elmo-nntp-xhdr-p session)
1163         (progn
1164           (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
1165           (elmo-nntp-send-command session
1166                                   (format "xhdr %s %s"
1167                                           field
1168                                           (if from-msgs
1169                                               (format
1170                                                "%d-%d"
1171                                                (car from-msgs)
1172                                                (nth
1173                                                 (max
1174                                                  (- (length from-msgs) 1) 0)
1175                                                 from-msgs))
1176                                             "0-")))
1177           (if (elmo-nntp-read-response session t)
1178               (elmo-nntp-parse-xhdr-response
1179                (elmo-nntp-read-contents session))
1180             (elmo-nntp-set-xhdr session nil)
1181             (error "NNTP XHDR command failed"))))))
1182
1183 (defun elmo-nntp-search-primitive (spec condition &optional from-msgs)
1184   (let ((search-key (elmo-filter-key condition)))
1185     (cond
1186      ((string= "last" search-key)
1187       (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
1188         (nthcdr (max (- (length numbers)
1189                         (string-to-int (elmo-filter-value condition)))
1190                      0)
1191                 numbers)))
1192      ((string= "first" search-key)
1193       (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
1194              (rest (nthcdr (string-to-int (elmo-filter-value condition) )
1195                            numbers)))
1196         (mapcar '(lambda (x) (delete x numbers)) rest)
1197         numbers))
1198      ((or (string= "since" search-key)
1199           (string= "before" search-key))
1200       (let* ((key-date (elmo-date-get-datevec (elmo-filter-value condition)))
1201              (key-datestr (elmo-date-make-sortable-string key-date))
1202              (since (string= "since" search-key))
1203              result)
1204         (if (eq (elmo-filter-type condition) 'unmatch)
1205             (setq since (not since)))
1206         (setq result
1207               (delq nil
1208                     (mapcar
1209                      (lambda (pair)
1210                        (if (if since
1211                                (string< key-datestr
1212                                         (elmo-date-make-sortable-string
1213                                          (timezone-fix-time
1214                                           (cdr pair)
1215                                           (current-time-zone) nil)))
1216                              (not (string< key-datestr
1217                                            (elmo-date-make-sortable-string
1218                                             (timezone-fix-time
1219                                              (cdr pair)
1220                                              (current-time-zone) nil)))))
1221                            (car pair)))
1222                      (elmo-nntp-retrieve-field spec "date" from-msgs))))
1223         (if from-msgs
1224             (elmo-list-filter from-msgs result)
1225           result)))
1226      (t
1227       (let ((val (elmo-filter-value condition))
1228             (negative (eq (elmo-filter-type condition) 'unmatch))
1229             (case-fold-search t)
1230             result)
1231         (setq result
1232               (delq nil
1233                     (mapcar
1234                      (lambda (pair)
1235                        (if (string-match val
1236                                          (eword-decode-string
1237                                           (decode-mime-charset-string
1238                                            (cdr pair) elmo-mime-charset)))
1239                            (unless negative (car pair))
1240                          (if negative (car pair))))
1241                      (elmo-nntp-retrieve-field spec search-key
1242                                                from-msgs))))
1243         (if from-msgs
1244             (elmo-list-filter from-msgs result)
1245           result))))))
1246
1247 (luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
1248                                         condition &optional from-msgs)
1249   (let (result)
1250     (cond
1251      ((vectorp condition)
1252       (setq result (elmo-nntp-search-primitive
1253                     folder condition from-msgs)))
1254      ((eq (car condition) 'and)
1255       (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
1256             result (elmo-list-filter result
1257                                      (elmo-folder-search
1258                                       folder (nth 2 condition)
1259                                       from-msgs))))
1260      ((eq (car condition) 'or)
1261       (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
1262             result (elmo-uniq-list
1263                     (nconc result
1264                            (elmo-folder-search folder (nth 2 condition)
1265                                                from-msgs)))
1266             result (sort result '<))))))
1267
1268 (defun elmo-nntp-get-folders-info-prepare (folder session-keys)
1269   (condition-case ()
1270       (let ((session (elmo-nntp-get-session folder))
1271             key count)
1272         (with-current-buffer (elmo-network-session-buffer session)
1273           (unless (setq key (assoc session session-keys))
1274             (erase-buffer)
1275             (setq key (cons session
1276                             (vector 0
1277                                     (elmo-net-folder-server-internal folder)
1278                                     (elmo-net-folder-user-internal folder)
1279                                     (elmo-net-folder-port-internal folder)
1280                                     (elmo-net-folder-stream-type-internal
1281                                      folder))))
1282             (setq session-keys (nconc session-keys (list key))))
1283           (elmo-nntp-send-command session
1284                                   (format "group %s"
1285                                           (elmo-nntp-folder-group-internal
1286                                            folder))
1287                                   'noerase)
1288           (if elmo-nntp-get-folders-securely
1289               (accept-process-output
1290                (elmo-network-session-process-internal session)
1291                1))
1292           (setq count (aref (cdr key) 0))
1293           (aset (cdr key) 0 (1+ count))))
1294     (error
1295      (when elmo-auto-change-plugged
1296        (sit-for 1))
1297      nil))
1298   session-keys)
1299
1300 (defun elmo-nntp-get-folders-info (session-keys)
1301   (let ((sessions session-keys)
1302         (cur (get-buffer-create " *ELMO NNTP Temp*")))
1303     (while sessions
1304       (let* ((session (caar sessions))
1305              (key     (cdar sessions))
1306              (count   (aref key 0))
1307              (server  (aref key 1))
1308              (user    (aref key 2))
1309              (port    (aref key 3))
1310              (type    (aref key 4))
1311              (hashtb (or elmo-newsgroups-hashtb
1312                          (setq elmo-newsgroups-hashtb
1313                                (elmo-make-hash count)))))
1314         (save-excursion
1315           (elmo-nntp-groups-read-response session cur count)
1316           (set-buffer cur)
1317           (goto-char (point-min))
1318           (let ((case-replace nil)
1319                 (postfix (elmo-nntp-folder-postfix user server port type)))
1320             (if (not (string= postfix ""))
1321                 (save-excursion
1322                   (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$"
1323                                   (concat "\\1"
1324                                           (elmo-replace-in-string
1325                                            postfix
1326                                            "\\\\" "\\\\\\\\\\\\\\\\"))))))
1327           (let (len min max group)
1328             (while (not (eobp))
1329               (condition-case ()
1330                   (when (= (following-char) ?2)
1331                     (read cur)
1332                     (setq len (read cur)
1333                           min (read cur)
1334                           max (read cur))
1335                     (set (setq group (let ((obarray hashtb)) (read cur)))
1336                          (list len min max)))
1337                 (error (and group (symbolp group) (set group nil))))
1338               (forward-line 1))))
1339         (setq sessions (cdr sessions))))
1340     (kill-buffer cur)))
1341
1342 ;; original is 'nntp-retrieve-groups [Gnus]
1343 (defun elmo-nntp-groups-read-response (session outbuf count)
1344   (let* ((received 0)
1345          (last-point (point-min)))
1346     (with-current-buffer (elmo-network-session-buffer session)
1347       (accept-process-output
1348        (elmo-network-session-process-internal session) 1)
1349       (discard-input)
1350       ;; Wait for all replies.
1351       (message "Getting folders info...")
1352       (while (progn
1353                (goto-char last-point)
1354                ;; Count replies.
1355                (while (re-search-forward "^[0-9]" nil t)
1356                  (setq received
1357                        (1+ received)))
1358                (setq last-point (point))
1359                (< received count))
1360         (accept-process-output (elmo-network-session-process-internal session)
1361                                1)
1362         (discard-input)
1363         (when (> count elmo-display-progress-threshold)
1364           (if (or (zerop (% received 10)) (= received count))
1365               (elmo-display-progress
1366                'elmo-nntp-groups-read-response "Getting folders info..."
1367                (/ (* received 100) count)))))
1368       (when (> count elmo-display-progress-threshold)
1369         (elmo-display-progress
1370          'elmo-nntp-groups-read-response "Getting folders info..." 100))
1371       ;; Wait for the reply from the final command.
1372       (goto-char (point-max))
1373       (re-search-backward "^[0-9]" nil t)
1374       (when (looking-at "^[23]")
1375         (while (progn
1376                  (goto-char (point-max))
1377                  (not (re-search-backward "\r?\n" (- (point) 3) t)))
1378           (accept-process-output
1379            (elmo-network-session-process-internal session) 1)
1380           (discard-input)))
1381       ;; Now all replies are received.  We remove CRs.
1382       (goto-char (point-min))
1383       (while (search-forward "\r" nil t)
1384         (replace-match "" t t))
1385       (copy-to-buffer outbuf (point-min) (point-max)))))
1386
1387 ;; from nntp.el [Gnus]
1388
1389 (defsubst elmo-nntp-next-result-arrived-p ()
1390   (cond
1391    ((eq (following-char) ?2)
1392     (if (re-search-forward "\n\\.\r?\n" nil t)
1393         t
1394       nil))
1395    ((looking-at "[34]")
1396     (if (search-forward "\n" nil t)
1397         t
1398       nil))
1399    (t
1400     nil)))
1401
1402 (defun elmo-nntp-retrieve-headers (session outbuf articles)
1403   "Retrieve the headers of ARTICLES."
1404   (with-current-buffer (elmo-network-session-buffer session)
1405     (erase-buffer)
1406     (let ((number (length articles))
1407           (count 0)
1408           (received 0)
1409           (last-point (point-min))
1410           article)
1411       ;; Send HEAD commands.
1412       (while (setq article (pop articles))
1413         (elmo-nntp-send-command session
1414                                 (format "head %s" article)
1415                                 'noerase)
1416         (setq count (1+ count))
1417         ;; Every 200 requests we have to read the stream in
1418         ;; order to avoid deadlocks.
1419         (when (or (null articles)       ;All requests have been sent.
1420                   (zerop (% count elmo-nntp-header-fetch-chop-length)))
1421           (accept-process-output
1422            (elmo-network-session-process-internal session) 1)
1423           (discard-input)
1424           (while (progn
1425                    (goto-char last-point)
1426                    ;; Count replies.
1427                    (while (elmo-nntp-next-result-arrived-p)
1428                      (setq last-point (point))
1429                      (setq received (1+ received)))
1430                    (< received count))
1431             (when (> number elmo-display-progress-threshold)
1432               (if (or (zerop (% received 20)) (= received number))
1433                   (elmo-display-progress
1434                    'elmo-nntp-retrieve-headers "Getting headers..."
1435                    (/ (* received 100) number))))
1436             (accept-process-output
1437              (elmo-network-session-process-internal session) 1)
1438             (discard-input))))
1439       (when (> number elmo-display-progress-threshold)
1440         (elmo-display-progress
1441          'elmo-nntp-retrieve-headers "Getting headers..." 100))
1442       (message "Getting headers...done")
1443       ;; Remove all "\r"'s.
1444       (goto-char (point-min))
1445       (while (search-forward "\r\n" nil t)
1446         (replace-match "\n"))
1447       (copy-to-buffer outbuf (point-min) (point-max)))))
1448
1449 ;; end of from Gnus
1450
1451 (defun elmo-nntp-msgdb-create-message (len new-mark
1452                                            already-mark seen-mark seen-list)
1453   (save-excursion
1454     (let (beg overview number-alist mark-alist
1455               entity i num gmark seen message-id)
1456       (elmo-set-buffer-multibyte nil)
1457       (goto-char (point-min))
1458       (setq i 0)
1459       (message "Creating msgdb...")
1460       (while (not (eobp))
1461         (setq beg (save-excursion (forward-line 1) (point)))
1462         (setq num
1463               (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
1464                    (string-to-int
1465                     (elmo-match-buffer 1))))
1466         (elmo-nntp-next-result-arrived-p)
1467         (when num
1468           (save-excursion
1469             (forward-line -1)
1470             (save-restriction
1471               (narrow-to-region beg (point))
1472               (setq entity
1473                     (elmo-msgdb-create-overview-from-buffer num))
1474               (when entity
1475                 (setq overview
1476                       (elmo-msgdb-append-element
1477                        overview entity))
1478                 (setq number-alist
1479                       (elmo-msgdb-number-add
1480                        number-alist
1481                        (elmo-msgdb-overview-entity-get-number entity)
1482                        (car entity)))
1483                 (setq message-id (car entity))
1484                 (setq seen (member message-id seen-list))
1485                 (if (setq gmark
1486                           (or (elmo-msgdb-global-mark-get message-id)
1487                               (if (elmo-file-cache-status
1488                                    (elmo-file-cache-get message-id))
1489                                   (if seen
1490                                       nil
1491                                     already-mark)
1492                                 (if seen
1493                                     (if elmo-nntp-use-cache
1494                                         seen-mark)
1495                                   new-mark))))
1496                     (setq mark-alist
1497                           (elmo-msgdb-mark-append
1498                            mark-alist
1499                            num gmark)))
1500                 ))))
1501         (when (> len elmo-display-progress-threshold)
1502           (setq i (1+ i))
1503           (if (or (zerop (% i 20)) (= i len))
1504               (elmo-display-progress
1505                'elmo-nntp-msgdb-create-message "Creating msgdb..."
1506                (/ (* i 100) len)))))
1507       (when (> len elmo-display-progress-threshold)
1508         (elmo-display-progress
1509          'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
1510       (list overview number-alist mark-alist))))
1511
1512 (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
1513   elmo-nntp-use-cache)
1514
1515 (luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder))
1516   nil)
1517
1518 (luna-define-method elmo-folder-writable-p ((folder elmo-nntp-folder))
1519   nil)
1520
1521 (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
1522   (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
1523         ngs)
1524     (if (not subscribe-only)
1525         nglist
1526       (dolist (ng nglist)
1527         (if (intern-soft ng elmo-newsgroups-hashtb)
1528             (setq ngs (cons ng ngs))))
1529       ngs)))
1530
1531 ;;; Crosspost processing.
1532
1533 ;; 1. setup crosspost alist.
1534 ;;    1.1. When message is fetched and is crossposted message,
1535 ;;         it is remembered in `temp-crosses' slot.
1536 ;;         temp-crosses slot is a list of cons cell:
1537 ;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1538 ;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1539 ;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
1540 ;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1541
1542 ;; 2. process crosspost alist.
1543 ;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1544 ;;         `elmo-crosspost-message-alist'.
1545 ;;    2.2. remove crosspost entry for current newsgroup from
1546 ;;         `elmo-crosspost-message-alist'.
1547 ;;    2.3. elmo-folder-list-unreads return unread message list according to
1548 ;;         `reads' slot.
1549 ;;         (There's a problem that if `elmo-folder-list-unreads'
1550 ;;           never executed, crosspost information is thrown away.)
1551 ;;    2.4. In elmo-folder-close, `read' slot is cleared,
1552
1553 (defun elmo-nntp-setup-crosspost-buffer (folder number)
1554 ;;    1.1. When message is fetched and is crossposted message,
1555 ;;         it is remembered in `temp-crosses' slot.
1556 ;;         temp-crosses slot is a list of cons cell:
1557 ;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1558   (let (newsgroups crosspost-newsgroups message-id)
1559     (save-restriction
1560       (std11-narrow-to-header)
1561       (setq newsgroups (std11-fetch-field "newsgroups")
1562             message-id (std11-msg-id-string
1563                         (car (std11-parse-msg-id-string
1564                               (std11-fetch-field "message-id"))))))
1565     (when newsgroups
1566       (when (setq crosspost-newsgroups
1567                   (delete
1568                    (elmo-nntp-folder-group-internal folder)
1569                    (elmo-nntp-parse-newsgroups newsgroups t)))
1570         (unless (assq number
1571                       (elmo-nntp-folder-temp-crosses-internal folder))
1572           (elmo-nntp-folder-set-temp-crosses-internal
1573            folder
1574            (cons (cons number (list message-id crosspost-newsgroups 'ng))
1575                  (elmo-nntp-folder-temp-crosses-internal folder))))))))
1576
1577 (luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
1578 ;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1579   (elmo-nntp-folder-set-temp-crosses-internal folder nil)
1580   (elmo-nntp-folder-set-reads-internal folder nil)
1581   )
1582
1583 (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
1584 ;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
1585 ;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1586   (let (elem)
1587     (dolist (number numbers)
1588       (when (setq elem (assq number
1589                              (elmo-nntp-folder-temp-crosses-internal folder)))
1590         (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
1591           (setq elmo-crosspost-message-alist
1592                 (cons (cdr elem) elmo-crosspost-message-alist)))
1593         (elmo-nntp-folder-set-temp-crosses-internal
1594          folder
1595          (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
1596
1597 (luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder)
1598                                               numbers)
1599   (elmo-nntp-folder-update-crosspost-message-alist folder numbers)
1600   t)
1601
1602 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)
1603                                                    &optional
1604                                                    number-alist)
1605   (elmo-nntp-folder-process-crosspost folder number-alist))
1606
1607 (defun elmo-nntp-folder-process-crosspost (folder number-alist)
1608 ;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1609 ;;         `elmo-crosspost-message-alist'.
1610 ;;    2.2. remove crosspost entry for current newsgroup from
1611 ;;         `elmo-crosspost-message-alist'.
1612   (let (cross-deletes reads entity ngs)
1613     (dolist (cross elmo-crosspost-message-alist)
1614       (if number-alist
1615           (when (setq entity (rassoc (nth 0 cross) number-alist))
1616             (setq reads (cons (car entity) reads)))
1617         (when (setq entity (elmo-msgdb-overview-get-entity
1618                             (nth 0 cross)
1619                             (elmo-folder-msgdb folder)))
1620           (setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
1621                             reads))))
1622       (when entity
1623         (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
1624                               (nth 1 cross)))
1625             (setcar (cdr cross) ngs)
1626           (setq cross-deletes (cons cross cross-deletes)))
1627         (setq elmo-crosspost-message-alist-modified t)))
1628     (dolist (dele cross-deletes)
1629       (setq elmo-crosspost-message-alist (delq
1630                                           dele
1631                                           elmo-crosspost-message-alist)))
1632     (elmo-nntp-folder-set-reads-internal folder reads)))
1633
1634 (luna-define-method elmo-folder-list-unreads-internal
1635   ((folder elmo-nntp-folder) unread-marks mark-alist)
1636   ;;    2.3. elmo-folder-list-unreads return unread message list according to
1637   ;;         `reads' slot.
1638   (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist
1639                                     (elmo-folder-msgdb folder)))))
1640     (elmo-living-messages (delq nil
1641                                 (mapcar
1642                                  (lambda (x)
1643                                    (if (member (nth 1 x) unread-marks)
1644                                        (car x)))
1645                                  mark-alist))
1646                           (elmo-nntp-folder-reads-internal folder))))
1647
1648 (require 'product)
1649 (product-provide (provide 'elmo-nntp) (require 'elmo-version))
1650
1651 ;;; elmo-nntp.el ends here