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