1 ;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; Author: Magnus Henoch <magnus.henoch@gmail.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; This program is implemented from RFC 5802. It implements the
25 ;; SCRAM-SHA-1 SASL mechanism.
27 ;; RFC 5802 foresees "hash agility", i.e. new mechanisms based on the
28 ;; same protocol but using a different hash function. Likewise, this
29 ;; module attempts to separate generic and specific functions, which
30 ;; should make it easy to implement any future SCRAM-* SASL mechanism.
31 ;; It should be as simple as copying the SCRAM-SHA-1 section below and
32 ;; replacing all SHA-1 references.
34 ;; This module does not yet implement the variants with channel
35 ;; binding, i.e. SCRAM-*-PLUS. That would require cooperation from
48 (defconst sasl-scram-sha-1-steps
49 '(sasl-scram-client-first-message
50 sasl-scram-sha-1-client-final-message
51 sasl-scram-sha-1-authenticate-server))
53 (defun sasl-scram-sha-1-client-final-message (client step)
54 (sasl-scram--client-final-message
55 ;; HMAC-SHA1 uses block length 64 and hash length 20; see RFC 2104.
56 'sha1 64 20 client step))
58 (defun sasl-scram-sha-1-authenticate-server (client step)
59 (sasl-scram--authenticate-server
60 'sha1 64 20 client step))
62 (put 'sasl-scram-sha-1 'sasl-mechanism
63 (sasl-make-mechanism "SCRAM-SHA-1" sasl-scram-sha-1-steps))
65 (provide 'sasl-scram-sha-1)
67 ;;; Generic for SCRAM-*
69 (defun sasl-scram-client-first-message (client _step)
70 (let ((c-nonce (sasl-unique-id)))
71 (sasl-client-set-property client 'c-nonce c-nonce))
73 ;; n = client doesn't support channel binding
75 ;; TODO: where would we get authorization id from?
77 (sasl-scram--client-first-message-bare client)))
79 (defun sasl-scram--client-first-message-bare (client)
80 (let ((c-nonce (sasl-client-property client 'c-nonce)))
82 ;; TODO: saslprep username or disallow non-ASCII characters
83 "n=" (sasl-client-name client) ","
86 (defun sasl-scram--client-final-message (hash-fun block-length hash-length client step)
88 "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)"
89 (sasl-step-data step))
90 (sasl-error "Unexpected server response"))
91 (let* ((hmac-fun (lambda (text key)
93 (rfc2104-hash hash-fun block-length hash-length key text))))
94 (step-data (sasl-step-data step))
95 (nonce (match-string 1 step-data))
96 (salt-base64 (match-string 2 step-data))
97 (iteration-count (string-to-number (match-string 3 step-data)))
99 (c-nonce (sasl-client-property client 'c-nonce))
100 ;; no channel binding, no authorization id
102 (unless (string-prefix-p c-nonce nonce)
103 (sasl-error "Invalid nonce from server"))
104 (let* ((client-final-message-without-proof
105 (concat "c=" (base64-encode-string cbind-input) ","
108 ;; TODO: either apply saslprep or disallow non-ASCII characters
109 (sasl-read-passphrase
110 (format "%s passphrase for %s: "
111 (sasl-mechanism-name (sasl-client-mechanism client))
112 (sasl-client-name client))))
113 (salt (base64-decode-string salt-base64))
116 (let ((digest (concat salt (string 0 0 0 1)))
118 (dotimes (_i iteration-count xored)
119 (setq digest (funcall hmac-fun digest password))
120 (setq xored (if (null xored)
122 (cl-map 'string 'logxor xored digest))))))
124 (funcall hmac-fun "Client Key" salted-password))
125 (stored-key (decode-hex-string (funcall hash-fun client-key)))
128 (sasl-scram--client-first-message-bare client) ","
130 client-final-message-without-proof))
131 (client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key))
132 (client-proof (cl-map 'string 'logxor client-key client-signature))
133 (client-final-message
134 (concat client-final-message-without-proof ","
135 "p=" (base64-encode-string client-proof))))
136 (sasl-client-set-property client 'auth-message auth-message)
137 (sasl-client-set-property client 'salted-password salted-password)
138 client-final-message)))
140 (defun sasl-scram--authenticate-server (hash-fun block-length hash-length client step)
142 ((string-match "^e=\\([^,]+\\)" (sasl-step-data step))
143 (sasl-error (format "Server error: %s" (match-string 1 (sasl-step-data step)))))
144 ((string-match "^v=\\([^,]+\\)" (sasl-step-data step))
145 (let* ((hmac-fun (lambda (text key)
147 (rfc2104-hash hash-fun block-length hash-length key text))))
148 (verifier (base64-decode-string (match-string 1 (sasl-step-data step))))
149 (auth-message (sasl-client-property client 'auth-message))
150 (salted-password (sasl-client-property client 'salted-password))
151 (server-key (funcall hmac-fun "Server Key" salted-password))
152 (expected-server-signature
153 (funcall hmac-fun (encode-coding-string auth-message 'utf-8) server-key)))
154 (unless (string= expected-server-signature verifier)
155 (sasl-error "Server not authenticated"))))
157 (sasl-error "Invalid response from server"))))
159 (provide 'sasl-scram-rfc)
160 ;;; sasl-scram-rfc.el ends here