sasl-scram.el

   1 ;;; sasl-scram.el --- Compute SCRAM-MD5.
   2
   3 ;; Copyright (C) 1999 Shuhei KOBAYASHI
   4
   5 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   6 ;;      Kenichi OKADA <okada@opaopa.org>
   7 ;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
   8
   9 ;; This file is part of FLIM (Faithful Library about Internet Message).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, 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; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This program is implemented from draft-newman-auth-scram-03.txt.
  29 ;;
  30 ;; It is caller's responsibility to base64-decode challenges and
  31 ;; base64-encode responses in IMAP4 AUTHENTICATE command.
  32 ;;
  33 ;; Passphrase should be longer than 16 bytes. (See RFC 2195)
  34
  35 ;; Examples.
  36 ;;
  37 ;; (sasl-scram-md5-make-security-info nil t 0)
  38 ;; => "^A^@^@^@"
  39 ;;
  40 ;; (base64-encode-string
  41 ;;  (sasl-scram-md5-make-client-msg-2
  42 ;;   (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
  43 ;;   (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
  44 ;;   (sasl-scram-md5-make-salted-pass
  45 ;;    "secret stuff" "testsalt")
  46 ;;   (sasl-scram-md5-make-security-info nil t 0)))
  47 ;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs="
  48 ;;
  49 ;; (base64-encode-string
  50 ;;  (sasl-scram-md5-make-server-msg-2
  51 ;;   (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
  52 ;;   (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
  53 ;;   (sasl-scram-md5-make-security-info nil t 0)
  54 ;;   "testsalt"
  55 ;;   (sasl-scram-md5-make-salted-pass
  56 ;;    "secret stuff" "testsalt")))
  57 ;; => "U0odqYw3B7XIIW0oSz65OQ=="
  58
  59 ;;; Code:
  60
  61 (require 'sasl)
  62 (require 'hmac-md5)
  63
  64 (defvar sasl-scram-md5-unique-id-function
  65   sasl-unique-id-function)
  66
  67 (defconst sasl-scram-md5-steps
  68   '(ignore                              ;no initial response
  69     sasl-scram-md5-response-1
  70     sasl-scram-md5-response-2
  71     sasl-scram-md5-authenticate-server))
  72
  73 (defmacro sasl-scram-md5-security-info-no-security-layer (security-info)
  74   `(eq (logand (aref ,security-info 0) 1) 1))
  75 (defmacro sasl-scram-md5-security-info-integrity-protection-layer (security-info)
  76   `(eq (logand (aref ,security-info 0) 2) 2))
  77 (defmacro sasl-scram-md5-security-info-buffer-size (security-info)
  78   `(let ((ssecinfo ,security-info))
  79      (+ (lsh (aref ssecinfo 1) 16)
  80         (lsh (aref ssecinfo 2) 8)
  81         (aref ssecinfo 3))))
  82
  83 (defun sasl-scram-md5-make-security-info (integrity-protection-layer
  84                                           no-security-layer buffer-size)
  85   (let ((csecinfo (make-string 4 0)))
  86     (when integrity-protection-layer
  87       (aset csecinfo 0 2))
  88     (if no-security-layer
  89         (aset csecinfo 0 (logior (aref csecinfo 0) 1))
  90       (aset csecinfo 1
  91             (lsh (logand buffer-size (lsh 255 16)) -16))
  92       (aset csecinfo 2
  93             (lsh (logand buffer-size (lsh 255 8)) -8))
  94       (aset csecinfo 3 (logand buffer-size 255)))
  95     csecinfo))
  96
  97 (defun sasl-scram-md5-make-unique-nonce ()      ; 8*OCTET, globally unique.
  98   ;; For example, concatenated string of process-identifier, system-clock,
  99   ;; sequence-number, random-number, and domain-name.
 100   (let* ((sasl-unique-id-function sasl-scram-md5-unique-id-function)
 101          (id (sasl-unique-id)))
 102     (unwind-protect
 103         (concat "<" id "@" (system-name) ">")
 104       (fillarray id 0))))
 105
 106 (defun sasl-scram-md5-xor-string (str1 str2)
 107   ;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
 108   (let* ((len (length str1))
 109          (dst (make-string len 0))
 110          (pos 0))
 111     (while (< pos len)
 112       (aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
 113       (setq pos (1+ pos)))
 114     dst))
 115
 116 (defun sasl-scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id nonce)
 117   "Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
 118 If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
 119   (concat authorize-id "\0" authenticate-id "\0"
 120           (or nonce
 121               (sasl-scram-md5-make-unique-nonce))))
 122
 123 (defun sasl-scram-md5-parse-server-msg-1 (server-msg-1)
 124   "Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
 125   (if (and (> (length server-msg-1) 16)
 126            (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
 127       (list (substring server-msg-1 0 8)        ; salt
 128             (substring server-msg-1 8 12)       ; server-security-info
 129             (substring server-msg-1     ; service-id
 130                        12 (1- (match-end 0))))
 131     (sasl-error (format "Unexpected response: %s" server-msg-1))))
 132
 133 (defun sasl-scram-md5-server-salt (server-msg-1)
 134   (car (sasl-scram-md5-parse-server-msg-1 server-msg-1)))
 135
 136 (defun sasl-scram-md5-make-salted-pass (passphrase salt)
 137   (hmac-md5 salt passphrase))
 138
 139 (defun sasl-scram-md5-make-client-key (salted-pass)
 140   (md5-binary salted-pass))
 141
 142 (defun sasl-scram-md5-make-client-verifier (client-key)
 143   (md5-binary client-key))
 144
 145 (defun sasl-scram-md5-make-shared-key (server-msg-1
 146                                        client-msg-1
 147                                        client-security-info
 148                                        client-verifier)
 149   (let (buff)
 150     (unwind-protect
 151         (hmac-md5
 152          (setq buff
 153                (concat server-msg-1 client-msg-1 client-security-info))
 154          client-verifier)
 155       (fillarray buff 0))))
 156
 157 (defun sasl-scram-md5-make-client-proof (client-key shared-key)
 158   (sasl-scram-md5-xor-string client-key shared-key))
 159
 160 (defun sasl-scram-md5-make-client-msg-2 (server-msg-1
 161                                          client-msg-1
 162                                          salted-pass
 163                                          client-security-info)
 164   (let (client-proof client-key shared-key client-verifier)
 165     (setq client-key
 166           (sasl-scram-md5-make-client-key salted-pass))
 167     (setq client-verifier
 168           (sasl-scram-md5-make-client-verifier client-key))
 169     (setq shared-key
 170           (unwind-protect
 171               (sasl-scram-md5-make-shared-key
 172                server-msg-1
 173                client-msg-1
 174                client-security-info
 175                client-verifier)
 176             (fillarray client-verifier 0)))
 177     (setq client-proof
 178           (unwind-protect
 179               (sasl-scram-md5-make-client-proof
 180                client-key shared-key)
 181             (fillarray client-key 0)
 182             (fillarray shared-key 0)))
 183     (unwind-protect
 184         (concat
 185          client-security-info
 186          client-proof)
 187       (fillarray client-proof 0))))
 188
 189 (defun sasl-scram-md5-make-server-msg-2 (server-msg-1
 190                                          client-msg-1
 191                                          client-security-info
 192                                          salt salted-pass)
 193   (let ((server-salt
 194         (hmac-md5 salt salted-pass))
 195         buff)
 196     (unwind-protect
 197         (hmac-md5
 198          (setq buff
 199                (concat
 200                 client-msg-1
 201                 server-msg-1
 202                 client-security-info))
 203          server-salt)
 204       (fillarray server-salt 0)
 205       (fillarray buff 0))))
 206
 207 (defun sasl-scram-md5-response-1 (client step)
 208   (sasl-client-set-property
 209    client 'client-msg-1
 210    (sasl-scram-md5-make-client-msg-1
 211     (sasl-client-name client)
 212     (sasl-client-property client 'authorize-id)
 213     (sasl-client-property client 'nonce))))
 214
 215 (defun sasl-scram-md5-response-2 (client step)
 216   (let* ((server-msg-1
 217           (sasl-client-set-property
 218            client 'server-msg-1
 219            (sasl-step-data step)))
 220          (salted-pass
 221           (sasl-client-set-property
 222            client 'salted-pass
 223            (sasl-scram-md5-make-salted-pass
 224             (sasl-read-passphrase
 225              (format "SCRAM-MD5 passphrase for %s: "
 226                      (sasl-client-name client)))
 227             (sasl-scram-md5-server-salt server-msg-1)))))
 228     (sasl-client-set-property
 229      client 'client-msg-2
 230      (sasl-scram-md5-make-client-msg-2
 231       server-msg-1
 232       (sasl-client-property client 'client-msg-1)
 233       salted-pass
 234       (or (sasl-client-property client 'client-security-info)
 235           (sasl-scram-md5-make-security-info nil t 0))))))
 236
 237 (defun sasl-scram-md5-authenticate-server (client step)
 238   (let ((server-msg-2
 239          (sasl-client-set-property
 240           client 'server-msg-2
 241           (sasl-step-data step)))
 242         (server-msg-1
 243          (sasl-client-property client 'server-msg-1)))
 244     (if (string= server-msg-2
 245                      (sasl-scram-md5-make-server-msg-2
 246                       server-msg-1
 247                       (sasl-client-property client 'client-msg-1)
 248                       (or (sasl-client-property client 'client-security-info)
 249                           (sasl-scram-md5-make-security-info nil t 0))
 250                       (sasl-scram-md5-server-salt server-msg-1)
 251                       (sasl-client-property client 'salted-pass)))
 252         " "
 253       (sasl-error "SCRAM-MD5:  authenticate server failed."))))
 254
 255 (put 'sasl-scram 'sasl-mechanism
 256      (sasl-make-mechanism "SCRAM-MD5" sasl-scram-md5-steps))
 257
 258 (provide 'sasl-scram)
 259
 260 ;;; sasl-scram.el ends here