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)
  35
  36 ;;; Code:
  37 ;;
  38
  39 ;;; ELMO net folder
  40 (eval-and-compile
  41   (luna-define-class elmo-net-folder
  42                      (elmo-folder)
  43                      (user auth server port stream-type))
  44   (luna-define-internal-accessors 'elmo-net-folder))
  45
  46 ;;; Session
  47 (eval-and-compile
  48   (autoload 'starttls-negotiate "starttls")
  49   (autoload 'sasl-find-mechanism "sasl")
  50   (autoload 'sasl-make-client "sasl")
  51   (autoload 'sasl-mechanism-name "sasl")
  52   (autoload 'sasl-next-step "sasl")
  53   (autoload 'sasl-step-data "sasl")
  54   (autoload 'sasl-step-set-data "sasl"))
  55
  56 (defvar sasl-mechanisms)
  57
  58 ;;; Code:
  59 ;;
  60 (eval-and-compile
  61   (luna-define-class elmo-network-session () (name
  62                                               server
  63                                               port
  64                                               user
  65                                               auth
  66                                               stream-type
  67                                               process
  68                                               greeting))
  69   (luna-define-internal-accessors 'elmo-network-session))
  70
  71 (luna-define-generic elmo-network-initialize-session (session)
  72   "Initialize SESSION (Called before authentication).")
  73
  74 (luna-define-generic elmo-network-initialize-session-buffer (session buffer)
  75   "Initialize SESSION's BUFFER.")
  76
  77 (luna-define-generic elmo-network-authenticate-session (session)
  78   "Authenticate SESSION.")
  79
  80 (luna-define-generic elmo-network-setup-session (session)
  81   "Setup SESSION. (Called after authentication).")
  82
  83 (luna-define-generic elmo-network-close-session (session)
  84   "Close SESSION.")
  85
  86 (luna-define-method
  87   elmo-network-initialize-session-buffer ((session
  88                                            elmo-network-session) buffer)
  89   (with-current-buffer buffer
  90     (elmo-set-buffer-multibyte nil)
  91     (buffer-disable-undo (current-buffer))))
  92
  93 (luna-define-method elmo-network-close-session ((session elmo-network-session))
  94   (when (elmo-network-session-process-internal session)
  95 ;;; (memq (process-status (elmo-network-session-process-internal session))
  96 ;;;       '(open run))
  97     (kill-buffer (process-buffer
  98                   (elmo-network-session-process-internal session)))
  99     (delete-process (elmo-network-session-process-internal session))))
 100
 101 (defmacro elmo-network-stream-type-spec-string (stream-type)
 102   (` (nth 0 (, stream-type))))
 103
 104 (defmacro elmo-network-stream-type-symbol (stream-type)
 105   (` (nth 1 (, stream-type))))
 106
 107 (defmacro elmo-network-stream-type-feature (stream-type)
 108   (` (nth 2 (, stream-type))))
 109
 110 (defmacro elmo-network-stream-type-function (stream-type)
 111   (` (nth 3 (, stream-type))))
 112
 113 (defsubst elmo-network-session-password-key (session)
 114   (format "%s:%s/%s@%s:%d"
 115           (elmo-network-session-name-internal session)
 116           (elmo-network-session-user-internal session)
 117           (elmo-network-session-auth-internal session)
 118           (elmo-network-session-server-internal session)
 119           (elmo-network-session-port-internal session)))
 120
 121 (defvar elmo-network-session-cache nil)
 122 (defvar elmo-network-session-name-prefix nil)
 123
 124 (defsubst elmo-network-session-cache-key (name folder)
 125   "Returns session cache key for NAME and FOLDER."
 126   (format "%s:%s/%s@%s:%d%s"
 127           (concat elmo-network-session-name-prefix name)
 128           (elmo-net-folder-user-internal folder)
 129           (elmo-net-folder-auth-internal folder)
 130           (elmo-net-folder-server-internal folder)
 131           (elmo-net-folder-port-internal folder)
 132           (or
 133            (elmo-network-stream-type-spec-string
 134             (elmo-net-folder-stream-type-internal folder)) "")))
 135
 136 (defun elmo-network-clear-session-cache ()
 137   "Clear session cache."
 138   (interactive)
 139   (dolist (pair elmo-network-session-cache)
 140     (elmo-network-close-session (cdr pair)))
 141   (setq elmo-network-session-cache nil))
 142
 143 (defmacro elmo-network-session-buffer (session)
 144   "Get buffer for SESSION."
 145   (` (process-buffer (elmo-network-session-process-internal
 146                       (, session)))))
 147
 148 (defun elmo-network-get-session (class name folder &optional if-exists)
 149   "Get network session from session cache or a new network session.
 150 CLASS is the class name of the session.
 151 NAME is the name of the process.
 152 FOLDER is the ELMO folder structure.
 153 Returns a `elmo-network-session' instance.
 154 If optional argument IF-EXISTS is non-nil, it does not return session
 155 if there is no session cache.
 156 if making session failed, returns nil."
 157   (let (pair session key)
 158     (if (not (elmo-plugged-p
 159               (elmo-net-folder-server-internal folder)
 160               (elmo-net-folder-port-internal folder)))
 161         (error "Unplugged"))
 162     (setq pair (assoc (setq key (elmo-network-session-cache-key name folder))
 163                       elmo-network-session-cache))
 164     (when (and pair
 165                (not (memq (process-status
 166                            (elmo-network-session-process-internal
 167                             (cdr pair)))
 168                           '(open run))))
 169       (setq elmo-network-session-cache
 170             (delq pair elmo-network-session-cache))
 171       (elmo-network-close-session (cdr pair))
 172       (setq pair nil))
 173     (if pair
 174         (cdr pair)                      ; connection cache exists.
 175       (unless if-exists
 176         (setq session
 177               (elmo-network-open-session
 178                class
 179                name
 180                (elmo-net-folder-server-internal folder)
 181                (elmo-net-folder-port-internal folder)
 182                (elmo-net-folder-user-internal folder)
 183                (elmo-net-folder-auth-internal folder)
 184                (elmo-net-folder-stream-type-internal folder)))
 185         (setq elmo-network-session-cache
 186               (cons (cons key session)
 187                     elmo-network-session-cache))
 188         session))))
 189
 190 (defun elmo-network-open-session (class name server port user auth
 191                                         stream-type)
 192   "Open an authenticated network session.
 193 CLASS is the class name of the session.
 194 NAME is the name of the process.
 195 SERVER is the name of the server server.
 196 PORT is the port number of the service.
 197 USER is the user-id for the authenticate.
 198 AUTH is the authenticate method name (symbol).
 199 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 200 Returns a process object.  if making session failed, returns nil."
 201   (let ((session
 202          (luna-make-entity class
 203                            :name name
 204                            :server server
 205                            :port port
 206                            :user user
 207                            :auth auth
 208                            :stream-type stream-type
 209                            :process nil
 210                            :greeting nil))
 211         (buffer (format " *%s session for %s@%s:%d%s"
 212                         (concat elmo-network-session-name-prefix name)
 213                         user
 214                         server
 215                         port
 216                         (or (elmo-network-stream-type-spec-string stream-type)
 217                             "")))
 218         process)
 219     (condition-case error
 220         (progn
 221           (if (get-buffer buffer) (kill-buffer buffer))
 222           (setq buffer (get-buffer-create buffer))
 223           (elmo-network-initialize-session-buffer session buffer)
 224           (elmo-network-session-set-process-internal
 225            session
 226            (setq process (elmo-open-network-stream
 227                           (elmo-network-session-name-internal session)
 228                           buffer server port stream-type)))
 229           (when process
 230             (elmo-network-initialize-session session)
 231             (elmo-network-authenticate-session session)
 232             (elmo-network-setup-session session)))
 233       (error
 234        (when (eq (car error) 'elmo-authenticate-error)
 235          (elmo-remove-passwd (elmo-network-session-password-key session)))
 236        (elmo-network-close-session session)
 237        (signal (car error)(cdr error))))
 238     session))
 239
 240 (defun elmo-open-network-stream (name buffer server service stream-type)
 241   (let ((auto-plugged (and elmo-auto-change-plugged
 242                            (> elmo-auto-change-plugged 0)))
 243         process)
 244     (if (and stream-type
 245              (elmo-network-stream-type-feature stream-type))
 246         (require (elmo-network-stream-type-feature stream-type)))
 247     (condition-case err
 248         (let (process-connection-type)
 249           (as-binary-process
 250            (setq process
 251                  (if stream-type
 252                      (funcall (elmo-network-stream-type-function stream-type)
 253                               name buffer server service)
 254                    (open-network-stream name buffer server service)))))
 255       (error
 256        (when auto-plugged
 257          (elmo-set-plugged nil server service stream-type (current-time))
 258          (message "Auto plugged off at %s:%d" server service)
 259          (sit-for 1))
 260        (signal (car err) (cdr err))))
 261     (when process
 262       (process-kill-without-query process)
 263       (when auto-plugged
 264         (elmo-set-plugged t server service stream-type))
 265       process)))
 266
 267 (luna-define-method elmo-folder-initialize ((folder
 268                                              elmo-net-folder)
 269                                             name)
 270   ;; user and auth should be set in subclass.
 271   (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
 272     (if (match-beginning 1)
 273         (elmo-net-folder-set-server-internal
 274          folder
 275          (elmo-match-substring 1 name 1)))
 276     (if (match-beginning 2)
 277         (elmo-net-folder-set-port-internal
 278          folder
 279          (string-to-int (elmo-match-substring 2 name 1))))
 280     (if (match-beginning 3)
 281         (elmo-net-folder-set-stream-type-internal
 282          folder
 283          (assoc (elmo-match-string 3 name)
 284                 elmo-network-stream-type-alist)))
 285     (substring name 0 (match-beginning 0))))
 286
 287 (defun elmo-net-port-info (folder)
 288   (list (elmo-net-folder-server-internal folder)
 289         (elmo-net-folder-port-internal folder)
 290         (elmo-network-stream-type-symbol
 291          (elmo-net-folder-stream-type-internal folder))))
 292
 293 (defun elmo-net-port-label (folder)
 294   (concat
 295    (symbol-name (elmo-folder-type-internal folder))
 296    (if (elmo-net-folder-stream-type-internal folder)
 297        (concat "!" (symbol-name
 298                     (elmo-network-stream-type-symbol
 299                      (elmo-net-folder-stream-type-internal
 300                       folder)))))))
 301
 302 (luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder))
 303   (apply 'elmo-plugged-p
 304          (append (elmo-net-port-info folder)
 305                  (list nil (quote (elmo-net-port-label folder))))))
 306
 307 (luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
 308                                              plugged &optional add)
 309   (apply 'elmo-set-plugged plugged
 310          (append (elmo-net-port-info folder)
 311                  (list nil nil (quote (elmo-net-port-label folder)) add))))
 312
 313 (luna-define-method elmo-folder-exists-p ((folder elmo-net-folder))
 314   (if (elmo-folder-plugged-p folder)
 315       (elmo-folder-send folder 'elmo-folder-exists-p-plugged)
 316     t)) ; If unplugged, assume the folder exists.
 317
 318 (luna-define-method elmo-folder-status ((folder elmo-net-folder))
 319   (if (elmo-folder-plugged-p folder)
 320       (elmo-folder-send folder 'elmo-folder-status-plugged)
 321     (elmo-folder-send folder 'elmo-folder-status-unplugged)))
 322
 323 (luna-define-method elmo-folder-status-unplugged
 324   ((folder elmo-net-folder))
 325   (if elmo-enable-disconnected-operation
 326       (progn
 327         (elmo-dop-folder-status folder))
 328     (error "Unplugged")))
 329
 330 (luna-define-method elmo-folder-list-messages-internal
 331   ((folder elmo-net-folder))
 332   (elmo-net-folder-list-messages-internal folder))
 333
 334 (defun elmo-net-folder-list-messages-internal (folder)
 335   (if (elmo-folder-plugged-p folder)
 336       (elmo-folder-send folder 'elmo-folder-list-messages-plugged)
 337     (elmo-folder-send folder 'elmo-folder-list-messages-unplugged)))
 338
 339 (luna-define-method elmo-folder-list-messages-plugged
 340   ((folder elmo-net-folder))
 341   t)
 342
 343 ;; XXX
 344 ;; Should consider offline append and removal.
 345 (luna-define-method elmo-folder-list-messages-unplugged
 346   ((folder elmo-net-folder))
 347   (if elmo-enable-disconnected-operation
 348       t
 349     (error "Unplugged")))
 350
 351 (luna-define-method elmo-folder-list-unreads-internal
 352   ((folder elmo-net-folder) unread-marks &optional mark-alist)
 353   (if (and (elmo-folder-plugged-p folder)
 354            (elmo-folder-use-flag-p folder))
 355       (elmo-folder-send folder 'elmo-folder-list-unreads-plugged)
 356     t))
 357
 358 (luna-define-method elmo-folder-list-importants-internal
 359   ((folder elmo-net-folder) important-mark)
 360   (if (and (elmo-folder-plugged-p folder)
 361            (elmo-folder-use-flag-p folder))
 362       (elmo-folder-send folder 'elmo-folder-list-importants-plugged)
 363     t))
 364
 365 (luna-define-method elmo-folder-list-unreads-plugged
 366   ((folder elmo-net-folder))
 367   t)
 368
 369 (luna-define-method elmo-folder-list-importants-plugged
 370   ((folder elmo-net-folder))
 371   t)
 372
 373 (luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder)
 374                                                  numbers)
 375   (if (elmo-folder-plugged-p folder)
 376       (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers)
 377     (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers)))
 378
 379 (luna-define-method elmo-folder-unmark-important ((folder elmo-net-folder)
 380                                                   numbers)
 381   (if (elmo-folder-use-flag-p folder)
 382       (if (elmo-folder-plugged-p folder)
 383           (elmo-folder-send folder 'elmo-folder-unmark-important-plugged
 384                             numbers)
 385         (elmo-folder-send folder
 386                           'elmo-folder-unmark-important-unplugged numbers))
 387     t))
 388
 389 (luna-define-method elmo-folder-mark-as-important ((folder elmo-net-folder)
 390                                                    numbers)
 391   (if (elmo-folder-use-flag-p folder)
 392       (if (elmo-folder-plugged-p folder)
 393           (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged
 394                             numbers)
 395         (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged
 396                           numbers))
 397     t))
 398
 399 (luna-define-method elmo-folder-unmark-read ((folder elmo-net-folder)
 400                                              numbers)
 401   (if (elmo-folder-use-flag-p folder)
 402       (if (elmo-folder-plugged-p folder)
 403           (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers)
 404         (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers))
 405     t))
 406
 407 (luna-define-method elmo-folder-mark-as-read ((folder elmo-net-folder)
 408                                               numbers)
 409   (if (elmo-folder-use-flag-p folder)
 410       (if (elmo-folder-plugged-p folder)
 411           (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers)
 412         (elmo-folder-send
 413          folder 'elmo-folder-mark-as-read-unplugged numbers))
 414     t))
 415
 416 (luna-define-method elmo-message-fetch ((folder elmo-net-folder)
 417                                         number strategy
 418                                         &optional section
 419                                         outbuf
 420                                         unseen)
 421   (if (elmo-folder-plugged-p folder)
 422       (let ((cache-file (elmo-file-cache-expand-path
 423                          (elmo-fetch-strategy-cache-path strategy)
 424                          section)))
 425         (if (and (elmo-fetch-strategy-use-cache strategy)
 426                  (file-exists-p cache-file))
 427             (if outbuf
 428                 (with-current-buffer outbuf
 429                   (insert-file-contents-as-binary cache-file)
 430                   t)
 431               (with-temp-buffer
 432                 (insert-file-contents-as-binary cache-file)
 433                 (buffer-string)))
 434           (if outbuf
 435               (with-current-buffer outbuf
 436                 (elmo-folder-send folder 'elmo-message-fetch-plugged
 437                                   number strategy section
 438                                   (current-buffer) unseen)
 439                 (elmo-delete-cr-buffer)
 440                 (when (and (> (buffer-size) 0)
 441                            (elmo-fetch-strategy-save-cache strategy))
 442                   (elmo-file-cache-save
 443                    (elmo-fetch-strategy-cache-path strategy)
 444                    section))
 445                 t)
 446             (with-temp-buffer
 447               (elmo-folder-send folder 'elmo-message-fetch-plugged
 448                                 number strategy section
 449                                 (current-buffer) unseen)
 450               (elmo-delete-cr-buffer)
 451               (when (and (> (buffer-size) 0)
 452                          (elmo-fetch-strategy-save-cache strategy))
 453                 (elmo-file-cache-save
 454                  (elmo-fetch-strategy-cache-path strategy)
 455                  section))
 456               (buffer-string)))))
 457     (elmo-folder-send folder 'elmo-message-fetch-unplugged
 458                       number strategy section outbuf unseen)))
 459
 460 (luna-define-method elmo-message-fetch-unplugged
 461   ((folder elmo-net-folder) number strategy  &optional section outbuf unseen)
 462   (if (elmo-fetch-strategy-use-cache strategy)
 463       (if outbuf
 464           (with-current-buffer outbuf
 465             (insert-file-contents-as-binary
 466              (elmo-file-cache-expand-path
 467               (elmo-fetch-strategy-cache-path strategy)
 468               section))
 469             t)
 470         (with-temp-buffer
 471           (insert-file-contents-as-binary
 472            (elmo-file-cache-expand-path
 473             (elmo-fetch-strategy-cache-path strategy)
 474             section))
 475           (buffer-string)))
 476     (error "Unplugged")))
 477
 478 (luna-define-method elmo-folder-check ((folder elmo-net-folder))
 479   (if (elmo-folder-plugged-p folder)
 480       (elmo-folder-send folder 'elmo-folder-check-plugged)))
 481
 482 (luna-define-method elmo-folder-close :after ((folder elmo-net-folder))
 483   (if (elmo-folder-plugged-p folder)
 484       (elmo-folder-send folder 'elmo-folder-check-plugged)))
 485
 486 (luna-define-method elmo-folder-diff :around ((folder elmo-net-folder)
 487                                               &optional numbers)
 488   (if (and (elmo-folder-use-flag-p folder)
 489            (elmo-folder-plugged-p folder))
 490       (elmo-folder-send folder 'elmo-folder-diff-plugged)
 491     (luna-call-next-method)))
 492
 493 (luna-define-method elmo-folder-local-p ((folder elmo-net-folder))
 494   nil)
 495
 496 (luna-define-method elmo-quit ((folder elmo-net-folder))
 497   (elmo-network-clear-session-cache))
 498
 499 (require 'product)
 500 (product-provide (provide 'elmo-net) (require 'elmo-version))
 501
 502 ;;; elmo-net.el ends here