elmo/elmo-nntp.el

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