ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

profiles: Gracefully deal with packages containing an etc/ symlink.

Browse source 
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:
Ludovic Courtès 2015-05-18 09:47:29 +02:00
parent 01dbc7e01a
commit 113c17a0c9
2 changed files with 31 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
guix/build/profiles.scm
View file

@ -94,7 +94,9 @@ (define (ensure-writable-directory directory)
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)

28
tests/profiles.scm
View file

@ -277,6 +277,34 @@ (define glibc
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")