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