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