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/04/28 10:30:51 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       (elmo-display-progress
 429        'elmo-nntp-list-folders "Parsing active..."
 430        100)
 431       (unless (string= server elmo-default-nntp-server)
 432         (setq append-serv (concat "@" server)))
 433       (unless (eq port elmo-default-nntp-port)
 434         (setq append-serv (concat append-serv ":" (int-to-string port))))
 435       (unless (eq ssl elmo-default-nntp-ssl)
 436         (if ssl
 437             (setq append-serv (concat append-serv "!")))
 438         (if (eq ssl 'starttls)
 439             (setq append-serv (concat append-serv "!"))))
 440       (mapcar '(lambda (fld)
 441                  (if (consp fld)
 442                      (list (concat "-" (car fld)
 443                                    (and user
 444                                         (concat ":" user))
 445                                    (and append-serv
 446                                         (concat append-serv))))
 447                    (concat "-" fld
 448                            (and user
 449                                 (concat ":" user))
 450                            (and append-serv
 451                                 (concat append-serv)))))
 452               ret-val)))))
 453
 454 (defun elmo-nntp-make-msglist (beg-str end-str)
 455   (elmo-set-work-buf
 456    (let ((beg-num (string-to-int beg-str))
 457          (end-num (string-to-int end-str))
 458          i)
 459      (setq i beg-num)
 460      (insert "(")
 461      (while (<= i end-num)
 462        (insert (format "%s " i))
 463        (setq i (1+ i)))
 464      (insert ")")
 465      (goto-char (point-min))
 466      (read (current-buffer)))))
 467
 468 (defun elmo-nntp-list-folder (spec)
 469   (elmo-nntp-setting spec
 470    (let* ((server (format "%s" server)) ;; delete text property
 471           response retval use-listgroup)
 472     (save-excursion
 473       (when (setq use-listgroup (elmo-nntp-listgroup-p server port))
 474         (elmo-nntp-send-command buffer
 475                                 process
 476                                 (format "listgroup %s" folder))
 477         (if (not (elmo-nntp-read-response buffer process t))
 478             (progn
 479               (elmo-nntp-set-listgroup server port nil)
 480               (setq use-listgroup nil))
 481           (if (null (setq response (elmo-nntp-read-contents buffer process)))
 482               (error "Fetching listgroup failed"))
 483           (setq retval (elmo-string-to-list response))))
 484       (if use-listgroup
 485           retval
 486         (elmo-nntp-send-command buffer
 487                                 process
 488                                 (format "group %s" folder))
 489         (if (null (setq response (elmo-nntp-read-response buffer process)))
 490             (error "Select folder failed"))
 491         (setcar (cddr connection) folder)
 492         (if (and
 493              (string-match "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
 494                            response)
 495              (> (string-to-int (elmo-match-string 1 response)) 0))
 496             (elmo-nntp-make-msglist
 497              (elmo-match-string 2 response)
 498              (elmo-match-string 3 response))
 499           nil))))))
 500
 501 (defun elmo-nntp-max-of-folder (spec)
 502   (let* ((port (elmo-nntp-spec-port spec))
 503          (user (elmo-nntp-spec-username spec))
 504          (server (elmo-nntp-spec-hostname spec))
 505          (ssl (elmo-nntp-spec-ssl spec))
 506          (folder (elmo-nntp-spec-group spec)))
 507     (if elmo-nntp-groups-async
 508         (let* ((fld (concat folder
 509                             (elmo-nntp-folder-postfix user server port ssl)))
 510                (entry (elmo-get-hash-val fld elmo-nntp-groups-hashtb)))
 511           (if entry
 512               (cons (nth 2 entry)
 513                     (car entry))
 514             (error "No such newsgroup \"%s\"" fld)))
 515       (let* ((connection (elmo-nntp-get-connection server user port ssl))
 516              (buffer  (car connection))
 517              (process (cadr connection))
 518              response e-num end-num)
 519         (if (not connection)
 520             (error "Connection failed"))
 521         (save-excursion
 522           (elmo-nntp-send-command buffer
 523                                   process
 524                                   (format "group %s" folder))
 525           (setq response (elmo-nntp-read-response buffer process))
 526           (if (and response
 527                    (string-match
 528                     "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
 529                     response))
 530               (progn
 531                 (setq end-num (string-to-int
 532                                (elmo-match-string 3 response)))
 533                 (setq e-num (string-to-int
 534                              (elmo-match-string 1 response)))
 535                 (cons end-num e-num))
 536             (if (null response)
 537                 (error "Selecting newsgroup \"%s\" failed" folder)
 538               nil)))))))
 539
 540 (defconst elmo-nntp-overview-index
 541   '(("number" . 0)
 542     ("subject" . 1)
 543     ("from" . 2)
 544     ("date" . 3)
 545     ("message-id" . 4)
 546     ("references" . 5)
 547     ("size" . 6)
 548     ("lines" . 7)
 549     ("xref" . 8)))
 550
 551 (defun elmo-nntp-create-msgdb-from-overview-string (str
 552                                                     folder
 553                                                     new-mark
 554                                                     already-mark
 555                                                     seen-mark
 556                                                     important-mark
 557                                                     seen-list
 558                                                     &optional numlist)
 559   (let (ov-list gmark message-id seen
 560         ov-entity overview number-alist mark-alist num
 561         extras extra ext field field-index)
 562     (setq ov-list (elmo-nntp-parse-overview-string str))
 563     (while ov-list
 564       (setq ov-entity (car ov-list))
 565       ;; INN bug??
 566 ;      (if (or (> (setq num (string-to-int (aref ov-entity 0)))
 567 ;                99999)
 568 ;             (<= num 0))
 569 ;         (setq num 0))
 570 ;     (setq num (int-to-string num))
 571       (setq num (string-to-int (aref ov-entity 0)))
 572       (when (or (null numlist)
 573                 (memq num numlist))
 574         (setq extras elmo-msgdb-extra-fields
 575               extra nil)
 576         (while extras
 577           (setq ext (downcase (car extras)))
 578           (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
 579             (setq field (aref ov-entity field-index))
 580             (when (eq field-index 8) ;; xref
 581               (setq field (elmo-msgdb-remove-field-string field)))
 582             (setq extra (cons (cons ext field) extra)))
 583           (setq extras (cdr extras)))
 584         (setq overview
 585               (elmo-msgdb-append-element
 586                overview
 587                (cons (aref ov-entity 4)
 588                      (vector num
 589                              (elmo-msgdb-get-last-message-id
 590                               (aref ov-entity 5))
 591                              ;; from
 592                              (elmo-mime-string (elmo-delete-char
 593                                                 ?\"
 594                                                 (or
 595                                                  (aref ov-entity 2)
 596                                                  elmo-no-from) 'uni))
 597                              ;; subject
 598                              (elmo-mime-string (or (aref ov-entity 1)
 599                                                    elmo-no-subject))
 600                              (aref ov-entity 3) ;date
 601                              nil ; to
 602                              nil ; cc
 603                              (string-to-int
 604                               (aref ov-entity 6)) ; size
 605                              extra ; extra-field-list
 606                              ))))
 607         (setq number-alist
 608               (elmo-msgdb-number-add number-alist num
 609                                      (aref ov-entity 4)))
 610         (setq message-id (aref ov-entity 4))
 611         (setq seen (member message-id seen-list))
 612         (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 613                             (if (elmo-cache-exists-p message-id);; XXX
 614                                 (if seen
 615                                     nil
 616                                   already-mark)
 617                               (if seen
 618                                   (if elmo-nntp-use-cache
 619                                       seen-mark)
 620                                 new-mark))))
 621             (setq mark-alist
 622                   (elmo-msgdb-mark-append mark-alist
 623                                           num gmark))))
 624       (setq ov-list (cdr ov-list)))
 625     (list overview number-alist mark-alist)))
 626
 627 (defun elmo-nntp-msgdb-create-as-numlist (spec numlist new-mark already-mark
 628                                                seen-mark important-mark
 629                                                seen-list)
 630   "Create msgdb for SPEC for NUMLIST."
 631   (elmo-nntp-msgdb-create spec numlist new-mark already-mark
 632                           seen-mark important-mark seen-list
 633                           t))
 634
 635 (defun elmo-nntp-msgdb-create (spec numlist new-mark already-mark
 636                                     seen-mark important-mark
 637                                     seen-list &optional as-num)
 638   (when numlist
 639     (save-excursion
 640      (elmo-nntp-setting spec
 641       (let* ((cwf     (caddr connection))
 642              (filter  (and as-num numlist))
 643              beg-num end-num cur length
 644              ret-val ov-str use-xover)
 645         (if (and folder
 646                  (not (string= cwf folder))
 647                  (null (elmo-nntp-goto-folder server folder user port ssl)))
 648             (error "group %s not found" folder))
 649         (when (setq use-xover (elmo-nntp-xover-p server port))
 650           (setq beg-num (car numlist)
 651                 cur beg-num
 652                 end-num (nth (1- (length numlist)) numlist)
 653                 length  (+ (- end-num beg-num) 1))
 654           (message "Getting overview...")
 655           (while (<= cur end-num)
 656             (elmo-nntp-send-command buffer process
 657                                     (format
 658                                      "xover %s-%s"
 659                                      (int-to-string cur)
 660                                      (int-to-string
 661                                       (+ cur
 662                                          elmo-nntp-overview-fetch-chop-length))))
 663             (with-current-buffer buffer
 664               (if ov-str
 665                   (setq ret-val
 666                         (elmo-msgdb-append
 667                          ret-val
 668                          (elmo-nntp-create-msgdb-from-overview-string
 669                           ov-str
 670                           folder
 671                           new-mark
 672                           already-mark
 673                           seen-mark
 674                           important-mark
 675                           seen-list
 676                           filter
 677                           )))))
 678             (if (null (elmo-nntp-read-response buffer process t))
 679                 (progn
 680                   (setq cur end-num);; exit while loop
 681                   (elmo-nntp-set-xover server port nil)
 682                   (setq use-xover nil))
 683               (if (null (setq ov-str (elmo-nntp-read-contents buffer process)))
 684                   (error "Fetching overview failed")))
 685             (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
 686             (elmo-display-progress
 687              'elmo-nntp-msgdb-create "Getting overview..."
 688              (/ (* (+ (- (min cur
 689                               end-num)
 690                          beg-num) 1) 100) length))))
 691         (if (not use-xover)
 692             (setq ret-val (elmo-nntp-msgdb-create-by-header
 693                            folder buffer process numlist
 694                            new-mark already-mark seen-mark seen-list))
 695           (with-current-buffer buffer
 696             (if ov-str
 697                 (setq ret-val
 698                       (elmo-msgdb-append
 699                        ret-val
 700                        (elmo-nntp-create-msgdb-from-overview-string
 701                         ov-str
 702                         folder
 703                         new-mark
 704                         already-mark
 705                         seen-mark
 706                         important-mark
 707                         seen-list
 708                         filter))))))
 709         (elmo-display-progress
 710          'elmo-nntp-msgdb-create "Getting overview..." 100)
 711         ;; If there are canceled messages, overviews are not obtained
 712         ;; to max-number(inn 2.3?).
 713         (when (and (elmo-nntp-max-number-precedes-list-active-p)
 714                    (elmo-nntp-list-active-p server port))
 715           (elmo-nntp-send-command buffer process
 716                                   (format "list active %s" folder))
 717           (if (null (elmo-nntp-read-response buffer process))
 718               (progn
 719                 (elmo-nntp-set-list-active server port nil)
 720                 (error "NNTP list command failed")))
 721           (elmo-nntp-catchup-msgdb
 722            ret-val
 723            (nth 1 (read (concat "(" (elmo-nntp-read-contents
 724                                      buffer process) ")")))))
 725         ret-val)))))
 726
 727 (defun elmo-nntp-sync-number-alist (spec number-alist)
 728   (if (elmo-nntp-max-number-precedes-list-active-p)
 729       (elmo-nntp-setting spec
 730         (if (elmo-nntp-list-active-p server port)
 731             (let* ((cwf (caddr connection))
 732                    msgdb-max max-number)
 733               ;; If there are canceled messages, overviews are not obtained
 734               ;; to max-number(inn 2.3?).
 735               (if (and folder
 736                        (not (string= cwf folder))
 737                        (null (elmo-nntp-goto-folder
 738                               server folder user port ssl)))
 739                   (error "group %s not found" folder))
 740               (elmo-nntp-send-command buffer process
 741                                       (format "list active %s" folder))
 742               (if (null (elmo-nntp-read-response buffer process))
 743                   (error "NNTP list command failed"))
 744               (setq max-number
 745                     (nth 1 (read (concat "(" (elmo-nntp-read-contents
 746                                               buffer process) ")"))))
 747               (setq msgdb-max
 748                     (car (nth (max (- (length number-alist) 1) 0)
 749                               number-alist)))
 750               (if (or (and number-alist (not msgdb-max))
 751                       (and msgdb-max max-number
 752                            (< msgdb-max max-number)))
 753                   (nconc number-alist
 754                          (list (cons max-number nil)))
 755                 number-alist))
 756           number-alist))))
 757
 758 (defun elmo-nntp-msgdb-create-by-header (folder buffer process numlist
 759                                                 new-mark already-mark
 760                                                 seen-mark seen-list)
 761   (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))
 762         ret-val)
 763     (elmo-nntp-retrieve-headers
 764      buffer tmp-buffer process numlist)
 765     (setq ret-val
 766           (elmo-nntp-msgdb-create-message
 767            tmp-buffer (length numlist) folder new-mark already-mark
 768            seen-mark seen-list))
 769     (kill-buffer tmp-buffer)
 770     ret-val))
 771
 772 (defun elmo-nntp-parse-overview-string (string)
 773   (save-excursion
 774     (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))
 775           ret-list ret-val beg)
 776       (set-buffer tmp-buffer)
 777       (erase-buffer)
 778       (elmo-set-buffer-multibyte nil)
 779       (insert string)
 780       (goto-char (point-min))
 781       (setq beg (point))
 782       (while (not (eobp))
 783         (end-of-line)
 784         (setq ret-list (save-match-data
 785                          (apply 'vector (split-string
 786                                          (buffer-substring beg (point))
 787                                          "\t"))))
 788         (beginning-of-line)
 789         (forward-line 1)
 790         (setq beg (point))
 791         (setq ret-val (nconc ret-val (list ret-list))))
 792 ;      (kill-buffer tmp-buffer)
 793       ret-val)))
 794
 795 (defun elmo-nntp-get-overview (server beg end folder user port ssl)
 796   (save-excursion
 797     (let* ((connection (elmo-nntp-get-connection server user port ssl))
 798            (buffer  (car connection))
 799            (process (cadr connection))
 800 ;          (cwf     (caddr connection))
 801            response errmsg ov-str)
 802       (catch 'done
 803         (if folder
 804             (if (null (elmo-nntp-goto-folder server folder user port ssl))
 805                 (progn
 806                   (setq errmsg (format "group %s not found." folder))
 807                   (throw 'done nil))))
 808         (elmo-nntp-send-command buffer process
 809                                 (format "xover %s-%s" beg end))
 810         (if (null (setq response (elmo-nntp-read-response
 811                                   buffer process t)))
 812             (progn
 813               (setq errmsg "Getting overview failed.")
 814               (throw 'done nil)))
 815         (if (null (setq response (elmo-nntp-read-contents
 816                                   buffer process)))
 817             (progn
 818               ;(setq errmsg "Fetching header failed")
 819               (throw 'done nil)))
 820         (setq ov-str response)
 821         )
 822       (if errmsg
 823           (progn
 824             (message errmsg)
 825             nil)
 826         ov-str))))
 827
 828
 829 (defun elmo-nntp-get-message (server user number folder outbuf port ssl)
 830   "Get nntp message on FOLDER at SERVER.
 831 Returns message string."
 832   (save-excursion
 833     (let* ((connection (elmo-nntp-get-connection server user port ssl))
 834            (buffer  (car connection))
 835            (process (cadr connection))
 836            (cwf     (caddr connection))
 837            response errmsg)
 838       (catch 'done
 839         (if (and folder
 840                  (not (string= cwf folder)))
 841             (if (null (elmo-nntp-goto-folder server folder user port ssl))
 842                 (progn
 843                   (setq errmsg (format "group %s not found." folder))
 844                   (throw 'done nil))))
 845         (elmo-nntp-send-command buffer process
 846                                 (format "article %s" number))
 847         (if (null (setq response (elmo-nntp-read-response
 848                                   buffer process t)))
 849             (progn
 850               (setq errmsg "Fetching message failed")
 851               (set-buffer outbuf)
 852               (erase-buffer)
 853               (insert "\n\n")
 854               (throw 'done nil)))
 855         (setq response (elmo-nntp-read-body buffer process outbuf))
 856         (set-buffer outbuf)
 857         (goto-char (point-min))
 858         (while (re-search-forward "^\\." nil t)
 859           (replace-match "")
 860           (forward-line))
 861         )
 862       (if errmsg
 863           (progn
 864             (message errmsg)
 865             nil))
 866       response)))
 867
 868 (defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port ssl)
 869   "Get nntp header string."
 870   (save-excursion
 871     (let* ((connection (elmo-nntp-get-connection server user port ssl))
 872            (buffer  (car connection))
 873            (process (cadr connection)))
 874       (elmo-nntp-send-command buffer process
 875                               (format "head %s" msgid))
 876       (if (elmo-nntp-read-response buffer process)
 877           (elmo-nntp-read-contents buffer process))
 878       (set-buffer buffer)
 879       (std11-field-body "Newsgroups"))))
 880
 881 (defun elmo-nntp-open-connection (server user portnum ssl)
 882   "Open NNTP connection and returns
 883 the list of (process session-buffer current-working-folder).
 884 Return nil if connection failed."
 885   (let ((process nil)
 886         (host server)
 887         (port (or portnum
 888                   elmo-default-nntp-port))
 889         (user-at-host (format "%s@%s" user server))
 890         process-buffer)
 891     (as-binary-process
 892      (catch 'done
 893        (setq process-buffer
 894              (get-buffer-create (format " *NNTP session to %s:%d" host port)))
 895        (save-excursion
 896          (set-buffer process-buffer)
 897          (elmo-set-buffer-multibyte nil)
 898          (erase-buffer))
 899        (setq process
 900              (elmo-open-network-stream "NNTP" process-buffer host port ssl))
 901        (and (null process) (throw 'done nil))
 902        (set-process-filter process 'elmo-nntp-process-filter)
 903        ;; flush connections when exiting...?
 904        ;; (add-hook 'kill-emacs-hook 'elmo-nntp-flush-connection)
 905        (save-excursion
 906          (set-buffer process-buffer)
 907          (elmo-set-buffer-multibyte nil)
 908          (make-local-variable 'elmo-nntp-read-point)
 909          (setq elmo-nntp-read-point (point-min))
 910          (if (null (elmo-nntp-read-response process-buffer process t))
 911              (throw 'done nil))
 912          (if elmo-nntp-send-mode-reader
 913              (elmo-nntp-send-mode-reader process-buffer process))
 914          ;; starttls
 915          (if (eq ssl 'starttls)
 916              (if (progn
 917                    (elmo-nntp-send-command process-buffer process "starttls")
 918                    (elmo-nntp-read-response process-buffer process))
 919                  (starttls-negotiate process)
 920                (error "STARTTLS aborted")))
 921          (if user
 922              (progn
 923                (elmo-nntp-send-command process-buffer process
 924                                        (format "authinfo user %s" user))
 925                (if (null (elmo-nntp-read-response process-buffer process))
 926                    (error "Authinfo failed"))
 927                (elmo-nntp-send-command process-buffer process
 928                                        (format "authinfo pass %s"
 929                                                (elmo-get-passwd user-at-host)))
 930                (if (null (elmo-nntp-read-response process-buffer process))
 931                    (progn
 932                      (elmo-remove-passwd user-at-host)
 933                      (error "Authinfo failed")))))
 934          (run-hooks 'elmo-nntp-opened-hook)) ; XXX
 935        (cons process-buffer process)))))
 936
 937 (defun elmo-nntp-send-mode-reader (buffer process)
 938   (elmo-nntp-send-command buffer
 939                           process
 940                           "mode reader")
 941   (if (null (elmo-nntp-read-response buffer process t))
 942       (error "mode reader failed")))
 943
 944 (defun elmo-nntp-send-command (buffer process command &optional noerase)
 945   "Send COMMAND string to server with sequence number."
 946   (save-excursion
 947     (set-buffer buffer)
 948     (when (not noerase)
 949       (erase-buffer)
 950       (goto-char (point-min)))
 951     (setq elmo-nntp-read-point (point))
 952     (process-send-string process command)
 953     (process-send-string process "\r\n")))
 954
 955 (defun elmo-nntp-read-msg (spec msg outbuf)
 956   (elmo-nntp-get-message (elmo-nntp-spec-hostname spec)
 957                          (elmo-nntp-spec-username spec)
 958                          msg
 959                          (elmo-nntp-spec-group spec)
 960                          outbuf
 961                          (elmo-nntp-spec-port spec)
 962                          (elmo-nntp-spec-ssl spec)))
 963
 964 ;(defun elmo-msgdb-nntp-overview-create-range (spec beg end mark)
 965 ;    (elmo-nntp-overview-create-range hostname beg end mark folder)))
 966
 967 ;(defun elmo-msgdb-nntp-max-of-folder (spec)
 968 ;    (elmo-nntp-max-of-folder hostname folder)))
 969
 970 (defun elmo-nntp-append-msg (spec string &optional msg no-see))
 971
 972 (defun elmo-nntp-post (hostname content-buf)
 973   (let* (;(folder (nth 1 spec))
 974          (connection
 975           (elmo-nntp-get-connection
 976            hostname
 977            elmo-default-nntp-user
 978            elmo-default-nntp-port elmo-default-nntp-ssl))
 979          (buffer (car connection))
 980          (process (cadr connection))
 981          response has-message-id
 982          )
 983     (save-excursion
 984       (set-buffer content-buf)
 985       (goto-char (point-min))
 986       (if (search-forward mail-header-separator nil t)
 987           (delete-region (match-beginning 0)(match-end 0)))
 988       (setq has-message-id (std11-field-body "message-id"))
 989       (elmo-nntp-send-command buffer process "post")
 990       (if (string-match "^340" (setq response
 991                                      (elmo-nntp-read-raw-response
 992                                       buffer process)))
 993           (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
 994               (unless has-message-id
 995                 (goto-char (point-min))
 996                 (insert (concat "Message-ID: "
 997                                 (elmo-match-string 1 response)
 998                                 "\n"))))
 999         (error "POST failed"))
1000       (current-buffer)
1001       (run-hooks 'elmo-nntp-post-pre-hook)
1002       (set-buffer buffer)
1003       (elmo-nntp-send-data process content-buf)
1004       (elmo-nntp-send-command buffer process ".")
1005       ;(elmo-nntp-read-response buffer process t)
1006       (if (not (string-match
1007                 "^2" (setq response (elmo-nntp-read-raw-response
1008                                      buffer process))))
1009           (error (concat "NNTP error: " response))))))
1010
1011 (defun elmo-nntp-send-data-line (process data)
1012   (goto-char (point-max))
1013
1014   ;; Escape "." at start of a line
1015   (if (eq (string-to-char data) ?.)
1016       (process-send-string process "."))
1017   (process-send-string process data)
1018   (process-send-string process "\r\n"))
1019
1020 (defun elmo-nntp-send-data (process buffer)
1021   (let
1022       ((data-continue t)
1023        (sending-data nil)
1024        this-line
1025        this-line-end)
1026     (save-excursion
1027       (set-buffer buffer)
1028       (goto-char (point-min)))
1029
1030     (while data-continue
1031       (save-excursion
1032         (set-buffer buffer)
1033         (beginning-of-line)
1034         (setq this-line (point))
1035         (end-of-line)
1036         (setq this-line-end (point))
1037         (setq sending-data nil)
1038         (setq sending-data (buffer-substring this-line this-line-end))
1039         (if (/= (forward-line 1) 0)
1040             (setq data-continue nil)))
1041
1042       (elmo-nntp-send-data-line process sending-data))))
1043
1044
1045 (defun elmo-nntp-delete-msgs (spec msgs)
1046   "MSGS on FOLDER at SERVER pretended as Deleted. Returns nil if failed."
1047   (let* ((dir (elmo-msgdb-expand-path nil spec))
1048 ;        (msgs (mapcar 'string-to-int msgs))
1049          (killed-list (elmo-msgdb-killed-list-load dir)))
1050     (mapcar '(lambda (msg)
1051                (setq killed-list
1052                      (elmo-msgdb-set-as-killed killed-list msg)))
1053             msgs)
1054     (elmo-msgdb-killed-list-save dir killed-list)
1055     t))
1056
1057 (defun elmo-nntp-check-validity (spec validity-file)
1058   t)
1059 (defun elmo-nntp-sync-validity (spec validity-file)
1060   t)
1061
1062 (defun elmo-nntp-folder-exists-p (spec)
1063   (if (elmo-nntp-plugged-p spec)
1064       (elmo-nntp-setting spec
1065         (elmo-nntp-send-command buffer
1066                                 process
1067                                 (format "group %s" folder))
1068         (elmo-nntp-read-response buffer process))
1069     t))
1070
1071 (defun elmo-nntp-folder-creatable-p (spec)
1072   nil)
1073
1074 (defun elmo-nntp-create-folder (spec)
1075   nil) ; noop
1076
1077 (defun elmo-nntp-search (spec condition &optional from-msgs)
1078   (error "Search by %s for %s is not implemented yet." condition (car spec))
1079   nil)
1080
1081 (defun elmo-nntp-get-folders-info-prepare (spec connection-keys)
1082   (condition-case ()
1083       (elmo-nntp-setting spec
1084         (let (key count)
1085           (save-excursion
1086             (set-buffer buffer)
1087             (unless (setq key (assoc (cons buffer process) connection-keys))
1088               (erase-buffer)
1089               (setq key (cons (cons buffer process)
1090                               (vector 0 server user port ssl)))
1091               (setq connection-keys (nconc connection-keys (list key))))
1092             (elmo-nntp-send-command buffer
1093                                     process
1094                                     (format "group %s" folder)
1095                                     t ;; don't erase-buffer
1096                                     )
1097             (if elmo-nntp-get-folders-securely
1098                 (accept-process-output process 1))
1099             (setq count (aref (cdr key) 0))
1100             (aset (cdr key) 0 (1+ count)))))
1101     (error
1102      (when elmo-auto-change-plugged
1103        (sit-for 1))
1104      nil))
1105   connection-keys)
1106
1107 (defun elmo-nntp-get-folders-info (connection-keys)
1108   (let ((connections connection-keys)
1109         (cur (get-buffer-create " *ELMO NNTP Temp*")))
1110     (while connections
1111       (let* ((connect (caar connections))
1112              (key     (cdar connections))
1113              (buffer  (car connect))
1114              (process (cdr connect))
1115              (count   (aref key 0))
1116              (server  (aref key 1))
1117              (user    (aref key 2))
1118              (port    (aref key 3))
1119              (ssl     (aref key 4))
1120              (hashtb (or elmo-nntp-groups-hashtb
1121                          (setq elmo-nntp-groups-hashtb
1122                                (elmo-make-hash count)))))
1123         (save-excursion
1124           (elmo-nntp-groups-read-response buffer cur process count)
1125           (set-buffer cur)
1126           (goto-char (point-min))
1127           (let ((case-replace nil)
1128                 (postfix (elmo-nntp-folder-postfix user server port ssl)))
1129             (if (not (string= postfix ""))
1130                 (save-excursion
1131                   (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$"
1132                                   (concat "\\1" postfix)))))
1133           (let (len min max group)
1134             (while (not (eobp))
1135               (condition-case ()
1136                   (when (= (following-char) ?2)
1137                     (read cur)
1138                     (setq len (read cur)
1139                           min (read cur)
1140                           max (read cur))
1141                     (set (setq group (let ((obarray hashtb)) (read cur)))
1142                          (list len min max)))
1143                 (error (and group (symbolp group) (set group nil))))
1144               (forward-line 1))))
1145         (setq connections (cdr connections))))
1146     (kill-buffer cur)))
1147
1148 ;; original is 'nntp-retrieve-groups [Gnus]
1149 (defun elmo-nntp-groups-read-response (buffer tobuffer process count)
1150   (let* ((received 0)
1151          (last-point (point-min)))
1152     (save-excursion
1153       (set-buffer buffer)
1154       (accept-process-output process 1)
1155       (discard-input)
1156       ;; Wait for all replies.
1157       (message "Getting folders info...")
1158       (while (progn
1159                (goto-char last-point)
1160                ;; Count replies.
1161                (while (re-search-forward "^[0-9]" nil t)
1162                  (setq received
1163                        (1+ received)))
1164                (setq last-point (point))
1165                (< received count))
1166         (accept-process-output process 1)
1167         (discard-input)
1168         (and (zerop (% received 10))
1169              (elmo-display-progress
1170               'elmo-nntp-groups-read-response "Getting folders info..."
1171               (/ (* received 100) count)))
1172         )
1173       (elmo-display-progress
1174        'elmo-nntp-groups-read-response "Getting folders info..."
1175        100)
1176       ;; Wait for the reply from the final command.
1177       (goto-char (point-max))
1178       (re-search-backward "^[0-9]" nil t)
1179       (when (looking-at "^[23]")
1180         (while (progn
1181                  (goto-char (point-max))
1182                  (not (re-search-backward "\r?\n" (- (point) 3) t)))
1183           (accept-process-output process 1)
1184           (discard-input)))
1185       ;; Now all replies are received.  We remove CRs.
1186       (goto-char (point-min))
1187       (while (search-forward "\r" nil t)
1188         (replace-match "" t t))
1189       (copy-to-buffer tobuffer (point-min) (point-max)))))
1190
1191 (defun elmo-nntp-make-groups-hashtb (folders &optional size)
1192   (let ((hashtb (or elmo-nntp-groups-hashtb
1193                     (setq elmo-nntp-groups-hashtb
1194                           (elmo-make-hash (or size (length folders)))))))
1195     (mapcar
1196      '(lambda (fld)
1197         (or (elmo-get-hash-val fld hashtb)
1198             (elmo-set-hash-val fld nil hashtb)))
1199      folders)
1200     hashtb))
1201
1202 ;; from nntp.el [Gnus]
1203
1204 (defsubst elmo-nntp-next-result-arrived-p ()
1205   (cond
1206    ((eq (following-char) ?2)
1207     (if (re-search-forward "\n\\.\r?\n" nil t)
1208         t
1209       nil))
1210    ((looking-at "[34]")
1211     (if (search-forward "\n" nil t)
1212         t
1213       nil))
1214    (t
1215     nil)))
1216
1217 (defun elmo-nntp-retrieve-headers (buffer tobuffer process articles)
1218   "Retrieve the headers of ARTICLES."
1219   (save-excursion
1220     (set-buffer buffer)
1221     (erase-buffer)
1222     (let ((number (length articles))
1223           (count 0)
1224           (received 0)
1225           (last-point (point-min))
1226           article)
1227       ;; Send HEAD commands.
1228       (while (setq article (pop articles))
1229         (elmo-nntp-send-command
1230          buffer
1231          process
1232          (format "head %s" article)
1233          t ;; not erase-buffer
1234          )
1235         (setq count (1+ count))
1236         ;; Every 200 requests we have to read the stream in
1237         ;; order to avoid deadlocks.
1238         (when (or (null articles)       ;All requests have been sent.
1239                   (zerop (% count elmo-nntp-header-fetch-chop-length)))
1240           (accept-process-output process 1)
1241           (discard-input)
1242           (while (progn
1243                    (set-buffer buffer)
1244                    (goto-char last-point)
1245                    ;; Count replies.
1246                    (while (elmo-nntp-next-result-arrived-p)
1247                      (setq last-point (point))
1248                      (setq received (1+ received)))
1249                    (< received count))
1250             (and (zerop (% received 20))
1251                  (elmo-display-progress
1252                   'elmo-nntp-retrieve-headers "Getting headers..."
1253                   (/ (* received 100) number)))
1254             (accept-process-output process 1)
1255             (discard-input)
1256             )))
1257       (elmo-display-progress
1258        'elmo-nntp-retrieve-headers "Getting headers..." 100)
1259       (message "Getting headers...done")
1260       ;; Remove all "\r"'s.
1261       (goto-char (point-min))
1262       (while (search-forward "\r\n" nil t)
1263         (replace-match "\n"))
1264       (copy-to-buffer tobuffer (point-min) (point-max)))))
1265
1266 ;; end of from Gnus
1267
1268 (defun elmo-nntp-msgdb-create-message (buffer len folder new-mark
1269                                               already-mark seen-mark seen-list)
1270   (save-excursion
1271     (let (beg
1272           overview number-alist mark-alist
1273           entity i num gmark seen message-id)
1274       (set-buffer buffer)
1275       (elmo-set-buffer-multibyte nil)
1276       (goto-char (point-min))
1277       (setq i 0)
1278       (message "Creating msgdb...")
1279       (while (not (eobp))
1280         (setq beg (save-excursion (forward-line 1) (point)))
1281         (setq num
1282               (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
1283                    (string-to-int
1284                     (elmo-match-buffer 1))))
1285         (elmo-nntp-next-result-arrived-p)
1286         (when num
1287           (save-excursion
1288             (forward-line -1)
1289             (save-restriction
1290               (narrow-to-region beg (point))
1291               (setq entity
1292                     (elmo-msgdb-create-overview-from-buffer num))
1293               (when entity
1294                 (setq overview
1295                       (elmo-msgdb-append-element
1296                        overview entity))
1297                 (setq number-alist
1298                       (elmo-msgdb-number-add number-alist
1299                                              (elmo-msgdb-overview-entity-get-number entity)
1300                                              (car entity)))
1301                 (setq message-id (car entity))
1302                 (setq seen (member message-id seen-list))
1303                 (if (setq gmark
1304                           (or (elmo-msgdb-global-mark-get message-id)
1305                               (if (elmo-cache-exists-p message-id);; XXX
1306                                   (if seen
1307                                       nil
1308                                     already-mark)
1309                                 (if seen
1310                                     seen-mark
1311                                   new-mark))))
1312                     (setq mark-alist
1313                           (elmo-msgdb-mark-append
1314                            mark-alist
1315                            num gmark)))
1316                 ))))
1317         (setq i (1+ i))
1318         (and (zerop (% i 20))
1319              (elmo-display-progress
1320               'elmo-nntp-msgdb-create-message "Creating msgdb..."
1321               (/ (* i 100) len))))
1322       (elmo-display-progress
1323        'elmo-nntp-msgdb-create-message "Creating msgdb..." 100)
1324       (list overview number-alist mark-alist))))
1325
1326 (defun elmo-nntp-use-cache-p (spec number)
1327   elmo-nntp-use-cache)
1328
1329 (defun elmo-nntp-local-file-p (spec number)
1330   nil)
1331
1332 (defun elmo-nntp-port-label (spec)
1333   (concat "nntp"
1334           (if (elmo-nntp-spec-ssl spec) "!ssl" "")))
1335
1336 (defsubst elmo-nntp-portinfo (spec)
1337   (list (elmo-nntp-spec-hostname spec)
1338         (elmo-nntp-spec-port spec)))
1339
1340 (defun elmo-nntp-plugged-p (spec)
1341   (apply 'elmo-plugged-p
1342          (append (elmo-nntp-portinfo spec)
1343                  (list nil (quote (elmo-nntp-port-label spec))))))
1344
1345 (defun elmo-nntp-set-plugged (spec plugged add)
1346   (apply 'elmo-set-plugged plugged
1347          (append (elmo-nntp-portinfo spec)
1348                  (list nil nil (quote (elmo-nntp-port-label spec)) add))))
1349
1350 (defalias 'elmo-nntp-list-folder-unread
1351   'elmo-generic-list-folder-unread)
1352 (defalias 'elmo-nntp-list-folder-important
1353   'elmo-generic-list-folder-important)
1354 (defalias 'elmo-nntp-commit 'elmo-generic-commit)
1355
1356 (provide 'elmo-nntp)
1357
1358 ;;; elmo-nntp.el ends here