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'.
This commit is contained in:
Ludovic Courtès 2014-01-11 17:11:14 +01:00
parent 349fd3b11f
commit 6bfec3edf5
5 changed files with 60 additions and 3 deletions

View File

@ -38,10 +38,13 @@ AC_ARG_ENABLE([daemon],
# Prepare a version of $localstatedir & co. that does not contain references # Prepare a version of $localstatedir & co. that does not contain references
# to shell variables. # to shell variables.
guix_localstatedir="`eval echo $localstatedir | sed -e "s|NONE|/usr/local|g"`" guix_prefix="`eval echo $prefix | sed -e"s|NONE|/usr/local|g"`"
guix_sysconfdir="`eval echo $sysconfdir | 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_localstatedir])
AC_SUBST([guix_sysconfdir]) AC_SUBST([guix_sysconfdir])
AC_SUBST([guix_sbindir])
dnl We require the pkg.m4 set of macros from pkg-config. dnl We require the pkg.m4 set of macros from pkg-config.
dnl Make sure it's available. dnl Make sure it's available.

View File

@ -24,6 +24,7 @@
%store-directory %store-directory
%state-directory %state-directory
%config-directory %config-directory
%guix-register-program
%system %system
%libgcrypt %libgcrypt
%nixpkgs %nixpkgs
@ -62,6 +63,10 @@
;; This must match `NIX_CONF_DIR' as defined in `daemon.am'. ;; This must match `NIX_CONF_DIR' as defined in `daemon.am'.
(or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix")) (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 (define %system
"@guix_system@") "@guix_system@")

View File

@ -33,6 +33,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 popen)
#:export (%daemon-socket-file #:export (%daemon-socket-file
nix-server? nix-server?
@ -85,6 +86,8 @@
current-build-output-port current-build-output-port
register-path
%store-prefix %store-prefix
store-path? store-path?
direct-store-path? direct-store-path?
@ -694,6 +697,28 @@ is true."
(and (export-path server head port #:sign? sign?) (and (export-path server head port #:sign? sign?)
(loop tail))))))) (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. ;;; Store paths.

View File

@ -46,6 +46,10 @@ NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS 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 # The following variables need only be defined when compiling Guix
# modules, but we define them to be on the safe side in case of # modules, but we define them to be on the safe side in case of
# auto-compilation. # auto-compilation.

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -389,6 +389,26 @@ Deriver: ~a~%"
(pk 'corrupt-imported imported) (pk 'corrupt-imported imported)
#f))))) #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") (test-end "store")