From: Magnus Henoch Date: Fri, 13 Feb 2015 08:54:57 +0000 (+1100) Subject: Implement SCRAM-SHA-1 SASL mechanism X-Git-Tag: emacs-25.0.90~2564^2~388 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e7d21b4ab11e73c709420eeeb32ffe2421fafe98;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8393009c061..02a7c3a7e9c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2015-02-13 Magnus Henoch + + * 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 * net/shr.el (shr-tag-li): Speed up rendering pages with lots of diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el new file mode 100644 index 00000000000..3d86da43f35 --- /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 + +;; 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 . + +;;; 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 648e6227497..e59ed5d43aa 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 979214c45da..29b7c7d59ea 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2015-02-13 Magnus Henoch + + * automated/sasl-scram-rfc-tests.el: New file. + 2015-02-11 Nicolas Petton * automated/seq-tests.el (test-seq-reverse, test-seq-group-by): diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/automated/sasl-scram-rfc-tests.el new file mode 100644 index 00000000000..c747e5f65c3 --- /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 + +;; 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 . + +;;; 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