X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=digest-md5.el;h=cb4d69743661079da98cad86597a69b276ac5727;hb=25a10e811f146d5af48fec3ee8295c380a46cae2;hp=bd090fcbbe1e975d4a5434247321689520ca0e09;hpb=bb18567ad6fec2d61a9b583a0183b70b67b24c7f;p=elisp%2Fflim.git

diff --git a/digest-md5.el b/digest-md5.el
index bd090fc..cb4d697 100644
--- a/digest-md5.el
+++ b/digest-md5.el
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1999 Kenichi OKADA
 
 ;; Author: Kenichi OKADA <okada@opaopa.org>
+;;	Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
 ;; Keywords: DIGEST-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).
@@ -24,8 +25,6 @@
 
 ;;; Commentary:
 
-;; NOW BUILDING.
-
 ;; This program is implemented from draft-leach-digest-sasl-05.txt.
 ;;
 ;; It is caller's responsibility to base64-decode challenges and
@@ -35,57 +34,47 @@
 
 ;; Examples.
 ;;
-;; (digest-md5-digest-response "chris" "elwood.innosoft.com"
-;; 			  "OA6MG9tEQGm2hh" "OA6MHXh6VqTrRk"
-;; 			  "imap/elwood.innosoft.com"
-;;  			  "d388dad90d4bbd760a152321f2143af7"
-;; 			  1 "auth" nil "utf-8")
-;; => "charset=utf-8,username=\"chris\",realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",nc=00000001,cnonce=\"OA6MHXh6VqTrRk\",digest-uri=\"imap/elwood.innosoft.com\",response=d388dad90d4bbd760a152321f2143af7,qop=auth"
-;;
+;; (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)
+
+;; (digest-md5-build-response-value
+;;   "chris" "secret" "OA6MHXh6VqTrRk" "imap/elwood.innosoft.com")
+;; => "d388dad90d4bbd760a152321f2143af7"
 
 ;;; Code:
 
 (require 'hmac-md5)
 (require 'unique-id)
 
+(defvar digest-md5-challenge nil)
+(defvar digest-md5-nonce-count 1)
+
+(defvar 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.")
+
+;;;###autoload
 (defun digest-md5-parse-digest-challenge (digest-challenge)
-  ;; return list of 
+  ;; return a property list of 
   ;; (realm nonce qop-options stale maxbuf charset 
   ;; algorithm cipher-opts auth-param).
-  (let (realm nonce qop-options stale maxbuf charset 
-	      algorithm cipher-opts auth-param
-	      challenges challenge)
-    (setq challenges
-	  (split-string digest-challenge ","))
-    (while (car challenges)
-      (if (null (string-match
-		 "\\([a-z]+\\)=\"?\\(.+\\)\"?" (car challenges)))
-	  (error "Parse error in digest-challenge1."))
-      (setq challenge (cons
-		       (match-string 1 (car challenges))
-		       (match-string 2 (car challenges))))
-      (cond
-       ((string= (car challenge) "realm")
-	(setq realm (cdr challenge)))
-       ((string= (car challenge) "nonce")
-	(setq nonce (cdr challenge)))
-       ((string= (car challenge) "qop")
-	(setq qop-options  (cdr challenge)))
-       ((string= (car challenge) "stale")
-	(setq stale (cdr challenge)))
-       ((string= (car challenge) "maxbuf")
-	(setq maxbuf (cdr challenge)))
-       ((string= (car challenge) "charset")
-	(setq charset (cdr challenge)))
-       ((string= (car challenge) "algorithm")
-	(setq algorithm (cdr challenge)))
-       ((string= (car challenge) "cipher")
-	(setq cipher-opts (cdr challenge)))
-       (t
-	(error "Parse error in digest-challenge.")))
-  (setq challenges (cdr challenges)))
-    (list realm nonce qop-options stale maxbuf charset 
-	  algorithm cipher-opts auth-param)))
+  (with-temp-buffer
+    (set-syntax-table 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 'digest-md5-challenge (read (point-min-marker)))
+      (end-of-file
+       (error "Parse error in digest-challenge.")))))
 
 (defun digest-md5-digest-uri (serv-type host &optional serv-name)
   (concat serv-type "/" host
@@ -93,36 +82,60 @@
 		   (null (string= host serv-name)))
 	      (concat "/" serv-name))))
 
-(defun digest-md5-cnonce ()
+(defmacro digest-md5-cnonce ()
   ;; It is RECOMMENDED that it 
   ;; contain at least 64 bits of entropy.
-  (concat (unique-id-m "") (unique-id-m "")))
-
-(defun digest-md5-digest-response (username 
-				   realm nonce cnonce
-				   digest-uri response 
-				   &optional nonce-count qop 
-				   maxbuf charset cipher authzid)
-  (concat
-   (if charset
-       (concat "charset=" charset ","))
-   "username=\"" username "\""
-   ",realm=\"" realm "\""
-   ",nonce=\"" nonce "\""
-   (format ",nc=%08x"
-	   (or nonce-count 1))
-   ",cnonce=\"" cnonce "\""
-   ",digest-uri=\"" digest-uri "\""
-   ",response=" response
-   (if qop
-       (concat ",qop=" qop))
-   (if maxbuf
-       (concat ",maxbuf=" maxbuf))
-   (if cipher
-       (concat ",cipher=" cipher))
-   (if authzid
-       (concat ",authzid=\"" authzid "\""))))
-
+  '(concat (unique-id-m "") (unique-id-m "")))
+
+(defmacro digest-md5-challenge (prop)
+  (list 'get ''digest-md5-challenge prop))
+
+(defmacro digest-md5-build-response-value 
+  (username passwd cnonce digest-uri qop)
+  `(encode-hex-string
+    (md5-binary
+     (concat
+      (encode-hex-string
+       (md5-binary (concat (md5-binary 
+			    (concat ,username 
+				    ":" (digest-md5-challenge 'realm)
+				    ":" ,passwd))
+			   ":" (digest-md5-challenge 'nonce)
+			   ":" ,cnonce
+			   (let ((authzid (digest-md5-challenge 'authzid)))
+			     (if authzid (concat ":" authzid) nil)))))
+      ":" (digest-md5-challenge 'nonce)
+      ":" (format "%08x" digest-md5-nonce-count) ":" ,cnonce ":" ,qop ":"
+      (encode-hex-string
+       (md5-binary
+	(concat "AUTHENTICATE:" ,digest-uri
+		(if (string-equal "auth-int" ,qop)
+		    ":00000000000000000000000000000000"
+		  nil))))))))
+
+;;;###autoload
+(defun digest-md5-digest-response (username passwd digest-uri &optional qop)
+  (let ((cnonce (digest-md5-cnonce)))
+    (concat
+     "username=\"" username "\","
+     "realm=\"" (digest-md5-challenge 'realm) "\","
+     "nonce=\"" (digest-md5-challenge 'nonce) "\","
+     (format "nc=%08x," digest-md5-nonce-count)
+     "cnonce=\"" cnonce "\","
+     "digest-uri=\"" digest-uri "\","
+     "response=" 
+     (digest-md5-build-response-value username passwd cnonce digest-uri 
+				      (or qop "auth"))
+     ","
+     (mapconcat 
+      #'identity
+      (delq nil 
+	    (mapcar (lambda (prop)
+		      (if (digest-md5-challenge prop)
+			  (format "%s=%s"
+				  prop (digest-md5-challenge prop))))
+		    '(charset qop maxbuf cipher authzid)))
+      ","))))
   
 (provide 'digest-md5)