Add SASL SCRAM-SHA-256 support.

* lisp/net/sasl.el (sasl-mechanisms): Add SCRAM-SHA-256.
(sasl-mechanism-alist): Ditto.
* lisp/net/sasl-scram-sha256.el: New file.
* tests/lisp/net/sasl-scram-rfc-tests.el (sasl-scram-sha-256-test):
New function.
parent 125bc5b1
Pipeline #4567 passed with stage
in 54 minutes and 22 seconds
;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Simon Josefsson <>
;; Package: sasl
;; 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
;; 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:
;; Implement the SCRAM-SHA-256 mechanism from RFC 7677.
;;; Code:
(require 'cl-lib)
(require 'sasl)
(require 'hex-util)
(require 'rfc2104)
(require 'sasl-scram-rfc)
;;; SCRAM-SHA-256
(defconst sasl-scram-sha-256-steps
(defun sasl-scram-sha256 (object &optional start end binary)
(secure-hash 'sha256 object start end binary))
(defun sasl-scram-sha-256-client-final-message (client step)
;; HMAC-SHA256 uses block length 64 and hash length 32; see RFC 4634.
'sasl-scram-sha256 64 32 client step))
(defun sasl-scram-sha-256-authenticate-server (client step)
'sasl-scram-sha256 64 32 client step))
(put 'sasl-scram-sha256 'sasl-mechanism
(sasl-make-mechanism "SCRAM-SHA-256" sasl-scram-sha-256-steps))
(provide 'sasl-scram-sha256)
;;; sasl-scram-sha256.el ends here
......@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
......@@ -45,6 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
("SCRAM-SHA-256" sasl-scram-sha256)
("SCRAM-SHA-1" sasl-scram-rfc)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*-
;;; sasl-scram-rfc-tests.el --- tests for SCRAM -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
......@@ -19,7 +19,7 @@
;;; Commentary:
;; Test cases from RFC 5802.
;; Test cases from RFC 5802 and RFC 7677.
;;; Code:
......@@ -47,4 +47,26 @@
(sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=
(require 'sasl-scram-sha256)
(ert-deftest sasl-scram-sha-256-test ()
;; The following strings are taken from section 3 of RFC 7677.
(let ((client
(sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-256"))
(data "r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096")
(c-nonce "rOprNGfwEbeRWgbNEkqO")
(lambda (_prompt) (copy-sequence "pencil"))))
(sasl-client-set-property client 'c-nonce c-nonce)
(sasl-scram-sha-256-client-final-message client (vector nil data))
;; This should not throw an error:
(sasl-scram-sha-256-authenticate-server client (vector nil "v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4="))))
;;; sasl-scram-rfc-tests.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment