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
|
@ -94,7 +94,9 @@ 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
|
||||
;; TARGET might itself be a symlink, so append "/" to make sure
|
||||
;; 'scandir' enters it.
|
||||
(files (scandir (string-append target "/")
|
||||
(negate (cut member <> '("." ".."))))))
|
||||
(delete-file link)
|
||||
(mkdir link)
|
||||
|
|
|
@ -277,6 +277,34 @@
|
|||
get-string-all)
|
||||
"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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue