From d6b9a3faa8d470af6dada3e052a12bba6c32fc22 Mon Sep 17 00:00:00 2001 From: Andrew Tropin Date: Thu, 7 Apr 2022 11:22:48 +0300 Subject: home: symlink-manager: Use no-follow version of file-exists?. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/home/services/symlink-manager.scm (update-symlinks-script): Use no-follow version of file-exists?. Signed-off-by: Ludovic Courtès --- gnu/home/services/symlink-manager.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'gnu/home') diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm index 24d21bfad3..5b85a0e581 100644 --- a/gnu/home/services/symlink-manager.scm +++ b/gnu/home/services/symlink-manager.scm @@ -85,6 +85,10 @@ subdirectory from XDG_CONFIG_HOME to generate a target path." ;; such as "config/fontconfig/fonts.conf" or "bashrc". (string-append home-directory "/" (preprocess-file file))) + (define (no-follow-file-exists? file) + "Return #t if file exists, even if it's a dangling symlink." + (->bool (false-if-exception (lstat file)))) + (define (symlink-to-store? file) (catch 'system-error (lambda () @@ -123,7 +127,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path." (const #t) (lambda (file stat _) ;leaf (let ((file (target-file (strip file)))) - (when (file-exists? file) + (when (no-follow-file-exists? file) ;; DO NOT remove the file if it is no longer a symlink to ;; the store, it will be backed up later during ;; create-symlinks phase. @@ -182,7 +186,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path." (lambda (file stat result) ;leaf (let ((source (source-file (strip file))) (target (target-file (strip file)))) - (when (file-exists? target) + (when (no-follow-file-exists? target) (backup-file (strip file))) (format #t (G_ "Symlinking ~a -> ~a...") target source) @@ -191,7 +195,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path." (lambda (directory stat result) ;down (unless (string=? directory config-file-directory) (let ((target (target-file (strip directory)))) - (when (and (file-exists? target) + (when (and (no-follow-file-exists? target) (not (file-is-directory? target))) (backup-file (strip directory))) -- cgit v1.2.3