elmo/elmo-nntp.el

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