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