From: ueno Date: Sun, 12 Nov 2000 18:05:10 +0000 (+0000) Subject: Synch with `deisui-1_14'. X-Git-Tag: flim-1_14_0-pre1~17 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=93fbe8430342dc3ab7f3926057d5c0234add7df9;p=elisp%2Fflim.git Synch with `deisui-1_14'. --- diff --git a/ChangeLog b/ChangeLog index ae2500e..f2dd15d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,22 @@ +2000-11-12 Daiki Ueno + + * smtp.el (smtp-primitive-data): Use `beginning-of-line' instead of + `forward-char'. + (smtp-read-response): Don't bind `case-fold-search'. + (smtp-send-data): Don't save excursion. + +2000-11-10 Daiki Ueno + + * sasl-digest.el (sasl-digest-md5-challenge): Abolish. + (sasl-digest-md5-syntax-table): Rename from + `sasl-digest-md5-parse-digest-challenge-syntax-table'. + (sasl-digest-md5-parse-string): Rename from + `sasl-digest-md5-parse-digest-challenge'; only return a property list. + (sasl-digest-md5-challenge): Abolish. + (sasl-digest-md5-build-response-value-1): Abolish. + (sasl-digest-md5-response-value): Define as function. + (sasl-digest-md5-response): Rewrite. + 2000-11-07 Kenichi OKADA * sasl.el (sasl-login-response-1): Fix. diff --git a/sasl-digest.el b/sasl-digest.el index a3804a0..87df5db 100644 --- a/sasl-digest.el +++ b/sasl-digest.el @@ -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,108 @@ 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 (string-equal "auth-int" qop) + ":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)) + (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)) + (concat + "username=\"" (sasl-client-name client) "\"," + "realm=\"" realm "\"," + "nonce=\"" (plist-get plist 'nonce) "\"," + "cnonce=\"" cnonce "\"," + (format "nc=%08x," nonce-count) + "digest-uri=\"" digest-uri "\"," + "response=\"" + (sasl-digest-md5-response-value + (sasl-client-name client) + realm + (plist-get plist 'nonce) + cnonce + nonce-count + (or (plist-get plist 'qop) + "auth") + digest-uri + (plist-get plist 'authzid)) + "\"," + (mapconcat + #'identity + (delq nil + (mapcar (lambda (prop) + (let ((value (sasl-client-property client prop))) + (if value + (format "%s=%s" prop value)))) + '(maxbuf charset cipher authzid))) + ",")))) + (put 'sasl-digest 'sasl-mechanism (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps)) diff --git a/smtp.el b/smtp.el index 7674291..2a979d4 100644 --- a/smtp.el +++ b/smtp.el @@ -308,7 +308,6 @@ of the host to connect to. SERVICE is name of the service desired." (smtp-primitive-data package)) (let ((connection (smtp-find-connection (current-buffer)))) (when (smtp-connection-opened connection) - ;; QUIT (smtp-primitive-quit package) (smtp-close-connection connection))))) @@ -476,7 +475,7 @@ of the host to connect to. SERVICE is name of the service desired." (while (not (eobp)) (smtp-send-data process (buffer-substring (point) (progn (end-of-line)(point)))) - (forward-char))) + (beginning-of-line 2))) (smtp-send-command process ".") (setq response (smtp-read-response process)) (if (/= (car response) 250) @@ -511,8 +510,7 @@ of the host to connect to. SERVICE is name of the service desired." (signal 'smtp-response-error response)) (defun smtp-read-response (process) - (let (case-fold-search - (response-continue t) + (let ((response-continue t) response) (while response-continue (goto-char smtp-read-point) @@ -542,15 +540,11 @@ of the host to connect to. SERVICE is name of the service desired." (process-send-string process "\r\n"))) (defun smtp-send-data (process data) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (setq smtp-read-point (point)) - ;; Escape "." at start of a line. - (if (eq (string-to-char data) ?.) - (process-send-string process ".")) - (process-send-string process data) - (process-send-string process "\r\n"))) + ;; Escape "." at start of a line. + (if (eq (string-to-char data) ?.) + (process-send-string process ".")) + (process-send-string process data) + (process-send-string process "\r\n")) (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
."