~ruther/guix-local

cd041b268e9af4918a696f9f6f2b04e51a2d0599 — Ludovic Courtès 8 years ago 4032dd8
store: Add store path computation procedures.

* guix/derivations.scm (compressed-hash, store-path)
(output-path, fixed-output-path): Move to...
* guix/store.scm: ... here.
2 files changed, 56 insertions(+), 53 deletions(-)

M guix/derivations.scm
M guix/store.scm
M guix/derivations.scm => guix/derivations.scm +0 -52
@@ 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 '())

M guix/store.scm => guix/store.scm +56 -1
@@ 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