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.
This commit is contained in:
		
							parent
							
								
									e1b38046a6
								
							
						
					
					
						commit
						a81bb1e4bb
					
				
					 1 changed files with 18 additions and 17 deletions
				
			
		| 
						 | 
				
			
			@ -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")))
 | 
			
		||||
                (('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)... done\n")
 | 
			
		||||
                      (get-target-path path))))
 | 
			
		||||
                                 (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))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue