Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 8 Jun 2018 09:32:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 31755 in the body.
You can then email your comments to 31755 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:32:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>
:guix-patches <at> gnu.org
.
(Fri, 08 Jun 2018 09:32:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 00/19] Use (guix store database) instead of 'guix-register' Date: Fri, 8 Jun 2018 11:30:42 +0200
Hello Guix! This not-so-interesting patch series refactors a whole bunch of things so that, in the end, we can use the “new” (guix store database) instead of the C++ ‘guix-register’. It turned out to be more involved that I thought. :-) A practical consequence of this is that guile-sqlite3 becomes a requirement. It would be nice if someone (maybe Danny?) could take care of tagging guile-sqlite3 and making releases as needed. I think the only new feature is that we can now populate the database in a deterministic fashion by setting the registration data (see one of the last patches.) Regardless, I think it’s a step in the right direction. Comments? Ludo’. Ludovic Courtès (19): database: 'with-database' can now initialize new databases. database: Fail registration when encountering unregistered references. store-copy: 'read-reference-graph' returns a list of records. build: Require Guile-SQLite3. database: Provide a way to specify the schema location. database: 'register-path' creates the database directory if needed. deduplicate: Fix a couple of thinkos. database: Remove extra SQL parameter in 'update-or-insert'. database: Add #:reset-timestamps? to 'register-path'. database: Replace existing entries in Refs. database: 'reset-timestamps' sets file permissions as well. vm: 'expression->derivation-in-linux-vm' code can now use dlopen. install: Use (guix store database) instead of 'guix-register'. database: 'sqlite-register' takes a database, not a file name. database: Add 'register-items'. install: Use 'reset-timestamps' from (guix store database). database: Allow for deterministic database construction. store: Remove 'register-path'. Remove 'guix-register' and its traces. .gitignore | 1 - Makefile.am | 24 +- README | 3 +- build-aux/pre-inst-env.in | 6 +- configure.ac | 5 +- doc/guix.texi | 3 + gnu/build/install.scm | 59 ++-- gnu/build/vm.scm | 6 +- gnu/packages/package-management.scm | 40 +-- gnu/services/base.scm | 5 +- gnu/system/file-systems.scm | 11 +- gnu/system/vm.scm | 414 +++++++++++++----------- guix/build/store-copy.scm | 121 ++++++- guix/config.scm.in | 12 +- guix/nar.scm | 3 +- guix/scripts/pack.scm | 219 +++++++------ guix/scripts/system.scm | 3 +- guix/self.scm | 25 +- guix/store.scm | 29 -- guix/store/database.scm | 235 +++++++++----- guix/store/deduplication.scm | 13 +- {nix/libstore => guix/store}/schema.sql | 0 nix/guix-register/guix-register.cc | 254 --------------- nix/local.mk | 18 +- tests/gexp.scm | 17 +- tests/guix-register.sh | 191 ----------- tests/store-database.scm | 45 ++- tests/store-deduplication.scm | 9 +- tests/store.scm | 22 +- 29 files changed, 739 insertions(+), 1054 deletions(-) rename {nix/libstore => guix/store}/schema.sql (100%) delete mode 100644 nix/guix-register/guix-register.cc delete mode 100644 tests/guix-register.sh -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:02 GMT) Full text and rfc822 format available.Message #8 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 02/19] database: Fail registration when encountering unregistered references. Date: Fri, 8 Jun 2018 11:34:34 +0200
* guix/store/database.scm (add-reference-sql): Remove nested SELECT. (add-references): Expect REFERENCES to be a list of ids. (sqlite-register): Call 'path-id' for each of REFERENCES and pass it to 'add-references'. * tests/store-database.scm ("register-path with unregistered references"): New test. --- guix/store/database.scm | 18 +++++++++++------- tests/store-database.scm | 20 ++++++++++++++++++++ 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index e81ab3dc9..d5e34ef04 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (rnrs io ports) #:use-module (ice-9 match) #:use-module (system foreign) @@ -139,13 +140,11 @@ of course. Returns the row id of the row that was modified or inserted." (last-insert-row-id db))))) (define add-reference-sql - "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT :referrer, id -FROM ValidPaths WHERE path = :reference") + "INSERT INTO Refs (referrer, reference) VALUES (:referrer, :reference);") (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list -containing store items being referred to. Note that all of the store items in -REFERENCES must already be registered." +ids of items referred to." (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t))) (for-each (lambda (reference) (sqlite-reset stmt) @@ -164,15 +163,20 @@ path of some store item, REFERENCES is a list of string paths which the store item PATH refers to (they need to be already registered!), DERIVER is a string path of the derivation that created the store item PATH, HASH is the base16-encoded sha256 hash of the store item denoted by PATH (prefixed with -\"sha256:\") after being converted to nar form, and nar-size is the size in -bytes of the store item denoted by PATH after being converted to nar form." +\"sha256:\") after being converted to nar form, and NAR-SIZE is the size in +bytes of the store item denoted by PATH after being converted to nar form. + +Every store item in REFERENCES must already be registered." (with-database db-file db (let ((id (update-or-insert db #:path path #:deriver deriver #:hash hash #:nar-size nar-size #:time (time-second (current-time time-utc))))) - (add-references db id references)))) + ;; Call 'path-id' on each of REFERENCES. This ensures we get a + ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. + (add-references db id + (map (cut path-id db <>) references))))) ;;; diff --git a/tests/store-database.scm b/tests/store-database.scm index 794736859..9562055fd 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -74,4 +74,24 @@ (list (path-id db "/gnu/foo") (path-id db "/gnu/bar"))))))) +(test-assert "register-path with unregistered references" + ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error + ;; when we try to add references that are not registered yet. Better safe + ;; than sorry. + (call-with-temporary-output-file + (lambda (db-file port) + (delete-file db-file) + (catch 'sqlite-error + (lambda () + (sqlite-register #:db-file db-file + #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234) + #f) + (lambda args + (pk 'welcome-exception! args) + #t))))) + (test-end "store-database") -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:02 GMT) Full text and rfc822 format available.Message #11 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 03/19] store-copy: 'read-reference-graph' returns a list of records. Date: Fri, 8 Jun 2018 11:34:35 +0200
The previous implementation of 'read-reference-graph' was good enough for many use cases, but it discarded the graph structure, which is useful information in some cases. * guix/build/store-copy.scm (<store-info>): New record type. (read-reference-graph): Rewrite to return a list of <store-info>. (closure-size, populate-store): Adjust accordingly. * gnu/services/base.scm (references-file): Adjust accordingly. * gnu/system/vm.scm (system-docker-image): Likewise. * guix/scripts/pack.scm (squashfs-image, docker-image): Likewise. * tests/gexp.scm ("gexp->derivation #:references-graphs"): Likewise. --- gnu/services/base.scm | 5 +- gnu/system/vm.scm | 6 +- guix/build/store-copy.scm | 120 +++++++++++++++++++++++++++++++++----- guix/scripts/pack.scm | 10 ++-- tests/gexp.scm | 17 ++++-- 5 files changed, 128 insertions(+), 30 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index b34bb7132..68411439d 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1592,8 +1592,9 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (call-with-output-file #$output (lambda (port) - (write (call-with-input-file "graph" - read-reference-graph) + (write (map store-info-item + (call-with-input-file "graph" + read-reference-graph)) port))))) #:options `(#:local-build? #f #:references-graphs (("graph" ,item)))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 8cfbda226..2ffab15dd 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -455,8 +455,10 @@ should set REGISTER-CLOSURES? to #f." (build-docker-image (string-append "/xchg/" #$name) ;; The output file. (cons* root-directory - (call-with-input-file (string-append "/xchg/" #$graph) - read-reference-graph)) + (map store-info-item + (call-with-input-file + (string-append "/xchg/" #$graph) + read-reference-graph))) #$os-drv #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") #:creation-time (make-time time-utc 0 1) diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index fe2eb6f69..bad1c09cb 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo <at> gnu.org> +;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,10 +18,21 @@ (define-module (guix build store-copy) #:use-module (guix build utils) + #:use-module (guix sets) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw) - #:export (read-reference-graph + #:use-module (ice-9 vlist) + #:export (store-info? + store-info-item + store-info-deriver + store-info-references + + read-reference-graph + closure-size populate-store)) @@ -34,19 +45,94 @@ ;;; ;;; Code: +;; Information about a store item as produced by #:references-graphs. +(define-record-type <store-info> + (store-info item deriver references) + store-info? + (item store-info-item) ;string + (deriver store-info-deriver) ;#f | string + (references store-info-references)) ;? + +;; TODO: Factorize with that in (guix store). +(define (topological-sort nodes edges) + "Return NODES in topological order according to EDGES. EDGES must be a +one-argument procedure that takes a node and returns the nodes it is connected +to." + (define (traverse) + ;; Do a simple depth-first traversal of all of PATHS. + (let loop ((nodes nodes) + (visited (setq)) + (result '())) + (match nodes + ((head tail ...) + (if (set-contains? visited head) + (loop tail visited result) + (call-with-values + (lambda () + (loop (edges head) + (set-insert head visited) + result)) + (lambda (visited result) + (loop tail visited (cons head result)))))) + (() + (values visited result))))) + + (call-with-values traverse + (lambda (_ result) + (reverse result)))) + (define (read-reference-graph port) - "Return a list of store paths from the reference graph at PORT. -The data at PORT is the format produced by #:references-graphs." - (let loop ((line (read-line port)) - (result '())) - (cond ((eof-object? line) - (delete-duplicates result)) - ((string-prefix? "/" line) - (loop (read-line port) - (cons line result))) - (else - (loop (read-line port) - result))))) + "Read the reference graph as produced by #:references-graphs from PORT and +return it as a list of <store-info> records in topological order--i.e., leaves +come first. IOW, store items in the resulting list can be registered in the +order in which they appear. + +The reference graph format consists of sequences of lines like this: + + FILE + DERIVER + NUMBER-OF-REFERENCES + REF1 + ... + REFN + +It is meant as an internal format." + (let loop ((result '()) + (table vlist-null) + (referrers vlist-null)) + (match (read-line port) + ((? eof-object?) + ;; 'guix-daemon' gives us something that's in "reverse topological + ;; order"--i.e., leaves (items with zero references) come last. Here + ;; we compute the topological order that we want: leaves come first. + (let ((unreferenced? (lambda (item) + (let ((referrers (vhash-fold* cons '() + (store-info-item item) + referrers))) + (or (null? referrers) + (equal? (list item) referrers)))))) + (topological-sort (filter unreferenced? result) + (lambda (item) + (map (lambda (item) + (match (vhash-assoc item table) + ((_ . node) node))) + (store-info-references item)))))) + (item + (let* ((deriver (match (read-line port) + ("" #f) + (line line))) + (count (string->number (read-line port))) + (refs (unfold-right (cut >= <> count) + (lambda (n) + (read-line port)) + 1+ + 0)) + (item (store-info item deriver refs))) + (loop (cons item result) + (vhash-cons (store-info-item item) item table) + (fold (cut vhash-cons <> item <>) + referrers + refs))))))) (define (file-size file) "Return the size of bytes of FILE, entering it if FILE is a directory." @@ -72,7 +158,8 @@ The data at PORT is the format produced by #:references-graphs." "Return an estimate of the size of the closure described by REFERENCE-GRAPHS, a list of reference-graph files." (define (graph-from-file file) - (call-with-input-file file read-reference-graph)) + (map store-info-item + (call-with-input-file file read-reference-graph))) (define items (delete-duplicates (append-map graph-from-file reference-graphs))) @@ -88,7 +175,8 @@ REFERENCE-GRAPHS, a list of reference-graph files." (define (things-to-copy) ;; Return the list of store files to copy to the image. (define (graph-from-file file) - (call-with-input-file file read-reference-graph)) + (map store-info-item + (call-with-input-file file read-reference-graph))) (delete-duplicates (append-map graph-from-file reference-graphs))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 76729d8e1..78bfd01ef 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -251,8 +251,9 @@ added to the pack." ;; ancestor directories and only keeps the basename. We fix this ;; in the following invocations of mksquashfs. (apply invoke "mksquashfs" - `(,@(call-with-input-file "profile" - read-reference-graph) + `(,@(map store-info-item + (call-with-input-file "profile" + read-reference-graph)) ,#$output ;; Do not perform duplicate checking because we @@ -352,8 +353,9 @@ the image." (setenv "PATH" (string-append #$archiver "/bin")) (build-docker-image #$output - (call-with-input-file "profile" - read-reference-graph) + (map store-info-item + (call-with-input-file "profile" + read-reference-graph)) #$profile #:system (or #$target (utsname:machine (uname))) #:symlinks '#$symlinks diff --git a/tests/gexp.scm b/tests/gexp.scm index a560adfc5..83fe81154 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -615,6 +615,7 @@ `(("graph" ,two)) #:modules '((guix build store-copy) + (guix sets) (guix build utils)))) (ok? (built-derivations (list drv))) (out -> (derivation->output-path drv))) @@ -815,21 +816,25 @@ (two (gexp->derivation "two" #~(symlink #$one #$output:chbouib))) (build -> (with-imported-modules '((guix build store-copy) + (guix sets) (guix build utils)) #~(begin (use-modules (guix build store-copy)) (with-output-to-file #$output (lambda () - (write (call-with-input-file "guile" - read-reference-graph)))) + (write (map store-info-item + (call-with-input-file "guile" + read-reference-graph))))) (with-output-to-file #$output:one (lambda () - (write (call-with-input-file "one" - read-reference-graph)))) + (write (map store-info-item + (call-with-input-file "one" + read-reference-graph))))) (with-output-to-file #$output:two (lambda () - (write (call-with-input-file "two" - read-reference-graph))))))) + (write (map store-info-item + (call-with-input-file "two" + read-reference-graph)))))))) (drv (gexp->derivation "ref-graphs" build #:references-graphs `(("one" ,one) ("two" ,two "chbouib") -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:03 GMT) Full text and rfc822 format available.Message #14 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 06/19] database: 'register-path' creates the database directory if needed. Date: Fri, 8 Jun 2018 11:34:38 +0200
* guix/store/database.scm (register-path): Call 'mkdir-p'. --- guix/store/database.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/store/database.scm b/guix/store/database.scm index 0f6d2e2c0..1400d0d1c 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -24,6 +24,7 @@ #:use-module (guix store deduplication) #:use-module (guix base16) #:use-module (guix build syscalls) + #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -268,6 +269,7 @@ be used internally by the daemon's build hook." (let-values (((hash nar-size) (nar-sha256 real-path))) (reset-timestamps real-path) + (mkdir-p db-dir) (sqlite-register #:db-file (string-append db-dir "/db.sqlite") #:schema schema -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:03 GMT) Full text and rfc822 format available.Message #17 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 07/19] deduplicate: Fix a couple of thinkos. Date: Fri, 8 Jun 2018 11:34:39 +0200
* guix/store/deduplication.scm (get-temp-link): Turn 'args' in the 'catch' handler into a rest argument. (deduplicate): Use 'lstat' instead of 'file-is-directory?' to properly handle symlinks. When iterating over the result of 'scandir', exclude the ".links" sub-directory. * tests/store-deduplication.scm ("deduplicate"): Create sub-directories and call 'deduplicate' directly on STORE. --- guix/store/deduplication.scm | 13 ++++++++----- tests/store-deduplication.scm | 9 ++++----- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index 4b4ac01f6..d3139eb90 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -85,7 +85,7 @@ LINK-PREFIX." (lambda () (link target tempname) tempname) - (lambda (args) + (lambda args (if (= (system-error-errno args) EEXIST) (try (tempname-in link-prefix)) (throw 'system-error args)))))) @@ -120,12 +120,15 @@ under STORE." (link-file (string-append links-directory "/" (bytevector->base16-string hash)))) (mkdir-p links-directory) - (if (file-is-directory? path) + (if (eq? 'directory (stat:type (lstat path))) ;; Can't hardlink directories, so hardlink their atoms. (for-each (lambda (file) - (unless (member file '("." "..")) - (deduplicate file (nar-sha256 file) - #:store store))) + (unless (or (member file '("." "..")) + (and (string=? path store) + (string=? file ".links"))) + (let ((file (string-append path "/" file))) + (deduplicate file (nar-sha256 file) + #:store store)))) (scandir path)) (if (file-exists? link-file) (false-if-system-error (EMLINK) diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index 04817a193..236172319 100644 --- a/tests/store-deduplication.scm +++ b/tests/store-deduplication.scm @@ -37,10 +37,12 @@ (lambda (store) (let ((data (string->utf8 "Hello, world!")) (identical (map (lambda (n) - (string-append store "/" (number->string n))) + (string-append store "/" (number->string n) + "/a/b/c")) (iota 5))) (unique (string-append store "/unique"))) (for-each (lambda (file) + (mkdir-p (dirname file)) (call-with-output-file file (lambda (port) (put-bytevector port data)))) @@ -49,10 +51,7 @@ (lambda (port) (put-bytevector port (string->utf8 "This is unique.")))) - (for-each (lambda (file) - (deduplicate file (sha256 data) #:store store)) - identical) - (deduplicate unique (nar-sha256 unique) #:store store) + (deduplicate store (nar-sha256 store) #:store store) ;; (system (string-append "ls -lRia " store)) (cons* (apply = (map (compose stat:ino stat) identical)) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:04 GMT) Full text and rfc822 format available.Message #20 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 08/19] database: Remove extra SQL parameter in 'update-or-insert'. Date: Fri, 8 Jun 2018 11:34:40 +0200
* guix/store/database.scm (update-or-insert): Remove extra #:path parameter. --- guix/store/database.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 1400d0d1c..b9170dda7 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -127,7 +127,7 @@ of course. Returns the row id of the row that was modified or inserted." (if id (let ((stmt (sqlite-prepare db update-sql #:cache? #t))) (sqlite-bind-arguments stmt #:id id - #:path path #:deriver deriver + #:deriver deriver #:hash hash #:size nar-size #:time time) (sqlite-fold cons '() stmt) (sqlite-finalize stmt) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:04 GMT) Full text and rfc822 format available.Message #23 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 10/19] database: Replace existing entries in Refs. Date: Fri, 8 Jun 2018 11:34:42 +0200
* guix/store/database.scm (add-reference-sql): Add "OR REPLACE". --- guix/store/database.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index bfd2c3626..094dea3ec 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -141,7 +141,7 @@ of course. Returns the row id of the row that was modified or inserted." (last-insert-row-id db))))) (define add-reference-sql - "INSERT INTO Refs (referrer, reference) VALUES (:referrer, :reference);") + "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:05 GMT) Full text and rfc822 format available.Message #26 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 09/19] database: Add #:reset-timestamps? to 'register-path'. Date: Fri, 8 Jun 2018 11:34:41 +0200
* guix/store/database.scm (register-path): Add #:reset-timestamps? and honor it. --- guix/store/database.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index b9170dda7..bfd2c3626 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -225,6 +225,7 @@ it's a directory." (define* (register-path path #:key (references '()) deriver prefix state-directory (deduplicate? #t) + (reset-timestamps? #t) (schema (sql-schema))) ;; Priority for options: first what is given, then environment variables, ;; then defaults. %state-directory, %store-directory, and @@ -268,7 +269,8 @@ be used internally by the daemon's build hook." (real-path (string-append store-dir "/" (basename path)))) (let-values (((hash nar-size) (nar-sha256 real-path))) - (reset-timestamps real-path) + (when reset-timestamps? + (reset-timestamps real-path)) (mkdir-p db-dir) (sqlite-register #:db-file (string-append db-dir "/db.sqlite") -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:05 GMT) Full text and rfc822 format available.Message #29 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 05/19] database: Provide a way to specify the schema location. Date: Fri, 8 Jun 2018 11:34:37 +0200
* guix/store/database.scm (sqlite-register): Add #:schema. Parameterize 'sql-schema' based on this. (register-path): Add #:schema and pass it to 'sqlite-register'. --- guix/store/database.scm | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index d5e34ef04..0f6d2e2c0 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -88,7 +88,7 @@ If FILE doesn't exist, create it and initialize it as a new database." ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; Work around that. (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" - #:cache? #t)) + #:cache? #t)) (result (sqlite-fold cons '() stmt))) (sqlite-finalize stmt) (match result @@ -157,7 +157,8 @@ ids of items referred to." ;; XXX figure out caching of statement and database objects... later (define* (sqlite-register #:key db-file path (references '()) - deriver hash nar-size) + deriver hash nar-size + (schema (sql-schema))) "Registers this stuff in a database specified by DB-FILE. PATH is the string path of some store item, REFERENCES is a list of string paths which the store item PATH refers to (they need to be already registered!), DERIVER is a string @@ -167,16 +168,17 @@ base16-encoded sha256 hash of the store item denoted by PATH (prefixed with bytes of the store item denoted by PATH after being converted to nar form. Every store item in REFERENCES must already be registered." - (with-database db-file db - (let ((id (update-or-insert db #:path path - #:deriver deriver - #:hash hash - #:nar-size nar-size - #:time (time-second (current-time time-utc))))) - ;; Call 'path-id' on each of REFERENCES. This ensures we get a - ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. - (add-references db id - (map (cut path-id db <>) references))))) + (parameterize ((sql-schema schema)) + (with-database db-file db + (let ((id (update-or-insert db #:path path + #:deriver deriver + #:hash hash + #:nar-size nar-size + #:time (time-second (current-time time-utc))))) + ;; Call 'path-id' on each of REFERENCES. This ensures we get a + ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. + (add-references db id + (map (cut path-id db <>) references)))))) ;;; @@ -221,7 +223,8 @@ it's a directory." (define* (register-path path #:key (references '()) deriver prefix - state-directory (deduplicate? #t)) + state-directory (deduplicate? #t) + (schema (sql-schema))) ;; Priority for options: first what is given, then environment variables, ;; then defaults. %state-directory, %store-directory, and ;; %store-database-directory already handle the "environment variables / @@ -267,6 +270,7 @@ be used internally by the daemon's build hook." (reset-timestamps real-path) (sqlite-register #:db-file (string-append db-dir "/db.sqlite") + #:schema schema #:path to-register #:references references #:deriver deriver -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:05 GMT) Full text and rfc822 format available.Message #32 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 01/19] database: 'with-database' can now initialize new databases. Date: Fri, 8 Jun 2018 11:34:33 +0200
* nix/libstore/schema.sql: Rename to... * guix/store/schema.sql: ... this. * Makefile.am (nobase_dist_guilemodule_DATA): Add it. * nix/local.mk (%D%/libstore/schema.sql.hh): Adjust accordingly. * guix/store/database.scm (sql-schema): New variable. (sqlite-exec, initialize-database, call-with-database): New procedures. (with-database): Rewrite in terms of 'call-with-database'. * tests/store-database.scm ("new database"): New test. * guix/self.scm (compiled-guix)[*core-modules*]: Add 'schema.sql' to #:extra-files. --- Makefile.am | 1 + guix/self.scm | 4 +- guix/store/database.scm | 50 ++++++++++++++++++++++--- {nix/libstore => guix/store}/schema.sql | 0 nix/local.mk | 2 +- tests/store-database.scm | 23 ++++++++++++ 6 files changed, 73 insertions(+), 7 deletions(-) rename {nix/libstore => guix/store}/schema.sql (100%) diff --git a/Makefile.am b/Makefile.am index 474575c9f..102f5a2e7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -300,6 +300,7 @@ EXAMPLES = \ GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go) nobase_dist_guilemodule_DATA = \ + guix/store/schema.sql \ $(MODULES) $(MODULES_NOT_COMPILED) $(AUX_FILES) $(EXAMPLES) \ $(MISC_DISTRO_FILES) nobase_nodist_guilemodule_DATA = guix/config.scm diff --git a/guix/self.scm b/guix/self.scm index 3acfac6f8..f8b8642bf 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -259,7 +259,9 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." ;; but we don't need to compile it; not compiling it allows ;; us to avoid an extra dependency on guile-gdbm-ffi. #:extra-files - `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))) + `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm")) + ("guix/store/schema.sql" + ,(local-file "../guix/store/schema.sql"))) #:guile-for-build guile-for-build)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 3623c0e7a..e81ab3dc9 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -24,25 +24,65 @@ #:use-module (guix store deduplication) #:use-module (guix base16) #:use-module (guix build syscalls) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (rnrs io ports) #:use-module (ice-9 match) - #:export (sqlite-register + #:use-module (system foreign) + #:export (sql-schema + with-database + sqlite-register register-path reset-timestamps)) ;;; Code for working with the store database directly. +(define sql-schema + ;; Name of the file containing the SQL scheme or #f. + (make-parameter #f)) -(define-syntax-rule (with-database file db exp ...) - "Open DB from FILE and close it when the dynamic extent of EXP... is left." - (let ((db (sqlite-open file))) +(define sqlite-exec + ;; XXX: This is was missing from guile-sqlite3 until + ;; <https://notabug.org/civodul/guile-sqlite3/commit/b87302f9bcd18a286fed57b2ea521845eb1131d7>. + (let ((exec (pointer->procedure + int + (dynamic-func "sqlite3_exec" (@@ (sqlite3) libsqlite3)) + '(* * * * *)))) + (lambda (db text) + (let ((ret (exec ((@@ (sqlite3) db-pointer) db) + (string->pointer text) + %null-pointer %null-pointer %null-pointer))) + (unless (zero? ret) + ((@@ (sqlite3) sqlite-error) db "sqlite-exec" ret)))))) + +(define (initialize-database db) + "Initializing DB, an empty database, by creating all the tables and indexes +as specified by SQL-SCHEMA." + (define schema + (or (sql-schema) + (search-path %load-path "guix/store/schema.sql"))) + + (sqlite-exec db (call-with-input-file schema get-string-all))) + +(define (call-with-database file proc) + "Pass PROC a database record corresponding to FILE. If FILE doesn't exist, +create it and initialize it as a new database." + (let ((new? (not (file-exists? file))) + (db (sqlite-open file))) (dynamic-wind noop (lambda () - exp ...) + (when new? + (initialize-database db)) + (proc db)) (lambda () (sqlite-close db))))) +(define-syntax-rule (with-database file db exp ...) + "Open DB from FILE and close it when the dynamic extent of EXP... is left. +If FILE doesn't exist, create it and initialize it as a new database." + (call-with-database file (lambda (db) exp ...))) + (define (last-insert-row-id db) ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; Work around that. diff --git a/nix/libstore/schema.sql b/guix/store/schema.sql similarity index 100% rename from nix/libstore/schema.sql rename to guix/store/schema.sql diff --git a/nix/local.mk b/nix/local.mk index 39717711f..b4c6ba61a 100644 --- a/nix/local.mk +++ b/nix/local.mk @@ -163,7 +163,7 @@ noinst_HEADERS = \ $(libformat_headers) $(libutil_headers) $(libstore_headers) \ $(guix_daemon_headers) -%D%/libstore/schema.sql.hh: %D%/libstore/schema.sql +%D%/libstore/schema.sql.hh: guix/store/schema.sql $(AM_V_GEN)$(GUILE) --no-auto-compile -c \ "(use-modules (rnrs io ports)) \ (call-with-output-file \"$@\" \ diff --git a/tests/store-database.scm b/tests/store-database.scm index 1348a75c2..794736859 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -20,6 +20,7 @@ #:use-module (guix tests) #:use-module ((guix store) #:hide (register-path)) #:use-module (guix store database) + #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) @@ -51,4 +52,26 @@ (null? (valid-derivers %store file)) (null? (referrers %store file)))))) +(test-equal "new database" + (list 1 2) + (call-with-temporary-output-file + (lambda (db-file port) + (delete-file db-file) + (sqlite-register #:db-file db-file + #:path "/gnu/foo" + #:references '() + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234) + (sqlite-register #:db-file db-file + #:path "/gnu/bar" + #:references '("/gnu/foo") + #:deriver "/gnu/bar.drv" + #:hash (string-append "sha256:" (make-string 64 #\a)) + #:nar-size 4321) + (let ((path-id (@@ (guix store database) path-id))) + (with-database db-file db + (list (path-id db "/gnu/foo") + (path-id db "/gnu/bar"))))))) + (test-end "store-database") -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:06 GMT) Full text and rfc822 format available.Message #35 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 04/19] build: Require Guile-SQLite3. Date: Fri, 8 Jun 2018 11:34:36 +0200
The next commits make (sqlite3) an indirect dependency of (gnu build install), which is itself used by (guix scripts system), hence this new requirement. * configure.ac: Error out when $guix_cv_have_recent_guile_sqlite3 is false. Remove HAVE_GUILE_SQLITE3 Automake conditional. * Makefile.am (MODULES, SCM_TESTS): Remove HAVE_GUILE_SQLITE3 conditions. * doc/guix.texi (Requirements): Add Guile-SQLite3. * README: Ditto. * gnu/packages/package-management.scm (guix)[propagated-inputs]: Add GUILE-SQLITE3. [arguments]: In 'wrap-program' phase, take guile-sqlite3 into account. --- Makefile.am | 16 +++------------- README | 3 ++- configure.ac | 5 +++-- doc/guix.texi | 3 +++ gnu/packages/package-management.scm | 4 +++- 5 files changed, 14 insertions(+), 17 deletions(-) diff --git a/Makefile.am b/Makefile.am index 102f5a2e7..d6403c02e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -262,11 +262,7 @@ STORE_MODULES = \ guix/store/database.scm \ guix/store/deduplication.scm -if HAVE_GUILE_SQLITE3 MODULES += $(STORE_MODULES) -else -MODULES_NOT_COMPILED += $(STORE_MODULES) -endif !HAVE_GUILE_SQLITE3 # Internal modules with test suite support. dist_noinst_DATA = guix/tests.scm guix/tests/http.scm @@ -379,7 +375,9 @@ SCM_TESTS = \ tests/scripts-build.scm \ tests/containers.scm \ tests/pack.scm \ - tests/import-utils.scm + tests/import-utils.scm \ + tests/store-database.scm \ + tests/store-deduplication.scm if HAVE_GUILE_JSON @@ -391,14 +389,6 @@ SCM_TESTS += \ endif -if HAVE_GUILE_SQLITE3 - -SCM_TESTS += \ - tests/store-database.scm \ - tests/store-deduplication.scm - -endif - SH_TESTS = \ tests/guix-build.sh \ tests/guix-download.sh \ diff --git a/README b/README index 243a6c058..e1d62763d 100644 --- a/README +++ b/README @@ -23,7 +23,8 @@ GNU Guix currently depends on the following packages: - [[https://gnu.org/software/guile/][GNU Guile 2.2.x or 2.0.x]], version 2.0.13 or later - [[https://gnupg.org/][GNU libgcrypt]] - [[https://www.gnu.org/software/make/][GNU Make]] - - [[https://www.gnutls.org][GnuTLS]] compiled with guile support enabled. + - [[https://www.gnutls.org][GnuTLS]] compiled with guile support enabled + - [[https://notabug.org/civodul/guile-sqlite3][Guile-SQLite3]] - [[https://gitlab.com/guile-git/guile-git][Guile-Git]] - [[http://www.zlib.net/][zlib]] - optionally [[https://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command diff --git a/configure.ac b/configure.ac index d338bfda5..b866e91b2 100644 --- a/configure.ac +++ b/configure.ac @@ -126,8 +126,9 @@ AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"]) dnl Guile-Sqlite3 is used by the (guix store ...) modules. GUIX_CHECK_GUILE_SQLITE3 -AM_CONDITIONAL([HAVE_GUILE_SQLITE3], - [test "x$guix_cv_have_recent_guile_sqlite3" = "xyes"]) +if test "x$guix_cv_have_recent_guile_sqlite3" != "xyes"; then + AC_MSG_ERROR([A recent Guile-SQLite3 could not be found; please install it.]) +fi dnl Make sure we have a full-fledged Guile. GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads]) diff --git a/doc/guix.texi b/doc/guix.texi index 77bdaa50e..f73eb9c2c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -615,6 +615,9 @@ later, including 2.2.x; Guile,, gnutls-guile, GnuTLS-Guile}); @item @c FIXME: Specify a version number once a release has been made. +@uref{https://notabug.org/civodul/guile-sqlite3, Guile-SQLite3}; +@item +@c FIXME: Specify a version number once a release has been made. @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 2017 or later; @item @url{http://zlib.net, zlib}; diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 1356480b8..b8c14ee5d 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -207,12 +207,13 @@ (let* ((out (assoc-ref outputs "out")) (guile (assoc-ref inputs "guile")) (json (assoc-ref inputs "guile-json")) + (sqlite (assoc-ref inputs "guile-sqlite3")) (git (assoc-ref inputs "guile-git")) (bs (assoc-ref inputs "guile-bytestructures")) (ssh (assoc-ref inputs "guile-ssh")) (gnutls (assoc-ref inputs "gnutls")) - (deps (list json gnutls git bs ssh)) + (deps (list json sqlite gnutls git bs ssh)) (effective (read-line (open-pipe* OPEN_READ @@ -269,6 +270,7 @@ (propagated-inputs `(("gnutls" ,gnutls) ("guile-json" ,guile-json) + ("guile-sqlite3" ,guile-sqlite3) ("guile-ssh" ,guile-ssh) ("guile-git" ,guile-git))) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:06 GMT) Full text and rfc822 format available.Message #38 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 11/19] database: 'reset-timestamps' sets file permissions as well. Date: Fri, 8 Jun 2018 11:34:43 +0200
* guix/store/database.scm (reset-timestamps): Add 'chmod' calls. --- guix/store/database.scm | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 094dea3ec..67dfb8b0e 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -24,7 +24,8 @@ #:use-module (guix store deduplication) #:use-module (guix base16) #:use-module (guix build syscalls) - #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module ((guix build utils) + #:select (mkdir-p executable-file?)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -189,11 +190,12 @@ Every store item in REFERENCES must already be registered." ;; TODO: Factorize with that in (gnu build install). (define (reset-timestamps file) "Reset the modification time on FILE and on all the files it contains, if -it's a directory." +it's a directory. While at it, canonicalize file permissions." (let loop ((file file) (type (stat:type (lstat file)))) (case type ((directory) + (chmod file #o555) (utime file 0 0 0 0) (let ((parent file)) (for-each (match-lambda @@ -212,16 +214,9 @@ it's a directory." ;; symlinks. #f) (else + (chmod file (if (executable-file? file) #o555 #o444)) (utime file 0 0 0 0))))) -;; TODO: make this canonicalize store items that are registered. This involves -;; setting permissions and timestamps, I think. Also, run a "deduplication -;; pass", whatever that involves. Also, handle databases not existing yet -;; (what should the default behavior be? Figuring out how the C++ stuff -;; currently does it sounds like a lot of grepping for global -;; variables...). Also, return #t on success like the documentation says we -;; should. - (define* (register-path path #:key (references '()) deriver prefix state-directory (deduplicate? #t) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:07 GMT) Full text and rfc822 format available.Message #41 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 12/19] vm: 'expression->derivation-in-linux-vm' code can now use dlopen. Date: Fri, 8 Jun 2018 11:34:44 +0200
* gnu/system/vm.scm (expression->derivation-in-linux-vm) [user-builder]: Define in non-monadic style as 'program-file'. [loader]: Likewise, and 'execl' USER-BUILDER instead of loading it. (system-docker-image): Pass BUILD as the second argument to 'expression->derivation-in-linux-vm'. (make-iso9660-image, qemu-image): Remove call to 'reboot'. --- gnu/system/vm.scm | 43 ++++++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 23 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2ffab15dd..e0fcf1f3e 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -148,12 +148,24 @@ based on the size of the closure of REFERENCES-GRAPHS. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs, as for `derivation'. The files containing the reference graphs are made available under the /xchg CIFS share." + (define user-builder + (program-file "builder-in-linux-vm" exp)) + + (define loader + ;; Invoke USER-BUILDER instead using 'primitive-load'. The reason for + ;; this is to allow USER-BUILDER to dlopen stuff by using a full-featured + ;; Guile, which it couldn't do using the statically-linked guile used in + ;; the initrd. See example at + ;; <https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html>. + (program-file "linux-vm-loader" + ;; When USER-BUILDER succeeds, reboot (indicating a + ;; success), otherwise die, which causes a kernel panic + ;; ("Attempted to kill init!"). + #~(when (zero? (system* #$user-builder)) + (reboot)))) + (mlet* %store-monad - ((user-builder (gexp->file "builder-in-linux-vm" exp)) - (loader (gexp->file "linux-vm-loader" - #~(primitive-load #$user-builder))) - (coreutils -> (canonical-package coreutils)) - (initrd (if initrd ; use the default initrd? + ((initrd (if initrd ; use the default initrd? (return initrd) (base-initrd %linux-vm-file-systems #:on-error 'backtrace @@ -254,8 +266,7 @@ INPUTS is a list of inputs (as for packages)." #:closures graphs #:volume-id #$file-system-label #:volume-uuid #$(and=> file-system-uuid - uuid-bytevector)) - (reboot)))) + uuid-bytevector))))) #:system system #:make-disk-image? #f #:single-file-output? #t @@ -373,8 +384,7 @@ the image." #:bootcfg-location #$(bootloader-configuration-file bootloader) #:bootloader-installer - #$(bootloader-installer bootloader)) - (reboot))))) + #$(bootloader-installer bootloader)))))) #:system system #:make-disk-image? #t #:disk-image-size disk-image-size @@ -464,20 +474,7 @@ should set REGISTER-CLOSURES? to #f." #:creation-time (make-time time-utc 0 1) #:transformations `((,root-directory -> "")))))))) (expression->derivation-in-linux-vm - name - ;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp - ;; needs to be run by a Guile that can dlopen libgcrypt. The following - ;; hack works around that problem by putting the "build" gexp into an - ;; executable script (created by program-file) which, when executed, will - ;; run using a Guile that supports dlopen. That way, the VM's initrd - ;; Guile can just execute it via invoke, without using dlopen. See: - ;; https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html - (with-imported-modules `((guix build utils)) - #~(begin - (use-modules (guix build utils)) - ;; If we use execl instead of invoke here, the VM will crash with a - ;; kernel panic. - (invoke #$(program-file "build-docker-image" build)))) + name build #:make-disk-image? #f #:single-file-output? #t #:references-graphs `((,graph ,os-drv))))) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:07 GMT) Full text and rfc822 format available.Message #44 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 14/19] database: 'sqlite-register' takes a database, not a file name. Date: Fri, 8 Jun 2018 11:34:46 +0200
* guix/store/database.scm (sqlite-register): Remove #:db-file and add 'db' parameter. Remove #:schema and 'parameterize'. (register-path): Wrap 'sqlite-register' call in 'with-database' and in 'parameterize'. * tests/store-database.scm ("new database") ("register-path with unregistered references"): Adjust accordingly. --- guix/store/database.scm | 57 ++++++++++++++++++---------------------- tests/store-database.scm | 40 ++++++++++++++-------------- 2 files changed, 46 insertions(+), 51 deletions(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 67dfb8b0e..1e5e3bcc7 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -157,30 +157,24 @@ ids of items referred to." (last-insert-row-id db)) references))) -;; XXX figure out caching of statement and database objects... later -(define* (sqlite-register #:key db-file path (references '()) - deriver hash nar-size - (schema (sql-schema))) - "Registers this stuff in a database specified by DB-FILE. PATH is the string -path of some store item, REFERENCES is a list of string paths which the store -item PATH refers to (they need to be already registered!), DERIVER is a string -path of the derivation that created the store item PATH, HASH is the -base16-encoded sha256 hash of the store item denoted by PATH (prefixed with -\"sha256:\") after being converted to nar form, and NAR-SIZE is the size in -bytes of the store item denoted by PATH after being converted to nar form. +(define* (sqlite-register db #:key path (references '()) + deriver hash nar-size) + "Registers this stuff in DB. PATH is the store item to register and +REFERENCES is the list of store items PATH refers to; DERIVER is the '.drv' +that produced PATH, HASH is the base16-encoded Nix sha256 hash of +PATH (prefixed with \"sha256:\"), and NAR-SIZE is the size in bytes PATH after +being converted to nar form. Every store item in REFERENCES must already be registered." - (parameterize ((sql-schema schema)) - (with-database db-file db - (let ((id (update-or-insert db #:path path - #:deriver deriver - #:hash hash - #:nar-size nar-size - #:time (time-second (current-time time-utc))))) - ;; Call 'path-id' on each of REFERENCES. This ensures we get a - ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. - (add-references db id - (map (cut path-id db <>) references)))))) + (let ((id (update-or-insert db #:path path + #:deriver deriver + #:hash hash + #:nar-size nar-size + #:time (time-second (current-time time-utc))))) + ;; Call 'path-id' on each of REFERENCES. This ensures we get a + ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. + (add-references db id + (map (cut path-id db <>) references)))) ;;; @@ -267,15 +261,16 @@ be used internally by the daemon's build hook." (when reset-timestamps? (reset-timestamps real-path)) (mkdir-p db-dir) - (sqlite-register - #:db-file (string-append db-dir "/db.sqlite") - #:schema schema - #:path to-register - #:references references - #:deriver deriver - #:hash (string-append "sha256:" - (bytevector->base16-string hash)) - #:nar-size nar-size) + (parameterize ((sql-schema schema)) + (with-database (string-append db-dir "/db.sqlite") db + (sqlite-register + db + #:path to-register + #:references references + #:deriver deriver + #:hash (string-append "sha256:" + (bytevector->base16-string hash)) + #:nar-size nar-size))) (when deduplicate? (deduplicate real-path hash #:store store-dir))))) diff --git a/tests/store-database.scm b/tests/store-database.scm index 9562055fd..22c356679 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -57,20 +57,20 @@ (call-with-temporary-output-file (lambda (db-file port) (delete-file db-file) - (sqlite-register #:db-file db-file - #:path "/gnu/foo" - #:references '() - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234) - (sqlite-register #:db-file db-file - #:path "/gnu/bar" - #:references '("/gnu/foo") - #:deriver "/gnu/bar.drv" - #:hash (string-append "sha256:" (make-string 64 #\a)) - #:nar-size 4321) - (let ((path-id (@@ (guix store database) path-id))) - (with-database db-file db + (with-database db-file db + (sqlite-register db + #:path "/gnu/foo" + #:references '() + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234) + (sqlite-register db + #:path "/gnu/bar" + #:references '("/gnu/foo") + #:deriver "/gnu/bar.drv" + #:hash (string-append "sha256:" (make-string 64 #\a)) + #:nar-size 4321) + (let ((path-id (@@ (guix store database) path-id))) (list (path-id db "/gnu/foo") (path-id db "/gnu/bar"))))))) @@ -83,12 +83,12 @@ (delete-file db-file) (catch 'sqlite-error (lambda () - (sqlite-register #:db-file db-file - #:path "/gnu/foo" - #:references '("/gnu/bar") - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234) + (with-database db-file db + (sqlite-register db #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234)) #f) (lambda args (pk 'welcome-exception! args) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:08 GMT) Full text and rfc822 format available.Message #47 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 15/19] database: Add 'register-items'. Date: Fri, 8 Jun 2018 11:34:47 +0200
* guix/build/store-copy.scm (store-info): Export. * guix/store/database.scm (register-items): New procedure. (register-path): Implement in terms of 'register-items'. * gnu/build/install.scm (register-closure): Use 'register-items' instead of 'for-each' and 'register-path'. --- gnu/build/install.scm | 15 ++--- guix/build/store-copy.scm | 1 + guix/store/database.scm | 113 ++++++++++++++++++++++---------------- 3 files changed, 72 insertions(+), 57 deletions(-) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 6cc678b44..82eb63d72 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -169,16 +169,11 @@ produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is true, reset timestamps on store files and, if DEDUPLICATE? is true, deduplicates files common to CLOSURE and the rest of PREFIX." (let ((items (call-with-input-file closure read-reference-graph))) - ;; TODO: Add a procedure to register all of ITEMS at once. - (for-each (lambda (item) - (register-path (store-info-item item) - #:references (store-info-references item) - #:deriver (store-info-deriver item) - #:prefix prefix - #:deduplicate? deduplicate? - #:reset-timestamps? reset-timestamps? - #:schema schema)) - items))) + (register-items items + #:prefix prefix + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:schema schema))) (define* (populate-single-profile-directory directory #:key profile closure diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index bad1c09cb..2d9590d16 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -27,6 +27,7 @@ #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) #:export (store-info? + store-info store-info-item store-info-deriver store-info-references diff --git a/guix/store/database.scm b/guix/store/database.scm index 1e5e3bcc7..3dbe5270a 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -26,6 +26,7 @@ #:use-module (guix build syscalls) #:use-module ((guix build utils) #:select (mkdir-p executable-file?)) + #:use-module (guix build store-copy) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -37,6 +38,7 @@ with-database sqlite-register register-path + register-items reset-timestamps)) ;;; Code for working with the store database directly. @@ -216,11 +218,6 @@ it's a directory. While at it, canonicalize file permissions." state-directory (deduplicate? #t) (reset-timestamps? #t) (schema (sql-schema))) - ;; Priority for options: first what is given, then environment variables, - ;; then defaults. %state-directory, %store-directory, and - ;; %store-database-directory already handle the "environment variables / - ;; defaults" question, so we only need to choose between what is given and - ;; those. "Register PATH as a valid store file, with REFERENCES as its list of references, and DERIVER as its deriver (.drv that led to it.) If PREFIX is given, it must be the name of the directory containing the new store to @@ -230,47 +227,69 @@ 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." - (let* ((db-dir (cond - (state-directory - (string-append state-directory "/db")) - (prefix - ;; If prefix is specified, the value of NIX_STATE_DIR - ;; (which affects %state-directory) isn't supposed to - ;; affect db-dir, only the compile-time-customized - ;; default should. - (string-append prefix %localstatedir "/guix/db")) - (else - %store-database-directory))) - (store-dir (if prefix - ;; same situation as above - (string-append prefix %storedir) - %store-directory)) - (to-register (if prefix - (string-append %storedir "/" (basename path)) - ;; note: we assume here that if path is, for - ;; example, /foo/bar/gnu/store/thing.txt and prefix - ;; isn't given, then an environment variable has - ;; been used to change the store directory to - ;; /foo/bar/gnu/store, since otherwise real-path - ;; would end up being /gnu/store/thing.txt, which is - ;; probably not the right file in this case. - path)) - (real-path (string-append store-dir "/" (basename path)))) - (let-values (((hash nar-size) - (nar-sha256 real-path))) + (register-items (list (store-info path deriver references)) + #:prefix prefix #:state-directory state-directory + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:schema schema)) + +(define* (register-items items + #:key prefix state-directory + (deduplicate? #t) + (reset-timestamps? #t) + (schema (sql-schema))) + "Register all of ITEMS, a list of <store-info> records as returned by +'read-reference-graph', in the database under PREFIX/STATE-DIRECTORY. ITEMS +must be in topological order (with leaves first.) If the database is +initially empty, apply SCHEMA to initialize it." + + ;; Priority for options: first what is given, then environment variables, + ;; then defaults. %state-directory, %store-directory, and + ;; %store-database-directory already handle the "environment variables / + ;; defaults" question, so we only need to choose between what is given and + ;; those. + + (define db-dir + (cond (state-directory + (string-append state-directory "/db")) + (prefix + (string-append prefix %localstatedir "/guix/db")) + (else + %store-database-directory))) + + (define store-dir + (if prefix + (string-append prefix %storedir) + %store-directory)) + + (define (register db item) + (define to-register + (if prefix + (string-append %storedir "/" (basename (store-info-item item))) + ;; note: we assume here that if path is, for example, + ;; /foo/bar/gnu/store/thing.txt and prefix isn't given, then an + ;; environment variable has been used to change the store directory + ;; to /foo/bar/gnu/store, since otherwise real-path would end up + ;; being /gnu/store/thing.txt, which is probably not the right file + ;; in this case. + (store-info-item item))) + + (define real-file-name + (string-append store-dir "/" (basename (store-info-item item)))) + + (let-values (((hash nar-size) (nar-sha256 real-file-name))) (when reset-timestamps? - (reset-timestamps real-path)) - (mkdir-p db-dir) - (parameterize ((sql-schema schema)) - (with-database (string-append db-dir "/db.sqlite") db - (sqlite-register - db - #:path to-register - #:references references - #:deriver deriver - #:hash (string-append "sha256:" - (bytevector->base16-string hash)) - #:nar-size nar-size))) - + (reset-timestamps real-file-name)) + (sqlite-register db #:path to-register + #:references (store-info-references item) + #:deriver (store-info-deriver item) + #:hash (string-append "sha256:" + (bytevector->base16-string hash)) + #:nar-size nar-size) (when deduplicate? - (deduplicate real-path hash #:store store-dir))))) + (deduplicate real-file-name hash #:store store-dir)))) + + (mkdir-p db-dir) + (parameterize ((sql-schema schema)) + (with-database (string-append db-dir "/db.sqlite") db + (for-each (cut register db <>) items)))) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:08 GMT) Full text and rfc822 format available.Message #50 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 17/19] database: Allow for deterministic database construction. Date: Fri, 8 Jun 2018 11:34:49 +0200
* guix/store/database.scm (sqlite-register): Add #:time. (%epoch): New variable. (register-items): Add #:registration-time. Pass #:time to 'sqlite-register'. * gnu/build/install.scm (register-closure): Pass #:registration-time. --- gnu/build/install.scm | 1 + guix/store/database.scm | 21 ++++++++++++++++----- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 5e84cd6f6..06ecb3995 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -158,6 +158,7 @@ deduplicates files common to CLOSURE and the rest of PREFIX." #:prefix prefix #:deduplicate? deduplicate? #:reset-timestamps? reset-timestamps? + #:registration-time %epoch #:schema schema))) (define* (populate-single-profile-directory directory diff --git a/guix/store/database.scm b/guix/store/database.scm index 82938455b..05b2ba6c3 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -39,6 +39,7 @@ sqlite-register register-path register-items + %epoch reset-timestamps)) ;;; Code for working with the store database directly. @@ -160,19 +161,22 @@ ids of items referred to." references))) (define* (sqlite-register db #:key path (references '()) - deriver hash nar-size) + deriver hash nar-size time) "Registers this stuff in DB. PATH is the store item to register and REFERENCES is the list of store items PATH refers to; DERIVER is the '.drv' that produced PATH, HASH is the base16-encoded Nix sha256 hash of PATH (prefixed with \"sha256:\"), and NAR-SIZE is the size in bytes PATH after -being converted to nar form. +being converted to nar form. TIME is the registration time to be recorded in +the database or #f, meaning \"right now\". Every store item in REFERENCES must already be registered." (let ((id (update-or-insert db #:path path #:deriver deriver #:hash hash #:nar-size nar-size - #:time (time-second (current-time time-utc))))) + #:time (time-second + (or time + (current-time time-utc)))))) ;; Call 'path-id' on each of REFERENCES. This ensures we get a ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. (add-references db id @@ -232,15 +236,21 @@ be used internally by the daemon's build hook." #:reset-timestamps? reset-timestamps? #:schema schema)) +(define %epoch + ;; When it all began. + (make-time time-utc 0 1)) + (define* (register-items items #:key prefix state-directory (deduplicate? #t) (reset-timestamps? #t) + registration-time (schema (sql-schema))) "Register all of ITEMS, a list of <store-info> records as returned by 'read-reference-graph', in the database under PREFIX/STATE-DIRECTORY. ITEMS must be in topological order (with leaves first.) If the database is -initially empty, apply SCHEMA to initialize it." +initially empty, apply SCHEMA to initialize it. REGISTRATION-TIME must be the +registration time to be recorded in the database; #f means \"now\"." ;; Priority for options: first what is given, then environment variables, ;; then defaults. %state-directory, %store-directory, and @@ -284,7 +294,8 @@ initially empty, apply SCHEMA to initialize it." #:deriver (store-info-deriver item) #:hash (string-append "sha256:" (bytevector->base16-string hash)) - #:nar-size nar-size) + #:nar-size nar-size + #:time registration-time) (when deduplicate? (deduplicate real-file-name hash #:store store-dir)))) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:09 GMT) Full text and rfc822 format available.Message #53 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 16/19] install: Use 'reset-timestamps' from (guix store database). Date: Fri, 8 Jun 2018 11:34:48 +0200
* gnu/build/install.scm (reset-timestamps): Remove. * gnu/build/vm.scm: Use 'reset-timestamps' from (guix store database). --- gnu/build/install.scm | 15 --------------- gnu/build/vm.scm | 1 + guix/store/database.scm | 1 - 3 files changed, 1 insertion(+), 16 deletions(-) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 82eb63d72..5e84cd6f6 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -26,7 +26,6 @@ #:export (install-boot-config evaluate-populate-directive populate-root-file-system - reset-timestamps register-closure populate-single-profile-directory)) @@ -145,20 +144,6 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (try)) (apply throw args))))))) -(define (reset-timestamps directory) - "Reset the timestamps of all the files under DIRECTORY, so that they appear -as created and modified at the Epoch." - (display "clearing file timestamps...\n") - (for-each (lambda (file) - (let ((s (lstat file))) - ;; XXX: Guile uses libc's 'utime' function (not 'futime'), so - ;; the timestamp of symlinks cannot be changed, and there are - ;; symlinks here pointing to /gnu/store, which is the host, - ;; read-only store. - (unless (eq? (stat:type s) 'symlink) - (utime file 0 0 0 0)))) - (find-files directory #:directories? #t))) - (define* (register-closure prefix closure #:key (deduplicate? #t) (reset-timestamps? #t) diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 37639f723..803cd5996 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -25,6 +25,7 @@ #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (guix build syscalls) + #:use-module ((guix store database) #:select (reset-timestamps)) #:use-module (gnu build linux-boot) #:use-module (gnu build install) #:use-module (gnu system uuid) diff --git a/guix/store/database.scm b/guix/store/database.scm index 3dbe5270a..82938455b 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -183,7 +183,6 @@ Every store item in REFERENCES must already be registered." ;;; High-level interface. ;;; -;; TODO: Factorize with that in (gnu build install). (define (reset-timestamps file) "Reset the modification time on FILE and on all the files it contains, if it's a directory. While at it, canonicalize file permissions." -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:09 GMT) Full text and rfc822 format available.Message #56 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 13/19] install: Use (guix store database) instead of 'guix-register'. Date: Fri, 8 Jun 2018 11:34:45 +0200
* gnu/build/install.scm (register-closure): Add #:reset-timestamps? and and #:schema; honor them. Rewrite in terms of 'register-path'. (populate-single-profile-directory): Add #:schema and honor it. Make /var/guix/profiles and /var/guix/gcroots. * gnu/build/vm.scm (root-partition-initializer): Pass #:reset-timestamps? to 'register-closure'. * gnu/system/vm.scm (not-config?): New procedure. (guile-sqlite3&co): New variable. (expression->derivation-in-linux-vm)[config]: New variable. [builder]: Use 'with-extensions'. (iso9660-image)[schema, config]: New variables. Wrap build expression in 'with-extensions'; add 'sql-schema' call. Remove GUIX from INPUTS. (qemu-image)[schema, config]: New variables. Wrap body in 'with-extensions'. (system-docker-image)[not-config?]: Remove. [config]: Use 'make-config.scm'. [schema]: New variable. [build]: Use 'with-extensions'. Add call to 'sql-schema'. Remove GUIX from INPUTS. * gnu/system/file-systems.scm (%store-prefix): Check whether '%store-prefix' is defined. * guix/scripts/pack.scm (self-contained-tarball)[not-config?] [libgcrypt, schema]: New variables. [build]: Wrap in 'with-extensions'. Adjust imported module list to use 'make-config.scm' for (guix config). --- gnu/build/install.scm | 45 +++-- gnu/build/vm.scm | 1 + gnu/system/file-systems.scm | 11 +- gnu/system/vm.scm | 369 ++++++++++++++++++++---------------- guix/scripts/pack.scm | 209 +++++++++++--------- 5 files changed, 356 insertions(+), 279 deletions(-) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 9e30c0d23..6cc678b44 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org> ;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build install) + #:use-module (guix store database) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (srfi srfi-26) @@ -158,23 +159,31 @@ as created and modified at the Epoch." (utime file 0 0 0 0)))) (find-files directory #:directories? #t))) -(define* (register-closure store closure - #:key (deduplicate? #t)) - "Register CLOSURE in STORE, where STORE is the directory name of the target -store and CLOSURE is the name of a file containing a reference graph as used -by 'guix-register'. As a side effect, this resets timestamps on store files -and, if DEDUPLICATE? is true, deduplicates files common to CLOSURE and the -rest of STORE." - (let ((status (apply system* "guix-register" "--prefix" store - (append (if deduplicate? '() '("--no-deduplication")) - (list closure))))) - (unless (zero? status) - (error "failed to register store items" closure)))) +(define* (register-closure prefix closure + #:key + (deduplicate? #t) (reset-timestamps? #t) + (schema (sql-schema))) + "Register CLOSURE in PREFIX, where PREFIX is the directory name of the +target store and CLOSURE is the name of a file containing a reference graph as +produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is +true, reset timestamps on store files and, if DEDUPLICATE? is true, +deduplicates files common to CLOSURE and the rest of PREFIX." + (let ((items (call-with-input-file closure read-reference-graph))) + ;; TODO: Add a procedure to register all of ITEMS at once. + (for-each (lambda (item) + (register-path (store-info-item item) + #:references (store-info-references item) + #:deriver (store-info-deriver item) + #:prefix prefix + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:schema schema)) + items))) (define* (populate-single-profile-directory directory #:key profile closure deduplicate? - register?) + register? schema) "Populate DIRECTORY with a store containing PROFILE, whose closure is given in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY is initialized to contain a single profile under /root pointing to PROFILE. @@ -200,11 +209,11 @@ This is used to create the self-contained tarballs with 'guix pack'." (when register? (register-closure (canonicalize-path directory) closure - #:deduplicate? deduplicate?) + #:deduplicate? deduplicate? + #:schema schema) - ;; XXX: 'guix-register' registers profiles as GC roots but the symlink - ;; target uses $TMPDIR. Fix that. - (delete-file (scope "/var/guix/gcroots/profiles")) + (mkdir-p* "/var/guix/profiles") + (mkdir-p* "/var/guix/gcroots") (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles")) diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index fa3ce7790..37639f723 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -354,6 +354,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." (for-each (lambda (closure) (register-closure target (string-append "/xchg/" closure) + #:reset-timestamps? copy-closures? #:deduplicate? deduplicate?)) closures) (unless copy-closures? diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 2b5948256..393dd0df7 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -194,10 +194,15 @@ ;; differs from user to user. (define (%store-prefix) "Return the store prefix." - (cond ((resolve-module '(guix store) #:ensure #f) + ;; Note: If we have (guix store database) in the search path and we do *not* + ;; have (guix store) proper, 'resolve-module' returns an empty (guix store) + ;; with one sub-module. + (cond ((and=> (resolve-module '(guix store) #:ensure #f) + (lambda (store) + (module-variable store '%store-prefix))) => - (lambda (store) - ((module-ref store '%store-prefix)))) + (lambda (variable) + ((variable-ref variable)))) ((getenv "NIX_STORE") => identity) (else diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e0fcf1f3e..f3a7b630e 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -34,6 +34,7 @@ #:use-module (guix utils) #:use-module (guix hash) #:use-module (guix base32) + #:use-module ((guix self) #:select (make-config.scm)) #:use-module ((gnu build vm) #:select (qemu-command)) @@ -50,7 +51,6 @@ #:use-module (gnu packages disk) #:use-module (gnu packages zile) #:use-module (gnu packages linux) - #:use-module (gnu packages package-management) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (gnu packages admin) @@ -116,6 +116,19 @@ (options "trans=virtio") (check? #f)))) +(define not-config? + ;; Select (guix …) and (gnu …) modules, except (guix config). + (match-lambda + (('guix 'config) #f) + (('guix rest ...) #t) + (('gnu rest ...) #t) + (rest #f))) + +(define guile-sqlite3&co + ;; Guile-SQLite3 and its propagated inputs. + (cons guile-sqlite3 + (package-transitive-propagated-inputs guile-sqlite3))) + (define* (expression->derivation-in-linux-vm name exp #:key (system (%current-system)) @@ -148,6 +161,10 @@ based on the size of the closure of REFERENCES-GRAPHS. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs, as for `derivation'. The files containing the reference graphs are made available under the /xchg CIFS share." + (define config + ;; (guix config) module for consumption by (guix gcrypt). + (make-config.scm #:libgcrypt libgcrypt)) + (define user-builder (program-file "builder-in-linux-vm" exp)) @@ -175,40 +192,44 @@ made available under the /xchg CIFS share." (define builder ;; Code that launches the VM that evaluates EXP. - (with-imported-modules (source-module-closure '((guix build utils) - (gnu build vm))) - #~(begin - (use-modules (guix build utils) - (gnu build vm)) + (with-extensions guile-sqlite3&co + (with-imported-modules `(,@(source-module-closure + '((guix build utils) + (gnu build vm)) + #:select? not-config?) + ((guix config) => ,config)) + #~(begin + (use-modules (guix build utils) + (gnu build vm)) - (let* ((inputs '#$(list qemu coreutils)) - (linux (string-append #$linux "/" - #$(system-linux-image-file-name))) - (initrd (string-append #$initrd "/initrd")) - (loader #$loader) - (graphs '#$(match references-graphs - (((graph-files . _) ...) graph-files) - (_ #f))) - (size #$(if (eq? 'guess disk-image-size) - #~(+ (* 70 (expt 2 20)) ;ESP - (estimated-partition-size graphs)) - disk-image-size))) + (let* ((inputs '#$(list qemu (canonical-package coreutils))) + (linux (string-append #$linux "/" + #$(system-linux-image-file-name))) + (initrd (string-append #$initrd "/initrd")) + (loader #$loader) + (graphs '#$(match references-graphs + (((graph-files . _) ...) graph-files) + (_ #f))) + (size #$(if (eq? 'guess disk-image-size) + #~(+ (* 70 (expt 2 20)) ;ESP + (estimated-partition-size graphs)) + disk-image-size))) - (set-path-environment-variable "PATH" '("bin") inputs) + (set-path-environment-variable "PATH" '("bin") inputs) - (load-in-linux-vm loader - #:output #$output - #:linux linux #:initrd initrd - #:memory-size #$memory-size - #:make-disk-image? #$make-disk-image? - #:single-file-output? #$single-file-output? - ;; FIXME: ‘target-arm32?’ may not operate on - ;; the right system/target values. Rewrite - ;; using ‘let-system’ when available. - #:target-arm32? #$(target-arm32?) - #:disk-image-format #$disk-image-format - #:disk-image-size size - #:references-graphs graphs))))) + (load-in-linux-vm loader + #:output #$output + #:linux linux #:initrd initrd + #:memory-size #$memory-size + #:make-disk-image? #$make-disk-image? + #:single-file-output? #$single-file-output? + ;; FIXME: ‘target-arm32?’ may not operate on + ;; the right system/target values. Rewrite + ;; using ‘let-system’ when available. + #:target-arm32? #$(target-arm32?) + #:disk-image-format #$disk-image-format + #:disk-image-size size + #:references-graphs graphs)))))) (gexp->derivation name builder ;; TODO: Require the "kvm" feature. @@ -231,42 +252,56 @@ made available under the /xchg CIFS share." "Return a bootable, stand-alone iso9660 image. INPUTS is a list of inputs (as for packages)." + (define config + (make-config.scm #:libgcrypt libgcrypt)) + + (define schema + (and register-closures? + (local-file (search-path %load-path + "guix/store/schema.sql")))) + (expression->derivation-in-linux-vm name - (with-imported-modules (source-module-closure '((gnu build vm) - (guix build utils))) - #~(begin - (use-modules (gnu build vm) - (guix build utils)) + (with-extensions guile-sqlite3&co + (with-imported-modules `(,@(source-module-closure '((gnu build vm) + (guix store database) + (guix build utils)) + #:select? not-config?) + ((guix config) => ,config)) + #~(begin + (use-modules (gnu build vm) + (guix store database) + (guix build utils)) - (let ((inputs - '#$(append (list qemu parted e2fsprogs dosfstools xorriso) - (map canonical-package - (list sed grep coreutils findutils gawk)) - (if register-closures? (list guix) '()))) + (sql-schema #$schema) + (let ((inputs + '#$(append (list qemu parted e2fsprogs dosfstools xorriso) + (map canonical-package + (list sed grep coreutils findutils gawk)))) - (graphs '#$(match inputs - (((names . _) ...) - names))) - ;; This variable is unused but allows us to add INPUTS-TO-COPY - ;; as inputs. - (to-register - '#$(map (match-lambda - ((name thing) thing) - ((name thing output) `(,thing ,output))) - inputs))) - (set-path-environment-variable "PATH" '("bin" "sbin") inputs) - (make-iso9660-image #$(bootloader-package bootloader) - #$bootcfg-drv - #$os-drv - "/xchg/guixsd.iso" - #:register-closures? #$register-closures? - #:closures graphs - #:volume-id #$file-system-label - #:volume-uuid #$(and=> file-system-uuid - uuid-bytevector))))) + (graphs '#$(match inputs + (((names . _) ...) + names))) + ;; This variable is unused but allows us to add INPUTS-TO-COPY + ;; as inputs. + (to-register + '#$(map (match-lambda + ((name thing) thing) + ((name thing output) `(,thing ,output))) + inputs))) + + (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + (make-iso9660-image #$(bootloader-package bootloader) + #$bootcfg-drv + #$os-drv + "/xchg/guixsd.iso" + #:register-closures? #$register-closures? + #:closures graphs + #:volume-id #$file-system-label + #:volume-uuid #$(and=> file-system-uuid + uuid-bytevector)))))) #:system system #:make-disk-image? #f #:single-file-output? #t @@ -301,90 +336,104 @@ INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, register INPUTS in the store database of the image so that Guix can be used in the image." + (define config + (make-config.scm #:libgcrypt libgcrypt)) + + (define schema + (and register-closures? + (local-file (search-path %load-path + "guix/store/schema.sql")))) + (expression->derivation-in-linux-vm name - (with-imported-modules (source-module-closure '((gnu build bootloader) - (gnu build vm) - (guix build utils))) - #~(begin - (use-modules (gnu build bootloader) - (gnu build vm) - (guix build utils) - (srfi srfi-26) - (ice-9 binary-ports)) + (with-extensions guile-sqlite3&co + (with-imported-modules `(,@(source-module-closure '((gnu build vm) + (gnu build bootloader) + (guix store database) + (guix build utils)) + #:select? not-config?) + ((guix config) => ,config)) + #~(begin + (use-modules (gnu build bootloader) + (gnu build vm) + (guix store database) + (guix build utils) + (srfi srfi-26) + (ice-9 binary-ports)) - (let ((inputs - '#$(append (list qemu parted e2fsprogs dosfstools) - (map canonical-package - (list sed grep coreutils findutils gawk)) - (if register-closures? (list guix) '()))) + (sql-schema #$schema) - ;; This variable is unused but allows us to add INPUTS-TO-COPY - ;; as inputs. - (to-register - '#$(map (match-lambda - ((name thing) thing) - ((name thing output) `(,thing ,output))) - inputs))) + (let ((inputs + '#$(append (list qemu parted e2fsprogs dosfstools) + (map canonical-package + (list sed grep coreutils findutils gawk)))) - (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + ;; This variable is unused but allows us to add INPUTS-TO-COPY + ;; as inputs. + (to-register + '#$(map (match-lambda + ((name thing) thing) + ((name thing output) `(,thing ,output))) + inputs))) - (let* ((graphs '#$(match inputs - (((names . _) ...) - names))) - (initialize (root-partition-initializer - #:closures graphs - #:copy-closures? #$copy-inputs? - #:register-closures? #$register-closures? - #:system-directory #$os-drv)) - (root-size #$(if (eq? 'guess disk-image-size) - #~(max - ;; Minimum 20 MiB root size - (* 20 (expt 2 20)) - (estimated-partition-size - (map (cut string-append "/xchg/" <>) - graphs))) - (- disk-image-size - (* 50 (expt 2 20))))) - (partitions - (append - (list (partition - (size root-size) - (label #$file-system-label) - (uuid #$(and=> file-system-uuid - uuid-bytevector)) - (file-system #$file-system-type) - (flags '(boot)) - (initializer initialize))) - ;; Append a small EFI System Partition for use with UEFI - ;; bootloaders if we are not targeting ARM because UEFI - ;; support in U-Boot is experimental. - ;; - ;; FIXME: ‘target-arm32?’ may be not operate on the right - ;; system/target values. Rewrite using ‘let-system’ when - ;; available. - (if #$(target-arm32?) - '() - (list (partition - ;; The standalone grub image is about 10MiB, but - ;; leave some room for custom or multiple images. - (size (* 40 (expt 2 20))) - (label "GNU-ESP") ;cosmetic only - ;; Use "vfat" here since this property is used - ;; when mounting. The actual FAT-ness is based - ;; on file system size (16 in this case). - (file-system "vfat") - (flags '(esp)))))))) - (initialize-hard-disk "/dev/vda" - #:partitions partitions - #:grub-efi #$grub-efi - #:bootloader-package - #$(bootloader-package bootloader) - #:bootcfg #$bootcfg-drv - #:bootcfg-location - #$(bootloader-configuration-file bootloader) - #:bootloader-installer - #$(bootloader-installer bootloader)))))) + (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + + (let* ((graphs '#$(match inputs + (((names . _) ...) + names))) + (initialize (root-partition-initializer + #:closures graphs + #:copy-closures? #$copy-inputs? + #:register-closures? #$register-closures? + #:system-directory #$os-drv)) + (root-size #$(if (eq? 'guess disk-image-size) + #~(max + ;; Minimum 20 MiB root size + (* 20 (expt 2 20)) + (estimated-partition-size + (map (cut string-append "/xchg/" <>) + graphs))) + (- disk-image-size + (* 50 (expt 2 20))))) + (partitions + (append + (list (partition + (size root-size) + (label #$file-system-label) + (uuid #$(and=> file-system-uuid + uuid-bytevector)) + (file-system #$file-system-type) + (flags '(boot)) + (initializer initialize))) + ;; Append a small EFI System Partition for use with UEFI + ;; bootloaders if we are not targeting ARM because UEFI + ;; support in U-Boot is experimental. + ;; + ;; FIXME: ‘target-arm32?’ may be not operate on the right + ;; system/target values. Rewrite using ‘let-system’ when + ;; available. + (if #$(target-arm32?) + '() + (list (partition + ;; The standalone grub image is about 10MiB, but + ;; leave some room for custom or multiple images. + (size (* 40 (expt 2 20))) + (label "GNU-ESP") ;cosmetic only + ;; Use "vfat" here since this property is used + ;; when mounting. The actual FAT-ness is based + ;; on file system size (16 in this case). + (file-system "vfat") + (flags '(esp)))))))) + (initialize-hard-disk "/dev/vda" + #:partitions partitions + #:grub-efi #$grub-efi + #:bootloader-package + #$(bootloader-package bootloader) + #:bootcfg #$bootcfg-drv + #:bootcfg-location + #$(bootloader-configuration-file bootloader) + #:bootloader-installer + #$(bootloader-installer bootloader))))))) #:system system #:make-disk-image? #t #:disk-image-size disk-image-size @@ -402,49 +451,41 @@ makes sense when you want to build a GuixSD Docker image that has Guix installed inside of it. If you don't need Guix (e.g., your GuixSD Docker image just contains a web server that is started by the Shepherd), then you should set REGISTER-CLOSURES? to #f." - (define not-config? - (match-lambda - (('guix 'config) #f) - (('guix rest ...) #t) - (('gnu rest ...) #t) - (rest #f))) - (define config ;; (guix config) module for consumption by (guix gcrypt). - (scheme-file "gcrypt-config.scm" - #~(begin - (define-module (guix config) - #:export (%libgcrypt)) + (make-config.scm #:libgcrypt libgcrypt)) - ;; XXX: Work around <http://bugs.gnu.org/15602>. - (eval-when (expand load eval) - (define %libgcrypt - #+(file-append libgcrypt "/lib/libgcrypt")))))) + (define schema + (and register-closures? + (local-file (search-path %load-path + "guix/store/schema.sql")))) (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t)) (name -> (string-append name ".tar.gz")) (graph -> "system-graph")) (define build - (with-extensions (list guile-json) ;for (guix docker) + (with-extensions (cons guile-json ;for (guix docker) + guile-sqlite3&co) ;for (guix store database) (with-imported-modules `(,@(source-module-closure '((guix docker) + (guix store database) (guix build utils) + (guix build store-copy) (gnu build vm)) #:select? not-config?) - (guix build store-copy) ((guix config) => ,config)) #~(begin (use-modules (guix docker) (guix build utils) (gnu build vm) (srfi srfi-19) - (guix build store-copy)) + (guix build store-copy) + (guix store database)) - (let* ((inputs '#$(append (list tar) - (if register-closures? - (list guix) - '()))) - ;; This initializer requires elevated privileges that are + ;; Set the SQL schema location. + (sql-schema #$schema) + + (let* (;; This initializer requires elevated privileges that are ;; not normally available in the build environment (e.g., ;; it needs to create device nodes). In order to obtain ;; such privileges, we run it as root in a VM. @@ -459,7 +500,7 @@ should set REGISTER-CLOSURES? to #f." ;; lack of privileges if we use a root-directory that is on ;; a file system that is shared with the host (e.g., /tmp). (root-directory "/guixsd-system-root")) - (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + (set-path-environment-variable "PATH" '("bin" "sbin") '(#+tar)) (mkdir root-directory) (initialize root-directory) (build-docker-image diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 78bfd01ef..ed876b259 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -35,6 +35,7 @@ #:use-module (guix search-paths) #:use-module (guix build-system gnu) #:use-module (guix scripts build) + #:use-module ((guix self) #:select (make-config.scm)) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (gnu packages compression) @@ -101,113 +102,133 @@ with a properly initialized store database. SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be added to the pack." + (define not-config? + (match-lambda + (('guix 'config) #f) + (('guix _ ...) #t) + (('gnu _ ...) #t) + (_ #f))) + + (define libgcrypt + (module-ref (resolve-interface '(gnu packages gnupg)) + 'libgcrypt)) + + (define schema + (and localstatedir? + (local-file (search-path %load-path + "guix/store/schema.sql")))) + (define build - (with-imported-modules (source-module-closure - '((guix build utils) - (guix build union) - (guix build store-copy) - (gnu build install))) - #~(begin - (use-modules (guix build utils) - ((guix build union) #:select (relative-file-name)) - (gnu build install) - (srfi srfi-1) - (srfi srfi-26) - (ice-9 match)) + (with-imported-modules `(((guix config) + => ,(make-config.scm + #:libgcrypt libgcrypt)) + ,@(source-module-closure + `((guix build utils) + (guix build union) + (guix build store-copy) + (gnu build install)) + #:select? not-config?)) + (with-extensions (cons guile-sqlite3 + (package-transitive-propagated-inputs + guile-sqlite3)) + #~(begin + (use-modules (guix build utils) + ((guix build union) #:select (relative-file-name)) + (gnu build install) + (srfi srfi-1) + (srfi srfi-26) + (ice-9 match)) - (define %root "root") + (define %root "root") - (define symlink->directives - ;; Return "populate directives" to make the given symlink and its - ;; parent directories. - (match-lambda - ((source '-> target) - (let ((target (string-append #$profile "/" target)) - (parent (dirname source))) - ;; Never add a 'directory' directive for "/" so as to - ;; preserve its ownnership when extracting the archive (see - ;; below), and also because this would lead to adding the - ;; same entries twice in the tarball. - `(,@(if (string=? parent "/") - '() - `((directory ,parent))) - (,source - -> ,(relative-file-name parent target))))))) + (define symlink->directives + ;; Return "populate directives" to make the given symlink and its + ;; parent directories. + (match-lambda + ((source '-> target) + (let ((target (string-append #$profile "/" target)) + (parent (dirname source))) + ;; Never add a 'directory' directive for "/" so as to + ;; preserve its ownnership when extracting the archive (see + ;; below), and also because this would lead to adding the + ;; same entries twice in the tarball. + `(,@(if (string=? parent "/") + '() + `((directory ,parent))) + (,source + -> ,(relative-file-name parent target))))))) - (define directives - ;; Fully-qualified symlinks. - (append-map symlink->directives '#$symlinks)) + (define directives + ;; Fully-qualified symlinks. + (append-map symlink->directives '#$symlinks)) - ;; The --sort option was added to GNU tar in version 1.28, released - ;; 2014-07-28. For testing, we use the bootstrap tar, which is - ;; older and doesn't support it. - (define tar-supports-sort? - (zero? (system* (string-append #+archiver "/bin/tar") - "cf" "/dev/null" "--files-from=/dev/null" - "--sort=name"))) + ;; The --sort option was added to GNU tar in version 1.28, released + ;; 2014-07-28. For testing, we use the bootstrap tar, which is + ;; older and doesn't support it. + (define tar-supports-sort? + (zero? (system* (string-append #+archiver "/bin/tar") + "cf" "/dev/null" "--files-from=/dev/null" + "--sort=name"))) - ;; We need Guix here for 'guix-register'. - (setenv "PATH" - (string-append #$(if localstatedir? - (file-append guix "/sbin:") - "") - #$archiver "/bin")) + ;; Add 'tar' to the search path. + (setenv "PATH" #+(file-append archiver "/bin")) - ;; Note: there is not much to gain here with deduplication and there - ;; is the overhead of the '.links' directory, so turn it off. - ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs - ;; with hard links: - ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. - (populate-single-profile-directory %root - #:profile #$profile - #:closure "profile" - #:deduplicate? #f - #:register? #$localstatedir?) + ;; Note: there is not much to gain here with deduplication and there + ;; is the overhead of the '.links' directory, so turn it off. + ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs + ;; with hard links: + ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. + (populate-single-profile-directory %root + #:profile #$profile + #:closure "profile" + #:deduplicate? #f + #:register? #$localstatedir? + #:schema #$schema) - ;; Create SYMLINKS. - (for-each (cut evaluate-populate-directive <> %root) - directives) + ;; Create SYMLINKS. + (for-each (cut evaluate-populate-directive <> %root) + directives) - ;; Create the tarball. Use GNU format so there's no file name - ;; length limitation. - (with-directory-excursion %root - (exit - (zero? (apply system* "tar" - "-I" - (string-join '#+(compressor-command compressor)) - "--format=gnu" + ;; Create the tarball. Use GNU format so there's no file name + ;; length limitation. + (with-directory-excursion %root + (exit + (zero? (apply system* "tar" + "-I" + (string-join '#+(compressor-command compressor)) + "--format=gnu" - ;; Avoid non-determinism in the archive. Use - ;; mtime = 1, not zero, because that is what the - ;; daemon does for files in the store (see the - ;; 'mtimeStore' constant in local-store.cc.) - (if tar-supports-sort? "--sort=name" "--mtime=@1") - "--mtime=@1" ;for files in /var/guix - "--owner=root:0" - "--group=root:0" + ;; Avoid non-determinism in the archive. Use + ;; mtime = 1, not zero, because that is what the + ;; daemon does for files in the store (see the + ;; 'mtimeStore' constant in local-store.cc.) + (if tar-supports-sort? "--sort=name" "--mtime=@1") + "--mtime=@1" ;for files in /var/guix + "--owner=root:0" + "--group=root:0" - "--check-links" - "-cvf" #$output - ;; Avoid adding / and /var to the tarball, so - ;; that the ownership and permissions of those - ;; directories will not be overwritten when - ;; extracting the archive. Do not include /root - ;; because the root account might have a - ;; different home directory. - #$@(if localstatedir? - '("./var/guix") - '()) + "--check-links" + "-cvf" #$output + ;; Avoid adding / and /var to the tarball, so + ;; that the ownership and permissions of those + ;; directories will not be overwritten when + ;; extracting the archive. Do not include /root + ;; because the root account might have a + ;; different home directory. + #$@(if localstatedir? + '("./var/guix") + '()) - (string-append "." (%store-directory)) + (string-append "." (%store-directory)) - (delete-duplicates - (filter-map (match-lambda - (('directory directory) - (string-append "." directory)) - ((source '-> _) - (string-append "." source)) - (_ #f)) - directives))))))))) + (delete-duplicates + (filter-map (match-lambda + (('directory directory) + (string-append "." directory)) + ((source '-> _) + (string-append "." source)) + (_ #f)) + directives)))))))))) (gexp->derivation (string-append name ".tar" (compressor-extension compressor)) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:09 GMT) Full text and rfc822 format available.Message #59 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 18/19] store: Remove 'register-path'. Date: Fri, 8 Jun 2018 11:34:50 +0200
* guix/store.scm (register-path): Remove. * guix/nar.scm: Use (guix store database). * guix/scripts/system.scm: Likewise. * tests/store-database.scm: Remove #:hide (register-path). * tests/store.scm ("register-path"): Remove. --- guix/nar.scm | 3 ++- guix/scripts/system.scm | 1 + guix/store.scm | 29 ----------------------------- tests/store-database.scm | 2 +- tests/store.scm | 22 +--------------------- 5 files changed, 5 insertions(+), 52 deletions(-) diff --git a/guix/nar.scm b/guix/nar.scm index 9b4c60823..3556de137 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo <at> gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo <at> gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw <at> netris.org> ;;; ;;; This file is part of GNU Guix. @@ -23,6 +23,7 @@ #:use-module ((guix build utils) #:select (delete-file-recursively with-directory-excursion)) #:use-module (guix store) + #:use-module (guix store database) #:use-module (guix ui) ; for '_' #:use-module (guix hash) #:use-module (guix pki) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 766cab1aa..23c45cc5a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -23,6 +23,7 @@ #:use-module (guix config) #:use-module (guix ui) #:use-module (guix store) + #:autoload (guix store database) (register-path) #:use-module (guix grafts) #:use-module (guix gexp) #:use-module (guix derivations) diff --git a/guix/store.scm b/guix/store.scm index 6742611c6..773d53e82 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -122,8 +122,6 @@ current-build-output-port - register-path - %store-monad store-bind store-return @@ -1301,33 +1299,6 @@ The result is always the empty list unless the daemon was started with This makes sense only when the daemon was started with '--cache-failures'." boolean) -(define* (register-path path - #:key (references '()) deriver prefix - state-directory) - "Register PATH as a valid store file, with REFERENCES as its list of -references, and DERIVER as its deriver (.drv that led to it.) If PREFIX is -not #f, it must be the name of the directory containing the new store to -initialize; if STATE-DIRECTORY is not #f, it must be a string containing the -absolute file name to the state directory of the store being initialized. -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. - (let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program - `(,@(if prefix - `("--prefix" ,prefix) - '()) - ,@(if state-directory - `("--state-directory" ,state-directory) - '()))))) - (and pipe - (begin - (format pipe "~a~%~a~%~a~%" - path (or deriver "") (length references)) - (for-each (cut format pipe "~a~%" <>) references) - (zero? (close-pipe pipe)))))) - ;;; ;;; Store monad. diff --git a/tests/store-database.scm b/tests/store-database.scm index 22c356679..fcae66e2d 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -18,7 +18,7 @@ (define-module (test-store-database) #:use-module (guix tests) - #:use-module ((guix store) #:hide (register-path)) + #:use-module (guix store) #:use-module (guix store database) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module (srfi srfi-26) diff --git a/tests/store.scm b/tests/store.scm index fdf3be33f..afecec940 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -777,26 +777,6 @@ (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-assert "verify-store" (let* ((text (random-text)) (file1 (add-text-to-store %store "foo" text)) -- 2.17.1
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Fri, 08 Jun 2018 09:36:10 GMT) Full text and rfc822 format available.Message #62 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31755 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 19/19] Remove 'guix-register' and its traces. Date: Fri, 8 Jun 2018 11:34:51 +0200
* Makefile.am (SH_TESTS): Remove tests/guix-register.sh. * build-aux/pre-inst-env.in (GUIX_REGISTER): Remove. * gnu/build/install.scm (directives): Remove outdated comment. * gnu/build/vm.scm (root-partition-initializer): Update comment. * gnu/packages/package-management.scm (guix-register): Remove. * guix/config.scm.in (%sbindir, %guix-register-program): Remove. * guix/scripts/system.scm (install): Adjust docstring. * guix/self.scm (make-config.scm): Remove #:guix. Do not generate %sbindir and %guix-register-program. (specification->package): Remove "guix". * nix/guix-register/guix-register.cc: Remove. * nix/local.mk (sbin_PROGRAMS, guix_register_SOURCES) (guix_register_CPPFLAGS, guix_register_LDFLAGS): Remove. * tests/guix-register.sh: Remove. --- .gitignore | 1 - Makefile.am | 7 - build-aux/pre-inst-env.in | 6 +- gnu/build/install.scm | 3 - gnu/build/vm.scm | 4 +- gnu/packages/package-management.scm | 36 ---- guix/config.scm.in | 12 +- guix/scripts/system.scm | 2 +- guix/self.scm | 21 +-- nix/guix-register/guix-register.cc | 254 ---------------------------- nix/local.mk | 16 -- tests/guix-register.sh | 191 --------------------- 12 files changed, 7 insertions(+), 546 deletions(-) delete mode 100644 nix/guix-register/guix-register.cc delete mode 100644 tests/guix-register.sh diff --git a/.gitignore b/.gitignore index 38a55a3b5..976be8355 100644 --- a/.gitignore +++ b/.gitignore @@ -69,7 +69,6 @@ /etc/guix-publish.conf /etc/guix-publish.service /guix-daemon -/guix-register /guix/config.scm /libformat.a /libstore.a diff --git a/Makefile.am b/Makefile.am index d6403c02e..dbfb21b52 100644 --- a/Makefile.am +++ b/Makefile.am @@ -405,13 +405,6 @@ SH_TESTS = \ tests/guix-graph.sh \ tests/guix-lint.sh -if BUILD_DAEMON - -SH_TESTS += tests/guix-register.sh - -endif BUILD_DAEMON - - TESTS = $(SCM_TESTS) $(SH_TESTS) AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" GUILE_AUTO_COMPILE=0 diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in index 14315d40d..286a81591 100644 --- a/build-aux/pre-inst-env.in +++ b/build-aux/pre-inst-env.in @@ -1,7 +1,7 @@ #!/bin/sh # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo <at> gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org> # Copyright © 2017 Eric Bavier <bavier <at> cray.com> # # This file is part of GNU Guix. @@ -55,10 +55,6 @@ NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload" @BUILD_DAEMON_OFFLOAD_FALSE@# No offloading support. @BUILD_DAEMON_OFFLOAD_FALSE <at> unset NIX_BUILD_HOOK -# 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/gnu/build/install.scm b/gnu/build/install.scm index 06ecb3995..5a5e70387 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -110,9 +110,6 @@ STORE." ("/var/guix/gcroots/booted-system" -> "/run/booted-system") ("/var/guix/gcroots/current-system" -> "/run/current-system") - - ;; XXX: 'guix-register' creates this symlink with a wrong target, so - ;; create it upfront to be sure. ("/var/guix/gcroots/profiles" -> "/var/guix/profiles") (directory "/bin") diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 803cd5996..73d0191de 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -346,7 +346,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." ;; Optionally, register the inputs in the image's store. (when register-closures? (unless copy-closures? - ;; XXX: 'guix-register' wants to palpate the things it registers, so + ;; XXX: 'register-closure' wants to palpate the things it registers, so ;; bind-mount the store on the target. (mkdir-p target-store) (mount (%store-directory) target-store "" MS_BIND)) @@ -365,7 +365,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." (display "populating...\n") (populate-root-file-system system-directory target) - ;; 'guix-register' resets timestamps and everything, so no need to do it + ;; 'register-closure' resets timestamps and everything, so no need to do it ;; once more in that case. (unless register-closures? (reset-timestamps target)))) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index b8c14ee5d..8790bd3a2 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -288,42 +288,6 @@ the Nix package manager.") ;; Alias for backward compatibility. (define-public guix-devel guix) -(define-public guix-register - ;; This package is for internal consumption: it allows us to quickly build - ;; the 'guix-register' program, which is referred to by (guix config). - ;; TODO: Remove this hack when 'guix-register' has been superseded by Scheme - ;; code. - (package - (inherit guix) - (properties `((hidden? . #t))) - (name "guix-register") - - ;; Use a minimum set of dependencies. - (native-inputs - (fold alist-delete (package-native-inputs guix) - '("po4a" "graphviz" "help2man"))) - (propagated-inputs - `(("gnutls" ,gnutls) - ("guile-git" ,guile-git))) - - (arguments - (substitute-keyword-arguments (package-arguments guix) - ((#:tests? #f #f) - #f) - ((#:phases phases '%standard-phases) - `(modify-phases ,phases - (replace 'build - (lambda _ - (invoke "make" "nix/libstore/schema.sql.hh") - (invoke "make" "-j" (number->string - (parallel-job-count)) - "guix-register"))) - (delete 'copy-bootstrap-guile) - (replace 'install - (lambda _ - (invoke "make" "install-sbinPROGRAMS"))) - (delete 'wrap-program))))))) - (define-public guile2.0-guix (package (inherit guix) diff --git a/guix/config.scm.in b/guix/config.scm.in index dfe5fe0db..1d84ddf18 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo <at> gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo <at> gnu.org> ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt <at> cune.org> ;;; ;;; This file is part of GNU Guix. @@ -26,13 +26,11 @@ %storedir %localstatedir %sysconfdir - %sbindir %store-directory %state-directory %store-database-directory %config-directory - %guix-register-program %system %libgcrypt @@ -70,9 +68,6 @@ (define %sysconfdir "@guix_sysconfdir@") -(define %sbindir - "@guix_sbindir@") - (define %store-directory (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path) %storedir)) @@ -91,11 +86,6 @@ (or (getenv "GUIX_CONFIGURATION_DIRECTORY") (string-append %sysconfdir "/guix"))) -(define %guix-register-program - ;; The 'guix-register' program. - (or (getenv "GUIX_REGISTER") - (string-append %sbindir "/guix-register"))) - (define %system "@guix_system@") diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 23c45cc5a..af2adc47e 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -198,7 +198,7 @@ TARGET, and register them." bootcfg bootcfg-file) "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's what -'guix-register' expects. +'register-path' expects. When INSTALL-BOOTLOADER? is true, install bootloader using BOOTCFG." (define (maybe-copy to-copy) diff --git a/guix/self.scm b/guix/self.scm index f8b8642bf..2b3e8125f 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -88,8 +88,6 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." ("gzip" (ref '(gnu packages compression) 'gzip)) ("bzip2" (ref '(gnu packages compression) 'bzip2)) ("xz" (ref '(gnu packages compression) 'xz)) - ("guix" (ref '(gnu packages package-management) - 'guix-register)) ("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json)) ("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh)) ("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git)) @@ -342,7 +340,6 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." #:gzip gzip #:bzip2 bzip2 #:xz xz - #:guix guix #:package-name %guix-package-name #:package-version @@ -387,8 +384,7 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (define %dependency-variables ;; (guix config) variables corresponding to dependencies. - '(%libgcrypt %libz %xz %gzip %bzip2 %nix-instantiate - %sbindir %guix-register-program)) + '(%libgcrypt %libz %xz %gzip %bzip2 %nix-instantiate)) (define %persona-variables ;; (guix config) variables that define Guix's persona. @@ -410,7 +406,7 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (string<? (symbol->string (car name+value1)) (symbol->string (car name+value2)))))) -(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 guix +(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 (package-name "GNU Guix") (package-version "0") (bug-report-address "bug-guix <at> gnu.org") @@ -426,8 +422,6 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." %guix-version %guix-bug-report-address %guix-home-page-url - %sbindir - %guix-register-program %libgcrypt %libz %gzip @@ -445,17 +439,6 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (define %guix-bug-report-address #$bug-report-address) (define %guix-home-page-url #$home-page-url) - (define %sbindir - ;; This is used to define '%guix-register-program'. - ;; TODO: Use a derivation that builds nothing but the - ;; C++ part. - #+(and guix (file-append guix "/sbin"))) - - (define %guix-register-program - (or (getenv "GUIX_REGISTER") - (and %sbindir - (string-append %sbindir "/guix-register")))) - (define %gzip #+(and gzip (file-append gzip "/bin/gzip"))) (define %bzip2 diff --git a/nix/guix-register/guix-register.cc b/nix/guix-register/guix-register.cc deleted file mode 100644 index 16dae62b3..000000000 --- a/nix/guix-register/guix-register.cc +++ /dev/null @@ -1,254 +0,0 @@ -/* GNU Guix --- Functional package management for GNU - Copyright (C) 2013, 2014, 2015 Ludovic Courtès <ludo <at> gnu.org> - Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, - 2013 Eelco Dolstra <eelco.dolstra <at> logicblox.com> - - This file is part of GNU Guix. - - GNU Guix is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or (at - your option) any later version. - - GNU Guix is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. */ - -/* This file derives from the implementation of 'nix-store - --register-validity', by Eelco Dolstra, as found in the Nix package - manager's src/nix-store/nix-store.cc. */ - -#include <config.h> - -#include <globals.hh> -#include <local-store.hh> - -#include <iostream> -#include <fstream> -#include <cstdlib> -#include <cstdio> - -#include <argp.h> -#include <gcrypt.h> - -using namespace nix; - -/* Input stream where we read closure descriptions. */ -static std::istream *input = &std::cin; - - - -/* Command-line options. */ - -const char *argp_program_version = - "guix-register (" PACKAGE_NAME ") " PACKAGE_VERSION; -const char *argp_program_bug_address = PACKAGE_BUGREPORT; - -static char doc[] = -"guix-register -- register a closure as valid in a store\ -\v\ -This program is used internally when populating a store with data \ -from an existing store. It updates the new store's database with \ -information about which store files are valid, and what their \ -references are."; - -#define GUIX_OPT_STATE_DIRECTORY 1 -#define GUIX_OPT_DEDUPLICATE 2 - -static const struct argp_option options[] = - { - { "prefix", 'p', "DIRECTORY", 0, - "Open the store that lies under DIRECTORY" }, - { "state-directory", GUIX_OPT_STATE_DIRECTORY, "DIRECTORY", 0, - "Use DIRECTORY as the state directory of the target store" }, - { "no-deduplication", GUIX_OPT_DEDUPLICATE, 0, 0, - "Disable automatic deduplication of registered store items" }, - { 0, 0, 0, 0, 0 } - }; - - -/* Prefix of the store being populated. */ -static std::string prefix; - -/* Whether to deduplicate the registered store items. */ -static bool deduplication = true; - -/* Parse a single option. */ -static error_t -parse_opt (int key, char *arg, struct argp_state *state) -{ - switch (key) - { - case 'p': - { - prefix = canonPath (arg); - settings.nixStore = prefix + NIX_STORE_DIR; - settings.nixDataDir = prefix + NIX_DATA_DIR; - settings.nixLogDir = prefix + NIX_LOG_DIR; - settings.nixStateDir = prefix + NIX_STATE_DIR; - settings.nixDBPath = settings.nixStateDir + "/db"; - break; - } - - case GUIX_OPT_STATE_DIRECTORY: - { - string state_dir = canonPath (arg); - - settings.nixStateDir = state_dir; - settings.nixDBPath = state_dir + "/db"; - break; - } - - case GUIX_OPT_DEDUPLICATE: - deduplication = false; - break; - - case ARGP_KEY_ARG: - { - std::ifstream *file; - - if (state->arg_num >= 2) - /* Too many arguments. */ - argp_usage (state); - - file = new std::ifstream (); - file->open (arg); - - input = file; - } - break; - - default: - return (error_t) ARGP_ERR_UNKNOWN; - } - - return (error_t) 0; -} - -/* Argument parsing. */ -static struct argp argp = { options, parse_opt, 0, doc }; - - -/* Read from INPUT the description of a closure, and register it as valid in - STORE. The expected format on INPUT is that used by #:references-graphs: - - FILE - DERIVER - NUMBER-OF-REFERENCES - REF1 - ... - REFN - - This is really meant as an internal format. */ -static void -register_validity (LocalStore *store, std::istream &input, - bool optimize = true, - bool reregister = true, bool hashGiven = false, - bool canonicalise = true) -{ - ValidPathInfos infos; - - while (1) - { - ValidPathInfo info = decodeValidPathInfo (input, hashGiven); - if (info.path == "") - break; - - if (!prefix.empty ()) - { - /* Rewrite the input to refer to the final name, as if we were in a - chroot under PREFIX. */ - std::string final_prefix (NIX_STORE_DIR "/"); - info.path = final_prefix + baseNameOf (info.path); - } - - /* Keep its real path to canonicalize it and compute its hash. */ - std::string real_path; - real_path = prefix + "/" + settings.nixStore + "/" + baseNameOf (info.path); - - if (!store->isValidPath (info.path) || reregister) - { - /* !!! races */ - if (canonicalise) - canonicalisePathMetaData (real_path, -1); - - if (!hashGiven) - { - HashResult hash = hashPath (htSHA256, real_path); - info.hash = hash.first; - info.narSize = hash.second; - } - infos.push_back (info); - } - } - - store->registerValidPaths (infos); - - /* XXX: When PREFIX is non-empty, store->linksDir points to the original - store's '.links' directory, which means 'optimisePath' would try to link - to that instead of linking to the target store. Thus, disable - deduplication in this case. */ - if (optimize) - { - /* Make sure deduplication is enabled. */ - settings.autoOptimiseStore = true; - - std::string store_dir = settings.nixStore; - - /* 'optimisePath' creates temporary links under 'settings.nixStore' and - this must be the real target store, under PREFIX, to avoid - cross-device links. Thus, temporarily switch the value of - 'settings.nixStore'. */ - settings.nixStore = prefix + store_dir; - for (auto&& i: infos) - store->optimisePath (prefix + i.path); - settings.nixStore = store_dir; - } -} - - -int -main (int argc, char *argv[]) -{ - /* Initialize libgcrypt, which is indirectly used. */ - if (!gcry_check_version (GCRYPT_VERSION)) - { - fprintf (stderr, "error: libgcrypt version mismatch\n"); - exit (EXIT_FAILURE); - } - - /* Tell Libgcrypt that initialization has completed, as per the Libgcrypt - 1.6.0 manual (although this does not appear to be strictly needed.) */ - gcry_control (GCRYCTL_INITIALIZATION_FINISHED, 0); - - /* Honor the environment variables, and initialize the settings. */ - settings.processEnvironment (); - - try - { - argp_parse (&argp, argc, argv, 0, 0, 0); - - /* Instantiate the store. This creates any missing directories among - 'settings.nixStore', 'settings.nixDBPath', etc. */ - LocalStore store; - - if (!prefix.empty ()) - /* Under the --prefix tree, the final name of the store will be - NIX_STORE_DIR. Set it here so that the database uses file names - prefixed by NIX_STORE_DIR and not PREFIX + NIX_STORE_DIR. */ - settings.nixStore = NIX_STORE_DIR; - - register_validity (&store, *input, deduplication); - } - catch (std::exception &e) - { - fprintf (stderr, "error: %s\n", e.what ()); - return EXIT_FAILURE; - } - - return EXIT_SUCCESS; -} diff --git a/nix/local.mk b/nix/local.mk index b4c6ba61a..140c78df3 100644 --- a/nix/local.mk +++ b/nix/local.mk @@ -120,7 +120,6 @@ libstore_a_CXXFLAGS = $(AM_CXXFLAGS) \ $(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS) bin_PROGRAMS = guix-daemon -sbin_PROGRAMS = guix-register guix_daemon_SOURCES = \ %D%/nix-daemon/nix-daemon.cc \ @@ -138,24 +137,9 @@ guix_daemon_LDADD = \ guix_daemon_headers = \ %D%/nix-daemon/shared.hh - -guix_register_SOURCES = \ - %D%/guix-register/guix-register.cc - -guix_register_CPPFLAGS = \ - $(libutil_a_CPPFLAGS) \ - $(libstore_a_CPPFLAGS) \ - -I$(top_srcdir)/%D%/libstore - -# XXX: Should we start using shared libs? -guix_register_LDADD = \ - libstore.a libutil.a libformat.a -lz \ - $(SQLITE3_LIBS) $(LIBGCRYPT_LIBS) - if HAVE_LIBBZ2 guix_daemon_LDADD += -lbz2 -guix_register_LDADD += -lbz2 endif HAVE_LIBBZ2 diff --git a/tests/guix-register.sh b/tests/guix-register.sh deleted file mode 100644 index 521735b8a..000000000 --- a/tests/guix-register.sh +++ /dev/null @@ -1,191 +0,0 @@ -# GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo <at> gnu.org> -# -# This file is part of GNU Guix. -# -# GNU Guix is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or (at -# your option) any later version. -# -# GNU Guix is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. - -# -# Test the 'guix-register' command-line utility. -# - -guix-register --version - -new_store="t-register-$$" -closure="t-register-closure-$$" -rm -rf "$new_store" - -exit_hook=":" -trap "chmod -R +w $new_store ; rm -rf $new_store $closure ; \$exit_hook" EXIT - -# -# Registering items in the current store---i.e., without '--prefix'. -# - -new_file="$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-guix-register-$$" -echo "Fake store file to test registration." > "$new_file" - -# Register the file with zero references and no deriver. -guix-register <<EOF -$new_file - -0 -EOF - -# Register an idendical file, and make sure it gets deduplicated. -new_file2="$new_file-duplicate" -cat "$new_file" > "$new_file2" -guix-register <<EOF -$new_file2 - -0 -EOF - -guile -c " - (exit (= (stat:ino (stat \"$new_file\")) - (stat:ino (stat \"$new_file2\"))))" - -# Make sure both are valid. -guile -c " - (use-modules (guix store)) - (define s (open-connection)) - (exit (and (valid-path? s \"$new_file\") - (valid-path? s \"$new_file2\") - (null? (references s \"$new_file\")) - (null? (references s \"$new_file2\"))))" - - -# -# Registering items in a new store, with '--prefix'. -# - -mkdir -p "$new_store/$storedir" -new_store_dir="`cd "$new_store/$storedir" ; pwd -P`" -new_store="`cd "$new_store" ; pwd -P`" - -to_copy="`guix build guile-bootstrap`" -cp -r "$to_copy" "$new_store_dir" -copied="$new_store_dir/`basename $to_copy`" - -# Create a file representing a closure with zero references, and with an empty -# "deriver" field. Note that we give the file name as it appears in the -# original store, and 'guix-register' translates it to match the prefix. -cat >> "$closure" <<EOF -$to_copy - -0 -EOF - -# Register it. -guix-register -p "$new_store" < "$closure" - -# Doing it a second time shouldn't hurt. -guix-register --prefix "$new_store" "$closure" - -# Same, but with the database stored in a different place. -guix-register -p "$new_store" \ - --state-directory "$new_store/chbouib" "$closure" - -# Register duplicate files. -cp "$new_file" "$new_file2" "$new_store_dir" -guix-register -p "$new_store" <<EOF -$new_file - -0 -EOF -guix-register -p "$new_store" <<EOF -$new_file2 - -0 -EOF - -copied_duplicate1="$new_store_dir/`basename $new_file`" -copied_duplicate2="$new_store_dir/`basename $new_file2`" - -# Make sure there is indeed deduplication under $new_store and that there are -# no cross-store hard links. -guile -c " - (exit (and (= (stat:ino (stat \"$copied_duplicate1\")) - (stat:ino (stat \"$copied_duplicate2\"))) - (not (= (stat:ino (stat \"$new_file\")) - (stat:ino (stat \"$copied_duplicate1\"))))))" - -# Delete them. -guix gc -d "$new_file" "$new_file2" - -# Now make sure this is recognized as valid. - -ls -R "$new_store" -for state_dir in "$localstatedir/guix" "/chbouib" -do - NIX_STORE_DIR="$new_store_dir" - NIX_STATE_DIR="$new_store$state_dir" - NIX_LOG_DIR="$new_store$state_dir/log/guix" - NIX_DB_DIR="$new_store$state_dir/db" - GUIX_DAEMON_SOCKET="$NIX_STATE_DIR/daemon-socket/socket" - - export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR \ - NIX_LOG_DIR NIX_DB_DIR GUIX_DAEMON_SOCKET - - # Check whether we overflow the limitation on local socket name lengths. - if [ `echo "$GUIX_DAEMON_SOCKET" | wc -c` -ge 108 ] - then - # Mark the test as skipped even though we already did some work so - # that the remainder is not silently skipped. - exit 77 - fi - - guix-daemon --disable-chroot & - subdaemon_pid=$! - exit_hook="kill $subdaemon_pid" - - final_name="$storedir/`basename $to_copy`" - - # At this point the copy in $new_store must be valid, and unreferenced. - # The database under $NIX_DB_DIR uses the $final_name, but we can't use - # that name in a 'valid-path?' query because 'assertStorePath' would kill - # us because of the wrong prefix. So we just list dead paths instead. - guile -c " - (use-modules (guix store) (srfi srfi-1) (srfi srfi-34)) - - (define s - (let loop ((i 5)) - (guard (c ((nix-connection-error? c) - (if (<= i 0) - (raise c) - (begin - (display \"waiting for daemon socket...\") - (newline) - (sleep 1) - (loop (- i 1)))))) - (open-connection \"$GUIX_DAEMON_SOCKET\")))) - - (exit (lset= string=? - (pk 1 (list \"$copied\" \"$copied_duplicate1\" - \"$copied_duplicate2\")) - (pk 2 (dead-paths s))))" - - # Kill the daemon so we can access the database below (otherwise we may - # get "database is locked" errors.) - kill $subdaemon_pid - exit_hook=":" - while kill -0 $subdaemon_pid ; do sleep 0.5 ; done - - # When 'sqlite3' is available, check the name in the database. - if type -P sqlite3 - then - echo "select * from ValidPaths where path=\"$final_name\";" | \ - sqlite3 "$NIX_DB_DIR/db.sqlite" - fi -done -- 2.17.1
ludo <at> gnu.org (Ludovic Courtès)
:Ludovic Courtès <ludo <at> gnu.org>
:Message #67 received at 31755-done <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: 31755-done <at> debbugs.gnu.org Subject: Re: [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register' Date: Thu, 14 Jun 2018 11:17:41 +0200
Ludovic Courtès <ludo <at> gnu.org> skribis: > This not-so-interesting patch series refactors a whole bunch of things so > that, in the end, we can use the “new” (guix store database) instead of the > C++ ‘guix-register’. It turned out to be more involved that I thought. :-) > > A practical consequence of this is that guile-sqlite3 becomes a requirement. > It would be nice if someone (maybe Danny?) could take care of tagging > guile-sqlite3 and making releases as needed. Merged! Ludo’.
guix-patches <at> gnu.org
:bug#31755
; Package guix-patches
.
(Thu, 14 Jun 2018 09:31:01 GMT) Full text and rfc822 format available.Message #70 received at 31755 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: 31755 <at> debbugs.gnu.org Subject: Re: bug#31755: closed (Re: [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register') Date: Thu, 14 Jun 2018 11:30:05 +0200
> Ludovic Courtès <ludo <at> gnu.org> skribis: > >> This not-so-interesting patch series refactors a whole bunch of things so >> that, in the end, we can use the “new” (guix store database) instead of the >> C++ ‘guix-register’. It turned out to be more involved that I thought. :-) >> >> A practical consequence of this is that guile-sqlite3 becomes a requirement. >> It would be nice if someone (maybe Danny?) could take care of tagging >> guile-sqlite3 and making releases as needed. > > Merged! BTW, code that is the most affected by this change is everything that creates a store database, in particular: • guix pack --localstatedir • guix system disk-image • guix system disk-image --file-system-type=iso9660 • guix system docker-image • guix system init I checked these manually but you’re very welcome to give it a spin and report any issues! Ludo’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org
.
(Thu, 12 Jul 2018 11:24:05 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.