From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id aFFAKXcz9WaFvwAA62LTzQ:P1 (envelope-from ) for ; Thu, 26 Sep 2024 10:12:07 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1.migadu.com with LMTPS id aFFAKXcz9WaFvwAA62LTzQ (envelope-from ) for ; Thu, 26 Sep 2024 12:12:07 +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=Ug3BqQG+; dkim=fail ("headers rsa verify failed") header.d=rimm.ee header.s=herman header.b=sLeo8E8s; 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=1727345527; 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=lb5Z9BXkBplUTzgV6fEWJU1FeLh8AVli2t2y2v/vpZ4Ob3LVsmq3l/UQvA2wuB4ZwJ6ExS S5g5X2rCERUsBhqXKN2d0FBoJA3DiNGgXjZ/RaFe/7XADCQbcutfR3rBKa89ORzqkWsfI6 fdNGyfe0njawDPG1PR7y3SEaWEWf5HQ2qsMCXZNvGZMn4Q8r2amvKkQzMmqHhlDYqy5LAJ apSsKSJ0DEHNHQHhfkz7H/1iPK6NI1bfsolF8wAn3aL4IyDme88kIbQhBSk/3MSoBszu0w 89/W0QuIltwxQ47BK0+eQZMX6njnOAIOFwpWVgzs/SzN2ZYMip9qaYnEcbw+8g== 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=Ug3BqQG+; dkim=fail ("headers rsa verify failed") header.d=rimm.ee header.s=herman header.b=sLeo8E8s; 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-Seal: i=1; s=key1; d=yhetil.org; t=1727345527; a=rsa-sha256; cv=none; b=Lrcx7+C5b22piWLdFCkrB4LiTeZG2ekKLlAmj9EYOufId0GhCpaCuS5nAHGgEh0b4BwYgC UbhhCt7eoGDPyzP/sJU3HfWBhMvRTALhbFtVrvl76WpG4gsht1goi6KzzIvBsQ+eJ2gCTO zferTmqsCFHUKWp5z4/T/1q/Tb5LjPlPLUFJbkknwkRmEQXAyWKmOTk+LXdcsBJ3N0D3Mc 4gnmFmXmTpAU/DgNpFdJdzy12baDC8wPCEV37KBRhNl37pQCnKVC3kt54t0oQ1MS1FSM45 fVibFuDXGjvbWNNz5AP6VyK88Dnnxc7r0peeXE1aSjWDTS86IWbW9Zjf+D18tA== 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 6767B744E for ; Thu, 26 Sep 2024 12:12:07 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1stlTJ-0002yU-4h; Thu, 26 Sep 2024 06:11:41 -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 1stlTH-0002xQ-Lv for guix-patches@gnu.org; Thu, 26 Sep 2024 06:11:39 -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 1stlTH-0007Ph-BQ for guix-patches@gnu.org; Thu, 26 Sep 2024 06:11:39 -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=Ug3BqQG+RweF8LqdpaC+ZdAShRjhU+0AXPe/32eDzrxmUfId0BlJJLhr72FcOYhTusP/H9OGolG6egbSqSHjUvqGkKxohaJgBDNUukphKSwrwSRyqaOUGkAEr2PqTNLaJSyUL4u3DkHCyE1U1GJjZqaIt5cv5T+cV8wIxDW1xRz8vqDKo69VlB78bCuUEb8G9LlqVRGtIocfyIzDey8ceT1zqG8EQV01acymE7H/NobZNQU/7Z6P92oVG/P4Sgx8YMIclyIIjPmmZf9qlydDD+R271SKO8QOowi7Jax1bg5z4RG5E+eodNLa7CznEBvUllpMWTA7Wovtgi9p2gXlZw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1stlTi-0003Uz-9d; Thu, 26 Sep 2024 06:12:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#73202] [PATCH v3 09/14] gnu: bootloader: Add bootloader-configurations->gexp. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: lilah@lunabee.space, guix-patches@gnu.org Resent-Date: Thu, 26 Sep 2024 10:12:06 +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 , Lilah Tascheter X-Debbugs-Original-Xcc: Lilah Tascheter Received: via spool by 73202-submit@debbugs.gnu.org id=B73202.172734550613310 (code B ref 73202); Thu, 26 Sep 2024 10:12:06 +0000 Received: (at 73202) by debbugs.gnu.org; 26 Sep 2024 10:11:46 +0000 Received: from localhost ([127.0.0.1]:55500 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stlTN-0003SW-El for submit@debbugs.gnu.org; Thu, 26 Sep 2024 06:11:45 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:39475 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stlSz-0003PA-Jv for 73202@debbugs.gnu.org; Thu, 26 Sep 2024 06:11:23 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1727345441; 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=sLeo8E8sZ/0XupqHGNTwOgS9j4GP2M8oqJ68gB2baZjQ4u8xMSLZ/XFnHgOgIKI0sAfxqX gRM3hBTCs1gc+zYwIcSV1NxGJxuzCX9SUCeeXuWnusycxVupMvtVN2fz+HOBcSUAbjfXS4 jCZdolEzEsSkr7ov1mYsmhyL2RMGt6VPO+IRlnLBhtOx8UnmLb0zFQep+Vxv+4BsGMjvL9 x1ycxG6DD43br44DtfSYwJjueTDPngP54CCs3N4n9jFeHfaBLvHUBl1rnfE1hxTaJvcuz2 vD4GleQcslNuPQUK1fxWZunJAApE4QC3CJSfvJwCu9VL3c4o/cGh412Ldhwqew== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 03d74ee7 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO); Thu, 26 Sep 2024 10:10:41 +0000 (UTC) Date: Thu, 26 Sep 2024 12:09:06 +0200 Message-ID: <2ce2a5d1b077a35dcfc95c707703f8c0a11bf3b2.1727345067.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: <74c789e74594d538308d33633ed8540283dcde49.1727345067.git.herman@rimm.ee> References: <74c789e74594d538308d33633ed8540283dcde49.1727345067.git.herman@rimm.ee> 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-Queue-Id: 6767B744E X-Migadu-Scanner: mx11.migadu.com X-Spam-Score: -6.52 X-Migadu-Spam-Score: -6.52 X-TUID: xN+1OZymTLeQ 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