tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

environment: Translate only file names under home directory.

Browse Source 
* guix/scripts/environment.scm (file-name-equal-or-under?): New procedure.
(override-user-mappings, override-user-dir): Use it.

Change-Id: Iadd9b838f6442a8080998ed7e07414db562068bf
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Tomas Volf
2025-05-18 15:39:35 +02:00
committed by Ludovic Courtès
parent 8654aecf74
commit 7a888d9841
1 changed files with 8 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
guix/scripts/environment.scm
View File

@@ -979,6 +979,12 @@ WHILE-LIST."
"Return home directory for override user USER."
(string-append "/home/" user))
(define (file-name-equal-or-under? file-name directory)
"Is @var{file-name} equal to or under @var{directory}?"
(or (string=? directory file-name)
(and (string-prefix? directory file-name)
(char=? #\/ (string-ref file-name (string-length directory))))))
(define (override-user-mappings user home mappings)
"If a username USER is provided, rewrite each HOME prefix in file system
mappings MAPPINGS to a home directory determined by 'override-user-dir';
@@ -987,7 +993,7 @@ otherwise, return MAPPINGS."
mappings
(map (lambda (mapping)
(let ((target (file-system-mapping-target mapping)))
(if (string-prefix? home target)
(if (file-name-equal-or-under? target home)
(file-system-mapping
(inherit mapping)
(target (override-user-dir user home target)))
@@ -997,7 +1003,7 @@ otherwise, return MAPPINGS."
(define (override-user-dir user home dir)
"If username USER is provided, overwrite string prefix HOME in DIR with a
directory determined by 'user-override-home'; otherwise, return DIR."
(if (and user (string-prefix? home dir))
(if (and user (file-name-equal-or-under? dir home))
(string-append (user-override-home user)
(substring dir (string-length home)))
dir))