diff options
| -rw-r--r-- | guix/utils.scm | 65 | ||||
| -rw-r--r-- | tests/utils.scm | 21 |
2 files changed, 77 insertions, 9 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index db37d432e8..ad7fe8583f 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -60,6 +60,40 @@ (let ((p (vector-ref refs (modulo index 8)))) (p bv (quotient (* index 5) 8)))))) +(define bytevector-quintet-ref-right + (let* ((ref bytevector-u8-ref) + (ref+ (lambda (bv offset) + (let ((o (+ 1 offset))) + (if (>= o (bytevector-length bv)) + 0 + (bytevector-u8-ref bv o))))) + (ref0 (lambda (bv offset) + (bit-field (ref bv offset) 0 5))) + (ref1 (lambda (bv offset) + (logior (bit-field (ref bv offset) 5 8) + (ash (bit-field (ref+ bv offset) 0 2) 3)))) + (ref2 (lambda (bv offset) + (bit-field (ref bv offset) 2 7))) + (ref3 (lambda (bv offset) + (logior (bit-field (ref bv offset) 7 8) + (ash (bit-field (ref+ bv offset) 0 4) 1)))) + (ref4 (lambda (bv offset) + (logior (bit-field (ref bv offset) 4 8) + (ash (bit-field (ref+ bv offset) 0 1) 4)))) + (ref5 (lambda (bv offset) + (bit-field (ref bv offset) 1 6))) + (ref6 (lambda (bv offset) + (logior (bit-field (ref bv offset) 6 8) + (ash (bit-field (ref+ bv offset) 0 3) 2)))) + (ref7 (lambda (bv offset) + (bit-field (ref bv offset) 3 8))) + (refs (vector ref0 ref1 ref2 ref3 ref4 ref5 ref6 ref7))) + (lambda (bv index) + "Return the INDEXth quintet of BV, assuming quintets start from the +least-significant bits, contrary to what RFC 4648 describes." + (let ((p (vector-ref refs (modulo index 8)))) + (p bv (quotient (* index 5) 8)))))) + (define (bytevector-quintet-length bv) "Return the number of quintets (including truncated ones) available in BV." (ceiling (/ (* (bytevector-length bv) 8) 5))) @@ -76,14 +110,27 @@ the previous application or INIT." r (loop (1+ i) (proc (bytevector-quintet-ref bv i) r))))) -(define (make-bytevector->base32-string base32-chars) +(define (bytevector-quintet-fold-right proc init bv) + "Return the result of applying PROC to each quintet of BV and the result of +the previous application or INIT." + (define len + (bytevector-quintet-length bv)) + + (let loop ((i len) + (r init)) + (if (zero? i) + r + (let ((j (- i 1))) + (loop j (proc (bytevector-quintet-ref-right bv j) r)))))) + +(define (make-bytevector->base32-string quintet-fold base32-chars) (lambda (bv) "Return a base32 encoding of BV using BASE32-CHARS as the alphabet." - (let ((chars (bytevector-quintet-fold (lambda (q r) - (cons (vector-ref base32-chars q) - r)) - '() - bv))) + (let ((chars (quintet-fold (lambda (q r) + (cons (vector-ref base32-chars q) + r)) + '() + bv))) (list->string (reverse chars))))) (define %nix-base32-chars @@ -98,10 +145,12 @@ the previous application or INIT." #\2 #\3 #\4 #\5 #\6 #\7)) (define bytevector->base32-string - (make-bytevector->base32-string %rfc4648-base32-chars)) + (make-bytevector->base32-string bytevector-quintet-fold + %rfc4648-base32-chars)) (define bytevector->nix-base32-string - (make-bytevector->base32-string %nix-base32-chars)) + (make-bytevector->base32-string bytevector-quintet-fold-right + %nix-base32-chars)) ;;; ;;; Hash. diff --git a/tests/utils.scm b/tests/utils.scm index 57705e6f48..eade84b5d4 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -22,7 +22,10 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors)) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 popen)) (test-begin "utils") @@ -43,6 +46,22 @@ "mzxw6ytb" "mzxw6ytboi"))) +;; The following tests requires `nix-hash' in $PATH. +(test-skip (if (false-if-exception (system* "nix-hash" "--version")) + 0 + 1)) + +(test-assert "sha256 & bytevector->nix-base32-string" + (let ((file (search-path %load-path "tests/test.drv"))) + (equal? (bytevector->nix-base32-string + (sha256 (call-with-input-file file get-bytevector-all))) + (let* ((c (format #f "nix-hash --type sha256 --base32 --flat \"~a\"" + file)) + (p (open-input-pipe c)) + (l (read-line p))) + (close-pipe p) + l)))) + (test-end) |