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