me/guix
Archived
1
0
Fork 0
Code Activity

home: symlink-manager: Use no-follow version of file-exists?.

Browse source 
* gnu/home/services/symlink-manager.scm (update-symlinks-script): Use
no-follow version of file-exists?.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Andrew Tropin 2022-04-07 11:22:48 +03:00 • committed by Ludovic Courtès
parent eeb8ac43c8
commit d6b9a3faa8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 7 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gnu/home/services/symlink-manager.scm
View file

@ -85,6 +85,10 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
;; such as "config/fontconfig/fonts.conf" or "bashrc". ;; such as "config/fontconfig/fonts.conf" or "bashrc".
(string-append home-directory "/" (preprocess-file file))) (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) (define (symlink-to-store? file)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
@ -123,7 +127,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
(const #t) (const #t)
(lambda (file stat _) ;leaf (lambda (file stat _) ;leaf
(let ((file (target-file (strip file)))) (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 ;; DO NOT remove the file if it is no longer a symlink to
;; the store, it will be backed up later during ;; the store, it will be backed up later during
;; create-symlinks phase. ;; create-symlinks phase.
@ -182,7 +186,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
(lambda (file stat result) ;leaf (lambda (file stat result) ;leaf
(let ((source (source-file (strip file))) (let ((source (source-file (strip file)))
(target (target-file (strip file)))) (target (target-file (strip file))))
(when (file-exists? target) (when (no-follow-file-exists? target)
(backup-file (strip file))) (backup-file (strip file)))
(format #t (G_ "Symlinking ~a -> ~a...") (format #t (G_ "Symlinking ~a -> ~a...")
target source) target source)
@ -191,7 +195,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
(lambda (directory stat result) ;down (lambda (directory stat result) ;down
(unless (string=? directory config-file-directory) (unless (string=? directory config-file-directory)
(let ((target (target-file (strip directory)))) (let ((target (target-file (strip directory))))
(when (and (file-exists? target) (when (and (no-follow-file-exists? target)
(not (file-is-directory? target))) (not (file-is-directory? target)))
(backup-file (strip directory))) (backup-file (strip directory)))