* sasl.el (sasl-scram-md5-client-msg-2): Erase insecure sequences.
(TopLevel): Add example for `scram-md5'.
* scram.el (scram-md5-make-server-msg-2): Rename from `scram-md5-authenticate-server'.
(scram-md5-make-salted-pass): Don't erase passphrase.
(scram-make-unique-nonce): Erase unique-id.
(scram-md5-make-client-msg-1): Erase nonce.
(scram-md5-make-shared-key): Erase buffer.
(scram-md5-make-server-msg-2): Ditto.
1999-12-01 Kenichi OKADA <okada@opaopa.org>
+ * smtp.el (smtp-auth-scram-md5): Erase insecure sequences.
+ * sasl.el (sasl-scram-md5-client-msg-2): Erase insecure sequences.
+ (TopLevel): Add example for `scram-md5'.
+ * scram.el (scram-md5-make-server-msg-2): Rename from `scram-md5-authenticate-server'.
+ (scram-md5-make-salted-pass): Don't erase passphrase.
+ (scram-make-unique-nonce): Erase unique-id.
+ (scram-md5-make-client-msg-1): Erase nonce.
+ (scram-md5-make-shared-key): Erase buffer.
+ (scram-md5-make-server-msg-2): Ditto.
+
+1999-12-01 Kenichi OKADA <okada@opaopa.org>
+
* smtp.el (smtp-auth-scram-md5): New function.
(smtp-authentication-method-alist): Add `scram-md5'.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
+;; Example.
+;;
+;; (base64-encode-string
+;; (sasl-scram-md5-client-msg-2
+;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
+;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
+;; (scram-md5-make-salted-pass
+;; "secret stuff" "testsalt")))
+;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs="
+;;
+;; (base64-encode-string
+;; (scram-md5-make-server-msg-2
+;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
+;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
+;; (scram-make-security-info nil t 0)
+;; "testsalt"
+;; (scram-md5-make-salted-pass
+;; "secret stuff" "testsalt")))
+;; => "U0odqYw3B7XIIW0oSz65OQ=="
+
;;; Code:
(require 'hmac-md5)
(defun sasl-scram-md5-client-msg-1 (authenticate-id &optional authorize-id)
(scram-md5-make-client-msg-1 authenticate-id authorize-id))
-(defun sasl-scram-md5-client-msg-2 (server-msg-1 client-msg-1 passphrase)
- (let (client-key)
- (scram-md5-make-client-msg-2
- sasl-scram-md5-client-security-info
- (scram-md5-make-client-proof
- (setq client-key
- (scram-md5-make-client-key
- (scram-md5-make-salted-pass
- passphrase
- (car ; salt
- (scram-md5-parse-server-msg-1 server-msg-1)))))
- (scram-md5-make-shared-key
- server-msg-1
- client-msg-1
- sasl-scram-md5-client-security-info
- (scram-md5-make-client-verifier client-key))))))
-
-(defun sasl-scram-md5-authenticate-server (server-msg-1
+(defun sasl-scram-md5-client-msg-2 (server-msg-1 client-msg-1 salted-pass)
+ (let (client-proof client-key shared-key client-verifier)
+ (setq client-key
+ (scram-md5-make-client-key salted-pass))
+ (setq client-verifier
+ (scram-md5-make-client-verifier client-key))
+ (setq shared-key
+ (unwind-protect
+ (scram-md5-make-shared-key
+ server-msg-1
+ client-msg-1
+ sasl-scram-md5-client-security-info
+ client-verifier)
+ (fillarray client-verifier 0)))
+ (setq client-proof
+ (unwind-protect
+ (scram-md5-make-client-proof
+ client-key shared-key)
+ (fillarray client-key 0)
+ (fillarray shared-key 0)))
+ (unwind-protect
+ (scram-md5-make-client-msg-2
+ sasl-scram-md5-client-security-info
+ client-proof)
+ (fillarray client-proof 0))))
+
+(defun sasl-scram-md5-authenticate-server (server-msg-1
server-msg-2
client-msg-1
- passphrase)
- (scram-md5-authenticate-server
- server-msg-1
- server-msg-2
- client-msg-1
- sasl-scram-md5-client-security-info
- (car ; salt
- (scram-md5-parse-server-msg-1 server-msg-1))
- (scram-md5-make-salted-pass
- passphrase
- (car ; salt
- (scram-md5-parse-server-msg-1 server-msg-1)))))
+ salted-pass)
+ (string= server-msg-2
+ (scram-md5-make-server-msg-2
+ server-msg-1
+ client-msg-1
+ sasl-scram-md5-client-security-info
+ (car
+ (scram-md5-parse-server-msg-1 server-msg-1))
+ salted-pass)))
;;; unique-ID
(defun sasl-number-base36 (num len)
;; 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).
;; base64-encode responses in IMAP4 AUTHENTICATE command.
;;
;; Passphrase should be longer than 16 bytes. (See RFC 2195)
+
+;; Examples.
+;;
+;; (scram-make-security-info nil t 0)
+;; => "^A^@^@^@"
;;
-;; TODO: Provide higher-level (SASL) APIs.
;;; Code:
(defun scram-make-unique-nonce () ; 8*OCTET, globally unique.
;; For example, concatenated string of process-identifier, system-clock,
;; sequence-number, random-number, and domain-name.
- (concat "<" (sasl-unique-id) "@" (system-name) ">"))
-
+ (let (id)
+ (unwind-protect
+ (concat "<"
+ (setq id (sasl-unique-id))
+ "@" (system-name) ">")
+ (fillarray id 0))))
+
(defun scram-xor-string (str1 str2)
;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
(let* ((len (length str1))
(defun scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id)
"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" (scram-make-unique-nonce)))
+ (let (nonce)
+ (unwind-protect
+ (concat authorize-id "\0" authenticate-id "\0"
+ (setq nonce (scram-make-unique-nonce)))
+ (fillarray nonce 0))))
(defun scram-md5-parse-server-msg-1 (server-msg-1)
"Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
12 (1- (match-end 0))))))
(defun scram-md5-make-salted-pass (passphrase salt)
- (unwind-protect
- (hmac-md5 salt passphrase)
- ;; immediately erase plaintext passphrase from memory.
- ;; (fillarray passphrase 0)))
- ))
+ (hmac-md5 salt passphrase))
(defun scram-md5-make-client-key (salted-pass)
(md5-binary salted-pass))
client-msg-1
client-security-info
client-verifier)
- (hmac-md5 (concat 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 scram-md5-make-client-proof (client-key shared-key)
(scram-xor-string client-key shared-key))
(defun scram-md5-make-client-msg-2 (client-security-info client-proof)
(concat client-security-info client-proof))
-(defun scram-md5-authenticate-server (server-msg-1
- server-msg-2
- client-msg-1
- client-security-info
- salt salted-pass)
- (string= (hmac-md5 (concat client-msg-1 server-msg-1 client-security-info)
- (hmac-md5 salt salted-pass))
- server-msg-2))
+(defun scram-md5-make-server-msg-2 (server-msg-1
+ client-msg-1
+ client-security-info
+ salt salted-pass)
+ (let (buff server-salt)
+ (setq server-salt
+ (hmac-md5 salt salted-pass))
+ (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))))
(provide 'scram-md5)
(defun smtp-auth-scram-md5 (process)
;; now tesing
- (let ((secure-word (copy-sequence smtp-authentication-passphrase))
- server-msg-1 server-msg-2 client-msg-1
- response)
+ (let (server-msg-1 server-msg-2 client-msg-1 salted-pass
+ response secure-word)
(smtp-send-command process "AUTH SCRAM-MD5")
(setq response (smtp-read-response process))
(if (or (null (car response))
(not (integerp (car response)))
(>= (car response) 400))
- (progn
- (fillarray secure-word 0)
- (throw 'done (car (cdr response)))))
- (smtp-send-command
- process
- (base64-encode-string
- (setq client-msg-1
- (sasl-scram-md5-client-msg-1 user))) t)
+ (throw 'done (car (cdr response))))
+ (unwind-protect
+ (smtp-send-command
+ process
+ (setq secure-word
+ (base64-encode-string
+ (setq client-msg-1
+ (sasl-scram-md5-client-msg-1
+ smtp-authentication-user)))) t)
+ (fillarray secure-word 0))
(setq response (smtp-read-response process))
(if (or (null (car response))
(not (integerp (car response)))
(>= (car response) 400))
- (progn
- (fillarray secure-word 0)
+ (progn
(fillarray client-msg-1 0)
(throw 'done (car (cdr response)))))
+ (setq secure-word
+ (unwind-protect
+ (substring (car (cdr response)) 4)
+ (fillarray (car (cdr response)) 0)))
(setq server-msg-1
- (base64-decode-string
- (substring (car (cdr response)) 4)))
- (smtp-send-command
- process
- (base64-encode-string
- (sasl-scram-md5-client-msg-2
- server-msg-1
- client-msg-1
- secure-word)) t)
+ (unwind-protect
+ (base64-decode-string secure-word)
+ (fillarray secure-word 0)))
+ (setq secure-word
+ (sasl-scram-md5-client-msg-2
+ server-msg-1 client-msg-1
+ (setq salted-pass
+ (scram-md5-make-salted-pass
+ smtp-authentication-passphrase
+ (car
+ (scram-md5-parse-server-msg-1 server-msg-1))))))
+ (setq secure-word
+ (unwind-protect
+ (base64-encode-string secure-word)
+ (fillarray secure-word 0)))
+ (unwind-protect
+ (smtp-send-command process secure-word t)
+ (fillarray secure-word 0))
(setq response (smtp-read-response process))
(if (or (null (car response))
(not (integerp (car response)))
(>= (car response) 400))
(progn
- (fillarray secure-word 0)
+ (fillarray salted-pass 0)
(fillarray server-msg-1 0)
(fillarray client-msg-1 0)
(throw 'done (car (cdr response)))))
(setq server-msg-2
- (base64-decode-string
- (substring (car (cdr response)) 4)))
- (if (null (prog1
- (sasl-scram-md5-authenticate-server
- server-msg-1
- server-msg-2
- client-msg-1
- secure-word)
- (fillarray secure-word 0)
- (fillarray server-msg-1 0)
- (fillarray server-msg-2 0)
- (fillarray client-msg-1 0)))
+ (unwind-protect
+ (base64-decode-string
+ (setq secure-word
+ (substring (car (cdr response)) 4)))
+ (fillarray secure-word 0)))
+ (if (null
+ (unwind-protect
+ (sasl-scram-md5-authenticate-server
+ server-msg-1
+ server-msg-2
+ client-msg-1
+ salted-pass)
+ (fillarray salted-pass 0)
+ (fillarray server-msg-1 0)
+ (fillarray server-msg-2 0)
+ (fillarray client-msg-1 0)))
(throw 'done nil))
(smtp-send-command process "")
(setq response (smtp-read-response process))
projects / elisp / flim.git / commitdiff