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