digest-md5.el

   1 ;;; digest-md5.el --- Compute DIGEST-MD5.
   2
   3 ;; Copyright (C) 1999 Kenichi OKADA
   4
   5 ;; Author: Kenichi OKADA <okada@opaopa.org>
   6 ;;      Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
   7 ;; Keywords: DIGEST-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
   8
   9 ;; This file is part of FLIM (Faithful Library about Internet Message).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This program is implemented from draft-leach-digest-sasl-05.txt.
  29 ;;
  30 ;; It is caller's responsibility to base64-decode challenges and
  31 ;; base64-encode responses in IMAP4 AUTHENTICATE command.
  32 ;;
  33 ;; Passphrase should be longer than 16 bytes. (See RFC 2195)
  34
  35 ;; Examples.
  36 ;;
  37 ;; (digest-md5-parse-digest-challenge
  38 ;;   "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",qop=\"auth\",algorithm=md5-sess,charset=utf-8")
  39 ;; => (realm "elwood.innosoft.com" nonce "OA6MG9tEQGm2hh" qop "auth" algorithm md5-sess charset utf-8)
  40
  41 ;; (digest-md5-build-response-value
  42 ;;   "chris" "secret" "OA6MHXh6VqTrRk" "imap/elwood.innosoft.com")
  43 ;; => "d388dad90d4bbd760a152321f2143af7"
  44
  45 ;;; Code:
  46
  47 (require 'hmac-md5)
  48 (require 'unique-id)
  49
  50 (defvar digest-md5-challenge nil)
  51 (defvar digest-md5-nonce-count 1)
  52
  53 (defvar digest-md5-parse-digest-challenge-syntax-table
  54   (let ((table (make-syntax-table)))
  55     (modify-syntax-entry ?= "." table)
  56     (modify-syntax-entry ?, "." table)
  57     table)
  58   "A syntax table for parsing digest-challenge attributes.")
  59
  60 ;;;###autoload
  61 (defun digest-md5-parse-digest-challenge (digest-challenge)
  62   ;; return a property list of
  63   ;; (realm nonce qop-options stale maxbuf charset
  64   ;; algorithm cipher-opts auth-param).
  65   (with-temp-buffer
  66     (set-syntax-table digest-md5-parse-digest-challenge-syntax-table)
  67     (insert digest-challenge)
  68     (goto-char (point-min))
  69     (insert "(")
  70     (while (progn (forward-sexp) (not (eobp)))
  71       (delete-char 1)
  72       (insert " "))
  73     (insert ")")
  74     (condition-case nil
  75         (setplist 'digest-md5-challenge (read (point-min-marker)))
  76       (end-of-file
  77        (error "Parse error in digest-challenge.")))))
  78
  79 (defun digest-md5-digest-uri (serv-type host &optional serv-name)
  80   (concat serv-type "/" host
  81           (if (and serv-name
  82                    (null (string= host serv-name)))
  83               (concat "/" serv-name))))
  84
  85 (defmacro digest-md5-cnonce ()
  86   ;; It is RECOMMENDED that it
  87   ;; contain at least 64 bits of entropy.
  88   '(concat (unique-id-m "") (unique-id-m "")))
  89
  90 (defmacro digest-md5-challenge (prop)
  91   (list 'get ''digest-md5-challenge prop))
  92
  93 (defmacro digest-md5-build-response-value
  94   (username passwd cnonce digest-uri qop)
  95   `(encode-hex-string
  96     (md5-binary
  97      (concat
  98       (encode-hex-string
  99        (md5-binary (concat (md5-binary
 100                             (concat ,username
 101                                     ":" (digest-md5-challenge 'realm)
 102                                     ":" ,passwd))
 103                            ":" (digest-md5-challenge 'nonce)
 104                            ":" ,cnonce
 105                            (let ((authzid (digest-md5-challenge 'authzid)))
 106                              (if authzid (concat ":" authzid) nil)))))
 107       ":" (digest-md5-challenge 'nonce)
 108       ":" (format "%08x" digest-md5-nonce-count) ":" ,cnonce ":" ,qop ":"
 109       (encode-hex-string
 110        (md5-binary
 111         (concat "AUTHENTICATE:" ,digest-uri
 112                 (if (string-equal "auth-int" ,qop)
 113                     ":00000000000000000000000000000000"
 114                   nil))))))))
 115
 116 ;;;###autoload
 117 (defun digest-md5-digest-response (username passwd digest-uri &optional qop)
 118   (let ((cnonce (digest-md5-cnonce)))
 119     (concat
 120      "username=\"" username "\","
 121      "realm=\"" (digest-md5-challenge 'realm) "\","
 122      "nonce=\"" (digest-md5-challenge 'nonce) "\","
 123      (format "nc=%08x," digest-md5-nonce-count)
 124      "cnonce=\"" cnonce "\","
 125      "digest-uri=\"" digest-uri "\","
 126      "response="
 127      (digest-md5-build-response-value username passwd cnonce digest-uri
 128                                       (or qop "auth"))
 129      ","
 130      (mapconcat
 131       #'identity
 132       (delq nil
 133             (mapcar (lambda (prop)
 134                       (if (digest-md5-challenge prop)
 135                           (format "%s=%s"
 136                                   prop (digest-md5-challenge prop))))
 137                     '(charset qop maxbuf cipher authzid)))
 138       ","))))
 139
 140 (provide 'digest-md5)
 141
 142 ;;; digest-md5.el ends here