elmo/elmo-net.el

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