--- /dev/null
+;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
+
+;; Copyright (C) 2000 Daiki Ueno
+
+;; Author: Kenichi OKADA <okada@opaopa.org>
+;; Daiki Ueno <ueno@unixuser.org>
+;; Keywords: SASL, DIGEST-MD5
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; This program is implemented from draft-leach-digest-sasl-05.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)
+
+;;; Commentary:
+
+(require 'sasl)
+(require 'hmac-md5)
+
+(defvar sasl-digest-md5-authenticator nil)
+
+(defvar sasl-digest-md5-challenge nil)
+(defvar sasl-digest-md5-nonce-count 1)
+(defvar sasl-digest-md5-unique-id-function
+ sasl-unique-id-function)
+
+(defvar sasl-digest-md5-parse-digest-challenge-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?= "." table)
+ (modify-syntax-entry ?, "." table)
+ table)
+ "A syntax table for parsing digest-challenge attributes.")
+
+(defconst sasl-digest-md5-continuations
+ '(ignore ;no initial response
+ sasl-digest-md5-response
+ ignore)) ;""
+
+(unless (get 'sasl-digest 'sasl-authenticator)
+ (put 'sasl-digest 'sasl-authenticator
+ (sasl-make-authenticator "DIGEST-MD5" sasl-digest-md5-continuations)))
+
+;;; @ low level functions
+;;;
+;;; Examples in `draft-leach-digest-sasl-05.txt'.
+;;;
+;;; (sasl-digest-md5-parse-digest-challenge
+;;; "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",qop=\"auth\",algorithm=md5-sess,charset=utf-8")
+;;; => (realm "elwood.innosoft.com" nonce "OA6MG9tEQGm2hh" qop "auth" algorithm md5-sess charset utf-8)
+
+;;; (sasl-digest-md5-build-response-value
+;;; "chris" "elwood.innosoft.com" "secret" "OA6MG9tEQGm2hh"
+;;; "OA6MHXh6VqTrRk" 1 "imap/elwood.innosoft.com" "auth")
+;;; => "d388dad90d4bbd760a152321f2143af7"
+
+(defun sasl-digest-md5-parse-digest-challenge (digest-challenge)
+ "Return a property list parsed DIGEST-CHALLENGE.
+The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
+charset algorithm cipher-opts auth-param)".
+ (with-temp-buffer
+ (set-syntax-table sasl-digest-md5-parse-digest-challenge-syntax-table)
+ (insert digest-challenge)
+ (goto-char (point-min))
+ (insert "(")
+ (while (progn (forward-sexp) (not (eobp)))
+ (delete-char 1)
+ (insert " "))
+ (insert ")")
+ (condition-case nil
+ (setplist 'sasl-digest-md5-challenge (read (point-min-marker)))
+ (end-of-file
+ (error "Parse error in digest-challenge.")))))
+
+(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
+ (concat serv-type "/" host
+ (if (and serv-name
+ (null (string= host serv-name)))
+ (concat "/" serv-name))))
+
+(defun sasl-digest-md5-cnonce ()
+ (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
+ (sasl-unique-id)))
+
+(defmacro sasl-digest-md5-challenge (prop)
+ (list 'get ''sasl-digest-md5-challenge prop))
+
+(defmacro sasl-digest-md5-build-response-value-1
+ (username realm passwd nonce cnonce nonce-count digest-uri qop)
+ `(encode-hex-string
+ (md5-binary
+ (concat
+ (encode-hex-string
+ (md5-binary (concat (md5-binary
+ (concat ,username
+ ":" ,realm
+ ":" ,passwd))
+ ":" ,nonce
+ ":" ,cnonce
+ (let ((authzid (sasl-digest-md5-challenge 'authzid)))
+ (if authzid (concat ":" authzid) nil)))))
+ ":" ,nonce
+ ":" (format "%08x" ,nonce-count) ":" ,cnonce ":" ,qop ":"
+ (encode-hex-string
+ (md5-binary
+ (concat "AUTHENTICATE:" ,digest-uri
+ (if (string-equal "auth-int" ,qop)
+ ":00000000000000000000000000000000"
+ nil))))))))
+
+(defun sasl-digest-md5-build-response-value
+ (username realm passwd nonce cnonce nonce-count digest-uri
+ &optional charset qop maxbuf cipher authzid)
+ (concat
+ "username=\"" username "\","
+ "realm=\"" realm "\","
+ "nonce=\"" nonce "\","
+ (format "nc=%08x," nonce-count)
+ "cnonce=\"" cnonce "\","
+ "digest-uri=\"" digest-uri "\","
+ "response="
+ (sasl-digest-md5-build-response-value
+ username realm passwd nonce cnonce nonce-count digest-uri
+ (or qop "auth"))
+ ","
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar (lambda (prop)
+ (if (sasl-digest-md5-challenge prop)
+ (format "%s=%s"
+ prop (sasl-digest-md5-challenge prop))))
+ '(charset qop maxbuf cipher authzid)))
+ ",")))
+
+(defun sasl-digest-md5-digest-response (principal challenge)
+ (sasl-digest-md5-parse-digest-challenge (nth 1 challenge))
+ (let ((passphrase
+ (sasl-read-passphrase
+ (format "DIGEST-MD5 passphrase for %s: "
+ (sasl-principal-name-internal principal)))))
+ (unwind-protect
+ (sasl-digest-md5-build-response-value
+ (sasl-principal-name-internal principal)
+ (or (sasl-principal-realm-internal principal)
+ (sasl-digest-md5-challenge 'realm)) ;need to check
+ passphrase
+ (sasl-digest-md5-challenge 'nonce)
+ (sasl-digest-md5-cnonce)
+ sasl-digest-md5-nonce-count
+ (sasl-digest-md5-digest-uri
+ (sasl-principal-service-internal principal)
+ (sasl-principal-server-internal principal)))
+ (fillarray passphrase 0))))
+
+(provide 'sasl-digest)
+
+;;; sasl-digest.el ends here
(require 'poe)
(defvar sasl-mechanisms
- '(("CRAM-MD5" sasl-cram)))
+ '(("CRAM-MD5" sasl-cram)
+ ("DIGEST-MD5" sasl-digest)
+ ("PLAIN" sasl-plain)))
+
+(defvar sasl-unique-id-function #'sasl-unique-id-function)
(defmacro sasl-make-authenticator (mechanism continuations)
`(vector ,mechanism ,continuations))
(defmacro sasl-authenticator-continuations-internal (authenticator)
`(aref ,authenticator 1))
-(defmacro sasl-make-principal (name service server)
- `(vector ,name ,service ,server))
+(defmacro sasl-make-principal (name service server &optional realm)
+ `(vector ,name ,realm ,service ,server))
(defmacro sasl-principal-name-internal (principal)
`(aref ,principal 0))
-(defmacro sasl-principal-service-internal (principal)
+(defmacro sasl-principal-realm-internal (principal)
`(aref ,principal 1))
-(defmacro sasl-principal-server-internal (principal)
+(defmacro sasl-principal-service-internal (principal)
`(aref ,principal 2))
+(defmacro sasl-principal-server-internal (principal)
+ `(aref ,principal 3))
+
(defun sasl-find-authenticator (mechanisms)
"Retrieve an apropriate authenticator object from MECHANISMS hints."
(let (mechanism)
(setq sasl-read-passphrase 'ange-ftp-read-passwd))))
(funcall sasl-read-passphrase prompt))
+(defun sasl-unique-id ()
+ "Compute a data string which must be different each time.
+It contain at least 64 bits of entropy."
+ (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
+
+(defvar sasl-unique-id-char nil)
+
+;; stolen (and renamed) from message.el
+(defun sasl-unique-id-function ()
+ ;; Don't use microseconds from (current-time), they may be unsupported.
+ ;; Instead we use this randomly inited counter.
+ (setq sasl-unique-id-char
+ (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+ ;; (current-time) returns 16-bit ints,
+ ;; and 2^16*25 just fits into 4 digits i base 36.
+ (* 25 25)))
+ (let ((tm (current-time)))
+ (concat
+ (sasl-unique-id-number-base36
+ (+ (car tm)
+ (lsh (% sasl-unique-id-char 25) 16)) 4)
+ (sasl-unique-id-number-base36
+ (+ (nth 1 tm)
+ (lsh (/ sasl-unique-id-char 25) 16)) 4))))
+
+(defun sasl-unique-id-number-base36 (num len)
+ (if (if (< len 0)
+ (<= num 0)
+ (= len 0))
+ ""
+ (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
+ (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+ (% num 36))))))
+
+;;; PLAIN SASL mechanism (RFC2595 Section 6)
+(defconst sasl-plain-continuations
+ '(sasl-plain-response))
+
+(unless (get 'sasl-plain 'sasl-authenticator)
+ (put 'sasl-plain 'sasl-authenticator
+ (sasl-make-authenticator "PLAIN" sasl-plain-continuations)))
+
+(defun sasl-plain-response (principal challenge)
+ (let ((passphrase
+ (sasl-read-passphrase
+ (format "PLAIN passphrase for %s: "
+ (sasl-principal-name-internal principal)))))
+ (unwind-protect
+ (concat "\0" (sasl-principal-name-internal principal) "\0" passphrase)
+ (fillarray passphrase 0))))
+
+(provide 'sasl-plain)
+
(provide 'sasl)
;;; sasl.el ends here
:type 'string
:group 'smtp-extensions)
+(defcustom smtp-sasl-principal-realm smtp-local-domain
+ "Realm name to be used for authorization."
+ :type 'string
+ :group 'smtp-extensions)
+
(defcustom smtp-sasl-mechanisms nil
"List of authentication mechanisms."
:type '(repeat string)
(cdr (assq 'auth (smtp-connection-extensions-internal connection))))
(principal
(sasl-make-principal
- smtp-sasl-principal-name "smtp"
- (smtp-connection-server-internal connection)))
+ smtp-sasl-principal-name
+ "smtp" (smtp-connection-server-internal connection)
+ smtp-sasl-principal-realm))
(authenticator
(sasl-find-authenticator mechanisms))
(mechanism
;; Retrieve the initial response
(sasl-response
(sasl-evaluate-challenge authenticator principal))
- sasl-challenge
response)
(smtp-send-command
process
(if (nth 1 sasl-response)
- (format "AUTH %s %s" mechanism (base64-encode-string (nth 1 sasl-response)))
+ (format "AUTH %s %s" mechanism (base64-encode-string
+ (nth 1 sasl-response) t))
(format "AUTH %s" mechanism)))
(catch 'done
(while t
(setq sasl-response
(sasl-evaluate-challenge
authenticator principal sasl-response))
- (smtp-send-command process (base64-encode-string sasl-response))))))
+ (smtp-send-command process (base64-encode-string
+ (nth 1 sasl-response) t))))))
(defun smtp-primitive-starttls (package)
(let* ((connection
projects / elisp / flim.git / commitdiff