From e00ade3fb81f89cd7c030f998ccd3e07ef2628f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Apr 2018 22:20:36 +0200 Subject: profiles: Optionally use relative file names for symlink targets. * 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 ++++++++- 2 files changed, 17 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index b4160fba1b..819688a913 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 @@ (define-module (guix build profiles) #: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 @@ (define (unsymlink link) (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 82d6199d9e..24b366af45 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -29,7 +29,8 @@ (define-module (guix build union) warn-about-collision - relative-file-name)) + relative-file-name + symlink-relative)) ;;; Commentary: ;;; @@ -213,4 +214,10 @@ (define (finish) (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 -- cgit v1.2.3