aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/profiles.scm74
-rw-r--r--tests/profiles.scm29
2 files changed, 88 insertions, 15 deletions
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index eda54cb37a..525d59b979 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -21,6 +21,7 @@
#:use-module (guix build utils)
#:use-module (guix search-paths)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:export (build-profile))
@@ -57,21 +58,9 @@ user-friendly name of the profile is, for instance ~/.guix-profile rather than
port)
(newline port))))
-(define* (build-profile output inputs
- #:key manifest search-paths)
- "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an
-sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for
-all the variables listed in SEARCH-PATHS."
- ;; Make the symlinks.
- (union-build output inputs
- #:log-port (%make-void-port "w"))
-
- ;; Store meta-data.
- (call-with-output-file (string-append output "/manifest")
- (lambda (p)
- (pretty-print manifest p)))
-
- ;; Add a ready-to-use Bash profile.
+(define (build-etc/profile output search-paths)
+ "Build the 'OUTPUT/etc/profile' shell file containing environment variable
+definitions for all the SEARCH-PATHS."
(mkdir-p (string-append output "/etc"))
(call-with-output-file (string-append output "/etc/profile")
(lambda (port)
@@ -99,4 +88,59 @@ all the variables listed in SEARCH-PATHS."
(for-each (write-environment-variable-definition port)
(map (abstract-profile output) variables))))))
+(define (ensure-writable-directory directory)
+ "Ensure DIRECTORY exists and is writable. If DIRECTORY is currently a
+symlink (to a read-only directory in the store), then delete the symlink and
+instead make DIRECTORY a \"real\" directory containing symlinks."
+ (define (unsymlink link)
+ (let* ((target (readlink link))
+ (files (scandir target
+ (negate (cut member <> '("." ".."))))))
+ (delete-file link)
+ (mkdir link)
+ (for-each (lambda (file)
+ (symlink (string-append target "/" file)
+ (string-append link "/" file)))
+ files)))
+
+ (catch 'system-error
+ (lambda ()
+ (mkdir directory))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (if (= errno EEXIST)
+ (let ((stat (lstat directory)))
+ (case (stat:type stat)
+ ((symlink)
+ ;; "Unsymlink" DIRECTORY so that it is writable.
+ (unsymlink directory))
+ ((directory)
+ #t)
+ (else
+ (error "cannot mkdir because a same-named file exists"
+ directory))))
+ (apply throw args))))))
+
+(define* (build-profile output inputs
+ #:key manifest search-paths)
+ "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an
+sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for
+-all the variables listed in SEARCH-PATHS."
+ ;; Make the symlinks.
+ (union-build output inputs
+ #:log-port (%make-void-port "w"))
+
+ ;; Store meta-data.
+ (call-with-output-file (string-append output "/manifest")
+ (lambda (p)
+ (pretty-print manifest p)))
+
+ ;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have
+ ;; made 'etc' a symlink to a read-only sub-directory in the store so we need
+ ;; to work around that.
+ (ensure-writable-directory (string-append output "/etc"))
+
+ ;; Write 'OUTPUT/etc/profile'.
+ (build-etc/profile output search-paths))
+
;;; profile.scm ends here
diff --git a/tests/profiles.scm b/tests/profiles.scm
index de1411dca2..ac7f28bf53 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -24,6 +24,7 @@
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
+ #:use-module (guix build-system trivial)
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages base) #:prefix packages:)
#:use-module ((gnu packages guile) #:prefix packages:)
@@ -248,6 +249,34 @@
(and (zero? (close-pipe pipe))
(string-contains path (string-append profile "/bin"))))))))
+(test-assertm "etc/profile when etc/ already exists"
+ ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
+ ;; etc/ directory, which makes it read-only. Make sure the profile build
+ ;; handles that.
+ (mlet* %store-monad
+ ((thing -> (dummy-package "dummy"
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (mkdir (string-append out "/etc"))
+ (call-with-output-file (string-append out "/etc/foo")
+ (lambda (port)
+ (display "foo!" port))))))))
+ (entry -> (package->manifest-entry thing))
+ (drv (profile-derivation (manifest (list entry))
+ #:hooks '()))
+ (profile -> (derivation->output-path drv)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (return (and (file-exists? (string-append profile "/etc/profile"))
+ (string=? (call-with-input-file
+ (string-append profile "/etc/foo")
+ get-string-all)
+ "foo!"))))))
+
(test-end "profiles")