Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

190 lines
7.0 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix build store-copy)
  19. #:use-module (guix build utils)
  20. #:use-module (guix sets)
  21. #:use-module (srfi srfi-1)
  22. #:use-module (srfi srfi-9)
  23. #:use-module (srfi srfi-26)
  24. #:use-module (ice-9 match)
  25. #:use-module (ice-9 rdelim)
  26. #:use-module (ice-9 ftw)
  27. #:use-module (ice-9 vlist)
  28. #:export (store-info?
  29. store-info-item
  30. store-info-deriver
  31. store-info-references
  32. read-reference-graph
  33. closure-size
  34. populate-store))
  35. ;;; Commentary:
  36. ;;;
  37. ;;; This module provides the tools to copy store items and their dependencies
  38. ;;; to another store. It relies on the availability of "reference graph"
  39. ;;; files as produced by 'gexp->derivation' et al. with the
  40. ;;; #:references-graphs parameter.
  41. ;;;
  42. ;;; Code:
  43. ;; Information about a store item as produced by #:references-graphs.
  44. (define-record-type <store-info>
  45. (store-info item deriver references)
  46. store-info?
  47. (item store-info-item) ;string
  48. (deriver store-info-deriver) ;#f | string
  49. (references store-info-references)) ;?
  50. ;; TODO: Factorize with that in (guix store).
  51. (define (topological-sort nodes edges)
  52. "Return NODES in topological order according to EDGES. EDGES must be a
  53. one-argument procedure that takes a node and returns the nodes it is connected
  54. to."
  55. (define (traverse)
  56. ;; Do a simple depth-first traversal of all of PATHS.
  57. (let loop ((nodes nodes)
  58. (visited (setq))
  59. (result '()))
  60. (match nodes
  61. ((head tail ...)
  62. (if (set-contains? visited head)
  63. (loop tail visited result)
  64. (call-with-values
  65. (lambda ()
  66. (loop (edges head)
  67. (set-insert head visited)
  68. result))
  69. (lambda (visited result)
  70. (loop tail visited (cons head result))))))
  71. (()
  72. (values visited result)))))
  73. (call-with-values traverse
  74. (lambda (_ result)
  75. (reverse result))))
  76. (define (read-reference-graph port)
  77. "Read the reference graph as produced by #:references-graphs from PORT and
  78. return it as a list of <store-info> records in topological order--i.e., leaves
  79. come first. IOW, store items in the resulting list can be registered in the
  80. order in which they appear.
  81. The reference graph format consists of sequences of lines like this:
  82. FILE
  83. DERIVER
  84. NUMBER-OF-REFERENCES
  85. REF1
  86. ...
  87. REFN
  88. It is meant as an internal format."
  89. (let loop ((result '())
  90. (table vlist-null)
  91. (referrers vlist-null))
  92. (match (read-line port)
  93. ((? eof-object?)
  94. ;; 'guix-daemon' gives us something that's in "reverse topological
  95. ;; order"--i.e., leaves (items with zero references) come last. Here
  96. ;; we compute the topological order that we want: leaves come first.
  97. (let ((unreferenced? (lambda (item)
  98. (let ((referrers (vhash-fold* cons '()
  99. (store-info-item item)
  100. referrers)))
  101. (or (null? referrers)
  102. (equal? (list item) referrers))))))
  103. (topological-sort (filter unreferenced? result)
  104. (lambda (item)
  105. (map (lambda (item)
  106. (match (vhash-assoc item table)
  107. ((_ . node) node)))
  108. (store-info-references item))))))
  109. (item
  110. (let* ((deriver (match (read-line port)
  111. ("" #f)
  112. (line line)))
  113. (count (string->number (read-line port)))
  114. (refs (unfold-right (cut >= <> count)
  115. (lambda (n)
  116. (read-line port))
  117. 1+
  118. 0))
  119. (item (store-info item deriver refs)))
  120. (loop (cons item result)
  121. (vhash-cons (store-info-item item) item table)
  122. (fold (cut vhash-cons <> item <>)
  123. referrers
  124. refs)))))))
  125. (define (file-size file)
  126. "Return the size of bytes of FILE, entering it if FILE is a directory."
  127. (file-system-fold (const #t)
  128. (lambda (file stat result) ;leaf
  129. (+ (stat:size stat) result))
  130. (lambda (directory stat result) ;down
  131. (+ (stat:size stat) result))
  132. (lambda (directory stat result) ;up
  133. result)
  134. (lambda (file stat result) ;skip
  135. result)
  136. (lambda (file stat errno result)
  137. (format (current-error-port)
  138. "file-size: ~a: ~a~%" file
  139. (strerror errno))
  140. result)
  141. 0
  142. file
  143. lstat))
  144. (define (closure-size reference-graphs)
  145. "Return an estimate of the size of the closure described by
  146. REFERENCE-GRAPHS, a list of reference-graph files."
  147. (define (graph-from-file file)
  148. (map store-info-item
  149. (call-with-input-file file read-reference-graph)))
  150. (define items
  151. (delete-duplicates (append-map graph-from-file reference-graphs)))
  152. (reduce + 0 (map file-size items)))
  153. (define* (populate-store reference-graphs target)
  154. "Populate the store under directory TARGET with the items specified in
  155. REFERENCE-GRAPHS, a list of reference-graph files."
  156. (define store
  157. (string-append target (%store-directory)))
  158. (define (things-to-copy)
  159. ;; Return the list of store files to copy to the image.
  160. (define (graph-from-file file)
  161. (map store-info-item
  162. (call-with-input-file file read-reference-graph)))
  163. (delete-duplicates (append-map graph-from-file reference-graphs)))
  164. (mkdir-p store)
  165. (chmod store #o1775)
  166. (for-each (lambda (thing)
  167. (copy-recursively thing
  168. (string-append target thing)))
  169. (things-to-copy)))
  170. ;;; store-copy.scm ends here