From fd68db2c7bb60c212f9d5aa91eade90a8240a047 Mon Sep 17 00:00:00 2001
From: David Vanderson <david.vanderson@gmail.com>
Date: Wed, 4 Sep 2013 13:10:01 -0400
Subject: [PATCH] make 'hex-string->bytes' public

---
 .../db-lib/db/private/mysql/connection.rkt    | 21 ----------------
 .../racket-doc/file/scribblings/sha1.scrbl    | 11 +++++++++
 .../racket-test/tests/file/sha1.rkt           | 22 ++++++++++-------
 racket/collects/file/sha1.rkt                 | 24 ++++++++++++++++++-
 racket/collects/openssl/sha1.rkt              |  3 ++-
 5 files changed, 49 insertions(+), 32 deletions(-)

diff --git a/pkgs/db-pkgs/db-lib/db/private/mysql/connection.rkt b/pkgs/db-pkgs/db-lib/db/private/mysql/connection.rkt
index 78f15589bf..4c8810ea72 100644
--- a/pkgs/db-pkgs/db-lib/db/private/mysql/connection.rkt
+++ b/pkgs/db-pkgs/db-lib/db/private/mysql/connection.rkt
@@ -591,27 +591,6 @@
         (loop (add1 i))))
     c))
 
-(define (hex-string->bytes s)
-  (define (hex-digit->int c)
-    (let ([c (char->integer c)])
-      (cond [(<= (char->integer #\0) c (char->integer #\9))
-             (- c (char->integer #\0))]
-            [(<= (char->integer #\a) c (char->integer #\f))
-             (+ 10 (- c (char->integer #\a)))]
-            [(<= (char->integer #\A) c (char->integer #\F))
-             (+ 10 (- c (char->integer #\A)))])))
-  (unless (and (string? s) (even? (string-length s))
-               (regexp-match? #rx"[0-9a-zA-Z]*" s))
-    (raise-type-error 'hex-string->bytes
-                      "string containing an even number of hexadecimal digits" s))
-  (let* ([c (quotient (string-length s) 2)]
-         [b (make-bytes c)])
-    (for ([i (in-range c)])
-      (let ([high (hex-digit->int (string-ref s (+ i i)))]
-            [low  (hex-digit->int (string-ref s (+ i i 1)))])
-        (bytes-set! b i (+ (arithmetic-shift high 4) low))))
-    b))
-
 ;; =======================================
 
 (provide old-scramble-password
diff --git a/pkgs/racket-pkgs/racket-doc/file/scribblings/sha1.scrbl b/pkgs/racket-pkgs/racket-doc/file/scribblings/sha1.scrbl
index d1a648c864..006fd38b19 100644
--- a/pkgs/racket-pkgs/racket-doc/file/scribblings/sha1.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/file/scribblings/sha1.scrbl
@@ -46,4 +46,15 @@ representation in the resulting string.
 (bytes->hex-string #"turtles")
 ]}
 
+@defproc[(hex-string->bytes [str string?]) bytes?]{
+
+Converts the given string to a byte string, where each pair of characters in
+@racket[str] is converted to a single byte in the result.
+
+@examples[
+#:eval sha1-eval
+(hex-string->bytes "70")
+(hex-string->bytes "Af")
+]}
+
 @close-eval[sha1-eval]
diff --git a/pkgs/racket-pkgs/racket-test/tests/file/sha1.rkt b/pkgs/racket-pkgs/racket-test/tests/file/sha1.rkt
index 2397203ec0..1f59d30a4b 100644
--- a/pkgs/racket-pkgs/racket-test/tests/file/sha1.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/file/sha1.rkt
@@ -1,12 +1,16 @@
 #lang racket/base
-(require file/sha1 tests/eli-tester)
 
-(provide tests)
+(module+ test
+  (require file/sha1 rackunit)
+  ;; The docs say that sha1 must return a 40-character string,
+  ;; and should include leading zeros.
+  (check-equal? (string-length (sha1 (open-input-string ""))) 40)
+  (check-equal? (string-length (sha1 (open-input-string " r a c k et"))) 40)
 
-(module+ main (tests))
-(define (tests)
-  (test
-   ;; The docs say that sha1 must return a 40-character string,
-   ;; and should include leading zeros.
-   (string-length (sha1 (open-input-string ""))) => 40
-   (string-length (sha1 (open-input-string " r a c k et"))) => 40))
+  (check-equal? (hex-string->bytes "") (bytes))
+  (check-equal? (hex-string->bytes "00") (bytes 0))
+  (check-equal? (hex-string->bytes "Af") (bytes 175))
+  (define s "1234567890abcdef")
+  (check-equal? (bytes->hex-string (hex-string->bytes s)) s)
+  
+  (check-exn exn:fail:contract? (lambda () (hex-string->bytes "1"))))
diff --git a/racket/collects/file/sha1.rkt b/racket/collects/file/sha1.rkt
index f4afd9150e..8db3099dff 100644
--- a/racket/collects/file/sha1.rkt
+++ b/racket/collects/file/sha1.rkt
@@ -31,7 +31,8 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (provide sha1
          sha1-bytes
-         bytes->hex-string)
+         bytes->hex-string
+         hex-string->bytes)
 
 (define 32-mask #xFFFFFFFF)
 
@@ -308,3 +309,24 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
         (bytes-set! bstr2 (* 2 i) (digit (arithmetic-shift c -4)))
         (bytes-set! bstr2 (+ (* 2 i) 1) (digit (bitwise-and c #xF)))))
     (bytes->string/latin-1 bstr2)))
+
+(define (hex-string->bytes s)
+  (unless (and (string? s) (regexp-match? #px"^([[:xdigit:]]{2})*$" s))
+    (raise-argument-error 'hex-string->bytes
+                          "string containing an even number of hexadecimal digits" s))
+  
+  (define (hex-char->int c)
+    (cond ((char<=? #\0 c #\9) (- (char->integer c) (char->integer #\0)))
+          ((char<=? #\a c #\f) (+ 10 (- (char->integer c) (char->integer #\a))))
+          ((char<=? #\A c #\F) (+ 10 (- (char->integer c) (char->integer #\A))))))
+  
+  (define bsize (/ (string-length s) 2))
+  (define b (make-bytes bsize))
+  
+  (for ((i (in-range bsize)))
+    (define high (hex-char->int (string-ref s (+ i i))))
+    (define low  (hex-char->int (string-ref s (+ i i 1))))
+    (bytes-set! b i (+ (arithmetic-shift high 4) low)))
+  
+  b)
+
diff --git a/racket/collects/openssl/sha1.rkt b/racket/collects/openssl/sha1.rkt
index 67283b4779..4f36d3a0ea 100644
--- a/racket/collects/openssl/sha1.rkt
+++ b/racket/collects/openssl/sha1.rkt
@@ -7,7 +7,8 @@
 
 (provide sha1
          sha1-bytes
-         (rename-out [r:bytes->hex-string bytes->hex-string]))
+         (rename-out [r:bytes->hex-string bytes->hex-string])
+         (rename-out [r:hex-string->bytes hex-string->bytes]))
 
 (define _SHA_CTX-pointer _pointer)