From 749c6567554c1da258992173f66fb41d8511f4e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 9 Jun 2012 18:49:19 +0200 Subject: [PATCH] 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. --- guix/derivations.scm | 16 ++++++++++------ tests/derivations.scm | 15 +++++++++++++++ 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 7bc14586ba..b7733e9a1a 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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 (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 . ($ 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 (($ ((_ . ($ 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)))) (($ outputs inputs sources system builder args env-vars) ;; A regular derivation: replace the path of each input with that diff --git a/tests/derivations.scm b/tests/derivations.scm index ff766cf175..06001078c5 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -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")))