elmo/elmo-nntp.el

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