From patchwork Thu Aug 5 14:41:09 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 31847 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 33C9527BC78; Thu, 5 Aug 2021 15:42:13 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id E890127BC6B for ; Thu, 5 Aug 2021 15:42:11 +0100 (BST) Received: from localhost ([::1]:33554 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mBeZW-0000rs-TJ for patchwork@mira.cbaines.net; Thu, 05 Aug 2021 10:42:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59562) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mBeZP-0000p4-0b for guix-patches@gnu.org; Thu, 05 Aug 2021 10:42:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36493) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mBeZO-0006cM-PJ for guix-patches@gnu.org; Thu, 05 Aug 2021 10:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mBeZO-0007tD-FR for guix-patches@gnu.org; Thu, 05 Aug 2021 10:42:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49828] [PATCH 05/20] build-system: minetest: Don't retain references to "bash-minimal". Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Aug 2021 14:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49828 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Leo Prikler , 49828@debbugs.gnu.org Received: via spool by 49828-submit@debbugs.gnu.org id=B49828.162817449630295 (code B ref 49828); Thu, 05 Aug 2021 14:42:02 +0000 Received: (at 49828) by debbugs.gnu.org; 5 Aug 2021 14:41:36 +0000 Received: from localhost ([127.0.0.1]:48039 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBeYu-0007sT-2p for submit@debbugs.gnu.org; Thu, 05 Aug 2021 10:41:35 -0400 Received: from michel.telenet-ops.be ([195.130.137.88]:39922) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBeYq-0007sH-Ny for 49828@debbugs.gnu.org; Thu, 05 Aug 2021 10:41:30 -0400 Received: from ptr-bvsjgyjmffd7q9timvx.18120a2.ip6.access.telenet.be ([IPv6:2a02:1811:8c09:9d00:aaf1:9810:a0b8:a55d]) by michel.telenet-ops.be with bizsmtp id dqhG2500G0mfAB406qhSZW; Thu, 05 Aug 2021 16:41:27 +0200 Message-ID: From: Maxime Devos Date: Thu, 05 Aug 2021 16:41:09 +0200 In-Reply-To: <1a63353207ea0cbccaaf3138d42148fe5a98da62.camel@student.tugraz.at> References: <20210802155019.6122-1-maximedevos@telenet.be> <20210802155019.6122-5-maximedevos@telenet.be> <60c5062a7debff22cee27198c2548605fd7441e0.camel@student.tugraz.at> <265c85f914757066aee6b6933ba58bf1abd2bc84.camel@telenet.be> <8d13a1057f368f47eef8da538c554a379892cacc.camel@student.tugraz.at> <7680df67d8be80c1d55771407256c28b76e0d836.camel@telenet.be> <2a49c566e1ecc280db79bcda1e893547216dd83a.camel@student.tugraz.at> <8a8699af5e530cff4bab22aad4e5fa1862ebffc7.camel@telenet.be> <1a63353207ea0cbccaaf3138d42148fe5a98da62.camel@student.tugraz.at> User-Agent: Evolution 3.34.2 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r21; t=1628174487; bh=AJ9qOhW9EY2XcZxsENbiiURyjhqRMqZIQu247VoPoEk=; h=Subject:From:To:Date:In-Reply-To:References; b=r4wteKYoPfKJCzfPUlc/2PaBk8tfCC+2MZJmW2Rj0pghXxEnXJ6Y1DLcYeyrEdZ4y cwzqb/In7h2avQiw4HnDmdOYyMYKngYCdfmLDMu86kClojeUnV00R/OT+Lu0zKSNzs XOIC6k9OiZfYgycMAz5FSuJ8DGdfqbYd57zO6CT210FYz2I0yyPVGpbFRVxdbvI57F 7QxEBVynIq4VBq8Lvr8x1JX21mz81J8ZQr01hyNkAURSsoffearDwPhMYunhAEtNKY qR1zGy4ezqqE665SwwsWbG9T7ckIq0wWuiC8ceUFpcYlOmhECmTpeZV7+bYeeipiHV 79bp8t4Y6AuGQ== 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: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Leo Prikler schreef op do 05-08-2021 om 15:42 [+0200]: > Am Donnerstag, den 05.08.2021, 15:16 +0200 schrieb Maxime Devos: > > [...] > > > > +(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. > I think the thing that's usually done here is fetching through > %standard-phases. > I.e. (define copy:install (assoc-ref copy-build-system:%standard-phases > 'install)) Done. > > > > +(define png-file? > > > > + ((@@ (guix build utils) file-header-match) %png-magic-bytes)) > > > Likewise import (guix build utils) directly. > > > > Likewise. > In that case fine, but make a note to move the variable and procedure > over to (guix build utils). I made a note. > The new lower-mod mostly LGTM, but > > + ;; Mods are architecture-independent. > > + ((#:target target #f) #f) > should be `target' imho. What if the mod e.g. actually builds a shared > object and somehow uses Lua's very dynamic FFI to load it? (Even if > that's not currently possible, it might be in the future). Setting it > to #f by default OTOH sounds very reasonable to me. 'target' is set by 'make-bag' in (guix build-system), so if the code above is made ((#:target target #f) target) then #:target will always be set to some triplet. Mostly harmless, but a bit a waste of disk space since this leads to (slightly) different derivations depending on the value of "target". I don't think any mods use Lua's FFI, but some mods use 'os.execute', which takes a file name referring to an executable, which might need to be absolutised in Guix, and therefore some mods are architecture-dependent. It dropped the ((#:target target #f) #f). I noticed "#:implicit-cross-inputs?" wasn't set to #f. That has been corrected as well. Greetings, Maxime. From 93aa8e1976e762d30be70aef6d5c50b1d06ca4be Mon Sep 17 00:00:00 2001 From: Maxime Devos 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 | 225 +++++++++++++++++++++++++++ 4 files changed, 334 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..f33e97559d --- /dev/null +++ b/guix/build-system/minetest.scm @@ -0,0 +1,99 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Maxime Devos +;;; +;;; 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 . + +(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) + ((#:implicit-cross-inputs? implicit-cross-inputs? #t) + #f) + ((#:imported-modules imported-modules %minetest-build-system-modules) + imported-modules) + ((#:modules modules %default-modules) + modules) + ((#:phases phases '%standard-phases) + phases) + ;; 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..b051d9c288 --- /dev/null +++ b/guix/build/minetest-build-system.scm @@ -0,0 +1,225 @@ +;;; Copyright © 2021 Maxime Devos +;;; +;;; 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 . + +(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:) + #:use-module ((guix build copy-build-system) #:prefix copy:) + #:export (%standard-phases + mod-install-plan minimise-png read-mod-name check)) + +;; (guix build copy-build-system) does not export 'install'. +(define copy:install + (assoc-ref copy:%standard-phases 'install)) + +(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 + ;; 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 copy: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 . + #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 + ;; . + (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