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