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

[Maxime Devos]

Leo Prikler schreef op do 05-08-2021 om 14:04 [+0200]:
> > +mods, which consists of copying lua code, images and other resources
> > to
> s/lua/Lua/ :)

Fixed.

> > +(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))
> @@ is a code smell, as far as Guix is concerned.  Rather import copy-
> build-system with the copy: prefix.

'copy-build-system' does not export 'install', so I have to use '@@' here.
Modifying 'copy-build-system' to export 'install' would presumably entail
a many rebuilds.

> > +(define png-file?
> > +  ((@@ (guix build utils) file-header-match) %png-magic-bytes))
> Likewise import (guix build utils) directly.

Likewise.

> > +(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))))))

> This appears a little confusing.  On first glance, it does not seem to
> allow overriding e.g. #:phases, but on a second look using `apply'
> together with shallowly substituted arguments would enable that. 

I modified the patch to move more things into 'substitute-keyword-arguments'
to reduce confusion.

>  The
> only thing that's missing imo is that #:implicit-inputs? is not
> honoured for (standard-minetest-packages) -- I think you might want to
> rectify that.

I modified 'lower-mod' to _not_ add 'standard-minetest-packages' to
'native-inputs' when #:implicit-inputs? is false, though I don't see
why a package definition for a Minetest mod would do that.

I also found a spellig bug ("to minimisation" -> "to minimise") which
is now fixed.

btw, I submitted the "MINETEST_MOD_PATH" patch upstream, with your suggestion
for "{std::string(...)}" construction:
<https://github.com/minetest/minetest/pull/11515>.

Greetings,
Maxime.

From dbd9cf53d359b461c01176e3170ba0663ce9007c 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       |  99 ++++++++++++
 guix/build/minetest-build-system.scm | 220 +++++++++++++++++++++++++++
 4 files changed, 329 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..d44ecc2005 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..98bcbc9e0c
--- /dev/null
+++ b/guix/build-system/minetest.scm
@@ -0,0 +1,99 @@
+;;; 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 #:key (implicit-inputs? #t) #:allow-other-keys
+                    #:rest arguments)
+  (define lower (build-system-lower gnu-build-system))
+  (apply lower
+         name
+         (substitute-keyword-arguments arguments
+           ;; minetest-mod-build-system adds implicit inputs by itself,
+           ;; so don't let gnu-build-system add its own implicit inputs
+           ;; as well.
+           ((#:implicit-inputs? implicit-inputs? #t)
+            #f)
+           ((#:imported-modules imported-modules 
%minetest-build-system-modules)
+            imported-modules)
+           ((#:modules modules %default-modules)
+            modules)
+           ((#:phases phases '%standard-phases)
+            phases)
+           ;; Mods are architecture-independent.
+           ((#:target target #f) #f)
+           ;; Ensure nothing sneaks into the closure.
+           ((#:allowed-references allowed-references '())
+            allowed-references)
+           ;; Add the implicit inputs.
+           ((#:native-inputs native-inputs '())
+            (if implicit-inputs?
+                (append native-inputs (standard-minetest-packages))
+                native-inputs)))))
+
+(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..e9eb491b1b
--- /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 minimise."))
+          (#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