09/16: home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit a81bb1e4bb838210eed7d63ad5bf89ae9dd72eda
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Feb 18 17:13:00 2022 +0100

    home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race.
    
    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 @@ appear only after all nested items already listed."
          (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 @@ appear only after all nested items already listed."
                 (('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))