cgit.sxemacs.org Git - gnus/blob - lisp/rfc2104.el

   1 ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
   2
   3 ;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <jas@pdc.kth.se>
   6 ;; Keywords: mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This is a high performance implementation of RFC2104.
  26 ;;
  27 ;; Example:
  28 ;;
  29 ;; (require 'md5)
  30 ;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?")
  31 ;; "750c783e6ab0b503eaa86e310a5db738"
  32 ;;
  33 ;; (require 'sha1)
  34 ;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?")
  35 ;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
  36 ;;
  37 ;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
  38 ;; resulting hash length (16 for MD5, 20 for SHA).
  39 ;;
  40 ;; Tested with Emacs 20.2 and XEmacs 20.3.
  41 ;;
  42 ;; Test case reference: RFC 2202.
  43
  44 ;;; History:
  45
  46 ;; 1998-08-16  initial release posted to gnu.emacs.sources
  47 ;; 1998-08-17  use append instead of char-list-to-string
  48 ;; 1998-08-26  don't require hexl
  49 ;; 1998-09-25  renamed from hmac.el to rfc2104.el, also renamed functions
  50 ;; 1999-10-23  included in pgnus
  51 ;; 2000-08-15  `rfc2104-hexstring-to-bitstring'
  52 ;; 2000-05-12  added sha-1 example, added test case reference
  53 ;; 2003-11-13  change rfc2104-hexstring-to-bitstring to ...-byte-list
  54 ;; 2008-04-25  rewrite rfc2104-hash for speed
  55
  56 ;;; Code:
  57
  58 (eval-when-compile (require 'cl))
  59
  60 ;; Magic character for inner HMAC round. 0x36 == 54 == '6'
  61 (defconst rfc2104-ipad ?\x36)
  62
  63 ;; Magic character for outer HMAC round. 0x5C == 92 == '\'
  64 (defconst rfc2104-opad ?\x5C)
  65
  66 (defconst rfc2104-nybbles
  67   (let ((v (make-vector
  68             ;; Find upper bound to save some space.
  69             (1+ (max ?0 ?9 ?a ?f ?A ?F))
  70             ;; Use non-numeric default to catch bogus hex strings.
  71             nil))
  72         (ls '((?0 . 0)   (?a . 10)   (?A . 10)
  73               (?1 . 1)   (?b . 11)   (?B . 11)
  74               (?2 . 2)   (?c . 12)   (?C . 12)
  75               (?3 . 3)   (?d . 13)   (?D . 13)
  76               (?4 . 4)   (?e . 14)   (?E . 14)
  77               (?5 . 5)   (?f . 15)   (?F . 15)
  78               (?6 . 6)
  79               (?7 . 7)
  80               (?8 . 8)
  81               (?9 . 9))))
  82     (while ls
  83       (aset v (caar ls) (cdar ls))
  84       (setq ls (cdr ls)))
  85     v))
  86
  87 (eval-when-compile
  88   (defmacro rfc2104-string-make-unibyte (string)
  89     "Return the unibyte equivalent of STRING.
  90 In XEmacs return just STRING."
  91     (if (featurep 'xemacs)
  92         string
  93       `(string-make-unibyte ,string))))
  94
  95 (defun rfc2104-hash (hash block-length hash-length key text)
  96   (let* (;; if key is longer than B, reset it to HASH(key)
  97          (key (if (> (length key) block-length)
  98                   (funcall hash key) key))
  99          (len (length key))
 100          (ipad (make-string    block-length              rfc2104-ipad))
 101          (opad (make-string (+ block-length hash-length) rfc2104-opad))
 102          c partial)
 103     ;; Prefix *pad with key, appropriately XORed.
 104     (do ((i 0 (1+ i)))
 105         ((= len i))
 106       (setq c (aref key i))
 107       (aset ipad i (logxor rfc2104-ipad c))
 108       (aset opad i (logxor rfc2104-opad c)))
 109     ;; Perform inner hash.
 110     (setq partial (rfc2104-string-make-unibyte
 111                    (funcall hash (concat ipad text))))
 112     ;; Pack latter part of opad.
 113     (do ((r 0 (+ 2 r))
 114          (w block-length (1+ w)))
 115         ((= (* 2 hash-length) r))
 116       (aset opad w
 117             (+ (* 16 (aref rfc2104-nybbles (aref partial     r)))
 118                (      aref rfc2104-nybbles (aref partial (1+ r))))))
 119     ;; Perform outer hash.
 120     (rfc2104-string-make-unibyte (funcall hash opad))))
 121
 122 (provide 'rfc2104)
 123
 124 ;;; rfc2104.el ends here