~ruther/guix-local

749c6567554c1da258992173f66fb41d8511f4e3 — Ludovic Courtès 13 years ago 6d800a8
Add support for fixed-output derivations.

* guix/derivations.scm (read-derivation)[outputs->alist]: For
  fixed-outputs, convert HASH with `base16-string->bytevector'.
  (write-derivation): Likewise, convert HASH-ALGO to a string and HASH
  to a base16 string.
  (derivation-hash): Expect HASH to be a bytevector, not a string;
  convert HASH with `bytevector->base16-string'.

* tests/derivations.scm ("fixed-output derivation"): New test.
2 files changed, 25 insertions(+), 6 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +10 -6
@@ 74,7 74,7 @@
  derivation-output?
  (path       derivation-output-path)             ; store path
  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
  (hash       derivation-output-hash))            ; symbol | #f
  (hash       derivation-output-hash))            ; bytevector | #f

(define-record-type <derivation-input>
  (make-derivation-input path sub-derivations)


@@ 112,7 112,8 @@ download with a fixed hash (aka. `fetchurl')."
                                 result))
                    ((name path hash-algo hash)
                     ;; fixed-output
                     (let ((algo (string->symbol hash-algo)))
                     (let ((algo (string->symbol hash-algo))
                           (hash (base16-string->bytevector hash)))
                       (alist-cons name
                                   (make-derivation-output path algo hash)
                                   result)))))


@@ 170,8 171,10 @@ that form."
     (write-list (map (match-lambda
                       ((name . ($ <derivation-output> path hash-algo hash))
                        (format #f "(~s,~s,~s,~s)"
                                name path (or hash-algo "")
                                (or hash ""))))
                                name path
                                (or (and=> hash-algo symbol->string) "")
                                (or (and=> hash bytevector->base16-string)
                                    ""))))
                      outputs))
     (display "," port)
     (write-list (map (match-lambda


@@ 222,12 225,13 @@ in SIZE bytes."
    "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
    (match drv
      (($ <derivation> ((_ . ($ <derivation-output> path
                                (? symbol? hash-algo) (? string? hash)))))
                                (? symbol? hash-algo) (? bytevector? hash)))))
       ;; A fixed-output derivation.
       (sha256
        (string->utf8
         (string-append "fixed:out:" (symbol->string hash-algo)
                        ":" hash ":" path))))
                        ":" (bytevector->base16-string hash)
                        ":" path))))
      (($ <derivation> outputs inputs sources
          system builder args env-vars)
       ;; A regular derivation: replace the path of each input with that

M tests/derivations.scm => tests/derivations.scm +15 -0
@@ 25,6 25,7 @@
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 rdelim))

(define %store


@@ 68,6 69,20 @@
           (string=? (call-with-input-file path read-line)
                     "hello, world")))))

(test-assert "fixed-output derivation"
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                        "echo -n hello > $out" '()))
         (hash       (sha256 (string->utf8 "hello")))
         (drv-path   (derivation %store "fixed" "x86_64-linux"
                                 "/bin/sh" `(,builder)
                                 '() `((,builder))
                                 #:hash hash #:hash-algo 'sha256))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((p (derivation-path->output-path drv-path)))
           (equal? (string->utf8 "hello")
                   (call-with-input-file p get-bytevector-all))))))


(define %coreutils
  (false-if-exception (nixpkgs-derivation "coreutils")))