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