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