From 311d07fa91cefca23c304ed51e8022b2a3a6c736 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=93scar=20N=C3=A1jera?= Date: Tue, 20 Oct 2020 00:24:05 +0200 Subject: Fix symlinking Do nothing if on desired state. Remove file on target location if it something is found. --- install.scm | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'install.scm') diff --git a/install.scm b/install.scm index 2b0e7cb..dfb85af 100755 --- a/install.scm +++ b/install.scm @@ -52,15 +52,22 @@ (string-append prefix (substring f user-end (string-length f))))) (else (string-append (getcwd) "/" f)))) +(define (symlink? path) + (false-if-exception + (eq? 'symlink (stat:type (lstat path))))) + (define (clean-file full-dest) - (when (file-exists? full-dest) + (when (false-if-exception (lstat full-dest)) (log-msg 'WARN (string-append "Deleting previous file: " full-dest)) - (delete-file full-dest)) - full-dest) + (delete-file full-dest))) (define (config-links title src target) - (symlink (expand-file src) (clean-file (expand-file target))) - (log-msg 'OK (string-append title " on " target))) + (let ((src-path (expand-file src)) + (target-path (expand-file target))) + (unless (and (symlink? target-path) (equal? (readlink target-path) src-path)) + (clean-file target-path) + (symlink src-path target-path) + (log-msg 'OK (string-append title " on " target))))) (define (git-config) (log-msg 'INFO "Configuring git") -- cgit v1.2.3