store: Add 'register-path' procedure.

* guix/store.scm (register-path): New procedure.
* tests/store.scm ("register-path"): New test.
* guix/config.scm.in (%guix-register-program): New variable.
* configure.ac: Compute and substitute 'guix_sbindir'.  Compute
  'guix_prefix'.
* pre-inst-env.in: Define 'GUIX_REGISTER'.

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.

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@")
 

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.

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.

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")