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