elmo/elmo-net.el

   1 ;;; elmo-net.el --- Network module for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'elmo-util)
  32 (require 'elmo-dop)
  33 (require 'elmo-vars)
  34 (require 'elmo-cache)
  35 (require 'elmo)
  36
  37 ;;; Code:
  38 ;;
  39
  40 (defconst elmo-net-folder-name-syntax '((?@ [server ".+"])
  41                                         (?: [port "^[0-9]+$"])
  42                                         (?! stream-type)))
  43
  44 ;;; ELMO net folder
  45 (eval-and-compile
  46   (luna-define-class elmo-net-folder
  47                      (elmo-folder)
  48                      (user auth server port stream-type))
  49   (luna-define-internal-accessors 'elmo-net-folder))
  50
  51 ;;; Session
  52 (eval-and-compile
  53   (autoload 'starttls-negotiate "starttls")
  54   (autoload 'sasl-find-mechanism "sasl")
  55   (autoload 'sasl-make-client "sasl")
  56   (autoload 'sasl-mechanism-name "sasl")
  57   (autoload 'sasl-next-step "sasl")
  58   (autoload 'sasl-step-data "sasl")
  59   (autoload 'sasl-step-set-data "sasl"))
  60
  61 (defvar sasl-mechanisms)
  62
  63 (defcustom elmo-network-session-idle-timeout nil
  64   "Idle timeout of the network cache. Specified in seconds.
  65 If elapsed time since last access is larger than this value,
  66 cached session is not reused.
  67 If nil, network cache is reused."
  68   :type '(choice number (const nil))
  69   :group 'elmo)
  70
  71 ;;; Code:
  72 ;;
  73 (eval-and-compile
  74   (luna-define-class elmo-network-session () (name
  75                                               server
  76                                               port
  77                                               user
  78                                               auth
  79                                               stream-type
  80                                               process
  81                                               greeting
  82                                               last-accessed))
  83   (luna-define-internal-accessors 'elmo-network-session))
  84
  85 (luna-define-generic elmo-network-initialize-session (session)
  86   "Initialize SESSION (Called before authentication).")
  87
  88 (luna-define-generic elmo-network-initialize-session-buffer (session buffer)
  89   "Initialize SESSION's BUFFER.")
  90
  91 (luna-define-generic elmo-network-authenticate-session (session)
  92   "Authenticate SESSION.")
  93
  94 (luna-define-generic elmo-network-setup-session (session)
  95   "Setup SESSION. (Called after authentication).")
  96
  97 (luna-define-generic elmo-network-close-session (session)
  98   "Close SESSION.")
  99
 100 (luna-define-method
 101   elmo-network-initialize-session-buffer ((session
 102                                            elmo-network-session) buffer)
 103   (with-current-buffer buffer
 104     (set-buffer-multibyte nil)
 105     (buffer-disable-undo (current-buffer))))
 106
 107 (luna-define-method elmo-network-close-session ((session elmo-network-session))
 108   (when (elmo-network-session-process-internal session)
 109 ;;; (memq (process-status (elmo-network-session-process-internal session))
 110 ;;;       '(open run))
 111     (kill-buffer (process-buffer
 112                   (elmo-network-session-process-internal session)))
 113     (delete-process (elmo-network-session-process-internal session))))
 114
 115 (defmacro elmo-network-stream-type-spec-string (stream-type)
 116   (` (nth 0 (, stream-type))))
 117
 118 (defmacro elmo-network-stream-type-symbol (stream-type)
 119   (` (nth 1 (, stream-type))))
 120
 121 (defmacro elmo-network-stream-type-feature (stream-type)
 122   (` (nth 2 (, stream-type))))
 123
 124 (defmacro elmo-network-stream-type-function (stream-type)
 125   (` (nth 3 (, stream-type))))
 126
 127 (defsubst elmo-network-session-password-key (session)
 128   (format "%s:%s/%s@%s:%d"
 129           (upcase
 130            (nth 1 (split-string (symbol-name
 131                                  (luna-class-name session)) "[4-]")))
 132           (elmo-network-session-user-internal session)
 133           (elmo-network-session-auth-internal session)
 134           (elmo-network-session-server-internal session)
 135           (elmo-network-session-port-internal session)))
 136
 137 (defvar elmo-network-session-cache nil)
 138
 139 (defsubst elmo-network-session-cache-key (name folder)
 140   "Returns session cache key for NAME and FOLDER."
 141   (format "%s:%s/%s@%s:%d%s"
 142           name
 143           (elmo-net-folder-user-internal folder)
 144           (elmo-net-folder-auth-internal folder)
 145           (elmo-net-folder-server-internal folder)
 146           (elmo-net-folder-port-internal folder)
 147           (or
 148            (elmo-network-stream-type-spec-string
 149             (elmo-net-folder-stream-type-internal folder)) "")))
 150
 151 (defun elmo-network-clear-session-cache ()
 152   "Clear session cache."
 153   (interactive)
 154   (dolist (pair elmo-network-session-cache)
 155     (elmo-network-close-session (cdr pair)))
 156   (setq elmo-network-session-cache nil))
 157
 158 (defmacro elmo-network-session-buffer (session)
 159   "Get buffer for SESSION."
 160   (` (process-buffer (elmo-network-session-process-internal
 161                       (, session)))))
 162
 163 (defun elmo-network-get-session (class name folder &optional if-exists)
 164   "Get network session from session cache or a new network session.
 165 CLASS is the class name of the session.
 166 NAME is the name of the process.
 167 FOLDER is the ELMO folder structure.
 168 Returns a `elmo-network-session' instance.
 169 If optional argument IF-EXISTS is non-nil, it does not return session
 170 if there is no session cache.
 171 if making session failed, returns nil."
 172   (let (pair session key)
 173     (if (not (elmo-plugged-p
 174               (elmo-net-folder-server-internal folder)
 175               (elmo-net-folder-port-internal folder)
 176               (elmo-network-stream-type-symbol
 177                (elmo-net-folder-stream-type-internal folder))))
 178         (error "Unplugged"))
 179     (setq pair (assoc (setq key (elmo-network-session-cache-key name folder))
 180                       elmo-network-session-cache))
 181     (when (and pair
 182                (or (not (memq (process-status
 183                                (elmo-network-session-process-internal
 184                                 (cdr pair)))
 185                               '(open run)))
 186                    (and elmo-network-session-idle-timeout
 187                         (elmo-network-session-last-accessed-internal
 188                          (cdr pair))
 189                         (elmo-time-expire
 190                          (elmo-network-session-last-accessed-internal
 191                           (cdr pair))
 192                          elmo-network-session-idle-timeout))))
 193       (setq elmo-network-session-cache
 194             (delq pair elmo-network-session-cache))
 195       (elmo-network-close-session (cdr pair))
 196       (setq pair nil))
 197     (if pair
 198         (progn
 199           (elmo-network-session-set-last-accessed-internal
 200            (cdr pair) (current-time))
 201           (cdr pair))                   ; connection cache exists.
 202       (unless if-exists
 203         (setq session
 204               (elmo-network-open-session
 205                class
 206                name
 207                (elmo-net-folder-server-internal folder)
 208                (elmo-net-folder-port-internal folder)
 209                (elmo-net-folder-user-internal folder)
 210                (elmo-net-folder-auth-internal folder)
 211                (elmo-net-folder-stream-type-internal folder)))
 212         (setq elmo-network-session-cache
 213               (cons (cons key session)
 214                     elmo-network-session-cache))
 215         session))))
 216
 217 (defun elmo-network-open-session (class name server port user auth
 218                                         stream-type)
 219   "Open an authenticated network session.
 220 CLASS is the class name of the session.
 221 NAME is the name of the process.
 222 SERVER is the name of the server server.
 223 PORT is the port number of the service.
 224 USER is the user-id for the authenticate.
 225 AUTH is the authenticate method name (symbol).
 226 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 227 Returns a process object.  if making session failed, returns nil."
 228   (let ((session
 229          (luna-make-entity class
 230                            :name name
 231                            :server server
 232                            :port port
 233                            :user user
 234                            :auth auth
 235                            :stream-type stream-type
 236                            :process nil
 237                            :greeting nil
 238                            :last-accessed (current-time)
 239                            ))
 240         (buffer (format " *%s session for %s@%s:%d%s"
 241                         name
 242                         user
 243                         server
 244                         port
 245                         (or (elmo-network-stream-type-spec-string stream-type)
 246                             "")))
 247         process)
 248     (condition-case error
 249         (progn
 250           (if (get-buffer buffer) (kill-buffer buffer))
 251           (setq buffer (get-buffer-create buffer))
 252           (elmo-network-initialize-session-buffer session buffer)
 253           (elmo-network-session-set-process-internal
 254            session
 255            (setq process (elmo-open-network-stream
 256                           (elmo-network-session-name-internal session)
 257                           buffer server port stream-type)))
 258           (when process
 259             (elmo-network-initialize-session session)
 260             (elmo-network-authenticate-session session)
 261             (elmo-network-setup-session session)))
 262       (error
 263        (when (eq (car error) 'elmo-open-error)
 264          (elmo-set-plugged nil server port
 265                            (elmo-network-stream-type-symbol stream-type)
 266                            (current-time))
 267          (message "Auto plugged off at %s:%d :%s" server port (cadr error))
 268          (sit-for 1))
 269        (when (eq (car error) 'elmo-authenticate-error)
 270          (elmo-remove-passwd (elmo-network-session-password-key session)))
 271        (elmo-network-close-session session)
 272        (signal (car error)(cdr error))))
 273     session))
 274
 275 (defun elmo-open-network-stream (name buffer server service stream-type)
 276   (let ((auto-plugged (and elmo-auto-change-plugged
 277                            (> elmo-auto-change-plugged 0)))
 278         process)
 279     (if (and stream-type
 280              (elmo-network-stream-type-feature stream-type))
 281         (require (elmo-network-stream-type-feature stream-type)))
 282     (condition-case err
 283         (let (process-connection-type)
 284           (as-binary-process
 285            (setq process
 286                  (if stream-type
 287                      (funcall (elmo-network-stream-type-function stream-type)
 288                               name buffer server service)
 289                    (open-network-stream name buffer server service)))))
 290       (error
 291        (when auto-plugged
 292          (elmo-set-plugged nil server service
 293                            (elmo-network-stream-type-symbol stream-type)
 294                            (current-time))
 295          (message "Auto plugged off at %s:%d" server service)
 296          (sit-for 1))
 297        (signal (car err) (cdr err))))
 298     (when process
 299       (process-kill-without-query process)
 300       (when auto-plugged
 301         (elmo-set-plugged t server service
 302                           (elmo-network-stream-type-symbol stream-type)))
 303       process)))
 304
 305 (defun elmo-get-network-stream-type (symbol)
 306   "Return network stream type corresponding to SYMBOL.
 307 Returned value is searched from `elmo-network-stream-type-alist'."
 308   (let ((alist elmo-network-stream-type-alist)
 309         spec)
 310     (while alist
 311       (when (eq (nth 1 (car alist)) symbol)
 312         (setq spec (car alist))
 313         (setq alist nil))
 314       (setq alist (cdr alist)))
 315     spec))
 316
 317 (defun elmo-net-folder-set-parameters (folder tokens &optional defaults)
 318   (let ((port (cdr (assq 'port tokens)))
 319         (stream-type (cdr (assq 'stream-type tokens))))
 320     ;; server
 321     (elmo-net-folder-set-server-internal
 322      folder
 323      (or (cdr (assq 'server tokens))
 324          (plist-get defaults :server)))
 325     ;; port
 326     (elmo-net-folder-set-port-internal
 327      folder
 328      (or (and port (string-to-int port))
 329          (plist-get defaults :port)))
 330     ;; stream-type
 331     (elmo-net-folder-set-stream-type-internal
 332      folder
 333      (or (and stream-type (assoc (concat "!" stream-type)
 334                                  elmo-network-stream-type-alist))
 335          (plist-get defaults :stream-type)))))
 336
 337 (luna-define-method elmo-folder-initialize ((folder elmo-net-folder) name)
 338   ;; user and auth should be set in subclass.
 339   (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
 340     (elmo-net-folder-set-parameters
 341      folder
 342      (car (elmo-parse-separated-tokens
 343            (substring name (match-beginning 0))
 344            elmo-net-folder-name-syntax))))
 345   folder)
 346
 347 (luna-define-method elmo-net-port-info ((folder elmo-net-folder))
 348   (list (elmo-net-folder-server-internal folder)
 349         (elmo-net-folder-port-internal folder)
 350         (elmo-network-stream-type-symbol
 351          (elmo-net-folder-stream-type-internal folder))))
 352
 353 (defun elmo-net-port-label (folder)
 354   (concat
 355    (symbol-name (elmo-folder-type-internal folder))
 356    (if (elmo-net-folder-stream-type-internal folder)
 357        (concat "!" (symbol-name
 358                     (elmo-network-stream-type-symbol
 359                      (elmo-net-folder-stream-type-internal
 360                       folder)))))))
 361
 362 (luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder))
 363   (apply 'elmo-plugged-p
 364          (append (elmo-net-port-info folder)
 365                  (list nil (quote (elmo-net-port-label folder))))))
 366
 367 (luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
 368                                              plugged &optional add)
 369   (apply 'elmo-set-plugged plugged
 370          (append (elmo-net-port-info folder)
 371                  (list nil nil (quote (elmo-net-port-label folder)) add))))
 372
 373 (luna-define-method elmo-folder-create ((folder elmo-net-folder))
 374   (if (elmo-folder-plugged-p folder)
 375       (elmo-folder-send folder 'elmo-folder-create-plugged)
 376     (elmo-folder-send folder 'elmo-folder-create-unplugged)))
 377
 378 (luna-define-method elmo-folder-create-unplugged ((folder elmo-net-folder))
 379   (if elmo-enable-disconnected-operation
 380       (elmo-folder-create-dop folder)
 381     (error "Unplugged")))
 382
 383 (luna-define-method elmo-folder-exists-p ((folder elmo-net-folder))
 384   (if (elmo-folder-plugged-p folder)
 385       (elmo-folder-send folder 'elmo-folder-exists-p-plugged)
 386     ;; If unplugged, guess by msgdb.
 387     (file-directory-p (elmo-folder-msgdb-path folder))))
 388
 389 (luna-define-method elmo-folder-status ((folder elmo-net-folder))
 390   (if (elmo-folder-plugged-p folder)
 391       (elmo-folder-send folder 'elmo-folder-status-plugged)
 392     (elmo-folder-send folder 'elmo-folder-status-unplugged)))
 393
 394 (luna-define-method elmo-folder-status-unplugged
 395   ((folder elmo-net-folder))
 396   (if elmo-enable-disconnected-operation
 397       (elmo-folder-status-dop folder)
 398     (error "Unplugged")))
 399
 400 (luna-define-method elmo-folder-next-message-number ((folder elmo-net-folder))
 401   (if (elmo-folder-plugged-p folder)
 402       (elmo-folder-send folder 'elmo-folder-next-message-number-plugged)
 403     (elmo-folder-send folder 'elmo-folder-next-message-number-unplugged)))
 404
 405 (luna-define-method elmo-folder-next-message-number-unplugged
 406   ((folder elmo-net-folder))
 407   (if elmo-enable-disconnected-operation
 408       (elmo-folder-next-message-number-dop folder)
 409     (error "Unplugged")))
 410
 411 (luna-define-method elmo-folder-list-messages-internal
 412   ((folder elmo-net-folder) &optional nohide)
 413   (elmo-net-folder-list-messages-internal folder nohide))
 414
 415 (defun elmo-net-folder-list-messages-internal (folder nohide)
 416   (if (elmo-folder-plugged-p folder)
 417       (elmo-folder-send folder 'elmo-folder-list-messages-plugged nohide)
 418     (elmo-folder-send folder 'elmo-folder-list-messages-unplugged)))
 419
 420 (luna-define-method elmo-folder-list-messages-plugged
 421   ((folder elmo-net-folder))
 422   nil)
 423
 424 ;; Should consider offline append and removal.
 425 (luna-define-method elmo-folder-list-messages-unplugged ((folder
 426                                                           elmo-net-folder))
 427   (if elmo-enable-disconnected-operation
 428       (let ((deleting (elmo-dop-list-deleting-messages folder)))
 429         (nconc
 430          ;; delete deleting messages
 431          (elmo-delete-if
 432           (lambda (number) (memq number deleting))
 433           ;; current number-list.
 434           (elmo-folder-list-messages folder nil 'in-msgdb))
 435          ;; append appending messages
 436          (mapcar (lambda (x) (* -1 x))
 437                  (elmo-dop-spool-folder-list-messages folder))))
 438     t))
 439
 440 (luna-define-method elmo-folder-list-flagged-internal ((folder elmo-net-folder)
 441                                                        flag)
 442   (if (and (elmo-folder-plugged-p folder)
 443            (elmo-folder-use-flag-p folder))
 444       (elmo-folder-send folder 'elmo-folder-list-flagged-plugged flag)
 445     ;; Should consider offline append and removal?
 446     t))
 447
 448 (luna-define-method elmo-folder-list-flagged-plugged ((folder elmo-net-folder)
 449                                                       flag)
 450   t)
 451
 452 (luna-define-method elmo-folder-delete-messages-internal ((folder
 453                                                            elmo-net-folder)
 454                                                           numbers)
 455    (if (elmo-folder-plugged-p folder)
 456        (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers)
 457      (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers)))
 458
 459 (luna-define-method elmo-folder-delete-messages-unplugged ((folder
 460                                                             elmo-net-folder)
 461                                                            numbers)
 462   (elmo-folder-delete-messages-dop folder numbers))
 463
 464 (luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder)
 465                                               numbers flag-table)
 466   (if (elmo-folder-plugged-p folder)
 467       (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged
 468                         numbers flag-table)
 469     (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged
 470                       numbers flag-table)))
 471
 472 (luna-define-method elmo-folder-msgdb-create-unplugged ((folder
 473                                                          elmo-net-folder)
 474                                                         numbers
 475                                                         flag-table)
 476   ;; XXXX should be appended to already existing msgdb.
 477   (elmo-dop-msgdb
 478    (elmo-folder-msgdb-create (elmo-dop-spool-folder folder)
 479                              (mapcar 'abs numbers)
 480                              flag-table)))
 481
 482 (luna-define-method elmo-folder-set-flag :before ((folder elmo-net-folder)
 483                                                   numbers
 484                                                   flag
 485                                                   &optional is-local)
 486   (when (and (not is-local)
 487              (elmo-folder-use-flag-p folder))
 488     (elmo-folder-send folder
 489                       (if (elmo-folder-plugged-p folder)
 490                           'elmo-folder-set-flag-plugged
 491                         'elmo-folder-set-flag-unplugged)
 492                       numbers
 493                       flag)))
 494
 495 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-net-folder)
 496                                                     numbers
 497                                                     flag
 498                                                     &optional is-local)
 499   (when (and (not is-local)
 500              (elmo-folder-use-flag-p folder))
 501     (elmo-folder-send folder
 502                       (if (elmo-folder-plugged-p folder)
 503                           'elmo-folder-unset-flag-plugged
 504                         'elmo-folder-unset-flag-unplugged)
 505                       numbers
 506                       flag)))
 507
 508 (luna-define-method elmo-folder-set-flag-unplugged ((folder elmo-net-folder)
 509                                                     numbers flag)
 510   (elmo-folder-set-flag-dop folder numbers flag))
 511
 512 (luna-define-method elmo-folder-unset-flag-unplugged ((folder elmo-net-folder)
 513                                                       numbers flag)
 514   (elmo-folder-unset-flag-dop folder numbers flag))
 515
 516 (luna-define-method elmo-message-encache :around ((folder elmo-net-folder)
 517                                                   number &optional read)
 518   (if (elmo-folder-plugged-p folder)
 519       (luna-call-next-method)
 520     (if elmo-enable-disconnected-operation
 521         (elmo-message-encache-dop folder number read)
 522       (error "Unplugged"))))
 523
 524 (luna-define-generic elmo-message-fetch-plugged (folder number strategy
 525                                                         &optional
 526                                                         section
 527                                                         outbuf
 528                                                         unseen)
 529   "")
 530
 531 (luna-define-generic elmo-message-fetch-unplugged (folder number strategy
 532                                                           &optional
 533                                                           section
 534                                                           outbuf
 535                                                           unseen)
 536   "")
 537
 538 (luna-define-method elmo-message-fetch-internal ((folder elmo-net-folder)
 539                                                  number strategy
 540                                                  &optional section unseen)
 541   (if (elmo-folder-plugged-p folder)
 542       (elmo-message-fetch-plugged folder number
 543                                   strategy section
 544                                   (current-buffer) unseen)
 545     (elmo-message-fetch-unplugged folder number
 546                                   strategy section
 547                                   (current-buffer) unseen)))
 548
 549 (luna-define-method elmo-message-fetch-unplugged
 550   ((folder elmo-net-folder) number strategy  &optional section outbuf unseen)
 551   (if (and elmo-enable-disconnected-operation
 552            (< number 0))
 553       (elmo-message-fetch-internal
 554        (elmo-dop-spool-folder folder) (abs number) strategy
 555        section unseen)
 556     (error "Unplugged")))
 557
 558 (luna-define-method elmo-folder-check ((folder elmo-net-folder))
 559   (if (elmo-folder-plugged-p folder)
 560       (elmo-folder-send folder 'elmo-folder-check-plugged)))
 561
 562 (luna-define-method elmo-folder-close :after ((folder elmo-net-folder))
 563   (if (elmo-folder-plugged-p folder)
 564       (elmo-folder-send folder 'elmo-folder-check-plugged)))
 565
 566 (luna-define-method elmo-folder-diff :around ((folder elmo-net-folder))
 567   (if (and (elmo-folder-use-flag-p folder)
 568            (elmo-folder-plugged-p folder))
 569       (elmo-folder-send folder 'elmo-folder-diff-plugged)
 570     (luna-call-next-method)))
 571
 572 (luna-define-method elmo-folder-local-p ((folder elmo-net-folder))
 573   nil)
 574
 575 (luna-define-method elmo-quit ((folder elmo-net-folder))
 576   (elmo-network-clear-session-cache))
 577
 578 (require 'product)
 579 (product-provide (provide 'elmo-net) (require 'elmo-version))
 580
 581 ;;; elmo-net.el ends here