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