From 6892f0a247a06ac12c8c462692f8b3f93e872911 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Jun 2018 22:06:34 +0200 Subject: store-copy: 'read-reference-graph' returns a list of records. 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 (): New record type. (read-reference-graph): Rewrite to return a list of . (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. --- guix/build/store-copy.scm | 120 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 104 insertions(+), 16 deletions(-) (limited to 'guix/build') diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index fe2eb6f69a..bad1c09cba 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 +;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès ;;; ;;; 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 @@ (define-module (guix build store-copy) ;;; ;;; Code: +;; Information about a store item as produced by #:references-graphs. +(define-record-type + (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 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 @@ (define (closure-size reference-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 @@ (define store (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))) -- cgit v1.2.3 From 31a63be8784b2769c2db21388f788a8b975fd4e1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Jun 2018 22:23:57 +0200 Subject: database: Add 'register-items'. * 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(-) (limited to 'guix/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 6cc678b44b..82eb63d726 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -169,16 +169,11 @@ (define* (register-closure prefix closure 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 bad1c09cba..2d9590d16f 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -27,6 +27,7 @@ (define-module (guix build store-copy) #: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 1e5e3bcc71..3dbe5270a3 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -26,6 +26,7 @@ (define-module (guix store database) #: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 @@ (define-module (guix store database) with-database sqlite-register register-path + register-items reset-timestamps)) ;;; Code for working with the store database directly. @@ -216,11 +218,6 @@ (define* (register-path path 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 @@ (define* (register-path path 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))) - (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))) + (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 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-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)))) -- cgit v1.2.3