From e05914abd5c9ec03f313e80d4ce4e3a8101cc15f Mon Sep 17 00:00:00 2001
From: Ryan Schanzenbacher <ryan@rschanz.org>
Date: Tue, 2 Jul 2024 21:34:47 -0400
Subject: [PATCH] Initial UKI work. systemd-stub and ukify compile
 successfully.

uki bootloader code added for reference, still need to go through and
fix
---
 modules/ryan-components/README        |   1 +
 modules/ryan-components/uki.scm       | 179 ++++++++++++++++++++++++++
 modules/ryan-packages/bootloaders.scm | 117 +++++++++++++++++
 3 files changed, 297 insertions(+)
 create mode 100644 modules/ryan-components/README
 create mode 100644 modules/ryan-components/uki.scm
 create mode 100644 modules/ryan-packages/bootloaders.scm

diff --git a/modules/ryan-components/README b/modules/ryan-components/README
new file mode 100644
index 0000000..d8f302b
--- /dev/null
+++ b/modules/ryan-components/README
@@ -0,0 +1 @@
+Placeholder directory for components that are technically deeper in Guix that I wish to override, like the bootloader generation process
diff --git a/modules/ryan-components/uki.scm b/modules/ryan-components/uki.scm
new file mode 100644
index 0000000..eb048a2
--- /dev/null
+++ b/modules/ryan-components/uki.scm
@@ -0,0 +1,179 @@
+;; Taken from https://paste.sr.ht/~hako/62bb15503290273e869520e12466718ebb82e000
+;; Based off various things related to https://issues.guix.gnu.org/68524
+
+(define-module (ryan-components uki)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu packages bootloaders)
+  #:use-module (gnu packages linux)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:export (uefi-uki-bootloader
+            uefi-uki-signed-bootloader))
+
+(define vendor "Guix")
+(define script-path "/boot/install-uki.scm")
+
+(define* (uefi-uki-configuration-file #:optional cert privkey)
+  (lambda* (config entries #:key (old-entries '()) #:allow-other-keys)
+
+    (define all-entries
+      (append entries old-entries))
+
+    (define (menu-entry->ukify-args entry)
+      (let* ((label     (menu-entry-label entry))
+             (linux     (menu-entry-linux entry))
+             (initrd    (menu-entry-initrd entry))
+             (arguments (menu-entry-linux-arguments entry))
+             (boot (bootloader-configuration-bootloader config))
+             (stub (bootloader-package boot)))
+        #~(list "--os-release" #$label
+                "--linux" #$linux
+                "--initrd" #$initrd
+                "--cmdline" (string-join (list #$@arguments))
+                "--stub" #$(file-append stub "/libexec/" (systemd-stub-name))
+                #$@(if cert #~("--secureboot-certificate" #$cert) '())
+                #$@(if privkey #~("--secureboot-private-key" #$privkey) '()))))
+
+    (define (enumerate-uki-filenames entries)
+      (map (lambda (n)
+             (string-append (number->string n) ".efi"))
+           (iota (length entries))))
+
+    (program-file
+     "install-uki"
+     (with-imported-modules (source-module-closure
+                             '((guix build syscalls)
+                               (guix build utils)
+                               (guix diagnostics)
+                               (guix i18n)))
+       #~(begin
+           (use-modules (guix build syscalls)
+                        (guix build utils)
+                        (guix diagnostics)
+                        (guix i18n)
+                        (ice-9 string-fun)
+                        (rnrs io ports)
+                        (srfi srfi-1))
+           (let* ((target (second (command-line)))
+                  (vendor-directory (string-append target "/EFI/" #$vendor))
+                  (schema (string-append vendor-directory "/boot.mgr"))
+                  (efibootmgr #$(file-append efibootmgr "/sbin/efibootmgr"))
+                  (ukify #$(file-append ukify "/bin/ukify")))
+             (define (uki-install-path name)
+               (string-append vendor-directory "/" name))
+
+             (define (uki-efi-path name)
+               (string-replace-substring
+                (string-drop (uki-install-path name) (string-length target))
+                "/"
+                "\\"))
+
+             (define target/trimmed
+               (let* ((not-slash (char-set-complement (char-set #\/)))
+                      (components (string-tokenize target not-slash)))
+                 (string-join components "/" 'prefix)))
+
+             (define disk
+               (let ((target-mount
+                      (find (lambda (mount)
+                              (string=? (mount-point mount) target/trimmed))
+                            (mounts))))
+                 (if target-mount
+                     (mount-source target-mount)
+                     (leave (G_ "target '~a' not mounted!~%") target/trimmed))))
+
+             ;; Delete all boot entries and files we control.
+             (when (file-exists? schema)
+              (call-with-input-file schema
+                (lambda (port)
+                  (for-each (lambda (line)
+                              (unless (string-null? line)
+                                (false-if-exception
+                                 (invoke/quiet
+                                  efibootmgr
+                                  "--delete-bootnum"
+                                  "--label" line))))
+                            (string-split (get-string-all port) #\newline)))))
+             (when (file-exists? vendor-directory)
+               (delete-file-recursively vendor-directory))
+             (mkdir-p vendor-directory)
+
+             (define (install-uki port)
+               (lambda (args label name boot?)
+                 "Install NAME, an unified kernel image to be built with ARGS,
+to vendor-directory, add it to UEFI boot entries with LABEL, and append LABEL to
+PORT.  If BOOT? is #t, also add the created boot entry to boot order."
+                 (define image
+                   (uki-install-path name))
+
+                 (define (out-of-space-handler . _)
+                   (when (file-exists? image)
+                     (delete-file image))
+                   (unless (file-exists? (uki-install-path "0.efi"))
+                     (leave
+                      (G_ "no bootloader installed due to insuffcient space \
+either in '~a' or UEFI NVRAM.  Please DO NOT turn off your computer until a \
+bootloader is properly installed.~%")
+                      target/trimmed))
+                   (exit))
+
+                 (with-exception-handler out-of-space-handler
+                   (lambda ()
+                     (let ((minbytes (* 2 (stat:size (stat #$script-path)))))
+                       (apply invoke/quiet
+                              ukify
+                              "build"
+                              "--output" image
+                              args)
+                       ;; Although ‘install-uki.scm’ may not reside on the EFI
+                       ;; system partition, this test can still be utilized to
+                       ;; ensure there's space left for writing to the schema
+                       ;; file.
+                       (when (< (free-disk-space vendor-directory) minbytes)
+                         (raise-exception 'insuffcient-disk-space))
+                       ;; Fails when no space left in NVRAM.
+                       (invoke/quiet efibootmgr
+                                     (if boot? "--create" "--create-only")
+                                     "--label" label
+                                     "--disk" disk
+                                     "--loader" (uki-efi-path name))
+                       ;; This part is harder to discard, so put it to the last
+                       ;; where all errors are handled.
+                       (put-string port label)
+                       (put-char port #\newline))))))
+
+             (call-with-output-file schema
+               (lambda (port)
+                 (for-each
+                  (install-uki port)
+                  (list #$@(map-in-order menu-entry->ukify-args all-entries))
+                  '#$(map-in-order menu-entry-label all-entries)
+                  '#$(enumerate-uki-filenames all-entries)
+                  '#$(append
+                      (map (const #t) entries)
+                      (map (const #f) old-entries)))))))))))
+
+(define install-uefi-uki
+  #~(lambda (bootloader target mount-point)
+      (invoke (string-append mount-point #$script-path)
+              (string-append mount-point target))))
+
+;; ‘configuration-file’ here is actually an activation script to be invoked by
+;; ‘installer’.
+;; FIXME: Not expected by ‘reinstall-bootloader’ in (guix scripts system).
+(define uefi-uki-bootloader
+  (bootloader
+   (name 'uefi-uki)
+   (package systemd-stub)
+   (installer install-uefi-uki)
+   (disk-image-installer #f)
+   (configuration-file script-path)
+   (configuration-file-generator (uefi-uki-configuration-file))))
+
+;; FIXME: Breaks ‘reinstall-bootloader’.
+;; ‘cert’ and ‘privkey’ are not provided to boot parameters.
+(define (uefi-uki-signed-bootloader cert privkey)
+  (bootloader
+   (inherit uefi-uki-bootloader)
+   (name 'uefi-uki-signed)
+   (configuration-file-generator (uefi-uki-configuration-file cert privkey))))
diff --git a/modules/ryan-packages/bootloaders.scm b/modules/ryan-packages/bootloaders.scm
new file mode 100644
index 0000000..38f7438
--- /dev/null
+++ b/modules/ryan-packages/bootloaders.scm
@@ -0,0 +1,117 @@
+(define-module (ryan-packages bootloaders)
+               #:use-module ((guix licenses) #:prefix license:)
+               #:use-module (guix gexp)
+               #:use-module (guix packages)
+               #:use-module (guix git-download)
+               #:use-module (guix utils)
+               #:use-module (gnu packages base)
+               #:use-module (gnu packages efi)
+               #:use-module (gnu packages gperf)
+               #:use-module (gnu packages linux)
+               #:use-module (gnu packages pkg-config)
+               #:use-module (gnu packages python)
+               #:use-module (gnu packages python-crypto)
+               #:use-module (gnu packages python-xyz)
+               #:use-module (guix build-system python)
+               #:use-module (guix build-system meson))
+
+(define systemd-version "256.1")
+(define systemd-source
+  (origin
+    (method git-fetch)
+    (uri (git-reference
+           (url "https://github.com/systemd/systemd")
+           (commit (string-append "v" systemd-version))))
+    (file-name (git-file-name "systemd" systemd-version))
+    (sha256
+      (base32
+        "0hjpwmap8vsf0dbpad9rzd2jh02mj0cw6w13ag3j2k61wj2nmlnc"))))
+
+(define-public (systemd-stub-name)
+  (let ((arch (cond ((target-x86-32?) "ia32")
+                    ((target-arm32?) "arm")
+                    ((target-x86-64?) "x64")
+                    ((target-aarch64?) "aa64")
+                    ((target-riscv64?) "riscv64"))))
+    (string-append "linux" arch ".efi.stub")))
+
+(define-public systemd-stub
+  (package
+    (name "systemd-stub")
+    (version systemd-version)
+    (source systemd-source)
+    (build-system meson-build-system)
+    (arguments
+      (list
+        #:configure-flags
+        `(list "-Defi=true" "-Dsbat-distro=guix"
+               "-Dsbat-distro-generation=1"
+               "-Dsbat-distro-summary=Guix System"
+               "-Dsbat-distro-url=https://guix.gnu.org"
+               ,(string-append "-Dsbat-distro-pkgname=" name)
+               ,(string-append "-Dsbat-distro-version=" version))
+        #:phases
+        #~(let ((stub #$(string-append "src/boot/efi/" (systemd-stub-name))))
+            (modify-phases %standard-phases
+              (replace 'build
+                (lambda* (#:key parallel-build? #:allow-other-keys)
+                  (invoke "ninja" stub
+                    "-j" (if parallel-build?
+                           (number->string (parallel-job-count)) "1"))))
+              (replace 'install
+                (lambda _
+                  (install-file stub (string-append #$output "/libexec"))))
+              (delete 'check)))))
+    (inputs
+      (list libcap
+            python-pyelftools
+            `(,util-linux "lib"))) ; FIXME - there's a better way to do this
+    (native-inputs
+      (list gperf
+            pkg-config
+            python-3
+            python-jinja2))
+    (home-page "https://systemd.io/")
+    (synopsis "Unified Kernel Image UEFI Stub")
+    (description "Simple UEFI boot stub that loads a kernel image + supporting data to proper locations, then chainloads kernel.")
+    (license license:lgpl2.1+)))
+
+(define-public ukify
+  (package
+    (name "ukify")
+    (version systemd-version)
+    (source systemd-source)
+    (build-system python-build-system)
+    (arguments
+      (list #:phases
+            #~(modify-phases %standard-phases
+                (replace 'build
+                  (lambda _
+                    (substitute* "src/ukify/ukify.py"
+                      (("datetime\\.UTC") "datetime.timezone.utc"))))
+                (delete 'check)
+                ;; below is becaue of system-error "utime" "~A" ("No such file or directory")
+                (delete 'ensure-no-mtimes-pre-1980)
+                (replace 'install
+                  (lambda* (#:key inputs #:allow-other-keys)
+                    (let* ((bin (string-append #$output "/bin"))
+                           (file (string-append bin "/ukify"))
+                           (binutils (assoc-ref inputs "binutils"))
+                           (sbsign (assoc-ref inputs "sbsigntools")))
+                      (mkdir-p bin)
+                      (copy-file "src/ukify/ukify.py" file)
+                      (wrap-program file
+                        `("PATH" ":" prefix
+                          (,(string-append binutils "/bin")
+                           ,(string-append sbsign "/bin"))))))))))
+    (inputs
+      (list binutils
+            python-cryptography
+            python-pefile
+            sbsigntools))
+    (home-page "https://systemd.io/")
+    (synopsis "UKI UEFI Tool")
+    (description "Joins a UKI stub, kernel, initrd, kernel args, and signatures into a single UEFI compatible image.")
+    (license license:lgpl2.1+)))
+
+systemd-stub