mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
profiles: Gracefully deal with packages containing an etc/ symlink.
This fixes a bug whereby 'guix package -i gcc-toolchain' would fail in 'build-profile'. This is because in 'gcc-toolchain', etc/ is a symlink, and so the 'scandir' call in 'unsymlink' would return #f instead of returning a list. Reported by Andreas Enge <andreas.enge@inria.fr>. * guix/build/profiles.scm (ensure-writable-directory)[unsymlink]: Append "/" to TARGET before calling 'scandir'. * tests/profiles.scm ("etc/profile when etc/ is a symlink"): New test.
This commit is contained in:
parent
01dbc7e01a
commit
113c17a0c9
2 changed files with 31 additions and 1 deletions
|
@ -94,7 +94,9 @@ (define (ensure-writable-directory directory)
|
||||||
instead make DIRECTORY a \"real\" directory containing symlinks."
|
instead make DIRECTORY a \"real\" directory containing symlinks."
|
||||||
(define (unsymlink link)
|
(define (unsymlink link)
|
||||||
(let* ((target (readlink link))
|
(let* ((target (readlink link))
|
||||||
(files (scandir target
|
;; TARGET might itself be a symlink, so append "/" to make sure
|
||||||
|
;; 'scandir' enters it.
|
||||||
|
(files (scandir (string-append target "/")
|
||||||
(negate (cut member <> '("." ".."))))))
|
(negate (cut member <> '("." ".."))))))
|
||||||
(delete-file link)
|
(delete-file link)
|
||||||
(mkdir link)
|
(mkdir link)
|
||||||
|
|
|
@ -277,6 +277,34 @@ (define glibc
|
||||||
get-string-all)
|
get-string-all)
|
||||||
"foo!"))))))
|
"foo!"))))))
|
||||||
|
|
||||||
|
(test-assertm "etc/profile when etc/ is a symlink"
|
||||||
|
;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
|
||||||
|
;; gracelessly because 'scandir' would return #f.
|
||||||
|
(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 "/foo"))
|
||||||
|
(symlink "foo" (string-append out "/etc"))
|
||||||
|
(call-with-output-file (string-append out "/etc/bar")
|
||||||
|
(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/bar")
|
||||||
|
get-string-all)
|
||||||
|
"foo!"))))))
|
||||||
|
|
||||||
(test-end "profiles")
|
(test-end "profiles")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue