summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--configure.ac7
-rw-r--r--guix/config.scm.in5
-rw-r--r--guix/store.scm25
-rw-r--r--pre-inst-env.in4
-rw-r--r--tests/store.scm22
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")