[bug#54762] [PATCH] home: symlink-manager: Use no-follow version of file-exists?.

[Andrew Tropin <andrew@trop.in>]

[-- Attachment #1.1: Type: text/plain, Size: 1019 bytes --]

On 2022-04-07 20:21, Maxime Devos wrote:

> Andrew Tropin schreef op do 07-04-2022 om 20:01 [+0300]:
>> Idk how file-exists? works internally, but still expect it to be more
>> efficient than lstat.  That's why I decided to use lstat only as a
>> "fallback" option in `or` statement.
>
> Here's the definition, from module/ice-9/boot-9.scm (Guile source
> code):
>
> ;; For reference, Emacs file-exists-p uses stat in this same way.
> (define file-exists?
>   (if (provided? 'posix)
>       (lambda (str)
>         (->bool (stat str #f)))
>       [non-POSIX code that's not relevant to Guix]))
>
> 'file-exists?' just calls 'stat', a variant of 'lstat', so I don't
> think there are performance gains to be had here.  Well, the
> (stat ... #f) might not need to install an exception handler since it
> is written in C, but that seems at most a micro-optimisation to me.
>
> Greetings,
> Maxime.

Updated the implementation, which behaves similiar to file-exists?, but
not follow symlinks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: v2-0001-home-symlink-manager-Use-no-follow-version-of-fil.patch --]
[-- Type: text/x-patch, Size: 2590 bytes --]

From 92ee52a96d536cba2b3b473f99e8f36646da81fd Mon Sep 17 00:00:00 2001
From: Andrew Tropin <andrew@trop.in>
Date: Thu, 7 Apr 2022 11:22:48 +0300
Subject: [PATCH v2] home: symlink-manager: Use no-follow version of
 file-exists?.

* gnu/home/services/symlink-manager.scm (update-symlinks-script): Use
no-follow version of file-exists?.
---
 gnu/home/services/symlink-manager.scm | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 6d19258ec7..e4c931fbee 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -85,6 +85,10 @@ (define (target-file file)
            ;; 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 @@ (define (strip file)
             (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.
@@ -183,7 +187,7 @@ (define (source-file file)
             (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)
@@ -192,7 +196,7 @@ (define (source-file file)
             (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)))
 
-- 
2.34.0


[-- Attachment #1.3: Type: text/plain, Size: 37 bytes --]


-- 
Best regards,
Andrew Tropin

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 853 bytes --]