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