From mboxrd@z Thu Jan 1 00:00:00 1970 From: John Darrington Subject: [PATCH] gnu: Mark /gnu/store as needed for boot. Date: Wed, 11 Jan 2017 21:01:42 +0100 Message-ID: <1484164902-10160-1-git-send-email-jmd@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:51068) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cRP5s-0005Ks-Ge for guix-devel@gnu.org; Wed, 11 Jan 2017 15:02:01 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cRP5n-0001gK-LB for guix-devel@gnu.org; Wed, 11 Jan 2017 15:02:00 -0500 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org Cc: John Darrington * gnu/system/file-systems.scm (all-subpaths): New procedure. (file-system-needed-for-boot?): Use it to check for ancestors of %store-directory. --- gnu/system/file-systems.scm | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 4cc1221..d42f271 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -20,6 +20,7 @@ #:use-module (ice-9 match) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix build utils) #:use-module ((gnu build file-systems) #:select (string->uuid uuid->string)) #:re-export (string->uuid @@ -95,11 +96,29 @@ (dependencies file-system-dependencies ; list of (default '()))) ; or + +(define (all-subpaths path) + "Given a directory PATH return a list of all paths which +are ancestors of this path, including PATH itself" + (let loop ((path (string-split path #\/)) + (ac '())) + (if (null? path) + ac + (loop (cdr path) + (cons + (string-append + (match ac + (() "/") + ((x _ . _) (string-append x "/")) + ((x . _) x)) + (car path)) + ac))))) + (define-inlinable (file-system-needed-for-boot? fs) - "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root -file system." + "Return true if FS has the 'needed-for-boot?' flag set, or if it holds +the store directory." (or (%file-system-needed-for-boot? fs) - (string=? "/" (file-system-mount-point fs)))) + (member (file-system-mount-point fs) (all-subpaths (%store-directory))))) (define (file-system->spec fs) "Return a list corresponding to file-system FS that can be passed to the -- 2.1.4