From: teranisi Date: Fri, 22 Dec 2000 06:15:57 +0000 (+0000) Subject: * utils/sasl: Sync up with flim-1_14. X-Git-Tag: wl-2_4_1pre~39 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=319ff66d8e61fc9d1f79ddc49148f4064bbfc54e;p=elisp%2Fwanderlust.git * utils/sasl: Sync up with flim-1_14. * utils/sasl/sasl-cram.el: New file. * utils/sasl/sasl-digest.el: New file. * utils/sasl/digest-md5.el: Delete. * utils/sasl/scram-md5.el: Delete. * utils/sasl/unique-id.el: Delete. --- diff --git a/utils/sasl/lisp/digest-md5.el b/utils/sasl/lisp/digest-md5.el deleted file mode 100644 index e72c535..0000000 --- a/utils/sasl/lisp/digest-md5.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; digest-md5.el --- Compute DIGEST-MD5. - -;; Copyright (C) 1999 Kenichi OKADA - -;; Author: Kenichi OKADA -;; Daiki Ueno -;; Keywords: DIGEST-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP - -;; 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. - -;;; Commentary: - -;; 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) - -;; Examples. -;; -;; (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" "elwood.innosoft.com" "secret" "OA6MG9tEQGm2hh" -;; "OA6MHXh6VqTrRk" 1 "imap/elwood.innosoft.com" "auth") -;; => "d388dad90d4bbd760a152321f2143af7" - -;;; Code: - -(require 'hmac-md5) -(require 'unique-id) - -(defvar digest-md5-challenge nil) - -(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 a property list of - ;; (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 - (if (and serv-name - (null (string= host serv-name))) - (concat "/" serv-name)))) - -(defmacro digest-md5-cnonce () - ;; It is RECOMMENDED that it - ;; contain at least 64 bits of entropy. - '(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 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 (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)))))))) - -;;;###autoload -(defun digest-md5-digest-response - (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=" - (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 (digest-md5-challenge prop) - (format "%s=%s" - prop (digest-md5-challenge prop)))) - '(charset qop maxbuf cipher authzid))) - ","))) - -(provide 'digest-md5) - -;;; digest-md5.el ends here diff --git a/utils/sasl/lisp/sasl-cram.el b/utils/sasl/lisp/sasl-cram.el new file mode 100644 index 0000000..25d1082 --- /dev/null +++ b/utils/sasl/lisp/sasl-cram.el @@ -0,0 +1,51 @@ +;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Kenichi OKADA +;; Keywords: SASL, CRAM-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. + +;;; Commentary: + +(require 'sasl) +(require 'hmac-md5) + +(defconst sasl-cram-md5-steps + '(ignore ;no initial response + sasl-cram-md5-response)) + +(defun sasl-cram-md5-response (client step) + (let ((passphrase + (sasl-read-passphrase + (format "CRAM-MD5 passphrase for %s: " + (sasl-client-name client))))) + (unwind-protect + (concat (sasl-client-name client) " " + (encode-hex-string + (hmac-md5 (sasl-step-data step) passphrase))) + (fillarray passphrase 0)))) + +(put 'sasl-cram 'sasl-mechanism + (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps)) + +(provide 'sasl-cram) + +;;; sasl-cram.el ends here diff --git a/utils/sasl/lisp/sasl-digest.el b/utils/sasl/lisp/sasl-digest.el new file mode 100644 index 0000000..9e061b7 --- /dev/null +++ b/utils/sasl/lisp/sasl-digest.el @@ -0,0 +1,156 @@ +;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Kenichi OKADA +;; 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-nonce-count 1) +(defvar sasl-digest-md5-unique-id-function + sasl-unique-id-function) + +(defvar sasl-digest-md5-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-steps + '(ignore ;no initial response + sasl-digest-md5-response + ignore)) ;"" + +(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)." + (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 ")") + (read (point-min-marker))))) + +(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name) + (concat serv-type "/" host + (if (and 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))) + +(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: " + username)))) + (unwind-protect + (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)) + +(provide 'sasl-digest) + +;;; sasl-digest.el ends here diff --git a/utils/sasl/lisp/sasl.el b/utils/sasl/lisp/sasl.el index dd07f13..cc782b9 100644 --- a/utils/sasl/lisp/sasl.el +++ b/utils/sasl/lisp/sasl.el @@ -1,9 +1,9 @@ -;;; sasl.el --- basic functions for SASL +;;; sasl.el --- SASL client framework -;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc. +;; Copyright (C) 2000 Free Software Foundation, Inc. -;; Author: Kenichi OKADA -;; Keywords: SMTP, SASL, RFC2222 +;; Author: Daiki Ueno +;; Keywords: SASL ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -24,133 +24,246 @@ ;;; Commentary: -;; Example. +;; This module provides common interface functions to share several +;; SASL mechanism drivers. The toplevel is designed to be mostly +;; compatible with [Java-SASL]. ;; -;; (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=" +;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)", +;; RFC 2222, October 1997. ;; -;; (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==" +;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program +;; Interface", draft-weltman-java-sasl-03.txt, March 2000. ;;; Code: -(require 'hmac-md5) - -(eval-when-compile - (require 'scram-md5) - (require 'digest-md5)) - -(eval-and-compile - (autoload 'open-ssl-stream "ssl") - (autoload 'base64-decode-string "base64") - (autoload 'base64-encode-string "base64") - (autoload 'starttls-open-stream "starttls") - (autoload 'starttls-negotiate "starttls") - (autoload 'digest-md5-parse-digest-challenge "digest-md5") - (autoload 'digest-md5-digest-response "digest-md5") - (autoload 'scram-md5-make-salted-pass "scram-md5") - (autoload 'scram-md5-parse-server-msg-1 "scram-md5") - (autoload 'scram-md5-make-client-msg-1 "scram-md5")) - -;;; CRAM-MD5 -(defun sasl-cram-md5 (username passphrase challenge) - (let ((secure-word (copy-sequence passphrase))) - (setq secure-word (unwind-protect - (hmac-md5 challenge secure-word) - (fillarray secure-word 0)) - secure-word (unwind-protect - (encode-hex-string secure-word) - (fillarray secure-word 0)) - secure-word (unwind-protect - (concat username " " secure-word) - (fillarray secure-word 0))))) - -;;; PLAIN -(defun sasl-plain (authorid authenid passphrase) - (concat authorid "\0" authenid "\0" passphrase)) - -;;; SCRAM-MD5 -(defvar sasl-scram-md5-client-security-info - (eval-when-compile - (scram-make-security-info nil t 0))) - -(defun sasl-scram-md5-make-salted-pass (server-msg-1 passphrase) - (scram-md5-make-salted-pass - passphrase - (car - (scram-md5-parse-server-msg-1 server-msg-1)))) - -(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 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))) +(defvar sasl-mechanisms + '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS")) + +(defvar sasl-mechanism-alist + '(("CRAM-MD5" sasl-cram) + ("DIGEST-MD5" sasl-digest) + ("PLAIN" sasl-plain) + ("LOGIN" sasl-login) + ("ANONYMOUS" sasl-anonymous))) + +(defvar sasl-unique-id-function (function sasl-unique-id-function)) + +(put 'sasl-error 'error-message "SASL error") +(put 'sasl-error 'error-conditions '(sasl-error error)) + +(defun sasl-error (datum) + (signal 'sasl-error (list datum))) + +;;; @ SASL client +;;; + +(defun sasl-make-client (mechanism name service server) + "Return a newly allocated SASL client. +NAME is name of the authorization. SERVICE is name of the service desired. +SERVER is the fully qualified host name of the server to authenticate to." + (vector mechanism name service server (make-symbol "sasl-client-properties"))) + +(defun sasl-client-mechanism (client) + "Return the authentication mechanism driver of CLIENT." + (aref client 0)) + +(defun sasl-client-name (client) + "Return the authorization name of CLIENT, a string." + (aref client 1)) + +(defun sasl-client-service (client) + "Return the service name of CLIENT, a string." + (aref client 2)) + +(defun sasl-client-server (client) + "Return the server name of CLIENT, a string." + (aref client 3)) + +(defun sasl-client-set-properties (client plist) + "Destructively set the properties of CLIENT. +The second argument PLIST is the new property list." + (setplist (aref client 4) plist)) + +(defun sasl-client-set-property (client property value) + "Add the given property/value to CLIENT." + (put (aref client 4) property value)) + +(defun sasl-client-property (client property) + "Return the value of the PROPERTY of CLIENT." + (get (aref client 4) property)) + +(defun sasl-client-properties (client) + "Return the properties of CLIENT." + (symbol-plist (aref client 4))) + +;;; @ SASL mechanism +;;; + +(defun sasl-make-mechanism (name steps) + "Make an authentication mechanism. +NAME is a IANA registered SASL mechanism name. +STEPS is list of continuation function." + (vector name + (mapcar + (lambda (step) + (let ((symbol (make-symbol (symbol-name step)))) + (fset symbol (symbol-function step)) + symbol)) + steps))) + +(defun sasl-mechanism-name (mechanism) + "Return name of MECHANISM, a string." + (aref mechanism 0)) + +(defun sasl-mechanism-steps (mechanism) + "Return the authentication steps of MECHANISM, a list of functions." + (aref mechanism 1)) + +(defun sasl-find-mechanism (mechanisms) + "Retrieve an apropriate mechanism object from MECHANISMS hints." + (let* ((sasl-mechanisms sasl-mechanisms) + (mechanism + (catch 'done + (while sasl-mechanisms + (if (member (car sasl-mechanisms) mechanisms) + (throw 'done (nth 1 (assoc (car sasl-mechanisms) + sasl-mechanism-alist)))) + (setq sasl-mechanisms (cdr sasl-mechanisms)))))) + (if mechanism + (require mechanism)) + (get mechanism 'sasl-mechanism))) + +;;; @ SASL authentication step +;;; + +(defun sasl-step-data (step) + "Return the data which STEP holds, a string." + (aref step 1)) + +(defun sasl-step-set-data (step data) + "Store DATA string to STEP." + (aset step 1 data)) + +(defun sasl-next-step (client step) + "Evaluate the challenge and prepare an appropriate next response. +The data type of the value and optional 2nd argument STEP is nil or +opaque authentication step which holds the reference to the next action +and the current challenge. At the first time STEP should be set to nil." + (let* ((steps + (sasl-mechanism-steps + (sasl-client-mechanism client))) + (function + (if (vectorp step) + (nth 1 (memq (aref step 0) steps)) + (car steps)))) + (if function + (vector function (funcall function client step))))) + +(defvar sasl-read-passphrase nil) +(defun sasl-read-passphrase (prompt) + (if (not sasl-read-passphrase) + (if (functionp 'read-passwd) + (setq sasl-read-passphrase 'read-passwd) + (if (load "passwd" t) + (setq sasl-read-passphrase 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (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 (RFC2595 Section 6) +(defconst sasl-plain-steps + '(sasl-plain-response)) + +(defun sasl-plain-response (client step) + (let ((passphrase + (sasl-read-passphrase + (format "PLAIN passphrase for %s: " (sasl-client-name client)))) + (authenticator-name + (sasl-client-property + client 'authenticator-name)) + (name (sasl-client-name client))) (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 - 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))) - -;;; DIGEST-MD5 - -(defvar sasl-digest-md5-nonce-count 1) - -(defun sasl-digest-md5-digest-response (digest-challenge username passwd - serv-type host &optional realm) - (digest-md5-parse-digest-challenge digest-challenge) - (digest-md5-digest-response - username - (or realm (digest-md5-challenge 'realm)) ;; need to check. - passwd - (digest-md5-challenge 'nonce) - (digest-md5-cnonce) - sasl-digest-md5-nonce-count - (digest-md5-digest-uri serv-type host) ;; MX host - )) + (if (and authenticator-name + (not (string= authenticator-name name))) + (concat authenticator-name "\0" name "\0" passphrase) + (concat "\0" name "\0" passphrase)) + (fillarray passphrase 0)))) + +(put 'sasl-plain 'sasl-mechanism + (sasl-make-mechanism "PLAIN" sasl-plain-steps)) + +(provide 'sasl-plain) + +;;; LOGIN (No specification exists) +(defconst sasl-login-steps + '(ignore ;no initial response + sasl-login-response-1 + sasl-login-response-2)) + +(defun sasl-login-response-1 (client step) +;;; (unless (string-match "^Username:" (sasl-step-data step)) +;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) + (sasl-client-name client)) + +(defun sasl-login-response-2 (client step) +;;; (unless (string-match "^Password:" (sasl-step-data step)) +;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) + (sasl-read-passphrase + (format "LOGIN passphrase for %s: " (sasl-client-name client)))) + +(put 'sasl-login 'sasl-mechanism + (sasl-make-mechanism "LOGIN" sasl-login-steps)) + +(provide 'sasl-login) + +;;; ANONYMOUS (RFC2245) +(defconst sasl-anonymous-steps + '(ignore ;no initial response + sasl-anonymous-response)) + +(defun sasl-anonymous-response (client step) + (or (sasl-client-property client 'trace) + (sasl-client-name client))) + +(put 'sasl-anonymous 'sasl-mechanism + (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) + +(provide 'sasl-anonymous) (provide 'sasl) -;;; sasl.el ends here \ No newline at end of file +;;; sasl.el ends here diff --git a/utils/sasl/lisp/scram-md5.el b/utils/sasl/lisp/scram-md5.el deleted file mode 100644 index 6891600..0000000 --- a/utils/sasl/lisp/scram-md5.el +++ /dev/null @@ -1,154 +0,0 @@ -;;; scram-md5.el --- Compute SCRAM-MD5. - -;; Copyright (C) 1999 Shuhei KOBAYASHI - -;; Author: Shuhei KOBAYASHI -;; Kenichi OKADA -;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP - -;; 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. - -;;; Commentary: - -;; This program is implemented from draft-newman-auth-scram-03.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) - -;; Examples. -;; -;; (scram-make-security-info nil t 0) -;; => "^A^@^@^@" - -;;; Code: - -(require 'hmac-md5) -(require 'unique-id) - -(defmacro scram-security-info-no-security-layer (security-info) - `(eq (logand (aref ,security-info 0) 1) 1)) -(defmacro scram-security-info-integrity-protection-layer (security-info) - `(eq (logand (aref ,security-info 0) 2) 2)) -(defmacro scram-security-info-buffer-size (security-info) - `(let ((ssecinfo ,security-info)) - (+ (lsh (aref ssecinfo 1) 16) - (lsh (aref ssecinfo 2) 8) - (aref ssecinfo 3)))) - -(defun scram-make-security-info (integrity-protection-layer - no-security-layer buffer-size) - (let ((csecinfo (make-string 4 0))) - (when integrity-protection-layer - (aset csecinfo 0 2)) - (if no-security-layer - (aset csecinfo 0 (logior (aref csecinfo 0) 1)) - (aset csecinfo 1 - (lsh (logand buffer-size (lsh 255 16)) -16)) - (aset csecinfo 2 - (lsh (logand buffer-size (lsh 255 8)) -8)) - (aset csecinfo 3 (logand buffer-size 255))) - csecinfo)) - -(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. - (let (id) - (unwind-protect - (concat "<" - (setq id (unique-id-m ".sasl")) - "@" (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)) - (dst (make-string len 0)) - (pos 0)) - (while (< pos len) - (aset dst pos (logxor (aref str1 pos) (aref str2 pos))) - (setq pos (1+ pos))) - dst)) - -(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." - (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)." - (when (and (> (length server-msg-1) 16) - (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12)) - (list (substring server-msg-1 0 8) ; salt - (substring server-msg-1 8 12) ; server-security-info - (substring server-msg-1 ; service-id - 12 (1- (match-end 0)))))) - -(defun scram-md5-make-salted-pass (passphrase salt) - (hmac-md5 salt passphrase)) - -(defun scram-md5-make-client-key (salted-pass) - (md5-binary salted-pass)) - -(defun scram-md5-make-client-verifier (client-key) - (md5-binary client-key)) - -(defun scram-md5-make-shared-key (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-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) - -;;; scram-md5.el ends here diff --git a/utils/sasl/lisp/unique-id.el b/utils/sasl/lisp/unique-id.el deleted file mode 100644 index f80b2d4..0000000 --- a/utils/sasl/lisp/unique-id.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; unique-id.el --- Compute DIGEST-MD5. - -;; Copyright (C) 1999 Kenichi OKADA - -;; Author: Katsumi Yamaoka - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;;; Code: - -;;; Gnus 5.8.3: message.el - -(defvar unique-id-m-char nil) - -;; If you ever change this function, make sure the new version -;; cannot generate IDs that the old version could. -;; You might for example insert a "." somewhere (not next to another dot -;; or string boundary), or modify the suffix string (default to "fsf"). -(defun unique-id-m (&optional suffix) - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq unique-id-m-char - (% (1+ (or unique-id-m-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 - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (user-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (unique-id-m-number-base36 (user-uid) -1)) - (unique-id-m-number-base36 (+ (car tm) - (lsh (% unique-id-m-char 25) 16)) 4) - (unique-id-m-number-base36 (+ (nth 1 tm) - (lsh (/ unique-id-m-char 25) 16)) 4) - ;; Append the suffix, because while the generated ID is unique to - ;; the application, other applications might otherwise generate - ;; the same ID via another algorithm. - (or suffix ".fsf")))) - -(defun unique-id-m-number-base36 (num len) - (if (if (< len 0) - (<= num 0) - (= len 0)) - "" - (concat (unique-id-m-number-base36 (/ num 36) (1- len)) - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" - (% num 36)))))) - - -;;; Wanderlust 1.0.3: wl-draft.el, wl-mule.el - -(defun unique-id-w-random-alphabet () - (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M - ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z))) - (nth (abs (% (random) 26)) alphabet))) - -(defun unique-id-w () - (let ((time (current-time))) - (format "%d.%d.%d.%d%c" - (car time) (nth 1 time) (nth 2 time) - (random 100000) - (unique-id-w-random-alphabet)))) - - -;;; VM 6.75: vm-misc.el - -(defun unique-id-v () - (let ((time (current-time))) - (format "%d.%d.%d.%d" - (car time) (nth 1 time) (nth 2 time) - (random 1000000)))) - - -;;; X-PGP-Sig 1.3.5.1 - -(defun unique-id-x (&optional length) - (let ((i (or length 16)) - s) - (while (> i 0) - (setq i (1- i) - s (concat s (char-to-string (+ (/ (* 94 (% (abs (random)) 100)) - 100) 33))))) - s)) - -(provide 'unique-id) - -;;; unique-id.el ends here -