X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=sasl-digest.el;h=9e061b75b49955cdff6284171f357280f93f4e90;hb=0c90a0315e6dedcadf9d43b2d6a50596521606f6;hp=a3804a0007867f65c9f171b9bc0676ce4526edc9;hpb=cfbeb2aa70dd2506c32ce4a2e1d232731a93701d;p=elisp%2Fflim.git diff --git a/sasl-digest.el b/sasl-digest.el index a3804a0..9e061b7 100644 --- a/sasl-digest.el +++ b/sasl-digest.el @@ -1,9 +1,9 @@ ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -;; Copyright (C) 2000 Daiki Ueno +;; Copyright (C) 2000 Free Software Foundation, Inc. -;; Author: Kenichi OKADA -;; Daiki Ueno +;; Author: Daiki Ueno +;; Kenichi OKADA ;; Keywords: SASL, DIGEST-MD5 ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -35,12 +35,11 @@ (require 'sasl) (require 'hmac-md5) -(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 +(defvar sasl-digest-md5-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?, "." table) @@ -52,119 +51,103 @@ sasl-digest-md5-response ignore)) ;"" -;;; @ 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. +(defun sasl-digest-md5-parse-string (string) + "Parse STRING and return a property list. The value is a cons cell of the form \(realm nonce qop-options stale maxbuf charset algorithm cipher-opts auth-param)." - (save-excursion - (with-temp-buffer - (set-syntax-table sasl-digest-md5-parse-digest-challenge-syntax-table) - (insert digest-challenge) + (with-temp-buffer + (set-syntax-table sasl-digest-md5-syntax-table) + (save-excursion + (insert string) (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.")))))) + (read (point-min-marker))))) (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))) + (not (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-1 - 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-response (client step) - (sasl-digest-md5-parse-digest-challenge (sasl-step-data step)) +(defun sasl-digest-md5-response-value (username + realm + nonce + cnonce + nonce-count + qop + digest-uri + authzid) (let ((passphrase (sasl-read-passphrase (format "DIGEST-MD5 passphrase for %s: " - (sasl-client-name client))))) + username)))) (unwind-protect - (sasl-digest-md5-build-response-value - (sasl-client-name client) - (or (sasl-client-property client 'realm) - (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-client-service client) - (sasl-client-server client))) + (encode-hex-string + (md5-binary + (concat + (encode-hex-string + (md5-binary (concat (md5-binary + (concat username ":" realm ":" passphrase)) + ":" nonce ":" cnonce + (if authzid + (concat ":" authzid))))) + ":" nonce + ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" + (encode-hex-string + (md5-binary + (concat "AUTHENTICATE:" digest-uri + (if (member qop '("auth-int" "auth-conf")) + ":00000000000000000000000000000000"))))))) (fillarray passphrase 0)))) +(defun sasl-digest-md5-response (client step) + (let* ((plist + (sasl-digest-md5-parse-string (sasl-step-data step))) + (realm + (or (sasl-client-property client 'realm) + (plist-get plist 'realm))) ;need to check + (nonce-count + (or (sasl-client-property client 'nonce-count) + sasl-digest-md5-nonce-count)) + (qop + (or (sasl-client-property client 'qop) + "auth")) + (digest-uri + (sasl-digest-md5-digest-uri + (sasl-client-service client)(sasl-client-server client))) + (cnonce + (or (sasl-client-property client 'cnonce) + (sasl-digest-md5-cnonce)))) + (sasl-client-set-property client 'nonce-count (1+ nonce-count)) + (unless (string= qop "auth") + (sasl-error (format "Unsupported \"qop-value\": %s" qop))) + (concat + "username=\"" (sasl-client-name client) "\"," + "realm=\"" realm "\"," + "nonce=\"" (plist-get plist 'nonce) "\"," + "cnonce=\"" cnonce "\"," + (format "nc=%08x," nonce-count) + "digest-uri=\"" digest-uri "\"," + "qop=" qop "," + "response=" + (sasl-digest-md5-response-value + (sasl-client-name client) + realm + (plist-get plist 'nonce) + cnonce + nonce-count + qop + digest-uri + (plist-get plist 'authzid))))) + (put 'sasl-digest 'sasl-mechanism (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))