[bug#49828] [PATCH 05/20] build-system: minetest: Don't retain references to "bash-minimal".

[Maxime Devos]

Hi,

The attached patch squashes "PATCH 04" and "PATCH 05" together
and extends the build system.  It now has an install plan only installing
what's necessary (Lua code, PNG images, some configuration files ...),
a 'check' build phase verifying Minetest can actually load the mod,
and a 'minimise-png' phase minimising PNG images.

The mod name for ‘(("." "share/minetest/mods/the-mod-name"))’ can now
be determined exactly in most cases (Minetest doesn't really care but
the directory name can appear in the GUI in some cases).

Greetings,
Maxime.

From e21ef78f6fdfd6d3952b2cc4f0fb1fa8b59ae5e1 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 31 Jul 2021 13:52:39 +0200
Subject: [PATCH] build-system: Add 'minetest-mod-build-system'.

* guix/build-system/minetest.scm: New module.
* guix/build/minetest-build-system.scm: Likewise.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Build Systems): Document 'minetest-mod-build-system'.
---
 Makefile.am                          |   2 +
 doc/guix.texi                        |   8 +
 guix/build-system/minetest.scm       |  87 +++++++++++
 guix/build/minetest-build-system.scm | 220 +++++++++++++++++++++++++++
 4 files changed, 317 insertions(+)
 create mode 100644 guix/build-system/minetest.scm
 create mode 100644 guix/build/minetest-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index d5ec909213..f4439ce93b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -141,6 +141,7 @@ MODULES =                                   \
   guix/build-system/go.scm                     \
   guix/build-system/meson.scm                  \
   guix/build-system/minify.scm                 \
+  guix/build-system/minetest.scm               \
   guix/build-system/asdf.scm                   \
   guix/build-system/copy.scm                   \
   guix/build-system/glib-or-gtk.scm            \
@@ -203,6 +204,7 @@ MODULES =                                   \
   guix/build/gnu-dist.scm                      \
   guix/build/guile-build-system.scm            \
   guix/build/maven-build-system.scm            \
+  guix/build/minetest-build-system.scm         \
   guix/build/node-build-system.scm             \
   guix/build/perl-build-system.scm             \
   guix/build/python-build-system.scm           \
diff --git a/doc/guix.texi b/doc/guix.texi
index b3c16e6507..f7dba4f293 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7895,6 +7895,14 @@ declaration.  Its default value is 
@code{(default-maven-plugins)} which is
 also exported.
 @end defvr
 
+@defvr {Scheme Variable} minetest-mod-build-system
+This variable is exported by @code{(guix build-system minetest)}.  It
+implements a build procedure for @uref{https://www.minetest.net, Minetest}
+mods, which consists of copying lua code, images and other resources to
+the location Minetest searches for mods.  The build system also minimises
+PNG images and verifies that Minetest can load the mod without errors.
+@end defvr
+
 @defvr {Scheme Variable} minify-build-system
 This variable is exported by @code{(guix build-system minify)}.  It
 implements a minification procedure for simple JavaScript packages.
diff --git a/guix/build-system/minetest.scm b/guix/build-system/minetest.scm
new file mode 100644
index 0000000000..e99cc411c9
--- /dev/null
+++ b/guix/build-system/minetest.scm
@@ -0,0 +1,87 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system minetest)
+  #:use-module (guix build-system copy)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system)
+  #:use-module (guix utils)
+  #:export (minetest-mod-build-system))
+
+;;
+;; Build procedure for minetest mods.  This is implemented as an extension
+;; of ‘copy-build-system’.
+;;
+;; Code:
+
+;; Lazily resolve the bindings to avoid circular dependencies.
+(define (default-optipng)
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (module-ref (resolve-interface '(gnu packages image)) 'optipng))
+
+(define (default-minetest)
+  (module-ref (resolve-interface '(gnu packages games)) 'minetest))
+
+(define (default-xvfb-run)
+  (module-ref (resolve-interface '(gnu packages xorg)) 'xvfb-run))
+
+(define %minetest-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build minetest-build-system)
+    ,@%copy-build-system-modules))
+
+(define %default-modules
+  ;; Modules in scope in the build-side environment.
+  '((guix build gnu-build-system)
+    (guix build minetest-build-system)
+    (guix build utils)))
+
+(define (standard-minetest-packages)
+  "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
+standard packages used as implicit inputs of the Minetest build system."
+  `(("xvfb-run" ,(default-xvfb-run))
+    ("optipng" ,(default-optipng))
+    ("minetest" ,(default-minetest))
+    ,@(filter (lambda (input)
+                (member (car input)
+                        '("libc" "tar" "gzip" "bzip2" "xz" "locales")))
+              (standard-packages))))
+
+(define (lower-mod name . arguments)
+  (define lower (build-system-lower gnu-build-system))
+  (apply lower
+         name
+         #:imported-modules %minetest-build-system-modules
+         #:modules %default-modules
+         #:phases '%standard-phases
+         #:implicit-inputs? #f
+         ;; Mods are architecture-independent.
+         #:target #f
+         ;; Ensure nothing sneaks into the closure.
+         #:allowed-references '()
+         (substitute-keyword-arguments arguments
+           ((#:native-inputs native-inputs '())
+            (append native-inputs (standard-minetest-packages))))))
+
+(define minetest-mod-build-system
+  (build-system
+    (name 'minetest-mod)
+    (description "The build system for minetest mods")
+    (lower lower-mod)))
+
+;;; minetest.scm ends here
diff --git a/guix/build/minetest-build-system.scm 
b/guix/build/minetest-build-system.scm
new file mode 100644
index 0000000000..e0c11e91f6
--- /dev/null
+++ b/guix/build/minetest-build-system.scm
@@ -0,0 +1,220 @@
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build minetest-build-system)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:export (%standard-phases
+            mod-install-plan minimise-png read-mod-name check))
+
+(define (mod-install-plan mod-name)
+  `(("." ,(string-append "share/minetest/mods/" mod-name)
+     ;; Only install files that will actually be used at run time.
+     ;; This can save a little disk space.
+     ;;
+     ;; See <https://github.com/minetest/minetest/blob/master/doc/lua_api.txt>
+     ;; for an incomple list of files that can be found in mods.
+     #:include ("mod.conf" "modpack.conf" "settingtypes.txt" "depends.txt"
+                "description.txt")
+     #:include-regexp (".lua$" ".png$" ".ogg$" ".obj$" ".b3d$" ".tr$"
+                       ".mts$"))))
+
+(define* (guess-mod-name #:key inputs #:allow-other-keys)
+  "Try to determine the name of the mod or modpack that is being built.
+If it is unknown, make an educated guess."
+  ;; Minetest doesn't care about the directory names in "share/minetest/mods"
+  ;; so there is no technical problem if the directory names don't match
+  ;; the mod names.  The directory can appear in the GUI if the modpack
+  ;; doesn't have the 'name' set though, so try to make the guess.
+  (define (guess)
+    (let* ((source (assoc-ref inputs "source"))
+           (file-name (basename source))
+           ;; The "minetest-" prefix is not informative, so strip it.
+           (file-name (if (string-prefix? "minetest-" file-name)
+                          (substring file-name (string-length "minetest-"))
+                          file-name))
+           ;; Strip "-checkout" suffixes of git checkouts.
+           (file-name (if (string-suffix? "-checkout" file-name)
+                          (substring file-name
+                                     0
+                                     (- (string-length file-name)
+                                        (string-length "-minetest")))
+                          file-name))
+           (first-dot (string-index file-name #\.))
+           ;; If the source code is in an archive (.tar.gz, .zip, ...),
+           ;; strip the extension.
+           (file-name (if first-dot
+                          (substring file-name 0 first-dot)
+                          file-name)))
+      (format (current-error-port)
+              "warning: the modpack ~a did not set 'name' in 'modpack.conf'~%"
+              file-name)
+      file-name))
+  (cond ((file-exists? "mod.conf")
+         (read-mod-name "mod.conf"))
+        ((file-exists? "modpack.conf")
+         (read-mod-name "modpack.conf" guess))
+        (#t (guess))))
+
+(define* (install #:key inputs #:allow-other-keys #:rest arguments)
+  (apply (@@ (guix build copy-build-system) install)
+         #:install-plan (mod-install-plan (apply guess-mod-name arguments))
+         arguments))
+
+(define %png-magic-bytes
+  ;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
+  ;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
+  ;; on <https://www.w3.org/TR/PNG/>.
+  #vu8(137 80 78 71 13 10 26 10))
+
+(define png-file?
+  ((@@ (guix build utils) file-header-match) %png-magic-bytes))
+
+(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
+  "Minimise PNG images found in the working directory."
+  (define optipng (which "optipng"))
+  (define (optimise image)
+    (format #t "Optimising ~a~%" image)
+    (make-file-writable (dirname image))
+    (make-file-writable image)
+    (define old-size (stat:size (stat image)))
+    ;; The mod "technic" has a file "technic_music_player_top.png" that
+    ;; actually is a JPEG file, see
+    ;; <https://github.com/minetest-mods/technic/issues/590>.
+    (if (png-file? image)
+        (invoke optipng "-o4" "-quiet" image)
+        (format #t "warning: skipping ~a because it's not actually a PNG 
image~%"
+                image))
+    (define new-size (stat:size (stat image)))
+    (values old-size new-size))
+  (define files (find-files "." ".png$"))
+  (let loop ((total-old-size 0)
+             (total-new-size 0)
+             (images (find-files "." ".png$")))
+    (cond ((pair? images)
+           (receive (old-size new-size)
+               (optimise (car images))
+             (loop (+ total-old-size old-size)
+                   (+ total-new-size new-size)
+                   (cdr images))))
+          ((= total-old-size 0)
+           (format #t "There were no PNG images to minimisation."))
+          (#t
+           (format #t "Minimisation reduced size of images by ~,2f% (~,2f MiB 
to ~,2f MiB)~%"
+                   (* 100.0 (- 1 (/ total-new-size total-old-size)))
+                   (/ total-old-size (expt 1024 2))
+                   (/ total-new-size (expt 1024 2)))))))
+
+(define name-regexp (make-regexp "^name[ ]*=(.+)$"))
+
+(define* (read-mod-name mod.conf #:optional not-found)
+  "Read the name of a mod from MOD.CONF.  If MOD.CONF
+does not have a name field and NOT-FOUND is #false, raise an
+error.  If NOT-FOUND is TRUE, call NOT-FOUND instead."
+  (call-with-input-file mod.conf
+    (lambda (port)
+      (let loop ()
+        (define line (read-line port))
+        (if (eof-object? line)
+            (if not-found
+                (not-found)
+                (error "~a does not have a 'name' field" mod.conf))
+            (let ((match (regexp-exec name-regexp line)))
+              (if (regexp-match? match)
+                  (string-trim-both (match:substring match 1) #\ )
+                  (loop))))))))
+
+(define* (check #:key outputs tests? #:allow-other-keys)
+  "Test whether the mod loads.  The mod must first be installed first."
+  (define (all-mod-names directories)
+    (append-map
+     (lambda (directory)
+       (map read-mod-name (find-files directory "mod.conf")))
+     directories))
+  (when tests?
+    (mkdir "guix_testworld")
+    ;; Add the mod to the mod search path, such that Minetest can find it.
+    (setenv "MINETEST_MOD_PATH"
+            (list->search-path-as-string
+             (cons
+              (string-append (assoc-ref outputs "out") "/share/minetest/mods")
+              (search-path-as-string->list
+               (or (getenv "MINETEST_MOD_PATH") "")))
+             ":"))
+    (with-directory-excursion "guix_testworld"
+      (setenv "HOME" (getcwd))
+      ;; Create a world in which all mods are loaded.
+      (call-with-output-file "world.mt"
+        (lambda (port)
+          (display
+           "gameid = minetest
+world_name = guix_testworld
+backend = sqlite3
+player_backend = sqlite3
+auth_backend = sqlite3
+" port)
+          (for-each
+           (lambda (mod)
+             (format port "load_mod_~a = true~%" mod))
+           (all-mod-names (search-path-as-string->list
+                           (getenv "MINETEST_MOD_PATH"))))))
+      (receive (port pid)
+          ((@@ (guix build utils) open-pipe-with-stderr)
+           "xvfb-run" "--" "minetest" "--info" "--world" "." "--go")
+        (format #t "Started Minetest with all mods loaded for testing~%")
+        ;; Scan the output for error messages.
+        ;; When the player has joined the server, stop minetest.
+        (define (error? line)
+          (and (string? line)
+               (string-contains line ": ERROR[")))
+        (define (stop? line)
+          (and (string? line)
+               (string-contains line "ACTION[Server]: singleplayer [127.0.0.1] 
joins game.")))
+        (let loop ()
+          (match (read-line port)
+            ((? error? line)
+             (error "minetest raised an error: ~a" line))
+            ((? stop?)
+             (kill pid SIGINT)
+             (close-port port)
+             (waitpid pid))
+            ((? string? line)
+             (display line)
+             (newline)
+             (loop))
+            ((? eof-object?)
+             (error "minetest didn't start"))))))))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'bootstrap)
+    (delete 'configure)
+    (add-before 'build 'minimise-png minimise-png)
+    (delete 'build)
+    (delete 'check)
+    (replace 'install install)
+    ;; The 'check' phase requires the mod to be installed,
+    ;; so move the 'check' phase after the 'install' phase.
+    (add-after 'install 'check check)))
+
+;;; minetest-build-system.scm ends here
-- 
2.32.0

signature.asc
Description: This is a digitally signed message part