diff --git a/collects/tests/web-server/stuffers-test.ss b/collects/tests/web-server/stuffers-test.ss index 3abd445dec..5036b080bc 100644 --- a/collects/tests/web-server/stuffers-test.ss +++ b/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))))))))) \ No newline at end of file + (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) +|# \ No newline at end of file diff --git a/collects/web-server/scribblings/stuffers.scrbl b/collects/web-server/scribblings/stuffers.scrbl index a0acc5c3f5..acea1290de 100644 --- a/collects/web-server/scribblings/stuffers.scrbl +++ b/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 - (build-path (find-system-path 'home-dir) ".urls"))]. + Equivalent to: + @schemeblock[ + (make-default-stuffer + (build-path + (find-system-path 'home-dir) + ".urls"))] } } \ No newline at end of file diff --git a/collects/web-server/stuffers.ss b/collects/web-server/stuffers.ss index 96131e44e8..f5b6c7a661 100644 --- a/collects/web-server/stuffers.ss +++ b/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)) \ No newline at end of file diff --git a/collects/web-server/stuffers/hmac-sha1.ss b/collects/web-server/stuffers/hmac-sha1.ss new file mode 100644 index 0000000000..00520efe29 --- /dev/null +++ b/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?))]) \ No newline at end of file