diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-05-04 16:40:00 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-05-04 18:05:05 +0200 |
commit | cd041b268e9af4918a696f9f6f2b04e51a2d0599 (patch) | |
tree | 103f9120c9a15db1048a7583f4503b1f4b847a42 | |
parent | 4032dd81d520666375e72914b5946620cac009a7 (diff) | |
download | guix-cd041b268e9af4918a696f9f6f2b04e51a2d0599.tar guix-cd041b268e9af4918a696f9f6f2b04e51a2d0599.tar.gz |
store: Add store path computation procedures.
* guix/derivations.scm (compressed-hash, store-path)
(output-path, fixed-output-path): Move to...
* guix/store.scm: ... here.
-rw-r--r-- | guix/derivations.scm | 52 | ||||
-rw-r--r-- | guix/store.scm | 57 |
2 files changed, 56 insertions, 53 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index d5e0f453e2..9aaab05ecb 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -76,7 +76,6 @@ derivation-name derivation-output-names fixed-output-derivation? - fixed-output-path offloadable-derivation? substitutable-derivation? substitution-oracle @@ -614,20 +613,6 @@ list of name/path pairs of its outputs." ;;; Derivation primitive. ;;; -(define (compressed-hash bv size) ; `compressHash' - "Given the hash stored in BV, return a compressed version thereof that fits -in SIZE bytes." - (define new (make-bytevector size 0)) - (define old-size (bytevector-length bv)) - (let loop ((i 0)) - (if (= i old-size) - new - (let* ((j (modulo i size)) - (o (bytevector-u8-ref new j))) - (bytevector-u8-set! new j - (logxor o (bytevector-u8-ref bv i))) - (loop (+ 1 i)))))) - (define derivation-path->base16-hash (mlambda (file) "Return a string containing the base16 representation of the hash of the @@ -674,43 +659,6 @@ derivation at FILE." ;; character. (sha256 (derivation->bytevector drv))))))) -(define (store-path type hash name) ; makeStorePath - "Return the store path for NAME/HASH/TYPE." - (let* ((s (string-append type ":sha256:" - (bytevector->base16-string hash) ":" - (%store-prefix) ":" name)) - (h (sha256 (string->utf8 s))) - (c (compressed-hash h 20))) - (string-append (%store-prefix) "/" - (bytevector->nix-base32-string c) "-" - name))) - -(define (output-path output hash name) ; makeOutputPath - "Return an output path for OUTPUT (the name of the output as a string) of -the derivation called NAME with hash HASH." - (store-path (string-append "output:" output) hash - (if (string=? output "out") - name - (string-append name "-" output)))) - -(define* (fixed-output-path name hash - #:key - (output "out") - (hash-algo 'sha256) - (recursive? #t)) - "Return an output path for the fixed output OUTPUT defined by HASH of type -HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for -'add-to-store'." - (if (and recursive? (eq? hash-algo 'sha256)) - (store-path "source" hash name) - (let ((tag (string-append "fixed:" output ":" - (if recursive? "r:" "") - (symbol->string hash-algo) ":" - (bytevector->base16-string hash) ":"))) - (store-path (string-append "output:" output) - (sha256 (string->utf8 tag)) - name)))) - (define* (derivation store name builder args #:key (system (%current-system)) (env-vars '()) diff --git a/guix/store.scm b/guix/store.scm index 8e7f09678e..ee47703a55 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -23,7 +23,8 @@ #:use-module (guix serialization) #:use-module (guix monads) #:use-module (guix base16) - #:autoload (guix base32) (bytevector->base32-string) + #:use-module (guix base32) + #:use-module (guix hash) #:autoload (guix build syscalls) (terminal-columns) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) @@ -133,6 +134,9 @@ interned-file %store-prefix + store-path + output-path + fixed-output-path store-path? direct-store-path? derivation-path? @@ -1347,6 +1351,57 @@ connection, and return the result." ;; Absolute path to the Nix store. (make-parameter %store-directory)) +(define (compressed-hash bv size) ; `compressHash' + "Given the hash stored in BV, return a compressed version thereof that fits +in SIZE bytes." + (define new (make-bytevector size 0)) + (define old-size (bytevector-length bv)) + (let loop ((i 0)) + (if (= i old-size) + new + (let* ((j (modulo i size)) + (o (bytevector-u8-ref new j))) + (bytevector-u8-set! new j + (logxor o (bytevector-u8-ref bv i))) + (loop (+ 1 i)))))) + +(define (store-path type hash name) ; makeStorePath + "Return the store path for NAME/HASH/TYPE." + (let* ((s (string-append type ":sha256:" + (bytevector->base16-string hash) ":" + (%store-prefix) ":" name)) + (h (sha256 (string->utf8 s))) + (c (compressed-hash h 20))) + (string-append (%store-prefix) "/" + (bytevector->nix-base32-string c) "-" + name))) + +(define (output-path output hash name) ; makeOutputPath + "Return an output path for OUTPUT (the name of the output as a string) of +the derivation called NAME with hash HASH." + (store-path (string-append "output:" output) hash + (if (string=? output "out") + name + (string-append name "-" output)))) + +(define* (fixed-output-path name hash + #:key + (output "out") + (hash-algo 'sha256) + (recursive? #t)) + "Return an output path for the fixed output OUTPUT defined by HASH of type +HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for +'add-to-store'." + (if (and recursive? (eq? hash-algo 'sha256)) + (store-path "source" hash name) + (let ((tag (string-append "fixed:" output ":" + (if recursive? "r:" "") + (symbol->string hash-algo) ":" + (bytevector->base16-string hash) ":"))) + (store-path (string-append "output:" output) + (sha256 (string->utf8 tag)) + name)))) + (define (store-path? path) "Return #t if PATH is a store path." ;; This is a lightweight check, compared to using a regexp, but this has to |