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