From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:51652) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fEKkq-0005Oc-Vp for guix-patches@gnu.org; Thu, 03 May 2018 16:23:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fEKkp-0005sL-AG for guix-patches@gnu.org; Thu, 03 May 2018 16:23:04 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:40735) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fEKkp-0005sB-6Y for guix-patches@gnu.org; Thu, 03 May 2018 16:23:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fEKko-0003vx-Vw for guix-patches@gnu.org; Thu, 03 May 2018 16:23:03 -0400 Subject: [bug#31360] [PATCH 2/5] profiles: Optionally use relative file names for symlink targets. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Thu, 3 May 2018 22:22:24 +0200 Message-Id: <20180503202227.22485-2-ludo@gnu.org> In-Reply-To: <20180503202227.22485-1-ludo@gnu.org> References: <20180503202227.22485-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 31360@debbugs.gnu.org * guix/build/union.scm (symlink-relative): New procedure. * guix/build/profiles.scm: Re-export it. (build-profile): Add #:symlink and pass it to 'union-build'. * guix/profiles.scm (profile-derivation): Add #:relative-symlinks?. Pass #:symlink to 'build-profile'. * tests/profiles.scm ("profile-derivation relative symlinks, one entry") ("profile-derivation relative symlinks, two entries"): New tests. --- guix/build/profiles.scm | 14 ++++++++----- guix/build/union.scm | 9 +++++++- guix/profiles.scm | 7 +++++++ tests/profiles.scm | 46 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 70 insertions(+), 6 deletions(-) diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index b4160fba1..819688a91 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017 Ludovic Courtès +;;; Copyright © 2015, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +24,7 @@ #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) + #:re-export (symlink-relative) ;for convenience #:export (ensure-writable-directory build-profile)) @@ -129,12 +130,15 @@ instead make DIRECTORY a \"real\" directory containing symlinks." (apply throw args)))))) (define* (build-profile output inputs - #:key manifest search-paths) - "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an -sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for --all the variables listed in SEARCH-PATHS." + #:key manifest search-paths + (symlink symlink)) + "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to +create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create +OUTPUT/etc/profile with Bash definitions for -all the variables listed in +SEARCH-PATHS." ;; Make the symlinks. (union-build output inputs + #:symlink symlink #:log-port (%make-void-port "w")) ;; Store meta-data. diff --git a/guix/build/union.scm b/guix/build/union.scm index 82d6199d9..24b366af4 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -29,7 +29,8 @@ warn-about-collision - relative-file-name)) + relative-file-name + symlink-relative)) ;;; Commentary: ;;; @@ -213,4 +214,10 @@ Note that this is from a purely lexical standpoint; conversely, \"..\" is (finish))))))) file)) +(define (symlink-relative old new) + "Assuming both OLD and NEW are absolute file names, make NEW a symlink to +OLD, but using a relative file name." + (symlink (relative-file-name (dirname new) old) + new)) + ;;; union.scm ends here diff --git a/guix/profiles.scm b/guix/profiles.scm index 95dc9746b..c17961c98 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1202,6 +1202,7 @@ the entries in MANIFEST." (hooks %default-profile-hooks) (locales? #t) (allow-collisions? #f) + (relative-symlinks? #f) system target) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by @@ -1213,6 +1214,9 @@ with a different version number.) When LOCALES? is true, the build is performed under a UTF-8 locale; this adds a dependency on the 'glibc-utf8-locales' package. +When RELATIVE-SYMLINKS? is true, use relative file names for symlink targets. +This is one of the things to do for the result to be relocatable. + When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST are cross-built for TARGET." (mlet* %store-monad ((system (if system @@ -1275,6 +1279,9 @@ are cross-built for TARGET." (manifest-entries manifest)))))) (build-profile #$output '#$inputs + #:symlink #$(if relative-symlinks? + #~symlink-relative + #~symlink) #:manifest '#$(manifest->gexp manifest) #:search-paths search-paths)))) diff --git a/tests/profiles.scm b/tests/profiles.scm index 92eb08cb9..c268591c5 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -223,6 +223,52 @@ (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) +(test-assertm "profile-derivation relative symlinks, one entry" + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)) + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (string=? (readlink bindir) + (string-append "../" + (basename + (derivation->output-path guile)) + "/bin")))))) + +(unless (network-reachable?) (test-skip 1)) +(test-assertm "profile-derivation relative symlinks, two entries" + (mlet* %store-monad + ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0)) + (manifest -> (packages->manifest + (list %bootstrap-guile gnu-make-boot0))) + (guile (package->derivation %bootstrap-guile)) + (make (package->derivation gnu-make-boot0)) + (drv (profile-derivation manifest + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (file-exists? (string-append bindir "/make")) + (string=? (readlink (string-append bindir "/guile")) + (string-append "../../" + (basename + (derivation->output-path guile)) + "/bin/guile")) + (string=? (readlink (string-append bindir "/make")) + (string-append "../../" + (basename + (derivation->output-path make)) + "/bin/make")))))) + (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) -- 2.17.0