aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-02-03 23:24:25 +0100
committerLudovic Courtès <ludo@gnu.org>2013-02-04 08:58:48 +0100
commit0f3d2504f75595a2db2a2344b624ced2ba307448 (patch)
treee2fabb0313fa177717090e5b44818af2817e2d57
parent63193ebfdc72eb11cfb1c50b8cd5dfc49d01361d (diff)
downloadpatches-0f3d2504f75595a2db2a2344b624ced2ba307448.tar
patches-0f3d2504f75595a2db2a2344b624ced2ba307448.tar.gz
store: Add substitute-related procedures.
* guix/store.scm (has-substitutes?, substitutable-paths, read-substitutable-path-list, substitutable-path-info): New procedures. (<substitutable>): New record type. (read-arg): Add `substitutable-path-info'. Change `hash' pattern variable to `base16' literal. * tests/store.scm ("no substitutes"): New test.
-rw-r--r--guix/store.scm57
-rw-r--r--tests/store.scm15
2 files changed, 69 insertions, 3 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 0a6285deac..6a3f036a8c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -54,6 +54,16 @@
add-temp-root
add-indirect-root
+ substitutable?
+ substitutable-path
+ substitutable-deriver
+ substitutable-references
+ substitutable-download-size
+ substitutable-nar-size
+ has-substitutes?
+ substitutable-paths
+ substitutable-path-info
+
live-paths
dead-paths
collect-garbage
@@ -268,6 +278,30 @@
(error "ENOSYS")))
(write-string ")" p))))
+;; Information about a substitutable store path.
+(define-record-type <substitutable>
+ (substitutable path deriver refs dl-size nar-size)
+ substitutable?
+ (path substitutable-path)
+ (deriver substitutable-deriver)
+ (refs substitutable-references)
+ (dl-size substitutable-download-size)
+ (nar-size substitutable-nar-size))
+
+(define (read-substitutable-path-list p)
+ (let loop ((len (read-int p))
+ (result '()))
+ (if (zero? len)
+ (reverse result)
+ (let ((path (read-store-path p))
+ (deriver (read-store-path p))
+ (refs (read-store-path-list p))
+ (dl-size (read-long-long p))
+ (nar-size (read-long-long p)))
+ (loop (- len 1)
+ (cons (substitutable path deriver refs dl-size nar-size)
+ result))))))
+
(define-syntax write-arg
(syntax-rules (integer boolean file string string-list
store-path store-path-list base16)
@@ -289,7 +323,8 @@
(write-string (bytevector->base16-string arg) p))))
(define-syntax read-arg
- (syntax-rules (integer boolean string store-path store-path-list base16)
+ (syntax-rules (integer boolean string store-path store-path-list
+ substitutable-path-list base16)
((_ integer p)
(read-int p))
((_ boolean p)
@@ -300,7 +335,9 @@
(read-store-path p))
((_ store-path-list p)
(read-store-path-list p))
- ((_ hash p)
+ ((_ substitutable-path-list p)
+ (read-substitutable-path-list p))
+ ((_ base16 p)
(base16-string->bytevector (read-string p)))))
@@ -552,6 +589,22 @@ name--it is the caller's responsibility to ensure that it is an absolute
file name. Return #t on success."
boolean)
+(define-operation (has-substitutes? (store-path path))
+ "Return #t if binary substitutes are available for PATH, and #f otherwise."
+ boolean)
+
+(define substitutable-paths
+ (operation (query-substitutable-paths (store-path-list paths))
+ "Return the subset of PATHS that is substitutable."
+ store-path-list))
+
+(define substitutable-path-info
+ (operation (query-substitutable-paths (store-path-list paths))
+ "Return information about the subset of PATHS that is
+substitutable. For each substitutable path, a `substitutable?' object is
+returned."
+ substitutable-path-list))
+
(define (run-gc server action to-delete min-freed)
"Perform the garbage-collector operation ACTION, one of the
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
diff --git a/tests/store.scm b/tests/store.scm
index 1ff6aa05c2..c90fd3fed9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +21,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix base32)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -77,6 +79,17 @@
(> freed 0)
(not (file-exists? p))))))
+(test-assert "no substitutes"
+ (let* ((s (open-connection))
+ (d1 (package-derivation s %bootstrap-guile (%current-system)))
+ (d2 (package-derivation s %bootstrap-glibc (%current-system)))
+ (o (map derivation-path->output-path (list d1 d2))))
+ (set-build-options s #:use-substitutes? #f)
+ (and (not (has-substitutes? s d1))
+ (not (has-substitutes? s d2))
+ (null? (substitutable-paths s o))
+ (null? (substitutable-path-info s o)))))
+
(test-end "store")