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.
This commit is contained in:
parent
63193ebfdc
commit
0f3d2504f7
|
@ -54,6 +54,16 @@
|
||||||
add-temp-root
|
add-temp-root
|
||||||
add-indirect-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
|
live-paths
|
||||||
dead-paths
|
dead-paths
|
||||||
collect-garbage
|
collect-garbage
|
||||||
|
@ -268,6 +278,30 @@
|
||||||
(error "ENOSYS")))
|
(error "ENOSYS")))
|
||||||
(write-string ")" p))))
|
(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
|
(define-syntax write-arg
|
||||||
(syntax-rules (integer boolean file string string-list
|
(syntax-rules (integer boolean file string string-list
|
||||||
store-path store-path-list base16)
|
store-path store-path-list base16)
|
||||||
|
@ -289,7 +323,8 @@
|
||||||
(write-string (bytevector->base16-string arg) p))))
|
(write-string (bytevector->base16-string arg) p))))
|
||||||
|
|
||||||
(define-syntax read-arg
|
(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)
|
((_ integer p)
|
||||||
(read-int p))
|
(read-int p))
|
||||||
((_ boolean p)
|
((_ boolean p)
|
||||||
|
@ -300,7 +335,9 @@
|
||||||
(read-store-path p))
|
(read-store-path p))
|
||||||
((_ store-path-list p)
|
((_ store-path-list p)
|
||||||
(read-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)))))
|
(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."
|
file name. Return #t on success."
|
||||||
boolean)
|
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)
|
(define (run-gc server action to-delete min-freed)
|
||||||
"Perform the garbage-collector operation ACTION, one of the
|
"Perform the garbage-collector operation ACTION, one of the
|
||||||
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
|
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -21,6 +21,8 @@
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix derivations)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -77,6 +79,17 @@
|
||||||
(> freed 0)
|
(> freed 0)
|
||||||
(not (file-exists? p))))))
|
(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")
|
(test-end "store")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue