summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-11 17:11:14 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-24 00:01:49 +0100
commit6bfec3edf52ed6145c3c89fb19d350498dd2b758 (patch)
tree6474526e72c555688af6efd220b015ec4351fa50 /guix
parent349fd3b11f320453ad8eeb3031621d0ffcaf078d (diff)
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'.
Diffstat (limited to 'guix')
-rw-r--r--guix/config.scm.in5
-rw-r--r--guix/store.scm25
2 files changed, 30 insertions, 0 deletions
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.