* bug#17636: Implement SCRAM-SHA-1 SASL mechanism
2014-06-01 14:20 ` Stefan Monnier
2014-06-05 9:25 ` Magnus Henoch
@ 2014-10-09 20:14 ` Magnus Henoch
2014-10-17 16:41 ` Stefan Monnier
2015-02-13 8:55 ` Lars Ingebrigtsen
1 sibling, 2 replies; 9+ messages in thread
From: Magnus Henoch @ 2014-10-09 20:14 UTC (permalink / raw)
To: 17636
[-- Attachment #1: Type: text/plain, Size: 438 bytes --]
rfc2104.el was rewritten for speed in 2008, and seems to be about
twice as fast as hmac-*.el. I think hmac-*.el could be deprecated and
eventually removed; the only use in the Emacs tree is in sasl-cram.el.
So here is a new and improved patch for implementing SCRAM-SHA-1, that
uses the existing rfc2104.el instead of adding hmac-sha1.el.
Would it be okay for a module in lisp/net to depend on a module in
lisp/gnus?
Regards,
Magnus
[-- Attachment #2: 0001-Implement-SCRAM-SHA-1-SASL-mechanism.patch --]
[-- Type: text/x-patch, Size: 11122 bytes --]
From 9e40ec05bd7e628432abc8570a8c62718a9e5a56 Mon Sep 17 00:00:00 2001
From: Magnus Henoch <magnus.henoch@gmail.com>
Date: Thu, 29 May 2014 20:46:30 +0100
Subject: [PATCH] Implement SCRAM-SHA-1 SASL mechanism
Remove all references to SCRAM-MD5, which never made it into an RFC,
and whose implementation wasn't merged from FLIM to Emacs. Use HMAC /
RFC 2104 implementation from rfc2104.el in Gnus.
* lisp/net/sasl-scram-rfc.el: New file.
* lisp/net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add
SCRAM-SHA-1 first.
(sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1
entry.
* test/automated/sasl-scram-rfc-tests.el: New file.
---
lisp/ChangeLog | 9 ++
lisp/net/sasl-scram-rfc.el | 160 +++++++++++++++++++++++++++++++++
lisp/net/sasl.el | 6 +-
test/ChangeLog | 4 +
test/automated/sasl-scram-rfc-tests.el | 50 +++++++++++
5 files changed, 226 insertions(+), 3 deletions(-)
create mode 100644 lisp/net/sasl-scram-rfc.el
create mode 100644 test/automated/sasl-scram-rfc-tests.el
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 552b43a..17cdbef 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2014-10-09 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add
+ SCRAM-SHA-1 first.
+ (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1
+ entry.
+
+ * net/sasl-scram-rfc.el: New file.
+
2014-07-14 Daniel Colascione <dancol@dancol.org>
* progmodes/cc-langs.el: Change comments from `cl-macroexpand-all'
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
new file mode 100644
index 0000000..3d86da4
--- /dev/null
+++ b/lisp/net/sasl-scram-rfc.el
@@ -0,0 +1,160 @@
+;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This program is implemented from RFC 5802. It implements the
+;; SCRAM-SHA-1 SASL mechanism.
+;;
+;; RFC 5802 foresees "hash agility", i.e. new mechanisms based on the
+;; same protocol but using a different hash function. Likewise, this
+;; module attempts to separate generic and specific functions, which
+;; should make it easy to implement any future SCRAM-* SASL mechanism.
+;; It should be as simple as copying the SCRAM-SHA-1 section below and
+;; replacing all SHA-1 references.
+;;
+;; This module does not yet implement the variants with channel
+;; binding, i.e. SCRAM-*-PLUS. That would require cooperation from
+;; the TLS library.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+
+;;; SCRAM-SHA-1
+
+(require 'hex-util)
+(require 'rfc2104)
+
+(defconst sasl-scram-sha-1-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-1-client-final-message
+ sasl-scram-sha-1-authenticate-server))
+
+(defun sasl-scram-sha-1-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA1 uses block length 64 and hash length 20; see RFC 2104.
+ 'sha1 64 20 client step))
+
+(defun sasl-scram-sha-1-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sha1 64 20 client step))
+
+(put 'sasl-scram-sha-1 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-1" sasl-scram-sha-1-steps))
+
+(provide 'sasl-scram-sha-1)
+
+;;; Generic for SCRAM-*
+
+(defun sasl-scram-client-first-message (client _step)
+ (let ((c-nonce (sasl-unique-id)))
+ (sasl-client-set-property client 'c-nonce c-nonce))
+ (concat
+ ;; n = client doesn't support channel binding
+ "n,"
+ ;; TODO: where would we get authorization id from?
+ ","
+ (sasl-scram--client-first-message-bare client)))
+
+(defun sasl-scram--client-first-message-bare (client)
+ (let ((c-nonce (sasl-client-property client 'c-nonce)))
+ (concat
+ ;; TODO: saslprep username or disallow non-ASCII characters
+ "n=" (sasl-client-name client) ","
+ "r=" c-nonce)))
+
+(defun sasl-scram--client-final-message (hash-fun block-length hash-length client step)
+ (unless (string-match
+ "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)"
+ (sasl-step-data step))
+ (sasl-error "Unexpected server response"))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (step-data (sasl-step-data step))
+ (nonce (match-string 1 step-data))
+ (salt-base64 (match-string 2 step-data))
+ (iteration-count (string-to-number (match-string 3 step-data)))
+
+ (c-nonce (sasl-client-property client 'c-nonce))
+ ;; no channel binding, no authorization id
+ (cbind-input "n,,"))
+ (unless (string-prefix-p c-nonce nonce)
+ (sasl-error "Invalid nonce from server"))
+ (let* ((client-final-message-without-proof
+ (concat "c=" (base64-encode-string cbind-input) ","
+ "r=" nonce))
+ (password
+ ;; TODO: either apply saslprep or disallow non-ASCII characters
+ (sasl-read-passphrase
+ (format "%s passphrase for %s: "
+ (sasl-mechanism-name (sasl-client-mechanism client))
+ (sasl-client-name client))))
+ (salt (base64-decode-string salt-base64))
+ (salted-password
+ ;; Hi(str, salt, i):
+ (let ((digest (concat salt (string 0 0 0 1)))
+ (xored nil))
+ (dotimes (_i iteration-count xored)
+ (setq digest (funcall hmac-fun digest password))
+ (setq xored (if (null xored)
+ digest
+ (cl-map 'string 'logxor xored digest))))))
+ (client-key
+ (funcall hmac-fun "Client Key" salted-password))
+ (stored-key (decode-hex-string (funcall hash-fun client-key)))
+ (auth-message
+ (concat
+ (sasl-scram--client-first-message-bare client) ","
+ step-data ","
+ client-final-message-without-proof))
+ (client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key))
+ (client-proof (cl-map 'string 'logxor client-key client-signature))
+ (client-final-message
+ (concat client-final-message-without-proof ","
+ "p=" (base64-encode-string client-proof))))
+ (sasl-client-set-property client 'auth-message auth-message)
+ (sasl-client-set-property client 'salted-password salted-password)
+ client-final-message)))
+
+(defun sasl-scram--authenticate-server (hash-fun block-length hash-length client step)
+ (cond
+ ((string-match "^e=\\([^,]+\\)" (sasl-step-data step))
+ (sasl-error (format "Server error: %s" (match-string 1 (sasl-step-data step)))))
+ ((string-match "^v=\\([^,]+\\)" (sasl-step-data step))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (verifier (base64-decode-string (match-string 1 (sasl-step-data step))))
+ (auth-message (sasl-client-property client 'auth-message))
+ (salted-password (sasl-client-property client 'salted-password))
+ (server-key (funcall hmac-fun "Server Key" salted-password))
+ (expected-server-signature
+ (funcall hmac-fun (encode-coding-string auth-message 'utf-8) server-key)))
+ (unless (string= expected-server-signature verifier)
+ (sasl-error "Server not authenticated"))))
+ (t
+ (sasl-error "Invalid response from server"))))
+
+(provide 'sasl-scram-rfc)
+;;; sasl-scram-rfc.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 03a8f72..adb13b9 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
- '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM" "SCRAM-MD5"))
+ '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
+ "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
@@ -45,7 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
- ("SCRAM-MD5" sasl-scram)))
+ ("SCRAM-SHA-1" sasl-scram-sha-1)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
diff --git a/test/ChangeLog b/test/ChangeLog
index 6e2f891..cc57b47 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,7 @@
+2014-10-09 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * automated/sasl-scram-rfc-tests.el: New file.
+
2014-07-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
* automated/python-tests.el (python-indent-block-enders-1)
diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/automated/sasl-scram-rfc-tests.el
new file mode 100644
index 0000000..c747e5f
--- /dev/null
+++ b/test/automated/sasl-scram-rfc-tests.el
@@ -0,0 +1,50 @@
+;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Test cases from RFC 5802.
+
+;;; Code:
+
+(require 'sasl)
+(require 'sasl-scram-rfc)
+
+(ert-deftest sasl-scram-sha-1-test ()
+ ;; The following strings are taken from section 5 of RFC 5802.
+ (let ((client
+ (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-1"))
+ "user"
+ "imap"
+ "localhost"))
+ (data "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096")
+ (c-nonce "fyko+d2lbbFgONRv9qkxdawL")
+ (sasl-read-passphrase
+ (lambda (_prompt) (copy-sequence "pencil"))))
+ (sasl-client-set-property client 'c-nonce c-nonce)
+ (should
+ (equal
+ (sasl-scram-sha-1-client-final-message client (vector nil data))
+ "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts="))
+
+ ;; This should not throw an error:
+ (sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=
+"))))
+
+;;; sasl-scram-rfc-tests.el ends here
--
2.0.1
^ permalink raw reply related [flat|nested] 9+ messages in thread