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