From a0dac7a01f766e75dc73200a889f31c3920a2d98 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 8 May 2015 15:39:45 +0200
Subject: profiles: Ensure the profile's etc/ directory is writable.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Reported by 宋文武 <iyzsong@gmail.com>.

* guix/build/profiles.scm (build-etc/profile,
  ensure-writable-directory): New procedures.
  (build-profile): Use them.
* tests/profiles.scm ("etc/profile when etc/ already exists"): New test.
---
 tests/profiles.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'tests')

diff --git a/tests/profiles.scm b/tests/profiles.scm
index de1411dca2..ac7f28bf53 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -24,6 +24,7 @@
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix build-system trivial)
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages base) #:prefix packages:)
   #:use-module ((gnu packages guile) #:prefix packages:)
@@ -248,6 +249,34 @@
          (and (zero? (close-pipe pipe))
               (string-contains path (string-append profile "/bin"))))))))
 
+(test-assertm "etc/profile when etc/ already exists"
+  ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
+  ;; etc/ directory, which makes it read-only.  Make sure the profile build
+  ;; handles that.
+  (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 "/etc"))
+                          (call-with-output-file (string-append out "/etc/foo")
+                            (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/foo")
+                               get-string-all)
+                             "foo!"))))))
+
 (test-end "profiles")
 
 
-- 
cgit v1.2.3