hmac-sha1

svn: r13506

collects/tests/web-server/stuffers-test.ss

@@ -75,6 +75,30 @@
    (test-suite "hash"
                (test-case "md5-stuffer" (stuffer-test (md5-stuffer (find-system-path 'temp-dir)))))
    
+   (test-suite "hmac-sha1"
+               (test-case "hmac-sha1 len" 
+                          (check-equal? (bytes-length (HMAC-SHA1 (make-bytes 10 (random 255))
+                                                                 (make-bytes 10 (random 255))))
+                                        20))
+               
+               (test-case "hmac-sha1 len" 
+                          (check-equal? (bytes-length (HMAC-SHA1 (make-bytes 10 (random 255))
+                                                                 (make-bytes 100 (random 255))))
+                                        20))
+               
+               (test-case "hmac-sha1 len" 
+                          (check-equal? (bytes-length (HMAC-SHA1 (make-bytes 10 (random 255))
+                                                                 (make-bytes 1000 (random 255))))
+                                        20))
+               
+               (test-case "hmac-sha1 stuffer" (stuffer-test (HMAC-SHA1-stuffer (make-bytes 10 (random 255)))))
+               
+               (test-case "hmac-sha1 stuffer (err)"
+                          (check-exn exn?
+                                     (lambda ()
+                                       ((stuffer-out (HMAC-SHA1-stuffer (make-bytes 10 (random 255))))
+                                        #"123456789012345678901234567890")))))
+   
    (test-suite "stuff-url"
                (test-case "make-default-stuffer"
                           (context-wrap 
@@ -100,4 +124,9 @@
                (test-case "is-url-too-big?"
                           (context-wrap
                            (lambda ()
-                             (check-not-false (is-url-too-big? (make-bytes 3000 65)))))))))
+                             (check-not-false (is-url-too-big? (make-bytes 3000 65)))))))))
+
+#|
+(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)))
+(test/graphical-ui all-stuffers-tests)
+|#

collects/web-server/scribblings/stuffers.scrbl

@@ -9,6 +9,7 @@
    web-server/stuffers/hash
    web-server/stuffers/serialize
    web-server/stuffers/store
+   web-server/stuffers/hmac-sha1
    (only-in web-server/lang/stuff-url
             default-stuffer
             make-default-stuffer
@@ -110,7 +111,7 @@ You can supply your own (built with these functions) when you write a stateless
 @defthing[gzip-stuffer (stuffer/c bytes? bytes?)]{                                 
  A @tech{stuffer} that uses @scheme[gzip/bytes] and @scheme[gunzip/bytes].
    
- Note: You should probably compose this with @scheme[base64-stuffer] to get URL-safe bytes.
+ @warning{You should compose this with @scheme[base64-stuffer] to get URL-safe bytes.}
 }
          
 }
@@ -131,7 +132,12 @@ The @schememodname[web-server/stuffers/hash] @tech{stuffers} rely on a key/value
                                                    
  @defproc[(dir-store [root path-string?])
           store?]{
-  A store that stores key @scheme[key]'s value in a file located at @scheme[(build-path root (bytes->string/utf-8 key))].
+  A store that stores key @scheme[key]'s value in a file located at 
+  @schemeblock[
+  (build-path 
+   root
+   (bytes->string/utf-8 key))
+  ]
  }
 
  It should be easy to use this interface to create store for databases, like SQLite, CouchDB, or BerkeleyDB.
@@ -160,6 +166,34 @@ The @schememodname[web-server/stuffers/hash] @tech{stuffers} rely on a key/value
                                      
 }
 
+@section{HMAC-SHA1 Signing}
+
+@defmodule[web-server/stuffers/hmac-sha1]{
+                                          
+ @defproc[(HMAC-SHA1 [kb bytes?] [db bytes?])
+          bytes?]{
+  Performs a HMAC-SHA1 calculation on @scheme[db] using @scheme[kb] as the key. The result is guaranteed to be 20 bytes. 
+  (You could curry this to use it with @scheme[hash-stuffer], but there is little value in doing so over @scheme[md5].)
+
+ }
+                 
+ @defproc[(HMAC-SHA1-stuffer [kb bytes?])
+          (stuffer/c bytes? bytes?)]{
+  A @tech{stuffer} that signs input using @scheme[HMAC-SHA1] with @scheme[kb] as the key. The result of the @tech{stuffer} is
+  the hash prepended to the input data. When the @tech{stuffer} is run in reverse, it checks if the first 20 bytes are the correct
+  has for the rest of the data.
+  
+  @warning{You should compose this with @scheme[base64-stuffer] to get URL-safe bytes.}
+
+  @warning{Without explicit provision, it is possible for users to modify the continuations they are sent through the other @tech{stuffers}.
+  This @tech{stuffer} allows the servlet to certify that stuffed data was truly generated by the servlet. Therefore, you @bold{should} use this
+  if you are not using the @scheme[hash-stuffer]s.}
+ 
+  @warning{This @tech{stuffer} does @bold{not} encrypt the data in anyway, so users can still observe the stuffed values.}
+ }
+                                    
+}
+
 @section{Helpers}
 
 @defmodule[web-server/lang/stuff-url]{
@@ -189,8 +223,12 @@ The @schememodname[web-server/stuffers/hash] @tech{stuffers} rely on a key/value
 }
                                           
 @defthing[default-stuffer (stuffer/c serializable? bytes?)]{
- Equivalent to @scheme[(make-default-stuffer
+ Equivalent to:
-                        (build-path (find-system-path 'home-dir) ".urls"))].
+ @schemeblock[
+  (make-default-stuffer
+   (build-path 
+    (find-system-path 'home-dir)
+    ".urls"))]
 }
 
 }

collects/web-server/stuffers.ss

@@ -5,6 +5,7 @@
          web-server/stuffers/hash
          web-server/stuffers/serialize
          web-server/stuffers/store
+         web-server/stuffers/hmac-sha1
          (only-in web-server/lang/stuff-url
                   default-stuffer
                   make-default-stuffer
@@ -16,4 +17,5 @@
                web-server/stuffers/hash
                web-server/stuffers/serialize
                web-server/stuffers/store
+               web-server/stuffers/hmac-sha1
                web-server/lang/stuff-url))

collects/web-server/stuffers/hmac-sha1.ss

@@ -0,0 +1,53 @@
+#lang scheme
+(require web-server/stuffers/stuffer
+         scheme/runtime-path
+         (rename-in scheme/foreign
+                    [-> f->]))
+
+(define-runtime-path libcrypto-so
+  (case (system-type)
+    [(windows) '(so "libeay32")]
+    [else '(so "libcrypto")]))
+
+(unsafe!)
+
+(define libcrypto
+  (ffi-lib libcrypto-so '("" "0.9.8b" "0.9.8" "0.9.7")))
+
+(define EVP_SHA1
+  (get-ffi-obj 'EVP_sha1 libcrypto-so
+               (_fun f-> _fpointer)))
+
+(define HMAC-SHA1/raw
+  (get-ffi-obj 'HMAC libcrypto-so
+               (_fun [EVP_MD : _fpointer = (EVP_SHA1)]
+                     [key : _bytes]
+                     [key_len : _int = (bytes-length key)]
+                     [data : _bytes]
+                     [data_len : _int = (bytes-length data)]
+                     [md : _int = 0]
+                     [md_len : _int = 0]
+                     f->
+                     _pointer)))
+
+(define (HMAC-SHA1 key data)
+  ; It returns the same pointer always
+  (bytes-copy
+   ; A SHA1 is 20 bytes, including 0s
+   (make-sized-byte-string (HMAC-SHA1/raw key data) 20)))
+
+(define (HMAC-SHA1-stuffer key)
+  (make-stuffer
+   (lambda (ib)
+     (bytes-append (HMAC-SHA1 key ib) ib))
+   (lambda (ob)
+     (define hib (subbytes ob 0 20))
+     (define ib (subbytes ob 20))
+     (define true-hib (HMAC-SHA1 key ib))
+     (if (bytes=? hib true-hib)
+         ib
+         (error 'HMAC-SHA1-stuffer "Signature does not match!")))))
+
+(provide/contract
+ [HMAC-SHA1 (bytes? bytes? . -> . bytes?)]
+ [HMAC-SHA1-stuffer (bytes? . -> . (stuffer/c bytes? bytes?))])