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 ;; NOW BUILDING.
  29
  30 ;; This program is implemented from draft-leach-digest-sasl-05.txt.
  31 ;;
  32 ;; It is caller's responsibility to base64-decode challenges and
  33 ;; base64-encode responses in IMAP4 AUTHENTICATE command.
  34 ;;
  35 ;; Passphrase should be longer than 16 bytes. (See RFC 2195)
  36
  37 ;; Examples.
  38 ;;
  39 ;; (digest-md5-parse-digest-challenge
  40 ;;   "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",qop=\"auth\",algorithm=md5-sess,charset=utf-8")
  41 ;; => (realm "elwood.innosoft.com" nonce "OA6MG9tEQGm2hh" qop "auth" algorithm md5-sess charset utf-8)
  42
  43 ;; (digest-md5-build-response-value
  44 ;;   "chris" "secret" "OA6MHXh6VqTrRk" "imap/elwood.innosoft.com")
  45 ;; => "d388dad90d4bbd760a152321f2143af7"
  46
  47 ;;; Code:
  48
  49 (require 'hmac-md5)
  50 (require 'unique-id)
  51
  52 (defvar digest-md5-challenge nil)
  53 (defvar digest-md5-nonce-count 1)
  54
  55 (defvar digest-md5-parse-digest-challenge-syntax-table
  56   (let ((table (make-syntax-table)))
  57     (modify-syntax-entry ?= "." table)
  58     (modify-syntax-entry ?, "." table)
  59     table)
  60   "A syntax table for parsing digest-challenge attributes.")
  61
  62 ;;;###autoload
  63 (defun digest-md5-parse-digest-challenge (digest-challenge)
  64   ;; return a property list of
  65   ;; (realm nonce qop-options stale maxbuf charset
  66   ;; algorithm cipher-opts auth-param).
  67   (with-temp-buffer
  68     (set-syntax-table digest-md5-parse-digest-challenge-syntax-table)
  69     (insert digest-challenge)
  70     (goto-char (point-min))
  71     (insert "(")
  72     (while (progn (forward-sexp) (not (eobp)))
  73       (delete-char 1)
  74       (insert " "))
  75     (insert ")")
  76     (condition-case nil
  77         (setplist 'digest-md5-challenge (read (point-min-marker)))
  78       (end-of-file
  79        (error "Parse error in digest-challenge.")))))
  80
  81 (defun digest-md5-digest-uri (serv-type host &optional serv-name)
  82   (concat serv-type "/" host
  83           (if (and serv-name
  84                    (null (string= host serv-name)))
  85               (concat "/" serv-name))))
  86
  87 (defun digest-md5-cnonce ()
  88   ;; It is RECOMMENDED that it
  89   ;; contain at least 64 bits of entropy.
  90   (concat (unique-id-m "") (unique-id-m "")))
  91
  92 (defmacro digest-md5-challenge (prop)
  93   (list 'get ''digest-md5-challenge prop))
  94
  95 (defmacro digest-md5-build-response-value (username passwd cnonce digest-uri)
  96   `(encode-hex-string
  97     (md5-binary
  98      (concat
  99       (encode-hex-string
 100        (md5-binary (concat (md5-binary
 101                             (concat ,username
 102                                     ":" (digest-md5-challenge 'realm)
 103                                     ":" ,passwd))
 104                            ":" (digest-md5-challenge 'nonce)
 105                            ":" ,cnonce
 106                            (let ((authzid (digest-md5-challenge 'authzid)))
 107                              (if authzid (concat ":" authzid) nil)))))
 108       ":" (digest-md5-challenge 'nonce)
 109       ":" (format "%08x" digest-md5-nonce-count) ":" ,cnonce
 110       ":" (digest-md5-challenge 'qop) ":"
 111       (encode-hex-string
 112        (md5-binary
 113         (concat "AUTHENTICATE:" ,digest-uri
 114                 (if (member "auth" (split-string
 115                                     (digest-md5-challenge 'qop)
 116                                     ","))
 117                     nil
 118                   ":00000000000000000000000000000000"))))))))
 119
 120 ;;;###autoload
 121 (defun digest-md5-digest-response (username passwd digest-uri)
 122   (let ((cnonce (digest-md5-cnonce)))
 123     (concat
 124      "username=\"" username "\","
 125      "realm=\"" (digest-md5-challenge 'realm) "\","
 126      "nonce=\"" (digest-md5-challenge 'nonce) "\","
 127      (format "nc=%08x," digest-md5-nonce-count)
 128      "cnonce=\"" cnonce "\","
 129      "digest-uri=\"" digest-uri "\","
 130      "response="
 131      (digest-md5-build-response-value username passwd cnonce digest-uri)
 132      ","
 133      (mapconcat
 134       #'identity
 135       (delq nil
 136             (mapcar (lambda (prop)
 137                       (if (digest-md5-challenge prop)
 138                           (format "%s=%s"
 139                                   prop (digest-md5-challenge prop))))
 140                     '(charset qop maxbuf cipher authzid)))
 141       ","))))
 142
 143 (provide 'digest-md5)
 144
 145 ;;; digest-md5.el ends here