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