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