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