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.

1 files changed, 104 insertions, 16 deletions

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