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