From d128c6fd33f46ec4e2d0ef352d20a858c377bf6f Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 12 Aug 2021 12:58:34 +0200 Subject: services: cuirass: Add a no-publish argument. * gnu/services/cuirass.scm (): Add a no-publish? field. (cuirass-shepherd-service): Honor it. * doc/guix.texi (Cuirass remote building): Document it. --- doc/guix.texi | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 4eb5324b51..ac6c11949f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -27889,6 +27889,11 @@ Use @var{cache} directory to cache build log files. Once a substitute is successfully fetched, trigger substitute baking at @var{trigger-url}. +@item @code{no-publish} (default: @code{#f}) +Do not start a publish server and ignore the @code{publish-port} +argument. This can be useful if there is already a standalone publish +server standing next to the remote server. + @item @code{public-key} @item @code{private-key} Use the specific @var{file}s as the public/private key pair used to sign -- cgit 1.4.1 From 23b5b168ae95aed04cbaa0598449361af3423688 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 12 Aug 2021 14:23:41 +0200 Subject: services: cuirass: Add a substitute-urls argument. * gnu/services/cuirass.scm (): Add a substitute-urls field. (cuirass-remote-worker-shepherd-service): Honor it. * doc/guix.texi (Cuirass remote building): Document it. --- doc/guix.texi | 3 +++ gnu/services/cuirass.scm | 10 +++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index ac6c11949f..78c1c09858 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -27928,6 +27928,9 @@ Location of the log file. @item @code{publish-port} (default: @code{5558}) The TCP port of the publish server. It defaults to @code{5558}. +@item @code{substitute-urls} (default: @code{%default-substitute-urls}) +The list of URLs where to look for substitutes by default. + @item @code{public-key} @item @code{private-key} Use the specific @var{file}s as the public/private key pair used to sign diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index f0df5a6824..4d4f81a3a8 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -25,6 +25,7 @@ #:use-module (guix channels) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (guix store) #:use-module (guix utils) #:use-module (gnu packages admin) #:use-module (gnu packages ci) @@ -338,6 +339,8 @@ (default "/var/log/cuirass-remote-worker.log")) (publish-port cuirass-remote-worker-configuration-publish-port ;int (default 5558)) + (substitute-urls cuirass-remote-worker-configuration-substitute-urls + (default %default-substitute-urls)) ;list of strings (public-key cuirass-remote-worker-configuration-public-key ;string (default #f)) (private-key cuirass-remote-worker-configuration-private-key ;string @@ -348,7 +351,7 @@ CONFIG." (match-record config (cuirass workers server systems log-file publish-port - public-key private-key) + substitute-urls public-key private-key) (list (shepherd-service (documentation "Run Cuirass remote build worker.") (provision '(cuirass-remote-worker)) @@ -371,6 +374,11 @@ CONFIG." "--publish-port=" (number->string publish-port))) '()) + #$@(if substitute-urls + (string-append + "--substitute-urls=" + (string-join substitute-urls)) + '()) #$@(if public-key (list (string-append "--public-key=" -- cgit 1.4.1 From cfd2442488971420289a12d5ca8f07816e1149bf Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 13 Aug 2021 13:44:06 +0200 Subject: services: cuirass: Reverse the no-publish logic. This is a follow-up of d128c6fd33f46ec4e2d0ef352d20a858c377bf6f. * gnu/services/cuirass.scm () [no-publish?]: Rename it to ... [publish?]: ... this new field. (cuirass-shepherd-service): Adapt it. * doc/guix.texi (Cuirass remote building): Document it. --- doc/guix.texi | 8 ++++---- gnu/services/cuirass.scm | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 78c1c09858..6ba52623c0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -27889,10 +27889,10 @@ Use @var{cache} directory to cache build log files. Once a substitute is successfully fetched, trigger substitute baking at @var{trigger-url}. -@item @code{no-publish} (default: @code{#f}) -Do not start a publish server and ignore the @code{publish-port} -argument. This can be useful if there is already a standalone publish -server standing next to the remote server. +@item @code{publish?} (default: @code{#t}) +If set to false, do not start a publish server and ignore the +@code{publish-port} argument. This can be useful if there is already a +standalone publish server standing next to the remote server. @item @code{public-key} @item @code{private-key} diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 34564b3894..83e63fe79c 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -73,8 +73,8 @@ (default "/var/log/cuirass-remote-server.log")) (cache cuirass-remote-server-configuration-cache ;string (default "/var/cache/cuirass/remote/")) - (no-publish? cuirass-remote-server-configuration-no-publish? ;boolean - (default #f)) + (publish? cuirass-remote-server-configuration-publish? ;boolean + (default #t)) (trigger-url cuirass-remote-server-trigger-url ;string (default #f)) (public-key cuirass-remote-server-configuration-public-key ;string @@ -194,7 +194,7 @@ (stop #~(make-kill-destructor))) ,@(if remote-server (match-record remote-server - (backend-port publish-port log-file cache no-publish? + (backend-port publish-port log-file cache publish? trigger-url public-key private-key) (list (shepherd-service @@ -228,9 +228,9 @@ "--trigger-substitute-url=" trigger-url)) '()) - #$@(if no-publish? - (list "--no-publish") - '()) + #$@(if publish? + '() + (list "--no-publish")) #$@(if public-key (list (string-append "--public-key=" -- cgit 1.4.1 From a0fd46304e42f1df711b001a7159160c8e26d21d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 15 Aug 2021 11:35:24 +0200 Subject: doc: Fix typo. * doc/guix-cookbook.texi (GUIX_PACKAGE_PATH): Fix typo in file name. Reported-by: breathein on IRC. --- doc/guix-cookbook.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 2e627ecc51..819dfd8dde 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -591,7 +591,7 @@ packages. Guix makes it possible to streamline the process by adding as many ``package declaration directories'' as you want. -Create a directory, say @file{~./guix-packages} and add it to the @samp{GUIX_PACKAGE_PATH} +Create a directory, say @file{~/guix-packages} and add it to the @samp{GUIX_PACKAGE_PATH} environment variable: @example -- cgit 1.4.1 From 94551439074f804f35970b08435aa02007edfb0b Mon Sep 17 00:00:00 2001 From: Christopher Lemmer Webber Date: Sun, 15 Aug 2021 14:15:37 -0400 Subject: Update copyright/name notices for Christine Lemmer-Webber. * doc/guix-cookbook.texi: Update copyright/name for Christine Lemmer-Webber. * gnu/build/image.scm: Likewise. * gnu/build/vm.scm: Likewise. * gnu/packages/admin.scm: Likewise. * gnu/packages/assembly.scm: Likewise. * gnu/packages/audio.scm: Likewise. * gnu/packages/backup.scm: Likewise. * gnu/packages/check.scm: Likewise. * gnu/packages/databases.scm: Likewise. * gnu/packages/emacs-xyz.scm: Likewise. * gnu/packages/finance.scm: Likewise. * gnu/packages/gnupg.scm: Likewise. * gnu/packages/guile-xyz.scm: Likewise. * gnu/packages/guile.scm: Likewise. * gnu/packages/haskell-xyz.scm: Likewise. * gnu/packages/linux.scm: Likewise. * gnu/packages/mail.scm: Likewise. * gnu/packages/password-utils.scm: Likewise. * gnu/packages/perl.scm: Likewise. * gnu/packages/python-web.scm: Likewise. * gnu/packages/python-xyz.scm: Likewise. * gnu/packages/python.scm: Likewise. * gnu/packages/sphinx.scm: Likewise. * gnu/packages/ssh.scm: Likewise. * gnu/packages/xdisorg.scm: Likewise. * gnu/services/networking.scm: Likewise. * gnu/system/vm.scm: Likewise. --- doc/guix-cookbook.texi | 2 +- gnu/build/image.scm | 2 +- gnu/build/vm.scm | 2 +- gnu/packages/admin.scm | 2 +- gnu/packages/assembly.scm | 2 +- gnu/packages/audio.scm | 2 +- gnu/packages/backup.scm | 2 +- gnu/packages/check.scm | 2 +- gnu/packages/databases.scm | 2 +- gnu/packages/emacs-xyz.scm | 2 +- gnu/packages/finance.scm | 2 +- gnu/packages/gnupg.scm | 2 +- gnu/packages/guile-xyz.scm | 2 +- gnu/packages/guile.scm | 2 +- gnu/packages/haskell-xyz.scm | 2 +- gnu/packages/linux.scm | 2 +- gnu/packages/mail.scm | 2 +- gnu/packages/password-utils.scm | 2 +- gnu/packages/perl.scm | 2 +- gnu/packages/python-web.scm | 2 +- gnu/packages/python-xyz.scm | 2 +- gnu/packages/python.scm | 2 +- gnu/packages/sphinx.scm | 2 +- gnu/packages/ssh.scm | 2 +- gnu/packages/xdisorg.scm | 2 +- gnu/services/networking.scm | 2 +- gnu/system/vm.scm | 2 +- 27 files changed, 27 insertions(+), 27 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 819dfd8dde..5b1b4b5ea9 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -16,7 +16,7 @@ Copyright @copyright{} 2020 Matthew Brooks@* Copyright @copyright{} 2020 Marcin Karpezo@* Copyright @copyright{} 2020 Brice Waegeneire@* Copyright @copyright{} 2020 André Batista@* -Copyright @copyright{} 2020 Christopher Lemmer Webber +Copyright @copyright{} 2020 Christine Lemmer-Webber@* Copyright @copyright{} 2021 Joshua Branson@* Permission is granted to copy, distribute and/or modify this document diff --git a/gnu/build/image.scm b/gnu/build/image.scm index 45eed0b298..6eb0290256 100644 --- a/gnu/build/image.scm +++ b/gnu/build/image.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2020 Tobias Geerinckx-Rice diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index bd59916bf3..7b55127599 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Marius Bakke diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index eda269f148..007f15f9f5 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -17,7 +17,7 @@ ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Ben Sturmfels ;;; Copyright © 2017 Ethan R. Jones -;;; Copyright © 2017 Christopher Allan Webber +;;; Copyright © 2017 Christine Lemmer-Webber ;;; Copyright © 2017, 2018, 2020 Marius Bakke ;;; Copyright © 2018, 2019 Arun Isaac ;;; Copyright © 2018 Pierre-Antoine Rouby diff --git a/gnu/packages/assembly.scm b/gnu/packages/assembly.scm index 51c0572674..c8576930ff 100644 --- a/gnu/packages/assembly.scm +++ b/gnu/packages/assembly.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2019 Guy Fleury Iteriteka ;;; Copyright © 2019 Andy Tai ;;; Copyright © 2020 Jakub Kądziołka -;;; Copyright © 2020 Christopher Lemmer Webber +;;; Copyright © 2020 Christine Lemmer-Webber ;;; Copyright © 2020 B. Wilson ;;; ;;; This file is part of GNU Guix. diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 5e1c6df6c3..80cd521773 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -24,7 +24,7 @@ ;;; Copyright © 2019, 2021 Arun Isaac ;;; Copyright © 2019 Mathieu Othacehe ;;; Copyright © 2019, 2020 Alexandros Theodotou -;;; Copyright © 2019 Christopher Lemmer Webber +;;; Copyright © 2019 Christine Lemmer-Webber ;;; Copyright © 2019 Jan Wielkiewicz ;;; Copyright © 2019 Hartmt Goebel ;;; Copyright © 2019, 2021 Nicolas Goaziou diff --git a/gnu/packages/backup.scm b/gnu/packages/backup.scm index 7d7868ea17..74e3f2ce01 100644 --- a/gnu/packages/backup.scm +++ b/gnu/packages/backup.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2017 Arun Isaac ;;; Copyright © 2017 Kei Kebreau ;;; Copyright © 2017, 2020 Efraim Flashner -;;; Copyright © 2017 Christopher Allan Webber +;;; Copyright © 2017 Christine Lemmer-Webber ;;; Copyright © 2017 Rutger Helling ;;; Copyright © 2018 Mark H Weaver ;;; Copyright © 2018 Oleg Pykhalov diff --git a/gnu/packages/check.scm b/gnu/packages/check.scm index 0d0229330e..894d8397e6 100644 --- a/gnu/packages/check.scm +++ b/gnu/packages/check.scm @@ -9,7 +9,7 @@ ;;; Copyright © 2015 Andreas Enge ;;; Copyright © 2015, 2016, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016, 2017 Leo Famulari -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Danny Milosavljevic ;;; Copyright © 2016 Roel Janssen ;;; Copyright © 2016 Sou Bunnbu diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index fbff9e8a7c..adb15c03ce 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -9,7 +9,7 @@ ;;; Copyright © 2015 Leo Famulari ;;; Copyright © 2015 Eric Dvorsak ;;; Copyright © 2016 Hartmut Goebel -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016, 2017 Nikita ;;; Copyright © 2016, 2017, 2018 Roel Janssen diff --git a/gnu/packages/emacs-xyz.scm b/gnu/packages/emacs-xyz.scm index cbe830062b..0b76b4e64e 100644 --- a/gnu/packages/emacs-xyz.scm +++ b/gnu/packages/emacs-xyz.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus ;;; Copyright © 2016, 2017, 2018, 2019 Chris Marusich -;;; Copyright © 2015, 2016, 2018, 2020 Christopher Lemmer Webber +;;; Copyright © 2015, 2016, 2018, 2020 Christine Lemmer-Webber ;;; Copyright © 2016 Adriano Peluso ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016 David Thompson diff --git a/gnu/packages/finance.scm b/gnu/packages/finance.scm index bae56d9735..0d398a5367 100644 --- a/gnu/packages/finance.scm +++ b/gnu/packages/finance.scm @@ -16,7 +16,7 @@ ;;; Copyright © 2019, 2020 Martin Becze ;;; Copyright © 2019 Sebastian Schott ;;; Copyright © 2020 Kei Kebreau -;;; Copyright © 2020 Christopher Lemmer Webber +;;; Copyright © 2020 Christine Lemmer-Webber ;;; Copyright © 2020 Tom Zander ;;; Copyright © 2020 Marius Bakke ;;; Copyright © 2020, 2021 Vinicius Monego diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 0eb6aff6e6..f0e87a36bb 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Efraim Flashner ;;; Copyright © 2015, 2016, 2017, 2019 Ricardo Wurmus -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Nikita ;;; Copyright © 2016 Christopher Baines ;;; Copyright © 2016 Mike Gerwitz diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index f8be5559cb..db31ada7b9 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2014, 2015, 2018 Mark H Weaver -;;; Copyright © 2015, 2017 Christopher Allan Webber +;;; Copyright © 2015, 2017 Christine Lemmer-Webber ;;; Copyright © 2016 Alex Sassmannshausen ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus ;;; Copyright © 2016 Erik Edrosa diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index f90ea85999..99372c4668 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2014 Cyril Roelandt ;;; Copyright © 2014, 2016, 2018 David Thompson ;;; Copyright © 2014, 2017, 2018 Mark H Weaver -;;; Copyright © 2015, 2017 Christopher Allan Webber +;;; Copyright © 2015, 2017 Christine Lemmer-Webber ;;; Copyright © 2016 Jan Nieuwenhuizen ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2016, 2019, 2020 Ricardo Wurmus diff --git a/gnu/packages/haskell-xyz.scm b/gnu/packages/haskell-xyz.scm index bb59476795..c12f97802e 100644 --- a/gnu/packages/haskell-xyz.scm +++ b/gnu/packages/haskell-xyz.scm @@ -27,7 +27,7 @@ ;;; Copyright © 2020, 2021 Nicolas Goaziou ;;; Copyright © 2020 Alexandru-Sergiu Marton ;;; Copyright © 2020 Carlo Holl -;;; Copyright © 2020 Christopher Lemmer Webber +;;; Copyright © 2020 Christine Lemmer-Webber ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 0b7a7aa56a..b1f7ab3cb7 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Efraim Flashner -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016–2021 Tobias Geerinckx-Rice ;;; Copyright © 2016, 2017 Alex Kost ;;; Copyright © 2016 Raymond Nicholson diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 8917a49c93..ccf44b7cf3 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -9,7 +9,7 @@ ;;; Copyright © 2015, 2016, 2018 Eric Bavier ;;; Copyright © 2015 Andreas Enge ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016 Al McElrath ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Leo Famulari ;;; Copyright © 2016 Lukas Gradl diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm index b969391ba9..a867fe1d94 100644 --- a/gnu/packages/password-utils.scm +++ b/gnu/packages/password-utils.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2015 Steve Sprang ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2015 Aljosha Papsch -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016 Jessica Tallon ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2016 Lukas Gradl diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index db10c44a20..a01d904896 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -17,7 +17,7 @@ ;;; Copyright © 2017 Adriano Peluso ;;; Copyright © 2017, 2018–2021 Tobias Geerinckx-Rice ;;; Copyright © 2017 Leo Famulari -;;; Copyright © 2017 Christopher Allan Webber +;;; Copyright © 2017 Christine Lemmer-Webber ;;; Copyright © 2018, 2019 Oleg Pykhalov ;;; Copyright © 2018, 2019 Pierre Neidhardt ;;; Copyright © 2018 Kei Kebreau diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm index 441af70f26..32b4aa4bf0 100644 --- a/gnu/packages/python-web.scm +++ b/gnu/packages/python-web.scm @@ -16,7 +16,7 @@ ;;; Copyright © 2016, 2019 Hartmut Goebel ;;; Copyright © 2016–2021 Tobias Geerinckx-Rice ;;; Copyright © 2015, 2017 Ben Woodcroft -;;; Copyright © 2015, 2016 Christopher Allan Webber +;;; Copyright © 2015, 2016 Christine Lemmer-Webber ;;; Copyright © 2017 Adriano Peluso ;;; Copyright © 2016 Dylan Jeffers ;;; Copyright © 2016 David Craven diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 295d158bd3..56920f68c3 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2015 Omar Radwan ;;; Copyright © 2015 Pierre-Antoine Rault ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus -;;; Copyright © 2015, 2016, 2020 Christopher Allan Webber +;;; Copyright © 2015, 2016, 2020 Christine Lemmer-Webber ;;; Copyright © 2015 Eric Dvorsak ;;; Copyright © 2015, 2016 David Thompson ;;; Copyright © 2015, 2016, 2017, 2019 Leo Famulari diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 4ff3200cc9..3bb57ee2bd 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2015 Omar Radwan ;;; Copyright © 2015 Pierre-Antoine Rault ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus -;;; Copyright © 2015, 2016 Christopher Allan Webber +;;; Copyright © 2015, 2016 Christine Lemmer-Webber ;;; Copyright © 2015 Eric Dvorsak ;;; Copyright © 2015, 2016 David Thompson ;;; Copyright © 2015, 2016, 2017, 2021 Leo Famulari diff --git a/gnu/packages/sphinx.scm b/gnu/packages/sphinx.scm index 6f1656eb82..a7a3443707 100644 --- a/gnu/packages/sphinx.scm +++ b/gnu/packages/sphinx.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2017 Danny Milosavljevic ;;; Copyright © 2017, 2018, 2020 Tobias Geerinckx-Rice ;;; Copyright © 2017 Frederick M. Muriithi -;;; Copyright © 2017 Christopher Allan Webber +;;; Copyright © 2017 Christine Lemmer-Webber ;;; Copyright © 2017 Julien Lepiller ;;; Copyright © 2019 Efraim Flashner ;;; Copyright © 2019, 2021 Nicolas Goaziou diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index 7429d4e956..4ceb437b26 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2015, 2016, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016, 2019 Leo Famulari ;;; Copyright © 2016, 2021 Nicolas Goaziou -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2017–2021 Tobias Geerinckx-Rice ;;; Copyright © 2017 Stefan Reichör ;;; Copyright © 2017 Ricardo Wurmus diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 8c630f3ac8..71c2ea4cbc 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -9,7 +9,7 @@ ;;; Copyright © 2015 Andy Wingo ;;; Copyright © 2015 xd1le ;;; Copyright © 2015 Florian Paul Schmidt -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2018 Ricardo Wurmus ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Efraim Flashner ;;; Copyright © 2016 Leo Famulari diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 4e1055609d..7e310b70ec 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -15,7 +15,7 @@ ;;; Copyright © 2019 Alex Griffin ;;; Copyright © 2020 Brice Waegeneire ;;; Copyright © 2021 Oleg Pykhalov -;;; Copyright © 2021 Christopher Lemmer Webber +;;; Copyright © 2021 Christine Lemmer-Webber ;;; Copyright © 2021 Maxime Devos ;;; Copyright © 2021 Guillaume Le Vaillant ;;; diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 3390f5a88f..0241810897 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Marius Bakke -- cgit 1.4.1 From b948ab8b56ac238e7a774625b8f971d28aee6055 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Sun, 21 Mar 2021 21:34:07 +0300 Subject: services: slim: Add pam-gnupg support. * gnu/system/pam.scm (unix-pam-service): Add account and session PAM entries for pam-gnupg. Don't pass "#f" to "allow-root?" argument, because "lambda*" already does this by default. * doc/guix.texi (X Window): Document this. * gnu/services/xorg.scm ()[gnupg?]: New record field. (slim-pam-service): Pass "#:gnupg?" argument to "unix-pam-service". --- doc/guix.texi | 8 ++++++++ gnu/services/xorg.scm | 7 ++++++- gnu/system/pam.scm | 21 +++++++++++++++++---- 3 files changed, 31 insertions(+), 5 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6ba52623c0..17ecc3ad0f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18065,6 +18065,14 @@ Data type representing the configuration of @code{slim-service-type}. @item @code{allow-empty-passwords?} (default: @code{#t}) Whether to allow logins with empty passwords. +@item @code{gnupg?} (default: @code{#f}) +If enabled, @code{pam-gnupg} will attempt to automatically unlock the +user's GPG keys with the login password via @code{gpg-agent}. The +keygrips of all keys to be unlocked should be written to +@file{~/.pam-gnupg}, and can be queried with @code{gpg -K +--with-keygrip}. Presetting passphrases must be enabled by adding +@code{allow-preset-passphrase} in @file{~/.gnupg/gpg-agent.conf}. + @item @code{auto-login?} (default: @code{#f}) @itemx @code{default-user} (default: @code{""}) When @code{auto-login?} is false, SLiM presents a log-in screen. diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index d95f8beb7a..e34cfd35b4 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020 Alex Griffin ;;; Copyright © 2021 Brice Waegeneire +;;; Copyright © 2021 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -543,6 +544,8 @@ a `service-extension', as used by `set-xorg-configuration'." (default slim)) (allow-empty-passwords? slim-configuration-allow-empty-passwords? (default #t)) + (gnupg? slim-configuration-gnupg? + (default #f)) (auto-login? slim-configuration-auto-login? (default #f)) (default-user slim-configuration-default-user @@ -572,7 +575,9 @@ a `service-extension', as used by `set-xorg-configuration'." "slim" #:login-uid? #t #:allow-empty-passwords? - (slim-configuration-allow-empty-passwords? config)))) + (slim-configuration-allow-empty-passwords? config) + #:gnupg? + (slim-configuration-gnupg? config)))) (define (slim-shepherd-service config) (let* ((xinitrc (xinitrc #:fallback-session diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm index ad02586be8..a31daada59 100644 --- a/gnu/system/pam.scm +++ b/gnu/system/pam.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module ((guix utils) #:select (%current-system)) + #:use-module (gnu packages linux) #:export (pam-service pam-service-name pam-service-account @@ -207,14 +208,16 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." (env (pam-entry ; to honor /etc/environment. (control "required") (module "pam_env.so")))) - (lambda* (name #:key allow-empty-passwords? (allow-root? #f) motd - login-uid?) + (lambda* (name #:key allow-empty-passwords? allow-root? motd + login-uid? gnupg?) "Return a standard Unix-style PAM service for NAME. When ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is true, allow root to run the command without authentication. When MOTD is true, it should be a file-like object used as the message-of-the-day. When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets -/proc/self/loginuid, which the libc 'getlogin' function relies on." +/proc/self/loginuid, which the libc 'getlogin' function relies on. When +GNUPG? is true, require the 'pam_gnupg.so' module; that module hands over +the login password to 'gpg-agent'." ;; See . (pam-service (name name) @@ -229,7 +232,12 @@ When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets (control "required") (module "pam_unix.so") (arguments '("nullok"))) - unix)))) + unix)) + (if gnupg? + (list (pam-entry + (control "required") + (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + '()))) (password (list (pam-entry (control "required") (module "pam_unix.so") @@ -247,6 +255,11 @@ When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets (control "required") (module "pam_loginuid.so"))) '()) + ,@(if gnupg? + (list (pam-entry + (control "required") + (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + '()) ,env ,unix)))))) (define (rootok-pam-service command) -- cgit 1.4.1 From 3df485152c545dc365c757368863c6f80815d9ec Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 10 Aug 2021 17:07:18 +0200 Subject: 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'. Signed-off-by: Leo Prikler --- Makefile.am | 2 + doc/guix.texi | 8 ++ guix/build-system/minetest.scm | 99 +++++++++++++++ guix/build/minetest-build-system.scm | 229 +++++++++++++++++++++++++++++++++++ 4 files changed, 338 insertions(+) create mode 100644 guix/build-system/minetest.scm create mode 100644 guix/build/minetest-build-system.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 5542aa1c56..344b7423c5 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 17ecc3ad0f..d6197d3743 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..477cc3d1d0 --- /dev/null +++ b/guix/build/minetest-build-system.scm @@ -0,0 +1,229 @@ +;;; 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 a guess. + (define (guess) + (let* ((source (assoc-ref inputs "source")) + ;; Don't retain a reference to the store. + (file-name (strip-store-file-name 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 "-checkout"))) + 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") + ;; Mods must have 'name' set in "mod.conf", so don't guess. + (read-mod-name "mod.conf")) + ((file-exists? "modpack.conf") + ;; While it is recommended to have 'name' set in 'modpack.conf', + ;; it is optional, so guess a name if necessary. + (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 -- cgit 1.4.1 From 467e874a86dc3dd83fe10e5610823c011de6565a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 10 Aug 2021 17:07:20 +0200 Subject: guix: Add ContentDB importer. * guix/import/contentdb.scm: New file. * guix/scripts/import/contentdb.scm: New file. * tests/contentdb.scm: New file. * Makefile.am (MODULES, SCM_TESTS): Register them. * po/guix/POTFILES.in: Likewise. * doc/guix.texi (Invoking guix import): Document it. Signed-off-by: Leo Prikler --- Makefile.am | 3 + doc/guix.texi | 32 +++ guix/import/minetest.scm | 456 +++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 3 +- guix/scripts/import/minetest.scm | 117 ++++++++++ po/guix/POTFILES.in | 1 + tests/minetest.scm | 355 ++++++++++++++++++++++++++++++ 7 files changed, 966 insertions(+), 1 deletion(-) create mode 100644 guix/import/minetest.scm create mode 100644 guix/scripts/import/minetest.scm create mode 100644 tests/minetest.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 344b7423c5..327d3f9961 100644 --- a/Makefile.am +++ b/Makefile.am @@ -262,6 +262,7 @@ MODULES = \ guix/import/json.scm \ guix/import/kde.scm \ guix/import/launchpad.scm \ + guix/import/minetest.scm \ guix/import/opam.scm \ guix/import/print.scm \ guix/import/pypi.scm \ @@ -304,6 +305,7 @@ MODULES = \ guix/scripts/import/go.scm \ guix/scripts/import/hackage.scm \ guix/scripts/import/json.scm \ + guix/scripts/import/minetest.scm \ guix/scripts/import/opam.scm \ guix/scripts/import/pypi.scm \ guix/scripts/import/stackage.scm \ @@ -470,6 +472,7 @@ SCM_TESTS = \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ + tests/minetest.scm \ tests/modules.scm \ tests/monads.scm \ tests/nar.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index d6197d3743..241a1824ec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11314,6 +11314,38 @@ and generate package expressions for all those packages that are not yet in Guix. @end table +@item contentdb +@cindex minetest +@cindex ContentDB +Import metadata from @uref{https://content.minetest.net, ContentDB}. +Information is taken from the JSON-formatted metadata provided through +@uref{https://content.minetest.net/help/api/, ContentDB's API} and +includes most relevant information, including dependencies. There are +some caveats, however. The license information is often incomplete. +The commit hash is sometimes missing. The descriptions are in the +Markdown format, but Guix uses Texinfo instead. Texture packs and +subgames are unsupported. + +The command below imports metadata for the Mesecons mod by Jeija: + +@example +guix import minetest Jeija/mesecons +@end example + +The author name can also be left out: + +@example +guix import minetest mesecons +@end example + +@table @code +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. +@end table + @item cpan @cindex CPAN Import metadata from @uref{https://www.metacpan.org/, MetaCPAN}. diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm new file mode 100644 index 0000000000..e1f8487b75 --- /dev/null +++ b/guix/import/minetest.scm @@ -0,0 +1,456 @@ +;;; 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 import minetest) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (ice-9 threads) + #:use-module (ice-9 hash-table) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (guix utils) + #:use-module (guix ui) + #:use-module (guix i18n) + #:use-module (guix memoization) + #:use-module (guix serialization) + #:use-module (guix import utils) + #:use-module (guix import json) + #:use-module ((gcrypt hash) #:select (open-sha256-port port-sha256)) + #:use-module (json) + #:use-module (guix base32) + #:use-module (guix git) + #:use-module (guix store) + #:export (%default-sort-key + %contentdb-api + json->package + contentdb-fetch + elaborate-contentdb-name + minetest->guix-package + minetest-recursive-import + sort-packages)) + +;; The ContentDB API is documented at +;; . + +(define %contentdb-api + (make-parameter "https://content.minetest.net/api/")) + +(define (string-or-false x) + (and (string? x) x)) + +(define (natural-or-false x) + (and (exact-integer? x) (>= x 0) x)) + +;; Descriptions on ContentDB use carriage returns, but Guix doesn't. +(define (delete-cr text) + (string-delete #\cr text)) + + + +;;; +;;; JSON mappings +;;; + +;; Minetest package. +;; +;; API endpoint: /packages/AUTHOR/NAME/ +(define-json-mapping make-package package? + json->package + (author package-author) ; string + (creation-date package-creation-date ; string + "created_at") + (downloads package-downloads) ; integer + (forums package-forums "forums" natural-or-false) + (issue-tracker package-issue-tracker "issue_tracker") ; string + (license package-license) ; string + (long-description package-long-description "long_description") ; string + (maintainers package-maintainers ; list of strings + "maintainers" vector->list) + (media-license package-media-license "media_license") ; string + (name package-name) ; string + (provides package-provides ; list of strings + "provides" vector->list) + (release package-release) ; integer + (repository package-repository "repo" string-or-false) + (score package-score) ; flonum + (screenshots package-screenshots "screenshots" vector->list) ; list of strings + (short-description package-short-description "short_description") ; string + (state package-state) ; string + (tags package-tags "tags" vector->list) ; list of strings + (thumbnail package-thumbnail) ; string + (title package-title) ; string + (type package-type) ; string + (url package-url) ; string + (website package-website "website" string-or-false)) + +(define-json-mapping make-release release? + json->release + ;; If present, a git commit identified by its hash + (commit release-commit "commit" string-or-false) + (downloads release-downloads) ; integer + (id release-id) ; integer + (max-minetest-version release-max-minetest-version string-or-false) + (min-minetest-version release-min-minetest-version string-or-false) + (release-date release-data) ; string + (title release-title) ; string + (url release-url)) ; string + +(define-json-mapping make-dependency dependency? + json->dependency + (optional? dependency-optional? "is_optional") ; bool + (name dependency-name) ; string + (packages dependency-packages "packages" vector->list)) ; list of strings + +;; A structure returned by the /api/packages/?fmt=keys endpoint +(define-json-mapping make-package-keys package-keys? + json->package-keys + (author package-keys-author) ; string + (name package-keys-name) ; string + (type package-keys-type)) ; string + +(define (package-mod? package) + "Is the ContentDB package PACKAGE a mod?" + ;; ContentDB also has ‘games’ and ‘texture packs’. + (string=? (package-type package) "mod")) + + + +;;; +;;; Manipulating names of packages +;;; +;;; There are three kind of names: +;;; +;;; * names of guix packages, e.g. minetest-basic-materials. +;;; * names of mods on ContentDB, e.g. basic_materials +;;; * a combination of author and mod name on ContentDB, e.g. VanessaE/basic_materials +;;; + +(define (%construct-full-name author name) + (string-append author "/" name)) + +(define (package-full-name package) + "Given a object, return the corresponding AUTHOR/NAME string." + (%construct-full-name (package-author package) (package-name package))) + +(define (package-keys-full-name package) + "Given a object, return the corresponding AUTHOR/NAME string." + (%construct-full-name (package-keys-author package) + (package-keys-name package))) + +(define (contentdb->package-name author/name) + "Given the AUTHOR/NAME of a package on ContentDB, return a Guix-compliant +name for the package." + ;; The author is not included, as the names of popular mods + ;; tend to be unique. + (string-append "minetest-" (snake-case (author/name->name author/name)))) + +(define (author/name->name author/name) + "Extract NAME from the AUTHOR/NAME string, or raise an error if AUTHOR/NAME +is ill-formatted." + (match (string-split author/name #\/) + ((author name) + (when (string-null? author) + (leave + (G_ "In ~a: author names must consist of at least a single character.~%") + author/name)) + (when (string-null? name) + (leave + (G_ "In ~a: mod names must consist of at least a single character.~%") + author/name)) + name) + ((too many . components) + (leave + (G_ "In ~a: author names and mod names may not contain forward slashes.~%") + author/name)) + ((name) + (if (string-null? name) + (leave (G_ "mod names may not be empty.~%")) + (leave (G_ "The name of the author is missing in ~a.~%") + author/name))))) + +(define* (elaborate-contentdb-name name #:key (sort %default-sort-key)) + "If NAME is an AUTHOR/NAME string, return it. Otherwise, try to determine +the author and return an appropriate AUTHOR/NAME string. If that fails, +raise an exception." + (if (or (string-contains name "/") (string-null? name)) + ;; Call 'author/name->name' to verify that NAME seems reasonable + ;; and raise an appropriate exception if it isn't. + (begin + (author/name->name name) + name) + (let* ((package-keys (contentdb-query-packages name #:sort sort)) + (correctly-named + (filter (lambda (package-key) + (string=? name (package-keys-name package-key))) + package-keys))) + (match correctly-named + ((one) (package-keys-full-name one)) + ((too . many) + (warning (G_ "~a is ambigious, presuming ~a (other options include: ~a)~%") + name (package-keys-full-name too) + (map package-keys-full-name many)) + (package-keys-full-name too)) + (() + (leave (G_ "No mods with name ~a were found.~%") name)))))) + + + +;;; +;;; API endpoints +;;; + +(define contentdb-fetch + (mlambda (author/name) + "Return a record for package AUTHOR/NAME, or #f on failure." + (and=> (json-fetch + (string-append (%contentdb-api) "packages/" author/name "/")) + json->package))) + +(define (contentdb-fetch-releases author/name) + "Return a list of records for package NAME by AUTHOR, or #f +on failure." + (and=> (json-fetch (string-append (%contentdb-api) "packages/" author/name + "/releases/")) + (lambda (json) + (map json->release (vector->list json))))) + +(define (latest-release author/name) + "Return the latest source release for package NAME by AUTHOR, +or #f if this package does not exist." + (and=> (contentdb-fetch-releases author/name) + car)) + +(define (contentdb-fetch-dependencies author/name) + "Return an alist of lists of records for package NAME by AUTHOR +and possibly some other packages as well, or #f on failure." + (define url (string-append (%contentdb-api) "packages/" author/name + "/dependencies/")) + (and=> (json-fetch url) + (lambda (json) + (map (match-lambda + ((key . value) + (cons key (map json->dependency (vector->list value))))) + json)))) + +(define* (contentdb-query-packages q #:key + (type "mod") + (limit 50) + (sort %default-sort-key) + (order "desc")) + "Search ContentDB for Q (a string). Sort by SORT, in ascending order +if ORDER is \"asc\" or descending order if ORDER is \"desc\". TYPE must +be \"mod\", \"game\" or \"txp\", restricting thes search results to +respectively mods, games and texture packs. Limit to at most LIMIT +results. The return value is a list of records." + ;; XXX does Guile have something for constructing (and, when necessary, + ;; escaping) query strings? + (define url (string-append (%contentdb-api) "packages/?type=" type + "&q=" q "&fmt=keys" + "&limit=" (number->string limit) + "&order=" order + "&sort=" sort)) + (let ((json (json-fetch url))) + (if json + (map json->package-keys (vector->list json)) + (leave + (G_ "The package search API doesn't exist anymore.~%"))))) + + + +;; XXX copied from (guix import elpa) +(define* (download-git-repository url ref) + "Fetch the given REF from the Git repository at URL." + (with-store store + (latest-repository-commit store url #:ref ref))) + +;; XXX adapted from (guix scripts hash) +(define (file-hash file) + "Compute the hash of FILE." + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port) + (force-output port) + (get-hash))) + +(define (make-minetest-sexp author/name version repository commit + inputs home-page synopsis + description media-license license) + "Return a S-expression for the minetest package with the given author/NAME, +VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, +MEDIA-LICENSE and LICENSE." + `(package + (name ,(contentdb->package-name author/name)) + (version ,version) + (source + (origin + (method git-fetch) + (uri (git-reference + (url ,repository) + (commit ,commit))) + (sha256 + (base32 + ;; The git commit is not always available. + ,(and commit + (bytevector->nix-base32-string + (file-hash + (download-git-repository repository + `(commit . ,commit))))))) + (file-name (git-file-name name version)))) + (build-system minetest-mod-build-system) + ,@(maybe-propagated-inputs (map contentdb->package-name inputs)) + (home-page ,home-page) + (synopsis ,(delete-cr synopsis)) + (description ,(delete-cr description)) + (license ,(if (eq? media-license license) + license + `(list ,media-license ,license))) + ;; The Minetest updater (not yet in Guix; it requires not-yet-submitted + ;; patches to (guix upstream) that require some work) needs to know both + ;; the author name and mod name for efficiency. + (properties ,(list 'quasiquote `((upstream-name . ,author/name)))))) + +(define (package-home-page package) + "Guess the home page of the ContentDB package PACKAGE. + +In order of preference, try the 'website', the forum topic on the +official Minetest forum and the Git repository (if any)." + (define (topic->url-sexp topic) + ;; 'minetest-topic' is a procedure defined in (gnu packages minetest) + `(minetest-topic ,topic)) + (or (package-website package) + (and=> (package-forums package) topic->url-sexp) + (package-repository package))) + +;; If the default sort key is changed, make sure to modify 'show-help' +;; in (guix scripts import minetest) appropriately as well. +(define %default-sort-key "score") + +(define* (sort-packages packages #:key (sort %default-sort-key)) + "Sort PACKAGES by SORT, in descending order." + (define package->key + (match sort + ("score" package-score) + ("downloads" package-downloads))) + (define (greater x y) + (> (package->key x) (package->key y))) + (sort-list packages greater)) + +(define builtin-mod? + (let ((%builtin-mods + (alist->hash-table + (map (lambda (x) (cons x #t)) + '("beds" "binoculars" "boats" "bones" "bucket" "butterflies" + "carts" "creative" "default" "doors" "dungeon_loot" "dye" + "env_sounds" "farming" "fire" "fireflies" "flowers" + "game_commands" "give_initial_stuff" "map" "mtg_craftguide" + "player_api" "screwdriver" "sethome" "sfinv" "spawn" "stairs" + "tnt" "vessels" "walls" "weather" "wool" "xpanes"))))) + (lambda (mod) + "Is MOD provided by the default minetest subgame?" + (hash-ref %builtin-mods mod)))) + +(define* (important-dependencies dependencies author/name + #:key (sort %default-sort-key)) + "Return the hard dependencies of AUTHOR/NAME in the association list +DEPENDENCIES as a list of AUTHOR/NAME strings." + (define dependency-list + (assoc-ref dependencies author/name)) + (filter-map + (lambda (dependency) + (and (not (dependency-optional? dependency)) + (not (builtin-mod? (dependency-name dependency))) + ;; The dependency information contains symbolic names + ;; that can be ‘provided’ by multiple mods, so we need to choose one + ;; of the implementations. + (let* ((implementations + (par-map contentdb-fetch (dependency-packages dependency))) + ;; Fetching package information about the packages is racy: + ;; some packages might be removed from ContentDB between the + ;; construction of DEPENDENCIES and the call to + ;; 'contentdb-fetch'. So filter out #f. + ;; + ;; Filter out ‘games’ that include the requested mod -- it's + ;; the mod itself we want. + (mods (filter (lambda (p) (and=> p package-mod?)) + implementations)) + (sorted-mods (sort-packages mods #:sort sort))) + (match sorted-mods + ((package) (package-full-name package)) + ((too . many) + (warning + (G_ "The dependency ~a of ~a has multiple different implementations ~a.~%") + (dependency-name dependency) + author/name + (map package-full-name sorted-mods)) + (match sort + ("score" + (warning + (G_ "The implementation with the highest score will be choosen!~%"))) + ("downloads" + (warning + (G_ "The implementation that has been downloaded the most will be choosen!~%")))) + (package-full-name too)) + (() + (warning + (G_ "The dependency ~a of ~a does not have any implementation. It will be ignored!~%") + (dependency-name dependency) author/name) + #f))))) + dependency-list)) + +(define* (%minetest->guix-package author/name #:key (sort %default-sort-key)) + "Fetch the metadata for AUTHOR/NAME from https://content.minetest.net, and +return the 'package' S-expression corresponding to that package, or raise an +exception on failure. On success, also return the upstream dependencies as a +list of AUTHOR/NAME strings." + ;; Call 'author/name->name' to verify that AUTHOR/NAME seems reasonable. + (author/name->name author/name) + (define package (contentdb-fetch author/name)) + (unless package + (leave (G_ "no package metadata for ~a on ContentDB~%") author/name)) + (define dependencies (contentdb-fetch-dependencies author/name)) + (unless dependencies + (leave (G_ "no dependency information for ~a on ContentDB~%") author/name)) + (define release (latest-release author/name)) + (unless release + (leave (G_ "no release of ~a on ContentDB~%") author/name)) + (define important-upstream-dependencies + (important-dependencies dependencies author/name #:sort sort)) + (values (make-minetest-sexp author/name + (release-title release) ; version + (package-repository package) + (release-commit release) + important-upstream-dependencies + (package-home-page package) + (package-short-description package) + (package-long-description package) + (spdx-string->license + (package-media-license package)) + (spdx-string->license + (package-license package))) + important-upstream-dependencies)) + +(define minetest->guix-package + (memoize %minetest->guix-package)) + +(define* (minetest-recursive-import author/name #:key (sort %default-sort-key)) + (define* (minetest->guix-package* author/name #:key repo version) + (minetest->guix-package author/name #:sort sort)) + (recursive-import author/name + #:repo->guix-package minetest->guix-package* + #:guix-name contentdb->package-name)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index f53d1ac1f4..b369a362d0 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -77,7 +77,8 @@ rather than \\n." ;;; (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" - "gem" "go" "cran" "crate" "texlive" "json" "opam")) + "gem" "go" "cran" "crate" "texlive" "json" "opam" + "minetest")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/minetest.scm b/guix/scripts/import/minetest.scm new file mode 100644 index 0000000000..5f204d90fc --- /dev/null +++ b/guix/scripts/import/minetest.scm @@ -0,0 +1,117 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson +;;; Copyright © 2018 Ricardo Wurmus +;;; 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 scripts import minetest) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import minetest) + #:use-module (guix import utils) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-minetest)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + `((sort . ,%default-sort-key))) + +(define (show-help) + (display (G_ "Usage: guix import minetest AUTHOR/NAME +Import and convert the Minetest mod NAME by AUTHOR from ContentDB.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " + -V, --version display version information and exit")) + (display (G_ " + --sort=KEY when choosing between multiple implementations, + choose the one with the highest value for KEY + (one of \"score\" (standard) or \"downloads\")")) + (newline) + (show-bug-report-information)) + +(define (verify-sort-order sort) + "Verify SORT can be used to sort mods by." + (unless (member sort '("score" "downloads" "reviews")) + (leave (G_ "~a: not a valid key to sort by~%") sort)) + sort) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import minetest"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + (option '("sort") #t #f + (lambda (opt name arg result) + (alist-cons 'sort (verify-sort-order arg) result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-minetest . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((name) + (with-error-handling + (let* ((sort (assoc-ref opts 'sort)) + (author/name (elaborate-contentdb-name name #:sort sort))) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (filter-map package->definition + (minetest-recursive-import author/name #:sort sort)) + ;; Single import + (minetest->guix-package author/name #:sort sort))))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 14324b25de..1eee82be53 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -60,6 +60,7 @@ guix/scripts/git.scm guix/scripts/git/authenticate.scm guix/scripts/hash.scm guix/scripts/import.scm +guix/scripts/import/contentdb.scm guix/scripts/import/cran.scm guix/scripts/import/elpa.scm guix/scripts/pull.scm diff --git a/tests/minetest.scm b/tests/minetest.scm new file mode 100644 index 0000000000..6ae476fe5f --- /dev/null +++ b/tests/minetest.scm @@ -0,0 +1,355 @@ +;;; 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 (test-minetest) + #:use-module (guix memoization) + #:use-module (guix import minetest) + #:use-module (guix import utils) + #:use-module (guix tests) + #:use-module (json) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64)) + + +;; Some procedures for populating a ‘fake’ ContentDB server. + +(define* (make-package-sexp #:key + (guix-name "minetest-foo") + (home-page "https://example.org/foo") + (repo "https://example.org/foo.git") + (synopsis "synopsis") + (guix-description "description") + (guix-license + '(list license:cc-by-sa4.0 license:lgpl3+)) + (inputs '()) + (upstream-name "Author/foo") + #:allow-other-keys) + `(package + (name ,guix-name) + ;; This is not a proper version number but ContentDB does not include + ;; version numbers. + (version "2021-07-25") + (source + (origin + (method git-fetch) + (uri (git-reference + (url ,(and (not (eq? repo 'null)) repo)) + (commit #f))) + (sha256 + (base32 #f)) + (file-name (git-file-name name version)))) + (build-system minetest-mod-build-system) + ,@(maybe-propagated-inputs inputs) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,guix-description) + (license ,guix-license) + (properties + ,(list 'quasiquote + `((upstream-name . ,upstream-name)))))) + +(define* (make-package-json #:key + (author "Author") + (name "foo") + (media-license "CC-BY-SA-4.0") + (license "LGPL-3.0-or-later") + (short-description "synopsis") + (long-description "description") + (repo "https://example.org/foo.git") + (website "https://example.org/foo") + (forums 321) + (score 987.654) + (downloads 123) + (type "mod") + #:allow-other-keys) + `(("author" . ,author) + ("content_warnings" . #()) + ("created_at" . "2018-05-23T19:58:07.422108") + ("downloads" . ,downloads) + ("forums" . ,forums) + ("issue_tracker" . "https://example.org/foo/issues") + ("license" . ,license) + ("long_description" . ,long-description) + ("maintainers" . #("maintainer")) + ("media_license" . ,media-license) + ("name" . ,name) + ("provides" . #("stuff")) + ("release" . 456) + ("repo" . ,repo) + ("score" . ,score) + ("screenshots" . #()) + ("short_description" . ,short-description) + ("state" . "APPROVED") + ("tags" . #("some" "tags")) + ("thumbnail" . null) + ("title" . "The name") + ("type" . ,type) + ("url" . ,(string-append "https://content.minetest.net/packages/" + author "/" name "/download/")) + ("website" . ,website))) + +(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys) + `#((("commit" . ,commit) + ("downloads" . 469) + ("id" . 8614) + ("max_minetest_version" . null) + ("min_minetest_version" . null) + ("release_date" . "2021-07-25T01:10:23.207584") + ("title" . "2021-07-25")))) + +(define* (make-dependencies-json #:key (author "Author") + (name "foo") + (requirements '(("default" #f ()))) + #:allow-other-keys) + `((,(string-append author "/" name) + . ,(list->vector + (map (match-lambda + ((symbolic-name optional? implementations) + `(("is_optional" . ,optional?) + ("name" . ,symbolic-name) + ("packages" . ,(list->vector implementations))))) + requirements))) + ("something/else" . #()))) + +(define* (make-packages-keys-json #:key (author "Author") + (name "Name") + (type "mod")) + `(("author" . ,author) + ("name" . ,name) + ("type" . ,type))) + +(define (call-with-packages thunk . argument-lists) + ;; Don't reuse results from previous tests. + (invalidate-memoization! contentdb-fetch) + (invalidate-memoization! minetest->guix-package) + (define (scm->json-port scm) + (open-input-string (scm->json-string scm))) + (define (handle-package url requested-author requested-name . rest) + (define relevant-argument-list + (any (lambda (argument-list) + (apply (lambda* (#:key (author "Author") (name "foo") + #:allow-other-keys) + (and (equal? requested-author author) + (equal? requested-name name) + argument-list)) + argument-list)) + argument-lists)) + (when (not relevant-argument-list) + (error "the package ~a/~a should be irrelevant, but ~a is fetched" + requested-author requested-name url)) + (scm->json-port + (apply (match rest + (("") make-package-json) + (("dependencies" "") make-dependencies-json) + (("releases" "") make-releases-json) + (_ (error "TODO ~a" rest))) + relevant-argument-list))) + (define (handle-mod-search sort) + ;; Produce search results, sorted by SORT in descending order. + (define arguments->key + (match sort + ("score" (lambda* (#:key (score 987.654) #:allow-other-keys) + score)) + ("downloads" (lambda* (#:key (downloads 123) #:allow-other-keys) + downloads)))) + (define argument-list->key (cut apply arguments->key <>)) + (define (greater x y) + (> (argument-list->key x) (argument-list->key y))) + (define sorted-argument-lists (sort-list argument-lists greater)) + (define* (arguments->json #:key (author "Author") (name "Foo") (type "mod") + #:allow-other-keys) + (and (string=? type "mod") + `(("author" . ,author) + ("name" . ,name) + ("type" . ,type)))) + (define argument-list->json (cut apply arguments->json <>)) + (scm->json-port + (list->vector (filter-map argument-list->json sorted-argument-lists)))) + (mock ((guix http-client) http-fetch + (lambda* (url #:key headers) + (unless (string-prefix? "mock://api/packages/" url) + (error "the URL ~a should not be used" url)) + (define resource + (substring url (string-length "mock://api/packages/"))) + (define components (string-split resource #\/)) + (match components + ((author name . rest) + (apply handle-package url author name rest)) + (((? (cut string-prefix? "?type=mod&q=" <>) query)) + (handle-mod-search + (cond ((string-contains query "sort=score") "score") + ((string-contains query "sort=downloads") "downloads") + (#t (error "search query ~a has unknown sort key" + query))))) + (_ + (error "the URL ~a should have an author and name component" + url))))) + (parameterize ((%contentdb-api "mock://api/")) + (thunk)))) + +(define* (minetest->guix-package* #:key (author "Author") (name "foo") + (sort %default-sort-key) + #:allow-other-keys) + (minetest->guix-package (string-append author "/" name) #:sort sort)) + +(define (imported-package-sexp* primary-arguments . secondary-arguments) + "Ask the importer to import a package specified by PRIMARY-ARGUMENTS, +during a dynamic where that package and the packages specified by +SECONDARY-ARGUMENTS are available on ContentDB." + (apply call-with-packages + (lambda () + ;; The memoization cache is reset by call-with-packages + (apply minetest->guix-package* primary-arguments)) + primary-arguments + secondary-arguments)) + +(define (imported-package-sexp . extra-arguments) + "Ask the importer to import a package specified by EXTRA-ARGUMENTS, +during a dynamic extent where that package is available on ContentDB." + (imported-package-sexp* extra-arguments)) + +(define-syntax-rule (test-package test-case . extra-arguments) + (test-equal test-case + (make-package-sexp . extra-arguments) + (imported-package-sexp . extra-arguments))) + +(define-syntax-rule (test-package* test-case primary-arguments extra-arguments + ...) + (test-equal test-case + (apply make-package-sexp primary-arguments) + (imported-package-sexp* primary-arguments extra-arguments ...))) + +(test-begin "minetest") + + +;; Package names +(test-package "minetest->guix-package") +(test-package "minetest->guix-package, _ → - in package name" + #:name "foo_bar" + #:guix-name "minetest-foo-bar" + #:upstream-name "Author/foo_bar") + +(test-equal "elaborate names, unambigious" + "Jeija/mesecons" + (call-with-packages + (cut elaborate-contentdb-name "mesecons") + '(#:name "mesecons" #:author "Jeija") + '(#:name "something" #:author "else"))) + +(test-equal "elaborate name, ambigious (highest score)" + "Jeija/mesecons" + (call-with-packages + ;; #:sort "score" is the default + (cut elaborate-contentdb-name "mesecons") + '(#:name "mesecons" #:author "Jeijc" #:score 777) + '(#:name "mesecons" #:author "Jeijb" #:score 888) + '(#:name "mesecons" #:author "Jeija" #:score 999))) + + +(test-equal "elaborate name, ambigious (most downloads)" + "Jeija/mesecons" + (call-with-packages + (cut elaborate-contentdb-name "mesecons" #:sort "downloads") + '(#:name "mesecons" #:author "Jeijc" #:downloads 777) + '(#:name "mesecons" #:author "Jeijb" #:downloads 888) + '(#:name "mesecons" #:author "Jeija" #:downloads 999))) + + +;; Determining the home page +(test-package "minetest->guix-package, website is used as home page" + #:home-page "web://site" + #:website "web://site") +(test-package "minetest->guix-package, if absent, the forum is used" + #:home-page '(minetest-topic 628) + #:forums 628 + #:website 'null) +(test-package "minetest->guix-package, if absent, the git repo is used" + #:home-page "https://github.com/minetest-mods/mesecons" + #:forums 'null + #:website 'null + #:repo "https://github.com/minetest-mods/mesecons") +(test-package "minetest->guix-package, all home page information absent" + #:home-page #f + #:forums 'null + #:website 'null + #:repo 'null) + + + +;; Dependencies +(test-package* "minetest->guix-package, unambigious dependency" + (list #:requirements '(("mesecons" #f + ("Jeija/mesecons" + "some-modpack/containing-mese"))) + #:inputs '("minetest-mesecons")) + (list #:author "Jeija" #:name "mesecons") + (list #:author "some-modpack" #:name "containing-mese" #:type "modpack")) + +(test-package* "minetest->guix-package, ambigious dependency (highest score)" + (list #:name "frobnicate" + #:guix-name "minetest-frobnicate" + #:upstream-name "Author/frobnicate" + #:requirements '(("frob" #f + ("Author/foo" "Author/bar"))) + ;; #:sort "score" is the default + #:inputs '("minetest-bar")) + (list #:author "Author" #:name "foo" #:score 0) + (list #:author "Author" #:name "bar" #:score 9999)) + +(test-package* "minetest->guix-package, ambigious dependency (most downloads)" + (list #:name "frobnicate" + #:guix-name "minetest-frobnicate" + #:upstream-name "Author/frobnicate" + #:requirements '(("frob" #f + ("Author/foo" "Author/bar"))) + #:inputs '("minetest-bar") + #:sort "downloads") + (list #:author "Author" #:name "foo" #:downloads 0) + (list #:author "Author" #:name "bar" #:downloads 9999)) + +(test-package "minetest->guix-package, optional dependency" + #:requirements '(("mesecons" #t + ("Jeija/mesecons" + "some-modpack/containing-mese"))) + #:inputs '()) + + +;; License +(test-package "minetest->guix-package, identical licenses" + #:guix-license 'license:lgpl3+ + #:license "LGPL-3.0-or-later" + #:media-license "LGPL-3.0-or-later") + +;; Sorting +(let* ((make-package + (lambda arguments + (json->package (apply make-package-json arguments)))) + (x (make-package #:score 0)) + (y (make-package #:score 1)) + (z (make-package #:score 2))) + (test-equal "sort-packages, already sorted" + (list z y x) + (sort-packages (list z y x))) + (test-equal "sort-packages, reverse" + (list z y x) + (sort-packages (list x y z)))) + +(test-end "minetest") -- cgit 1.4.1 From 33a1ec29fa0ad72c61cef13c8af08c847eb399c1 Mon Sep 17 00:00:00 2001 From: pukkamustard Date: Mon, 9 Aug 2021 07:19:03 +0000 Subject: guix: dune-build-system: Add a profile parameter. * guix/build-system/dune.scm: Add a profile parameter. * guix/build/dune-build-system.scm (build): Use it. * doc/guix.texi: Document it. * gnu/packages/ocaml.scm: Remove profile being set from build flags. Signed-off-by: Julien Lepiller --- doc/guix.texi | 7 +++++++ gnu/packages/ocaml.scm | 17 ++++++----------- guix/build-system/dune.scm | 3 +++ guix/build/dune-build-system.scm | 8 ++++++-- 4 files changed, 22 insertions(+), 13 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 241a1824ec..949d6d4092 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -94,6 +94,7 @@ Copyright @copyright{} 2021 Xinglu Chen@* Copyright @copyright{} 2021 Raghav Gururajan@* Copyright @copyright{} 2021 Domagoj Stolfa@* Copyright @copyright{} 2021 Hui Lu@* +Copyright @copyright{} 2021 pukkamustard@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -7731,6 +7732,12 @@ The @code{#:package} parameter can be passed to specify a package name, which is useful when a package contains multiple packages and you want to build only one of them. This is equivalent to passing the @code{-p} argument to @code{dune}. + +The @code{#:profile} parameter can be passed to specify the +@uref{https://dune.readthedocs.io/en/stable/dune-files.html#profile, +dune build profile}. This is equivalent to passing the @code{--profile} +argument to @code{dune}. Its default value is @code{"release"}. + @end defvr @defvr {Scheme Variable} go-build-system diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm index bdd52d2940..fee9e5e0ee 100644 --- a/gnu/packages/ocaml.scm +++ b/gnu/packages/ocaml.scm @@ -2876,8 +2876,7 @@ without a complete in-memory representation of the data.") "1dvcl108ir9nqkk4mjm9xhhj4p9dx9bmg8bnms54fizs1x3x8ar3")))) (build-system dune-build-system) (arguments - `(#:test-target "tests" - #:build-flags (list "--profile=release"))) + `(#:test-target "tests")) (propagated-inputs `(("ocaml-cmdliner" ,ocaml-cmdliner))) (home-page "https://www.typerex.org/ocp-indent.html") @@ -3295,8 +3294,7 @@ build system and allows external tools to analyse your project easily.") "1smcc0l6fh2n0y6bp96c69j5nw755jja99w0b206wx3yb2m4w2hs")))) (build-system dune-build-system) (arguments - `(#:tests? #f - #:build-flags (list "--profile" "release"))) + `(#:tests? #f)) (native-inputs `(("ocamlbuild" ,ocamlbuild))) (home-page "https://github.com/mjambon/cppo") @@ -3364,8 +3362,7 @@ standard iterator type starting from 4.07.") (base32 "07ycb103mr4mrkxfd63cwlsn023xvcjp0ra0k7n2gwrg0mwxmfss")))) (build-system dune-build-system) (arguments - `(#:tests? #f - #:build-flags (list "--profile" "release"))) + `(#:tests? #f)) (propagated-inputs `(("ocaml-seq" ,ocaml-seq))) (native-inputs @@ -3842,9 +3839,8 @@ the plugins facilitate extensibility, and the frontends serve as entry points.") "0chn7ldqb3wyf95yhmsxxq65cif56smgz1mhhc7m0dpwmyq1k97h")))) (build-system dune-build-system) (arguments - `(#:build-flags (list "--profile" "release") - #:test-target "camomile-test" - #:tests? #f; Tests fail, see https://github.com/yoriyuki/Camomile/issues/82 + `(#:test-target "camomile-test" + #:tests? #f ; Tests fail, see https://github.com/yoriyuki/Camomile/issues/82 #:phases (modify-phases %standard-phases (add-before 'build 'fix-usr-share @@ -3935,8 +3931,7 @@ connect an engine to your inputs and rendering functions to get an editor.") (base32 "0zcjy6fvf0d3i2ssz96asl889n3r6bplyzk7xvb2s3dkxbgcisyy")))) (build-system dune-build-system) (arguments - `(#:build-flags (list "--profile" "release") - #:tests? #f + `(#:tests? #f #:ocaml ,ocaml-4.07 #:findlib ,ocaml4.07-findlib #:dune ,ocaml4.07-dune)) diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm index 6a2f3d16de..1a64cf9b75 100644 --- a/guix/build-system/dune.scm +++ b/guix/build-system/dune.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Julien Lepiller ;;; Copyright © 2017 Ben Woodcroft +;;; Copyright © 2021 pukkamustard ;;; ;;; This file is part of GNU Guix. ;;; @@ -88,6 +89,7 @@ (out-of-source? #t) (jbuild? #f) (package #f) + (profile "release") (tests? #t) (test-flags ''()) (test-target "test") @@ -127,6 +129,7 @@ provides a 'setup.ml' file as its build system." #:out-of-source? ,out-of-source? #:jbuild? ,jbuild? #:package ,package + #:profile ,profile #:tests? ,tests? #:test-target ,test-target #:install-target ,install-target diff --git a/guix/build/dune-build-system.scm b/guix/build/dune-build-system.scm index 7e2ec1e3e1..6a0c2593ac 100644 --- a/guix/build/dune-build-system.scm +++ b/guix/build/dune-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2019 Gabriel Hondet +;;; Copyright © 2021 pukkamustard ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,11 +32,14 @@ ;; Code: (define* (build #:key (build-flags '()) (jbuild? #f) - (use-make? #f) (package #f) #:allow-other-keys) + (use-make? #f) (package #f) + (profile "release") #:allow-other-keys) "Build the given package." (let ((program (if jbuild? "jbuilder" "dune"))) (apply invoke program "build" "@install" - (append (if package (list "-p" package) '()) build-flags))) + (append (if package (list "-p" package) '()) + `("--profile" ,profile) + build-flags))) #t) (define* (check #:key (test-flags '()) (test-target "test") tests? -- cgit 1.4.1 From fc29c80b9635ff490bcc768c774442043cb1e231 Mon Sep 17 00:00:00 2001 From: Alice BRENON Date: Sat, 7 Aug 2021 19:50:10 +0200 Subject: guix: opam: More flexibility in the importer. * guix/scripts/import/opam.scm: Pass all instances of --repo as a list to the importer. * guix/import/opam.scm (opam-fetch): Stop expecting "expanded" repositories and call get-opam-repository instead to keep values "symbolic" as long as possible and factorize. (get-opam-repository): Use the same repository source as CLI opam does (i.e. HTTP-served index.tar.gz instead of git repositories). (find-latest-version): Be more flexible on the repositories structure instead of expecting packages/PACKAGE-NAME/PACKAGE-NAME.VERSION/. * tests/opam.scm: Update the call to opam->guix-package since repo is now expected to be a list and remove the mocked get-opam-repository deprecated by the support for local folders by the actual implementation. * doc/guix.texi: Document the new semantics and valid arguments for the --repo option. Signed-off-by: Julien Lepiller --- doc/guix.texi | 29 ++++++-- guix/import/opam.scm | 158 ++++++++++++++++++++++++++----------------- guix/scripts/import/opam.scm | 8 ++- tests/opam.scm | 68 +++++++++---------- 4 files changed, 159 insertions(+), 104 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 949d6d4092..5155e67481 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -95,6 +95,7 @@ Copyright @copyright{} 2021 Raghav Gururajan@* Copyright @copyright{} 2021 Domagoj Stolfa@* Copyright @copyright{} 2021 Hui Lu@* Copyright @copyright{} 2021 pukkamustard@* +Copyright @copyright{} 2021 Alice Brenon@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -11659,14 +11660,30 @@ Traverse the dependency graph of the given upstream package recursively and generate package expressions for all those packages that are not yet in Guix. @item --repo -Select the given repository (a repository name). Possible values include: +By default, packages are searched in the official OPAM repository. This +option, which can be used more than once, lets you add other repositories +which will be searched for packages. It accepts as valid arguments: + @itemize -@item @code{opam}, the default opam repository, -@item @code{coq} or @code{coq-released}, the stable repository for coq packages, -@item @code{coq-core-dev}, the repository that contains development versions of coq, -@item @code{coq-extra-dev}, the repository that contains development versions - of coq packages. +@item the name of a known repository - can be one of @code{opam}, + @code{coq} (equivalent to @code{coq-released}), + @code{coq-core-dev}, @code{coq-extra-dev} or @code{grew}. +@item the URL of a repository as expected by the @code{opam repository + add} command (for instance, the URL equivalent of the above + @code{opam} name would be @uref{https://opam.ocaml.org}). +@item the path to a local copy of a repository (a directory containing a + @file{packages/} sub-directory). @end itemize + +Repositories are assumed to be passed to this option by order of +preference. The additional repositories will not replace the default +@code{opam} repository, which is always kept as a fallback. + +Also, please note that versions are not compared accross repositories. +The first repository (from left to right) that has at least one version +of a given package will prevail over any others, and the version +imported will be the latest one found @emph{in this repository only}. + @end table @item go diff --git a/guix/import/opam.scm b/guix/import/opam.scm index a35b01d277..fe13d29f03 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Alice Brenon ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,21 +23,24 @@ #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 peg) + #:use-module ((ice-9 popen) #:select (open-pipe*)) #:use-module (ice-9 receive) - #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (ice-9 textual-ports) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) - #:use-module (web uri) + #:use-module ((srfi srfi-26) #:select (cut)) + #:use-module ((web uri) #:select (string->uri uri->string)) + #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p)) #:use-module (guix build-system) #:use-module (guix build-system ocaml) #:use-module (guix http-client) - #:use-module (guix git) #:use-module (guix ui) #:use-module (guix packages) #:use-module (guix upstream) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (cache-directory + version>? + call-with-temporary-output-file)) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) #:export (opam->guix-package @@ -121,51 +125,83 @@ (define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE)) (define-peg-pattern condition-var all (+ (or (range #\a #\z) "-" ":"))) -(define* (get-opam-repository #:optional repo) +(define (opam-cache-directory path) + (string-append (cache-directory) "/opam/" path)) + +(define known-repositories + '((opam . "https://opam.ocaml.org") + (coq . "https://coq.inria.fr/opam/released") + (coq-released . "https://coq.inria.fr/opam/released") + (coq-core-dev . "https://coq.inria.fr/opam/core-dev") + (coq-extra-dev . "https://coq.inria.fr/opam/extra-dev") + (grew . "http://opam.grew.fr"))) + +(define (get-uri repo-root) + (let ((archive-file (string-append repo-root "/index.tar.gz"))) + (or (string->uri archive-file) + (begin + (warning (G_ "'~a' is not a valid URI~%") archive-file) + 'bad-repo)))) + +(define (repo-type repo) + (match (assoc-ref known-repositories (string->symbol repo)) + (#f (if (file-exists? repo) + `(local ,repo) + `(remote ,(get-uri repo)))) + (url `(remote ,(get-uri url))))) + +(define (update-repository input) + "Make sure the cache for opam repository INPUT is up-to-date" + (let* ((output (opam-cache-directory (basename (port-filename input)))) + (cached-date (if (file-exists? output) + (stat:mtime (stat output)) + (begin (mkdir-p output) 0)))) + (when (> (stat:mtime (stat input)) cached-date) + (call-with-port + (open-pipe* OPEN_WRITE "tar" "xz" "-C" output "-f" "-") + (cut dump-port input <>))) + output)) + +(define* (get-opam-repository #:optional (repo "opam")) "Update or fetch the latest version of the opam repository and return the path to the repository." - (let ((url (cond - ((or (not repo) (equal? repo 'opam)) - "https://github.com/ocaml/opam-repository") - ((string-prefix? "coq-" (symbol->string repo)) - "https://github.com/coq/opam-coq-archive") - ((equal? repo 'coq) "https://github.com/coq/opam-coq-archive") - (else (throw 'unknown-repository repo))))) - (receive (location commit _) - (update-cached-checkout url) - (cond - ((or (not repo) (equal? repo 'opam)) - location) - ((equal? repo 'coq) - (string-append location "/released")) - ((string-prefix? "coq-" (symbol->string repo)) - (string-append location "/" (substring (symbol->string repo) 4))) - (else location))))) + (match (repo-type repo) + (('local p) p) + (('remote 'bad-repo) #f) ; to weed it out during filter-map in opam-fetch + (('remote r) (call-with-port (http-fetch/cached r) update-repository)))) ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests. (set! get-opam-repository get-opam-repository) -(define (latest-version versions) - "Find the most recent version from a list of versions." - (fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions)) +(define (get-version-and-file path) + "Analyse a candidate path and return an list containing information for proper + version comparison as well as the source path for metadata." + (and-let* ((metadata-file (string-append path "/opam")) + (filename (basename path)) + (version (string-join (cdr (string-split filename #\.)) "."))) + (and (file-exists? metadata-file) + (eq? 'regular (stat:type (stat metadata-file))) + (if (string-prefix? "v" version) + `(V ,(substring version 1) ,metadata-file) + `(digits ,version ,metadata-file))))) + +(define (keep-max-version a b) + "Version comparison on the lists returned by the previous function taking the + janestreet re-versioning into account (v-prefixed come first)." + (match (cons a b) + ((('V va _) . ('V vb _)) (if (version>? va vb) a b)) + ((('V _ _) . _) a) + ((_ . ('V _ _)) b) + ((('digits va _) . ('digits vb _)) (if (version>? va vb) a b)))) (define (find-latest-version package repository) "Get the latest version of a package as described in the given repository." - (let* ((dir (string-append repository "/packages/" package)) - (versions (scandir dir (lambda (name) (not (string-prefix? "." name)))))) - (if versions - (let ((versions (map - (lambda (dir) - (string-join (cdr (string-split dir #\.)) ".")) - versions))) - ;; Workaround for janestreet re-versionning - (let ((v-versions (filter (lambda (version) (string-prefix? "v" version)) versions))) - (if (null? v-versions) - (latest-version versions) - (string-append "v" (latest-version (map (lambda (version) (substring version 1)) v-versions)))))) - (begin - (format #t (G_ "Package not found in opam repository: ~a~%") package) - #f)))) + (let ((packages (string-append repository "/packages")) + (filter (make-regexp (string-append "^" package "\\.")))) + (reduce keep-max-version #f + (filter-map + get-version-and-file + (find-files packages filter #:directories? #t))))) (define (get-metadata opam-file) (with-input-from-file opam-file @@ -266,28 +302,30 @@ path to the repository." (define (depends->native-inputs depends) (filter (lambda (name) (not (equal? "" name))) - (map dependency->native-input depends))) + (map dependency->native-input depends))) (define (dependency-list->inputs lst) (map - (lambda (dependency) - (list dependency (list 'unquote (string->symbol dependency)))) - (ocaml-names->guix-names lst))) - -(define* (opam-fetch name #:optional (repository (get-opam-repository))) - (and-let* ((repository repository) - (version (find-latest-version name repository)) - (file (string-append repository "/packages/" name "/" name "." version "/opam"))) - `(("metadata" ,@(get-metadata file)) - ("version" . ,(if (string-prefix? "v" version) - (substring version 1) - version))))) - -(define* (opam->guix-package name #:key (repo 'opam) version) - "Import OPAM package NAME from REPOSITORY (a directory name) or, if -REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp + (lambda (dependency) + (list dependency (list 'unquote (string->symbol dependency)))) + (ocaml-names->guix-names lst))) + +(define* (opam-fetch name #:optional (repositories-specs '("opam"))) + (or (fold (lambda (repository others) + (match (find-latest-version name repository) + ((_ version file) `(("metadata" ,@(get-metadata file)) + ("version" . ,version))) + (_ others))) + #f + (filter-map get-opam-repository repositories-specs)) + (leave (G_ "package '~a' not found~%") name))) + +(define* (opam->guix-package name #:key (repo '()) version) + "Import OPAM package NAME from REPOSITORIES (a list of names, URLs or local +paths, always including OPAM's official repository). Return a 'package' sexp or #f on failure." - (and-let* ((opam-file (opam-fetch name (get-opam-repository repo))) + (and-let* ((with-opam (if (member "opam" repo) repo (cons "opam" repo))) + (opam-file (opam-fetch name with-opam)) (version (assoc-ref opam-file "version")) (opam-content (assoc-ref opam-file "metadata")) (url-dict (metadata-ref opam-content "url")) @@ -312,9 +350,7 @@ or #f on failure." (values `(package (name ,(ocaml-name->guix-name name)) - (version ,(if (string-prefix? "v" version) - (substring version 1) - version)) + (version ,version) (source (origin (method url-fetch) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index 64164e7cc4..834ac34cb0 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2021 Sarah Morgensen +;;; Copyright © 2021 Alice Brenon ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,7 +47,8 @@ Import and convert the opam package for PACKAGE-NAME.\n")) (display (G_ " -r, --recursive import packages recursively")) (display (G_ " - --repo import packages from this opam repository")) + --repo import packages from this opam repository (name, URL or local path) + can be used more than once")) (display (G_ " -V, --version display version information and exit")) (newline) @@ -81,7 +83,9 @@ Import and convert the opam package for PACKAGE-NAME.\n")) #:build-options? #f)) (let* ((opts (parse-options)) - (repo (and=> (assoc-ref opts 'repo) string->symbol)) + (repo (filter-map (match-lambda + (('repo . name) name) + (_ #f)) opts)) (args (filter-map (match-lambda (('argument . value) value) diff --git a/tests/opam.scm b/tests/opam.scm index f1e3b70cb0..1536b74339 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -82,41 +82,39 @@ url { (set! test-source-hash (call-with-input-file file-name port-sha256)))) (_ (error "Unexpected URL: " url))))) - (mock ((guix import opam) get-opam-repository - (const test-repo)) - (let ((my-package (string-append test-repo - "/packages/foo/foo.1.0.0"))) - (mkdir-p my-package) - (with-output-to-file (string-append my-package "/opam") - (lambda _ - (format #t "~a" test-opam-file)))) - (match (opam->guix-package "foo" #:repo test-repo) - (('package - ('name "ocaml-foo") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri "https://example.org/foo-1.0.0.tar.gz") - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'ocaml-build-system) - ('propagated-inputs - ('quasiquote - (("ocaml-zarith" ('unquote 'ocaml-zarith))))) - ('native-inputs - ('quasiquote - (("ocaml-alcotest" ('unquote 'ocaml-alcotest)) - ("ocamlbuild" ('unquote 'ocamlbuild))))) - ('home-page "https://example.org/") - ('synopsis "Some example package") - ('description "This package is just an example.") - ('license 'license:bsd-3)) - (string=? (bytevector->nix-base32-string - test-source-hash) - hash)) - (x - (pk 'fail x #f)))))) + (let ((my-package (string-append test-repo + "/packages/foo/foo.1.0.0"))) + (mkdir-p my-package) + (with-output-to-file (string-append my-package "/opam") + (lambda _ + (format #t "~a" test-opam-file)))) + (match (opam->guix-package "foo" #:repo (list test-repo)) + (('package + ('name "ocaml-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri "https://example.org/foo-1.0.0.tar.gz") + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'ocaml-build-system) + ('propagated-inputs + ('quasiquote + (("ocaml-zarith" ('unquote 'ocaml-zarith))))) + ('native-inputs + ('quasiquote + (("ocaml-alcotest" ('unquote 'ocaml-alcotest)) + ("ocamlbuild" ('unquote 'ocamlbuild))))) + ('home-page "https://example.org/") + ('synopsis "Some example package") + ('description "This package is just an example.") + ('license 'license:bsd-3)) + (string=? (bytevector->nix-base32-string + test-source-hash) + hash)) + (x + (pk 'fail x #f))))) ;; Test the opam file parser ;; We fold over some test cases. Each case is a pair of the string to parse and the -- cgit 1.4.1 From 79c07db3d52fb97f38de13d409264c5194e132fe Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Sat, 21 Aug 2021 12:29:44 +0100 Subject: doc: Work around po4a doc generation hangup. Multiple people are affected by 'guix pull' hangup. The reproducer is: $ po4a-translate -d -M UTF-8 -L UTF-8 -k 0 -f texinfo \ -m "doc/guix.texi" -p "po/doc/guix-manual.de.po" -l "doc/guix.de.texi.tmp" The regression is bisected down to commit fc29c80b9 ("guix: opam: More flexibility in the importer"). The workaround is to avoid multiline @code{...} directive. * doc/guix.texi: Avoid multiline @code{...} directive. Signed-off-by: Julien Lepiller --- doc/guix.texi | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 5155e67481..2b8448c856 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11668,9 +11668,10 @@ which will be searched for packages. It accepts as valid arguments: @item the name of a known repository - can be one of @code{opam}, @code{coq} (equivalent to @code{coq-released}), @code{coq-core-dev}, @code{coq-extra-dev} or @code{grew}. -@item the URL of a repository as expected by the @code{opam repository - add} command (for instance, the URL equivalent of the above - @code{opam} name would be @uref{https://opam.ocaml.org}). +@item the URL of a repository as expected by the + @code{opam repository add} command (for instance, the URL equivalent + of the above @code{opam} name would be + @uref{https://opam.ocaml.org}). @item the path to a local copy of a repository (a directory containing a @file{packages/} sub-directory). @end itemize -- cgit 1.4.1 From 2ca982ff41270288913ad6b7d5d9e1cad87b06d9 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 6 Aug 2021 16:33:02 -0400 Subject: gnu: bootloader: Support multiple targets. Fixes . * gnu/bootloader.scm (): New 'targets' field. (%bootloader-configuration-target): New procedure. (bootloader-configuration-target): Add deprecation warning. (bootloader-configuration-targets): New procedure. * guix/scripts/system.scm (install): Access targets via bootloader-configuration-targets. (perform-action)[bootloader-target]: Remove unused argument and update doc. Access targets via bootloader-configuration-targets and fix indentation. (process-action): Access targets via bootloader-configuration-targets. Do not provide the unused BOOTLOADER-TARGET argument when applying `perform-action'. * guix/scripts/system/reconfigure.scm (install-bootloader-program): Rename DEVICE argument to DEVICES. Adjust doc and comment. Apply `installer' and `disk-installer' for every DEVICES. (install-bootloader): Access targets via bootloader-configuration-targets and rename variable from DEVICE to DEVICES. * gnu/tests/install.scm: Adjust accordingly. * tests/guix-system.sh: Likewise. * gnu/tests/reconfigure.scm (run-install-bootloader-test): Adjust the DEVICES argument so that it is a list. * doc/guix.texi: Update doc. --- doc/guix.texi | 91 +++++++++++++++++++------------------ gnu/bootloader.scm | 22 ++++++++- gnu/tests/install.scm | 26 +++++------ gnu/tests/reconfigure.scm | 2 +- guix/scripts/system.scm | 20 ++++---- guix/scripts/system/reconfigure.scm | 22 +++++---- tests/guix-system.sh | 6 +-- 7 files changed, 108 insertions(+), 81 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 2b8448c856..6620f882f5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2569,14 +2569,15 @@ in particular: @itemize @item -Make sure the @code{bootloader-configuration} form refers to the target -you want to install GRUB on. It should mention @code{grub-bootloader} if -you are installing GRUB in the legacy way, or @code{grub-efi-bootloader} -for newer UEFI systems. For legacy systems, the @code{target} field -names a device, like @code{/dev/sda}; for UEFI systems it names a path -to a mounted EFI partition, like @code{/boot/efi}; do make sure the path is -currently mounted and a @code{file-system} entry is specified in your -configuration. +Make sure the @code{bootloader-configuration} form refers to the targets +you want to install GRUB on. It should mention @code{grub-bootloader} +if you are installing GRUB in the legacy way, or +@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems, +the @code{targets} field contain the names of the devices, like +@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted +EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths +are currently mounted and a @code{file-system} entry is specified in +your configuration. @item Be sure that your file system labels match the value of their respective @@ -13543,7 +13544,7 @@ the @code{bootloader} field should contain something along these lines: @lisp (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi")) + (targets '("/boot/efi"))) @end lisp @xref{Bootloader Configuration}, for more information on the available @@ -14758,7 +14759,7 @@ configuration would look like: (keyboard-layout (keyboard-layout "tr")) ;for the console (bootloader (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi") + (targets '("/boot/efi")) (keyboard-layout keyboard-layout))) ;for GRUB (services (cons (set-xorg-configuration (xorg-configuration ;for Xorg @@ -33188,11 +33189,11 @@ in ``legacy'' BIOS mode. through TFTP@. In combination with an NFS root file system this allows you to build a diskless Guix system. -The installation of the @code{grub-efi-netboot-bootloader} generates the content -of the TFTP root directory at @code{target} -(@pxref{Bootloader Configuration, @code{target}}), to be served by a TFTP server. - You may want to mount your TFTP server directory onto @code{target} to move the -required files to the TFTP server automatically. +The installation of the @code{grub-efi-netboot-bootloader} generates the +content of the TFTP root directory at @code{targets} (@pxref{Bootloader +Configuration, @code{targets}}), to be served by a TFTP server. You may +want to mount your TFTP server directories onto the @code{targets} to +move the required files to the TFTP server automatically. If you plan to use an NFS root file system as well (actually if you mount the store from an NFS share), then the TFTP server needs to serve the file @@ -33203,22 +33204,25 @@ files from the store will be accessed by GRUB through TFTP with their normal store path, for example as @file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}. -Two symlinks are created to make this possible. The first symlink is -@code{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to -@file{../../../boot/grub/grub.cfg}, -where @code{target} may be @file{/boot}. In this case the link is not leaving -the served TFTP root directory, but otherwise it does. The second link is -@code{target}@file{/gnu/store} and points to @file{../gnu/store}. This link -is leaving the served TFTP root directory. - -The assumption behind all this is that you have an NFS server exporting the root -file system for your Guix system, and additionally a TFTP server exporting your -@code{target} directory—usually @file{/boot}—from that same root file system for -your Guix system. In this constellation the symlinks will work. - -For other constellations you will have to program your own bootloader installer, -which then takes care to make necessary files from the store accessible through -TFTP, for example by copying them into the TFTP root directory at @code{target}. +Two symlinks are created to make this possible. For each target in the +@code{targets} field, the first symlink is +@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to +@file{../../../boot/grub/grub.cfg}, where @samp{target} may be +@file{/boot}. In this case the link is not leaving the served TFTP root +directory, but otherwise it does. The second link is +@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This +link is leaving the served TFTP root directory. + +The assumption behind all this is that you have an NFS server exporting +the root file system for your Guix system, and additionally a TFTP +server exporting your @code{targets} directories—usually a single +@file{/boot}—from that same root file system for your Guix system. In +this constellation the symlinks will work. + +For other constellations you will have to program your own bootloader +installer, which then takes care to make necessary files from the store +accessible through TFTP, for example by copying them into the TFTP root +directory to your @code{targets}. It is important to note that symlinks pointing outside the TFTP root directory may need to be allowed in the configuration of your TFTP server. Further the @@ -33230,18 +33234,19 @@ NFS servers, you also need a properly configured DHCP server to make the booting over netboot possible. For all this we can currently only recommend you to look for instructions about @acronym{PXE, Preboot eXecution Environment}. -@item @code{target} -This is a string denoting the target onto which to install the +@item @code{targets} +This is a list of strings denoting the targets onto which to install the bootloader. -The interpretation depends on the bootloader in question. For -@code{grub-bootloader}, for example, it should be a device name understood by -the bootloader @command{installer} command, such as @code{/dev/sda} or -@code{(hd0)} (@pxref{Invoking grub-install,,, grub, GNU GRUB Manual}). For -@code{grub-efi-bootloader}, it should be the mount point of the EFI file -system, usually @file{/boot/efi}. For @code{grub-efi-netboot-bootloader}, -@code{target} should be the mount point corresponding to the TFTP root -directory of your TFTP server. +The interpretation of targets depends on the bootloader in question. +For @code{grub-bootloader}, for example, they should be device names +understood by the bootloader @command{installer} command, such as +@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub, +GNU GRUB Manual}). For @code{grub-efi-bootloader}, they should be mount +points of the EFI file system, usually @file{/boot/efi}. For +@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount +points corresponding to TFTP root directories served by your TFTP +server. @item @code{menu-entries} (default: @code{()}) A possibly empty list of @code{menu-entry} objects (see below), denoting @@ -33657,7 +33662,7 @@ files, packages, and so on. It also creates other essential files needed for the system to operate correctly---e.g., the @file{/etc}, @file{/var}, and @file{/run} directories, and the @file{/bin/sh} file. -This command also installs bootloader on the target specified in +This command also installs bootloader on the targets specified in @file{my-os-config}, unless the @option{--no-bootloader} option was passed. @@ -34053,7 +34058,7 @@ evaluates to. As an example, @var{file} might contain a definition like this: (timezone "Etc/UTC") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vda") + (targets '("/dev/vda")) (terminal-outputs '(console)))) (file-systems (cons (file-system (mount-point "/") diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 6d7352ddd2..98807a4810 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -55,7 +55,8 @@ bootloader-configuration bootloader-configuration? bootloader-configuration-bootloader - bootloader-configuration-target + bootloader-configuration-target ;deprecated + bootloader-configuration-targets bootloader-configuration-menu-entries bootloader-configuration-default-entry bootloader-configuration-timeout @@ -183,7 +184,9 @@ record." bootloader-configuration make-bootloader-configuration bootloader-configuration? (bootloader bootloader-configuration-bootloader) ; - (target bootloader-configuration-target ;string + (targets %bootloader-configuration-targets ;list of strings + (default #f)) + (target %bootloader-configuration-target ;deprecated (default #f)) (menu-entries bootloader-configuration-menu-entries ;list of (default '())) @@ -204,6 +207,21 @@ record." (serial-speed bootloader-configuration-serial-speed ;integer | #f (default #f))) +;;; Deprecated. +(define (bootloader-configuration-target config) + (warning (G_ "the 'target' field is deprecated, please use 'targets' \ +instead~%")) + (%bootloader-configuration-target config)) + +(define (bootloader-configuration-targets config) + (or (%bootloader-configuration-targets config) + ;; TODO: Remove after the deprecated 'target' field is removed. + (list (bootloader-configuration-target config)) + ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this + ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f, + ;; hence the default value of '(#f) rather than '(). + (list #f))) + ;;; ;;; Bootloaders. diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 80604361e0..d7fafd210c 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -4,7 +4,7 @@ ;;; Copyright © 2020 Mathieu Othacehe ;;; Copyright © 2020 Danny Milosavljevic ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen -;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020, 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -97,7 +97,7 @@ (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) @@ -135,7 +135,7 @@ (bootloader (bootloader-configuration (bootloader extlinux-bootloader-gpt) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) @@ -418,7 +418,7 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vda"))) + (targets (list "/dev/vda")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) @@ -549,7 +549,7 @@ partition. In particular, home directories must be correctly created (see (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "root-fs")) @@ -626,7 +626,7 @@ where /gnu lives on a separate partition.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) ;; Add a kernel module for RAID-1 (aka. "mirror"). @@ -842,7 +842,7 @@ build (current-guix) and then store a couple of full system images.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (mapped-devices (list (mapped-device @@ -929,7 +929,7 @@ reboot\n") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (mapped-devices (list (mapped-device (source @@ -1029,7 +1029,7 @@ store a couple of full system images.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) @@ -1103,7 +1103,7 @@ build (current-guix) and then store a couple of full system images.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system @@ -1171,7 +1171,7 @@ RAID-0 (stripe) root partition.") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "btrfs-pool")) @@ -1264,7 +1264,7 @@ build (current-guix) and then store a couple of full system images.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) @@ -1337,7 +1337,7 @@ build (current-guix) and then store a couple of full system images.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index 52beeef447..001b5d185a 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -261,7 +261,7 @@ bootloader's configuration file." ;; would attempt to write directly to the virtual disk if the ;; installation script were run. (test - (install-bootloader-program #f #f #f bootcfg bootcfg-file #f "/"))))) + (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/"))))) (define %test-switch-to-system diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 40401d7e03..83bbefd3dc 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -253,7 +253,7 @@ the ownership of '~a' may be incorrect!~%") #:target target) (return (info (G_ "bootloader successfully installed on '~a'~%") - (bootloader-configuration-target bootloader)))))))) + (bootloader-configuration-targets bootloader)))))))) ;;; @@ -768,14 +768,13 @@ and TARGET arguments." skip-safety-checks? install-bootloader? dry-run? derivations-only? - use-substitutes? bootloader-target target + use-substitutes? target full-boot? container-shared-network? (mappings '()) (gc-root #f)) "Perform ACTION for IMAGE. INSTALL-BOOTLOADER? specifies whether to install -bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the -target root directory. +bootloader; TARGET is the target root directory. FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK? @@ -856,13 +855,13 @@ static checks." #:target (or target "/")) (return (info (G_ "bootloader successfully installed on '~a'~%") - (bootloader-configuration-target bootloader)))) + (bootloader-configuration-targets bootloader)))) (with-shepherd-error-handling - (upgrade-shepherd-services local-eval os) - (return (format #t (G_ "\ + (upgrade-shepherd-services local-eval os) + (return (format #t (G_ "\ To complete the upgrade, run 'herd restart SERVICE' to stop, upgrade, and restart each service that was not automatically restarted.\n"))) - (return (format #t (G_ "\ + (return (format #t (G_ "\ Run 'herd status' to view the list of services on your system.\n")))))) ((init) (newline) @@ -1218,9 +1217,9 @@ resulting from command-line parsing." (target-file (match args ((first second) second) (_ #f))) - (bootloader-target + (bootloader-targets (and bootloader? - (bootloader-configuration-target + (bootloader-configuration-targets (operating-system-bootloader os))))) (define (graph-backend) @@ -1269,7 +1268,6 @@ resulting from command-line parsing." opts) #:install-bootloader? bootloader? #:target target-file - #:bootloader-target bootloader-target #:gc-root (assoc-ref opts 'gc-root))))) #:target target #:system system))) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 49da6ecb16..bf23fb06af 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -207,10 +207,10 @@ services as defined by OS." (define (install-bootloader-program installer disk-installer bootloader-package bootcfg - bootcfg-file device target) + bootcfg-file devices target) "Return an executable store item that, upon being evaluated, will install -BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device, -at TARGET, a mount point, and subsequently run INSTALLER from +BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system +devices, at TARGET, a mount point, and subsequently run INSTALLER from BOOTLOADER-PACKAGE." (program-file "install-bootloader.scm" @@ -254,11 +254,17 @@ BOOTLOADER-PACKAGE." ;; The bootloader might not support installation on a ;; mounted directory using the BOOTLOADER-INSTALLER ;; procedure. In that case, fallback to installing the - ;; bootloader directly on DEVICE using the + ;; bootloader directly on DEVICES using the ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure. (if #$installer - (#$installer #$bootloader-package #$device #$target) - (#$disk-installer #$bootloader-package 0 #$device))) + (for-each (lambda (device) + (#$installer #$bootloader-package device + #$target)) + '#$devices) + (for-each (lambda (device) + (#$disk-installer #$bootloader-package + 0 device)) + '#$devices))) (lambda args (delete-file new-gc-root) (match args @@ -284,7 +290,7 @@ additional configurations specified by MENU-ENTRIES can be selected." (disk-installer (and run-installer? (bootloader-disk-image-installer bootloader))) (package (bootloader-package bootloader)) - (device (bootloader-configuration-target configuration)) + (devices (bootloader-configuration-targets configuration)) (bootcfg-file (bootloader-configuration-file bootloader))) (eval #~(parameterize ((current-warning-port (%make-void-port "w"))) (primitive-load #$(install-bootloader-program installer @@ -292,7 +298,7 @@ additional configurations specified by MENU-ENTRIES can be selected." package bootcfg bootcfg-file - device + devices target)))))) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 7e992e7bdb..6aab1f380a 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -115,7 +115,7 @@ cat > "$tmpfile" <: Replace by 'targets'. * gnu/bootloader/grub.scm: Likewise. * gnu/installer/parted.scm: Likewise. * gnu/machine/digital-ocean.scm: Likewise. * gnu/system/examples/asus-c201.tmpl: Likewise * gnu/system/examples/bare-bones.tmpl: Likewise * gnu/system/examples/bare-hurd.tmpl: Likewise * gnu/system/examples/beaglebone-black.tmpl: Likewise * gnu/system/examples/desktop.tmpl: Likewise * gnu/system/examples/docker-image.tmpl: Likewise * gnu/system/examples/lightweight-desktop.tmpl: Likewise * gnu/system/examples/vm-image.tmpl: Likewise * gnu/system/examples/yggdrasil.tmpl: Likewise * gnu/system/hurd.scm: Likewise * gnu/system/images/hurd.scm: Likewise * gnu/system/images/novena.scm: Likewise * gnu/system/images/pine64.scm: Likewise * gnu/system/images/pinebook-pro.scm: Likewise * gnu/system/images/rock64.scm: Likewise * gnu/system/install.scm: Likewise * gnu/system/vm.scm: Likewise * gnu/tests.scm: Likewise * gnu/tests/ganeti.scm: Likewise * gnu/tests/install.scm: Likewise * gnu/tests/nfs.scm: Likewise * gnu/tests/telephony.scm: Likewise * tests/boot-parameters.scm: Likewise * tests/system.scm: Likewise --- doc/guix-cookbook.texi | 2 +- gnu/bootloader/grub.scm | 5 +++-- gnu/installer/parted.scm | 4 ++-- gnu/machine/digital-ocean.scm | 2 +- gnu/system/examples/asus-c201.tmpl | 2 +- gnu/system/examples/bare-bones.tmpl | 2 +- gnu/system/examples/bare-hurd.tmpl | 2 +- gnu/system/examples/beaglebone-black.tmpl | 2 +- gnu/system/examples/desktop.tmpl | 2 +- gnu/system/examples/docker-image.tmpl | 2 +- gnu/system/examples/lightweight-desktop.tmpl | 2 +- gnu/system/examples/vm-image.tmpl | 2 +- gnu/system/examples/yggdrasil.tmpl | 2 +- gnu/system/hurd.scm | 2 +- gnu/system/images/hurd.scm | 2 +- gnu/system/images/novena.scm | 2 +- gnu/system/images/pine64.scm | 2 +- gnu/system/images/pinebook-pro.scm | 2 +- gnu/system/images/rock64.scm | 2 +- gnu/system/install.scm | 6 +++--- gnu/system/vm.scm | 2 +- gnu/tests.scm | 2 +- gnu/tests/ganeti.scm | 2 +- gnu/tests/install.scm | 4 ++-- gnu/tests/nfs.scm | 2 +- gnu/tests/telephony.scm | 2 +- tests/boot-parameters.scm | 2 +- tests/system.scm | 4 ++-- 28 files changed, 35 insertions(+), 34 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 5b1b4b5ea9..7f7dd98e06 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -1718,7 +1718,7 @@ operating-system dedicated to the @b{Pine A64 LTS} board. (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-pine64-lts-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index ce146aba3c..d8e888ff40 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -647,11 +647,12 @@ below the directory TARGET for the system whose root is mounted at MOUNT-POINT. MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point' or '/' for other 'guix system' commands. -TARGET is the target argument given to the bootloader-configuration in +Where TARGET comes from the targets argument given to the +bootloader-configuration in: (operating-system (bootloader (bootloader-configuration - (target \"/boot\") + (targets '(\"/boot\")) …)) …) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 1f9cec1d11..c000b1dec2 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1356,9 +1356,9 @@ from (gnu system mapped-devices) and return it." `((bootloader-configuration ,@(if (efi-installation?) `((bootloader grub-efi-bootloader) - (target ,(default-esp-mount-point))) + (targets (list ,(default-esp-mount-point)))) `((bootloader grub-bootloader) - (target ,root-partition-disk))) + (targets (list ,root-partition-disk)))) ;; XXX: Assume we defined the 'keyboard-layout' field of ;; right above. diff --git a/gnu/machine/digital-ocean.scm b/gnu/machine/digital-ocean.scm index d97c300d18..90b66a54d9 100644 --- a/gnu/machine/digital-ocean.scm +++ b/gnu/machine/digital-ocean.scm @@ -235,7 +235,7 @@ cat > /etc/bootstrap-config.scm << EOF (timezone \"Etc/UTC\") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target \"/dev/vda\") + (targets '(\"/dev/vda\")) (terminal-outputs '(console)))) (file-systems (cons (file-system (mount-point \"/\") diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl index c08f85367f..6b6aa706fa 100644 --- a/gnu/system/examples/asus-c201.tmpl +++ b/gnu/system/examples/asus-c201.tmpl @@ -14,7 +14,7 @@ ;; "my-root" is the label of the target root file system. (bootloader (bootloader-configuration (bootloader depthcharge-bootloader) - (target "/dev/mmcblk0p1"))) + (targets '("/dev/mmcblk0p1")))) ;; The ASUS C201PA requires a very particular kernel to boot, ;; as well as the following arguments. diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 1035ab1d60..387e4b12ba 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -15,7 +15,7 @@ ;; root file system. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl index 135ed23cb6..f0dd0cf742 100644 --- a/gnu/system/examples/bare-hurd.tmpl +++ b/gnu/system/examples/bare-hurd.tmpl @@ -32,7 +32,7 @@ (inherit %hurd-default-operating-system) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl index def05e807d..90dab62062 100644 --- a/gnu/system/examples/beaglebone-black.tmpl +++ b/gnu/system/examples/beaglebone-black.tmpl @@ -14,7 +14,7 @@ ;; the label of the target root file system. (bootloader (bootloader-configuration (bootloader u-boot-beaglebone-black-bootloader) - (target "/dev/mmcblk1"))) + (targets '("/dev/mmcblk1")))) ;; This module is required to mount the SD card. (initrd-modules (cons "omap_hsmmc" %base-initrd-modules)) diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl index 716b9feb8d..c928008c92 100644 --- a/gnu/system/examples/desktop.tmpl +++ b/gnu/system/examples/desktop.tmpl @@ -19,7 +19,7 @@ ;; Partition mounted on /boot/efi. (bootloader (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi") + (targets '("/boot/efi")) (keyboard-layout keyboard-layout))) ;; Specify a mapped device for the encrypted root partition. diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl index ca633cc838..bdc6afa6f0 100644 --- a/gnu/system/examples/docker-image.tmpl +++ b/gnu/system/examples/docker-image.tmpl @@ -35,7 +35,7 @@ ;; This will be ignored. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "does-not-matter"))) + (targets '("does-not-matter")))) ;; This will be ignored, too. (file-systems (list (file-system (device "does-not-matter") diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index d5a63dc457..d4330ecc8e 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -16,7 +16,7 @@ ;; Partition mounted on /boot/efi. (bootloader (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi"))) + (targets '("/boot/efi")))) ;; Assume the target root file system is labelled "my-root", ;; and the EFI System Partition has UUID 1234-ABCD. diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl index 697019e877..a59d91587b 100644 --- a/gnu/system/examples/vm-image.tmpl +++ b/gnu/system/examples/vm-image.tmpl @@ -51,7 +51,7 @@ accounts.\x1b[0m ;; Adjust as needed. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vda") + (targets '("/dev/vda")) (terminal-outputs '(console)))) (file-systems (cons (file-system (mount-point "/") diff --git a/gnu/system/examples/yggdrasil.tmpl b/gnu/system/examples/yggdrasil.tmpl index be80bf4de9..4d34f49b54 100644 --- a/gnu/system/examples/yggdrasil.tmpl +++ b/gnu/system/examples/yggdrasil.tmpl @@ -15,7 +15,7 @@ ;; root file system. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 95e511196a..e976494d74 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -110,7 +110,7 @@ (hurd hurd) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd #f) (initrd-modules (lambda _ '())) (firmware '()) diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index eac5b7f7e6..fc2dbe3209 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -42,7 +42,7 @@ (inherit %hurd-default-operating-system) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm index 1cd724ff88..63227af509 100644 --- a/gnu/system/images/novena.scm +++ b/gnu/system/images/novena.scm @@ -39,7 +39,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-novena-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '("sdhci-esdhc-imx" "ahci_imx" "i2c-dev")) ;(kernel linux-libre-arm-generic) (kernel-arguments '("console=ttymxc1,115200")) diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm index 613acd5cfd..808c71295f 100644 --- a/gnu/system/images/pine64.scm +++ b/gnu/system/images/pine64.scm @@ -38,7 +38,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-pine64-lts-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm index ca96621cc4..b6b844cef6 100644 --- a/gnu/system/images/pinebook-pro.scm +++ b/gnu/system/images/pinebook-pro.scm @@ -38,7 +38,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-pinebook-pro-rk3399-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm index 3f193e8528..68d3742adc 100644 --- a/gnu/system/images/rock64.scm +++ b/gnu/system/images/rock64.scm @@ -39,7 +39,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-rock64-rk3328-bootloader) - (target "/dev/sda"))) + (targets '("/dev/sda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 87da89e3fb..7b394184ad 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -454,7 +454,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m (name-service-switch %mdns-host-lookup-nss) (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sda"))) + (targets '("/dev/sda")))) (label (string-append "GNU Guix installation " (package-version guix))) @@ -530,7 +530,7 @@ operating-system's kernel-arguments (\"console=ttyS0\" or similar)." (bootloader (bootloader-configuration (bootloader (bootloader (inherit u-boot-bootloader) (package (make-u-boot-package board triplet)))) - (target bootloader-target))))) + (targets (list bootloader-target)))))) (define* (embedded-installation-os bootloader bootloader-target tty #:key (extra-modules '())) @@ -542,7 +542,7 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET." (inherit installation-os) (bootloader (bootloader-configuration (bootloader bootloader) - (target bootloader-target))) + (targets (list bootloader-target)))) (kernel linux-libre) (kernel-arguments (cons (string-append "console=" tty) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 0241810897..1e2d8b47c2 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -630,7 +630,7 @@ environment with the store shared with the host. MAPPINGS is a list of (bootloader (bootloader-configuration (inherit (operating-system-bootloader os)) (bootloader grub-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd (lambda (file-systems . rest) (apply (operating-system-initrd os) diff --git a/gnu/tests.scm b/gnu/tests.scm index eb636873a2..85f38ae8c9 100644 --- a/gnu/tests.scm +++ b/gnu/tests.scm @@ -222,7 +222,7 @@ the system under test." (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm index 19c26b86dd..b64a332dde 100644 --- a/gnu/tests/ganeti.scm +++ b/gnu/tests/ganeti.scm @@ -38,7 +38,7 @@ (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index d7fafd210c..130a4f76b0 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -494,7 +494,7 @@ reboot\n") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets '("/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "my-root")) @@ -709,7 +709,7 @@ by 'mdadm'.") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vdb"))) + (targets '("/dev/vdb")))) ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt ;; detection logic in 'enter-luks-passphrase'. diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 9b2b785176..a0c091eadb 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -50,7 +50,7 @@ (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems %base-file-systems) (users %base-user-accounts) (packages (cons* diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm index 1155a9dbc2..aeb6500c47 100644 --- a/gnu/tests/telephony.scm +++ b/gnu/tests/telephony.scm @@ -74,7 +74,7 @@ (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm index 3deae564c4..b2799d0596 100644 --- a/tests/boot-parameters.scm +++ b/tests/boot-parameters.scm @@ -81,7 +81,7 @@ (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sda"))) + (targets '("/dev/sda")))) (file-systems (cons* (file-system (device %default-root-device) (mount-point %root-path) diff --git a/tests/system.scm b/tests/system.scm index 9416b950e6..019c720e65 100644 --- a/tests/system.scm +++ b/tests/system.scm @@ -39,7 +39,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons %root-fs %base-file-systems)) (users %base-user-accounts))) @@ -56,7 +56,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (mapped-devices (list %luks-device)) (file-systems (cons (file-system (inherit %root-fs) -- cgit 1.4.1 From cefaa0e60726cf05fa7adff0f3949e57ba76b34a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 31 Aug 2021 22:21:10 +0200 Subject: doc: Correct name of Minetest importer. * doc/guix.texi (Invoking guix import): Let the item name be 'minetest' instead of 'contentdb'. Signed-off-by: Leo Prikler --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6620f882f5..d2819b259e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11323,7 +11323,7 @@ and generate package expressions for all those packages that are not yet in Guix. @end table -@item contentdb +@item minetest @cindex minetest @cindex ContentDB Import metadata from @uref{https://content.minetest.net, ContentDB}. -- cgit 1.4.1 From cc16103861b26836908a7d16e0751739a0e20da2 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 25 Aug 2021 03:00:44 +0200 Subject: gnu: gitolite: Add unsafe-pattern configuration option. * gnu/services/version-control.scm (gitolite-rc-file): Add unsafe-pattern field. (gitolite-rc-file-compiler): Write it. * doc/guix.texi (Version Control Services): Document it. --- doc/guix.texi | 13 +++++++++++++ gnu/services/version-control.scm | 8 +++++++- 2 files changed, 20 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index d2819b259e..ab178a6b06 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -31517,6 +31517,19 @@ A value like @code{#o0027} will give read access to the group used by Gitolite (by default: @code{git}). This is necessary when using Gitolite with software like cgit or gitweb. +@item @code{unsafe-pattern} (default: @code{#f}) +An optional Perl regular expression for catching unsafe configurations in +the configuration file. See +@uref{https://gitolite.com/gitolite/git-config.html#compensating-for-unsafe_patt, +Gitolite's documentation} for more information. + +When the value is not @code{#f}, it should be a string containing a Perl +regular expression, such as @samp{"[`~#\$\&()|;<>]"}, which is the default +value used by gitolite. It rejects any special character in configuration +that might be interpreted by a shell, which is useful when sharing the +administration burden with other people that do not otherwise have shell +access on the server. + @item @code{git-config-keys} (default: @code{""}) Gitolite allows you to set git config values using the @samp{config} keyword. This setting allows control over the config keys to accept. diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index 8cb5633165..ab86f82e62 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -54,6 +54,7 @@ gitolite-rc-file gitolite-rc-file-umask + gitolite-rc-file-unsafe-pattern gitolite-rc-file-git-config-keys gitolite-rc-file-roles gitolite-rc-file-enable @@ -226,6 +227,8 @@ access to exported repositories under @file{/srv/git}." gitolite-rc-file? (umask gitolite-rc-file-umask (default #o0077)) + (unsafe-pattern gitolite-rc-file-unsafe-pattern + (default #f)) (git-config-keys gitolite-rc-file-git-config-keys (default "")) (roles gitolite-rc-file-roles @@ -245,7 +248,7 @@ access to exported repositories under @file{/srv/git}." (define-gexp-compiler (gitolite-rc-file-compiler (file ) system target) (match file - (($ umask git-config-keys roles enable) + (($ umask unsafe-pattern git-config-keys roles enable) (apply text-file* "gitolite.rc" `("%RC = (\n" " UMASK => " ,(format #f "~4,'0o" umask) ",\n" @@ -264,6 +267,9 @@ access to exported repositories under @file{/srv/git}." " ],\n" ");\n" "\n" + ,(if unsafe-pattern + (string-append "$UNSAFE_PATT = qr(" unsafe-pattern ");") + "") "1;\n"))))) (define-record-type* -- cgit 1.4.1 From c60daa8e9dfa5f641ecb5f4f3a9135e27b58d2d7 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Thu, 5 Aug 2021 03:46:40 +0200 Subject: gnu: version-control: Add gitile service. * gnu/services/version-control.scm (gitile-service-type): New variable. * doc/guix.texi (Version Control Services): Document it. * gnu/tests/version-control.scm (%test-gitile): New variable. --- doc/guix.texi | 132 +++++++++++++++++++++++++++++++++++++ gnu/services/version-control.scm | 128 +++++++++++++++++++++++++++++++++++- gnu/tests/version-control.scm | 138 ++++++++++++++++++++++++++++++++++++++- 3 files changed, 395 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index ab178a6b06..36a0c7f5ec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25144,6 +25144,7 @@ of strings and G-expressions. @end table @end deffn +@anchor{NGINX} @subsubheading NGINX @deffn {Scheme Variable} nginx-service-type @@ -31544,6 +31545,137 @@ This setting controls the commands and features to enable within Gitolite. @end deftp +@subsubheading Gitile Service + +@cindex Gitile service +@cindex Git, forge +@uref{https://git.lepiller.eu/gitile, Gitile} is a Git forge for viewing +public git repository contents from a web browser. + +Gitile works best in collaboration with Gitolite, and will serve the public +repositories from Gitolite by default. The service should listen only on +a local port, and a webserver should be configured to serve static resources. +The gitile service provides an easy way to extend the Nginx service for +that purpose (@pxref{NGINX}). + +The following example will configure Gitile to serve repositories from a +custom location, with some default messages for the home page and the +footers. + +@lisp +(service gitile-service-type + (gitile-configuration + (repositories "/srv/git") + (base-git-url "https://myweb.site/git") + (index-title "My git repositories") + (intro '((p "This is all my public work!"))) + (footer '((p "This is the end"))) + (nginx-server-block + (nginx-server-configuration + (ssl-certificate + "/etc/letsencrypt/live/myweb.site/fullchain.pem") + (ssl-certificate-key + "/etc/letsencrypt/live/myweb.site/privkey.pem") + (listen '("443 ssl http2" "[::]:443 ssl http2")) + (locations + (list + ;; Allow for https anonymous fetch on /git/ urls. + (git-http-nginx-location-configuration + (git-http-configuration + (uri-path "/git/") + (git-root "/var/lib/gitolite/repositories"))))))))) +@end lisp + +In addition to the configuration record, you should configure your git +repositories to contain some optional information. First, your public +repositories need to contain the @file{git-daemon-export-ok} magic file +that allows Git to export the repository. Gitile uses the presence of this +file to detect public repositories it should make accessible. To do so with +Gitolite for instance, modify your @file{conf/gitolite.conf} to include +this in the repositories you want to make public: + +@example +repo foo + R = daemon +@end example + +In addition, Gitile can read the repository configuration to display more +infomation on the repository. Gitile uses the gitweb namespace for its +configuration. As an example, you can use the following in your +@file{conf/gitolite.conf}: + +@example +repo foo + R = daemon + desc = A long description, optionally with HTML, shown on the index page + config gitweb.name = The Foo Project + config gitweb.synopsis = A short description, shown on the main page of the project +@end example + +Do not forget to commit and push these changes once you are satisfied. You +may need to change your gitolite configuration to allow the previous +configuration options to be set. One way to do that is to add the +following service definition: + +@lisp +(service gitolite-service-type + (gitolite-configuration + (admin-pubkey (local-file "key.pub")) + (rc-file + (gitolite-rc-file + (umask #o0027) + ;; Allow to set any configuration key + (git-config-keys ".*") + ;; Allow any text as a valid configuration value + (unsafe-patt "^$"))))) +@end lisp + +@deftp {Data Type} gitile-configuration +Data type representing the configuration for @code{gitile-service-type}. + +@table @asis +@item @code{package} (default: @var{gitile}) +Gitile package to use. + +@item @code{host} (default: @code{"localhost"}) +The host on which gitile is listening. + +@item @code{port} (default: @code{8080}) +The port on which gitile is listening. + +@item @code{database} (default: @code{"/var/lib/gitile/gitile-db.sql"}) +The location of the database. + +@item @code{repositories} (default: @code{"/var/lib/gitolite/repositories"}) +The location of the repositories. Note that only public repositories will +be shown by Gitile. To make a repository public, add an empty +@file{git-daemon-export-ok} file at the root of that repository. + +@item @code{base-git-url} +The base git url that will be used to show clone commands. + +@item @code{index-title} (default: @code{"Index"}) +The page title for the index page that lists all the available repositories. + +@item @code{intro} (default: @code{'()}) +The intro content, as a list of sxml expressions. This is shown above the list +of repositories, on the index page. + +@item @code{footer} (default: @code{'()}) +The footer content, as a list of sxml expressions. This is shown on every +page served by Gitile. + +@item @code{nginx-server-block} +An nginx server block that will be extended and used as a reverse proxy by +Gitile to serve its pages, and as a normal web server to serve its assets. + +You can use this block to add more custom URLs to your domain, such as a +@code{/git/} URL for anonymous clones, or serving any other files you would +like to serve. +@end table +@end deftp + + @node Game Services @subsection Game Services diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index ab86f82e62..3315e80c6f 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2017 Oleg Pykhalov ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2018 Christopher Baines +;;; Copyright © 2021 Julien Lepiller ;;; ;;; This file is part of GNU Guix. ;;; @@ -59,7 +60,21 @@ gitolite-rc-file-roles gitolite-rc-file-enable - gitolite-service-type)) + gitolite-service-type + + gitile-configuration + gitile-configuration-package + gitile-configuration-host + gitile-configuration-port + gitile-configuration-database + gitile-configuration-repositories + gitile-configuration-git-base-url + gitile-configuration-index-title + gitile-configuration-intro + gitile-configuration-footer + gitile-configuration-nginx + + gitile-service-type)) ;;; Commentary: ;;; @@ -386,3 +401,114 @@ access to exported repositories under @file{/srv/git}." By default, the @code{git} user is used, but this is configurable. Additionally, Gitolite can integrate with with tools like gitweb or cgit to provide a web interface to view selected repositories."))) + +;;; +;;; Gitile +;;; + +(define-record-type* + gitile-configuration make-gitile-configuration gitile-configuration? + (package gitile-configuration-package + (default gitile)) + (host gitile-configuration-host + (default "127.0.0.1")) + (port gitile-configuration-port + (default 8080)) + (database gitile-configuration-database + (default "/var/lib/gitile/gitile-db.sql")) + (repositories gitile-configuration-repositories + (default "/var/lib/gitolite/repositories")) + (base-git-url gitile-configuration-base-git-url) + (index-title gitile-configuration-index-title + (default "Index")) + (intro gitile-configuration-intro + (default '())) + (footer gitile-configuration-footer + (default '())) + (nginx gitile-configuration-nginx)) + +(define (gitile-config-file host port database repositories base-git-url + index-title intro footer) + (define build + #~(write `(config + (port #$port) + (host #$host) + (database #$database) + (repositories #$repositories) + (base-git-url #$base-git-url) + (index-title #$index-title) + (intro #$intro) + (footer #$footer)) + (open-output-file #$output))) + + (computed-file "gitile.conf" build)) + +(define gitile-nginx-server-block + (match-lambda + (($ package host port database repositories + base-git-url index-title intro footer nginx) + (list (nginx-server-configuration + (inherit nginx) + (locations + (append + (list + (nginx-location-configuration + (uri "/") + (body + (list + #~(string-append "proxy_pass http://" #$host + ":" (number->string #$port) + "/;"))))) + (map + (lambda (loc) + (nginx-location-configuration + (uri loc) + (body + (list + #~(string-append "root " #$package "/share/gitile/assets;"))))) + '("/css" "/js" "/images")) + (nginx-server-configuration-locations nginx)))))))) + +(define gitile-shepherd-service + (match-lambda + (($ package host port database repositories + base-git-url index-title intro footer nginx) + (list (shepherd-service + (provision '(gitile)) + (requirement '(loopback)) + (documentation "gitile") + (start (let ((gitile (file-append package "/bin/gitile"))) + #~(make-forkexec-constructor + `(,#$gitile "-c" #$(gitile-config-file + host port database + repositories + base-git-url index-title + intro footer)) + #:user "gitile" + #:group "git"))) + (stop #~(make-kill-destructor))))))) + +(define %gitile-accounts + (list (user-group + (name "git") + (system? #t)) + (user-account + (name "gitile") + (group "git") + (system? #t) + (comment "Gitile user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define gitile-service-type + (service-type + (name 'gitile) + (description "Run Gitile, a small Git forge. Expose public repositories +on the web.") + (extensions + (list (service-extension account-service-type + (const %gitile-accounts)) + (service-extension shepherd-root-service-type + gitile-shepherd-service) + (service-extension nginx-service-type + gitile-nginx-server-block))))) diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index d3cf19c913..a7cde1f163 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -38,7 +38,8 @@ #:use-module (guix modules) #:export (%test-cgit %test-git-http - %test-gitolite)) + %test-gitolite + %test-gitile)) (define README-contents "Hello! This is what goes inside the 'README' file.") @@ -63,7 +64,10 @@ (invoke git "commit" "-m" "That's a commit.")) (mkdir-p "/srv/git") - (rename-file "/tmp/test-repo/.git" "/srv/git/test"))))) + (rename-file "/tmp/test-repo/.git" "/srv/git/test") + (with-output-to-file "/srv/git/test/git-daemon-export-ok" + (lambda _ + (display ""))))))) (define %test-repository-service ;; Service that creates /srv/git/test. @@ -416,3 +420,133 @@ HTTP-PORT." (name "gitolite") (description "Clone the Gitolite admin repository.") (value (run-gitolite-test)))) + +;;; +;;; Gitile. +;;; + +(define %gitile-configuration-nginx + (nginx-server-configuration + (root "/does/not/exists") + (try-files (list "$uri" "=404")) + (listen '("19418")) + (ssl-certificate #f) + (ssl-certificate-key #f))) + +(define %gitile-os + ;; Operating system under test. + (simple-operating-system + (service dhcp-client-service-type) + (simple-service 'srv-git activation-service-type + #~(mkdir-p "/srv/git")) + (service gitile-service-type + (gitile-configuration + (base-git-url "http://localhost") + (repositories "/srv/git") + (nginx %gitile-configuration-nginx))) + %test-repository-service)) + +(define* (run-gitile-test #:optional (http-port 19418)) + "Run tests in %GITOLITE-OS, which has nginx running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + %gitile-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((8081 . ,http-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "gitile") + + ;; XXX: Shepherd reads the config file *before* binding its control + ;; socket, so /var/run/shepherd/socket might not exist yet when the + ;; 'marionette' service is started. + (test-assert "shepherd socket ready" + (marionette-eval + `(begin + (use-modules (gnu services herd)) + (let loop ((i 10)) + (cond ((file-exists? (%shepherd-socket-file)) + #t) + ((> i 0) + (sleep 1) + (loop (- i 1))) + (else + 'failure)))) + marionette)) + + ;; Wait for nginx to be up and running. + (test-assert "nginx running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'nginx)) + marionette)) + + ;; Make sure the PID file is created. + (test-assert "PID file" + (marionette-eval + '(file-exists? "/var/run/nginx/pid") + marionette)) + + ;; Make sure Git test repository is created. + (test-assert "Git test repository" + (marionette-eval + '(file-exists? "/srv/git/test") + marionette)) + + (sleep 2) + + ;; Make sure we can access pages that correspond to our repository. + (letrec-syntax ((test-url + (syntax-rules () + ((_ path code) + (test-equal (string-append "GET " path) + code + (let-values (((response body) + (http-get (string-append + "http://localhost:8081" + path)))) + (response-code response)))) + ((_ path) + (test-url path 200))))) + (test-url "/") + (test-url "/css/gitile.css") + (test-url "/test") + (test-url "/test/commits") + (test-url "/test/tree" 404) + (test-url "/test/tree/-") + (test-url "/test/tree/-/README") + (test-url "/test/does-not-exist" 404) + (test-url "/test/tree/-/does-not-exist" 404) + (test-url "/does-not-exist" 404)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "gitile-test" test)) + +(define %test-gitile + (system-test + (name "gitile") + (description "Connect to a running Gitile server.") + (value (run-gitile-test)))) -- cgit 1.4.1