all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 54180@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race.
Date: Sun, 27 Feb 2022 14:53:35 +0100	[thread overview]
Message-ID: <20220227135342.10296-5-ludo@gnu.org> (raw)
In-Reply-To: <20220227135342.10296-1-ludo@gnu.org>

This removes three 'stat' syscalls.

* gnu/home/services/symlink-manager.scm (update-symlinks-script)[empty-directory?]:
Remove.
[cleanup-symlinks]: Replace use of 'file-exists?', 'file-is-directory?',
and 'empty-directory?' by a single 'rmdir' call.
---
 gnu/home/services/symlink-manager.scm | 35 ++++++++++++++-------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index f133eb17f2..6b3a9de3d1 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -101,9 +102,6 @@ (define (get-target-path path)
          (define (get-backup-path path)
            (string-append backup-dir "/." path))
 
-         (define (empty-directory? dir)
-           (equal? (scandir dir) '("." "..")))
-
          (define (symlink-to-store? path)
            (and (equal? (stat:type (lstat path)) 'symlink)
                 (store-file-name? (readlink path))))
@@ -127,20 +125,23 @@ (define (cleanup-symlinks old-tree)
                 (('dir . ".")
                  (display (G_ "Cleanup finished.\n\n")))
 
-                (('dir . path)
-                 (if (and
-                      (file-exists? (get-target-path path))
-                      (file-is-directory? (get-target-path path))
-                      (empty-directory? (get-target-path path)))
-                     (begin
-                       (format #t (G_ "Removing ~a...")
-                               (get-target-path path))
-                       (rmdir (get-target-path path))
-                       (display (G_ " done\n")))
-                     (format
-                      #t
-                      (G_ "Skipping ~a (not an empty directory)... done\n")
-                      (get-target-path path))))
+                (('dir . directory)
+                 (let ((directory (get-target-path directory)))
+                   (catch 'system-error
+                     (lambda ()
+                       (rmdir directory)
+                       (format #t (G_ "Removed ~a.\n") directory))
+                     (lambda args
+                       (let ((errno (system-error-errno args)))
+                         (cond ((= ENOTEMPTY errno)
+                                (format
+                                 #t
+                                 (G_ "Skipping ~a (not an empty directory)...\n")
+                                 directory))
+                               ((= ENOTDIR errno)
+                                #t)
+                               (else
+                                (apply throw args))))))))
 
                 (('file . path)
                  (when (file-exists? (get-target-path path))
-- 
2.34.0





  parent reply	other threads:[~2022-02-27 14:02 UTC|newest]

Thread overview: 28+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-02-27 13:40 [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-02-27 13:53 ` [bug#54180] [PATCH 01/12] home: symlink-manager: Clarify module imports Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines Ludovic Courtès
2022-02-27 15:58     ` Maxime Devos
2022-03-10 10:28       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 03/12] home: symlink-manager: Use 'for-each' when used for effects Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 04/12] home: symlink-manager: Use 'file-is-directory?' Ludovic Courtès
2022-02-27 13:53   ` Ludovic Courtès [this message]
2022-02-27 15:54     ` [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race Maxime Devos
2022-03-05 22:19       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-03-05 22:37         ` Maxime Devos
2022-02-27 13:53   ` [bug#54180] [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call Ludovic Courtès
2022-02-27 15:52     ` Maxime Devos
2022-02-27 13:53   ` [bug#54180] [PATCH 07/12] tests: Make sure 'guix home reconfigure' backs up files Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 08/12] tests: Simplify use of 'local-file' in 'tests/guix-home.sh' Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation Ludovic Courtès
2022-02-27 15:49     ` Maxime Devos
2022-03-05 22:20       ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Ludovic Courtès
2022-03-05 22:27         ` Maxime Devos
2022-03-05 22:38           ` Maxime Devos
2022-03-10 10:24             ` Ludovic Courtès
2022-03-10 10:23           ` Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 10/12] home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold' Ludovic Courtès
2022-02-27 13:53   ` [bug#54180] [PATCH 11/12] home: symlink-manager: 'create-symlinks' " Ludovic Courtès
2022-02-27 16:00     ` Maxime Devos
2022-02-27 13:53   ` [bug#54180] [PATCH 12/12] home: symlink-manager: Rename "path" to "file" where appropriate Ludovic Courtès
2022-02-28  7:53 ` [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Andrew Tropin
2022-03-10 10:45 ` bug#54180: " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220227135342.10296-5-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=54180@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.