Add `base16-string->bytevector'.

* guix/utils.scm (base16-string->bytevector): New procedure.

* tests/utils.scm ("bytevector->base16-string->bytevector"): New test.
This commit is contained in:
Ludovic Courtès 2012-06-09 16:34:18 +02:00
parent c8369cacce
commit 6d800a80ea
2 changed files with 35 additions and 0 deletions

View File

@ -35,6 +35,7 @@
bytevector->base16-string bytevector->base16-string
base32-string->bytevector base32-string->bytevector
nix-base32-string->bytevector nix-base32-string->bytevector
base16-string->bytevector
sha256 sha256
%nixpkgs-directory %nixpkgs-directory
@ -327,6 +328,33 @@ starting from the right of S."
(loop (+ 1 i) (loop (+ 1 i)
(cons (vector-ref chars (bytevector-u8-ref bv i)) r)))))) (cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))
(define base16-string->bytevector
(let ((chars->value (fold (lambda (i r)
(vhash-consv (string-ref (number->string i 16)
0)
i r))
vlist-null
(iota 16))))
(lambda (s)
"Return the bytevector whose hexadecimal representation is string S."
(define bv
(make-bytevector (quotient (string-length s) 2) 0))
(string-fold (lambda (chr i)
(let ((j (quotient i 2))
(v (and=> (vhash-assv chr chars->value) cdr)))
(if v
(if (zero? (logand i 1))
(bytevector-u8-set! bv j
(arithmetic-shift v 4))
(let ((w (bytevector-u8-ref bv j)))
(bytevector-u8-set! bv j (logior v w))))
(error "invalid hexadecimal character" chr)))
(+ i 1))
0
s)
bv)))
;;; ;;;
;;; Hash. ;;; Hash.

View File

@ -62,6 +62,13 @@
;; Examples from RFC 4648. ;; Examples from RFC 4648.
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
(test-assert "bytevector->base16-string->bytevector"
(every (lambda (bv)
(equal? (base16-string->bytevector
(bytevector->base16-string bv))
bv))
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
;; The following tests requires `nix-hash' in $PATH. ;; The following tests requires `nix-hash' in $PATH.
(test-skip (if (false-if-exception (system* "nix-hash" "--version")) (test-skip (if (false-if-exception (system* "nix-hash" "--version"))
0 0