Merge branch 'master' into nix-integration

Conflicts:
	guix/store.scm

AUTHORS

@@ -1 +1,11 @@
-Ludovic Courtès <ludo@gnu.org>
+GNU Guix is consists of Scheme code that implements the deployment model
+of the Nix package management tool.  In fact, it currently talks to a
+build daemon whose code comes from Nix (see the manual for details.)
+
+Nix was initially written by Eelco Dolstra; other people have been
+contributing to it.  See `nix/AUTHORS' for details.
+
+GNU Guix was initiated by Ludovic Courtès <ludo@gnu.org>, but it would
+not be what it is without the contributions of the following people:
+
+  Nikita Karetnikov <nikita@karetnikov.org>

Makefile.am

@@ -27,6 +27,8 @@ MODULES =					\
   guix/utils.scm				\
   guix/derivations.scm				\
   guix/download.scm				\
+  guix/gnu-maintenance.scm			\
+  guix/licenses.scm				\
   guix/build-system.scm				\
   guix/build-system/gnu.scm			\
   guix/build-system/trivial.scm			\
@@ -41,6 +43,8 @@ MODULES =					\
   guix/snix.scm					\
   guix.scm					\
   distro.scm					\
+  distro/packages/acl.scm			\
+  distro/packages/attr.scm			\
   distro/packages/autotools.scm			\
   distro/packages/base.scm			\
   distro/packages/bash.scm			\
@@ -172,6 +176,7 @@ TESTS =						\
   tests/build-utils.scm				\
   tests/packages.scm				\
   tests/snix.scm				\
+  tests/store.scm				\
   tests/union.scm				\
   tests/guix-build.sh				\
   tests/guix-download.sh			\

THANKS

@@ -1,3 +1,9 @@
 A big thanks to Eelco Dolstra, who designed and implemented Nix.
 Transposing functional programming discipline to package management
 proved to be inspiring and fruitful.
+
+Thanks to the following people who contributed to GNU Guix through
+suggestions, bug reports, patches, or general infrastructure help:
+
+  Andreas Enge <andreas@enge.fr>
+  Jason Self <jself@gnu.org>

TODO

@@ -104,7 +104,6 @@ etc.
 ** add ‘--roll-back’
 ** add ‘--list-generations’, and ‘--delete-generations’
 ** add ‘--upgrade’
-** add ‘--list-installed’ and ‘--list-available’
 ** add ‘--search’
 
 * guix build utils

distro/packages/acl.scm

@@ -0,0 +1,61 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.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 (distro packages acl)
+  #:use-module (distro packages attr)
+  #:use-module (distro packages perl)
+  #:use-module ((distro packages gettext)
+                #:renamer (symbol-prefix-proc 'guix:))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu))
+
+(define-public acl
+  (package
+    (name "acl")
+    (version "2.2.51")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://savannah/acl/acl-"
+                          version ".src.tar.gz"))
+      (sha256
+       (base32
+        "09aj30m49ivycl3irram8c3givc0crivjm3ymw0nhfaxrwhlb186"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (alist-replace 'check
+                      (lambda _
+                        (patch-shebang "test/run")
+                        (system* "make" "tests" "-C" "test")
+
+                        ;; XXX: Ignore the test result since this is
+                        ;; dependent on the underlying file system.
+                        #t)
+                      %standard-phases)))
+    (inputs `(("attr" ,attr)
+              ("gettext" ,guix:gettext)
+              ("perl" ,perl)))
+    (home-page
+     "http://savannah.nongnu.org/projects/acl")
+    (synopsis
+     "Library and tools for manipulating access control lists")
+    (description
+     "Library and tools for manipulating access control lists.")
+    (license '("GPLv2+" "LGPLv2.1+"))))

distro/packages/attr.scm

@@ -0,0 +1,68 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
+;;; 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 (distro packages attr)
+  #:use-module (distro packages perl)
+  #:use-module ((distro packages gettext)
+                #:renamer (symbol-prefix-proc 'guix:))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu))
+
+(define-public attr
+  (package
+    (name "attr")
+    (version "2.4.46")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://savannah/attr/attr-"
+                          version ".src.tar.gz"))
+      (sha256
+       (base32
+        "07qf6kb2zk512az481bbnsk9jycn477xpva1a726n5pzlzf9pmnw"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (alist-replace 'install
+                      (lambda _
+                        (zero? (system* "make"
+                                        "install"
+                                        "install-lib"
+                                        "install-dev")))
+                      (alist-replace 'check
+                                     (lambda _
+                                       (for-each patch-shebang
+                                                 (find-files "test" ".*"))
+                                       (system* "make" "tests" "-C" "test")
+
+                                       ;; XXX: Ignore the test result since
+                                       ;; this is dependent on the underlying
+                                       ;; file system.
+                                       #t)
+                                     %standard-phases))))
+    (inputs `(("perl" ,perl)
+              ("gettext" ,guix:gettext)))
+    (home-page
+     "http://savannah.nongnu.org/projects/attr/")
+    (synopsis
+     "Library and tools for manipulating extended attributes")
+    (description
+     "Portable library and tools for manipulating extended attributes.")
+    (license '("GPLv2+" "LGPLv2.1+"))))

doc/guix.texi

@@ -210,7 +210,7 @@ want to roll back.
 @table @code
 
 @item --install=@var{package}
-@itemx -x @var{package}
+@itemx -i @var{package}
 Install @var{package}.
 
 @var{package} may specify either a simple package name, such as

guix/download.scm

@@ -65,7 +65,7 @@
        "ftp://mirror.cict.fr/gnupg/"
        "ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/")
       (savannah
-       "http://download.savannah.gnu.org/"
+       "http://download.savannah.gnu.org/releases/"
        "ftp://ftp.twaren.net/Unix/NonGNU/"
        "ftp://mirror.csclub.uwaterloo.ca/nongnu/"
        "ftp://mirror.publicns.net/pub/nongnu/"

guix/gnu-maintenance.scm

@@ -0,0 +1,57 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
+;;; 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 gnu-maintenance)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:export (official-gnu-packages))
+
+(define (http-fetch uri)
+  "Return a string containing the textual data at URI, a string."
+  (let*-values (((resp data)
+                (http-get (string->uri uri)))
+               ((code)
+                (response-code resp)))
+    (case code
+      ((200)
+       data)
+      (else
+       (error "download failed:" uri code
+              (response-reason-phrase resp))))))
+
+(define %package-list-url
+  (string-append "http://cvs.savannah.gnu.org/"
+                 "viewvc/*checkout*/gnumaint/"
+                 "gnupackages.txt?root=womb"))
+
+(define (official-gnu-packages)
+  "Return a list of GNU packages."
+  (define %package-line-rx
+    (make-regexp "^package: (.+)$"))
+
+  (let ((lst (string-split (http-fetch %package-list-url) #\nl)))
+    (filter-map (lambda (line)
+                  (and=> (regexp-exec %package-line-rx line)
+                         (cut match:substring <> 1)))
+                lst)))

guix/licenses.scm

@@ -0,0 +1,171 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.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 licenses)
+  #:use-module (srfi srfi-9)
+  #:export (license? license-name license-uri license-comment
+            asl2.0
+            boost1.0
+            bsd-2 bsd-3 bsd-4
+            cddl1.0
+            cpl1.0
+            epl1.0
+            gpl2 gpl2+ gpl3 gpl3+
+            ijg
+            ibmpl1.0
+            lgpl2.1 lgpl2.1+ lgpl3 lgpl3+
+            mpl2.0
+            openssl
+            public-domain
+            x11
+            zlib))
+
+(define-record-type <license>
+  (license name uri comment)
+  license?
+  (name    license-name)
+  (uri     license-uri)
+  (comment license-comment))
+
+;;; Commentary:
+;;;
+;;; Available licenses.
+;;;
+;;; This list is based on these links:
+;;; https://github.com/NixOS/nixpkgs/blob/master/pkgs/lib/licenses.nix
+;;; https://www.gnu.org/licenses/license-list
+;;;
+;;; Code:
+
+(define asl2.0
+  (license "ASL 2.0"
+           "http://directory.fsf.org/wiki/License:Apache2.0"
+           "https://www.gnu.org/licenses/license-list#apache2"))
+
+(define boost1.0
+  (license "Boost 1.0"
+           "http://directory.fsf.org/wiki/License:Boost1.0"
+           "https://www.gnu.org/licenses/license-list#boost"))
+
+(define bsd-2
+  (license "FreeBSD"
+           "http://directory.fsf.org/wiki/License:FreeBSD"
+           "https://www.gnu.org/licenses/license-list#FreeBSD"))
+
+(define bsd-3
+  (license "Modified BSD"
+           "http://directory.fsf.org/wiki/License:BSD_3Clause"
+           "https://www.gnu.org/licenses/license-list#ModifiedBSD"))
+
+(define bsd-4
+  (license "Original BSD"
+           "http://directory.fsf.org/wiki/License:BSD_4Clause"
+           "https://www.gnu.org/licenses/license-list#OriginalBSD"))
+
+(define cddl1.0
+  (license "CDDL 1.0"
+           "http://directory.fsf.org/wiki/License:CDDLv1.0"
+           "https://www.gnu.org/licenses/license-list#CDDL"))
+
+(define cpl1.0
+  (license "CPL 1.0"
+           "http://directory.fsf.org/wiki/License:CPLv1.0"
+           "https://www.gnu.org/licenses/license-list#CommonPublicLicense10"))
+
+(define epl1.0
+  (license "EPL 1.0"
+           "http://directory.fsf.org/wiki/License:EPLv1.0"
+           "https://www.gnu.org/licenses/license-list#EPL"))
+
+(define gpl2
+  (license "GPL 2"
+           "https://www.gnu.org/licenses/old-licenses/gpl-2.0.html"
+           "https://www.gnu.org/licenses/license-list#GPLv2"))
+
+(define gpl2+
+  (license "GPL 2+"
+           "https://www.gnu.org/licenses/old-licenses/gpl-2.0.html"
+           "https://www.gnu.org/licenses/license-list#GPLv2"))
+
+(define gpl3
+  (license "GPL 3"
+           "https://www.gnu.org/licenses/gpl.html"
+           "https://www.gnu.org/licenses/license-list#GNUGPLv3"))
+
+(define gpl3+
+  (license "GPL 3+"
+           "https://www.gnu.org/licenses/gpl.html"
+           "https://www.gnu.org/licenses/license-list#GNUGPLv3"))
+
+(define ijg
+  (license "IJG"
+           "http://directory.fsf.org/wiki/License:JPEG"
+           "https://www.gnu.org/licenses/license-list#ijg"))
+
+(define ibmpl1.0
+  (license "IBMPL 1.0"
+           "http://directory.fsf.org/wiki/License:IBMPLv1.0"
+           "https://www.gnu.org/licenses/license-list#IBMPL"))
+
+(define lgpl2.1
+  (license "LGPL 2.1"
+           "https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html"
+           "https://www.gnu.org/licenses/license-list#LGPLv2.1"))
+
+(define lgpl2.1+
+  (license "LGPL 2.1+"
+           "https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html"
+           "https://www.gnu.org/licenses/license-list#LGPLv2.1"))
+
+(define lgpl3
+  (license "LGPL 3"
+           "https://www.gnu.org/licenses/lgpl.html"
+           "https://www.gnu.org/licenses/license-list#LGPLv3"))
+
+(define lgpl3+
+  (license "LGPL 3+"
+           "https://www.gnu.org/licenses/lgpl.html"
+           "https://www.gnu.org/licenses/license-list#LGPLv3"))
+
+(define mpl2.0
+  (license "MPL 2.0"
+           "http://directory.fsf.org/wiki/License:MPLv2.0"
+           "https://www.gnu.org/licenses/license-list#MPL-2.0"))
+
+(define openssl
+  (license "OpenSSL"
+           "http://directory.fsf.org/wiki/License:OpenSSL"
+           "https://www.gnu.org/licenses/license-list#OpenSSL"))
+
+(define public-domain
+  (license "Public Domain"
+           "http://directory.fsf.org/wiki/License:PublicDomain"
+           "https://www.gnu.org/licenses/license-list#PublicDomain"))
+
+(define x11
+  (license "X11"
+           "http://directory.fsf.org/wiki/License:X11"
+           "https://www.gnu.org/licenses/license-list#X11License"))
+
+(define zlib
+  (license "Zlib"
+           "http://www.gzip.org/zlib/zlib_license.html"
+           "https://www.gnu.org/licenses/license-list#ZLib"))
+
+;;; licenses.scm ends here

guix/store.scm

@@ -51,8 +51,14 @@
             add-text-to-store
             add-to-store
             build-derivations
+            add-temp-root
             add-indirect-root
 
+            live-paths
+            dead-paths
+            collect-garbage
+            delete-paths
+
             current-build-output-port
 
             %store-prefix
@@ -112,6 +118,13 @@
   (sha1 2)
   (sha256 3))
 
+(define-enumerate-type gc-action
+  ;; store-api.hh
+  (return-live 0)
+  (return-dead 1)
+  (delete-dead 2)
+  (delete-specific 3))
+
 (define %default-socket-path
   (string-append (or (getenv "NIX_STATE_DIR") %state-directory)
                  "/daemon-socket/socket"))
@@ -133,6 +146,10 @@
     (bytevector-u64-set! b 0 n (endianness little))
     (put-bytevector p b)))
 
+(define (read-long-long p)
+  (let ((b (get-bytevector-n p 8)))
+    (bytevector-u64-ref b 0 (endianness little))))
+
 (define write-padding
   (let ((zero (make-bytevector 8 0)))
     (lambda (n p)
@@ -159,9 +176,23 @@
   (write-int (length l) p)
   (for-each (cut write-string <> p) l))
 
+(define (read-string-list p)
+  (let ((len (read-int p)))
+    (unfold (cut >= <> len)
+            (lambda (i)
+              (read-string p))
+            1+
+            0)))
+
+(define (write-store-path f p)
+  (write-string f p))                             ; TODO: assert path
+
 (define (read-store-path p)
   (read-string p))                                ; TODO: assert path
 
+(define write-store-path-list write-string-list)
+(define read-store-path-list read-string-list)
+
 (define (write-contents file p)
   "Write the contents of FILE to output port P."
   (define (dump in size)
@@ -223,7 +254,8 @@
       (write-string ")" p))))
 
 (define-syntax write-arg
-  (syntax-rules (integer boolean file string string-list base16)
+  (syntax-rules (integer boolean file string string-list
+                 store-path store-path-list base16)
     ((_ integer arg p)
      (write-int arg p))
     ((_ boolean arg p)
@@ -234,11 +266,15 @@
      (write-string arg p))
     ((_ string-list arg p)
      (write-string-list arg p))
+    ((_ store-path arg p)
+     (write-store-path arg p))
+    ((_ store-path-list arg p)
+     (write-store-path-list arg p))
     ((_ base16 arg p)
      (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path base16)
+  (syntax-rules (integer boolean string store-path store-path-list base16)
     ((_ integer p)
      (read-int p))
     ((_ boolean p)
@@ -247,6 +283,8 @@
      (read-string p))
     ((_ store-path p)
      (read-store-path p))
+    ((_ store-path-list p)
+     (read-store-path-list p))
     ((_ hash p)
      (base16-string->bytevector (read-string p)))))
 
@@ -385,7 +423,7 @@ again until #t is returned or an error is raised."
 
 (define-syntax define-operation
   (syntax-rules ()
-    ((_ (name (type arg) ...) docstring return)
+    ((_ (name (type arg) ...) docstring return ...)
      (define (name server arg ...)
        docstring
        (let ((s (nix-server-socket server)))
@@ -395,7 +433,7 @@ again until #t is returned or an error is raised."
          ;; Loop until the server is done sending error output.
          (let loop ((done? (process-stderr server)))
            (or done? (loop (process-stderr server))))
-         (read-arg return s))))))
+         (values (read-arg return s) ...))))))
 
 (define-operation (valid-path? (string path))
   "Return #t when PATH is a valid store path."
@@ -424,6 +462,11 @@ FIXED? is for backward compatibility with old Nix versions and must be #t."
 Return #t on success."
   boolean)
 
+(define-operation (add-temp-root (store-path path))
+  "Make PATH a temporary root for the duration of the current session.
+Return #t."
+  boolean)
+
 (define-operation (add-indirect-root (string file-name))
   "Make FILE-NAME an indirect root for the garbage collector; FILE-NAME
 can be anywhere on the file system, but it must be an absolute file
@@ -431,6 +474,61 @@ name--it is the caller's responsibility to ensure that it is an absolute
 file name.  Return #t on success."
   boolean)
 
+(define (run-gc server action to-delete min-freed)
+  "Perform the garbage-collector operation ACTION, one of the
+`gc-action' values.  When ACTION is `delete-specific', the TO-DELETE is
+the list of store paths to delete.  IGNORE-LIVENESS? should always be
+#f.  MIN-FREED is the minimum amount of disk space to be freed, in
+bytes, before the GC can stop.  Return the list of store paths delete,
+and the number of bytes freed."
+  (let ((s (nix-server-socket server)))
+    (write-int (operation-id collect-garbage) s)
+    (write-int action s)
+    (write-store-path-list to-delete s)
+    (write-arg boolean #f s)                      ; ignore-liveness?
+    (write-long-long min-freed s)
+    (write-int 0 s)                               ; obsolete
+    (when (>= (nix-server-minor-version server) 5)
+      ;; Obsolete `use-atime' and `max-atime' parameters.
+      (write-int 0 s)
+      (write-int 0 s))
+
+    ;; Loop until the server is done sending error output.
+    (let loop ((done? (process-stderr server)))
+      (or done? (loop (process-stderr server))))
+
+    (let ((paths    (read-store-path-list s))
+          (freed    (read-long-long s))
+          (obsolete (read-long-long s)))
+     (values paths freed))))
+
+(define-syntax-rule (%long-long-max)
+  ;; Maximum unsigned 64-bit integer.
+  (- (expt 2 64) 1))
+
+(define (live-paths server)
+  "Return the list of live store paths---i.e., store paths still
+referenced, and thus not subject to being garbage-collected."
+  (run-gc server (gc-action return-live) '() (%long-long-max)))
+
+(define (dead-paths server)
+  "Return the list of dead store paths---i.e., store paths no longer
+referenced, and thus subject to being garbage-collected."
+  (run-gc server (gc-action return-dead) '() (%long-long-max)))
+
+(define* (collect-garbage server #:optional (min-freed (%long-long-max)))
+  "Collect garbage from the store at SERVER.  If MIN-FREED is non-zero,
+then collect at least MIN-FREED bytes.  Return the paths that were
+collected, and the number of bytes freed."
+  (run-gc server (gc-action delete-dead) '() min-freed))
+
+(define* (delete-paths server paths #:optional (min-freed (%long-long-max)))
+  "Delete PATHS from the store at SERVER, if they are no longer
+referenced.  If MIN-FREED is non-zero, then stop after at least
+MIN-FREED bytes have been collected.  Return the paths that were
+collected, and the number of bytes freed."
+  (run-gc server (gc-action delete-specific) paths min-freed))
+
 
 ;;;
 ;;; Store paths.

tests/store.scm

@@ -0,0 +1,87 @@
+;;; 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-store)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix base32)
+  #:use-module (distro packages bootstrap)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix store) module.
+
+(define %store
+  (false-if-exception (open-connection)))
+
+(when %store
+  ;; Make sure we build everything by ourselves.
+  (set-build-options %store #:use-substitutes? #f))
+
+(define %seed
+  (seed->random-state (logxor (getpid) (car (gettimeofday)))))
+
+(define (random-text)
+  (number->string (random (expt 2 256) %seed) 16))
+
+
+(test-begin "store")
+
+(test-skip (if %store 0 10))
+
+(test-assert "dead-paths"
+  (let ((p (add-text-to-store %store "random-text"
+                              (random-text) '())))
+    (member p (dead-paths %store))))
+
+;; FIXME: Find a test for `live-paths'.
+;;
+;; (test-assert "temporary root is in live-paths"
+;;   (let* ((p1 (add-text-to-store %store "random-text"
+;;                                 (random-text) '()))
+;;          (b  (add-text-to-store %store "link-builder"
+;;                                 (format #f "echo ~a > $out" p1)
+;;                                 '()))
+;;          (d1 (derivation %store "link" (%current-system)
+;;                          "/bin/sh" `("-e" ,b) '()
+;;                          `((,b) (,p1))))
+;;          (p2 (derivation-path->output-path d1)))
+;;     (and (add-temp-root %store p2)
+;;          (build-derivations %store (list d1))
+;;          (valid-path? %store p1)
+;;          (member (pk p2) (live-paths %store)))))
+
+(test-assert "dead path can be explicitly collected"
+  (let ((p (add-text-to-store %store "random-text"
+                              (random-text) '())))
+    (let-values (((paths freed) (delete-paths %store (list p))))
+      (and (equal? paths (list p))
+           (> freed 0)
+           (not (file-exists? p))))))
+
+(test-end "store")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'test-assert 'scheme-indent-function 1)
+;;; End: