~ruther/guix-local

0f3d2504f75595a2db2a2344b624ced2ba307448 — Ludovic Courtès 13 years ago 63193eb
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.
2 files changed, 69 insertions(+), 3 deletions(-)

M guix/store.scm
M tests/store.scm
M guix/store.scm => guix/store.scm +55 -2
@@ 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

M tests/store.scm => tests/store.scm +14 -1
@@ 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")