jabber-conn.el

   1 ;; jabber-conn.el - Network transport functions
   2
   3 ;; Copyright (C) 2005 - Georg Lehner - jorge@magma.com.ni
   4 ;; mostly inspired by Gnus.
   5
   6 ;; Copyright (C) 2005 - Carl Henrik Lunde - chlunde+jabber+@ping.uio.no
   7 ;; (starttls)
   8
   9 ;; This file is a part of jabber.el.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; if not, write to the Free Software
  23 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  24
  25 ;; A collection of functions, that hide the details of transmitting to
  26 ;; and fro a Jabber Server
  27
  28 (eval-when-compile (require 'cl))
  29
  30 ;; Try two different TLS/SSL libraries, but don't fail if none available.
  31 (or (ignore-errors (require 'tls))
  32     (ignore-errors (require 'ssl)))
  33
  34 (ignore-errors (require 'starttls))
  35
  36 (require 'srv)
  37
  38 ;; This variable holds the connection, which is used for further
  39 ;; input/output to the server
  40 (defvar *jabber-connection* nil
  41   "the process that does the actual connection")
  42
  43 (defgroup jabber-conn nil "Jabber Connection Settings"
  44   :group 'jabber)
  45
  46 (defun jabber-have-starttls ()
  47   "Return true if we can use STARTTLS."
  48   (and (featurep 'starttls)
  49        (or (and (bound-and-true-p starttls-gnutls-program)
  50                 (executable-find starttls-gnutls-program))
  51            (and (bound-and-true-p starttls-program)
  52                 (executable-find starttls-program)))))
  53
  54 (defconst jabber-default-connection-type
  55   (cond
  56    ;; Use STARTTLS if we can...
  57    ((jabber-have-starttls)
  58     'starttls)
  59    ;; ...else default to unencrypted connection.
  60    (t
  61     'network))
  62   "Default connection type.
  63 See `jabber-connect-methods'.")
  64
  65 (defcustom jabber-connection-ssl-program nil
  66   "Program used for SSL/TLS connections.
  67 nil means prefer gnutls but fall back to openssl.
  68 'gnutls' means use gnutls (through `open-tls-stream').
  69 'openssl means use openssl (through `open-ssl-stream')."
  70   :type '(choice (const :tag "Prefer gnutls, fall back to openssl" nil)
  71                  (const :tag "Use gnutls" gnutls)
  72                  (const :tag "Use openssl" openssl))
  73   :group 'jabber-conn)
  74
  75 (defvar jabber-connect-methods
  76   '((network jabber-network-connect jabber-network-send)
  77     (starttls jabber-starttls-connect jabber-ssl-send)
  78     (ssl jabber-ssl-connect jabber-ssl-send)
  79     (virtual jabber-virtual-connect jabber-virtual-send))
  80   "Alist of connection methods and functions.
  81 First item is the symbol naming the method.
  82 Second item is the connect function.
  83 Third item is the send function.")
  84
  85 (defun jabber-get-connect-function (type)
  86   "Get the connect function associated with TYPE.
  87 TYPE is a symbol; see `jabber-connection-type'."
  88   (let ((entry (assq type jabber-connect-methods)))
  89     (nth 1 entry)))
  90
  91 (defun jabber-get-send-function (type)
  92   "Get the send function associated with TYPE.
  93 TYPE is a symbol; see `jabber-connection-type'."
  94   (let ((entry (assq type jabber-connect-methods)))
  95     (nth 2 entry)))
  96
  97 (defun jabber-srv-targets (server network-server port)
  98   "Find host and port to connect to.
  99 If NETWORK-SERVER and/or PORT are specified, use them.
 100 If we can't find SRV records, use standard defaults."
 101   ;; If the user has specified a host or a port, obey that.
 102   (if (or network-server port)
 103       (list (cons (or network-server server)
 104                   (or port 5222)))
 105     (or (condition-case nil
 106             (srv-lookup (concat "_xmpp-client._tcp." server))
 107           (error nil))
 108         (list (cons server 5222)))))
 109
 110 ;; Plain TCP/IP connection
 111 (defun jabber-network-connect (fsm server network-server port)
 112   "Connect to a Jabber server with a plain network connection.
 113 Send a message of the form (:connected CONNECTION) to FSM if
 114 connection succeeds.  Send a message :connection-failed if
 115 connection fails."
 116   ;; XXX: asynchronous connection
 117   (let ((coding-system-for-read 'utf-8)
 118         (coding-system-for-write 'utf-8)
 119         (targets (jabber-srv-targets server network-server port)))
 120     (catch 'connected
 121       (dolist (target targets)
 122         (condition-case e
 123             (let ((process-buffer (generate-new-buffer jabber-process-buffer))
 124                   connection)
 125               (unwind-protect
 126                   (setq connection (open-network-stream
 127                                     "jabber"
 128                                     process-buffer
 129                                     (car target)
 130                                     (cdr target)))
 131
 132                 (unless (or connection jabber-debug-keep-process-buffers)
 133                   (kill-buffer process-buffer)))
 134
 135               (when connection
 136                 (fsm-send fsm (list :connected connection))
 137                 (throw 'connected connection)))
 138           (error
 139            (message "Couldn't connect to %s: %s" target
 140                     (error-message-string e)))))
 141       (fsm-send fsm :connection-failed))))
 142
 143 (defun jabber-network-send (connection string)
 144   "Send a string via a plain TCP/IP connection to the Jabber Server."
 145   (process-send-string connection string))
 146
 147 ;; SSL connection, we use openssl's s_client function for encryption
 148 ;; of the link
 149 ;; TODO: make this configurable
 150 (defun jabber-ssl-connect (fsm server network-server port)
 151   "connect via OpenSSL or GnuTLS to a Jabber Server
 152 Send a message of the form (:connected CONNECTION) to FSM if
 153 connection succeeds.  Send a message :connection-failed if
 154 connection fails."
 155   (let ((coding-system-for-read 'utf-8)
 156         (coding-system-for-write 'utf-8)
 157         (connect-function
 158          (cond
 159           ((and (memq jabber-connection-ssl-program '(nil gnutls))
 160                 (fboundp 'open-tls-stream))
 161            'open-tls-stream)
 162           ((and (memq jabber-connection-ssl-program '(nil openssl))
 163                 (fboundp 'open-ssl-stream))
 164            'open-ssl-stream)
 165           (t
 166            (error "Neither TLS nor SSL connect functions available")))))
 167     (let ((process-buffer (generate-new-buffer jabber-process-buffer))
 168           connection)
 169       (unwind-protect
 170           (setq connection (funcall connect-function
 171                                     "jabber"
 172                                     process-buffer
 173                                     (or network-server server)
 174                                     (or port 5223)))
 175         (unless (or connection jabber-debug-keep-process-buffers)
 176           (kill-buffer process-buffer)))
 177       (if connection
 178           (fsm-send fsm (list :connected connection))
 179         (fsm-send fsm :connection-failed)))))
 180
 181 (defun jabber-ssl-send (connection string)
 182   "Send a string via an SSL-encrypted connection to the Jabber Server."
 183   ;; It seems we need to send a linefeed afterwards.
 184   (process-send-string connection string)
 185   (process-send-string connection "\n"))
 186
 187 (defun jabber-starttls-connect (fsm server network-server port)
 188   "Connect via GnuTLS to a Jabber Server.
 189 Send a message of the form (:connected CONNECTION) to FSM if
 190 connection succeeds.  Send a message :connection-failed if
 191 connection fails."
 192   (let ((coding-system-for-read 'utf-8)
 193         (coding-system-for-write 'utf-8)
 194         (targets (jabber-srv-targets server network-server port)))
 195     (unless (fboundp 'starttls-open-stream)
 196       (error "starttls.el not available"))
 197     (catch 'connected
 198       (dolist (target targets)
 199         (condition-case e
 200             (let ((process-buffer (generate-new-buffer jabber-process-buffer))
 201                   connection)
 202               (unwind-protect
 203                   (setq connection
 204                         (starttls-open-stream
 205                          "jabber"
 206                          process-buffer
 207                          (car target)
 208                          (cdr target)))
 209                 (unless (or connection jabber-debug-keep-process-buffers)
 210                   (kill-buffer process-buffer)))
 211               (when connection
 212                 (fsm-send fsm (list :connected connection))
 213                 (throw 'connected connection)))
 214           (error
 215            (message "Couldn't connect to %s: %s" target
 216                     (error-message-string e))))
 217         (fsm-send fsm :connection-failed)))))
 218
 219 (defun jabber-starttls-initiate (fsm)
 220   "Initiate a starttls connection"
 221   (jabber-send-sexp fsm
 222    '(starttls ((xmlns . "urn:ietf:params:xml:ns:xmpp-tls")))))
 223
 224 (defun jabber-starttls-process-input (fsm xml-data)
 225   "Process result of starttls request.
 226 Return non-nil on success, nil on failure."
 227   (cond
 228    ((eq (car xml-data) 'proceed)
 229     (starttls-negotiate (plist-get (fsm-get-state-data fsm) :connection)))
 230    ((eq (car xml-data) 'failure)
 231     nil)))
 232
 233 (defvar *jabber-virtual-server-function* nil
 234   "Function to use for sending stanzas on a virtual connection.
 235 The function should accept two arguments, the connection object
 236 and a string that the connection wants to send.")
 237
 238 (defun jabber-virtual-connect (fsm server network-server port)
 239   "Connect to a virtual \"server\".
 240 Use `*jabber-virtual-server-function*' as send function."
 241   (unless (functionp *jabber-virtual-server-function*)
 242     (error "No virtual server function specified"))
 243   ;; We pass the fsm itself as "connection object", as that is what a
 244   ;; virtual server needs to send stanzas.
 245   (fsm-send fsm (list :connected fsm)))
 246
 247 (defun jabber-virtual-send (connection string)
 248   (funcall *jabber-virtual-server-function* connection string))
 249
 250 (provide 'jabber-conn)
 251 ;; arch-tag: f95ec240-8cd3-11d9-9dbf-000a95c2fcd0