Implement SCRAM-SHA-1 SASL mechanism
Fixes: debbugs:17636 * 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.
This commit is contained in:
Magnus Henoch
Lars Magne Ingebrigtsen
parent
f61c87f12a
commit
e7d21b4ab1
5 changed files with 226 additions and 3 deletions
|
|
@ -1,3 +1,12 @@
|
|||
2015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
|
||||
|
||||
* net/sasl-scram-rfc.el: New file.
|
||||
|
||||
* 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 (bug#17636).
|
||||
|
||||
2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* net/shr.el (shr-tag-li): Speed up rendering pages with lots of
|
||||
|
|
|
|||
160
lisp/net/sasl-scram-rfc.el
Normal file
160
lisp/net/sasl-scram-rfc.el
Normal file
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
|
||||
|
||||
* automated/sasl-scram-rfc-tests.el: New file.
|
||||
|
||||
2015-02-11 Nicolas Petton <nicolas@petton.fr>
|
||||
|
||||
* automated/seq-tests.el (test-seq-reverse, test-seq-group-by):
|
||||
|
|
|
|||
50
test/automated/sasl-scram-rfc-tests.el
Normal file
50
test/automated/sasl-scram-rfc-tests.el
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue