me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2012-06-09 18:49:19 +02:00
parent 6d800a80ea
commit 749c656755
2 changed files with 25 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
guix/derivations.scm
View File

@ -74,7 +74,7 @@
derivation-output? derivation-output?
(path derivation-output-path) ; store path (path derivation-output-path) ; store path
(hash-algo derivation-output-hash-algo) ; symbol | #f (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> (define-record-type <derivation-input>
(make-derivation-input path sub-derivations) (make-derivation-input path sub-derivations)
@ -112,7 +112,8 @@ download with a fixed hash (aka. `fetchurl')."
result)) result))
((name path hash-algo hash) ((name path hash-algo hash)
;; fixed-output ;; fixed-output
(let ((algo (string->symbol hash-algo))) (let ((algo (string->symbol hash-algo))
(hash (base16-string->bytevector hash)))
(alist-cons name (alist-cons name
(make-derivation-output path algo hash) (make-derivation-output path algo hash)
result))))) result)))))
@ -170,8 +171,10 @@ that form."
(write-list (map (match-lambda (write-list (map (match-lambda
((name . ($ <derivation-output> path hash-algo hash)) ((name . ($ <derivation-output> path hash-algo hash))
(format #f "(~s,~s,~s,~s)" (format #f "(~s,~s,~s,~s)"
name path (or hash-algo "") name path
(or hash "")))) (or (and=> hash-algo symbol->string) "")
(or (and=> hash bytevector->base16-string)
""))))
outputs)) outputs))
(display "," port) (display "," port)
(write-list (map (match-lambda (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." "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
(match drv (match drv
(($ <derivation> ((_ . ($ <derivation-output> path (($ <derivation> ((_ . ($ <derivation-output> path
(? symbol? hash-algo) (? string? hash))))) (? symbol? hash-algo) (? bytevector? hash)))))
;; A fixed-output derivation. ;; A fixed-output derivation.
(sha256 (sha256
(string->utf8 (string->utf8
(string-append "fixed:out:" (symbol->string hash-algo) (string-append "fixed:out:" (symbol->string hash-algo)
":" hash ":" path)))) ":" (bytevector->base16-string hash)
":" path))))
(($ <derivation> outputs inputs sources (($ <derivation> outputs inputs sources
system builder args env-vars) system builder args env-vars)
;; A regular derivation: replace the path of each input with that ;; A regular derivation: replace the path of each input with that

15
tests/derivations.scm
View File

@ -25,6 +25,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 rdelim)) #:use-module (ice-9 rdelim))
(define %store (define %store
@ -68,6 +69,20 @@
(string=? (call-with-input-file path read-line) (string=? (call-with-input-file path read-line)
"hello, world"))))) "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 (define %coreutils
(false-if-exception (nixpkgs-derivation "coreutils"))) (false-if-exception (nixpkgs-derivation "coreutils")))