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 (require 'luna)
  30 (require 'elmo-util)
  31 (require 'elmo-vars)
  32
  33 (eval-and-compile
  34   (autoload 'starttls-negotiate "starttls")
  35   (autoload 'sasl-find-mechanism "sasl")
  36   (autoload 'sasl-make-client "sasl")
  37   (autoload 'sasl-mechanism-name "sasl")
  38   (autoload 'sasl-next-step "sasl")
  39   (autoload 'sasl-step-data "sasl")
  40   (autoload 'sasl-step-set-data "sasl"))
  41
  42 (defvar sasl-mechanisms)
  43
  44 ;;; Code:
  45 ;;
  46 (eval-and-compile
  47   (luna-define-class elmo-network-session () (name
  48                                               host
  49                                               port
  50                                               user
  51                                               auth
  52                                               stream-type
  53                                               process
  54                                               greeting))
  55   (luna-define-internal-accessors 'elmo-network-session))
  56
  57 (luna-define-generic elmo-network-initialize-session (session)
  58   "Initialize SESSION (Called before authentication).")
  59
  60 (luna-define-generic elmo-network-initialize-session-buffer (session buffer)
  61   "Initialize SESSION's BUFFER.")
  62
  63 (luna-define-generic elmo-network-authenticate-session (session)
  64   "Authenticate SESSION.")
  65
  66 (luna-define-generic elmo-network-setup-session (session)
  67   "Setup SESSION. (Called after authentication).")
  68
  69 (luna-define-generic elmo-network-close-session (session)
  70   "Close SESSION.")
  71
  72 (luna-define-method
  73   elmo-network-initialize-session-buffer ((session
  74                                            elmo-network-session) buffer)
  75   (with-current-buffer buffer
  76     (elmo-set-buffer-multibyte nil)
  77     (buffer-disable-undo (current-buffer))))
  78
  79 (luna-define-method elmo-network-close-session ((session elmo-network-session))
  80   (when (elmo-network-session-process-internal session)
  81 ;;; (memq (process-status (elmo-network-session-process-internal session))
  82 ;;;       '(open run))
  83     (kill-buffer (process-buffer
  84                   (elmo-network-session-process-internal session)))
  85     (delete-process (elmo-network-session-process-internal session))))
  86
  87 (defmacro elmo-network-stream-type-spec-string (stream-type)
  88   (` (nth 0 (, stream-type))))
  89
  90 (defmacro elmo-network-stream-type-symbol (stream-type)
  91   (` (nth 1 (, stream-type))))
  92
  93 (defmacro elmo-network-stream-type-feature (stream-type)
  94   (` (nth 2 (, stream-type))))
  95
  96 (defmacro elmo-network-stream-type-function (stream-type)
  97   (` (nth 3 (, stream-type))))
  98
  99 (defsubst elmo-network-session-password-key (session)
 100   (format "%s:%s/%s@%s:%d"
 101           (elmo-network-session-name-internal session)
 102           (elmo-network-session-user-internal session)
 103           (elmo-network-session-auth-internal session)
 104           (elmo-network-session-host-internal session)
 105           (elmo-network-session-port-internal session)))
 106
 107 (defvar elmo-network-session-cache nil)
 108 (defvar elmo-network-session-name-prefix nil)
 109
 110 (defsubst elmo-network-session-cache-key (name host port user auth stream-type)
 111   "Returns session cache key."
 112   (format "%s:%s/%s@%s:%d%s"
 113           (concat elmo-network-session-name-prefix name)
 114           user auth host port (or stream-type "")))
 115
 116 (defun elmo-network-clear-session-cache ()
 117   "Clear session cache."
 118   (interactive)
 119   (mapcar (lambda (pair)
 120             (elmo-network-close-session (cdr pair)))
 121           elmo-network-session-cache)
 122   (setq elmo-network-session-cache nil))
 123
 124 (defmacro elmo-network-session-buffer (session)
 125   "Get buffer for SESSION."
 126   (` (process-buffer (elmo-network-session-process-internal
 127                       (, session)))))
 128
 129 (defun elmo-network-get-session (class name host port user auth stream-type
 130                                        &optional if-exists)
 131   "Get network session from session cache or a new network session.
 132 CLASS is the class name of the session.
 133 NAME is the name of the process.
 134 HOST is the name of the server host.
 135 PORT is the port number of the service.
 136 USER is the user-id for the authenticate.
 137 AUTH is the authenticate method name (symbol).
 138 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 139 Returns a `elmo-network-session' instance.
 140 If optional argument IF-EXISTS is non-nil, it does not return session
 141 if there is no session cache.
 142 if making session failed, returns nil."
 143   (let (pair session key)
 144     (if (not (elmo-plugged-p host port))
 145         (error "Unplugged"))
 146     (setq pair (assoc (setq key (elmo-network-session-cache-key
 147                                  name host port user auth stream-type))
 148                       elmo-network-session-cache))
 149     (when (and pair
 150                (not (memq (process-status
 151                            (elmo-network-session-process-internal
 152                             (cdr pair)))
 153                           '(open run))))
 154       (setq elmo-network-session-cache
 155             (delq pair elmo-network-session-cache))
 156       (elmo-network-close-session (cdr pair))
 157       (setq pair nil))
 158     (if pair
 159         (cdr pair)                      ; connection cache exists.
 160       (unless if-exists
 161         (setq session
 162               (elmo-network-open-session class name
 163                                          host port user auth stream-type))
 164         (setq elmo-network-session-cache
 165               (cons (cons key session)
 166                     elmo-network-session-cache))
 167         session))))
 168
 169 (defun elmo-network-open-session (class name host port user auth
 170                                         stream-type)
 171   "Open an authenticated network session.
 172 CLASS is the class name of the session.
 173 NAME is the name of the process.
 174 HOST is the name of the server host.
 175 PORT is the port number of the service.
 176 USER is the user-id for the authenticate.
 177 AUTH is the authenticate method name (symbol).
 178 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 179 Returns a process object.  if making session failed, returns nil."
 180   (let ((session
 181          (luna-make-entity class
 182                            :name name
 183                            :host host
 184                            :port port
 185                            :user user
 186                            :auth auth
 187                            :stream-type stream-type
 188                            :process nil
 189                            :greeting nil))
 190         (buffer (format " *%s session for %s@%s:%d%s"
 191                         (concat elmo-network-session-name-prefix name)
 192                         user
 193                         host
 194                         port
 195                         (or (elmo-network-stream-type-spec-string stream-type)
 196                             "")))
 197         process)
 198     (condition-case error
 199         (progn
 200           (if (get-buffer buffer) (kill-buffer buffer))
 201           (setq buffer (get-buffer-create buffer))
 202           (elmo-network-initialize-session-buffer session buffer)
 203           (elmo-network-session-set-process-internal
 204            session
 205            (setq process (elmo-open-network-stream
 206                           (elmo-network-session-name-internal session)
 207                           buffer host port stream-type)))
 208           (when process
 209             (elmo-network-initialize-session session)
 210             (elmo-network-authenticate-session session)
 211             (elmo-network-setup-session session)))
 212       (error
 213        (when (eq (car error) 'elmo-authenticate-error)
 214          (elmo-remove-passwd (elmo-network-session-password-key session)))
 215        (elmo-network-close-session session)
 216        (signal (car error)(cdr error))))
 217     session))
 218
 219 (defun elmo-open-network-stream (name buffer host service stream-type)
 220   (let ((auto-plugged (and elmo-auto-change-plugged
 221                            (> elmo-auto-change-plugged 0)))
 222         process)
 223     (if (and stream-type
 224              (elmo-network-stream-type-feature stream-type))
 225         (require (elmo-network-stream-type-feature stream-type)))
 226     (condition-case err
 227         (let (process-connection-type)
 228           (as-binary-process
 229            (setq process
 230                  (if stream-type
 231                      (funcall (elmo-network-stream-type-function stream-type)
 232                               name buffer host service)
 233                    (open-network-stream name buffer host service)))))
 234       (error
 235        (when auto-plugged
 236          (elmo-set-plugged nil host service (current-time))
 237          (message "Auto plugged off at %s:%d" host service)
 238          (sit-for 1))
 239        (signal (car err) (cdr err))))
 240     (when process
 241       (process-kill-without-query process)
 242       (when auto-plugged
 243         (elmo-set-plugged t host service))
 244       process)))
 245
 246 (require 'product)
 247 (product-provide (provide 'elmo-net) (require 'elmo-version))
 248
 249 ;;; elmo-net.el ends here