From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id aMynChBR7WbrngAAqHPOHw:P1 (envelope-from ) for ; Fri, 20 Sep 2024 10:40:16 +0000 Received: from aspmx1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0.migadu.com with LMTPS id aMynChBR7WbrngAAqHPOHw (envelope-from ) for ; Fri, 20 Sep 2024 12:40:16 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=fY7xDKYA; dkim=fail ("headers rsa verify failed") header.d=rimm.ee header.s=herman header.b=kYa1VIPD; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1726828816; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=qBNIh/kScwIFDm4cVMybJISLgB15iFQHhIQqqC68N6I=; b=DCeQGFEdjZONe2+m6layDUTAf3HMIHnuMgQVLPm9YYrimGhKU6o9eTvFt6hgL1ILfiMTWI Ei9TCJeaXjl7uKHi5kJ0Enu7WSyE7HFHyKoFQXbEitjMLJqgnXx4/MgOMD9fdr/5SdJnX8 0MA4JH1PlHRWDU2D1Zt/lAP2J+KI92XkP/frSDn352SfJNb6rsgYfXgq6aqrCJvwvAkvpv SxP1tae9PA0mmHu2+wXslSSIVyCDA9vsbyPXe9ZMwS7yFqF63DnznYVdCZ8UUNnmLHAZ5S iAM6jpOJf9TbNNmiIyCvcHcxivvP/Eq/fASJouCp5ECnZ7cxgBeYq9CdaryUog== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1726828816; a=rsa-sha256; cv=none; b=Av80cX0ipON1J8zlshxe85W3KdjRUUAUD9JfhIuGQCkWTtt8gmkhvB/1ryy/8Zk2Ae1nvr LvhPJWEMVd94AlTMUpXADJQwh4JnGsBZQH+pS84+DNvfStrxTP0tYq1L13Y89osbSy9vX+ 5M67t+z9BAX/RdahoxUR6rQbCFhqfBSitCz+2nqa9kYhQ6c9CLypHjTItefXx4l5y7WfTG eI/gqe/WUJ75UU7UF6btlw8kU0ss6nXWxwW95bl8yJaMwxr7oIlHrVEBICGgyDrT+pn5ro DxtgWMVbhvxwPe4PBzZK76cozyAaUZqigpcK2/XZ78g19BY3Xbu1CTCrGKZT3g== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=fY7xDKYA; dkim=fail ("headers rsa verify failed") header.d=rimm.ee header.s=herman header.b=kYa1VIPD; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id C22F97BAE6 for ; Fri, 20 Sep 2024 12:40:15 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1srb3Y-00054j-PO; Fri, 20 Sep 2024 06:40:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1srb3E-0004xr-UR for guix-patches@gnu.org; Fri, 20 Sep 2024 06:39:49 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1srb3E-0006U0-KE for guix-patches@gnu.org; Fri, 20 Sep 2024 06:39:48 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=IJShaDk+nVvCcgJhpUHmyt7BkJueute34U1DFCvRRVc=; b=fY7xDKYASJlDZOSgS8Cv+KVtcZF19TJocSFOP8Gla0C7bu8NtEfSB/q53C/726omA7o1jKmTIXbqFiBuCOERMOFHrig6ouU2EW33g2VMud/9P9EyN4TP+kr7APKMHR4fEpbQoluYMkhoZ9BVboe6EfQ+sTzwmYv6yKCHWGtqbV9FSTvrI5kf+O/xSe4MUl5r5ku2kkGpX1x4aofPxLcEAAqk5t6GDeresvR7LSB1O2tRIsjJVXKM1G6+sNAB3iptqEXAFg+1UOhZCCIN64gBclHN2+d00LOTcNfQyZxtG+LwqR8EBACzp2OQUYYWty19nHk1PCey/ZcEnqPo0kMF7Q==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1srb3X-0001Pr-7W for guix-patches@gnu.org; Fri, 20 Sep 2024 06:40:07 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#73202] [PATCH v2 09/15] gnu: bootloader: Add bootloader-configurations->gexp. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 20 Sep 2024 10:40:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73202 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 73202@debbugs.gnu.org Cc: Lilah Tascheter Received: via spool by 73202-submit@debbugs.gnu.org id=B73202.17268287815291 (code B ref 73202); Fri, 20 Sep 2024 10:40:07 +0000 Received: (at 73202) by debbugs.gnu.org; 20 Sep 2024 10:39:41 +0000 Received: from localhost ([127.0.0.1]:34167 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srb36-0001NA-TN for submit@debbugs.gnu.org; Fri, 20 Sep 2024 06:39:41 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:54361 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srb2w-0001KU-2H for 73202@debbugs.gnu.org; Fri, 20 Sep 2024 06:39:30 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1726828736; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=qBNIh/kScwIFDm4cVMybJISLgB15iFQHhIQqqC68N6I=; b=kYa1VIPDu0TbozIxMUfi3rFd3qi0pV+A4J1sRX6pF9zRr1rEjgRbz1ue4h25UzRRw3pNPA cueJCbXLjSq5T6q9SSmbgeNIA2H+hkyHUxjbakhNllwuUhTH86gmOh7w6LmP13vfwKsAt4 sarTrIfBi1HQin3JIyHPX2VeaLbvBHC5dZqEp32/CXcaJ97NWOHldXJ8OIx0HPACUVJlM6 nNYX/sTBGhNyRCOeBKnBt9peUd1AFwmA0fB8LdNlZJPqViyk+91IexTQpWuc9rwc0aY0ar BUTUyTXzUovPjwPPr0qYNTJERBwsHd70mJHDAKdnTgqNm+htKUu3JEA5NkhsWg== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 408c324a (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO); Fri, 20 Sep 2024 10:38:56 +0000 (UTC) Date: Fri, 20 Sep 2024 12:37:54 +0200 Message-ID: <36b06c055689a23a29e1ad8cc0e2617a1f57f900.1726827025.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches From: Herman Rimm via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Scanner: mx12.migadu.com X-Migadu-Spam-Score: -6.51 X-Migadu-Queue-Id: C22F97BAE6 X-Spam-Score: -6.51 X-TUID: X/M66YvHpLsW From: Lilah Tascheter * gnu/bootloader.scm (bootloader)[default-targets]: Add field. (target-overrides, normalize, bootloader-configuration->gexp, bootloader-configurations->gexp): New procedures. Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739 --- gnu/bootloader.scm | 108 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 0c24996205..c77de6f55e 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -67,6 +67,7 @@ (define-module (gnu bootloader) bootloader? bootloader-name bootloader-package + bootloader-default-targets bootloader-installer bootloader-disk-image-installer bootloader-configuration-file @@ -107,6 +108,8 @@ (define-module (gnu bootloader) bootloader-configuration-device-tree-support? bootloader-configuration-extra-initrd + bootloader-configuration->gexp + bootloader-configurations->gexp efi-bootloader-chain)) @@ -255,6 +258,7 @@ (define-record-type* bootloader? (name bootloader-name) (package bootloader-package) + (default-targets bootloader-default-targets (default '())) (installer bootloader-installer) (disk-image-installer bootloader-disk-image-installer (default #f)) @@ -498,6 +502,110 @@ (define (bootloader-configuration-targets config) ;; hence the default value of '(#f) rather than '(). (list #f))) + +;;; +;;; Bootloader installation paths. +;;; + +(define (target-overrides . layers) + (let* ((types (flat-map (cute map bootloader-target-type <>) layers)) + ;; TODO: use loop instead of fold for early termination. + (pred (lambda (type layer found) + (or found (get-target-of-type type layer)))) + (find (lambda (type) (fold (cute pred type <> <>) #f layers)))) + (filter identity (map find (delete-duplicates types))))) + +(define (normalize targets) + "Augments TARGETS with filesystem information at runtime, allowing +users to specify a lot less information. Puts TARGETS into a normal +form, where each path is fully specified up to a device offset." + (define (mass m) + `((,(mount-source m) . ,m) + (,(mount-point m) . ,m))) + + (define (accessible=> d f) + (and d (access? d R_OK) (f d))) + + (define (fixuuid target) + (match-record target (uuid file-system) + (let ((type (cond ((not file-system) 'dce) + ((member file-system '("vfat" "fat32")) 'fat) + ((string=? file-system "ntfs") 'ntfs) + ((string=? file-system "iso9660") 'iso9660) + (else 'dce)))) + (bootloader-target (inherit target) + (uuid (cond ((uuid? uuid) uuid) + ((bytevector? uuid) (bytevector->uuid uuid type)) + ((string? uuid) (string->uuid uuid type)) + (else #f))))))) + + (define (arborify target targets) + (let* ((up (lambda (t) (and t (parent-of t targets)))) + (proto (unfold target-base? identity up (up target) list)) + (chain (reverse (cons target proto)))) + (bootloader-target + (inherit target) + (offset (and=> (car chain) bootloader-target-type)) + (path (reduce pathcat #f (map bootloader-target-path (cdr chain))))))) + + (let ((amounts (delay (apply append (map mass (mounts)))))) + (define (assoc-mnt f) + (lambda (v) (and=> (assoc-ref (force amounts) v) f))) + + (define (scrape target) + (match-record target + (expected? path offset device label uuid file-system) + (if expected? target + (bootloader-target + (inherit target) + (device (or device + (false-if-exception + (or (and=> uuid find-partition-by-uuid) + (and=> label find-partition-by-label))) + (and path ((assoc-mnt mount-source) + (unfold-pathcat target targets))))) + (label (or label (accessible=> device read-partition-label))) + (uuid (or uuid (accessible=> device read-partition-uuid))) + (file-system (or file-system (and=> device (assoc-mnt mount-type)))) + (offset (and path offset)) + (path (or path (and=> device (assoc-mnt mount-point)))))))) + + (let ((mid (map (compose fixuuid scrape) targets))) + (map (cut arborify <> mid) mid)))) + +(define* (bootloader-configuration->gexp bootloader-config args #:key + (root-offset "/") (overrides '())) + "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS +to each installer alongside the additional #:bootloader-config keyword +arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET +applied. The following keyword arguments are expected in ARGS: +@enumerate +@item current-boot-alternative +@item old-boot-alternatives +@item locale (from bootmeta) +@item store-directory-prefix (from bootmeta) +@item store-crypto-devices (from bootmeta) +@end enumerate" + (let* ((bootloader (bootloader-configuration-bootloader bootloader-config)) + (installer (bootloader-installer bootloader)) + (auto-targets (list (bootloader-target + (type 'root) + (path root-offset) + (offset #f)))) + (targets (target-overrides + overrides + (bootloader-configuration-targets bootloader-config) + auto-targets + (bootloader-default-targets bootloader))) + (conf (bootloader-configuration + (inherit bootloader-config) + (targets (normalize targets))))) + (apply installer #:bootloader-config conf args))) + +(define (bootloader-configurations->gexp bootloader-configs . rest) + (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest) + bootloader-configs))) + ;;; ;;; Bootloaders. -- 2.45.2