~ruther/guix-local

113c17a0c969e600023698ae3a34994a796d0046 — Ludovic Courtès 11 years ago 01dbc7e
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.
2 files changed, 31 insertions(+), 1 deletions(-)

M guix/build/profiles.scm
M tests/profiles.scm
M guix/build/profiles.scm => guix/build/profiles.scm +3 -1
@@ 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)

M tests/profiles.scm => tests/profiles.scm +28 -0
@@ 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")