store: Add store path computation procedures.
* guix/derivations.scm (compressed-hash, store-path) (output-path, fixed-output-path): Move to... * guix/store.scm: ... here.master
parent
4032dd81d5
commit
cd041b268e
|
@ -76,7 +76,6 @@
|
||||||
derivation-name
|
derivation-name
|
||||||
derivation-output-names
|
derivation-output-names
|
||||||
fixed-output-derivation?
|
fixed-output-derivation?
|
||||||
fixed-output-path
|
|
||||||
offloadable-derivation?
|
offloadable-derivation?
|
||||||
substitutable-derivation?
|
substitutable-derivation?
|
||||||
substitution-oracle
|
substitution-oracle
|
||||||
|
@ -614,20 +613,6 @@ list of name/path pairs of its outputs."
|
||||||
;;; Derivation primitive.
|
;;; 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
|
(define derivation-path->base16-hash
|
||||||
(mlambda (file)
|
(mlambda (file)
|
||||||
"Return a string containing the base16 representation of the hash of the
|
"Return a string containing the base16 representation of the hash of the
|
||||||
|
@ -674,43 +659,6 @@ derivation at FILE."
|
||||||
;; character.
|
;; character.
|
||||||
(sha256 (derivation->bytevector drv)))))))
|
(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
|
(define* (derivation store name builder args
|
||||||
#:key
|
#:key
|
||||||
(system (%current-system)) (env-vars '())
|
(system (%current-system)) (env-vars '())
|
||||||
|
|
|
@ -23,7 +23,8 @@
|
||||||
#:use-module (guix serialization)
|
#:use-module (guix serialization)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
#:use-module (guix base16)
|
#:use-module (guix base16)
|
||||||
#:autoload (guix base32) (bytevector->base32-string)
|
#:use-module (guix base32)
|
||||||
|
#:use-module (guix hash)
|
||||||
#:autoload (guix build syscalls) (terminal-columns)
|
#:autoload (guix build syscalls) (terminal-columns)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
|
@ -133,6 +134,9 @@
|
||||||
interned-file
|
interned-file
|
||||||
|
|
||||||
%store-prefix
|
%store-prefix
|
||||||
|
store-path
|
||||||
|
output-path
|
||||||
|
fixed-output-path
|
||||||
store-path?
|
store-path?
|
||||||
direct-store-path?
|
direct-store-path?
|
||||||
derivation-path?
|
derivation-path?
|
||||||
|
@ -1347,6 +1351,57 @@ connection, and return the result."
|
||||||
;; Absolute path to the Nix store.
|
;; Absolute path to the Nix store.
|
||||||
(make-parameter %store-directory))
|
(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)
|
(define (store-path? path)
|
||||||
"Return #t if PATH is a store path."
|
"Return #t if PATH is a store path."
|
||||||
;; This is a lightweight check, compared to using a regexp, but this has to
|
;; This is a lightweight check, compared to using a regexp, but this has to
|
||||||
|
|
Reference in New Issue