sasl-digest.el

   1 ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
   2
   3 ;; Copyright (C) 2000 Daiki Ueno
   4
   5 ;; Author: Kenichi OKADA <okada@opaopa.org>
   6 ;;      Daiki Ueno <ueno@unixuser.org>
   7 ;; Keywords: SASL, DIGEST-MD5
   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 (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; 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 the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;; This program is implemented from draft-leach-digest-sasl-05.txt.
  27 ;;
  28 ;; It is caller's responsibility to base64-decode challenges and
  29 ;; base64-encode responses in IMAP4 AUTHENTICATE command.
  30 ;;
  31 ;; Passphrase should be longer than 16 bytes. (See RFC 2195)
  32
  33 ;;; Commentary:
  34
  35 (require 'sasl)
  36 (require 'hmac-md5)
  37
  38 (defvar sasl-digest-md5-challenge nil)
  39 (defvar sasl-digest-md5-nonce-count 1)
  40 (defvar sasl-digest-md5-unique-id-function
  41   sasl-unique-id-function)
  42
  43 (defvar sasl-digest-md5-parse-digest-challenge-syntax-table
  44   (let ((table (make-syntax-table)))
  45     (modify-syntax-entry ?= "." table)
  46     (modify-syntax-entry ?, "." table)
  47     table)
  48   "A syntax table for parsing digest-challenge attributes.")
  49
  50 (defconst sasl-digest-md5-steps
  51   '(ignore                              ;no initial response
  52     sasl-digest-md5-response
  53     ignore))                            ;""
  54
  55 ;;; @ low level functions
  56 ;;;
  57 ;;; Examples in `draft-leach-digest-sasl-05.txt'.
  58 ;;;
  59 ;;; (sasl-digest-md5-parse-digest-challenge
  60 ;;;   "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",qop=\"auth\",algorithm=md5-sess,charset=utf-8")
  61 ;;; => (realm "elwood.innosoft.com" nonce "OA6MG9tEQGm2hh" qop "auth" algorithm md5-sess charset utf-8)
  62
  63 ;;; (sasl-digest-md5-build-response-value
  64 ;;;   "chris" "elwood.innosoft.com" "secret" "OA6MG9tEQGm2hh"
  65 ;;;   "OA6MHXh6VqTrRk" 1 "imap/elwood.innosoft.com" "auth")
  66 ;;; => "d388dad90d4bbd760a152321f2143af7"
  67
  68 (defun sasl-digest-md5-parse-digest-challenge (digest-challenge)
  69   "Return a property list parsed DIGEST-CHALLENGE.
  70 The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
  71 charset algorithm cipher-opts auth-param)."
  72   (save-excursion
  73     (with-temp-buffer
  74       (set-syntax-table sasl-digest-md5-parse-digest-challenge-syntax-table)
  75       (insert digest-challenge)
  76       (goto-char (point-min))
  77       (insert "(")
  78       (while (progn (forward-sexp) (not (eobp)))
  79         (delete-char 1)
  80         (insert " "))
  81       (insert ")")
  82       (condition-case nil
  83           (setplist 'sasl-digest-md5-challenge (read (point-min-marker)))
  84         (end-of-file
  85          (error "Parse error in digest-challenge."))))))
  86
  87 (defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
  88   (concat serv-type "/" host
  89           (if (and serv-name
  90                    (null (string= host serv-name)))
  91               (concat "/" serv-name))))
  92
  93 (defun sasl-digest-md5-cnonce ()
  94   (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
  95     (sasl-unique-id)))
  96
  97 (defmacro sasl-digest-md5-challenge (prop)
  98   (list 'get ''sasl-digest-md5-challenge prop))
  99
 100 (defmacro sasl-digest-md5-build-response-value-1
 101   (username realm passwd nonce cnonce nonce-count digest-uri qop)
 102   `(encode-hex-string
 103     (md5-binary
 104      (concat
 105       (encode-hex-string
 106        (md5-binary (concat (md5-binary
 107                             (concat ,username
 108                                     ":" ,realm
 109                                     ":" ,passwd))
 110                            ":" ,nonce
 111                            ":" ,cnonce
 112                            (let ((authzid (sasl-digest-md5-challenge 'authzid)))
 113                              (if authzid (concat ":" authzid) nil)))))
 114       ":" ,nonce
 115       ":" (format "%08x" ,nonce-count) ":" ,cnonce ":" ,qop ":"
 116       (encode-hex-string
 117        (md5-binary
 118         (concat "AUTHENTICATE:" ,digest-uri
 119                 (if (string-equal "auth-int" ,qop)
 120                     ":00000000000000000000000000000000"
 121                   nil))))))))
 122
 123 (defun sasl-digest-md5-build-response-value
 124   (username realm passwd nonce cnonce nonce-count digest-uri
 125             &optional charset qop maxbuf cipher authzid)
 126   (concat
 127    "username=\"" username "\","
 128    "realm=\"" realm "\","
 129    "nonce=\"" nonce "\","
 130    (format "nc=%08x," nonce-count)
 131    "cnonce=\"" cnonce "\","
 132    "digest-uri=\"" digest-uri "\","
 133    "response="
 134    (sasl-digest-md5-build-response-value-1
 135     username realm passwd nonce cnonce nonce-count digest-uri
 136     (or qop "auth"))
 137    ","
 138    (mapconcat
 139     #'identity
 140     (delq nil
 141           (mapcar (lambda (prop)
 142                     (if (sasl-digest-md5-challenge prop)
 143                         (format "%s=%s"
 144                                 prop (sasl-digest-md5-challenge prop))))
 145                   '(charset qop maxbuf cipher authzid)))
 146     ",")))
 147
 148 (defun sasl-digest-md5-response (client step)
 149   (sasl-digest-md5-parse-digest-challenge (sasl-step-data step))
 150   (let ((passphrase
 151          (sasl-read-passphrase
 152           (format "DIGEST-MD5 passphrase for %s: "
 153                   (sasl-client-name client)))))
 154     (unwind-protect
 155         (sasl-digest-md5-build-response-value
 156          (sasl-client-name client)
 157          (or (sasl-client-property client 'realm)
 158              (sasl-digest-md5-challenge 'realm))        ;need to check
 159          passphrase
 160          (sasl-digest-md5-challenge 'nonce)
 161          (sasl-digest-md5-cnonce)
 162          sasl-digest-md5-nonce-count
 163          (sasl-digest-md5-digest-uri
 164           (sasl-client-service client)
 165           (sasl-client-server client)))
 166       (fillarray passphrase 0))))
 167
 168 (put 'sasl-digest 'sasl-mechanism
 169      (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
 170
 171 (provide 'sasl-digest)
 172
 173 ;;; sasl-digest.el ends here