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