Browse Source

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 (<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.
gn-latest-20200428
Ludovic Courtès 2 years ago
parent
commit
6892f0a247
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
5 changed files with 128 additions and 30 deletions
  1. +3
    -2
      gnu/services/base.scm
  2. +4
    -2
      gnu/system/vm.scm
  3. +104
    -16
      guix/build/store-copy.scm
  4. +6
    -4
      guix/scripts/pack.scm
  5. +11
    -6
      tests/gexp.scm

+ 3
- 2
gnu/services/base.scm View File

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


+ 4
- 2
gnu/system/vm.scm View File

@@ -466,8 +466,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)


+ 104
- 16
guix/build/store-copy.scm View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo@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)))



+ 6
- 4
guix/scripts/pack.scm View File

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


+ 11
- 6
tests/gexp.scm View File

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


Loading…
Cancel
Save