From a81bb1e4bb838210eed7d63ad5bf89ae9dd72eda Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 18 Feb 2022 17:13:00 +0100 Subject: 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(-) (limited to 'gnu/home') 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 ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2022 Ludovic Courtès ;;; ;;; 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)) -- cgit v1.2.3