elmo/elmo-nntp.el

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