summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm52
-rw-r--r--tests/derivations.scm22
2 files changed, 70 insertions, 4 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index b5e3db2d21..c35595fd1e 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -52,7 +52,8 @@
derivation
%guile-for-build
- build-expression->derivation))
+ build-expression->derivation
+ imported-files))
;;;
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
@@ -372,6 +373,51 @@ known in advance, such as a file download."
;; when using `build-expression->derivation'.
(make-parameter (false-if-exception (nixpkgs-derivation "guile"))))
+(define* (imported-files store files
+ #:key (name "file-import") (system (%current-system)))
+ "Return a derivation that imports FILES into STORE. FILES must be a list
+of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
+system, imported, and appears under FINAL-PATH in the resulting store path."
+ (define (parent-dirs file-name)
+ ;; Return the list of parent dirs of FILE-NAME, in the order in which an
+ ;; `mkdir -p' implementation would make them.
+ (let ((not-slash (char-set-complement (char-set #\/))))
+ (reverse
+ (fold (lambda (dir result)
+ (match result
+ (()
+ (list dir))
+ ((prev _ ...)
+ (cons (string-append prev "/" dir)
+ result))))
+ '()
+ (remove (cut string=? <> ".")
+ (string-tokenize (dirname file-name) not-slash))))))
+
+ (let* ((files (map (match-lambda
+ ((final-path . file-name)
+ (cons final-path
+ (add-to-store store (basename final-path) #t #f
+ "sha256" file-name))))
+ files))
+ (builder
+ `(begin
+ (mkdir %output) (chdir %output)
+ ,@(append-map (match-lambda
+ ((final-path . store-path)
+ (append (match (parent-dirs final-path)
+ (() '())
+ ((head ... tail)
+ (append (map (lambda (d)
+ `(false-if-exception
+ (mkdir ,d)))
+ head)
+ `((mkdir ,tail)))))
+ `((symlink ,store-path ,final-path)))))
+ files))))
+ (build-expression->derivation store name (%current-system)
+ builder files)))
+
(define* (build-expression->derivation store name system exp inputs
#:key (outputs '("out"))
hash hash-algo)
@@ -395,7 +441,9 @@ INPUTS."
',(map (match-lambda
((name . drv)
(cons name
- (derivation-path->output-path drv))))
+ (if (derivation-path? drv)
+ (derivation-path->output-path drv)
+ drv))))
inputs))) )
(builder (add-text-to-store store
(string-append name "-guile-builder")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index ec48f44420..1a85639930 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -24,11 +24,13 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 rdelim)
- #:use-module (ice-9 ftw))
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 match))
(define %store
(false-if-exception (open-connection)))
@@ -156,7 +158,7 @@
(let ((p (derivation-path->output-path drv-path)))
(file-exists? (string-append p "/good"))))))
-(test-skip (if (%guile-for-build) 0 2))
+(test-skip (if (%guile-for-build) 0 4))
(test-assert "build-expression->derivation without inputs"
(let* ((builder '(begin
@@ -208,6 +210,22 @@
(let ((p (derivation-path->output-path drv-path)))
(string-contains (call-with-input-file p read-line) "GNU")))))
+(test-assert "imported-files"
+ (let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
+ ("a/b/c" . ,(search-path %load-path
+ "guix/derivations.scm"))
+ ("p/q" . ,(search-path %load-path "guix.scm"))))
+ (drv-path (imported-files %store files)))
+ (and (build-derivations %store (list drv-path))
+ (let ((dir (derivation-path->output-path drv-path)))
+ (every (match-lambda
+ ((path . source)
+ (equal? (call-with-input-file (string-append dir "/" path)
+ get-bytevector-all)
+ (call-with-input-file source
+ get-bytevector-all))))
+ files)))))
+
(test-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
0
1))