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
 990                    (elmo-get-network-stream-type
 991                     elmo-nntp-default-stream-type))))
 992         response has-message-id)
 993     (save-excursion
 994       (set-buffer content-buf)
 995       (goto-char (point-min))
 996       (if (search-forward mail-header-separator nil t)
 997           (delete-region (match-beginning 0)(match-end 0)))
 998       (setq has-message-id (std11-field-body "message-id"))
 999       (elmo-nntp-send-command session "post")
1000       (if (string-match "^340" (setq response
1001                                      (elmo-nntp-read-raw-response session)))
1002           (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
1003               (unless has-message-id
1004                 (goto-char (point-min))
1005                 (insert (concat "Message-ID: "
1006                                 (elmo-match-string 1 response)
1007                                 "\n"))))
1008         (error "POST failed"))
1009       (run-hooks 'elmo-nntp-post-pre-hook)
1010       (elmo-nntp-send-buffer session content-buf)
1011       (elmo-nntp-send-command session ".")
1012 ;;;   (elmo-nntp-read-response buffer process t)
1013       (if (not (string-match
1014                 "^2" (setq response (elmo-nntp-read-raw-response
1015                                      session))))
1016           (error (concat "NNTP error: " response))))))
1017
1018 (defsubst elmo-nntp-send-data-line (session line)
1019   "Send LINE to SESSION."
1020   ;; Escape "." at start of a line
1021   (if (eq (string-to-char line) ?.)
1022       (process-send-string (elmo-network-session-process-internal
1023                             session) "."))
1024   (process-send-string (elmo-network-session-process-internal
1025                         session) line)
1026   (process-send-string (elmo-network-session-process-internal
1027                         session) "\r\n"))
1028
1029 (defun elmo-nntp-send-buffer (session databuf)
1030   "Send data content of DATABUF to SESSION."
1031   (let ((data-continue t)
1032         line bol)
1033     (with-current-buffer databuf
1034       (goto-char (point-min))
1035       (while data-continue
1036         (beginning-of-line)
1037         (setq bol (point))
1038         (end-of-line)
1039         (setq line (buffer-substring bol (point)))
1040         (unless (eq (forward-line 1) 0) (setq data-continue nil))
1041         (elmo-nntp-send-data-line session line)))))
1042
1043 (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
1044                                                  numbers)
1045   (elmo-nntp-folder-delete-messages folder numbers))
1046
1047 (defun elmo-nntp-folder-delete-messages (folder numbers)
1048   (let ((killed-list (elmo-folder-killed-list-internal folder)))
1049     (dolist (number numbers)
1050       (setq killed-list
1051             (elmo-msgdb-set-as-killed killed-list number)))
1052     (elmo-folder-set-killed-list-internal folder killed-list))
1053   t)
1054
1055 (luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder))
1056   (let ((session (elmo-nntp-get-session folder)))
1057     (if (elmo-folder-plugged-p folder)
1058         (progn
1059           (elmo-nntp-send-command
1060            session
1061            (format "group %s"
1062                    (elmo-nntp-folder-group-internal folder)))
1063           (elmo-nntp-read-response session))
1064       t)))
1065
1066 (defun elmo-nntp-retrieve-field (spec field from-msgs)
1067   "Retrieve FIELD values from FROM-MSGS.
1068 Returns a list of cons cells like (NUMBER . VALUE)"
1069   (let ((session (elmo-nntp-get-session spec)))
1070     (if (elmo-nntp-xhdr-p session)
1071         (progn
1072           (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
1073           (elmo-nntp-send-command session
1074                                   (format "xhdr %s %s"
1075                                           field
1076                                           (if from-msgs
1077                                               (format
1078                                                "%d-%d"
1079                                                (car from-msgs)
1080                                                (nth
1081                                                 (max
1082                                                  (- (length from-msgs) 1) 0)
1083                                                 from-msgs))
1084                                             "0-")))
1085           (if (elmo-nntp-read-response session t)
1086               (elmo-nntp-parse-xhdr-response
1087                (elmo-nntp-read-contents session))
1088             (elmo-nntp-set-xhdr session nil)
1089             (error "NNTP XHDR command failed"))))))
1090
1091 (defun elmo-nntp-search-primitive (spec condition &optional from-msgs)
1092   (let ((search-key (elmo-filter-key condition)))
1093     (cond
1094      ((string= "last" search-key)
1095       (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
1096         (nthcdr (max (- (length numbers)
1097                         (string-to-int (elmo-filter-value condition)))
1098                      0)
1099                 numbers)))
1100      ((string= "first" search-key)
1101       (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
1102              (rest (nthcdr (string-to-int (elmo-filter-value condition) )
1103                            numbers)))
1104         (mapcar '(lambda (x) (delete x numbers)) rest)
1105         numbers))
1106      ((or (string= "since" search-key)
1107           (string= "before" search-key))
1108       (let* ((key-date (elmo-date-get-datevec (elmo-filter-value condition)))
1109              (key-datestr (elmo-date-make-sortable-string key-date))
1110              (since (string= "since" search-key))
1111              result)
1112         (if (eq (elmo-filter-type condition) 'unmatch)
1113             (setq since (not since)))
1114         (setq result
1115               (delq nil
1116                     (mapcar
1117                      (lambda (pair)
1118                        (if (if since
1119                                (string< key-datestr
1120                                         (elmo-date-make-sortable-string
1121                                          (timezone-fix-time
1122                                           (cdr pair)
1123                                           (current-time-zone) nil)))
1124                              (not (string< key-datestr
1125                                            (elmo-date-make-sortable-string
1126                                             (timezone-fix-time
1127                                              (cdr pair)
1128                                              (current-time-zone) nil)))))
1129                            (car pair)))
1130                      (elmo-nntp-retrieve-field spec "date" from-msgs))))
1131         (if from-msgs
1132             (elmo-list-filter from-msgs result)
1133           result)))
1134      (t
1135       (let ((val (elmo-filter-value condition))
1136             (negative (eq (elmo-filter-type condition) 'unmatch))
1137             (case-fold-search t)
1138             result)
1139         (setq result
1140               (delq nil
1141                     (mapcar
1142                      (lambda (pair)
1143                        (if (string-match val
1144                                          (eword-decode-string
1145                                           (decode-mime-charset-string
1146                                            (cdr pair) elmo-mime-charset)))
1147                            (unless negative (car pair))
1148                          (if negative (car pair))))
1149                      (elmo-nntp-retrieve-field spec search-key
1150                                                from-msgs))))
1151         (if from-msgs
1152             (elmo-list-filter from-msgs result)
1153           result))))))
1154
1155 (luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
1156                                         condition &optional from-msgs)
1157   (let (result)
1158     (cond
1159      ((vectorp condition)
1160       (setq result (elmo-nntp-search-primitive
1161                     folder condition from-msgs)))
1162      ((eq (car condition) 'and)
1163       (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
1164             result (elmo-list-filter result
1165                                      (elmo-folder-search
1166                                       folder (nth 2 condition)
1167                                       from-msgs))))
1168      ((eq (car condition) 'or)
1169       (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
1170             result (elmo-uniq-list
1171                     (nconc result
1172                            (elmo-folder-search folder (nth 2 condition)
1173                                                from-msgs)))
1174             result (sort result '<))))))
1175
1176 (defun elmo-nntp-get-folders-info-prepare (folder session-keys)
1177   (condition-case ()
1178       (let ((session (elmo-nntp-get-session folder))
1179             key count)
1180         (with-current-buffer (elmo-network-session-buffer session)
1181           (unless (setq key (assoc session session-keys))
1182             (erase-buffer)
1183             (setq key (cons session
1184                             (vector 0
1185                                     (elmo-net-folder-server-internal folder)
1186                                     (elmo-net-folder-user-internal folder)
1187                                     (elmo-net-folder-port-internal folder)
1188                                     (elmo-net-folder-stream-type-internal
1189                                      folder))))
1190             (setq session-keys (nconc session-keys (list key))))
1191           (elmo-nntp-send-command session
1192                                   (format "group %s"
1193                                           (elmo-nntp-folder-group-internal
1194                                            folder))
1195                                   'noerase)
1196           (if elmo-nntp-get-folders-securely
1197               (accept-process-output
1198                (elmo-network-session-process-internal session)
1199                1))
1200           (setq count (aref (cdr key) 0))
1201           (aset (cdr key) 0 (1+ count))))
1202     (error
1203      (when elmo-auto-change-plugged
1204        (sit-for 1))
1205      nil))
1206   session-keys)
1207
1208 (defun elmo-nntp-get-folders-info (session-keys)
1209   (let ((sessions session-keys)
1210         (cur (get-buffer-create " *ELMO NNTP Temp*")))
1211     (while sessions
1212       (let* ((session (caar sessions))
1213              (key     (cdar sessions))
1214              (count   (aref key 0))
1215              (server  (aref key 1))
1216              (user    (aref key 2))
1217              (port    (aref key 3))
1218              (type    (aref key 4))
1219              (hashtb (or elmo-newsgroups-hashtb
1220                          (setq elmo-newsgroups-hashtb
1221                                (elmo-make-hash count)))))
1222         (save-excursion
1223           (elmo-nntp-groups-read-response session cur count)
1224           (set-buffer cur)
1225           (goto-char (point-min))
1226           (let ((case-replace nil)
1227                 (postfix (elmo-nntp-folder-postfix user server port type)))
1228             (if (not (string= postfix ""))
1229                 (save-excursion
1230                   (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$"
1231                                   (concat "\\1"
1232                                           (elmo-replace-in-string
1233                                            postfix
1234                                            "\\\\" "\\\\\\\\\\\\\\\\"))))))
1235           (let (len min max group)
1236             (while (not (eobp))
1237               (condition-case ()
1238                   (when (= (following-char) ?2)
1239                     (read cur)
1240                     (setq len (read cur)
1241                           min (read cur)
1242                           max (read cur))
1243                     (set (setq group (let ((obarray hashtb)) (read cur)))
1244                          (list len min max)))
1245                 (error (and group (symbolp group) (set group nil))))
1246               (forward-line 1))))
1247         (setq sessions (cdr sessions))))
1248     (kill-buffer cur)))
1249
1250 ;; original is 'nntp-retrieve-groups [Gnus]
1251 (defun elmo-nntp-groups-read-response (session outbuf count)
1252   (let* ((received 0)
1253          (last-point (point-min)))
1254     (with-current-buffer (elmo-network-session-buffer session)
1255       (accept-process-output
1256        (elmo-network-session-process-internal session) 1)
1257       (discard-input)
1258       ;; Wait for all replies.
1259       (message "Getting folders info...")
1260       (while (progn
1261                (goto-char last-point)
1262                ;; Count replies.
1263                (while (re-search-forward "^[0-9]" nil t)
1264                  (setq received
1265                        (1+ received)))
1266                (setq last-point (point))
1267                (< received count))
1268         (accept-process-output (elmo-network-session-process-internal session)
1269                                1)
1270         (discard-input)
1271         (when (> count elmo-display-progress-threshold)
1272           (if (or (zerop (% received 10)) (= received count))
1273               (elmo-display-progress
1274                'elmo-nntp-groups-read-response "Getting folders info..."
1275                (/ (* received 100) count)))))
1276       (when (> count elmo-display-progress-threshold)
1277         (elmo-display-progress
1278          'elmo-nntp-groups-read-response "Getting folders info..." 100))
1279       ;; Wait for the reply from the final command.
1280       (goto-char (point-max))
1281       (re-search-backward "^[0-9]" nil t)
1282       (when (looking-at "^[23]")
1283         (while (progn
1284                  (goto-char (point-max))
1285                  (not (re-search-backward "\r?\n" (- (point) 3) t)))
1286           (accept-process-output
1287            (elmo-network-session-process-internal session) 1)
1288           (discard-input)))
1289       ;; Now all replies are received.  We remove CRs.
1290       (goto-char (point-min))
1291       (while (search-forward "\r" nil t)
1292         (replace-match "" t t))
1293       (copy-to-buffer outbuf (point-min) (point-max)))))
1294
1295 ;; from nntp.el [Gnus]
1296
1297 (defsubst elmo-nntp-next-result-arrived-p ()
1298   (cond
1299    ((eq (following-char) ?2)
1300     (if (re-search-forward "\n\\.\r?\n" nil t)
1301         t
1302       nil))
1303    ((looking-at "[34]")
1304     (if (search-forward "\n" nil t)
1305         t
1306       nil))
1307    (t
1308     nil)))
1309
1310 (defun elmo-nntp-retrieve-headers (session outbuf articles)
1311   "Retrieve the headers of ARTICLES."
1312   (with-current-buffer (elmo-network-session-buffer session)
1313     (erase-buffer)
1314     (let ((number (length articles))
1315           (count 0)
1316           (received 0)
1317           (last-point (point-min))
1318           article)
1319       ;; Send HEAD commands.
1320       (while (setq article (pop articles))
1321         (elmo-nntp-send-command session
1322                                 (format "head %s" article)
1323                                 'noerase)
1324         (setq count (1+ count))
1325         ;; Every 200 requests we have to read the stream in
1326         ;; order to avoid deadlocks.
1327         (when (or (null articles)       ;All requests have been sent.
1328                   (zerop (% count elmo-nntp-header-fetch-chop-length)))
1329           (accept-process-output
1330            (elmo-network-session-process-internal session) 1)
1331           (discard-input)
1332           (while (progn
1333                    (goto-char last-point)
1334                    ;; Count replies.
1335                    (while (elmo-nntp-next-result-arrived-p)
1336                      (setq last-point (point))
1337                      (setq received (1+ received)))
1338                    (< received count))
1339             (when (> number elmo-display-progress-threshold)
1340               (if (or (zerop (% received 20)) (= received number))
1341                   (elmo-display-progress
1342                    'elmo-nntp-retrieve-headers "Getting headers..."
1343                    (/ (* received 100) number))))
1344             (accept-process-output
1345              (elmo-network-session-process-internal session) 1)
1346             (discard-input))))
1347       (when (> number elmo-display-progress-threshold)
1348         (elmo-display-progress
1349          'elmo-nntp-retrieve-headers "Getting headers..." 100))
1350       (message "Getting headers...done")
1351       ;; Remove all "\r"'s.
1352       (goto-char (point-min))
1353       (while (search-forward "\r\n" nil t)
1354         (replace-match "\n"))
1355       (copy-to-buffer outbuf (point-min) (point-max)))))
1356
1357 ;; end of from Gnus
1358
1359 (defun elmo-nntp-msgdb-create-message (len new-mark
1360                                            already-mark seen-mark seen-list)
1361   (save-excursion
1362     (let (beg overview number-alist mark-alist
1363               entity i num gmark seen message-id)
1364       (elmo-set-buffer-multibyte nil)
1365       (goto-char (point-min))
1366       (setq i 0)
1367       (message "Creating msgdb...")
1368       (while (not (eobp))
1369         (setq beg (save-excursion (forward-line 1) (point)))
1370         (setq num
1371               (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
1372                    (string-to-int
1373                     (elmo-match-buffer 1))))
1374         (elmo-nntp-next-result-arrived-p)
1375         (when num
1376           (save-excursion
1377             (forward-line -1)
1378             (save-restriction
1379               (narrow-to-region beg (point))
1380               (setq entity
1381                     (elmo-msgdb-create-overview-from-buffer num))
1382               (when entity
1383                 (setq overview
1384                       (elmo-msgdb-append-element
1385                        overview entity))
1386                 (setq number-alist
1387                       (elmo-msgdb-number-add
1388                        number-alist
1389                        (elmo-msgdb-overview-entity-get-number entity)
1390                        (car entity)))
1391                 (setq message-id (car entity))
1392                 (setq seen (member message-id seen-list))
1393                 (if (setq gmark
1394                           (or (elmo-msgdb-global-mark-get message-id)
1395                               (if (elmo-file-cache-status
1396                                    (elmo-file-cache-get message-id))
1397                                   (if seen
1398                                       nil
1399                                     already-mark)
1400                                 (if seen
1401                                     (if elmo-nntp-use-cache
1402                                         seen-mark)
1403                                   new-mark))))
1404                     (setq mark-alist
1405                           (elmo-msgdb-mark-append
1406                            mark-alist
1407                            num gmark)))
1408                 ))))
1409         (when (> len elmo-display-progress-threshold)
1410           (setq i (1+ i))
1411           (if (or (zerop (% i 20)) (= i len))
1412               (elmo-display-progress
1413                'elmo-nntp-msgdb-create-message "Creating msgdb..."
1414                (/ (* i 100) len)))))
1415       (when (> len elmo-display-progress-threshold)
1416         (elmo-display-progress
1417          'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
1418       (list overview number-alist mark-alist))))
1419
1420 (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
1421   elmo-nntp-use-cache)
1422
1423 (luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder))
1424   nil)
1425
1426 (luna-define-method elmo-folder-writable-p ((folder elmo-nntp-folder))
1427   nil)
1428
1429 (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
1430   (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
1431         ngs)
1432     (if (not subscribe-only)
1433         nglist
1434       (dolist (ng nglist)
1435         (if (intern-soft ng elmo-newsgroups-hashtb)
1436             (setq ngs (cons ng ngs))))
1437       ngs)))
1438
1439 ;;; Crosspost processing.
1440
1441 ;; 1. setup crosspost alist.
1442 ;;    1.1. When message is fetched and is crossposted message,
1443 ;;         it is remembered in `temp-crosses' slot.
1444 ;;         temp-crosses slot is a list of cons cell:
1445 ;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1446 ;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1447 ;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
1448 ;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1449
1450 ;; 2. process crosspost alist.
1451 ;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1452 ;;         `elmo-crosspost-message-alist'.
1453 ;;    2.2. remove crosspost entry for current newsgroup from
1454 ;;         `elmo-crosspost-message-alist'.
1455 ;;    2.3. elmo-folder-list-unreads return unread message list according to
1456 ;;         `reads' slot.
1457 ;;         (There's a problem that if `elmo-folder-list-unreads'
1458 ;;           never executed, crosspost information is thrown away.)
1459 ;;    2.4. In elmo-folder-close, `read' slot is cleared,
1460
1461 (defun elmo-nntp-setup-crosspost-buffer (folder number)
1462 ;;    1.1. When message is fetched and is crossposted message,
1463 ;;         it is remembered in `temp-crosses' slot.
1464 ;;         temp-crosses slot is a list of cons cell:
1465 ;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1466   (let (newsgroups crosspost-newsgroups message-id)
1467     (save-restriction
1468       (std11-narrow-to-header)
1469       (setq newsgroups (std11-fetch-field "newsgroups")
1470             message-id (std11-msg-id-string
1471                         (car (std11-parse-msg-id-string
1472                               (std11-fetch-field "message-id"))))))
1473     (when newsgroups
1474       (when (setq crosspost-newsgroups
1475                   (delete
1476                    (elmo-nntp-folder-group-internal folder)
1477                    (elmo-nntp-parse-newsgroups newsgroups t)))
1478         (unless (assq number
1479                       (elmo-nntp-folder-temp-crosses-internal folder))
1480           (elmo-nntp-folder-set-temp-crosses-internal
1481            folder
1482            (cons (cons number (list message-id crosspost-newsgroups 'ng))
1483                  (elmo-nntp-folder-temp-crosses-internal folder))))))))
1484
1485 (luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
1486 ;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1487   (elmo-nntp-folder-set-temp-crosses-internal folder nil)
1488   (elmo-nntp-folder-set-reads-internal folder nil)
1489   )
1490
1491 (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
1492 ;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
1493 ;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1494   (let (elem)
1495     (dolist (number numbers)
1496       (when (setq elem (assq number
1497                              (elmo-nntp-folder-temp-crosses-internal folder)))
1498         (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
1499           (setq elmo-crosspost-message-alist
1500                 (cons (cdr elem) elmo-crosspost-message-alist)))
1501         (elmo-nntp-folder-set-temp-crosses-internal
1502          folder
1503          (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
1504
1505 (luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder)
1506                                               numbers)
1507   (elmo-nntp-folder-update-crosspost-message-alist folder numbers)
1508   t)
1509
1510 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)
1511                                                    &optional
1512                                                    number-alist)
1513   (elmo-nntp-folder-process-crosspost folder number-alist))
1514
1515 (defun elmo-nntp-folder-process-crosspost (folder number-alist)
1516 ;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1517 ;;         `elmo-crosspost-message-alist'.
1518 ;;    2.2. remove crosspost entry for current newsgroup from
1519 ;;         `elmo-crosspost-message-alist'.
1520   (let (cross-deletes reads entity ngs)
1521     (dolist (cross elmo-crosspost-message-alist)
1522       (if number-alist
1523           (when (setq entity (rassoc (nth 0 cross) number-alist))
1524             (setq reads (cons (car entity) reads)))
1525         (when (setq entity (elmo-msgdb-overview-get-entity
1526                             (nth 0 cross)
1527                             (elmo-folder-msgdb folder)))
1528           (setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
1529                             reads))))
1530       (when entity
1531         (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
1532                               (nth 1 cross)))
1533             (setcar (cdr cross) ngs)
1534           (setq cross-deletes (cons cross cross-deletes)))
1535         (setq elmo-crosspost-message-alist-modified t)))
1536     (dolist (dele cross-deletes)
1537       (setq elmo-crosspost-message-alist (delq
1538                                           dele
1539                                           elmo-crosspost-message-alist)))
1540     (elmo-nntp-folder-set-reads-internal folder reads)))
1541
1542 (luna-define-method elmo-folder-list-unreads-internal
1543   ((folder elmo-nntp-folder) unread-marks mark-alist)
1544   ;;    2.3. elmo-folder-list-unreads return unread message list according to
1545   ;;         `reads' slot.
1546   (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist
1547                                     (elmo-folder-msgdb folder)))))
1548     (elmo-living-messages (delq nil
1549                                 (mapcar
1550                                  (lambda (x)
1551                                    (if (member (nth 1 x) unread-marks)
1552                                        (car x)))
1553                                  mark-alist))
1554                           (elmo-nntp-folder-reads-internal folder))))
1555
1556 (require 'product)
1557 (product-provide (provide 'elmo-nntp) (require 'elmo-version))
1558
1559 ;;; elmo-nntp.el ends here