modules/crypto.lsp

   1 ;; @module crypto.lsp
   2 ;; @description SSL crypto functions for MD5 and SHA-1 hashing
   3 ;; @version 1.01 - initial release
   4 ;; @version 1.02 - renamed to crypto, new lib detection
   5 ;; @version 1.04 - added hmac encryption from amazon.com query API
   6 ;; @author Lutz Mueller 2007, Martin Quiroga 2007
   7 ;;
   8 ;; <h2>Module for SSL lib crypto  bindings</h2>
   9 ;; This modules imports functions for the MD5 and SHA-1 hashing algorithms described
  10 ;; here: @link http://www.ietf.org/rfc/rfc3174.txt http://www.ietf.org/rfc/rfc3174.txt .
  11 ;; The crypto library is part of the @link http://www.openssl.org/ OpenSSL libraries.
  12 ;;
  13 ;; To use this module include the following 'load' statement at the
  14 ;; beginning of the program file:
  15 ;; <pre>
  16 ;; (load "/usr/share/newlisp/modules/crypto.lsp")
  17 ;; </pre>
  18 ;;
  19 ;; <h2>Requirements:</h2>
  20 ;; On Mac OS X, UBUNTU and many other Linux, BSDs and other UNIX installations
  21 ;; <tt>libcrypto.so</tt> is installed by default as part of the OpenSSL
  22 ;; libraries in <tt>usr/lib/libcrypto.so</tt>. If loading this module
  23 ;; finishes with an error message the path of the library should be corrected.
  24 ;;
  25 ;; This module has been tested on Mac OS X, UBUNTU Linux and FreeBSD.
  26
  27 (context 'crypto)
  28
  29 ; set library to path-name of the library on your platform OS
  30 ;
  31 (set 'files '(
  32         "/usr/lib/libcrypto.so"
  33         "/usr/lib/libcrypto.so.0.9.8"
  34         "/usr/lib/libcrypto.so.0.9.7"
  35         "/usr/lib/libcrypto.so.0.9.6"
  36         "/usr/lib/libcrypto.so.4"
  37         "/usr/lib/libcrypto.dylib"
  38 ))
  39
  40 (set 'library (files (or
  41                                 (find true (map file? files))
  42                                 (begin (println "cannot find crypto library") (exit)))))
  43
  44 (import library "MD5")
  45 (import library "SHA1")
  46
  47 ;; @syntax (crypto:md5 <string> <bool-raw>)
  48 ;; @param <string> The string buffer for which to calculate a MD5 hash
  49 ;; @param <bool-raw> Return the raw binay buffer when 'true'.
  50 ;; @return The 16 Byte MD5 hash as a 32 Byte long hex string or as a 16 byte binary buffer.
  51 ;;
  52 ;; @example
  53 ;; (crypto:md5 "ABC") => "902fbdd2b1df0c4f70b4a5d23525e932"
  54 ;;
  55 ;; (crypto:md5 (read-file "newlisp-9.1.0.tgz")) => "46c79c93e904df35c6a8474ace406c92"
  56
  57 (define (md5 str raw-flag)
  58         (if raw-flag
  59                 (let (buff (dup "\000" 16))
  60                         (cpymem (MD5 str (length str) 0) buff 16)
  61                         buff)
  62                 (join
  63                         (map (lambda (x) (format "%02x" (& x 0xff)))
  64                                 (unpack (dup "c" 16) (MD5 str (length str) 0))))
  65         )
  66 )
  67
  68 ;; @syntax (crypto:sha1 <string> <bool-raw>)
  69 ;; @param <string> The string buffer for which to calculate a SHA-1 hash
  70 ;; @param <bool-raw> Return the raw binay buffer when 'true'.
  71 ;; @return The 20 Byte SHA-1 hash as a 40 Byte long hex string or as a 20 byte binary buffer.
  72 ;;
  73 ;; @example
  74 ;; (crypto:sha1 "ABC") => "3c01bdbb26f358bab27f267924aa2c9a03fcfdb8"
  75 ;;
  76 ;; (crypto:sha1 (read-file "newlisp-9.1.0.tgz")) => "2127a9c487f338b00f36cfd60b5f33d27b8d0010"
  77
  78 (define (sha1 str raw-flag)
  79         (if raw-flag
  80                 (let (buff (dup "\000" 20))
  81                         (cpymem (SHA1 str (length str) 0) buff 20)
  82                         buff)
  83                 (join
  84                         (map (lambda (x) (format "%02x" (& x 0xff)))
  85                                 (unpack (dup "c" 20) (SHA1 str (length str) 0)))
  86                 )
  87         )
  88 )
  89
  90 ;; @syntax (crypto:hmac <func-hash> <str-message> <str-key>)
  91 ;; @param <func-hash> The hash function to use.
  92 ;; @param <str-message> The message to encrypt.
  93 ;; @param <str-key> The encryption key.
  94 ;;
  95 ;; This function is part of the amazon.com
  96 ;; @link http://docs.amazonwebservices.com/AWSEC2/2007-08-29/DeveloperGuide/using-query-api.html Query-API
  97 ;; and based on @link http://www.faqs.org/rfcs/rfc2104.html RFC2104 - HMAC: Keyed-Hashing for Message Authentication
  98 ;;
  99 ;; @example
 100 ;; (set 'output (crypto:hmac crypto:md5 "Hello World" "secret"))
 101 ;; (unpack (dup "c" (length output)) output)
 102 ;; => (107 59 -76 66 117 -119 -35 -31 -7 -121 90 55 -109 -68 32 98)
 103
 104 (define (hmac hash_fn msg_str key_str , blocksize opad ipad)
 105   (set 'blocksize 64)
 106    (set 'opad (dup "\x5c" blocksize))
 107    (set 'ipad (dup "\x36" blocksize))
 108   (if (> (length key_str) blocksize)
 109     (set 'key_str (get-true-str (hash_fn key_str)))
 110   )
 111   (set 'key_str (append key_str (dup "\000" (- blocksize (length key_str))))) ;; padding key with binary zeros
 112   (set 'opad (encrypt opad key_str))
 113   (set 'ipad (encrypt ipad key_str))
 114   (hash_fn (append opad (hash_fn (append ipad msg_str) true)) true)
 115 )
 116
 117 ; eof ;
 118