jabber-sasl.el

   1 ;; jabber-sasl.el - SASL authentication
   2
   3 ;; Copyright (C) 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4
   5 ;; This file is a part of jabber.el.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; if not, write to the Free Software
  19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 (require 'cl)
  22
  23 ;;; This file uses sasl.el from FLIM or Gnus.  If it can't be found,
  24 ;;; jabber-core.el won't use the SASL functions.
  25 (eval-and-compile
  26   (condition-case nil
  27       (require 'sasl)
  28     (error nil)))
  29
  30 ;;; Alternatives to FLIM would be the command line utility of GNU SASL,
  31 ;;; or anything the Gnus people decide to use.
  32
  33 ;;; See XMPP-CORE and XMPP-IM for details about the protocol.
  34
  35 (require 'jabber-xml)
  36
  37 (defun jabber-sasl-start-auth (jc stream-features)
  38   ;; Find a suitable common mechanism.
  39   (let* ((mechanism-elements (car (jabber-xml-get-children stream-features 'mechanisms)))
  40          (mechanisms (mapcar
  41                       (lambda (tag)
  42                         (car (jabber-xml-node-children tag)))
  43                       (jabber-xml-get-children mechanism-elements 'mechanism)))
  44          (mechanism
  45           (if (and (member "ANONYMOUS" mechanisms)
  46                    (yes-or-no-p "Use anonymous authentication? "))
  47               (sasl-find-mechanism '("ANONYMOUS"))
  48             (sasl-find-mechanism mechanisms))))
  49
  50     ;; No suitable mechanism?
  51     (if (null mechanism)
  52         ;; Maybe we can use legacy authentication
  53         (let ((node (find "http://jabber.org/features/iq-auth"
  54                           (jabber-xml-get-children stream-features 'auth)
  55                           :key #'(lambda (node) (jabber-xml-get-attribute node 'xmlns))
  56                           :test #'string=)))
  57           (if node
  58               (fsm-send jc :use-legacy-auth-instead)
  59             (message "No suitable SASL mechanism found")
  60             (fsm-send jc :authentication-failure)))
  61
  62       ;; Watch for plaintext logins over unencrypted connections
  63       (if (and (not (plist-get (fsm-get-state-data jc) :encrypted))
  64                (member (sasl-mechanism-name mechanism)
  65                        '("PLAIN" "LOGIN"))
  66                (not (yes-or-no-p "Jabber server only allows cleartext password transmission!  Continue? ")))
  67           (fsm-send jc :authentication-failure)
  68
  69         ;; Start authentication.
  70         (let* (passphrase
  71                (client (sasl-make-client mechanism
  72                                          (plist-get (fsm-get-state-data jc) :username)
  73                                          "xmpp"
  74                                          (plist-get (fsm-get-state-data jc) :server)))
  75                (sasl-read-passphrase (jabber-sasl-read-passphrase-closure
  76                                       jc
  77                                       (lambda (p) (setq passphrase (copy-sequence p)) p)))
  78                (step (sasl-next-step client nil)))
  79           (jabber-send-sexp
  80            jc
  81            `(auth ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl")
  82                    (mechanism . ,(sasl-mechanism-name mechanism)))
  83                   ,(when (sasl-step-data step)
  84                      (base64-encode-string (sasl-step-data step) t))))
  85           (list client step passphrase))))))
  86
  87 (defun jabber-sasl-read-passphrase-closure (jc remember)
  88   "Return a lambda function suitable for `sasl-read-passphrase' for JC.
  89 Call REMEMBER with the password.  REMEMBER is expected to return it as well."
  90   (lexical-let ((password (plist-get (fsm-get-state-data jc) :password))
  91                 (bare-jid (jabber-connection-bare-jid jc))
  92                 (remember remember))
  93     (if password
  94         (lambda (prompt) (funcall remember (copy-sequence password)))
  95       (lambda (prompt) (funcall remember (jabber-read-password bare-jid))))))
  96
  97 (defun jabber-sasl-process-input (jc xml-data sasl-data)
  98   (let* ((client (first sasl-data))
  99          (step (second sasl-data))
 100          (passphrase (third sasl-data))
 101          (sasl-read-passphrase (jabber-sasl-read-passphrase-closure
 102                                 jc
 103                                 (lambda (p) (setq passphrase (copy-sequence p)) p))))
 104     (cond
 105      ((eq (car xml-data) 'challenge)
 106       (sasl-step-set-data step (base64-decode-string (car (jabber-xml-node-children xml-data))))
 107       (setq step (sasl-next-step client step))
 108       (jabber-send-sexp
 109        jc
 110        `(response ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl"))
 111                   ,(when (sasl-step-data step)
 112                      (base64-encode-string (sasl-step-data step) t)))))
 113
 114      ((eq (car xml-data) 'failure)
 115       (message "SASL authentication failure: %s"
 116                (jabber-xml-node-name (car (jabber-xml-node-children xml-data))))
 117       (fsm-send jc :authentication-failure))
 118
 119      ((eq (car xml-data) 'success)
 120       (message "Authentication succeeded")
 121       (fsm-send jc (cons :authentication-success passphrase))))
 122     (list client step passphrase)))
 123
 124 (provide 'jabber-sasl)
 125 ;;; arch-tag: 2a4a234d-34d3-49dd-950d-518c899c0fd0