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