6ef1442dabeb — Linus Björnstam 4 years ago
Added hex.scm for working with hexadecimal.
1 files changed, 89 insertions(+), 0 deletions(-)

A => hex.scm
A => hex.scm +89 -0
@@ 0,0 1,89 @@ 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Copyright 2017, 2019 Linus Björnstam                                         ;;
+;;                                                                              ;;
+;; Permission to use, copy, modify, and/or distribute this software for any     ;;
+;; purpose with or without fee is hereby granted, provided that the above       ;;
+;; copyright notice and this permission notice appear in all source copies.     ;;
+;; The software is provided "as is", without any express or implied warranties. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; A small utility library to work with hexadecimal representations.
+;;; Provides procedures to convert bytevectors to bytevectors of hexadecimal pairs
+;;; and from hexadecimal pair bytevectors to strings and back.
+;;; The meat of this module is lookup-table based and could probably be made faster.
+;;; If you are sensitive to side-channel attacks, DO NOT USE THIS. Use a constant
+;;; time conversion, such as the one provided by libsodium.
+
+
+(define-module (hex)
+  #:use-module (rnrs bytevectors)
+  #:export (bin->hex
+            hex->bin
+            valid-hex-char?
+            bin->hexstr
+            hexstr->bin))
+
+
+(define hex-chars (vector 48 49 50 51 52 53 54 55 56 57 97 98 99 100 101 102))
+
+(define (bin->hex bin)
+  (let* ([bin-len (bytevector-length bin)]
+         [hex (make-bytevector (* bin-len 2) 0)])
+    (let loop ([i 0])
+      (when (< i bin-len)
+        (let ([b (bytevector-u8-ref bin i)]
+              [index (* i 2)])
+          (bytevector-u8-set! hex index (vector-ref hex-chars (logand (ash b -4) 15)))
+          (bytevector-u8-set! hex (+ 1 index) (vector-ref hex-chars (logand b 15))))
+        (loop (+ 1 i))))
+    hex))
+
+
+
+;; 256 elements. No byte will read out of bounds.
+(define char-hexs (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          0  1  2  3  4  5  6  7  8  9  #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f 10 11 12 13 14 15 #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f 10 11 12 13 14 15 #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+                          #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
+
+
+;; Converts bytvector with hexbytes hex to a bytevector of bytes. Works only
+;; on pair hexadecimal, ie: 1 is 01, not 1.
+(define (hex->bin hex)
+  (if (odd? (bytevector-length hex))
+      (error "hex->bin only works with bytevectors of even length.")
+      (let* ([bin-len (euclidean/ (bytevector-length hex) 2)]
+             [bin (make-bytevector bin-len 0)])
+        (let loop ([i 0])
+          (when (< i bin-len)
+            (let ([fst (vector-ref char-hexs (bytevector-u8-ref hex (* i 2)))]
+                  [snd (vector-ref char-hexs (bytevector-u8-ref hex (+ (* i 2) 1)))])
+              (unless (and fst snd)
+                (error 'hex->bin "non-hex byte in bytevector hex"))
+              (bytevector-u8-set! bin i (+ (* fst 16) snd))
+              (loop (+ 1 i)))))
+        bin)))
+
+
+(define (valid-hex-char? ch)
+  (or (and (char>=? ch #\0) (char<=? ch #\9))
+      (and (char-ci>=? ch #\A) (char-ci<=? ch #\F))))
+
+(define (bin->hexstr bin)
+  (utf8->string (bin->hex bin)))
+
+(define (hexstr->bin str)
+  (hex->bin (string->utf8 str)))
+