diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-09-10 23:37:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-11 00:14:58 +0200 |
| commit | 2225d56a14a2d8d29374a14eefe90b3cffa79804 (patch) | |
| tree | a591bd0ef10b0569442a4b4b2d8a516560a78cec /tests | |
| parent | cbb0edd1be1f653d253258dfa90c8b45f288fb1b (diff) | |
| download | guix-2225d56a14a2d8d29374a14eefe90b3cffa79804.tar guix-2225d56a14a2d8d29374a14eefe90b3cffa79804.tar.gz | |
profiles: Correctly deal with etc/ being a relative symlink.
Fixes <https://bugs.gnu.org/32686>.
Reported by Oleg Pykhalov <go.wigust@gmail.com>.
* guix/build/profiles.scm (ensure-writable-directory): Add #:symlink.
[absolute?]: New procedure.
[unsymlink]: Use it to determine how to resolve readlink's result.
(build-profile): Pass SYMLINK to 'ensure-writable-directory'.
* tests/profiles.scm ("profile-derivation when etc/ is a relative symlink"):
New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/profiles.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/profiles.scm b/tests/profiles.scm index 3a59a0cc4f..9f366a04ef 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -20,6 +20,7 @@ (define-module (test-profiles) #:use-module (guix tests) #:use-module (guix profiles) + #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix grafts) @@ -543,6 +544,41 @@ get-string-all) "foo!")))))) +(test-assertm "profile-derivation when etc/ is a relative symlink" + ;; See <https://bugs.gnu.org/32686>. + (mlet* %store-monad + ((etc (gexp->derivation + "etc" + #~(begin + (mkdir #$output) + (call-with-output-file (string-append #$output "/foo") + (lambda (port) + (display "Heya!" port)))))) + (thing -> (dummy-package "dummy" + (build-system trivial-build-system) + (inputs + `(("etc" ,etc))) + (arguments + `(#:guile ,%bootstrap-guile + #:builder + (let ((out (assoc-ref %outputs "out")) + (etc (assoc-ref %build-inputs "etc"))) + (mkdir out) + (symlink etc (string-append out "/etc")) + #t))))) + (entry -> (package->manifest-entry thing)) + (drv (profile-derivation (manifest (list entry)) + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (return (string=? (call-with-input-file + (string-append profile "/etc/foo") + get-string-all) + "Heya!"))))) + (test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949> "does-not-exist" (mlet* %store-monad |