diff options
| -rw-r--r-- | guix/utils.scm | 28 | ||||
| -rw-r--r-- | tests/utils.scm | 7 |
2 files changed, 35 insertions, 0 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 65e89a0e1b..77ed9ce6ee 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -35,6 +35,7 @@ bytevector->base16-string base32-string->bytevector nix-base32-string->bytevector + base16-string->bytevector sha256 %nixpkgs-directory @@ -327,6 +328,33 @@ starting from the right of S." (loop (+ 1 i) (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. diff --git a/tests/utils.scm b/tests/utils.scm index edea11db72..db4eb5a340 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -62,6 +62,13 @@ ;; Examples from RFC 4648. (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. (test-skip (if (false-if-exception (system* "nix-hash" "--version")) 0 |