sasl-scram.el

   1 ;;; sasl-scram.el --- Compute SCRAM-MD5.
   2
   3 ;; Copyright (C) 1999 Shuhei KOBAYASHI
   4
   5 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   6 ;;      Kenichi OKADA <okada@opaopa.org>
   7 ;; Keywords: SCRAM-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-newman-auth-scram-03.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 ;; (sasl-scram-md5-make-security-info nil t 0)
  38 ;; => "^A^@^@^@"
  39
  40 ;;; Code:
  41
  42 (require 'sasl)
  43 (require 'hmac-md5)
  44
  45 (defvar sasl-scram-md5-unique-id-function
  46   sasl-unique-id-function)
  47
  48 (defmacro sasl-scram-md5-security-info-no-security-layer (security-info)
  49   `(eq (logand (aref ,security-info 0) 1) 1))
  50 (defmacro sasl-scram-md5-security-info-integrity-protection-layer (security-info)
  51   `(eq (logand (aref ,security-info 0) 2) 2))
  52 (defmacro sasl-scram-md5-security-info-buffer-size (security-info)
  53   `(let ((ssecinfo ,security-info))
  54      (+ (lsh (aref ssecinfo 1) 16)
  55         (lsh (aref ssecinfo 2) 8)
  56         (aref ssecinfo 3))))
  57
  58 (defun sasl-scram-md5-make-security-info (integrity-protection-layer
  59                                  no-security-layer buffer-size)
  60   (let ((csecinfo (make-string 4 0)))
  61     (when integrity-protection-layer
  62       (aset csecinfo 0 2))
  63     (if no-security-layer
  64         (aset csecinfo 0 (logior (aref csecinfo 0) 1))
  65       (aset csecinfo 1
  66             (lsh (logand buffer-size (lsh 255 16)) -16))
  67       (aset csecinfo 2
  68             (lsh (logand buffer-size (lsh 255 8)) -8))
  69       (aset csecinfo 3 (logand buffer-size 255)))
  70     csecinfo))
  71
  72 (defun sasl-scram-md5-make-unique-nonce ()      ; 8*OCTET, globally unique.
  73   ;; For example, concatenated string of process-identifier, system-clock,
  74   ;; sequence-number, random-number, and domain-name.
  75   (let ((sasl-unique-id-function sasl-scram-md5-unique-id-function)
  76         id)
  77     (unwind-protect
  78         (concat "<"
  79                 (setq id (sasl-unique-id))
  80                 "@" (system-name) ">")
  81       (fillarray id 0))))
  82
  83 (defun sasl-scram-md5-xor-string (str1 str2)
  84   ;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
  85   (let* ((len (length str1))
  86          (dst (make-string len 0))
  87          (pos 0))
  88     (while (< pos len)
  89       (aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
  90       (setq pos (1+ pos)))
  91     dst))
  92
  93 (defun sasl-scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id)
  94   "Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
  95 If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
  96   (let (nonce)
  97     (unwind-protect
  98         (concat authorize-id "\0" authenticate-id "\0"
  99                 (setq nonce (sasl-scram-md5-make-unique-nonce)))
 100       (fillarray nonce 0))))
 101
 102 (defun sasl-scram-md5-parse-server-msg-1 (server-msg-1)
 103   "Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
 104   (when (and (> (length server-msg-1) 16)
 105              (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
 106     (list (substring server-msg-1 0 8)  ; salt
 107           (substring server-msg-1 8 12) ; server-security-info
 108           (substring server-msg-1       ; service-id
 109                      12 (1- (match-end 0))))))
 110
 111 (defun sasl-scram-md5-make-salted-pass (passphrase salt)
 112   (hmac-md5 salt passphrase))
 113
 114 (defun sasl-scram-md5-make-client-key (salted-pass)
 115   (md5-binary salted-pass))
 116
 117 (defun sasl-scram-md5-make-client-verifier (client-key)
 118   (md5-binary client-key))
 119
 120 (defun sasl-scram-md5-make-shared-key (server-msg-1
 121                                   client-msg-1
 122                                   client-security-info
 123                                   client-verifier)
 124   (let (buff)
 125     (unwind-protect
 126         (hmac-md5
 127          (setq buff
 128                (concat server-msg-1 client-msg-1 client-security-info))
 129          client-verifier)
 130       (fillarray buff 0))))
 131
 132 (defun sasl-scram-md5-make-client-proof (client-key shared-key)
 133   (sasl-scram-md5-xor-string client-key shared-key))
 134
 135 (defun sasl-scram-md5-make-client-msg-2 (client-security-info client-proof)
 136   (concat client-security-info client-proof))
 137
 138 (defun sasl-scram-md5-make-server-msg-2 (server-msg-1
 139                                     client-msg-1
 140                                     client-security-info
 141                                     salt salted-pass)
 142   (let (buff server-salt)
 143     (setq server-salt
 144           (hmac-md5 salt salted-pass))
 145     (unwind-protect
 146         (hmac-md5
 147          (setq buff
 148                (concat
 149                 client-msg-1
 150                 server-msg-1
 151                 client-security-info))
 152          server-salt)
 153       (fillarray server-salt 0)
 154       (fillarray buff 0))))
 155
 156 (provide 'sasl-scram)
 157
 158 ;;; sasl-scram.el ends here