summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--guix-download.in1
-rw-r--r--guix.scm3
-rw-r--r--guix/base32.scm288
-rw-r--r--guix/derivations.scm1
-rw-r--r--guix/packages.scm1
-rw-r--r--guix/snix.scm1
-rw-r--r--guix/utils.scm264
-rw-r--r--tests/base32.scm93
-rw-r--r--tests/builders.scm1
-rw-r--r--tests/derivations.scm1
-rw-r--r--tests/utils.scm58
12 files changed, 392 insertions, 322 deletions
diff --git a/Makefile.am b/Makefile.am
index b0fefae968..b29bf6584b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -23,6 +23,7 @@ bin_SCRIPTS =					\
   guix-package
 
 MODULES =					\
+  guix/base32.scm				\
   guix/utils.scm				\
   guix/derivations.scm				\
   guix/build-system.scm				\
@@ -137,6 +138,7 @@ distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz:
 nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
 
 TESTS =						\
+  tests/base32.scm				\
   tests/builders.scm				\
   tests/derivations.scm				\
   tests/utils.scm				\
diff --git a/guix-download.in b/guix-download.in
index 8a3c2c4100..46efaa17e8 100644
--- a/guix-download.in
+++ b/guix-download.in
@@ -36,6 +36,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix base32)
   #:use-module (guix ftp-client)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
diff --git a/guix.scm b/guix.scm
index 8427780f47..1e136372bc 100644
--- a/guix.scm
+++ b/guix.scm
@@ -23,7 +23,8 @@
 (eval-when (eval load compile)
   (begin
     (define %public-modules
-      '(build-system
+      '(base32
+        build-system
         derivations
         ftp-client
         ftp
diff --git a/guix/base32.scm b/guix/base32.scm
new file mode 100644
index 0000000000..6f0a92bd99
--- /dev/null
+++ b/guix/base32.scm
@@ -0,0 +1,288 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guix.
+;;;
+;;; Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix base32)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-60)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 vlist)
+  #:export (bytevector-quintet-length
+            bytevector->base32-string
+            bytevector->nix-base32-string
+            base32-string->bytevector
+            nix-base32-string->bytevector))
+
+;;; Commentary:
+;;;
+;;; A generic, customizable to convert bytevectors to/from a base32
+;;; representation.
+;;;
+;;; Code:
+
+(define bytevector-quintet-ref
+  (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) 3 8)))
+         (ref1 (lambda (bv offset)
+                 (logior (ash (bit-field (ref bv offset) 0 3) 2)
+                         (bit-field (ref+ bv offset) 6 8))))
+         (ref2 (lambda (bv offset)
+                 (bit-field (ref bv offset) 1 6)))
+         (ref3 (lambda (bv offset)
+                 (logior (ash (bit-field (ref bv offset) 0 1) 4)
+                         (bit-field (ref+ bv offset) 4 8))))
+         (ref4 (lambda (bv offset)
+                 (logior (ash (bit-field (ref bv offset) 0 4) 1)
+                         (bit-field (ref+ bv offset) 7 8))))
+         (ref5 (lambda (bv offset)
+                 (bit-field (ref bv offset) 2 7)))
+         (ref6 (lambda (bv offset)
+                 (logior (ash (bit-field (ref bv offset) 0 2) 3)
+                         (bit-field (ref+ bv offset) 5 8))))
+         (ref7 (lambda (bv offset)
+                 (bit-field (ref bv offset) 0 5)))
+         (refs (vector ref0 ref1 ref2 ref3 ref4 ref5 ref6 ref7)))
+    (lambda (bv index)
+      "Return the INDEXth quintet of BV."
+      (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)))
+
+(define (bytevector-quintet-fold 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 0)
+             (r init))
+    (if (= i len)
+        r
+        (loop (1+ i) (proc (bytevector-quintet-ref bv i) r)))))
+
+(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 (quintet-fold (lambda (q r)
+                                 (cons (vector-ref base32-chars q)
+                                       r))
+                               '()
+                               bv)))
+      (list->string (reverse chars)))))
+
+(define %nix-base32-chars
+  ;; See `libutil/hash.cc'.
+  #(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+    #\a #\b #\c #\d #\f #\g #\h #\i #\j #\k #\l #\m #\n
+    #\p #\q #\r #\s #\v #\w #\x #\y #\z))
+
+(define %rfc4648-base32-chars
+  #(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+    #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
+    #\2 #\3 #\4 #\5 #\6 #\7))
+
+(define bytevector->base32-string
+  (make-bytevector->base32-string bytevector-quintet-fold
+                                  %rfc4648-base32-chars))
+
+(define bytevector->nix-base32-string
+  (make-bytevector->base32-string bytevector-quintet-fold-right
+                                  %nix-base32-chars))
+
+
+(define bytevector-quintet-set!
+  (let* ((setq! (lambda (bv offset start stop value)
+                  (let ((v (bytevector-u8-ref bv offset))
+                        (w (arithmetic-shift value start))
+                        (m (bitwise-xor (1- (expt 2 stop))
+                                        (1- (expt 2 start)))))
+                    (bytevector-u8-set! bv offset
+                                        (bitwise-merge m w v)))))
+         (set0! (lambda (bv offset value)
+                  (setq! bv offset 3 8 value)))
+         (set1! (lambda (bv offset value)
+                  (setq! bv offset 0 3 (bit-field value 2 5))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 6 8 (bit-field value 0 2)))))
+         (set2! (lambda (bv offset value)
+                  (setq! bv offset 1 6 value)))
+         (set3! (lambda (bv offset value)
+                  (setq! bv offset 0 1 (bit-field value 4 5))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 4 8 (bit-field value 0 4)))))
+         (set4! (lambda (bv offset value)
+                  (setq! bv offset 0 4 (bit-field value 1 5))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 7 8  (bit-field value 0 1)))))
+         (set5! (lambda (bv offset value)
+                  (setq! bv offset 2 7 value)))
+         (set6! (lambda (bv offset value)
+                  (setq! bv offset 0 2 (bit-field value 3 5))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 5 8 (bit-field value 0 3)))))
+         (set7! (lambda (bv offset value)
+                  (setq! bv offset 0 5 value)))
+         (sets  (vector set0! set1! set2! set3! set4! set5! set6! set7!)))
+    (lambda (bv index value)
+      "Set the INDEXth quintet of BV to VALUE."
+      (let ((p (vector-ref sets (modulo index 8))))
+        (p bv (quotient (* index 5) 8) (logand value #x1f))))))
+
+(define bytevector-quintet-set-right!
+  (let* ((setq! (lambda (bv offset start stop value)
+                  (let ((v (bytevector-u8-ref bv offset))
+                        (w (arithmetic-shift value start))
+                        (m (bitwise-xor (1- (expt 2 stop))
+                                        (1- (expt 2 start)))))
+                    (bytevector-u8-set! bv offset
+                                        (bitwise-merge m w v)))))
+         (set0! (lambda (bv offset value)
+                  (setq! bv offset 0 5 value)))
+         (set1! (lambda (bv offset value)
+                  (setq! bv offset 5 8 (bit-field value 0 3))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 0 2 (bit-field value 3 5)))))
+         (set2! (lambda (bv offset value)
+                  (setq! bv offset 2 7 value)))
+         (set3! (lambda (bv offset value)
+                  (setq! bv offset 7 8 (bit-field value 0 1))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 0 4 (bit-field value 1 5)))))
+         (set4! (lambda (bv offset value)
+                  (setq! bv offset 4 8 (bit-field value 0 4))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 0 1 (bit-field value 4 5)))))
+         (set5! (lambda (bv offset value)
+                  (setq! bv offset 1 6 value)))
+         (set6! (lambda (bv offset value)
+                  (setq! bv offset 6 8 (bit-field value 0 2))
+                  (or (= (+ 1 offset) (bytevector-length bv))
+                      (setq! bv (+ 1 offset) 0 3 (bit-field value 2 5)))))
+         (set7! (lambda (bv offset value)
+                  (setq! bv offset 3 8 value)))
+         (sets  (vector set0! set1! set2! set3! set4! set5! set6! set7!)))
+    (lambda (bv index value)
+      "Set the INDEXth quintet of BV to VALUE, assuming quintets start from
+the least-significant bits."
+      (let ((p (vector-ref sets (modulo index 8))))
+        (p bv (quotient (* index 5) 8) (logand value #x1f))))))
+
+(define (base32-string-unfold f s)
+  "Given procedure F which, when applied to a character, returns the
+corresponding quintet, return the bytevector corresponding to string S."
+  (define len (string-length s))
+
+  (let ((bv (make-bytevector (quotient (* len 5) 8))))
+    (string-fold (lambda (chr index)
+                   (bytevector-quintet-set! bv index (f chr))
+                   (+ 1 index))
+                 0
+                 s)
+    bv))
+
+(define (base32-string-unfold-right f s)
+  "Given procedure F which, when applied to a character, returns the
+corresponding quintet, return the bytevector corresponding to string S,
+starting from the right of S."
+  (define len (string-length s))
+
+  (let ((bv (make-bytevector (quotient (* len 5) 8))))
+    (string-fold-right (lambda (chr index)
+                         (bytevector-quintet-set-right! bv index (f chr))
+                         (+ 1 index))
+                       0
+                       s)
+    bv))
+
+(define (make-base32-string->bytevector base32-string-unfold base32-chars)
+  (let ((char->value (let loop ((i 0)
+                                (v vlist-null))
+                       (if (= i (vector-length base32-chars))
+                           v
+                           (loop (+ 1 i)
+                                 (vhash-consv (vector-ref base32-chars i)
+                                              i v))))))
+    (lambda (s)
+      "Return the binary representation of base32 string S as a bytevector."
+      (base32-string-unfold (lambda (chr)
+                              (or (and=> (vhash-assv chr char->value) cdr)
+                                  (error "invalid base32 character" chr)))
+                            s))))
+
+(define base32-string->bytevector
+  (make-base32-string->bytevector base32-string-unfold %rfc4648-base32-chars))
+
+(define nix-base32-string->bytevector
+  (make-base32-string->bytevector base32-string-unfold-right %nix-base32-chars))
+
+;;; base32.scm ends here
diff --git a/guix/derivations.scm b/guix/derivations.scm
index cbf755ab63..cda1f065d4 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -26,6 +26,7 @@
   #:use-module (ice-9 rdelim)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix base32)
   #:export (<derivation>
             derivation?
             derivation-outputs
diff --git a/guix/packages.scm b/guix/packages.scm
index 9d1dbe7dc4..23761f4101 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -19,6 +19,7 @@
 (define-module (guix packages)
   #:use-module (guix utils)
   #:use-module (guix store)
+  #:use-module (guix base32)
   #:use-module (guix build-system)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
diff --git a/guix/snix.scm b/guix/snix.scm
index ef98eb42a0..c6a9bee6a7 100644
--- a/guix/snix.scm
+++ b/guix/snix.scm
@@ -32,6 +32,7 @@
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
   #:use-module (guix utils)
+  #:use-module (guix base32)
   #:use-module (guix config)
   #:export (open-nixpkgs
             xml->snix
diff --git a/guix/utils.scm b/guix/utils.scm
index fa5abadc7a..ff8730aa63 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -33,12 +33,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:autoload   (system foreign) (pointer->procedure)
-  #:export (bytevector-quintet-length
-            bytevector->base32-string
-            bytevector->nix-base32-string
-            bytevector->base16-string
-            base32-string->bytevector
-            nix-base32-string->bytevector
+  #:export (bytevector->base16-string
             base16-string->bytevector
             sha256
 
@@ -81,263 +76,6 @@ evaluate to a simple datum."
 
 
 ;;;
-;;; Base 32.
-;;;
-
-(define bytevector-quintet-ref
-  (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) 3 8)))
-         (ref1 (lambda (bv offset)
-                 (logior (ash (bit-field (ref bv offset) 0 3) 2)
-                         (bit-field (ref+ bv offset) 6 8))))
-         (ref2 (lambda (bv offset)
-                 (bit-field (ref bv offset) 1 6)))
-         (ref3 (lambda (bv offset)
-                 (logior (ash (bit-field (ref bv offset) 0 1) 4)
-                         (bit-field (ref+ bv offset) 4 8))))
-         (ref4 (lambda (bv offset)
-                 (logior (ash (bit-field (ref bv offset) 0 4) 1)
-                         (bit-field (ref+ bv offset) 7 8))))
-         (ref5 (lambda (bv offset)
-                 (bit-field (ref bv offset) 2 7)))
-         (ref6 (lambda (bv offset)
-                 (logior (ash (bit-field (ref bv offset) 0 2) 3)
-                         (bit-field (ref+ bv offset) 5 8))))
-         (ref7 (lambda (bv offset)
-                 (bit-field (ref bv offset) 0 5)))
-         (refs (vector ref0 ref1 ref2 ref3 ref4 ref5 ref6 ref7)))
-    (lambda (bv index)
-      "Return the INDEXth quintet of BV."
-      (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)))
-
-(define (bytevector-quintet-fold 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 0)
-             (r init))
-    (if (= i len)
-        r
-        (loop (1+ i) (proc (bytevector-quintet-ref bv i) r)))))
-
-(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 (quintet-fold (lambda (q r)
-                                 (cons (vector-ref base32-chars q)
-                                       r))
-                               '()
-                               bv)))
-      (list->string (reverse chars)))))
-
-(define %nix-base32-chars
-  ;; See `libutil/hash.cc'.
-  #(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
-    #\a #\b #\c #\d #\f #\g #\h #\i #\j #\k #\l #\m #\n
-    #\p #\q #\r #\s #\v #\w #\x #\y #\z))
-
-(define %rfc4648-base32-chars
-  #(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
-    #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
-    #\2 #\3 #\4 #\5 #\6 #\7))
-
-(define bytevector->base32-string
-  (make-bytevector->base32-string bytevector-quintet-fold
-                                  %rfc4648-base32-chars))
-
-(define bytevector->nix-base32-string
-  (make-bytevector->base32-string bytevector-quintet-fold-right
-                                  %nix-base32-chars))
-
-
-(define bytevector-quintet-set!
-  (let* ((setq! (lambda (bv offset start stop value)
-                  (let ((v (bytevector-u8-ref bv offset))
-                        (w (arithmetic-shift value start))
-                        (m (bitwise-xor (1- (expt 2 stop))
-                                        (1- (expt 2 start)))))
-                    (bytevector-u8-set! bv offset
-                                        (bitwise-merge m w v)))))
-         (set0! (lambda (bv offset value)
-                  (setq! bv offset 3 8 value)))
-         (set1! (lambda (bv offset value)
-                  (setq! bv offset 0 3 (bit-field value 2 5))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 6 8 (bit-field value 0 2)))))
-         (set2! (lambda (bv offset value)
-                  (setq! bv offset 1 6 value)))
-         (set3! (lambda (bv offset value)
-                  (setq! bv offset 0 1 (bit-field value 4 5))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 4 8 (bit-field value 0 4)))))
-         (set4! (lambda (bv offset value)
-                  (setq! bv offset 0 4 (bit-field value 1 5))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 7 8  (bit-field value 0 1)))))
-         (set5! (lambda (bv offset value)
-                  (setq! bv offset 2 7 value)))
-         (set6! (lambda (bv offset value)
-                  (setq! bv offset 0 2 (bit-field value 3 5))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 5 8 (bit-field value 0 3)))))
-         (set7! (lambda (bv offset value)
-                  (setq! bv offset 0 5 value)))
-         (sets  (vector set0! set1! set2! set3! set4! set5! set6! set7!)))
-    (lambda (bv index value)
-      "Set the INDEXth quintet of BV to VALUE."
-      (let ((p (vector-ref sets (modulo index 8))))
-        (p bv (quotient (* index 5) 8) (logand value #x1f))))))
-
-(define bytevector-quintet-set-right!
-  (let* ((setq! (lambda (bv offset start stop value)
-                  (let ((v (bytevector-u8-ref bv offset))
-                        (w (arithmetic-shift value start))
-                        (m (bitwise-xor (1- (expt 2 stop))
-                                        (1- (expt 2 start)))))
-                    (bytevector-u8-set! bv offset
-                                        (bitwise-merge m w v)))))
-         (set0! (lambda (bv offset value)
-                  (setq! bv offset 0 5 value)))
-         (set1! (lambda (bv offset value)
-                  (setq! bv offset 5 8 (bit-field value 0 3))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 0 2 (bit-field value 3 5)))))
-         (set2! (lambda (bv offset value)
-                  (setq! bv offset 2 7 value)))
-         (set3! (lambda (bv offset value)
-                  (setq! bv offset 7 8 (bit-field value 0 1))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 0 4 (bit-field value 1 5)))))
-         (set4! (lambda (bv offset value)
-                  (setq! bv offset 4 8 (bit-field value 0 4))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 0 1 (bit-field value 4 5)))))
-         (set5! (lambda (bv offset value)
-                  (setq! bv offset 1 6 value)))
-         (set6! (lambda (bv offset value)
-                  (setq! bv offset 6 8 (bit-field value 0 2))
-                  (or (= (+ 1 offset) (bytevector-length bv))
-                      (setq! bv (+ 1 offset) 0 3 (bit-field value 2 5)))))
-         (set7! (lambda (bv offset value)
-                  (setq! bv offset 3 8 value)))
-         (sets  (vector set0! set1! set2! set3! set4! set5! set6! set7!)))
-    (lambda (bv index value)
-      "Set the INDEXth quintet of BV to VALUE, assuming quintets start from
-the least-significant bits."
-      (let ((p (vector-ref sets (modulo index 8))))
-        (p bv (quotient (* index 5) 8) (logand value #x1f))))))
-
-(define (base32-string-unfold f s)
-  "Given procedure F which, when applied to a character, returns the
-corresponding quintet, return the bytevector corresponding to string S."
-  (define len (string-length s))
-
-  (let ((bv (make-bytevector (quotient (* len 5) 8))))
-    (string-fold (lambda (chr index)
-                   (bytevector-quintet-set! bv index (f chr))
-                   (+ 1 index))
-                 0
-                 s)
-    bv))
-
-(define (base32-string-unfold-right f s)
-  "Given procedure F which, when applied to a character, returns the
-corresponding quintet, return the bytevector corresponding to string S,
-starting from the right of S."
-  (define len (string-length s))
-
-  (let ((bv (make-bytevector (quotient (* len 5) 8))))
-    (string-fold-right (lambda (chr index)
-                         (bytevector-quintet-set-right! bv index (f chr))
-                         (+ 1 index))
-                       0
-                       s)
-    bv))
-
-(define (make-base32-string->bytevector base32-string-unfold base32-chars)
-  (let ((char->value (let loop ((i 0)
-                                (v vlist-null))
-                       (if (= i (vector-length base32-chars))
-                           v
-                           (loop (+ 1 i)
-                                 (vhash-consv (vector-ref base32-chars i)
-                                              i v))))))
-    (lambda (s)
-      "Return the binary representation of base32 string S as a bytevector."
-      (base32-string-unfold (lambda (chr)
-                              (or (and=> (vhash-assv chr char->value) cdr)
-                                  (error "invalid base32 character" chr)))
-                            s))))
-
-(define base32-string->bytevector
-  (make-base32-string->bytevector base32-string-unfold %rfc4648-base32-chars))
-
-(define nix-base32-string->bytevector
-  (make-base32-string->bytevector base32-string-unfold-right %nix-base32-chars))
-
-
-
-;;;
 ;;; Base 16.
 ;;;
 
diff --git a/tests/base32.scm b/tests/base32.scm
new file mode 100644
index 0000000000..b8b9ebb0dd
--- /dev/null
+++ b/tests/base32.scm
@@ -0,0 +1,93 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guix.
+;;;
+;;; Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-base32)
+  #:use-module (guix base32)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 popen)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports))
+
+;; Test the (guix base32) module.
+
+(define %nix-hash
+  (or (getenv "NIX_HASH")
+      "nix-hash"))
+
+(test-begin "base32")
+
+(test-assert "bytevector->base32-string"
+  (fold (lambda (bv expected result)
+          (and result
+               (string=? (bytevector->base32-string bv)
+                         expected)))
+        #t
+
+        ;; Examples from RFC 4648.
+        (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))
+        '(""
+          "my"
+          "mzxq"
+          "mzxw6"
+          "mzxw6yq"
+          "mzxw6ytb"
+          "mzxw6ytboi")))
+
+(test-assert "base32-string->bytevector"
+  (every (lambda (bv)
+           (equal? (base32-string->bytevector
+                    (bytevector->base32-string bv))
+                   bv))
+         ;; Examples from RFC 4648.
+         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
+
+(test-assert "nix-base32-string->bytevector"
+  (every (lambda (bv)
+           (equal? (nix-base32-string->bytevector
+                    (bytevector->nix-base32-string bv))
+                   bv))
+         ;; Examples from RFC 4648.
+         (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
+               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 "~a --type sha256 --base32 --flat \"~a\""
+                              %nix-hash file))
+                   (p (open-input-pipe c))
+                   (l (read-line p)))
+              (close-pipe p)
+              l))))
+
+(test-end)
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'test-assert 'scheme-indent-function 1)
+;;; End:
diff --git a/tests/builders.scm b/tests/builders.scm
index 8b0fa117a9..d9dc5afa20 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -23,6 +23,7 @@
   #:use-module (guix build-system gnu)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix base32)
   #:use-module (guix derivations)
   #:use-module ((guix packages) #:select (package-derivation))
   #:use-module (distro packages bootstrap)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 01ede11af0..618a7c4b96 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -21,6 +21,7 @@
   #:use-module (guix derivations)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix base32)
   #:use-module ((guix packages) #:select (package-derivation))
   #:use-module (distro packages bootstrap)
   #:use-module (srfi srfi-1)
diff --git a/tests/utils.scm b/tests/utils.scm
index 1ced410d41..0a6e8a0833 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -16,59 +16,17 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-
 (define-module (test-utils)
   #:use-module (guix utils)
   #:use-module ((guix store) #:select (store-path-package-name))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 popen)
   #:use-module (ice-9 match))
 
-(define %nix-hash
-  (or (getenv "NIX_HASH")
-      "nix-hash"))
-
 (test-begin "utils")
 
-(test-assert "bytevector->base32-string"
-  (fold (lambda (bv expected result)
-          (and result
-               (string=? (bytevector->base32-string bv)
-                         expected)))
-        #t
-
-        ;; Examples from RFC 4648.
-        (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))
-        '(""
-          "my"
-          "mzxq"
-          "mzxw6"
-          "mzxw6yq"
-          "mzxw6ytb"
-          "mzxw6ytboi")))
-
-(test-assert "base32-string->bytevector"
-  (every (lambda (bv)
-           (equal? (base32-string->bytevector
-                    (bytevector->base32-string bv))
-                   bv))
-         ;; Examples from RFC 4648.
-         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
-
-(test-assert "nix-base32-string->bytevector"
-  (every (lambda (bv)
-           (equal? (nix-base32-string->bytevector
-                    (bytevector->nix-base32-string bv))
-                   bv))
-         ;; 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
@@ -76,22 +34,6 @@
                    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
-               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 "~a --type sha256 --base32 --flat \"~a\""
-                              %nix-hash file))
-                   (p (open-input-pipe c))
-                   (l (read-line p)))
-              (close-pipe p)
-              l))))
-
 (test-assert "gnu-triplet->nix-system"
   (let ((samples '(("i586-gnu0.3" "i686-gnu")
                    ("x86_64-unknown-linux-gnu" "x86_64-linux")