From 5f89f45e7465ebbdc84c925ea3cfaec5dd06ed88 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 8 Apr 2024 16:04:20 +0200
Subject: [PATCH] linux-initrd: Further strip the static Guile.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

‘guile-static-initrd’ weighs in at 46 MiB, compared to 54 MiB for
‘guile-static-stripped’ (15% reduction).

* gnu/packages/make-bootstrap.scm (make-guile-static-stripped): Add
‘directories-to-remove’ parameter and honor it.
(%guile-static-initrd): New variable.
* gnu/system/linux-initrd.scm (expression->initrd): Default to
‘%guile-static-initrd’.
* doc/guix.texi (Initial RAM Disk): Adjust accordingly.

Change-Id: I2baf06fed7a3698433e7c83b1d7726054a8c746e
---
 doc/guix.texi                   |  2 +-
 gnu/packages/make-bootstrap.scm | 37 ++++++++++++++++++++++++++++-----
 gnu/system/linux-initrd.scm     |  4 ++--
 3 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5d3c9225b4..3f5d4e7f0d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41435,7 +41435,7 @@ program.  That gives a lot of flexibility.  The
 program to run in that initrd.
 
 @deffn {Procedure} expression->initrd exp @
-       [#:guile %guile-static-stripped] [#:name "guile-initrd"]
+       [#:guile %guile-static-initrd] [#:name "guile-initrd"]
 Return as a file-like object a Linux initrd (a gzipped cpio archive)
 containing @var{guile} and that evaluates @var{exp}, a G-expression,
 upon booting.  All the derivations referenced by @var{exp} are
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 7b40f395f3..4dd45a4a27 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018, 2019 Mark H Weaver <mhw@netris.org>
@@ -55,7 +55,8 @@
             %guile-bootstrap-tarball
             %bootstrap-tarballs
 
-            %guile-static-stripped))
+            %guile-static-stripped
+            %guile-static-initrd))
 
 ;;; Commentary:
 ;;;
@@ -674,7 +675,8 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
                        "guile-3.0-linux-syscalls.patch"
                        "guile-3.0-relocatable.patch")))
 
-(define* (make-guile-static-stripped static-guile)
+(define* (make-guile-static-stripped static-guile
+                                     #:optional (directories-to-remove '()))
   (package
     (inherit static-guile)
     (name (string-append (package-name static-guile) "-stripped"))
@@ -702,6 +704,12 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
                  (mkdir (string-append out "/bin"))
                  (copy-file guile1 guile2)
 
+                 ;; Optionally remove additional directories.
+                 (for-each (lambda (directory)
+                             (delete-file-recursively
+                              (string-append out "/" directory)))
+                           '#$directories-to-remove)
+
                  ;; Verify that the relocated Guile works.
                  #$@(if (%current-target-system)
                         '()
@@ -720,10 +728,29 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
     (synopsis "Minimal statically-linked and relocatable Guile")))
 
 (define %guile-static-stripped
-  ;; A stripped static Guile 3.0 binary, for use in initrds
-  ;; and during bootstrap.
+  ;; A stripped static Guile 3.0 binary for use during bootstrap.
   (make-guile-static-stripped %guile-static-3.0))
 
+(define %guile-static-initrd
+  ;; A stripped static Guile 3.0 binary for use in initrds.  Remove various
+  ;; modules that are useless in an initrd.  Note: Keep most of language/
+  ;; because it is needed for Bournish.
+  (package
+    (inherit
+     (make-guile-static-stripped
+      %guile-static-3.0
+      (append-map (lambda (directory)
+                    (list (string-append "lib/guile/3.0/ccache/" directory)
+                          (string-append "share/guile/3.0/" directory)))
+                  '("language/brainfuck"
+                    "language/ecmascript"
+                    "language/elisp"
+                    "oop"
+                    "scripts"
+                    "texinfo"
+                    "web"))))
+    (name "guile-static-initrd")))
+
 (define (tarball-package pkg)
   "Return a package containing a tarball of PKG."
   (package
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 40ff2dc808..d448c78918 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -36,7 +36,7 @@
   #:use-module ((gnu packages xorg)
                 #:select (console-setup xkeyboard-config))
   #:use-module ((gnu packages make-bootstrap)
-                #:select (%guile-static-stripped))
+                #:select (%guile-static-initrd))
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
   #:use-module (gnu system keyboard)
@@ -62,7 +62,7 @@
 
 (define* (expression->initrd exp
                              #:key
-                             (guile %guile-static-stripped)
+                             (guile %guile-static-initrd)
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system)))