diff options
| -rw-r--r-- | guix/store.scm | 57 | ||||
| -rw-r--r-- | tests/store.scm | 15 |
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") |