diff options
| -rw-r--r-- | configure.ac | 7 | ||||
| -rw-r--r-- | guix/config.scm.in | 5 | ||||
| -rw-r--r-- | guix/store.scm | 25 | ||||
| -rw-r--r-- | pre-inst-env.in | 4 | ||||
| -rw-r--r-- | tests/store.scm | 22 |
5 files changed, 60 insertions, 3 deletions
diff --git a/configure.ac b/configure.ac index 799b3e8152..749672f15b 100644 --- a/configure.ac +++ b/configure.ac @@ -38,10 +38,13 @@ AC_ARG_ENABLE([daemon], # Prepare a version of $localstatedir & co. that does not contain references # to shell variables. -guix_localstatedir="`eval echo $localstatedir | sed -e "s|NONE|/usr/local|g"`" -guix_sysconfdir="`eval echo $sysconfdir | sed -e "s|NONE|/usr/local|g"`" +guix_prefix="`eval echo $prefix | sed -e"s|NONE|/usr/local|g"`" +guix_localstatedir="`eval echo $localstatedir | sed -e "s|NONE|$guix_prefix|g"`" +guix_sysconfdir="`eval echo $sysconfdir | sed -e "s|NONE|$guix_prefix|g"`" +guix_sbindir="`eval echo $sbindir | sed -e "s|NONE|$guix_prefix|g"`" AC_SUBST([guix_localstatedir]) AC_SUBST([guix_sysconfdir]) +AC_SUBST([guix_sbindir]) dnl We require the pkg.m4 set of macros from pkg-config. dnl Make sure it's available. diff --git a/guix/config.scm.in b/guix/config.scm.in index 3a5c50e00a..5edb4ced30 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -24,6 +24,7 @@ %store-directory %state-directory %config-directory + %guix-register-program %system %libgcrypt %nixpkgs @@ -62,6 +63,10 @@ ;; This must match `NIX_CONF_DIR' as defined in `daemon.am'. (or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix")) +(define %guix-register-program + ;; The 'guix-register' program. + (or (getenv "GUIX_REGISTER") "@guix_sbindir@/guix-register")) + (define %system "@guix_system@") diff --git a/guix/store.scm b/guix/store.scm index 8ad32b2fd5..393eee8d1b 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -33,6 +33,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 vlist) + #:use-module (ice-9 popen) #:export (%daemon-socket-file nix-server? @@ -85,6 +86,8 @@ current-build-output-port + register-path + %store-prefix store-path? direct-store-path? @@ -694,6 +697,28 @@ is true." (and (export-path server head port #:sign? sign?) (loop tail))))))) +(define* (register-path path + #:key (references '()) deriver) + "Register PATH as a valid store file, with REFERENCES as its list of +references, and DERIVER as its deriver (.drv that led to it.) Return #t on +success. + +Use with care as it directly modifies the store! This is primarily meant to +be used internally by the daemon's build hook." + ;; Currently this is implemented by calling out to the fine C++ blob. + (catch 'system-error + (lambda () + (let ((pipe (open-pipe* OPEN_WRITE %guix-register-program))) + (and pipe + (begin + (format pipe "~a~%~a~%~a~%" + path (or deriver "") (length references)) + (for-each (cut format pipe "~a~%" <>) references) + (zero? (close-pipe pipe)))))) + (lambda args + ;; Failed to run %GUIX-REGISTER-PROGRAM. + #f))) + ;;; ;;; Store paths. diff --git a/pre-inst-env.in b/pre-inst-env.in index acdce61168..3f1fa59bb8 100644 --- a/pre-inst-env.in +++ b/pre-inst-env.in @@ -46,6 +46,10 @@ NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS +# The 'guix-register' program. +GUIX_REGISTER="$abs_top_builddir/guix-register" +export GUIX_REGISTER + # The following variables need only be defined when compiling Guix # modules, but we define them to be on the safe side in case of # auto-compilation. diff --git a/tests/store.scm b/tests/store.scm index 4bd739e7f6..5ae036c060 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -389,6 +389,26 @@ Deriver: ~a~%" (pk 'corrupt-imported imported) #f))))) +(test-assert "register-path" + (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) + "-fake"))) + (when (valid-path? %store file) + (delete-paths %store (list file))) + (false-if-exception (delete-file file)) + + (let ((ref (add-text-to-store %store "ref-of-fake" (random-text))) + (drv (string-append file ".drv"))) + (call-with-output-file file + (cut display "This is a fake store item.\n" <>)) + (register-path file + #:references (list ref) + #:deriver drv) + + (and (valid-path? %store file) + (equal? (references %store file) (list ref)) + (null? (valid-derivers %store file)) + (null? (referrers %store file)))))) + (test-end "store") |