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