261 lines
8.7 KiB
EmacsLisp
261 lines
8.7 KiB
EmacsLisp
;;; sasl-scram.el --- Compute SCRAM-MD5.
|
|
|
|
;; Copyright (C) 1999 Shuhei KOBAYASHI
|
|
|
|
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
|
|
;; Kenichi OKADA <okada@opaopa.org>
|
|
;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
|
|
|
|
;; This file is part of FLIM (Faithful Library about Internet Message).
|
|
|
|
;; This program 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 2, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program 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 this program; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This program is implemented from draft-newman-auth-scram-03.txt.
|
|
;;
|
|
;; It is caller's responsibility to base64-decode challenges and
|
|
;; base64-encode responses in IMAP4 AUTHENTICATE command.
|
|
;;
|
|
;; Passphrase should be longer than 16 bytes. (See RFC 2195)
|
|
|
|
;; Examples.
|
|
;;
|
|
;; (sasl-scram-md5-make-security-info nil t 0)
|
|
;; => "^A^@^@^@"
|
|
;;
|
|
;; (base64-encode-string
|
|
;; (sasl-scram-md5-make-client-msg-2
|
|
;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
|
|
;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
|
|
;; (sasl-scram-md5-make-salted-pass
|
|
;; "secret stuff" "testsalt")
|
|
;; (sasl-scram-md5-make-security-info nil t 0)))
|
|
;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs="
|
|
;;
|
|
;; (base64-encode-string
|
|
;; (sasl-scram-md5-make-server-msg-2
|
|
;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
|
|
;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
|
|
;; (sasl-scram-md5-make-security-info nil t 0)
|
|
;; "testsalt"
|
|
;; (sasl-scram-md5-make-salted-pass
|
|
;; "secret stuff" "testsalt")))
|
|
;; => "U0odqYw3B7XIIW0oSz65OQ=="
|
|
|
|
;;; Code:
|
|
|
|
(require 'sasl)
|
|
(require 'hmac-md5)
|
|
|
|
(defvar sasl-scram-md5-unique-id-function
|
|
sasl-unique-id-function)
|
|
|
|
(defconst sasl-scram-md5-steps
|
|
'(ignore ;no initial response
|
|
sasl-scram-md5-response-1
|
|
sasl-scram-md5-response-2
|
|
sasl-scram-md5-authenticate-server))
|
|
|
|
(defmacro sasl-scram-md5-security-info-no-security-layer (security-info)
|
|
`(eq (logand (aref ,security-info 0) 1) 1))
|
|
(defmacro sasl-scram-md5-security-info-integrity-protection-layer (security-info)
|
|
`(eq (logand (aref ,security-info 0) 2) 2))
|
|
(defmacro sasl-scram-md5-security-info-buffer-size (security-info)
|
|
`(let ((ssecinfo ,security-info))
|
|
(+ (lsh (aref ssecinfo 1) 16)
|
|
(lsh (aref ssecinfo 2) 8)
|
|
(aref ssecinfo 3))))
|
|
|
|
(defun sasl-scram-md5-make-security-info (integrity-protection-layer
|
|
no-security-layer buffer-size)
|
|
(let ((csecinfo (make-string 4 0)))
|
|
(when integrity-protection-layer
|
|
(aset csecinfo 0 2))
|
|
(if no-security-layer
|
|
(aset csecinfo 0 (logior (aref csecinfo 0) 1))
|
|
(aset csecinfo 1
|
|
(lsh (logand buffer-size (lsh 255 16)) -16))
|
|
(aset csecinfo 2
|
|
(lsh (logand buffer-size (lsh 255 8)) -8))
|
|
(aset csecinfo 3 (logand buffer-size 255)))
|
|
csecinfo))
|
|
|
|
(defun sasl-scram-md5-make-unique-nonce () ; 8*OCTET, globally unique.
|
|
;; For example, concatenated string of process-identifier, system-clock,
|
|
;; sequence-number, random-number, and domain-name.
|
|
(let* ((sasl-unique-id-function sasl-scram-md5-unique-id-function)
|
|
(id (sasl-unique-id)))
|
|
(unwind-protect
|
|
(concat "<" id "@" (system-name) ">")
|
|
(fillarray id 0))))
|
|
|
|
(defun sasl-scram-md5-xor-string (str1 str2)
|
|
;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
|
|
(let* ((len (length str1))
|
|
(dst (make-string len 0))
|
|
(pos 0))
|
|
(while (< pos len)
|
|
(aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
|
|
(setq pos (1+ pos)))
|
|
dst))
|
|
|
|
(defun sasl-scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id nonce)
|
|
"Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
|
|
If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
|
|
(concat authorize-id "\0" authenticate-id "\0"
|
|
(or nonce
|
|
(sasl-scram-md5-make-unique-nonce))))
|
|
|
|
(defun sasl-scram-md5-parse-server-msg-1 (server-msg-1)
|
|
"Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
|
|
(if (and (> (length server-msg-1) 16)
|
|
(eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
|
|
(list (substring server-msg-1 0 8) ; salt
|
|
(substring server-msg-1 8 12) ; server-security-info
|
|
(substring server-msg-1 ; service-id
|
|
12 (1- (match-end 0))))
|
|
(sasl-error (format "Unexpected response: %s" server-msg-1))))
|
|
|
|
(defun sasl-scram-md5-server-salt (server-msg-1)
|
|
(car (sasl-scram-md5-parse-server-msg-1 server-msg-1)))
|
|
|
|
(defun sasl-scram-md5-make-salted-pass (passphrase salt)
|
|
(hmac-md5 salt passphrase))
|
|
|
|
(defun sasl-scram-md5-make-client-key (salted-pass)
|
|
(md5-binary salted-pass))
|
|
|
|
(defun sasl-scram-md5-make-client-verifier (client-key)
|
|
(md5-binary client-key))
|
|
|
|
(defun sasl-scram-md5-make-shared-key (server-msg-1
|
|
client-msg-1
|
|
client-security-info
|
|
client-verifier)
|
|
(let (buff)
|
|
(unwind-protect
|
|
(hmac-md5
|
|
(setq buff
|
|
(concat server-msg-1 client-msg-1 client-security-info))
|
|
client-verifier)
|
|
(fillarray buff 0))))
|
|
|
|
(defun sasl-scram-md5-make-client-proof (client-key shared-key)
|
|
(sasl-scram-md5-xor-string client-key shared-key))
|
|
|
|
(defun sasl-scram-md5-make-client-msg-2 (server-msg-1
|
|
client-msg-1
|
|
salted-pass
|
|
client-security-info)
|
|
(let (client-proof client-key shared-key client-verifier)
|
|
(setq client-key
|
|
(sasl-scram-md5-make-client-key salted-pass))
|
|
(setq client-verifier
|
|
(sasl-scram-md5-make-client-verifier client-key))
|
|
(setq shared-key
|
|
(unwind-protect
|
|
(sasl-scram-md5-make-shared-key
|
|
server-msg-1
|
|
client-msg-1
|
|
client-security-info
|
|
client-verifier)
|
|
(fillarray client-verifier 0)))
|
|
(setq client-proof
|
|
(unwind-protect
|
|
(sasl-scram-md5-make-client-proof
|
|
client-key shared-key)
|
|
(fillarray client-key 0)
|
|
(fillarray shared-key 0)))
|
|
(unwind-protect
|
|
(concat
|
|
client-security-info
|
|
client-proof)
|
|
(fillarray client-proof 0))))
|
|
|
|
(defun sasl-scram-md5-make-server-msg-2 (server-msg-1
|
|
client-msg-1
|
|
client-security-info
|
|
salt salted-pass)
|
|
(let ((server-salt
|
|
(hmac-md5 salt salted-pass))
|
|
buff)
|
|
(unwind-protect
|
|
(hmac-md5
|
|
(setq buff
|
|
(concat
|
|
client-msg-1
|
|
server-msg-1
|
|
client-security-info))
|
|
server-salt)
|
|
(fillarray server-salt 0)
|
|
(fillarray buff 0))))
|
|
|
|
(defun sasl-scram-md5-response-1 (client step)
|
|
(sasl-client-set-property
|
|
client 'client-msg-1
|
|
(sasl-scram-md5-make-client-msg-1
|
|
(sasl-client-name client)
|
|
(sasl-client-property client 'authorize-id)
|
|
(sasl-client-property client 'nonce))))
|
|
|
|
(defun sasl-scram-md5-response-2 (client step)
|
|
(let* ((server-msg-1
|
|
(sasl-client-set-property
|
|
client 'server-msg-1
|
|
(sasl-step-data step)))
|
|
(salted-pass
|
|
(sasl-client-set-property
|
|
client 'salted-pass
|
|
(sasl-scram-md5-make-salted-pass
|
|
(sasl-read-passphrase
|
|
(format "SCRAM-MD5 passphrase for %s: "
|
|
(sasl-client-name client)))
|
|
(sasl-scram-md5-server-salt server-msg-1)))))
|
|
(sasl-client-set-property
|
|
client 'client-msg-2
|
|
(sasl-scram-md5-make-client-msg-2
|
|
server-msg-1
|
|
(sasl-client-property client 'client-msg-1)
|
|
salted-pass
|
|
(or (sasl-client-property client 'client-security-info)
|
|
(sasl-scram-md5-make-security-info nil t 0))))))
|
|
|
|
(defun sasl-scram-md5-authenticate-server (client step)
|
|
(let ((server-msg-2
|
|
(sasl-client-set-property
|
|
client 'server-msg-2
|
|
(sasl-step-data step)))
|
|
(server-msg-1
|
|
(sasl-client-property client 'server-msg-1)))
|
|
(if (string= server-msg-2
|
|
(sasl-scram-md5-make-server-msg-2
|
|
server-msg-1
|
|
(sasl-client-property client 'client-msg-1)
|
|
(or (sasl-client-property client 'client-security-info)
|
|
(sasl-scram-md5-make-security-info nil t 0))
|
|
(sasl-scram-md5-server-salt server-msg-1)
|
|
(sasl-client-property client 'salted-pass)))
|
|
" "
|
|
(sasl-error "SCRAM-MD5: authenticate server failed."))))
|
|
|
|
(put 'sasl-scram 'sasl-mechanism
|
|
(sasl-make-mechanism "SCRAM-MD5" sasl-scram-md5-steps))
|
|
|
|
(provide 'sasl-scram)
|
|
|
|
;;; sasl-scram.el ends here
|