ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Add substitute-related procedures.

Browse source 
* 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:
Ludovic Courtès 2013-02-03 23:24:25 +01:00
parent 63193ebfdc
commit 0f3d2504f7
2 changed files with 69 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
guix/store.scm
View file

@ -54,6 +54,16 @@ (define-module (guix store)
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 @@ (define %archive-version-1 "nix-archive-1")
(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 @@ (define-syntax write-arg
(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 @@ (define-syntax read-arg
(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 @@ (define-operation (add-indirect-root (string file-name))
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

15
tests/store.scm
View file

@ -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 @@ (define-module (test-store)
#: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 @@ (define (random-text)
(> 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")