[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/06: store: Add store path computation procedures.
From: |
Ludovic Courtès |
Subject: |
05/06: store: Add store path computation procedures. |
Date: |
Thu, 4 May 2017 12:05:12 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit cd041b268e9af4918a696f9f6f2b04e51a2d0599
Author: Ludovic Courtès <address@hidden>
Date: Thu May 4 16:40:00 2017 +0200
store: Add store path computation procedures.
* guix/derivations.scm (compressed-hash, store-path)
(output-path, fixed-output-path): Move to...
* guix/store.scm: ... here.
---
guix/derivations.scm | 52 -----------------------------------------------
guix/store.scm | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 56 insertions(+), 53 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index d5e0f45..9aaab05 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 8e7f096..ee47703 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
- branch master updated (3e961de -> 396d12f), Ludovic Courtès, 2017/05/04
- 03/06: gnu: Add address@hidden, Ludovic Courtès, 2017/05/04
- 04/06: gnu: fish-guix: Adjust the home-page., Ludovic Courtès, 2017/05/04
- 06/06: store: Use 'write-bytevector' instead of hand-coded equivalent., Ludovic Courtès, 2017/05/04
- 02/06: tests: Use 'fold-module-public-variables' for discovery., Ludovic Courtès, 2017/05/04
- 05/06: store: Add store path computation procedures.,
Ludovic Courtès <=
- 01/06: nls: Mark (guix discovery) as translatable., Ludovic Courtès, 2017/05/04