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
  97 (defsubst elmo-network-session-cache-key (name host port user auth stream-type)
  98   "Returns session cache key."
  99   (format "%s:%s/%s@%s:%d%s"
 100           name user auth host port (or stream-type "")))
 101
 102 (defun elmo-network-clear-session-cache ()
 103   "Clear session cache."
 104   (interactive)
 105   (mapcar (lambda (pair)
 106             (elmo-network-close-session (cdr pair)))
 107           elmo-network-session-cache)
 108   (setq elmo-network-session-cache nil))
 109
 110 (defmacro elmo-network-session-buffer (session)
 111   "Get buffer for SESSION."
 112   (` (process-buffer (elmo-network-session-process-internal
 113                       (, session)))))
 114
 115 (defun elmo-network-get-session (class name host port user auth stream-type
 116                                        &optional if-exists)
 117   "Get network session from session cache or a new network session.
 118 CLASS is the class name of the session.
 119 NAME is the name of the process.
 120 HOST is the name of the server host.
 121 PORT is the port number of the service.
 122 USER is the user-id for the authenticate.
 123 AUTH is the authenticate method name (symbol).
 124 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 125 Returns a `elmo-network-session' instance.
 126 If optional argument IF-EXISTS is non-nil, it does not return session
 127 if there is no session cache.
 128 if making session failed, returns nil."
 129   (let (pair session key)
 130     (if (not (elmo-plugged-p host port))
 131         (error "Unplugged"))
 132     (setq pair (assoc (setq key (elmo-network-session-cache-key
 133                                  name host port user auth stream-type))
 134                       elmo-network-session-cache))
 135     (when (and pair
 136                (memq (process-status
 137                       (elmo-network-session-process-internal
 138                        (cdr pair)))
 139                      '(closed exit)))
 140       (setq elmo-network-session-cache
 141             (delq pair elmo-network-session-cache))
 142       (elmo-network-close-session (cdr pair))
 143       (setq pair nil))
 144     (if pair
 145         (cdr pair)                      ; connection cache exists.
 146       (unless if-exists
 147         (setq session
 148               (elmo-network-open-session class name
 149                                          host port user auth stream-type))
 150         (setq elmo-network-session-cache
 151               (cons (cons key session)
 152                     elmo-network-session-cache))
 153         session))))
 154
 155 (defun elmo-network-open-session (class name host port user auth
 156                                         stream-type)
 157   "Open an authenticated network session.
 158 CLASS is the class name of the session.
 159 NAME is the name of the process.
 160 HOST is the name of the server host.
 161 PORT is the port number of the service.
 162 USER is the user-id for the authenticate.
 163 AUTH is the authenticate method name (symbol).
 164 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
 165 Returns a process object. if making session failed, returns nil."
 166   (let ((session
 167          (luna-make-entity class
 168                            :name name
 169                            :host host
 170                            :port port
 171                            :user user
 172                            :auth auth
 173                            :stream-type stream-type
 174                            :process nil
 175                            :greeting nil))
 176         (buffer (format " *%s session for %s@%s:%d%s"
 177                         name
 178                         user
 179                         host
 180                         port
 181                         (or (elmo-network-stream-type-spec-string stream-type)
 182                             "")))
 183         process)
 184     (condition-case error
 185         (progn
 186           (if (get-buffer buffer) (kill-buffer buffer))
 187           (setq buffer (get-buffer-create buffer))
 188           (elmo-network-initialize-session-buffer session buffer)
 189           (elmo-network-session-set-process-internal
 190            session
 191            (setq process (elmo-open-network-stream
 192                           (elmo-network-session-name-internal session)
 193                           buffer host port stream-type)))
 194           (when process
 195             (elmo-network-initialize-session session)
 196             (elmo-network-authenticate-session session)
 197             (elmo-network-setup-session session)))
 198       (error
 199        (when (eq (car error) 'elmo-authenticate-error)
 200          (elmo-remove-passwd (elmo-network-session-password-key session)))
 201        (elmo-network-close-session session)
 202        (signal (car error)(cdr error))))
 203     session))
 204
 205 (defun elmo-open-network-stream (name buffer host service stream-type)
 206   (let ((auto-plugged (and elmo-auto-change-plugged
 207                            (> elmo-auto-change-plugged 0)))
 208         process)
 209     (if (and stream-type
 210              (elmo-network-stream-type-feature stream-type))
 211         (require (elmo-network-stream-type-feature stream-type)))
 212     (condition-case err
 213         (let (process-connection-type)
 214           (as-binary-process
 215            (setq process
 216                  (if stream-type
 217                      (funcall (elmo-network-stream-type-function stream-type)
 218                               name buffer host service)
 219                    (open-network-stream name buffer host service)))))
 220       (error
 221        (when auto-plugged
 222          (elmo-set-plugged nil host service (current-time))
 223          (message "Auto plugged off at %s:%d" host service)
 224          (sit-for 1))
 225        (signal (car err) (cdr err))))
 226     (when process
 227       (process-kill-without-query process)
 228       (when auto-plugged
 229         (elmo-set-plugged t host service))
 230       process)))
 231
 232 (provide 'elmo-net)
 233
 234 ;;; elmo-net.el ends here