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