me
/
guix
Archived
1
0
Fork 0
Code

Merge remote-tracking branch 'origin/master' into staging 

With resolved conflicts in:
	gnu/packages/bittorrent.scm
	gnu/packages/databases.scm
	gnu/packages/geo.scm
	gnu/packages/gnupg.scm
	gnu/packages/gstreamer.scm
	gnu/packages/gtk.scm
	gnu/packages/linux.scm
	gnu/packages/python-xyz.scm
	gnu/packages/xorg.scm
	guix/build/qt-utils.scm
master
Maxim Cournoyer 2021-10-01 17:10:49 -04:00
parent 9c68ecb24d f1a3c11407
commit 2e65e4834a
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
840 changed files with 905024 additions and 175830 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.dir-locals.el
View File

@ -75,6 +75,7 @@
(eval . (put 'origin 'scheme-indent-function 0))
(eval . (put 'build-system 'scheme-indent-function 0))
(eval . (put 'bag 'scheme-indent-function 0))
(eval . (put 'gexp->derivation 'scheme-indent-function 1))
(eval . (put 'graft 'scheme-indent-function 0))
(eval . (put 'operating-system 'scheme-indent-function 0))
(eval . (put 'file-system 'scheme-indent-function 0))
@ -140,6 +141,8 @@
(eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
(eval . (put 'with-shepherd-action 'scheme-indent-function 3))
;; This notably allows '(' in Paredit to not insert a space when the
;; preceding symbol is one of these.
(eval . (modify-syntax-entry ?~ "'"))

9
.gitignore vendored
View File

@ -1,6 +1,7 @@
*.eps
*.go
*.log
*.mo
*.pdf
*.png
*.tar.xz
@ -73,9 +74,10 @@
/etc/guix-daemon.service
/etc/guix-publish.conf
/etc/guix-publish.service
/etc/guix-gc.service
/etc/init.d/guix-daemon
/etc/openrc/guix-daemon
/guix-daemon
/guix-*
/guix/config.scm
/libformat.a
/libstore.a
@ -93,6 +95,7 @@
/nix/config.h
/nix/config.h.in
/po/doc/*.mo
/po/doc/*.pot
/po/guix/*.gmo
/po/guix/*.insert-header
/po/guix/*.mo
@ -128,6 +131,7 @@
/po/packages/remove-potcdate.sin
/po/packages/stamp-po
/pre-inst-env
/release-*
/scripts/guix
/test-env
/test-tmp
@ -145,8 +149,9 @@ stamp-h[0-9]
tmp
/doc/os-config-lightweight-desktop.texi
/nix/scripts/download
/.tarball-version
/.version
/doc/stamp-[0-9]
/doc/stamp-*
/gnu/packages/bootstrap
/gnu/packages/aux-files/guile-guile-launcher.o
/guile

8
.guix-authorizations
View File

@ -23,7 +23,7 @@
"39B3 3C8D 9448 0D2D DCC2 A498 8B44 A0CD C7B9 56F2"
(name "bandali"))
(;; primary: "34FF 38BC D151 25A6 E340 A0B5 3453 2F9F AFCA 8B8E"
"A0C5 E352 2EF8 EF5C 64CD B7F0 FD73 CAC7 19D3 2566"
"A3A4 B419 0074 087C A7DE 5698 BC45 CA67 E2F8 D007"
(name "bavier"))
("45CC 63B8 5258 C9D5 5F34 B239 D37D 0EA7 CECC 3912"
(name "biscuolo"))
@ -73,21 +73,17 @@
(name "jlicht"))
("8141 6036 E81A 5CF7 8F80 1071 ECFC 8398 8B4E 4B9F"
(name "jonsger"))
("83B6 703A DCCA 3B69 4BCE 2DA6 E6A5 EE3C 1946 7A0D"
(name "kkebreau"))
("017D 74E2 7F58 5696 3801 781D F663 943E 08D8 092A"
(name "lbraun"))
("CA4F 8CF4 37D7 478F DA05 5FD4 4213 7701 1A37 8446"
(name "lbraun (professional)"))
("ACC2 3BA0 59F7 CCF4 08F0 43AD 442A 84B8 C70E 2F87"
(name "leoprikler"))
(name "lilyp"))
("45E5 75FA 53EA 8BD6 1BCE 0B4E 3ADC 75F0 13D6 78F9"
(name "leungbk"))
(;; primary: "4F71 6F9A 8FA2 C80E F1B5 E1BA 5E35 F231 DE1A C5E0"
"B051 5948 F1E7 D3C1 B980 38A0 2646 FA30 BACA 7F08"
(name "lfam"))
("148B CB8B D80B FB16 B1DE 0E91 45A8 B1E8 6BCD 10A6"
(name "lle_bout"))
("8887 84C4 1459 ACCB 83E7 E84C 634C 6E89 79FA BEC2"
(name "m1gu3l"))
("CBF5 9755 CBE7 E7EF EF18 3FB1 DD40 9A15 D822 469D"

14
.mailmap
View File

@ -15,6 +15,7 @@ Ben Woodcroft <donttrustben@gmail.com>
Ben Woodcroft <donttrustben@gmail.com> <b.woodcroft@uq.edu.au>
Ben Woodcroft <donttrustben@gmail.com> <donttrustben near gmail.com>
Brett Gilio <brettg@gnu.org> <brettg@posteo.net>
Christine Lemmer-Webber <cwebber@dustycloud.org>
Claes Wallin (韋嘉誠) <claes.wallin@greatsinodevelopment.com>
Cyprien Nicolas <cyprien@nicolas.tf> <c.nicolas+gitorious@gmail.com>
Daniel Pimentel <d4n1@d4n1.org> <d4n1@member.fsf.org>
@ -24,8 +25,8 @@ David Thompson <davet@gnu.org> <dthompson2@worcester.edu>
David Thompson <davet@gnu.org> <dthompson@member.fsf.org>
David Thompson <davet@gnu.org> <dthompson@vistahigherlearning.com>
Deck Pickard <deck.r.pickard@gmail.com> <nebu@kipple>
Eric Bavier <bavier@member.fsf.org> <ericbavier@gmail.com>
Eric Bavier <bavier@member.fsf.org> <bavier@posteo.net>
Eric Bavier <bavier@posteo.net> <ericbavier@gmail.com>
Eric Bavier <bavier@posteo.net> <bavier@member.fsf.org>
Eric Dvorsak <eric@dvorsak.fr> <yenda1@gmail.com>
George Clemmer <myglc2@gmail.com>
ison <ison@airmail.cc> <ison111@protonmail.com>
@ -38,16 +39,21 @@ Joshua Grant <tadni@riseup.net> <gzg@riseup.net>
Joshua Grant <tadni@riseup.net> <jgrant@parenthetical.io>
Joshua Grant <tadni@riseup.net> <tadnimi@gmail.com>
Joshua Grant <tadni@riseup.net> <youlysses@riseup.net>
Kei Kebreau <kei@openmailbox.org> <kkebreau@posteo.net>
Kei Kebreau <kkebreau@posteo.net>
Leo Famulari <leo@famulari.name> <lfamular@gmail.com>
Liliana Prikler <liliana.prikler@gmail.com> Leo Prikler <leo.prikler@student.tugraz.at>
Ludovic Courtès <ludo@gnu.org> <ludovic.courtes@inria.fr>
Marek Benc <dusxmt@gmx.com> <merkur32@gmail.com>
Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk>
Marius Bakke <marius@gnu.org> <mbakke@fastmail.com>
Marius Bakke <marius@gnu.org> <m.bakke@warwick.ac.uk>
Marius Bakke <marius@gnu.org> <marius.bakke@usit.uio.no>
Marius Bakke <marius@gnu.org> <mbakke@berlin.guixsd.org>
Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
Mathieu Othacehe <m.othacehe@gmail.com>
Mathieu Othacehe <mathieu.othacehe@parrot.com>
Mathieu Othacehe <othacehe@gnu.org>
Matthew James Kraai <kraai@ftbfs.org>
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
nikita <nikita@n0.is>
nikita <nikita@n0.is> ng0 <ng0@n0.is>

227
Makefile.am
View File

@ -15,6 +15,7 @@
# Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
# Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
# Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
# Copyright © 2021 Andrew Tropin <andrew@trop.in>
#
# This file is part of GNU Guix.
#
@ -141,6 +142,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 +205,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 \
@ -220,6 +223,7 @@ MODULES = \
guix/build/linux-module-build-system.scm \
guix/build/store-copy.scm \
guix/build/json.scm \
guix/build/pack.scm \
guix/build/utils.scm \
guix/build/union.scm \
guix/build/profiles.scm \
@ -248,8 +252,10 @@ MODULES = \
guix/import/cpan.scm \
guix/import/cran.scm \
guix/import/crate.scm \
guix/import/egg.scm \
guix/import/elpa.scm \
guix/import/gem.scm \
guix/import/git.scm \
guix/import/github.scm \
guix/import/gnome.scm \
guix/import/gnu.scm \
@ -258,10 +264,10 @@ 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 \
guix/import/snix.scm \
guix/import/stackage.scm \
guix/import/texlive.scm \
guix/import/utils.scm \
@ -290,17 +296,20 @@ MODULES = \
guix/scripts/system.scm \
guix/scripts/system/search.scm \
guix/scripts/system/reconfigure.scm \
guix/scripts/home.scm \
guix/scripts/home/import.scm \
guix/scripts/lint.scm \
guix/scripts/challenge.scm \
guix/scripts/import/crate.scm \
guix/scripts/import/cran.scm \
guix/scripts/import/egg.scm \
guix/scripts/import/elpa.scm \
guix/scripts/import/gem.scm \
guix/scripts/import/gnu.scm \
guix/scripts/import/go.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/json.scm \
guix/scripts/import/nix.scm \
guix/scripts/import/minetest.scm \
guix/scripts/import/opam.scm \
guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm \
@ -365,10 +374,10 @@ AUX_FILES = \
gnu/packages/aux-files/chromium/master-preferences.json \
gnu/packages/aux-files/emacs/guix-emacs.el \
gnu/packages/aux-files/guix.vim \
gnu/packages/aux-files/linux-libre/5.11-arm.conf \
gnu/packages/aux-files/linux-libre/5.11-arm64.conf \
gnu/packages/aux-files/linux-libre/5.11-i686.conf \
gnu/packages/aux-files/linux-libre/5.11-x86_64.conf \
gnu/packages/aux-files/linux-libre/5.14-arm.conf \
gnu/packages/aux-files/linux-libre/5.14-arm64.conf \
gnu/packages/aux-files/linux-libre/5.14-i686.conf \
gnu/packages/aux-files/linux-libre/5.14-x86_64.conf \
gnu/packages/aux-files/linux-libre/5.10-arm.conf \
gnu/packages/aux-files/linux-libre/5.10-arm64.conf \
gnu/packages/aux-files/linux-libre/5.10-i686.conf \
@ -451,6 +460,7 @@ SCM_TESTS = \
tests/debug-link.scm \
tests/derivations.scm \
tests/discovery.scm \
tests/egg.scm \
tests/elpa.scm \
tests/file-systems.scm \
tests/gem.scm \
@ -459,14 +469,15 @@ SCM_TESTS = \
tests/git-authenticate.scm \
tests/glob.scm \
tests/gnu-maintenance.scm \
tests/go.scm \
tests/grafts.scm \
tests/graph.scm \
tests/gremlin.scm \
tests/hackage.scm \
tests/import-git.scm \
tests/import-utils.scm \
tests/inferior.scm \
tests/lint.scm \
tests/minetest.scm \
tests/modules.scm \
tests/monads.scm \
tests/nar.scm \
@ -486,10 +497,11 @@ SCM_TESTS = \
tests/search-paths.scm \
tests/services.scm \
tests/services/file-sharing.scm \
tests/services/configuration.scm \
tests/services/linux.scm \
tests/services/telephony.scm \
tests/sets.scm \
tests/size.scm \
tests/snix.scm \
tests/status.scm \
tests/store-database.scm \
tests/store-deduplication.scm \
@ -508,6 +520,12 @@ SCM_TESTS = \
tests/uuid.scm \
tests/workers.scm
if HAVE_GUILE_LIB
SCM_TESTS += tests/go.scm
else
EXTRA_DIST += tests/go.scm
endif
if BUILD_DAEMON_OFFLOAD
SCM_TESTS += tests/offload.scm
else
@ -582,7 +600,8 @@ check-system: $(GOBJECTS)
dist_pkgdata_DATA = \
etc/substitutes/berlin.guix.gnu.org.pub \
etc/substitutes/ci.guix.gnu.org.pub \
etc/substitutes/ci.guix.info.pub
etc/substitutes/ci.guix.info.pub \
etc/substitutes/bordeaux.guix.gnu.org.pub
# Bash completion file.
dist_bashcompletion_DATA = etc/completion/bash/guix \
@ -606,9 +625,11 @@ EXTRA_DIST += \
.guix-authorizations \
.guix-channel \
scripts/guix.in \
etc/disarchive-manifest.scm \
etc/guix-install.sh \
etc/news.scm \
etc/release-manifest.scm \
etc/source-manifest.scm \
etc/system-tests.scm \
etc/historical-authorizations \
build-aux/build-self.scm \
@ -658,15 +679,53 @@ CLEANFILES = \
# the whole thing. Likewise, set 'XDG_CACHE_HOME' to avoid loading possibly
# stale files from ~/.cache/guile/ccache.
%.go: make-go ; @:
make-go: $(MODULES) guix/config.scm $(dist_noinst_DATA)
$(AM_V_at)echo "Compiling Scheme modules..." ; \
unset GUILE_LOAD_COMPILED_PATH ; \
XDG_CACHE_HOME=/nowhere \
host=$(host) srcdir="$(top_srcdir)" \
$(top_builddir)/pre-inst-env \
$(GUILE) -L "$(top_builddir)" -L "$(top_srcdir)" \
--no-auto-compile \
-s "$(top_srcdir)"/build-aux/compile-all.scm $^
make-go: make-core-go make-packages-go make-system-go make-cli-go
# Define a rule to build a subset of the .go files.
define guile-compilation-rule
$(1): $(2)
$(AM_V_at)echo "Compiling Scheme modules..." ; \
unset GUILE_LOAD_COMPILED_PATH ; \
XDG_CACHE_HOME=/nowhere \
host=$(host) srcdir="$(top_srcdir)" \
$(top_builddir)/pre-inst-env \
$(GUILE) -L "$(top_builddir)" -L "$(top_srcdir)" \
--no-auto-compile \
-s "$(top_srcdir)"/build-aux/compile-all.scm \
--total $(words $(MODULES)) \
--completed $(3) \
$$(filter %.scm,$$^)
.PHONY: $(1)
endef
# Split compilation in several steps, each of which building a subset of
# $(MODULES). The main goal is to reduce peak memory consumption, as reported
# in <https://issues.guix.gnu.org/48963>. Each 'eval' call below creates a
# 'make-*-go' phony target that builds the corresponding subset.
MODULES_CORE = guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULES)))
MODULES_PACKAGES = $(filter gnu/packages/%,$(MODULES))
MODULES_SYSTEM = gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES)))
MODULES_CLI = $(filter guix/scripts/%,$(MODULES))
$(eval $(call guile-compilation-rule,make-core-go, \
$(MODULES_CORE) guix/config.scm $(dist_noinst_DATA), \
0))
$(eval $(call guile-compilation-rule,make-packages-go, \
$(MODULES_PACKAGES) make-core-go, \
$(words $(MODULES_CORE))))
$(eval $(call guile-compilation-rule,make-system-go, \
$(MODULES_SYSTEM) make-packages-go make-core-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES))))
$(eval $(call guile-compilation-rule,make-cli-go, \
$(MODULES_CLI) make-system-go make-packages-go make-core-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES) $(MODULES_SYSTEM))))
SUFFIXES = .go
@ -733,22 +792,22 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
--enable-daemon \
ac_cv_guix_test_root="$(GUIX_TEST_ROOT)"
# Name of the 'guix' package shipped in the binary tarball.
GUIX_FOR_BINARY_TARBALL = guix
# The self-contained tarball.
guix-binary.%.tar.xz:
$(AM_V_GEN)GUIX_PACKAGE_PATH= \
tarball=`$(top_builddir)/pre-inst-env guix pack -C xz \
--fallback \
-s "$*" --localstatedir --profile-name=current-guix \
$(GUIX_FOR_BINARY_TARBALL)` ; \
guix` ; \
cp "$$tarball" "$@.tmp" ; mv "$@.tmp" "$@"
# The dependency on doc-pot-update is to generate the .pot files, which are
# not checked in.
dist: doc-pot-update
dist-hook: gen-ChangeLog gen-AUTHORS gen-tarball-version
dist-hook: assert-no-store-file-names
dist-hook: doc-po-update
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
@ -829,21 +888,20 @@ system_flags = $(foreach system,$(1),-s $(system))
# The release process works in several phases:
#
# 0. We assume the developer created a 'vX.Y' tag.
# 0. We assume the developer created a 'vX.Y.Z' tag.
# 1. Build the source tarball.
# 2. Update the 'guix' package so that it corresponds to the 'vX.Y' tag.
# 2. Update the 'guix' package so that it corresponds to the 'vX.Y.Z' tag.
# 3. Build the binary tarballs for that 'guix' package.
# 4. Update the 'guix' package again.
# 5. Build the installation images. The images will run 'guix'
# corresponding to 'vX.Y' + 1 commit, and they will install 'vX.Y'.
# 5. Build the installation and VM images. The images will run 'guix'
# corresponding to 'vX.Y.Z' + 1 commit, and they will install 'vX.Y.Z'.
#
# This 'release' target takes care of everything and copies the resulting
# files to $(releasedir).
#
# XXX: Depend on 'dist' rather than 'distcheck' to work around the Gettext
# issue described at <https://savannah.gnu.org/bugs/index.php?51027>.
release: dist-with-updated-version
cd po; git checkout .
release: dist-with-updated-version all
@if ! git diff-index --quiet HEAD; then \
echo "There are uncommitted changes; stopping." >&2 ; \
exit 1 ; \
@ -851,21 +909,24 @@ release: dist-with-updated-version
$(MKDIR_P) "$(releasedir)"
rm -f "$(releasedir)"/*
mv $(SOURCE_TARBALLS) "$(releasedir)"
# Bump the Guix package version and build it.
GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT=yes \
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-guix-package.scm \
"`git rev-parse HEAD`" "$(PACKAGE_VERSION)"
git add $(top_srcdir)/gnu/packages/package-management.scm
git commit -m "gnu: guix: Update to $(PACKAGE_VERSION)."
$(top_builddir)/pre-inst-env guix build $(GUIX_FOR_BINARY_TARBALL) \
$(top_builddir)/pre-inst-env guix build guix \
$(call system_flags,$(SUPPORTED_SYSTEMS)) \
-v1 --no-grafts --fallback
# Generate the binary release tarballs.
rm -f $(BINARY_TARBALLS)
$(MAKE) $(BINARY_TARBALLS)
for system in $(SUPPORTED_SYSTEMS) ; do \
mv "guix-binary.$$system.tar.xz" \
"$(releasedir)/guix-binary-$(PACKAGE_VERSION).$$system.tar.xz" ; \
done
# Bump the Guix package version and build it (again).
GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT=yes \
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-guix-package.scm \
@ -875,9 +936,10 @@ release: dist-with-updated-version
$(top_builddir)/pre-inst-env guix build guix \
$(call system_flags,$(GUIX_SYSTEM_SUPPORTED_SYSTEMS)) \
-v1 --no-grafts --fallback
# Generate the ISO installation images.
for system in $(GUIX_SYSTEM_SUPPORTED_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system disk-image -t iso9660 \
guix system image -t iso9660 \
--label="GUIX_$${system}_$(VERSION)" \
--system=$$system --fallback \
gnu/system/install.scm` ; \
@ -885,13 +947,14 @@ release: dist-with-updated-version
echo "failed to produced Guix installation image for $$system" >&2 ; \
exit 1 ; \
fi ; \
xz < "$$image" > "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz.tmp" ; \
mv "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz.tmp" \
"$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz" ; \
cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" ; \
mv "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" \
"$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso" ; \
done
# Generate the VM images.
for system in $(GUIX_SYSTEM_VM_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system vm-image $(GUIX_SYSTEM_VM_IMAGE_FLAGS) \
guix system image -t qcow2 $(GUIX_SYSTEM_VM_IMAGE_FLAGS) \
--save-provenance \
--system=$$system --fallback \
gnu/system/examples/vm-image.tmpl` ; \
@ -899,9 +962,7 @@ release: dist-with-updated-version
echo "failed to produced Guix VM image for $$system" >&2 ; \
exit 1 ; \
fi ; \
xz < "$$image" > "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz.tmp" ; \
mv "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz.tmp" \
"$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz" ; \
cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.qcow2"; \
done
@echo
@echo "Congratulations! All the release files are now in $(releasedir)."
@ -969,76 +1030,32 @@ cuirass-jobs: $(GOBJECTS)
# Downloading up-to-date PO files.
# make-download-po-rule DOMAIN DIRECTORY [FILE-NAME-PREFIX]
define make-download-po-rule
WEBLATE_REPO = https://framagit.org/tyreunom/guix-translations
download-po.$(1):
if [ -f "$(top_srcdir)/$(2)/LINGUAS" ]; then \
LINGUAS="`grep -v '^[[:blank:]]*#' < $(top_srcdir)/$(2)/LINGUAS`" ; \
else \
LINGUAS="`(cd $(top_srcdir)/$(2); \
for i in *.po; do echo $$$$i; done) | cut -d . -f 2`" ; \
fi ; \
for lang in $$$$LINGUAS; do \
if wget -nv -O "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" \
"https://translate.fedoraproject.org/api/translations/guix/$(1)/$$$$lang/file/" ; \
then \
msgfilter --no-wrap -i "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" \
cat > "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp2" ; \
rm "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" ; \
mv "$(top_srcdir)/$(2)/$(3)$$$$lang.po"{.tmp2,} ; \
else \
rm "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" ; \
fi ; \
done
.PHONY: download-po.$(1)
endef
# Checking po files for issues. This is useful to run after downloading new
# po files.
# make-check-po-rule DOMAIN DIRECTORY [FILE-NAME-PREFIX]
define make-check-po-rule
check-po.$(1):
if [ -f "$(top_srcdir)/$(2)/LINGUAS" ]; then \
LINGUAS="`grep -v '^[[:blank:]]*#' < $(top_srcdir)/$(2)/LINGUAS`" ; \
else \
LINGUAS="`(cd $(top_srcdir)/$(2); \
for i in *.po; do echo $$$$i; done) | cut -d . -f 2`" ; \
fi ; \
for lang in $$$$LINGUAS; do \
if [ -f "$(top_srcdir)/$(2)/$(3)$$$$lang.po" ]; \
then \
if ! msgfmt -c "$(top_srcdir)/$(2)/$(3)$$$$lang.po" ; \
then \
exit 1 ; \
fi ; \
fi ; \
done
.PHONY: check-po.$(1)
endef
$(eval $(call make-download-po-rule,documentation-cookbook,po/doc,guix-cookbook.))
$(eval $(call make-download-po-rule,documentation-manual,po/doc,guix-manual.))
$(eval $(call make-download-po-rule,guix,po/guix))
$(eval $(call make-download-po-rule,packages,po/packages))
$(eval $(call make-check-po-rule,documentation-cookbook,po/doc,guix-cookbook.))
$(eval $(call make-check-po-rule,documentation-manual,po/doc,guix-manual.))
$(eval $(call make-check-po-rule,guix,po/guix))
$(eval $(call make-check-po-rule,packages,po/packages))
download-po: $(foreach domain,guix packages documentation-manual documentation-cookbook,download-po.$(domain))
# Shallow clone the Git repository behind Weblate and copy files from it if
# they contain at least one translation, and they are well-formed (Scheme
# format only), warn otherwise. Copied files are converted to a canonical
# form.
download-po:
dir=$$(mktemp -d); \
git clone --depth 1 "$(WEBLATE_REPO)" "$$dir/translations"; \
for domain in po/doc po/guix po/packages; do \
for po in "$$dir/translations/$$domain"/*.po; do \
translated=$$(LANG=en_US.UTF-8 msgfmt --statistics "$$po" 2>&1 | cut -f1 -d' '); \
target=$$(basename "$$po"); \
target="$$domain/$$target"; \
if msgfmt -c "$$po" && [ "$$translated" != "0" ]; then \
msgfilter --no-wrap -i "$$po" cat > "$$po".tmp; \
mv "$$po".tmp "$$target"; \
echo "copied $$target."; \
else \
echo "WARN: $$target ($$translated translated messages) was not added/updated."; \
fi; \
done; \
done; \
rm -rf "$$dir"
.PHONY: download-po
check-po: $(foreach domain,guix packages documentation-manual documentation-cookbook,check-po.$(domain))
.PHONY: check-po
## -------------- ##
## Silent rules. ##
## -------------- ##

153
NEWS
View File

@ -2,8 +2,9 @@
#+TITLE: Guix NEWS – history of user-visible changes
#+STARTUP: content hidestars
Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
@ -11,6 +12,156 @@ Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
Please send Guix bug reports to bug-guix@gnu.org.
* Changes in 1.4.0 (since 1.3.0)
** Package management
*** New ‘deb’ format for the ‘guix pack’ command
*** New ‘guix import minetest’ command, to import Minetest extensions
*** ‘guix import elpa’ now supports the non-GNU ELPA repository
*** New updater (see ‘guix refresh’): ‘generic-git’
*** ‘--with-commit’ option now accepts strings returned by ‘git describe’
** Distribution
*** The installation script can now enable local substitute servers discovery
*** More control over boot-time file system checks and repairs
*** XFS file systems can be created by the installer and mounted by label/UUID
** Programming interfaces
*** (guix records) now supports “field sanitizers”
** Noteworthy bug fixes
*** Fall back to Software Heritage when cloning a channel
(<https://issues.guix.gnu.org/44187>)
*** ‘--with-patch’ can be used on packages with non-origin sources
(<https://issues.guix.gnu.org/49697>)
*** Fix pathological profile building performance in the presence of grafts
(<https://issues.guix.gnu.org/49439>)
* Changes in 1.3.0 (since 1.2.0)
** Package management
*** POWER9 (powerpc64le-linux) is now supported as a technology preview
*** New ‘--export-manifest’ and ‘--export-channels’ options of ‘guix package’
*** New ‘--profile’ option for ‘guix environment’
*** New ‘--discover’ option of ‘guix-daemon’, for local substitute discovery
*** New ‘--advertise’ option of ‘guix publish’
*** New ‘--with-patch’ and ‘--with-latest’ package transformation options
*** ‘guix system image’ supersedes the ‘disk-image’ and ‘vm-image’ sub-commands
*** ‘--verbosity=1’ no longer displays download URLs
*** ‘guix publish -C’ now supports zstd compression via Guile-zstd
*** ‘guix-daemon’ now supports zstd substitutes, which decompress faster
*** New ‘guix import go’ command, to import Go packages
*** ‘guix import opam’ now supports Coq packages and has a ‘--repo’ option
*** ‘guix import crate’ now honors semantic versioning (“semver”)
*** ‘guix import nix’ has been removed
*** New updaters (see ‘guix refresh’): ‘sourceforge’ and ‘generic-html’
*** Substitute installation has been optimized
*** ‘guix’ commands suggest alternative sub-commands or options upon typos
*** Offloading no longer requires ‘guile’ to be in $PATH on build machines
*** ‘GUIX_EXTENSIONS_PATH’ is honored when looking for extensions such as GWL
*** New ‘--format’ option for ‘guix processes’
*** ‘guix upgrade’ can now be passed several regexps
** Distribution
*** The Guix System demonstration VM now supports the SPICE protocol
*** The installation script can now run in a fully automated manner
*** ‘qemu-binfmt-service-type’ now relies on statically-linked QEMU
*** ‘sysctl-service-type’ enables Linux protected hardlinks/symlinks by default
*** ‘%base-services’ now includes a default ‘sysctl-service-type’ instance
*** Linux Logical Volumne Manager (LVM) now supported, via ‘lvm-device-mapping’
*** ‘guix system init’ has been optimized
*** ‘guix system’ warns when users/groups appear more than once
*** ‘guix system image -t rock64-raw’ produces images for Rock64 devices
*** ‘herd discover guix-daemon on’ turns on substitute server discovery
*** Default initrd now supports bcachefs
*** CUPS service includes ‘brlaser’ extension by default
*** “lp” group is no longer included in ‘%base-groups’
*** New ‘--graph-backend’ option for ‘guix system {extension,shepherd}-graph’
*** New services
agate, cuirass-remote-worker, ipfs, keepalived, laminar, radicale, syncthing,
transmission-daemon, wireguard, xorg-server
*** 2009 new packages
*** 3100 package updates
Noteworthy updates:
emacs 27.2, gcc-toolchain 10.3.0, ghc 8.8.3, glibc 2.31, gnome 3.34.5,
gnupg 2.2.27, go 1.14.15, guile 3.0.5, icecat 78.10.0-guix0-preview1,
icedtea 3.7.0, inkscape 1.0.2, julia 1.5.3, libreoffice 6.4.7.2,
linux-libre 5.11.15, ocaml 4.11.1, octave 6.2.0, openjdk 14.0,
python 3.8.2, racket 8.0, rust 1.51.0, r 4.0.4, sbcl 2.1.3, xfce 4.16.0,
xorg-server 1.20.10
** Programming interfaces
*** New ‘channel-with-substitutes-available’ procedure in (guix channels)
*** New modules (guix substitutes), (guix narinfo), and (guix avahi)
*** <image> records can be passed to ‘guix system image’
*** New (guix ipfs) module to interact with an IPFS gateway
** Noteworthy bug fixes
*** Risk of local privilege escalation via guix-daemon fixed
(<https://issues.guix.gnu.org/47229>, CVE-2021-27851)
*** Setuid programs on Guix System are no longer setgid root
(<https://issues.guix.gnu.org/46395>)
*** Risk of local privilege escalation during reconfigure fixed
(<https://issues.guix.gnu.org/47584>)
*** Grafting recognizes UTF-16 and UTF-32 store references
(<https://issues.guix.gnu.org/33848>)
*** (guix git) honors HTTP/HTTPS proxy settings for Git submodules
(<https://issues.guix.gnu.org/44593>)
*** Fix ‘guix substitute’ crash when interleaving lzip and gzip
(<https://issues.guix.gnu.org/46967>)
*** Fix GnuTLS memory corruption when used from Guile
(<https://issues.guix.gnu.org/46330>)
*** Update GnuTLS to 3.6.15, addressing a time-dependent test failure
(<https://issues.guix.gnu.org/44559>)
*** Booted system is fully protected from garbage collection
(<https://issues.guix.gnu.org/46767>)
*** Add MSDOS disk label support on UEFI systems
(<https://issues.guix.gnu.org/47889>)
*** Installer’s kmscon no longer uses up 100% CPU
(<https://issues.guix.gnu.org/39341>)
*** Git checkouts can be updated to the remote’s default HEAD
(<https://issues.guix.gnu.org/45187>)
*** ‘guix pull’ correctly displays early builds and downloads
(<https://issues.guix.gnu.org/41930>)
*** Fix OpenRC init scripts for ‘guix-daemon’
(<https://issues.guix.gnu.org/46871>)
*** Activate system when switching generations
(<https://issues.guix.gnu.org/38884>)
*** ‘guix environment -C’ preserves original mount flags
(<https://issues.guix.gnu.org/46292>)
*** Remove duplicates in profile transactions
(<https://issues.guix.gnu.org/23874>)
*** Fix sound problems with ALSA plugins on foreign distros
(<https://issues.guix.gnu.org/40832>)
** Native language support
*** Updated translations of the manual
The manual is fully translated into French and German, 90% translated into
Spanish, and has preliminary translations into Chinese, Brazilian Portuguese,
and Russian.
*** Update translations of the cookbook
The cookbook is fully translated in French and German and has a preliminary
translation into Korean.
*** Updated translations of messages
This version of Guix is fully translated in French, German, and Slovak; it has
good translation into Brazilian Portuguese and Spanish, and preliminary
translations in a dozen other languages.
*** Translations now hosted on Fedora’s Weblate instance
Translations are now handled at
<https://translate.fedoraproject.org/projects/guix/guix/> (thanks, Fedora!).
You can join to help improve translations in your native language of messages,
documentation, package descriptions, and the web site.
* Changes in 1.2.0 (since 1.1.0)
** Package management

2
README
View File

@ -62,7 +62,7 @@ Please email <help-guix@gnu.org> for questions and <bug-guix@gnu.org> for bug
reports; email <gnu-system-discuss@gnu.org> for general issues regarding the
GNU system.
Join #guix on irc.freenode.net.
Join #guix on irc.libera.chat.
* Guix & Nix

2
ROADMAP
View File

@ -23,7 +23,7 @@ There will be a few 0.x releases by then to give the new features more
exposure and testing.
You're welcome to discuss this road map on guix-devel@gnu.org or #guix on
Freenode!
the Libera Chat IRC network!
* Features scheduled for 1.0

2
THANKS
View File

@ -43,7 +43,7 @@ infrastructure help:
Alen Skondro <askondro@gmail.com>
Jan Synáček <jan.synacek@gmail.com>
Matthias Wachs <wachs@net.in.tum.de>
Christopher Allan Webber <cwebber@dustycloud.org>
Christine Lemmer-Webber <cwebber@dustycloud.org>
Philip Woods <elzairthesorcerer@gmail.com>
GNU Guix also includes non-software works. Thanks to the following

6
bootstrap
View File

@ -5,8 +5,7 @@ set -e -x
# Generate stubs for translations.
langs=`find po/doc -type f -name 'guix-manual*.po' \
| sed -e 's,guix-manual\.,,' \
| xargs -n 1 -I{} basename {} .po`
| sed -e 's,.*/guix-manual\.,,;s,\.po$,,'`
for lang in ${langs}; do
if [ ! -e "doc/guix.${lang}.texi" ]; then
echo "@setfilename guix.${lang}.info" > "doc/guix.${lang}.texi"
@ -16,8 +15,7 @@ for lang in ${langs}; do
fi
done
langs=`find po/doc -type f -name 'guix-cookbook*.po' \
| sed -e 's,guix-cookbook\.,,' \
| xargs -n 1 -I{} basename {} .po`
| sed -e 's,.*/guix-cookbook\.,,;s,\.po$,,'`
for lang in ${langs}; do
if [ ! -e "doc/guix-cookbook.${lang}.texi" ]; then
echo "@setfilename guix-cookbook.${lang}.info" > "doc/guix-cookbook.${lang}.texi"

1
build-aux/build-self.scm
View File

@ -250,6 +250,7 @@ interface (FFI) of Guile.")
(match-lambda
(('guix 'config) #f)
(('guix 'channels) #f)
(('guix 'build 'download) #f) ;autoloaded by (guix download)
(('guix _ ...) #t)
(('gnu _ ...) #t)
(_ #f)))

55
build-aux/compile-all.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -98,26 +98,36 @@ to 'make'."
(exit 1)))
(match (command-line)
((_ . files)
((_ "--total" (= string->number grand-total)
"--completed" (= string->number processed)
. files)
;; GRAND-TOTAL is the total number of .scm files in the project; PROCESSED
;; is the total number of .scm files already compiled in previous
;; invocations of this script.
(catch #t
(lambda ()
(compile-files srcdir (getcwd)
(filter file-needs-compilation? files)
#:workers (parallel-job-count*)
#:host host
#:report-load (lambda (file total completed)
(when file
(format #t "[~3d%] LOAD ~a~%"
(% (+ 1 completed) (* 2 total))
file)
(force-output)))
#:report-compilation (lambda (file total completed)
(when file
(format #t "[~3d%] GUILEC ~a~%"
(% (+ total completed 1)
(* 2 total))
(scm->go file))
(force-output)))))
(let* ((to-build (filter file-needs-compilation? files))
(processed (+ processed
(- (length files) (length to-build)))))
(compile-files srcdir (getcwd) to-build
#:workers (parallel-job-count*)
#:host host
#:report-load (lambda (file total completed)
(when file
(format #t "[~3d%] LOAD ~a~%"
(% (+ 1 completed
(* 2 processed))
(* 2 grand-total))
file)
(force-output)))
#:report-compilation (lambda (file total completed)
(when file
(format #t "[~3d%] GUILEC ~a~%"
(% (+ total completed 1
(* 2 processed))
(* 2 grand-total))
(scm->go file))
(force-output))))))
(lambda _
(primitive-exit 1))
(lambda args
@ -132,11 +142,8 @@ to 'make'."
(false-if-exception
(module-ref ui 'report-load-error)))))
(if report
;; In Guile <= 2.2.5, 'current-load-port' was not exported.
(let ((load-port ((module-ref (resolve-module '(ice-9 ports))
'current-load-port))))
(report (or (and=> load-port port-filename) "?.scm")
args frame))
(report (or (and=> (current-load-port) port-filename) "?.scm")
args frame)
(begin
(print-exception (current-error-port) frame
(car args) (cdr args))

7
build-aux/test-env.in
View File

@ -1,7 +1,7 @@
#!/bin/sh
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@ -91,14 +91,11 @@ then
# Place for the substituter's cache.
XDG_CACHE_HOME="$GUIX_STATE_DIRECTORY/cache-$$"
# For the (guix import snix) tests.
NIXPKGS="@NIXPKGS@"
export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \
GUIX_LOG_DIRECTORY GUIX_STATE_DIRECTORY GUIX_DATABASE_DIRECTORY \
GUIX_BINARY_SUBSTITUTE_URL \
GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES \
GUIX_CONFIGURATION_DIRECTORY XDG_CACHE_HOME NIXPKGS
GUIX_CONFIGURATION_DIRECTORY XDG_CACHE_HOME
# Launch the daemon without chroot support because is may be
# unavailable, for instance if we're not running as root.

18
build-aux/update-NEWS.scm
View File

@ -95,7 +95,7 @@ paragraph."
(with-atomic-file-replacement news-file
(lambda (input output)
(rewrite-org-section input output
(make-regexp "^(\\*+) (.*) new packages")
(make-regexp "^(\\*+).*new packages")
(lambda (match port)
(let ((stars (match:substring match 1)))
(format port
@ -141,7 +141,7 @@ paragraph."
(with-atomic-file-replacement news-file
(lambda (input output)
(rewrite-org-section input output
(make-regexp "^(\\*+) (.*) package updates")
(make-regexp "^(\\*+).*package updates")
(lambda (match port)
(let ((stars (match:substring match 1))
(lst (map (match-lambda
@ -166,16 +166,22 @@ paragraph."
(string-append data-directory "/packages-"
version ".txt"))
(define (package<? p1 p2)
(string<? (package-full-name p1) (package-full-name p2)))
(let-values (((previous-version new-version)
(call-with-input-file news-file NEWS->versions)))
(format (current-error-port) "Updating NEWS for ~a to ~a...~%"
previous-version new-version)
(let* ((old (call-with-input-file (package-file previous-version)
read))
(new (fold-packages (lambda (p r)
(alist-cons (package-name p) (package-version p)
r))
'())))
(all-packages/sorted (sort (fold-packages (lambda (p r)
(cons p r))
'())
package<?))
(new (map (lambda (p)
(cons (package-name p) (package-version p)))
all-packages/sorted)))
(call-with-output-file (package-file new-version)
(lambda (port)
(pretty-print new port)))

2
config-daemon.ac
View File

@ -117,7 +117,7 @@ if test "x$guix_build_daemon" = "xyes"; then
dnl Determine the appropriate default list of substitute URLs (GnuTLS
dnl is required so we can default to 'https'.)
guix_substitute_urls="https://ci.guix.gnu.org"
guix_substitute_urls="https://ci.guix.gnu.org https://bordeaux.guix.gnu.org"
AC_MSG_CHECKING([for default substitute URLs])
AC_MSG_RESULT([$guix_substitute_urls])

32
configure.ac
View File

@ -21,7 +21,7 @@ dnl For the C++ code. This must be used early.
AC_USE_SYSTEM_EXTENSIONS
AM_GNU_GETTEXT([external])
AM_GNU_GETTEXT_VERSION([0.18.1])
AM_GNU_GETTEXT_VERSION([0.19.1])
GUIX_SYSTEM_TYPE
GUIX_ASSERT_SUPPORTED_SYSTEM
@ -96,16 +96,12 @@ m4_pattern_forbid([^GUIX_])
dnl Search for 'guile' and 'guild'. This macro defines
dnl 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([3.0 2.2])
GUILE_PKG([3.0])
GUILE_PROGS
if test "x$GUILD" = "x"; then
AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.])
fi
if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
fi
dnl Get CFLAGS and LDFLAGS for libguile.
GUILE_FLAGS
@ -150,6 +146,13 @@ if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
fi
dnl Check for the optional Guile-Lib.
GUILE_MODULE_EXPORTS([have_guile_lib], [(htmlprag)], [%strict-tokenizer?])
AM_CONDITIONAL([HAVE_GUILE_LIB], [test "x$have_guile_lib" = "xyes"])
AM_COND_IF(HAVE_GUILE_LIB,,
[AC_MSG_WARN([The Guile-Lib requirement was not satisfied (>= 0.2.7);
Some features such as the Go importer will not be usable.])])
dnl Check for Guile-zlib.
GUIX_CHECK_GUILE_ZLIB
if test "x$guix_cv_have_recent_guile_zlib" != "xyes"; then
@ -195,23 +198,6 @@ AC_SUBST([GZIP])
AC_SUBST([BZIP2])
AC_SUBST([XZ])
AC_ARG_WITH([nixpkgs],
[AS_HELP_STRING([--with-nixpkgs=DIR],
[search for Nixpkgs in DIR (for testing purposes only)])],
[case "$withval" in
yes|no) AC_MSG_ERROR([Please use `--with-nixpkgs=DIR'.]);;
*) NIXPKGS="$withval";;
esac],
[])
AC_MSG_CHECKING([for Nixpkgs source tree])
if test -f "$NIXPKGS/default.nix"; then
AC_MSG_RESULT([$NIXPKGS])
AC_SUBST([NIXPKGS])
else
AC_MSG_RESULT([not found])
fi
LIBGCRYPT_LIBDIR="no"
LIBGCRYPT_PREFIX="no"

17
doc/build.scm
View File

@ -51,7 +51,16 @@
(@@ (guix self) file-append*))
(define translated-texi-manuals
(@@ (guix self) translate-texi-manuals))
(let ((translated (@@ (guix self) translate-texi-manuals)))
(lambda (source)
(let ((result (translated source)))
;; Build with 'guile-3.0-latest', which is linked against
;; 'libgc/disable-munmap', to avoid the dreaded "mmap(PROT_NONE)
;; failed" crash: <https://bugs.gnu.org/47428>.
(computed-file (computed-file-name result)
(computed-file-gexp result)
#:options (computed-file-options result)
#:guile guile-3.0-latest)))))
(define info-manual
(@@ (guix self) info-manual))
@ -63,9 +72,9 @@
"guix"))
(define %languages
;; The cookbook is currently only translated into German.
;; The cookbook is not translated in the same languages as the manual
(if (string=? %manual "guix-cookbook")
'("de" "en")
'("de" "en" "fr")
'("de" "en" "es" "fr" "ru" "zh_CN")))
(define (texinfo-manual-images source)
@ -948,7 +957,7 @@ from SOURCE."
(div
(ul
(li (a (@ (href "html_node"))
"HTML, with one page per node"))
"HTML, with a separate page per node"))
(li (a (@ (href
,(string-append
#$manual

513
doc/contributing.texi
View File

@ -3,7 +3,7 @@
This project is a cooperative effort, and we need your help to make it
grow! Please get in touch with us on @email{guix-devel@@gnu.org} and
@code{#guix} on the Freenode IRC network. We welcome ideas, bug
@code{#guix} on the Libera Chat IRC network. We welcome ideas, bug
reports, patches, and anything that may be helpful to the project. We
particularly welcome help on packaging (@pxref{Packaging Guidelines}).
@ -26,9 +26,10 @@ choice.
* Packaging Guidelines:: Growing the distribution.
* Coding Style:: Hygiene of the contributor.
* Submitting Patches:: Share your work.
* Tracking Bugs and Patches:: Using Debbugs.
* Tracking Bugs and Patches:: Keeping it all organized.
* Commit Access:: Pushing to the official repository.
* Updating the Guix Package:: Updating the Guix package definition.
* Translating Guix:: Make Guix speak your native language.
@end menu
@node Building from Git
@ -241,7 +242,7 @@ Manual}). First, you need more than an editor, you need
wonderful @url{https://nongnu.org/geiser/, Geiser}. To set that up, run:
@example
guix package -i emacs guile emacs-geiser
guix package -i emacs guile emacs-geiser emacs-geiser-guile
@end example
Geiser allows for interactive and incremental development from within
@ -375,12 +376,12 @@ Once your package builds correctly, please send us a patch
(@pxref{Submitting Patches}). Well, if you need help, we will be happy to
help you too. Once the patch is committed in the Guix repository, the
new package automatically gets built on the supported platforms by
@url{@value{SUBSTITUTE-URL}, our continuous integration system}.
@url{https://@value{SUBSTITUTE-SERVER-1}, our continuous integration system}.
@cindex substituter
Users can obtain the new package definition simply by running
@command{guix pull} (@pxref{Invoking guix pull}). When
@code{@value{SUBSTITUTE-SERVER}} is done building the package, installing the
@code{@value{SUBSTITUTE-SERVER-1}} is done building the package, installing the
package automatically downloads binaries from there
(@pxref{Substitutes}). The only place where human intervention is
needed is to review and apply the patch.
@ -531,9 +532,11 @@ It is a good idea to strip commit identifiers in the @code{version}
field to, say, 7 digits. It avoids an aesthetic annoyance (assuming
aesthetics have a role to play here) as well as problems related to OS
limits such as the maximum shebang length (127 bytes for the Linux
kernel). It is best to use the full commit identifiers in
@code{origin}s, though, to avoid ambiguities. A typical package
definition may look like this:
kernel). There are helper functions for doing this for packages using
@code{git-fetch} or @code{hg-fetch} (see below). It is best to use the
full commit identifiers in @code{origin}s, though, to avoid ambiguities.
A typical package definition may look like this:
@lisp
(define my-package
@ -552,6 +555,20 @@ definition may look like this:
)))
@end lisp
@deffn {Scheme Procedure} git-version @var{VERSION} @var{REVISION} @var{COMMIT}
Return the version string for packages using @code{git-fetch}.
@lisp
(git-version "0.2.3" "0" "93818c936ee7e2f1ba1b315578bde363a7d43d05")
@result{} "0.2.3-0.93818c9"
@end lisp
@end deffn
@deffn {Scheme Procedure} hg-version @var{VERSION} @var{REVISION} @var{CHANGESET}
Return the version string for packages using @code{hg-fetch}. It works
in the same way as @code{git-version}.
@end deffn
@node Synopses and Descriptions
@subsection Synopses and Descriptions
@ -994,6 +1011,12 @@ Before submitting a patch that adds or modifies a package definition,
please run through this check list:
@enumerate
@cindex @code{git format-patch}
@cindex @code{git-format-patch}
@item
We recommend to use the command @code{git format-patch --base} to
include the commit where your patch applies.
@item
If the authors of the packaged software provide a cryptographic
signature for the release tarball, make an effort to verify the
@ -1017,20 +1040,21 @@ Make sure the package builds on your platform, using @code{guix build
We recommend you also try building the package on other supported
platforms. As you may not have access to actual hardware platforms, we
recommend using the @code{qemu-binfmt-service-type} to emulate them. In
order to enable it, add the following service to the list of services in
your @code{operating-system} configuration:
order to enable it, add the @code{virtualization} service module and the
following service to the list of services in your @code{operating-system}
configuration:
@lisp
(service qemu-binfmt-service-type
(qemu-binfmt-configuration
(platforms (lookup-qemu-platforms "arm" "aarch64"))
(platforms (lookup-qemu-platforms "arm" "aarch64"))))
@end lisp
Then reconfigure your system.
You can then build packages for different platforms by specifying the
@code{--system} option. For example, to build the "hello" package for
the armhf, aarch64, or mips64 architectures, you would run the following
the armhf or aarch64 architectures, you would run the following
commands, respectively:
@example
guix build --system=armhf-linux --rounds=2 hello
@ -1061,7 +1085,7 @@ and which optional dependencies should be used. In particular, avoid adding
the @code{texlive-tiny} package or @code{texlive-union} procedure instead.
@item
For important changes, check that dependent package (if applicable) are
For important changes, check that dependent packages (if applicable) are
not affected by the change; @code{guix refresh --list-dependent
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
@ -1079,15 +1103,17 @@ rebuilding induced, commits go to different branches, along these lines:
@code{staging} branch (non-disruptive changes). This branch is intended
to be merged in @code{master} every 6 weeks or so. Topical changes
(e.g., an update of the GNOME stack) can instead go to a specific branch
(say, @code{gnome-updates}).
(say, @code{gnome-updates}). This branch is not expected to be
buildable or usable until late in its development process.
@item more than 1,800 dependent packages
@code{core-updates} branch (may include major and potentially disruptive
changes). This branch is intended to be merged in @code{master} every
6 months or so.
6 months or so. This branch is not expected to be buildable or usable
until late in its development process.
@end table
All these branches are @uref{@value{SUBSTITUTE-URL},
All these branches are @uref{https://@value{SUBSTITUTE-SERVER-1},
tracked by our build farm} and merged into @code{master} once
everything has been successfully built. This allows us to fix issues
before they hit users, and to reduce the window during which pre-built
@ -1121,7 +1147,7 @@ as timestamps or randomly-generated output in the build result.
Another option is to use @command{guix challenge} (@pxref{Invoking guix
challenge}). You may run it once the package has been committed and
built by @code{@value{SUBSTITUTE-SERVER}} to check whether it obtains the same
built by @code{@value{SUBSTITUTE-SERVER-1}} to check whether it obtains the same
result as you did. Better yet: Find another machine that can build it
and run @command{guix publish}. Since the remote build machine is
likely different from yours, this can catch non-determinism issues
@ -1177,6 +1203,11 @@ MIME attachments. You are advised to pay attention if your email client
changes anything like line breaks or indentation which could potentially
break the patches.
Expect some delay when you submit your very first patch to
@email{guix-patches@@gnu.org}. You have to wait until you get an
acknowledgement with the assigned tracking number. Future acknowledgements
should not be delayed.
When a bug is resolved, please close the thread by sending an email to
@email{@var{NNN}-done@@debbugs.gnu.org}.
@ -1198,6 +1229,18 @@ for more information. You can install @command{git send-email} with
@node Tracking Bugs and Patches
@section Tracking Bugs and Patches
This section describes how the Guix project tracks its bug reports and
patch submissions.
@menu
* The Issue Tracker:: The official bug and patch tracker.
* Debbugs User Interfaces:: Ways to interact with Debbugs.
* Debbugs Usertags:: Tag reports with custom labels.
@end menu
@node The Issue Tracker
@subsection The Issue Tracker
@cindex bug reports, tracking
@cindex patch submissions, tracking
@cindex issue tracking
@ -1209,6 +1252,9 @@ email to @email{bug-guix@@gnu.org}, while patch submissions are filed
against the @code{guix-patches} package by sending email to
@email{guix-patches@@gnu.org} (@pxref{Submitting Patches}).
@node Debbugs User Interfaces
@subsection Debbugs User Interfaces
A web interface (actually @emph{two} web interfaces!) are available to
browse issues:
@ -1246,12 +1292,72 @@ For example, to list all open issues on @code{guix-patches}, hit:
@xref{Top,,, debbugs-ug, Debbugs User Guide}, for more information on
this nifty tool!
@node Debbugs Usertags
@subsection Debbugs Usertags
@cindex usertags, for debbugs
@cindex Debbugs usertags
Debbugs provides a feature called @dfn{usertags} that allows any user to
tag any bug with an arbitrary label. Bugs can be searched by usertag,
so this is a handy way to organize bugs@footnote{The list of usertags is
public information, and anyone can modify any user's list of usertags,
so keep that in mind if you choose to use this feature.}.
For example, to view all the bug reports (or patches, in the case of
@code{guix-patches}) tagged with the usertag @code{powerpc64le-linux}
for the user @code{guix}, open a URL like the following in a web
browser:
@url{https://debbugs.gnu.org/cgi-bin/pkgreport.cgi?tag=powerpc64le-linux;users=guix}.
For more information on how to use usertags, please refer to the
documentation for Debbugs or the documentation for whatever tool you use
to interact with Debbugs.
In Guix, we are experimenting with usertags to keep track of
architecture-specific issues. To facilitate collaboration, all our
usertags are associated with the single user @code{guix}. The following
usertags currently exist for that user:
@table @code
@item powerpc64le-linux
The purpose of this usertag is to make it easy to find the issues that
matter most for the @code{powerpc64le-linux} system type. Please assign
this usertag to bugs or patches that affect @code{powerpc64le-linux} but
not other system types. In addition, you may use it to identify issues
that for some reason are particularly important for the
@code{powerpc64le-linux} system type, even if the issue affects other
system types, too.
@item reproducibility
For issues related to reproducibility. For example, it would be
appropriate to assign this usertag to a bug report for a package that
fails to build reproducibly.
@end table
If you're a committer and you want to add a usertag, just start using it
with the @code{guix} user. If the usertag proves useful to you,
consider updating this section of the manual so that others will know
what your usertag means.
@node Commit Access
@section Commit Access
@cindex commit access, for developers
For frequent contributors, having write access to the repository is
convenient. When you deem it necessary, consider applying for commit
Everyone can contribute to Guix without having commit access
(@pxref{Submitting Patches}). However, for frequent contributors,
having write access to the repository can be convenient. Commit access
should not be thought of as a ``badge of honor'' but rather as a
responsibility a contributor is willing to take to help the project.
The following sections explain how to get commit access, how to be ready
to push commits, and the policies and community expectations for commits
pushed upstream.
@subsection Applying for Commit Access
When you deem it necessary, consider applying for commit
access by following these steps:
@enumerate
@ -1323,6 +1429,29 @@ review and merging system, which, as a consequence, may lead us to have
fewer people with commit access to the main repository. Stay tuned!
@end quotation
All commits that are pushed to the central repository on Savannah must
be signed with an OpenPGP key, and the public key should be uploaded to
your user account on Savannah and to public key servers, such as
@code{keys.openpgp.org}. To configure Git to automatically sign
commits, run:
@example
git config commit.gpgsign true
# Substitute the fingerprint of your public PGP key.
git config user.signingkey CABBA6EA1DC0FF33
@end example
You can prevent yourself from accidentally pushing unsigned commits to
Savannah by using the pre-push Git hook located at
@file{etc/git/pre-push}:
@example
cp etc/git/pre-push .git/hooks/pre-push
@end example
@subsection Commit Policy
If you get commit access, please make sure to follow
the policy below (discussions of the policy can take place on
@email{guix-devel@@gnu.org}).
@ -1341,25 +1470,6 @@ mailing list for commit notifications (@email{guix-commits@@gnu.org}),
so people can notice. Before pushing your changes, make sure to run
@code{git pull --rebase}.
All commits that are pushed to the central repository on Savannah must
be signed with an OpenPGP key, and the public key should be uploaded to
your user account on Savannah and to public key servers, such as
@code{keys.openpgp.org}. To configure Git to automatically sign
commits, run:
@example
git config commit.gpgsign true
git config user.signingkey CABBA6EA1DC0FF33
@end example
You can prevent yourself from accidentally pushing unsigned commits to
Savannah by using the pre-push Git hook called located at
@file{etc/git/pre-push}:
@example
cp etc/git/pre-push .git/hooks/pre-push
@end example
When pushing a commit on behalf of somebody else, please add a
@code{Signed-off-by} line at the end of the commit log message---e.g.,
with @command{git am --signoff}. This improves tracking of who did
@ -1381,12 +1491,76 @@ you're confident, it's OK to commit.
That last part is subject to being adjusted, allowing individuals to commit
directly on non-controversial changes on parts they’re familiar with.
@subsection Addressing Issues
Peer review (@pxref{Submitting Patches}) and tools such as
@command{guix lint} (@pxref{Invoking guix lint}) and the test suite
(@pxref{Running the Test Suite}) should catch issues before they are
pushed. Yet, commits that ``break'' functionality might occasionally
go through. When that happens, there are two priorities: mitigating
the impact, and understanding what happened to reduce the chance of
similar incidents in the future. The responsibility for both these
things primarily lies with those involved, but like everything this is
a group effort.
Some issues can directly affect all users---for instance because they
make @command{guix pull} fail or break core functionality, because they
break major packages (at build time or run time), or because they
introduce known security vulnerabilities.
@cindex reverting commits
The people involved in authoring, reviewing, and pushing such
commit(s) should be at the forefront to mitigate their impact in a
timely fashion: by pushing a followup commit to fix it (if possible),
or by reverting it to leave time to come up with a proper fix, and by
communicating with other developers about the problem.
If these persons are unavailable to address the issue in time, other
committers are entitled to revert the commit(s), explaining in the
commit log and on the mailing list what the problem was, with the goal
of leaving time to the original committer, reviewer(s), and author(s)
to propose a way forward.
Once the problem has been dealt with, it is the responsibility of
those involved to make sure the situation is understood. If you are
working to understand what happened, focus on gathering information
and avoid assigning any blame. Do ask those involved to describe what
happened, do not ask them to explain the situation---this would
implicitly blame them, which is unhelpful. Accountability comes from
a consensus about the problem, learning from it and improving
processes so that it's less likely to reoccur.
@subsection Commit Revocation
In order to reduce the possibility of mistakes, committers will have
their Savannah account removed from the Guix Savannah project and their
key removed from @file{.guix-authorizations} after 12 months of
inactivity; they can ask to regain commit access by emailing the
maintainers, without going through the vouching process.
Maintainers@footnote{See @uref{https://guix.gnu.org/en/about} for the
current list of maintainers. You can email them privately at
@email{guix-maintainers@@gnu.org}.} may also revoke an individual's
commit rights, as a last resort, if cooperation with the rest of the
community has caused too much friction---even within the bounds of the
project's code of conduct (@pxref{Contributing}). They would only do so
after public or private discussion with the individual and a clear
notice. Examples of behavior that hinders cooperation and could lead to
such a decision include:
@itemize
@item repeated violation of the commit policy stated above;
@item repeated failure to take peer criticism into account;
@item breaching trust through a series of grave incidents.
@end itemize
When maintainers resort to such a decision, they notify developers on
@email{guix-devel@@gnu.org}; inquiries may be sent to
@email{guix-maintainers@@gnu.org}. Depending on the situation, the
individual may still be welcome to contribute.
@subsection Helping Out
One last thing: the project keeps moving forward because committers not
only push their own awesome changes, but also offer some of their time
@emph{reviewing} and pushing other people's changes. As a committer,
@ -1429,3 +1603,266 @@ This check can be disabled, @emph{at your own peril}, by setting the
@code{GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT} environment variable. When
this variable is set, the updated package source is also added to the
store. This is used as part of the release process of Guix.
@cindex translation
@cindex l10n
@cindex i18n
@cindex native language support
@node Translating Guix
@section Translating Guix
Writing code and packages is not the only way to provide a meaningful
contribution to Guix. Translating to a language you speak is another
example of a valuable contribution you can make. This section is designed
to describe the translation process. It gives you advice on how you can
get involved, what can be translated, what mistakes you should avoid and
what we can do to help you!
Guix is a big project that has multiple components that can be translated.
We coordinate the translation effort on a
@uref{https://translate.fedoraproject.org/projects/guix/,Weblate instance}
hosted by our friends at Fedora. You will need an account to submit
translations.
Some of the software packaged in Guix also contain translations. We do not
host a translation platform for them. If you want to translate a package
provided by Guix, you should contact their developers or find the information
on their website. As an example, you can find the homepage of the
@code{hello} package by typing @code{guix show hello}. On the ``homepage''
line, you will see @url{https://www.gnu.org/software/hello/} as the homepage.
Many GNU and non-GNU packages can be translated on the
@uref{https://translationproject.org,Translation Project}. Some projects
with multiple components have their own platform. For instance, GNOME has
its own platform, @uref{https://l10n.gnome.org/,Damned Lies}.
Guix has five components hosted on Weblate.
@itemize
@item @code{guix} contains all the strings from the Guix software (the
guided system installer, the package manager, etc), excluding packages.
@item @code{packages} contains the synopsis (single-sentence description
of a package) and description (longer description) of packages in Guix.
@item @code{website} contains the official Guix website, except for
blog posts and multimedia content.
@item @code{documentation-manual} corresponds to this manual.
@item @code{documentation-cookbook} is the component for the cookbook.
@end itemize
@subsubheading General Directions
Once you get an account, you should be able to select a component from
@uref{https://translate.fedoraproject.org/projects/guix/,the guix project},
and select a language. If your language does not appear in the list, go
to the bottom and click on the ``Start new translation'' button. Select
the language you want to translate to from the list, to start your new
translation.
Like lots of other free software packages, Guix uses
@uref{https://www.gnu.org/software/gettext,GNU Gettext} for its translations,
with which translatable strings are extracted from the source code to so-called
PO files.
Even though PO files are text files, changes should not be made with a text
editor but with PO editing software. Weblate integrates PO editing
functionality. Alternatively, translators can use any of various
free-software tools for filling in translations, of which
@uref{https://poedit.net/,Poedit} is one example, and (after logging in)
@uref{https://docs.weblate.org/en/latest/user/files.html,upload} the changed
file. There is also a special
@uref{https://www.emacswiki.org/emacs/PoMode,PO editing mode} for users of GNU
Emacs. Over time translators find out what software they are happy with and
what features they need.
On Weblate, you will find various links to the editor, that will show various
subsets (or all) of the strings. Have a look around and at the
@uref{https://docs.weblate.org/en/latest/,documentation} to familiarize
yourself with the platform.
@subsubheading Translation Components
In this section, we provide more detailed guidance on the translation
process, as well as details on what you should or should not do. When in
doubt, please contact us, we will be happy to help!
@table @asis
@item guix
Guix is written in the Guile programming language, and some strings contain
special formatting that is interpreted by Guile. These special formatting
should be highlighted by Weblate. They start with @code{~} followed by one
or more characters.
When printing the string, Guile replaces the special formatting symbols with
actual values. For instance, the string @samp{ambiguous package specification
`~a'} would be substituted to contain said package specification instead of
@code{~a}. To properly translate this string, you must keep the formatting
code in your translation, although you can place it where it makes sense in
your language. For instance, the French translation says @samp{spécification
du paquet « ~a » ambiguë} because the adjective needs to be placed in the
end of the sentence.
If there are multiple formatting symbols, make sure to respect the order.
Guile does not know in which order you intended the string to be read, so it
will substitute the symbols in the same order as the English sentence.
As an example, you cannot translate @samp{package '~a' has been superseded by
'~a'} by @samp{'~a' superseeds package '~a'}, because the meaning would be
reversed. If @var{foo} is superseded by @var{bar}, the translation would read
@samp{'foo' superseeds package 'bar'}. To work around this problem, it
is possible to use more advanced formatting to select a given piece of data,
instead of following the default English order. @xref{Formatted Output,,,
guile, GNU Guile Reference Manual}, for more information on formatting in Guile.
@item packages
Package descriptions occasionally contain Texinfo markup (@pxref{Synopses
and Descriptions}). Texinfo markup looks like @samp{@@code@{rm -rf@}},
@samp{@@emph@{important@}}, etc. When translating, please leave markup as is.
The characters after ``@@'' form the name of the markup, and the text between
``@{'' and ``@}'' is its content. In general, you should not translate the
content of markup like @code{@@code}, as it contains literal code that do not
change with language. You can translate the content of formatting markup such
as @code{@@emph}, @code{@@i}, @code{@@itemize}, @code{@@item}. However, do
not translate the name of the markup, or it will not be recognized. Do
not translate the word after @code{@@end}, it is the name of the markup that
is closed at this position (e.g.@: @code{@@itemize ... @@end itemize}).
@item documentation-manual and documentation-cookbook
The first step to ensure a successful translation of the manual is to find
and translate the following strings @emph{first}:
@itemize
@item @code{version.texi}: Translate this string as @code{version-xx.texi},
where @code{xx} is your language code (the one shown in the URL on
weblate).
@item @code{contributing.texi}: Translate this string as
@code{contributing.xx.texi}, where @code{xx} is the same language code.
@item @code{Top}: Do not translate this string, it is important for Texinfo.
If you translate it, the document will be empty (missing a Top node).
Please look for it, and register @code{Top} as its translation.
@end itemize
Translating these strings first ensure we can include your translation in
the guix repository without breaking the make process or the
@command{guix pull} machinery.
The manual and the cookbook both use Texinfo. As for @code{packages}, please
keep Texinfo markup as is. There are more possible markup types in the manual
than in the package descriptions. In general, do not translate the content
of @code{@@code}, @code{@@file}, @code{@@var}, @code{@@value}, etc. You
should translate the content of formatting markup such as @code{@@emph},
@code{@@i}, etc.
The manual contains sections that can be referred to by name by @code{@@ref},
@code{@@xref} and @code{@@pxref}. We have a mechanism in place so you do
not have to translate their content. If you keep the English title, we will
automatically replace it with your translation of that title. This ensures
that Texinfo will always be able to find the node. If you decide to change
the translation of the title, the references will automatically be updated
and you will not have to update them all yourself.
When translating references from the cookbook to the manual, you need to
replace the name of the manual and the name of the section. For instance,
to translate @code{@@pxref@{Defining Packages,,, guix, GNU Guix Reference
Manual@}}, you would replace @code{Defining Packages} with the title of that
section in the translated manual @emph{only} if that title is translated.
If the title is not translated in your language yet, do not translate it here,
or the link will be broken. Replace @code{guix} with @code{guix.xx} where
@code{xx} is your language code. @code{GNU Guix Reference Manual} is the
text of the link. You can translate it however you wish.
@item website
The website pages are written using SXML, an s-expression version of HTML,
the basic language of the web. We have a process to extract translatable
strings from the source, and replace complex s-expressions with a more familiar
XML markup, where each markup is numbered. Translators can arbitrarily change
the ordering, as in the following example.
@example
#. TRANSLATORS: Defining Packages is a section name
#. in the English (en) manual.
#: apps/base/templates/about.scm:64
msgid "Packages are <1>defined<1.1>en</1.1><1.2>Defining-Packages.html</1.2></1> as native <2>Guile</2> modules."
msgstr "Pakete werden als reine <2>Guile</2>-Module <1>definiert<1.1>de</1.1><1.2>Pakete-definieren.html</1.2></1>."
@end example
Note that you need to include the same markups. You cannot skip any.
@end table
In case you make a mistake, the component might fail to build properly with your
language, or even make guix pull fail. To prevent that, we have a process
in place to check the content of the files before pushing to our repository.
We will not be able to update the translation for your language in Guix, so
we will notify you (through weblate and/or by email) so you get a chance to
fix the issue.
@subsubheading Outside of Weblate
Currently, some parts of Guix cannot be translated on Weblate, help wanted!
@itemize
@item @command{guix pull} news can be translated in @file{news.scm}, but is not
available from Weblate. If you want to provide a translation, you
can prepare a patch as described above, or simply send us your
translation with the name of the news entry you translated and your
language. @xref{Writing Channel News}, for more information about
channel news.
@item Guix blog posts cannot currently be translated.
@item The installer script (for foreign distributions) is entirely in English.
@item Some of the libraries Guix uses cannot be translated or are translated
outside of the Guix project. Guile itself is not internationalized.
@item Other manuals linked from this manual or the cookbook might not be
translated.
@end itemize
@subsubheading Translation Infrastructure
Weblate is backed by a git repository from which it discovers new strings to
translate and pushes new and updated translations. Normally, it would be
enough to give it commit access to our repositories. However, we decided
to use a separate repository for two reasons. First, we would have to give
Weblate commit access and authorize its signing key, but we do not trust it
in the same way we trust guix developers, especially since we do not manage
the instance ourselves. Second, if translators mess something up, it can
break the generation of the website and/or guix pull for all our users,
independently of their language.
For these reasons, we use a dedicated repository to host translations, and we
synchronize it with our guix and artworks repositories after checking no issue
was introduced in the translation.
Developers can download the latest PO files from weblate in the Guix
repository by running the @command{make download-po} command. It will
automatically download the latest files from weblate, reformat them to a
canonical form, and check they do not contain issues. The manual needs to be
built again to check for additional issues that might crash Texinfo.
Before pushing new translation files, developers should add them to the
make machinery so the translations are actually available. The process
differs for the various components.
@itemize
@item New po files for the @code{guix} and @code{packages} components must
be registered by adding the new language to @file{po/guix/LINGUAS} or
@file{po/packages/LINGUAS}.
@item New po files for the @code{documentation-manual} component must be
registered by adding the file name to @code{DOC_PO_FILES} in
@file{po/doc/local.mk}, the generated @file{%D%/guix.xx.texi} manual to
@code{info_TEXINFOS} in @file{doc/local.mk} and the generated
@file{%D%/guix.xx.texi} and @file{%D%/contributing.xx.texi} to
@code{TRANSLATED_INFO} also in @file{doc/local.mk}.
@item New po files for the @code{documentation-cookbook} component must be
registered by adding the file name to @code{DOC_COOKBOOK_PO_FILES} in
@file{po/doc/local.mk}, the generated @file{%D%/guix-cookbook.xx.texi}
manual to @code{info_TEXINFOS} in @file{doc/local.mk} and the generated
@file{%D%/guix-cookbook.xx.texi} to @code{TRANSLATED_INFO} also
in @file{doc/local.mk}.
@item New po files for the @code{website} component must be added to the
@code{guix-artwork} repository, in @file{website/po/}.
@file{website/po/LINGUAS} and @file{website/po/ietf-tags.scm} must
be updated accordingly (see @file{website/i18n-howto.txt} for more
information on the process).
@end itemize

94
doc/guix-cookbook.texi
View File

@ -16,7 +16,8 @@ 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
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -85,8 +86,8 @@ Packaging
System Configuration
* Customizing the Kernel:: Creating and using a custom Linux kernel
* Auto-Login to a Specific TTY:: Automatically Login a User to a Specific TTY
* Customizing the Kernel:: Creating and using a custom Linux kernel on Guix System.
@end detailmenu
@end menu
@ -590,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
@ -1353,6 +1354,7 @@ chapter is to demonstrate some advanced configuration concepts.
reference.
@menu
* Auto-Login to a Specific TTY:: Automatically Login a User to a Specific TTY
* Customizing the Kernel:: Creating and using a custom Linux kernel on Guix System.
* Guix System Image API:: Customizing images to target specific platforms.
* Connecting to Wireguard VPN:: Connecting to a Wireguard VPN.
@ -1363,6 +1365,51 @@ reference.
* Setting up NGINX with Lua:: Configuring NGINX web-server to load Lua modules.
@end menu
@node Auto-Login to a Specific TTY
@section Auto-Login to a Specific TTY
While the Guix manual explains auto-login one user to @emph{all} TTYs (
@pxref{auto-login to TTY,,, guix, GNU Guix Reference Manual}), some
might prefer a situation, in which one user is logged into one TTY with
the other TTYs either configured to login different users or no one at
all. Note that one can auto-login one user to any TTY, but it is
usually advisable to avoid @code{tty1}, which, by default, is used to
log warnings and errors.
Here is how one might set up auto login for one user to one tty:
@lisp
(define (auto-login-to-tty config tty user)
(if (string=? tty (mingetty-configuration-tty config))
(mingetty-configuration
(inherit config)
(auto-login user))
config))
(define %my-services
(modify-services %base-services
;; @dots{}
(mingetty-service-type config =>
(auto-login-to-tty
config "tty3" "alice"))))
(operating-system
;; @dots{}
(services %my-services))
@end lisp
One could also @code{compose} (@pxref{Higher-Order Functions,,, guile,
The Guile Reference Manual}) @code{auto-login-to-tty} to login multiple
users to multiple ttys.
Finally, here is a note of caution. Setting up auto login to a TTY,
means that anyone can turn on your computer and run commands as your
regular user.
However, if you have an encrypted root partition, and thus already need
to enter a passphrase when the system boots, auto-login might be a
convenient option.
@node Customizing the Kernel
@section Customizing the Kernel
@ -1671,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
@ -2003,10 +2050,12 @@ Copy into it the output of:
cat ~/.ssh/<username>_rsa.pub
@end example
Power the Linode down. In the Linode's Disks/Configurations tab, resize
the Debian disk to be smaller. 30 GB is recommended.
Power the Linode down.
In the Linode's Storage tab, resize the Debian disk to be smaller.
30 GB free space is recommended. Then click "Add a disk", and fill
out the form with the following:
In the Linode settings, "Add a disk", with the following:
@itemize @bullet
@item
Label: "Guix"
@ -2018,9 +2067,9 @@ Filesystem: ext4
Set it to the remaining size
@end itemize
On the "configuration" field that comes with the default image, press
"..." and select "Edit", then on that menu add to @file{/dev/sdc} the "Guix"
label.
In the Configurations tab, press "Edit" on the default Debian profile.
Under "Block Device Assignment" click "Add a Device". It should be
@file{/dev/sdc} and you can select the "Guix" disk. Save Changes.
Now "Add a Configuration", with the following:
@itemize @bullet
@ -2046,8 +2095,8 @@ Root device: @file{/dev/sda}
Turn off all the filesystem/boot helpers
@end itemize
Now power it back up, picking the Debian configuration. Once it's
booted up, ssh in your server via @code{ssh
Now power it back up, booting with the Debian configuration. Once it's
running, ssh to your server via @code{ssh
root@@@var{<your-server-IP-here>}}. (You can find your server IP address in
your Linode Summary section.) Now you can run the "install guix from
@pxref{Binary Installation,,, guix, GNU Guix}" steps:
@ -2136,19 +2185,20 @@ Replace the following fields in the above configuration:
@end lisp
The last line in the above example lets you log into the server as root
and set the initial root password. After you have done this, you may
and set the initial root password (see the note at the end of this
recipe about root login). After you have done this, you may
delete that line from your configuration and reconfigure to prevent root
login.
Save your ssh public key (eg: @file{~/.ssh/id_rsa.pub}) as
@file{@var{<your-username-here>}_rsa.pub} and your
Copy your ssh public key (eg: @file{~/.ssh/id_rsa.pub}) as
@file{@var{<your-username-here>}_rsa.pub} and put
@file{guix-config.scm} in the same directory. In a new terminal run
these commands.
@example
sftp root@@<remote server ip address>
put /home/<username>/ssh/id_rsa.pub .
put /path/to/linode/guix-config.scm .
put /path/to/files/<username>_rsa.pub .
put /path/to/files/guix-config.scm .
@end example
In your first terminal, mount the guix drive:
@ -2158,9 +2208,9 @@ mkdir /mnt/guix
mount /dev/sdc /mnt/guix
@end example
Due to the way we set things up above, we do not install GRUB
completely. Instead we install only our grub configuration file. So we
need to copy over some of the other GRUB stuff that is already there:
Due to the way we set up the bootloader section of the guix-config.scm,
only the grub configuration file will be installed. So, we need to copy
over some of the other GRUB stuff already installed on the Debian system:
@example
mkdir -p /mnt/guix/boot/grub
@ -2213,7 +2263,7 @@ still need to set your root and user password initially by clicking on
the ``Launch Console'' option in your linode. Choose the ``Glish''
instead of ``Weblish''. Now you should be able to ssh into the machine.
Horray! At this point you can shut down the server, delete the
Hooray! At this point you can shut down the server, delete the
Debian disk, and resize the Guix to the rest of the size.
Congratulations!

2215
doc/guix.texi
View File

File diff suppressed because it is too large Load Diff

24
doc/he-config-bare-bones.scm 100644
View File

@ -0,0 +1,24 @@
(use-modules (gnu home)
(gnu home-services)
(gnu home-services shells)
(gnu services)
(gnu packages admin)
(guix gexp))
(home-environment
(packages (list htop))
(services
(list
(service home-bash-service-type
(home-bash-configuration
(guix-defaults? #t)
(bash-profile '("\
export HISTFILE=$XDG_CACHE_HOME/.bash_history"))))
(simple-service 'test-config
home-files-service-type
(list `("config/test.conf"
,(plain-file "tmp-file.txt"
"the content of ~/.config/test.conf")))))))

10
doc/htmlxref.cnf
View File

@ -397,15 +397,15 @@ guile-gtk node ${GS}/guile-gtk/docs/guile-gtk/
guile-rpc mono ${GS}/guile-rpc/manual/guile-rpc.html
guile-rpc node ${GS}/guile-rpc/manual/html_node/
guix.de mono ${GS}/guix/manual/de/guix.html
guix.de mono ${GS}/guix/manual/de/guix.de.html
guix.de node ${GS}/guix/manual/de/html_node/
guix.es mono ${GS}/guix/manual/es/guix.html
guix.es mono ${GS}/guix/manual/es/guix.es.html
guix.es node ${GS}/guix/manual/es/html_node/
guix.fr mono ${GS}/guix/manual/fr/guix.html
guix.fr mono ${GS}/guix/manual/fr/guix.fr.html
guix.fr node ${GS}/guix/manual/fr/html_node/
guix.ru mono ${GS}/guix/manual/ru/guix.html
guix.ru mono ${GS}/guix/manual/ru/guix.ru.html
guix.ru node ${GS}/guix/manual/ru/html_node/
guix.zh_CN mono ${GS}/guix/manual/zh-cn/guix.html
guix.zh_CN mono ${GS}/guix/manual/zh-cn/guix.zh_CN.html
guix.zh_CN node ${GS}/guix/manual/zh-cn/html_node/
guix mono ${GS}/guix/manual/en/guix.html
guix node ${GS}/guix/manual/en/html_node/

43
doc/local.mk
View File

@ -4,7 +4,7 @@
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
# Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
# Copyright © 2018, 2021 Julien Lepiller <julien@lepiller.eu>
#
# This file is part of GNU Guix.
#
@ -21,14 +21,35 @@
# You should have received a copy of the GNU General Public License
# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
# If adding a language, update the following variables, and info_TEXINFOS.
MANUAL_LANGUAGES = de es fa fr it ko pt_BR ru sk zh_CN
COOKBOOK_LANGUAGES = de fa fr ko ru sk zh_Hans
# Arg1: A list of languages codes.
# Arg2: The file name stem.
lang_to_texinfo = $(foreach lang,$(1),%D%/$(2).$(lang).texi)
# Automake does not understand GNU Make non-standard extensions,
# unfortunately, so we cannot use the above patsubst-based function here.
info_TEXINFOS = %D%/guix.texi \
%D%/guix.de.texi \
%D%/guix.es.texi \
%D%/guix.fa.texi \
%D%/guix.fr.texi \
%D%/guix.it.texi \
%D%/guix.ko.texi \
%D%/guix.pt_BR.texi \
%D%/guix.ru.texi \
%D%/guix.sk.texi \
%D%/guix.zh_CN.texi \
%D%/guix-cookbook.texi \
%D%/guix-cookbook.de.texi
%D%/guix-cookbook.de.texi \
%D%/guix-cookbook.fa.texi \
%D%/guix-cookbook.fr.texi \
%D%/guix-cookbook.ko.texi \
%D%/guix-cookbook.ru.texi \
%D%/guix-cookbook.sk.texi \
%D%/guix-cookbook.zh_Hans.texi
%C%_guix_TEXINFOS = \
%D%/contributing.texi \
@ -61,18 +82,10 @@ OS_CONFIG_EXAMPLES_TEXI = \
%D%/os-config-desktop.texi \
%D%/os-config-lightweight-desktop.texi
TRANSLATED_INFO = \
%D%/guix.de.texi \
%D%/guix.es.texi \
%D%/guix.fr.texi \
%D%/guix.ru.texi \
%D%/guix.zh_CN.texi \
%D%/contributing.de.texi \
%D%/contributing.es.texi \
%D%/contributing.fr.texi \
%D%/contributing.ru.texi \
%D%/contributing.zh_CN.texi \
%D%/guix-cookbook.de.texi
TRANSLATED_INFO = \
$(call lang_to_texinfo,$(MANUAL_LANGUAGES),guix) \
$(call lang_to_texinfo,$(MANUAL_LANGUAGES),contributing) \
$(call lang_to_texinfo,$(COOKBOOK_LANGUAGES),guix-cookbook)
# Bundle this file so that makeinfo finds it in out-of-source-tree builds.
BUILT_SOURCES += $(OS_CONFIG_EXAMPLES_TEXI) $(TRANSLATED_INFO)
@ -100,7 +113,7 @@ cat "$@.tmp" | egrep '@p?x?ref' -A1 | sed 'N;s|--\n||g;P;D' | sed 's|^| |g' | \
line=$$(grep -n "^msgid \"$$e\"" "$<" | cut -f1 --delimiter=":") ;\
((line++)) ;\
if [ "$$line" != "1" ]; then \
translation=$$(head -n "$$line" "$<" | tail -1 | grep msgstr | sed 's|msgstr "\(.*\)"|\1|') ;\
translation=$$(head -n "$$line" "$<" | tail -1 | grep msgstr | sed 's|msgstr "\([^"]*\)"|\1|') ;\
if [ "$$translation" != "" ]; then \
sed "N;s@\(p\?x\?ref\){$$(echo $$e | sed 's| |[\\n ]|g')\(,\|}\)@\1{$$translation\2@g;P;D" -i "$@.tmp" ;\
fi ;\

134
etc/committer.scm.in
View File

@ -4,6 +4,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,7 +38,43 @@
(ice-9 popen)
(ice-9 match)
(ice-9 rdelim)
(ice-9 textual-ports))
(ice-9 regex)
(ice-9 textual-ports)
(guix gexp))
(define* (break-string str #:optional (max-line-length 70))
"Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
Return a single string."
(define (restore-line words)
(string-join (reverse words) " "))
(if (<= (string-length str) max-line-length)
str
(let ((words+lengths (map (lambda (word)
(cons word (string-length word)))
(string-tokenize str))))
(match (fold (match-lambda*
(((word . length)
(count current lines))
(let ((new-count (+ count length 1)))
(if (< new-count max-line-length)
(list new-count
(cons word current)
lines)
(list length
(list word)
(cons (restore-line current) lines))))))
'(0 () ())
words+lengths)
((_ last-words lines)
(string-join (reverse (cons (restore-line last-words) lines))
"\n"))))))
(define* (break-string-with-newlines str #:optional (max-line-length 70))
"Break the lines of string STR into lines that are no longer than
MAX-LINE-LENGTH. Return a single string."
(string-join (map (cut break-string <> max-line-length)
(string-split str #\newline))
"\n"))
(define (read-excursion port)
"Read an expression from PORT and reset the port position before returning
@ -204,18 +242,19 @@ corresponding to the top-level definition containing the staged changes."
(added (lset-difference equal? new-values old-values)))
(format port
"[~a]: ~a~%" field
(match (list (map symbol->string removed)
(map symbol->string added))
((() added)
(format #f "Add ~a."
(listify added)))
((removed ())
(format #f "Remove ~a."
(listify removed)))
((removed added)
(format #f "Remove ~a; add ~a."
(listify removed)
(listify added)))))))))
(break-string
(match (list (map symbol->string removed)
(map symbol->string added))
((() added)
(format #f "Add ~a."
(listify added)))
((removed ())
(format #f "Remove ~a."
(listify removed)))
((removed added)
(format #f "Remove ~a; add ~a."
(listify removed)
(listify added))))))))))
'(inputs propagated-inputs native-inputs)))
(define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
@ -224,6 +263,41 @@ corresponding to the top-level definition containing the staged changes."
"gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
variable-name file-name variable-name))
(define* (custom-commit-message file-name variable-name message changelog
#:optional (port (current-output-port)))
"Print custom commit message for a change to VARIABLE-NAME in FILE-NAME, using
MESSAGE as the commit message and CHANGELOG as the body of the ChangeLog
entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already
contains ': ', no colon is inserted between the location and body of the
ChangeLog entry."
(define (trim msg)
(string-trim-right (string-trim-both msg) (char-set #\.)))
(define (changelog-has-location? changelog)
(->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog)))
(let* ((message (trim message))
(changelog (if changelog (trim changelog) message))
(message/f (format #f "gnu: ~a: ~a." variable-name message))
(changelog/f (if (changelog-has-location? changelog)
(format #f "* ~a (~a)~a."
file-name variable-name changelog)
(format #f "* ~a (~a): ~a."
file-name variable-name changelog))))
(format port
"~a~%~%~a~%"
(break-string-with-newlines message/f 72)
(break-string-with-newlines changelog/f 72))))
(define (add-copyright-line line)
"Add the copyright line on LINE to the previous commit."
(let ((author (match:substring
(string-match "^\\+;;; Copyright ©[^[:alpha:]]+(.*)$" line)
1)))
(format
(current-output-port) "Amend and add copyright line for ~a~%" author)
(system* "git" "commit" "--amend" "--no-edit")))
(define (group-hunks-by-sexp hunks)
"Return a list of pairs associating all hunks with the S-expression they are
modifying."
@ -252,6 +326,15 @@ modifying."
(define %delay 1000)
(define (main . args)
(define* (change-commit-message* file-name old new #:rest rest)
(let ((changelog #f))
(match args
((or (message changelog) (message))
(apply custom-commit-message
file-name (second old) message changelog rest))
(_
(apply change-commit-message file-name old new rest)))))
(match (diff-info)
(()
(display "Nothing to be done.\n" (current-error-port)))
@ -297,18 +380,25 @@ modifying."
(error "Cannot apply")))
(usleep %delay))
hunks)
(change-commit-message (hunk-file-name (first hunks))
old new
(current-output-port))
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(change-commit-message (hunk-file-name (first hunks))
old new
port)
(define copyright-line
(any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
(const line)))
(hunk-diff-lines (first hunks))))
(cond
(copyright-line
(add-copyright-line copyright-line))
(else
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(change-commit-message* (hunk-file-name (first hunks))
old new)
(change-commit-message* (hunk-file-name (first hunks))
old new
port)
(usleep %delay)
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit")))))
(error "Cannot commit")))))))
;; XXX: we recompute the hunks here because previous
;; insertions lead to offsets.
(new+old+hunks (diff-info)))))))
(main)
(apply main (cdr (command-line)))

117
etc/completion/bash/guix
View File

@ -1,5 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2021 Tobias Geerinck-Rice <me@tobias.gr>
#
# This file is part of GNU Guix.
#
@ -68,31 +69,29 @@ _guix_complete_installed_package ()
_guix_complete_option ()
{
local subcommand
case "${COMP_WORDS[2]}" in
-*) subcommand="";;
[a-z]*) subcommand="${COMP_WORDS[2]}";;
esac
local options="$(${COMP_WORDS[0]} ${COMP_WORDS[1]} $subcommand --help 2> /dev/null \
local command="${COMP_WORDS[$1]}"
local subcommand="${COMP_WORDS[$(($1 + 1))]}"
if _guix_is_option "$subcommand"
then
subcommand=""
fi
local options="$(${COMP_WORDS[0]} $command $subcommand --help 2> /dev/null \
| grep '^ \+-' \
| sed -e's/^.*--\([a-zA-Z0-9_-]\+\)\(=\?\).*/--\1\2/g')"
compopt -o nospace
COMPREPLY=($(compgen -W "$options" -- "${COMP_WORDS[${#COMP_WORDS[*]} - 1]}"))
COMPREPLY=($(compgen -W "$options" -- "$2"))
}
_guix_is_command ()
_guix_is_option ()
{
local word
local result="false"
for word in ${COMP_WORDS[*]}
do
if [ "$word" = "$1" ]
then
result=true
break
fi
done
$result
case "$1" in
-*)
true
;;
*)
false
;;
esac
}
_guix_is_removing ()
@ -183,22 +182,43 @@ _guix_complete ()
local word_count=${#COMP_WORDS[*]}
local word_at_point="${COMP_WORDS[$COMP_CWORD]}"
if [ "$COMP_CWORD" -gt 1 ]
then
case "$word_at_point" in
-*)
_guix_complete_option "$word_at_point"
return
;;
esac
fi
# Find the innermost command at point, e.g. "build" in the case of
# "guix time-machine OPTIONS -- build<Tab>" -- but "time-machine" if
# point is moved before "build".
local command_index=0
local command
local word_index=0
local word
local expect_command="true"
while [[ $((++word_index)) -le COMP_CWORD ]]
do
word="${COMP_WORDS[$word_index]}"
if $expect_command
then
command_index=$word_index
command="$word"
expect_command="false"
continue
fi
if [[ "$word" = "--" ]]
then
case "$command" in
environment)
break
;;
time-machine)
expect_command="true"
;;
esac
fi
done
case $COMP_CWORD in
1)
$command_index)
_guix_complete_command
;;
*)
if _guix_is_command "package"
if [[ "$command" = "package" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p || _guix_is_dash_f
then
@ -209,7 +229,7 @@ _guix_complete ()
else
_guix_complete_available_package "$word_at_point"
fi
elif _guix_is_command "install"
elif [[ "$command" = "install" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
then
@ -217,7 +237,7 @@ _guix_complete ()
else
_guix_complete_available_package "$word_at_point"
fi
elif _guix_is_command "remove"
elif [[ "$command" = "remove" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
then
@ -225,7 +245,7 @@ _guix_complete ()
else
_guix_complete_installed_package "$word_at_point"
fi
elif _guix_is_command "upgrade"
elif [[ "$command" = "upgrade" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
then
@ -233,7 +253,7 @@ _guix_complete ()
else
_guix_complete_installed_package "$word_at_point"
fi
elif _guix_is_command "build"
elif [[ "$command" = "build" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_f
then
@ -241,51 +261,54 @@ _guix_complete ()
else
_guix_complete_available_package "$word_at_point"
fi
elif _guix_is_command "environment"
elif [[ "$command" = "environment" ]]
then
if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p || _guix_is_dash_l
then
_guix_complete_file
elif _guix_is_option "$word_at_point"
then
_guix_complete_option "$command_index" "$word_at_point"
else
_guix_complete_available_package "$word_at_point"
fi
elif _guix_is_command "download"
elif [[ "$command" = "download" ]]
then
_guix_complete_file
elif _guix_is_command "system"
elif [[ "$command" = "system" ]]
then
case $COMP_CWORD in
2) _guix_complete_subcommand;;
*) _guix_complete_file;; # TODO: restrict to *.scm
esac
elif _guix_is_command "pull"
elif [[ "$command" = "pull" ]]
then
if _guix_is_dash_C || _guix_is_dash_p
then
_guix_complete_file
fi
elif _guix_is_command "time-machine"
elif [[ "$command" = "time-machine" ]]
then
if _guix_is_dash_C
then
_guix_complete_file
else
_guix_complete_command
_guix_complete_option "$command_index" "$word_at_point"
fi
elif _guix_is_command "container"
elif [[ "$command" = "container" ]]
then
case $COMP_CWORD in
2) _guix_complete_subcommand;;
3) _guix_complete_pid "$word_at_point";;
*) _guix_complete_file;;
esac
elif _guix_is_command "import"
elif [[ "$command" = "import" ]]
then
_guix_complete_subcommand
elif _guix_is_command "hash" || _guix_is_command "gc"
elif [[ "$command" = "hash" || "$command" = "gc" ]]
then
_guix_complete_file
elif _guix_is_command "weather"
elif [[ "$command" = "weather" ]]
then
if _guix_is_dash_m
then
@ -296,6 +319,12 @@ _guix_complete ()
fi
;;
esac
if [[ -z "$COMPREPLY" && COMP_CWORD -gt command_index ]] &&
_guix_is_option "$word_at_point"
then
_guix_complete_option "$command_index" "$word_at_point"
fi
}
complete -F _guix_complete guix

2
etc/completion/fish/guix.fish
View File

@ -322,8 +322,6 @@ complete -f -c guix -n '__fish_guix_needs_command' -a import -d 'Run IMPORTER wi
##### import gnu
complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a gnu -d 'Return a package declaration template for PACKAGE, a GNU package.'
complete -f -c guix -n '__fish_guix_using_command import; and __fish_seen_subcommand_from gnu' -a "--key-download=" -d 'handle missing OpenPGP keys according to POLICY: "always", "never", and "interactive", which is also used when "key-download" is not specified.'
##### import nix
complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a nix -d 'Import and convert the Nix expression ATTRIBUTE of NIXPKGS.'
##### import pypi
complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a pypi -d 'Import and convert the PyPI package for PACKAGE-NAME.'
##### import cpan

410
etc/completion/zsh/_guix
View File

@ -2,6 +2,8 @@
#
# GNU Guix --- Functional package management for GNU
# Copyright © 2016 Eric Le Bihan <eric.le.bihan.dev@free.fr>
# Copyright © 2021 Noah Evans <noah@nevans.me>
# Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
#
# This file is part of GNU Guix.
#
@ -68,21 +70,24 @@ _guix_list_installed_packages()
(( $+functions[_guix_build] )) || _guix_build()
{
_arguments \
'--expression=[build the package matching EXPR]:EXPR' \
'--file=[build the package matching code evaluated from FILE]:FILE:_files' \
'--source[build the packages source derivations]' \
'--sources=[build source derivations]:TYPE:(all package transitive)' \
'--system=[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
{-e,--expression=}'[build the package or derivation EXPR evaluates to]:EXPR' \
{-f,--file=}'[build the package or derivation that the code within FILE evaluates to]:FILE:_files' \
{-m,--manifest=}'[build the packages that the manifest given in FILE evaluates to]:FILE:_files' \
{-S,--source}'[build the packages source derivations]' \
'--sources=[build source derivations]:TYPE:(package all transitive)' \
{-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
'--target=[cross-build for TRIPLET (e.g. "armel-linux-gnu")]:TRIPLET' \
'--derivations[return the derivation paths of the given packages]' \
{-d,--derivations}'[return the derivation paths of the given packages]' \
'--check[rebuild items to check for non-determinism issues]' \
'--root=[symlink result to FILE and register it as GC root]:FILE:_files' \
'--quiet[do not show the build log]' \
'--repair[repair the specified items]' \
{-r,--root=}'[make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
{-q,--quiet}'[do not show the build log]' \
'--log-file[return the log file names for the given derivations]' \
'--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
'--keep-failed[keep build tree of failed builds]' \
'--keep-going[keep going when some of the derivations fail]' \
'--dry-run[do not build the derivations]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -\' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@ -90,12 +95,12 @@ _guix_list_installed_packages()
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--verbosity=[use the given verbosity LEVEL]:LEVEL' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
'--cores=[allow the use of up to N CPU cores for the build]:N' \
'--max-jobs=[allow at most N build jobs]:N' \
'--with-source=[use SOURCE when building the corresponding package]:SOURCE' \
'--with-input=[replace dependency PACKAGE by REPLACEMENT]:PACKAGE=REPLACEMENT' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
'--help-transform[list package transformation options not shown here]' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
@ -107,7 +112,10 @@ _guix_list_installed_packages()
(( $+functions[_guix_challenge] )) || _guix_challenge()
{
_arguments \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
'--substitute-urls=[compare build results with those at URLS]:URLS:_urls' \
'--diff=[show differences according to MODE]:MODE' \
{-v,--verbose}'[show details about successful comparisons]' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
@ -126,7 +134,11 @@ _guix_list_installed_packages()
(( $+functions[_guix_download] )) || _guix_download()
{
_arguments \
'--format=[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
{-f,--format=}'[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
{-H,--hash=}'[use the given hash ALGORITHM]:ALGORITHM' \
'--no-check-certificate[do not validate the certificate of HTTPS servers ]' \
{-o,--output=}'[download to FILE]:FILE:_files' \
{-V,--version}'[display version information and exit]' \
'1:URL:_urls'
}
@ -139,21 +151,29 @@ _guix_list_installed_packages()
(( $+functions[_guix_environment] )) || _guix_environment()
{
_arguments \
'--expression=[create environment for the package evaluated from EXPR]:EXPR' \
'--load=[create environment for the package evaluated from FILE]:FILE:_files' \
'--ad-hoc[include all specified packages, not only their inputs]' \
{-e,--expression=}'[create environment for the package that EXPR evaluates to]:EXPR' \
{-l,--load=}'[create environment for the package that the code within FILE evaluates to]:FILE:_files' \
{-m,--manifest=}'[create environment with the manifest from FILE]:FILE:_files' \
{-p,--profile=}'[create environment from profile at PATH]:PATH:_files -/' \
'--ad-hoc[include all specified packages in the environment instead of only their inputs]' \
'--pure[unset existing environment variables]' \
{-E,--preserve=}'[preserve environment variables that match REGEXP]:REGEXP' \
'--search-paths[display needed environment variable definitions]' \
'--system=[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
'--container[run command within an isolated container]' \
'--network[allow containers to access the network]' \
'--share=[share writable host file system according to SPEC]:SPEC' \
'--expose=[expose read-only host file system according to SPEC]:SPEC' \
{-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
{-r,--root=}'[make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
{-C,--container}'[run command within an isolated container]' \
{-N,--network}'[allow containers to access the network]' \
{-P,--link-profile}'[link environment profile to ~/.guix-profile within an isolated container]' \
{-u,--user=}'[instead of copying the name and home of the current user into an isolated container, use the name USER with home directory /home/USER]:USER:_users' \
'--no-cwd[do not share current working directory with an isolated container]' \
'--share=[for containers, share writable host file system according to SPEC]:SPEC' \
'--expose=[for containers, expose read-only host file system according to SPEC]:SPEC' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
'--bootstrap[use bootstrap binaries to build the environment]' \
'--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
'--keep-failed[keep build tree of failed builds]' \
'--keep-going[keep going when some of the derivations fail]' \
'--dry-run[do not build the derivations]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@ -161,10 +181,12 @@ _guix_list_installed_packages()
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--verbosity=[use the given verbosity LEVEL]:LEVEL' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
'--cores=[allow the use of up to N CPU cores for the build]:N' \
'--max-jobs=[allow at most N build jobs]:N' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
'--help-transform[list package transformation options not shown here]' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
@ -177,27 +199,39 @@ _guix_list_installed_packages()
(( $+functions[_guix_gc] )) || _guix_gc()
{
_arguments \
'--collect-garbage=[collect at least MIN bytes of garbage]:MIN' \
'--free-space=[attempt to reach FREE available space in the store]:FREE' \
'--delete[attempt to delete PATHS]' \
{-C,--collect-garbage=}'[collect at least MIN bytes of garbage]:MIN' \
{-F,--free-space=}'[attempt to reach FREE available space in the store]:FREE' \
{-d,--delete-generations=}'[delete profile generations matching PATTERN]:PATTERN' \
{-D,--delete}'[attempt to delete PATHS]' \
'--list-roots[list the users GC roots]' \
'--list-busy[list store items used by running processes]' \
'--optimize[optimize the store by deduplicating identical files]' \
'--list-dead[list dead paths]' \
'--list-live[list live paths]' \
'--references[list the references of PATHS]' \
'--requisites[list the requisites of PATHS]' \
{-R,--requisites}'[list the requisites of PATHS]' \
'--referrers[list the referrers of PATHS]' \
'--derivers[list the derivers of PATHS]' \
'--verify=[verify the integrity of the store]:OPTS:(contents repair)' \
'--list-failures[list cached build failures]' \
'--clear-failures[remove PATHS from the set of cached failures]' \
'1:PATH:_dirs'
{-V,--version}'[display version information and exit]:V' \
'1:PATH:_files -/'
}
(( $+functions[_guix_graph] )) || _guix_graph()
{
_arguments \
'--type=[represent nodes of the given TYPE]:TYPE:->types' \
{-b,--backend=}'[produce a graph with the given backend TYPE]:TYPE:->types' \
'--list-backends[list the available graph backends]' \
{-t,--type=}'[represent nodes of the given TYPE]:TYPE:->types' \
'--list-types[list the available graph types]' \
'--expression=[consider the package EXPR evaluates to]:EXPR' \
'--path[display the shortest path between the given nodes]' \
{-e,--expression=}'[consider the package EXPR evaluates to]:EXPR' \
{-s,--system=}'[consider the graph for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
'--help-transform[list package transformation options not shown here]' \
{-V,--version}'[display version information and exit]' \
'1:PACKAGE:->packages'
case "$state" in
@ -216,14 +250,18 @@ _guix_list_installed_packages()
(( $+functions[_guix_hash] )) || _guix_hash()
{
_arguments \
'--format=[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
'--recursive[compute the hash on FILE recursively]'\
{-x,--exclude-vcs}'[exclude version control directories]' \
{-H,--hash=}'[use the given hash ALGORITHM]:ALGORITHM' \
{-f,--format=}'[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
{-r,--recursive}'[compute the hash on FILE recursively]' \
{-V,--version}'[display version information and exit]' \
'1:FILE:_files'
}
(( $+functions[_guix_import] )) || _guix_import()
{
_arguments \
{-V,--version}'[display version information and exit]' \
'1:IMPORTER:->importer' \
'*:args:'
@ -236,8 +274,12 @@ _guix_list_installed_packages()
(( $+functions[_guix_lint] )) || _guix_lint()
{
_arguments \
'--checkers=[only run the specified checkers]:CHECKERS:->checkers' \
'--list-checkers[display the list of available lint checkers]' \
{-c,--checkers=}'[only run the specified checkers]:CHECKERS:->checkers' \
{-x,--exclude=}'[exclude the specified checkers]:CHECKERSS:->checkers' \
{-n,--no-network}'[only run checkers that do not access the network]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-l,--list-checkers}'[display the list of available lint checkers]' \
{-V,--version}'[display version information and exit]' \
'1:PACKAGE:->packages'
case "$state" in
@ -255,29 +297,32 @@ _guix_list_installed_packages()
(( $+functions[_guix_package] )) || _guix_package()
{
_arguments \
'--install[install one or more packages]: :->install' \
'--install-from-expression=[install the package EXP evaluates to]:EXP' \
'--install-from-file=[install the package evaluated from FILE]:FILE:_files' \
'--remove[remove one or more packages]: :->remove' \
'--upgrade=[upgrade all the installed packages matching REGEXP]:REGEXP' \
'--manifest=[create a new profile generation from FILE]:FILE:_files' \
{-i,--install}'[install one or more packages]: :->install' \
{-e,--install-from-expression=}'[install the package EXP evaluates to]:EXP' \
{-f,--install-from-file=}'[install the package evaluated from FILE]:FILE:_files' \
{-r,--remove}'[remove one or more packages]: :->remove' \
{-u,--upgrade=}'[upgrade all the installed packages matching REGEXP]:REGEXP' \
{-m,--manifest=}'[create a new profile generation from FILE]:FILE:_files' \
'--do-not-upgrade=[do not upgrade any packages matching REGEXP]:REGEXP' \
'--roll-back[roll back to the previous generation]' \
'--search-paths=[display needed environment variable definitions]:KINDS' \
'--list-generations=[list generations matching PATTERN]:PATTERN' \
'--delete-generations=[delete generations matching PATTERN]:PATTERN' \
'--switch-generation=[switch to a generation matching PATTERN]:PATTERN' \
'--profile=[use PROFILE instead of the default profile]:PROFILE' \
{-l,--list-generations=}'[list generations matching PATTERN]:PATTERN' \
{-d,--delete-generations=}'[delete generations matching PATTERN]:PATTERN' \
{-S,--switch-generation=}'[switch to a generation matching PATTERN]:PATTERN' \
'--export-manifest[print a manifest for the chosen profile]' \
'--export-channels[print channels for the chosen profile]' \
{-p,--profile}'[use PROFILE instead of the default profile]:PROFILE:_files -/' \
'--list-profiles[list the profiles]' \
'--allow-collisions[do not treat collisions in the profile as an error]' \
'--bootstrap[use the bootstrap Guile to build the profile]' \
'--verbose[produce verbose output]' \
'--search=[search in synopsis and description using REGEXP]:REGEXP' \
'--list-installed=[list installed packages matching REGEXP]:REGEXP' \
'--list-available=[list available packages matching REGEXP]:REGEXP' \
{-s,--search=}'[search in synopsis and description using REGEXP]:REGEXP' \
{-I,--list-installed=}'[list installed packages matching REGEXP]:REGEXP' \
{-A,--list-available=}'[list available packages matching REGEXP]:REGEXP' \
'--show=[show details about a package]: :->show' \
'--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
'--keep-failed[keep build tree of failed builds]' \
'--keep-going[keep going when some of the derivations fail]' \
'--dry-run[do not build the derivations]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@ -285,12 +330,13 @@ _guix_list_installed_packages()
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--verbosity=[use the given verbosity LEVEL]:LEVEL' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
'--cores=[allow the use of up to N CPU cores for the build]:N' \
'--max-jobs=[allow at most N build jobs]:N' \
'--with-source=[use SOURCE when building the corresponding package]:SOURCE' \
'--with-input=[replace dependency PACKAGE by REPLACEMENT]:PACKAGE=REPLACEMENT'
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]' \
'--help-transform[list package transformation options not shown here]' \
{-v,--verbosity=}'[use the given verbosity LEVEL]' \
{-V,--version}'[display version information and exit]'
case "$state" in
install|show)
@ -304,37 +350,165 @@ _guix_list_installed_packages()
esac
}
(( $+functions[_guix_install] )) || _guix_install()
{
_arguments \
{-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
'--no-grafts[do not graft packages]' \
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
'--help-transform[list package transformation options not shown here]' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
_guix_list_available_packages
compadd -a -- _guix_available_packages
fi
}
(( $+functions[_guix_remove] )) || _guix_remove()
{
_arguments \
{-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
'--no-grafts[do not graft packages]' \
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
_guix_list_installed_packages
compadd -a -- _guix_installed_packages
fi
}
(( $+functions[_guix_upgrade] )) || _guix_upgrade()
{
_arguments \
{-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
'--do-not-upgrade=[do not upgrade any packages matching REGEXP]:REGEXP' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
'--no-grafts[do not graft packages]' \
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
'--help-transform[list package transformation options not shown here]' \
{-V,--version}'[display version information and exit]' \
'*:regexp'
}
(( $+functions[_guix_publish] )) || _guix_publish()
{
_arguments \
'--port=[listen on PORT]:PORT:' \
'--listen=[listen on the network interface for HOST]:HOST:_hosts' \
'--user=[change privileges to USER as soon as possible]:USER:_users' \
'--compression=[compress archives at LEVEL]:LEVEL' \
{-p,--port=}'[listen on PORT]:PORT' \
'--listen=[listen on the network interface for HOST]:HOST_hosts' \
{-u,--user=}'[change privileges to USER as soon as possible]:USER_users' \
{-a,--advertise}'[advertise on the local network]' \
{-C,--compression=}'[compress archives with METHOD at LEVEL]:METHOD' \
{-c,--cache=}'[cache published items to DIRECTORY]:DIRECTORY:_files -/' \
'--cache-bypass-threshold=[serve store items below SIZE even when not cached]:SIZE' \
'--workers=[use N workers to bake items]:N' \
'--ttl=[announce narinfos can be cached for TTL seconds]:TTL' \
'--repl=[spawn REPL server on PORT]:PORT'
'--negative-ttl=[announce missing narinfos can be cached for TTL seconds]:TTL' \
'--nar-path=[use PATH as the prefix for nar URLs]:PATH' \
'--public-key=[use FILE as the public key for signatures]:FILE:_files' \
'--private-key=[use FILE as the private key for signatures]:FILE:_files' \
{-r,--repl=}'[spawn REPL server on PORT]:PORT' \
{-V,--version}'[display version information and exit]' \
}
(( $+functions[_guix_pull] )) || _guix_pull()
{
_arguments \
'--verbose[produce verbose output]' \
'--url=[download the Guix tarball from URL]:URL:_urls' \
'--bootstrap[use the bootstrap Guile to build the new Guix]'
{-C,--channels=}'[deploy the channels defined in FILE]:FILE:_files' \
'--url=[download from the Git repository at URL]:URL:_urls' \
'--commit=[download the specified COMMIT]:COMMIT' \
'--branch=[download the tip of the specified BRANCH]:BRANCH' \
'--allow-downgrades[allow downgrades to earlier channel revisions]' \
'--disable-authentication[disable channel authentication]' \
{-N,--news}'[display news compared to the previous generation]' \
{-l,--list-generations=}'[list generations matching PATTERN]:PATTERN' \
'--roll-back[roll back to the previous generation]' \
{-d,--delete-generations=}'[delete generations matching PATTERN]:PATTERN' \
{-S,--switch-generation=}'[switch to a generation matching PATTERN]:PATTERN' \
{-p,--profile=}'[use PROFILE instead of ~/.config/guix/current]:PROFILE:_files -/' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
{-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
'--bootstrap[use the bootstrap Guile to build the new Guix]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
'--no-grafts[do not graft packages]' \
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
{-V,--version}'[display version information and exit]'
}
(( $+functions[_guix_refresh] )) || _guix_refresh()
{
_arguments \
'--expression=[consider the package EXPR evaluates to]:EXPR' \
'--update[update source files in place]' \
'--select=[select all the packages in SUBSET]:SUBSET:(core non-core)' \
'--type=[restrict to updates from the specified updaters]:UPDATER:->updaters' \
'--list-updaters[list available updaters and exit]' \
'--list-dependent[list top-level dependent packages]' \
'--key-server=[use HOST as the OpenPGP key server]:HOST:_hosts' \
{-e,--expression=}'[consider the package EXPR evaluates to]:EXPR' \
{-u,--update}'[update source files in place]' \
{-s,--select=}'[select all the packages in SUBSET, one of]:SUBSET:(core non-core)' \
{-m,--manifest=}'[select all the packages from the manifest in FILE]:FILE:_files' \
{-t,--type=}'[restrict to updates from the specified updaters]:UPDATER:-.updaters' \
{-L,--list-updaters}'[list available updaters and exit]' \
{-l,--list-dependent}'[list top-level dependent packages that would need to be rebuilt as a result of upgrading PACKAGE...]' \
{-r,--recursive}'[check the PACKAGE and its inputs for upgrades]' \
'--list-transitive[list all the packages that PACKAGE depends on]' \
'--keyring=[use FILE as the keyring of upstream OpenPGP keys]:FILE:_files' \
'--key-server=[use HOST as the OpenPGP key server]:HOST_hosts' \
'--gpg=[use COMMAND as the GnuPG 2.x command]:COMMAND' \
'--key-download=[policy to handle missing OpenPGP keys]:POLICY:(always interactive never)' \
'--key-download=[handle missing OpenPGP keys according to POLICY:]:POLICY:(always interactive never)' \
'--load-path=[prepend DIR to the package module search path]:DIR:_files -/' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
case "$state" in
@ -352,9 +526,12 @@ _guix_list_installed_packages()
(( $+functions[_guix_size] )) || _guix_size()
{
_arguments \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
'-system=[consider packages for SYSTEM--e.g., "i686-linux"]:SYSTEM' \
'--map-file=[write to FILE a graphical map of disk usage]:FILE:_files' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
{-s,--system=}'[consider packages for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
'--sort=[sort according to KEY]:KEY:(closure self)' \
{-m,--map-file=}'[write to FILE a graphical map of disk usage]:FILE:_files' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-V,--version}'[display version information and exit]' \
'*:package:->packages'
if [[ "$state" = packages ]]; then
@ -366,28 +543,42 @@ _guix_list_installed_packages()
(( $+functions[_guix_system] )) || _guix_system()
{
_arguments \
'--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
'--keep-failed[keep build tree of failed builds]' \
'--keep-going[keep going when some of the derivations fail]' \
'--dry-run[do not build the derivations]' \
{-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
{-K,--keep-failed}'[keep build tree of failed builds]' \
{-k,--keep-going}'[keep going when some of the derivations fail]' \
{-n,--dry-run}'[do not build the derivations]' \
'--fallback[fall back to building when the substituter fails]' \
'--no-substitutes[build instead of resorting to pre-built substitutes]' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
'--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
'--no-grafts[do not graft packages]' \
'--no-offload[do not attempt to offload builds]' \
'--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
'--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
'--verbosity=[use the given verbosity LEVEL]:LEVEL' \
'--rounds=[build N times in a row to detect non-determinism]:N' \
'--cores=[allow the use of up to N CPU cores for the build]:N' \
'--max-jobs=[allow at most N build jobs]:N' \
'--derivation[return the derivation of the given system]' \
'--on-error=[apply STRATEGY when an error occurs while reading FILE]:STRATEGY' \
'--image-size=[for "image", produce an image of SIZE]:SIZE' \
'--no-grub[for "init", do not install GRUB]' \
'--share=[for "vm", share host file system according to SPEC]:SPEC' \
'--expose=[for "vm", expose host file system according to SPEC]:SPEC' \
'--full-boot[for "vm", make a full boot sequence]' \
{-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
{-M,--max-jobs=}'[allow at most N build jobs]:N' \
'--debug=[produce debugging output at LEVEL]:LEVEL' \
{-d,--derivation}'[return the derivation of the given system]' \
{-e,--expression=}'[consider the operating-system EXPR evaluates to instead of reading FILE, when applicable]:EXPR' \
'--allow-downgrades[for reconfigure, allow downgrades to earlier channel revisions]' \
'--on-error=[apply STRATEGY when an error occurs while reading FILE]:STRATEGY:(nothing-special backtrace debug)' \
'--list-image-types[list available image types]' \
{-t,--image-type=}'[for image, produce an image of TYPE]:TYPE' \
'--image-size=[for image, produce an image of SIZE]:SIZE' \
'--no-bootloader[for init, do not install a bootloader]' \
'--volatile[for image, make the root file system volatile]' \
'--label=[for image, label disk image with LABEL]:LABEL' \
'--save-provenance[save provenance information]' \
'--share=[for vm and container, share host file system with read/write access according to SPEC]:SPEC' \
'--expose=[for vm and container, expose host file system directory as read-only according to SPEC]:SPEC' \
{-N,--network}'[for container, allow containers to access the network]' \
{-r,--root=}'[for vm, image, container and build, make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
'--full-boot[for vm, make a full boot sequence]' \
'--skip-checks[skip file system and initrd module safety checks]' \
'--target=[cross-build for TRIPLET (e.g. "armel-linux-gnu")]:TRIPLET' \
{-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
'--graph-backend=[use BACKEND for extension-graphs and shepherd-graph]:BACKEND' \
{-V,--version}'[display version information and exit]' \
'1:action:->actions' \
'*:file:_files'
@ -405,20 +596,35 @@ _guix_list_installed_packages()
"build:Build a given package"
"challenge:Challenge the substitutes for a package"
"container:Build and manipulate Linux containers"
"copy:Copy store items remotely over SSH"
"deploy:Deploy operating systems on a set of machines"
"describe:Describe the channel revisions currently used"
"download:Download the file at given URL and add it to the store"
"edit:Edit the definitions of a package"
"environment:Build an environment with a package and its dependencies"
"gc:Invoke the garbage collector"
"git:Operate on Git repositories"
"graph:Emit a DOT representation of the dependencies of a package"
"hash:Return the cryptographic hash of a file"
"import:Run an importer"
"install:Install packages"
"lint:Run a set of checkers on a package"
"offload:Set up and operate build offloading"
"pack:Create application bundles"
"package:Install, remove, or upgrade packages"
"processes:List currently running sessions"
"publish:Publish /gnu/store over HTTP."
"pull:Download and deploy the latest version of Guix"
"refresh:Update package definitions to match the latest version"
"remove:Remove packages"
"repl:Read-eval-print loop (REPL) for interactive programming"
"search:Search for packages"
"show:Show information about packages"
"size:Report the size of a package and its dependencies"
"system:Build the operating system"
"time-machine:Run commands from a different revision"
"upgrade:Upgrade packages"
"weather:Report on the availability of pre-built package binaries"
)
if (( CURRENT == 1 )); then

112
etc/disarchive-manifest.scm 100644
View File

@ -0,0 +1,112 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; This file returns a manifest that builds a directory containing Disarchive
;;; metadata for all the tarballs packages refer to.
(use-modules (srfi srfi-1) (ice-9 match)
(guix packages) (guix gexp) (guix profiles)
(guix base16)
(gnu packages))
(include "source-manifest.scm")
(define (tarball-origin? origin)
(match (origin-actual-file-name origin)
(#f #f)
((? string? file)
;; As of version 0.2.1, Disarchive can only deal with raw tarballs and
;; gzip-compressed tarballs.
(and (origin-hash origin)
(or (string-suffix? ".tar.gz" file)
(string-suffix? ".tgz" file)
(string-suffix? ".tar" file))))))
(define (origin->disarchive origin)
"Return a directory containing Disarchive metadata for ORIGIN, a tarball, or
an empty directory if ORIGIN could not be disassembled."
(define file-name
(let ((hash (origin-hash origin)))
(string-append (symbol->string (content-hash-algorithm hash))
"/"
(bytevector->base16-string
(content-hash-value hash)))))
(define disarchive
(specification->package "disarchive"))
(define build
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(srfi srfi-34))
(define tarball
#+(upstream-origin origin))
(define file-name
(string-append #$output "/" #$file-name))
(define profile
#+(profile (content (packages->manifest (list disarchive)))))
(mkdir-p (dirname file-name))
(setenv "PATH" (string-append profile "/bin"))
(setenv "GUILE_LOAD_PATH"
(string-append profile "/share/guile/site/"
(effective-version)))
(setenv "GUILE_LOAD_COMPILED_PATH"
(string-append profile "/lib/guile/" (effective-version)
"/site-ccache"))
(guard (c ((invoke-error? c)
;; Sometimes Disarchive fails with "could not find Gzip
;; compressor". When that happens, produce an empty
;; directory instead of failing.
(report-invoke-error c)
(delete-file file-name)))
(with-output-to-file file-name
(lambda ()
;; Disarchive records the tarball name in its output. Thus,
;; strip the hash from TARBALL.
(let ((short-name (strip-store-file-name tarball)))
(symlink tarball short-name)
(invoke "disarchive" "disassemble" short-name))))))))
(computed-file (match (origin-actual-file-name origin)
((? string? str) (string-append str ".dis"))
(#f "anonymous-tarball.dis"))
build))
(define (disarchive-collection origins)
"Return a directory containing all the Disarchive metadata for ORIGINS."
(directory-union "disarchive-collection"
(filter-map (lambda (origin)
(and (tarball-origin? origin)
(origin->disarchive origin)))
origins)
#:copy? #t))
;; The manifest containing Disarchive data.
(let ((origins (all-origins)))
(manifest
(list (manifest-entry
(name "disarchive-collection")
(version (length origins))
(item (disarchive-collection origins))))))

7
etc/guix-daemon.cil.in
View File

@ -301,7 +301,7 @@
open read write)))
(allow guix_daemon_t
guix_daemon_conf_t
(lnk_file (create getattr rename unlink)))
(lnk_file (create getattr rename unlink read)))
(allow guix_daemon_t net_conf_t
(file (getattr open read)))
(allow guix_daemon_t net_conf_t
@ -328,6 +328,9 @@
(allow guix_daemon_t
cache_home_t
(dir (search)))
(allow guix_daemon_t
cache_home_t
(lnk_file (getattr read)))
;; self upgrades
(allow guix_daemon_t
@ -340,7 +343,7 @@
;; Socket operations
(allow guix_daemon_t
guix_daemon_socket_t
(sock_file (unlink)))
(sock_file (unlink write)))
(allow guix_daemon_t
init_t
(fd (use)))

2
etc/guix-daemon.conf.in
View File

@ -7,4 +7,4 @@ start on runlevel [2345]
stop on runlevel [016]
exec @localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild
exec @localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild --discover=no

3
etc/guix-daemon.service.in
View File

@ -6,7 +6,8 @@
Description=Build daemon for GNU Guix
[Service]
ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild
ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon \
--build-users-group=guixbuild --discover=no
Environment='GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale' LC_ALL=en_US.utf8
RemainAfterExit=yes
StandardOutput=syslog

20
etc/guix-gc.service.in 100644
View File

@ -0,0 +1,20 @@
# This is a "service unit file" for the systemd init system to perform a
# one-shot 'guix gc' operation. It is meant to be triggered by a timer.
# Drop it in /etc/systemd/system or similar together with 'guix-gc.timer'
# to set it up.
[Unit]
Description=Discard unused Guix store items
[Service]
Type=oneshot
# Customize the 'guix gc' arguments to fit your needs.
ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix gc -d 1m -F 10G
PrivateDevices=yes
PrivateNetwork=yes
PrivateUsers=no
ProtectKernelTunables=yes
ProtectKernelModules=yes
ProtectControlGroups=yes
MemoryDenyWriteExecute=yes
SystemCallFilter=@default @file-system @basic-io @system-service

15
etc/guix-gc.timer 100644
View File

@ -0,0 +1,15 @@
# This is a "timer unit file" for the systemd init system to trigger
# 'guix-gc.service' periodically. Drop it in /etc/systemd/system or similar
# together with 'guix-gc.service' to set it up.
[Unit]
Description=Discard unused Guix store items
[Timer]
OnCalendar=weekly
AccuracySec=1h
Persistent=true
RandomizedDelaySec=6000
[Install]
WantedBy=timers.target

200
etc/guix-install.sh
View File

@ -9,6 +9,7 @@
# Copyright © 2020 Daniel Brooks <db48x@db48x.net>
# Copyright © 2021 Jakub Kądziołka <kuba@kadziolka.net>
# Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
# Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
#
# This file is part of GNU Guix.
#
@ -64,12 +65,12 @@ INF="[ INFO ] "
DEBUG=0
GNU_URL="https://ftp.gnu.org/gnu/guix/"
#GNU_URL="https://alpha.gnu.org/gnu/guix/"
OPENPGP_SIGNING_KEY_ID="3CE464558A84FDC69DB40CFB090B11993D9AEBB5"
# This script needs to know where root's home directory is. However, we
# cannot simply use the HOME environment variable, since there is no guarantee
# that it points to root's home directory.
ROOT_HOME="$(echo ~root)"
# The following associative array holds set of GPG keys used to sign the
# releases, keyed by their corresponding Savannah user ID.
declare -A GPG_SIGNING_KEYS
GPG_SIGNING_KEYS[15145]=3CE464558A84FDC69DB40CFB090B11993D9AEBB5 # ludo
GPG_SIGNING_KEYS[127547]=27D586A4F8900854329FF09F1260E46482E63562 # maxim
# ------------------------------------------------------------------------------
#+UTILITIES
@ -91,13 +92,25 @@ _debug()
fi
}
# Return true if user answered yes, false otherwise.
# $1: The prompt question.
prompt_yes_no() {
while true; do
read -rp "$1 " yn
case $yn in
[Yy]*) return 0;;
[Nn]*) return 1;;
*) _msg "Please answer yes or no."
esac
done
}
chk_require()
{ # Check that every required command is available.
declare -a warn
local c
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
for c in "$@"; do
command -v "$c" &>/dev/null || warn+=("$c")
@ -112,29 +125,44 @@ chk_require()
chk_gpg_keyring()
{ # Check whether the Guix release signing public key is present.
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
local user_id
local gpg_key_id
local exit_flag
# Without --dry-run this command will create a ~/.gnupg owned by root on
# systems where gpg has never been used, causing errors and confusion.
gpg --dry-run --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || (
_err "${ERR}Missing OpenPGP public key. Fetch it with this command:"
echo " wget 'https://sv.gnu.org/people/viewgpg.php?user_id=15145' -qO - | sudo -i gpg --import -"
for user_id in "${!GPG_SIGNING_KEYS[@]}"; do
gpg_key_id=${GPG_SIGNING_KEYS[$user_id]}
# Without --dry-run this command will create a ~/.gnupg owned by root on
# systems where gpg has never been used, causing errors and confusion.
if ! gpg --dry-run --list-keys "$gpg_key_id" >/dev/null 2>&1; then
if prompt_yes_no "${INF}The following OpenPGP public key is \
required to verify the Guix binary signature: $gpg_key_id.
Would you like me to fetch it for you? (yes/no)"; then
wget "https://sv.gnu.org/people/viewgpg.php?user_id=$user_id" \
--no-verbose -O- | gpg --import -
else
_err "${ERR}Missing OpenPGP public key ($gpg_key_id).
Fetch it with this command:
wget \"https://sv.gnu.org/people/viewgpg.php?user_id=$user_id\" -O - | \
sudo -i gpg --import -"
exit_flag=yes
fi
fi
done
if [ "$exit_flag" = yes ]; then
exit 1
)
fi
}
chk_term()
{ # Check for ANSI terminal for color printing.
local ansi_term
if [ -t 2 ]; then
if [ "${TERM+set}" = 'set' ]; then
case "$TERM" in
xterm*|rxvt*|urxvt*|linux*|vt*|eterm*|screen*)
ansi_term=true
;;
*)
ansi_term=false
ERR="[ FAIL ] "
PAS="[ PASS ] "
;;
@ -221,6 +249,16 @@ chk_sys_nscd()
fi
}
# Configure substitute discovery according to user's preferences.
# $1 is the installed service file to edit.
configure_substitute_discovery() {
if grep -q -- '--discover=no' "$1" && \
prompt_yes_no "Would you like the Guix daemon to automatically \
discover substitute servers on the local network? (yes/no)"; then
sed -i 's/--discover=no/--discover=yes/' "$1"
fi
}
# ------------------------------------------------------------------------------
#+MAIN
@ -231,10 +269,10 @@ guix_get_bin_list()
local latest_ver
local default_ver
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
# Filter only version and architecture
bin_ver_ls=("$(wget -qO- "$gnu_url" \
bin_ver_ls=("$(wget "$gnu_url" --no-verbose -O- \
| sed -n -e 's/.*guix-binary-\([0-9.]*[a-z0-9]*\)\..*.tar.xz.*/\1/p' \
| sort -Vu)")
@ -260,25 +298,25 @@ guix_get_bin()
local url="$1"
local bin_ver="$2"
local dl_path="$3"
local wget_args=()
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
_msg "${INF}Downloading Guix release archive"
wget --help | grep -q '\--show-progress' && \
_PROGRESS_OPT="-q --show-progress" || _PROGRESS_OPT=""
wget $_PROGRESS_OPT -P "$dl_path" "${url}/${bin_ver}.tar.xz" "${url}/${bin_ver}.tar.xz.sig"
wget --help | grep -q '\--show-progress' \
&& wget_args=("--no-verbose" "--show-progress")
if [[ "$?" -eq 0 ]]; then
_msg "${PAS}download completed."
if wget "${wget_args[@]}" -P "$dl_path" \
"${url}/${bin_ver}.tar.xz" "${url}/${bin_ver}.tar.xz.sig"; then
_msg "${PAS}download completed."
else
_err "${ERR}could not download ${url}/${bin_ver}.tar.xz."
exit 1
fi
pushd "${dl_path}" >/dev/null
gpg --verify "${bin_ver}.tar.xz.sig" >/dev/null 2>&1
if [[ "$?" -eq 0 ]]; then
if gpg --verify "${bin_ver}.tar.xz.sig" >/dev/null 2>&1; then
_msg "${PAS}Signature is valid."
popd >/dev/null
else
@ -292,53 +330,57 @@ sys_create_store()
local pkg="$1"
local tmp_path="$2"
_debug "--- [ $FUNCNAME ] ---"
cd "$tmp_path"
tar --extract \
--file "$pkg" &&
_msg "${PAS}unpacked archive"
_debug "--- [ ${FUNCNAME[0]} ] ---"
if [[ -e "/var/guix" || -e "/gnu" ]]; then
_err "${ERR}A previous Guix installation was found. Refusing to overwrite."
exit 1
else
_msg "${INF}Installing /var/guix and /gnu..."
mv "${tmp_path}/var/guix" /var/
mv "${tmp_path}/gnu" /
fi
_msg "${INF}Linking the root user's profile"
mkdir -p "${ROOT_HOME}/.config/guix"
ln -sf /var/guix/profiles/per-user/root/current-guix \
"${ROOT_HOME}/.config/guix/current"
cd "$tmp_path"
tar --extract --file "$pkg" && _msg "${PAS}unpacked archive"
GUIX_PROFILE="${ROOT_HOME}/.config/guix/current"
_msg "${INF}Installing /var/guix and /gnu..."
mv "${tmp_path}/var/guix" /var/
mv "${tmp_path}/gnu" /
_msg "${INF}Linking the root user's profile"
mkdir -p "~root/.config/guix"
ln -sf /var/guix/profiles/per-user/root/current-guix \
"~root/.config/guix/current"
GUIX_PROFILE="~root/.config/guix/current"
# shellcheck disable=SC1090
source "${GUIX_PROFILE}/etc/profile"
_msg "${PAS}activated root profile at ${ROOT_HOME}/.config/guix/current"
_msg "${PAS}activated root profile at ${GUIX_PROFILE}"
}
sys_create_build_user()
{ # Create the group and user accounts for build users.
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
if [ $(getent group guixbuild) ]; then
if getent group guixbuild > /dev/null; then
_msg "${INF}group guixbuild exists"
else
groupadd --system guixbuild
_msg "${PAS}group <guixbuild> created"
fi
if getent group kvm > /dev/null; then
_msg "${INF}group kvm exists and build users will be added to it"
local KVMGROUP=,kvm
fi
for i in $(seq -w 1 10); do
if id "guixbuilder${i}" &>/dev/null; then
_msg "${INF}user is already in the system, reset"
usermod -g guixbuild -G guixbuild \
usermod -g guixbuild -G guixbuild${KVMGROUP} \
-d /var/empty -s "$(which nologin)" \
-c "Guix build user $i" \
"guixbuilder${i}";
else
useradd -g guixbuild -G guixbuild \
useradd -g guixbuild -G guixbuild${KVMGROUP} \
-d /var/empty -s "$(which nologin)" \
-c "Guix build user $i" --system \
"guixbuilder${i}";
@ -354,7 +396,7 @@ sys_enable_guix_daemon()
local local_bin
local var_guix
_debug "--- [ $FUNCNAME ] ---"
_debug "--- [ ${FUNCNAME[0]} ] ---"
info_path="/usr/local/share/info"
local_bin="/usr/local/bin"
@ -363,8 +405,9 @@ sys_enable_guix_daemon()
case "$INIT_SYS" in
upstart)
{ initctl reload-configuration;
cp "${ROOT_HOME}/.config/guix/current/lib/upstart/system/guix-daemon.conf" \
cp "~root/.config/guix/current/lib/upstart/system/guix-daemon.conf" \
/etc/init/ &&
configure_substitute_discovery /etc/init/guix-daemon.conf &&
start guix-daemon; } &&
_msg "${PAS}enabled Guix daemon via upstart"
;;
@ -372,15 +415,15 @@ sys_enable_guix_daemon()
{ # systemd .mount units must be named after the target directory.
# Here we assume a hard-coded name of /gnu/store.
# XXX Work around <https://issues.guix.gnu.org/41356> until next release.
if [ -f "${ROOT_HOME}/.config/guix/current/lib/systemd/system/gnu-store.mount" ]; then
cp "${ROOT_HOME}/.config/guix/current/lib/systemd/system/gnu-store.mount" \
if [ -f "~root/.config/guix/current/lib/systemd/system/gnu-store.mount" ]; then
cp "~root/.config/guix/current/lib/systemd/system/gnu-store.mount" \
/etc/systemd/system/;
chmod 664 /etc/systemd/system/gnu-store.mount;
systemctl daemon-reload &&
systemctl enable gnu-store.mount;
fi
cp "${ROOT_HOME}/.config/guix/current/lib/systemd/system/guix-daemon.service" \
cp "~root/.config/guix/current/lib/systemd/system/guix-daemon.service" \
/etc/systemd/system/;
chmod 664 /etc/systemd/system/guix-daemon.service;
@ -394,6 +437,9 @@ sys_enable_guix_daemon()
-e 's/^Environment=\(.*\)$/Environment=\1 LC_ALL=en_US.UTF-8';
fi;
configure_substitute_discovery \
/etc/systemd/system/guix-daemon.service
systemctl daemon-reload &&
systemctl enable guix-daemon &&
systemctl start guix-daemon; } &&
@ -401,10 +447,12 @@ sys_enable_guix_daemon()
;;
sysv-init)
{ mkdir -p /etc/init.d;
cp "${ROOT_HOME}/.config/guix/current/etc/init.d/guix-daemon" \
cp "~root/.config/guix/current/etc/init.d/guix-daemon" \
/etc/init.d/guix-daemon;
chmod 775 /etc/init.d/guix-daemon;
configure_substitute_discovery /etc/init.d/guix-daemon
update-rc.d guix-daemon defaults &&
update-rc.d guix-daemon enable &&
service guix-daemon start; } &&
@ -412,17 +460,19 @@ sys_enable_guix_daemon()
;;
openrc)
{ mkdir -p /etc/init.d;
cp "${ROOT_HOME}/.config/guix/current/etc/openrc/guix-daemon" \
cp "~root/.config/guix/current/etc/openrc/guix-daemon" \
/etc/init.d/guix-daemon;
chmod 775 /etc/init.d/guix-daemon;
configure_substitute_discovery /etc/init.d/guix-daemon
rc-update add guix-daemon default &&
rc-service guix-daemon start; } &&
_msg "${PAS}enabled Guix daemon via OpenRC"
;;
NA|*)
_msg "${ERR}unsupported init system; run the daemon manually:"
echo " ${ROOT_HOME}/.config/guix/current/bin/guix-daemon --build-users-group=guixbuild"
echo " ~root/.config/guix/current/bin/guix-daemon --build-users-group=guixbuild"
;;
esac
@ -439,21 +489,18 @@ sys_enable_guix_daemon()
sys_authorize_build_farms()
{ # authorize the public key of the build farm
while true; do
read -p "Permit downloading pre-built package binaries from the project's build farm? (yes/no) " yn
case $yn in
[Yy]*) guix archive --authorize < "${ROOT_HOME}/.config/guix/current/share/guix/ci.guix.gnu.org.pub" &&
_msg "${PAS}Authorized public key for ci.guix.gnu.org";
break;;
[Nn]*) _msg "${INF}Skipped authorizing build farm public keys"
break;;
*) _msg "Please answer yes or no.";
esac
done
if prompt_yes_no "Permit downloading pre-built package binaries from the \
project's build farm? (yes/no)"; then
guix archive --authorize \
< "~root/.config/guix/current/share/guix/ci.guix.gnu.org.pub" \
&& _msg "${PAS}Authorized public key for ci.guix.gnu.org"
else
_msg "${INF}Skipped authorizing build farm public keys"
fi
}
sys_create_init_profile()
{ # Create /etc/profile.d/guix.sh for better desktop integration
{ # Define for better desktop integration
# This will not take effect until the next shell or desktop session!
[ -d "/etc/profile.d" ] || mkdir /etc/profile.d # Just in case
cat <<"EOF" > /etc/profile.d/guix.sh
@ -470,7 +517,7 @@ export INFOPATH="$_GUIX_PROFILE/share/info:$INFOPATH"
GUIX_PROFILE="$HOME/.guix-profile"
[ -L $GUIX_PROFILE ] || return
GUIX_LOCPATH="$GUIX_PROFILE/lib/locale"
export GUIX_PROFILE GUIX_LOCPATH
export GUIX_LOCPATH
[ -f "$GUIX_PROFILE/etc/profile" ] && . "$GUIX_PROFILE/etc/profile"
@ -527,7 +574,7 @@ This script installs GNU Guix on your system
https://www.gnu.org/software/guix/
EOF
echo -n "Press return to continue..."
read -r ANSWER
read -r
}
main()
@ -549,10 +596,19 @@ main()
umask 0022
tmp_path="$(mktemp -t -d guix.XXX)"
guix_get_bin_list "${GNU_URL}"
guix_get_bin "${GNU_URL}" "${BIN_VER}" "$tmp_path"
if [ -z "${GUIX_BINARY_FILE_NAME}" ]; then
guix_get_bin_list "${GNU_URL}"
guix_get_bin "${GNU_URL}" "${BIN_VER}" "$tmp_path"
GUIX_BINARY_FILE_NAME=${BIN_VER}.tar.xz
else
if ! [[ $GUIX_BINARY_FILE_NAME =~ $ARCH_OS ]]; then
_err "$ARCH_OS not in ${GUIX_BINARY_FILE_NAME}; aborting"
fi
_msg "${INF}Using manually provided binary ${GUIX_BINARY_FILE_NAME}"
GUIX_BINARY_FILE_NAME=$(realpath "$GUIX_BINARY_FILE_NAME")
fi
sys_create_store "${BIN_VER}.tar.xz" "${tmp_path}"
sys_create_store "${GUIX_BINARY_FILE_NAME}" "${tmp_path}"
sys_create_build_user
sys_enable_guix_daemon
sys_authorize_build_farms

3
etc/indent-code.el
View File

@ -99,6 +99,8 @@
nil t)
(let ((indent-tabs-mode nil))
(beginning-of-defun)
(mark-sexp)
(untabify (point) (mark))
(indent-sexp)
(save-buffer)
(message "Done!"))
@ -108,6 +110,7 @@
;; Indent all of FILE-NAME.
(find-file file-name)
(let ((indent-tabs-mode nil))
(untabify (point-min) (point-max))
(indent-region (point-min) (point-max))
(save-buffer)
(message "Done!")))

2
etc/init.d/guix-daemon.in
View File

@ -36,7 +36,7 @@ start)
-E LC_ALL=en_US.utf8 \
-p "/var/run/guix-daemon.pid" \
@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon \
--build-users-group=guixbuild
--build-users-group=guixbuild --discover=no
fi
;;
stop)

195
etc/news.scm
View File

@ -14,6 +14,8 @@
;; Copyright © 2021 Zhu Zihao <all_but_last@163.com>
;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;
;; Copying and distribution of this file, with or without modification, are
;; permitted in any medium without royalty provided the copyright notice and
@ -21,6 +23,199 @@
(channel-news
(version 0)
(entry (commit "a2324d8b56eabf8117bca220a507cc791edffd2e")
(title
(en "Guix Home is a part of GNU Guix")
(de "Guix Home ist jetzt Teil von GNU Guix")
(ru "Guix Home теперь поставляется в составе GNU Guix"))
(body
(en "Guix Home splitted out from rde project and now is a part of
Guix proper. It is available as a @emph{technology preview} and thus subject
to change.
The new @command{guix home} command with its actions allows users to
manage their packages and configurations (aka. dotfiles) in a declarative way,
similar to how many people manage their system with @command{guix system}.
Take a look at available actions and arguments:
@example
guix home --help
@end example
See @command{info \"(guix) Home Configuration\"} for more information.")
(de "Guix Home ist aus dem rde-Projekt ins offizielle Guix übernommen
worden. Es ist als @emph{Technologievorschau} bereits verfügbar, aber die
Schnittstelle kann sich in Zukunft noch ändern.
Der neue Befehl @command{guix home} ermöglicht es, die Pakete und
Konfigurationsdateien (Dotfiles) für ein Benutzerkonto im deklarativen Stil zu
verwalten. Es ist analog dazu, wie man @command{guix system} benutzen kann, um
sein System zu verwalten.
Werfen Sie einen Blick auf die verfügbaren Aktionen und Argumente:
@example
guix home --help
@end example
Führen Sie für mehr Informationen @command{info \"(guix) Home Configuration\"}
aus.")
(ru "Guix Home отделился от проекта rde и теперь является частью
Guix. Новая команда @command{guix home} даёт возможность пользователям
управлять их пакетами и конфигурациями (дотфайлами) для них в декларативном
стиле, аналогично тому, как многие люди управляют своими системами с помощью
@command{guix system}.
Чтобы получить список доступных действий и аргументов:
@example
guix home --help
@end example
Смотрите @command{info \"(guix) Home Configuration\"} для получения более
детальных сведений.")))
(entry (commit "5b32ad4f6f555d305659cee825879df075b06331")
(title
(en "New @option{--max-depth} option for @command{guix graph}")
(de "Neue Option @option{--max-depth} für @command{guix graph}")
(fr "Nouvelle option @option{--max-depth} pour @command{guix graph}"))
(body
(en "The @command{guix graph} command has a new @option{--max-depth}
(or @option{-M}) option, which allows you to restrict a graph to the given
depth---very useful when visualizing large graphs. For example, the command
below displays, using the @code{xdot} package, the dependency graph of
LibreOffice, including only nodes that are at most at distance 2 of
LibreOffice itself:
@example
guix graph -M 2 libreoffice | xdot -
@end example
See @command{info \"(guix) Invoking guix graph\"} for more information.")
(de "Der Befehl @command{guix graph} verfügt über eine neue
Befehlszeilenoption @option{--max-depth} (oder @option{-M}), mit der
Sie einen Graphen auf die angegebene Tiefe einschränken. Das ist vor
allem bei großen Graphen nützlich; zum Beispiel zeigt der folgende
Befehl, unter Verwendung des Pakets @code{xdot}, den
Abhängigkeitsgraphen von LibreOffice unter Ausschluss der Knoten, die
eine Distanz größer als 2 von LibreOffice selbst haben:
@example
guix graph -M 2 libreoffice | xdot -
@end example
Führen Sie @code{info \"(guix.de) Aufruf von guix graph\"} aus, um mehr zu
erfahren.")
(fr "La commande @command{guix graph} dispose d'une nouvelle option
@option{--max-depth} (ou @option{-M}) pour restreindre la profondeur d'un
graphe---très utile pour visualiser des gros graphes. Par exemple, la
commande ci-dessous affiche, en utilisant @code{xdot}, le graphe de dépendance
de LibreOffice en n'incluant que les nœuds qui sont au plus à distance 2 de
LibreOffice soi-même :
@example
guix graph -M 2 libreoffice | xdot -
@end example
Voir @command{info \"(guix.fr) Invoquer guix graph\"} pour plus
d'informations.")))
(entry (commit "05f44c2d858a1e7b13c90362c35fa86bdc4d5a24")
(title
(en "Channel clones fall back to Software Heritage")
(de "Zum Klonen von Kanälen wird notfalls auf Software Heritage zurückgegriffen")
(fr "Les clones de canaux peuvent recourir à Software Heritage"))
(body
(en "When @command{guix time-machine} or @command{guix pull} fetches
a channel pinned to a specific commit, it now automatically falls back to
cloning it from the Software Heritage archive if the original URL is
unreachable. This contributes to long-term reproducibility. See
@command{info \"(guix) Replicating Guix\"}.
Automatic fallback also works for other Git clones made on your behalf, such
as when using @option{--with-commit} and related package transformation
options.")
(de "Wenn bei @command{guix time-machine} oder @command{guix
pull} ein bestimmter Commit eines Kanals bezogen werden soll, wird
jetzt für den Fall, dass die ursprüngliche URL unerreichbar ist,
automatisch vom Software-Heritage-Archiv geklont. Das trägt zur
langfristigen Reproduzierbarkeit bei. Siehe @command{info \"(guix.de)
Guix nachbilden\"}.
Der automatische Rückgriff auf Software Heritage findet auch
Verwendung bei anderen Arten von Git-Klon, die Guix durchführt, z.B.@:
wenn Sie @option{--with-commit} und ähnliche Paketumwandlungsoptionen
einsetzen.")
(fr "Quand la commande @command{guix time-machine} ou @command{guix
pull} récupère un canal fixé à une révision spécifique, elle est maintenant
capable de le cloner depuis l'archive Software Heritage si l'URL initiale
n'est plus disponible. Cela contribue à la reproductibilité à long terme.
Voir @command{info \"(guix.fr) Répliquer Guix\"}.
Ce recours à Software Heritage fonctionne aussi pour les autres clones Git que
Guix peut faire, comme lorsqu'on utilise @option{--with-commit} et les options
de transformation de paquet similaires.")))
(entry (commit "82daab42811a2e3c7684ebdf12af75ff0fa67b99")
(title
(en "New @samp{deb} format for the @command{guix pack} command")
(de "Neues Format @samp{deb} für den Befehl @command{guix pack}"))
(body
(en "Debian archives (with the .deb file extension) can now be
produced via the @command{guix pack --format=deb} command, providing an
alternative distribution path for software built with Guix. Here is a simple
example that generates a Debian archive for the @code{hello} package:
@example
guix pack --format=deb --symlink=/usr/bin/hello=bin/hello hello
@end example
See @command{info \"(guix) Invoking guix pack\"} for more information.")
(de "Debian-Archive (mit der Dateinamenserweiterung .deb) können
jetzt auch mit dem Befehl @command{guix pack --format=deb} erzeugt werden, um
mit Guix erstellte Software auf andere Art anzubieten. Hier sehen Sie ein
einfaches Beispiel, wie ein Debian-Archiv für das Paket @code{hello} angelegt
wird:
@example
guix pack --format=deb --symlink=/usr/bin/hello=bin/hello hello
@end example
Siehe @command{info \"(guix.de) Aufruf von guix pack\"} für mehr
Informationen.")))
(entry (commit "bdc298ecee15283451d3aa20a849dd7bb22c8538")
(title
(en "New @command{guix import egg} command")
(de "Neuer Befehl @command{guix import egg}")
(zh "新的 @command{guix import egg} 命令"))
(body
(en "The new @command{guix import egg} command allows packagers to
generate a package definition or a template thereof given the name of a
CHICKEN egg package, like so:
@example
guix import egg sourcehut
@end example
Run @command{info \"(guix) Invoking guix import\"} for more info.")
(de "Mit dem neuen Befehl @command{guix import egg} können
Paketautoren eine Paketdefinition oder eine Vorlage dafür anhand des Namens
eines „Egg“-Pakets für CHICKEN erzeugen, etwa so:
@example
guix import egg sourcehut
@end example
Führen Sie @command{info \"(guix.de) Aufruf von guix import\"} aus, um mehr
Informationen zu bekommen.")
(zh "新的 @command{guix import egg} 命令能让贡献者从一个CHICKEN egg生
成一个包装或包装样板。
@example
guix import egg sourcehut
@end example
想了解更多可以运行 @command{info \"(guix) Invoking guix import\"}。")))
(entry (commit "2161820ebbbab62a5ce76c9101ebaec54dc61586")
(title

2
etc/openrc/guix-daemon.in
View File

@ -20,7 +20,7 @@
export GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale
export LC_ALL=en_US.utf8
command="@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon"
command_args="--build-users-group=guixbuild"
command_args="--build-users-group=guixbuild --discover=no"
command_background="yes"
pidfile="/var/run/guix-daemon.pid"

25
etc/release-manifest.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@ -49,6 +49,14 @@ TARGET."
'("bootstrap-tarballs" "gcc-toolchain" "nss-certs"
"openssh" "emacs" "vim" "python" "guile" "guix")))
(define %base-packages/armhf
;; XXX: Relax requirements for armhf-linux for lack of enough build power.
(map (lambda (package)
(if (string=? (package-name package) "emacs")
(specification->package "emacs-no-x")
package))
%base-packages))
(define %base-packages/hurd
;; XXX: For now we are less demanding of "i586-gnu".
(map specification->package
@ -100,9 +108,18 @@ TARGET."
(manifest
(append-map (lambda (system)
(map (cut package->manifest-entry* <> system)
(if (string=? system "i586-gnu")
%base-packages/hurd
%base-packages)))
(cond ((string=? system "i586-gnu")
%base-packages/hurd)
((string=? system "armhf-linux")
;; FIXME: Drop special case when ci.guix.gnu.org
;; has more ARMv7 build power.
%base-packages/armhf)
((string=? system "powerpc64le-linux")
;; FIXME: Drop 'bootstrap-tarballs' until
;; <https://bugs.gnu.org/48055> is fixed.
(drop %base-packages 1))
(else
%base-packages))))
%cuirass-supported-systems)))
(define %system-manifest

4
etc/snippets/scheme-mode/guix-origin
View File

@ -19,7 +19,9 @@
(t "(string-append \\"https://\\" version \\".tar.gz\\")"))}$0)
${1:$(cond ((equal yas-text "git-fetch")
"(file-name (git-file-name name version))")
((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch" "bzr-fetch"))
((equal yas-text "hg-fetch")
"(file-name (hg-file-name name version))")
((member yas-text '("svn-fetch" "cvs-fetch" "bzr-fetch"))
"(file-name (string-append name \\"-\\" version \\"-checkout\\"))")
(t ""))}
(sha256

66
etc/source-manifest.scm 100644
View File

@ -0,0 +1,66 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; This file returns a manifest containing origins of all the packages. The
;;; main purpose is to allow continuous integration services to keep upstream
;;; source code around. It can also be passed to 'guix weather -m'.
(use-modules (srfi srfi-1) (srfi srfi-26)
(ice-9 match) (ice-9 vlist)
(guix packages) (guix profiles)
(gnu packages))
(define (all-packages)
"Return the list of all the packages, public or private, omitting only
superseded packages."
(fold-packages (lambda (package lst)
(match (package-replacement package)
(#f (cons package lst))
(replacement
(append (list replacement package) lst))))
'()
#:select? (negate package-superseded)))
(define (upstream-origin source)
"Return SOURCE without any patches or snippet."
(origin (inherit source)
(snippet #f) (patches '())))
(define (all-origins)
"Return the list of origins referred to by all the packages."
(let loop ((packages (all-packages))
(origins '())
(visited vlist-null))
(match packages
((head . tail)
(let ((new (remove (cut vhash-assq <> visited)
(package-direct-sources head))))
(loop tail (append new origins)
(fold (cut vhash-consq <> #t <>)
visited new))))
(()
origins))))
;; Return a manifest containing all the origins.
(manifest (map (lambda (origin)
(manifest-entry
(name (or (origin-actual-file-name origin)
"origin"))
(version "0")
(item (upstream-origin origin))))
(all-origins)))

6
etc/substitutes/bordeaux.guix.gnu.org.pub 100644
View File

@ -0,0 +1,6 @@
(public-key
(ecc
(curve Ed25519)
(q #7D602902D3A2DBB83F8A0FB98602A754C5493B0B778C8D1DD4E0F41DE14DE34F#)
)
)

37
gnu/bootloader.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@ -25,7 +25,10 @@
#:use-module (guix gexp)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (guix deprecation)
#:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (menu-entry
@ -55,7 +58,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
@ -179,12 +183,17 @@ record."
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
(define-syntax-rule (warn-target-field-deprecation value)
(%warn-target-field-deprecation value (current-source-location)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader bootloader-configuration-bootloader) ;<bootloader>
(target bootloader-configuration-target ;string
(targets %bootloader-configuration-targets ;list of strings
(default #f))
(target %bootloader-configuration-target ;deprecated
(default #f) (sanitize warn-target-field-deprecation))
(menu-entries bootloader-configuration-menu-entries ;list of <menu-entry>
(default '()))
(default-entry bootloader-configuration-default-entry ;integer
@ -204,6 +213,26 @@ record."
(serial-speed bootloader-configuration-serial-speed ;integer | #f
(default #f)))
(define (%warn-target-field-deprecation value location)
(when value
(warning (source-properties->location location)
(G_ "the 'target' field is deprecated, please use 'targets' \
instead~%")))
value)
(define-deprecated (bootloader-configuration-target config)
bootloader-configuration-targets
(%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.

5
gnu/bootloader/grub.scm
View File

@ -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\"))
…))
…)

7
gnu/bootloader/u-boot.scm
View File

@ -73,9 +73,12 @@
(define install-allwinner64-u-boot
#~(lambda (bootloader root-index image)
(let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
(let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
(u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
(write-file-on-device spl (stat:size (stat spl))
image (* 8 1024)))))
image (* 8 1024))
(write-file-on-device u-boot (stat:size (stat u-boot))
image (* 40 1024)))))
(define install-imx-u-boot
#~(lambda (bootloader root-index image)

38
gnu/build/activation.scm
View File

@ -6,6 +6,8 @@
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,6 +26,7 @@
(define-module (gnu build activation)
#:use-module (gnu system accounts)
#:use-module (gnu system setuid)
#:use-module (gnu build accounts)
#:use-module (gnu build linux-boot)
#:use-module (guix build utils)
@ -279,14 +282,17 @@ they already exist."
"/run/setuid-programs")
(define (activate-setuid-programs programs)
"Turn PROGRAMS, a list of file names, into setuid programs stored under
%SETUID-DIRECTORY."
(define (make-setuid-program prog)
"Turn PROGRAMS, a list of file setuid-programs record, into setuid programs
stored under %SETUID-DIRECTORY."
(define (make-setuid-program program setuid? setgid? uid gid)
(let ((target (string-append %setuid-directory
"/" (basename prog))))
(copy-file prog target)
(chown target 0 0)
(chmod target #o4555)))
"/" (basename program)))
(mode (+ #o0555 ; base permissions
(if setuid? #o4000 0) ; setuid bit
(if setgid? #o2000 0)))) ; setgid bit
(copy-file program target)
(chown target uid gid)
(chmod target mode)))
(format #t "setting up setuid programs in '~a'...~%"
%setuid-directory)
@ -302,15 +308,27 @@ they already exist."
(for-each (lambda (program)
(catch 'system-error
(lambda ()
(make-setuid-program program))
(let* ((program-name (setuid-program-program program))
(setuid? (setuid-program-setuid? program))
(setgid? (setuid-program-setgid? program))
(user (setuid-program-user program))
(group (setuid-program-group program))
(uid (match user
((? string?) (passwd:uid (getpwnam user)))
((? integer?) user)))
(gid (match group
((? string?) (group:gid (getgrnam group)))
((? integer?) group))))
(make-setuid-program program-name setuid? setgid? uid gid)))
(lambda args
;; If we fail to create a setuid program, better keep going
;; so that we don't leave %SETUID-DIRECTORY empty or
;; half-populated. This can happen if PROGRAMS contains
;; incorrect file names: <https://bugs.gnu.org/38800>.
(format (current-error-port)
"warning: failed to make '~a' setuid-root: ~a~%"
program (strerror (system-error-errno args))))))
"warning: failed to make ~s setuid/setgid: ~a~%"
(setuid-program-program program)
(strerror (system-error-errno args))))))
programs))
(define (activate-special-files special-files)

358
gnu/build/file-systems.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019–2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 David C. Trudgian <dave@trudgian.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
@ -166,14 +166,23 @@ if DEVICE does not contain an ext2 file system."
(sub-bytevector sblock 104 16))
(define (ext2-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 16 characters, or
#f if SBLOCK has no volume name."
"Return the volume name of ext2 superblock SBLOCK as a string of at most 16
characters, or #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 120 16)))
(define (check-ext2-file-system device)
"Return the health of an ext2 file system on DEVICE."
(define (check-ext2-file-system device force? repair)
"Return the health of an unmounted ext2 file system on DEVICE. If FORCE? is
true, check the file system even if it's marked as clean. If REPAIR is false,
do not write to the file system to fix errors. If it's #t, fix all
errors. Otherwise, fix only those considered safe to repair automatically."
(match (status:exit-val
(system* "e2fsck" "-v" "-p" "-C" "0" device))
(apply system* `("e2fsck" "-v" "-C" "0"
,@(if force? '("-f") '())
,@(match repair
(#f '("-n"))
(#t '("-y"))
(_ '("-p")))
,device)))
(0 'pass)
(1 'errors-corrected)
(2 'reboot-required)
@ -239,15 +248,15 @@ if DEVICE does not contain an linux-swap file system."
(define (read-bcachefs-superblock device)
"Return the raw contents of DEVICE's bcachefs superblock as a bytevector, or #f
if DEVICE does not contain a bcachefs file system."
;; We completely ignore the back-up superblock & any checksum errors.
;; Superblock field names, with offset & length respectively, in bytes:
;; Field offsets & lengths, in bytes. There are more (and the superblock is
;; extensible) but we need only some basic information here:
;; 0 16 bch_csum
;; 16 8 version
;; 24 16 magic
;; 40 16 uuid ← ‘internal UUID’, you probably don't want this
;; 56 16 user_uuid ← ‘external UUID’, the one by which to mount
;; 40 16 uuid ← ‘internal’: you probably don't want this one
;; 56 16 user_uuid ← ‘external’: user-visible one by which to mount
;; 72 32 label
;; … there are more & the superblock is extensible, but we don't care yet.
;; Assume a sane file system: ignore the back-up superblock & checksums.
(read-superblock device 4096 104 bcachefs-superblock?))
(define (bcachefs-superblock-external-uuid sblock)
@ -256,19 +265,28 @@ bytevector."
(sub-bytevector sblock 56 16))
(define (bcachefs-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 32 characters, or
#f if SBLOCK has no volume name."
"Return the volume name of bcachefs superblock SBLOCK as a string of at most
32 characters, or #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 72 32)))
(define (check-bcachefs-file-system device)
"Return the health of a bcachefs file system on DEVICE."
(define (check-bcachefs-file-system device force? repair)
"Return the health of an unmounted bcachefs file system on DEVICE. If FORCE?
is true, check the file system even if it's marked as clean. If REPAIR is
false, do not write to the file system to fix errors. If it's #t, fix all
errors. Otherwise, fix only those considered safe to repair automatically."
(let ((ignored-bits (logior 2)) ; DEVICE was mounted read-only
(status
;; A number, or #f on abnormal termination (e.g., assertion failure).
(status:exit-val
(apply system* "bcachefs" "fsck" "-p" "-v"
;; Make each multi-device member a separate argument.
(string-split device #\:)))))
(match (logand (lognot ignored-bits) status)
(apply system* `("bcachefs" "fsck" "-v"
,@(if force? '("-f") '())
,@(match repair
(#f '("-n"))
(#t '("-y"))
(_ '("-p")))
;; Make each multi-device member a separate argument.
,@(string-split device #\:))))))
(match (and=> status (cut logand <> (lognot ignored-bits)))
(0 'pass)
(1 'errors-corrected)
(_ 'fatal-error))))
@ -299,16 +317,33 @@ if DEVICE does not contain a btrfs file system."
(sub-bytevector sblock 32 16))
(define (btrfs-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 256 characters, or
#f if SBLOCK has no volume name."
"Return the volume name of btrfs superblock SBLOCK as a string of at most 256
characters, or #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 299 256)))
(define (check-btrfs-file-system device)
"Return the health of a btrfs file system on DEVICE."
(match (status:exit-val
(system* "btrfs" "device" "scan"))
(0 'pass)
(_ 'fatal-error)))
(define (check-btrfs-file-system device force? repair)
"Return the health of an unmounted btrfs file system on DEVICE. If FORCE? is
false, return 'PASS unconditionally as btrfs claims no need for off-line checks.
When FORCE? is true, do perform a real check. This is not recommended! See
@uref{https://bugzilla.redhat.com/show_bug.cgi?id=625967#c8}. If REPAIR is
false, do not write to DEVICE. If it's #t, fix any errors found. Otherwise,
fix only those considered safe to repair automatically."
(if force?
(match (status:exit-val
(apply system* `("btrfs" "check" "--progress"
;; Btrfs's ‘--force’ is not relevant to us here.
,@(match repair
;; Upstream considers ALL repairs dangerous
;; and will warn the user at run time.
(#t '("--repair"))
(_ '("--readonly" ; a no-op for clarity
;; A 466G file system with 180G used is
;; enough to kill btrfs with 6G of RAM.
"--mode" "lowmem")))
,device)))
(0 'pass)
(_ 'fatal-error))
'pass))
;;;
@ -332,15 +367,22 @@ if DEVICE does not contain a btrfs file system."
(sub-bytevector sblock 67 4))
(define (fat32-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 11 characters, or
#f if SBLOCK has no volume name. The volume name is a latin1 string.
Trailing spaces are trimmed."
"Return the volume name of fat superblock SBLOCK as a string of at most 11
characters, or #f if SBLOCK has no volume name. The volume name is a latin1
string. Trailing spaces are trimmed."
(string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space))
(define (check-fat-file-system device)
"Return the health of a fat file system on DEVICE."
(define (check-fat-file-system device force? repair)
"Return the health of an unmounted FAT file system on DEVICE. FORCE? is
ignored: a full file system scan is always performed. If REPAIR is false, do
not write to the file system to fix errors. Otherwise, automatically fix them
using the least destructive approach."
(match (status:exit-val
(system* "fsck.vfat" "-v" "-a" device))
(apply system* `("fsck.vfat" "-v"
,@(match repair
(#f '("-n"))
(_ '("-a"))) ; no 'safe/#t distinction
,device)))
(0 'pass)
(1 'errors-corrected)
(_ 'fatal-error)))
@ -365,9 +407,9 @@ Trailing spaces are trimmed."
(sub-bytevector sblock 39 4))
(define (fat16-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 11 characters, or
#f if SBLOCK has no volume name. The volume name is a latin1 string.
Trailing spaces are trimmed."
"Return the volume name of fat superblock SBLOCK as a string of at most 11
characters, or #f if SBLOCK has no volume name. The volume name is a latin1
string. Trailing spaces are trimmed."
(string-trim-right (latin1->string (sub-bytevector sblock 43 11)
(lambda (c) #f))
#\space))
@ -426,8 +468,8 @@ SBLOCK as a bytevector. If that's not set, returns the creation time."
(sub-bytevector time 0 16))) ; strips GMT offset.
(define (iso9660-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string. The volume name is an ASCII
string. Trailing spaces are trimmed."
"Return the volume name of iso9660 superblock SBLOCK as a string. The volume
name is an ASCII string. Trailing spaces are trimmed."
;; Note: Valid characters are of the set "[0-9][A-Z]_" (ECMA-119 Appendix A)
(string-trim-right (latin1->string (sub-bytevector sblock 40 32)
(lambda (c) #f)) #\space))
@ -458,14 +500,32 @@ if DEVICE does not contain a JFS file system."
(sub-bytevector sblock 136 16))
(define (jfs-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 16 characters, or
#f if SBLOCK has no volume name."
"Return the volume name of JFS superblock SBLOCK as a string of at most 16
characters, or #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 152 16)))
(define (check-jfs-file-system device)
"Return the health of a JFS file system on DEVICE."
(define (check-jfs-file-system device force? repair)
"Return the health of an unmounted JFS file system on DEVICE. If FORCE? is
true, check the file system even if it's marked as clean. If REPAIR is false,
do not write to the file system to fix errors, and replay the transaction log
only if FORCE? is true. Otherwise, replay the transaction log before checking
and automatically fix found errors."
(match (status:exit-val
(system* "jfs_fsck" "-p" "-v" device))
(apply system*
`("jfs_fsck" "-v"
;; The ‘LEVEL’ logic is convoluted. To quote fsck/xchkdsk.c
;; (‘-p’, ‘-a’, and ‘-r’ are aliases in every way):
;; “If -f was chosen, have it override [-p] by [forcing] a
;; check regardless of the outcome after the log is
;; replayed”.
;; “If -n is specified by itself, don't replay the journal.
;; If -n is specified with [-p], replay the journal but
;; don't make any other changes”.
,@(if force? '("-f") '())
,@(match repair
(#f '("-n"))
(_ '("-p"))) ; no 'safe/#t distinction
,device)))
(0 'pass)
(1 'errors-corrected)
(2 'reboot-required)
@ -510,18 +570,28 @@ if DEVICE does not contain an F2FS file system."
16))
(define (f2fs-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 512 characters, or
#f if SBLOCK has no volume name."
"Return the volume name of F2FS superblock SBLOCK as a string of at most 512
characters, or #f if SBLOCK has no volume name."
(null-terminated-utf16->string
(sub-bytevector sblock (- (+ #x470 12) #x400) 512)
%f2fs-endianness))
(define (check-f2fs-file-system device)
"Return the health of a F2FS file system on DEVICE."
(define (check-f2fs-file-system device force? repair)
"Return the health of an unmuounted F2FS file system on DEVICE. If FORCE? is
true, check the file system even if it's marked as clean. If either FORCE? or
REPAIR are true, automatically fix found errors."
;; There's no ‘-n’ equivalent (‘--dry-run’ does not disable writes).
;; ’-y’ is an alias of ‘-f’. The man page is bad: read main.c.
(when (and force? (not repair))
(format (current-error-port)
"warning: forced check of F2FS ~a implies repairing any errors~%"
device))
(match (status:exit-val
(system* "fsck.f2fs" "-p" device))
;; 0 and -1 are the only two possibilities
;; (according to the manpage)
(apply system* `("fsck.f2fs"
,@(if force? '("-f") '())
,@(if repair '("-p") '("--dry-run"))
,device)))
;; 0 and -1 are the only two possibilities according to the man page.
(0 'pass)
(_ 'fatal-error)))
@ -599,13 +669,81 @@ if DEVICE does not contain a NTFS file system."
;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems
;; way harder to access.
(define (check-ntfs-file-system device)
"Return the health of a NTFS file system on DEVICE."
(define (check-ntfs-file-system device force? repair)
"Return the health of an unmounted NTFS file system on DEVICE. FORCE? is
ignored: a full check is always performed. Repair is not possible: if REPAIR is
true and the volume has been repaired by an external tool, clear the volume
dirty flag to indicate that it's now safe to mount."
(match (status:exit-val
(system* "ntfsfix" device))
(apply system* `("ntfsfix"
,@(if repair '("--clear-dirty") '("--no-action"))
,device)))
(0 'pass)
(_ 'fatal-error)))
;;;
;;; XFS file systems.
;;;
;; <https://git.kernel.org/pub/scm/fs/xfs/xfs-documentation.git/tree/design/XFS_Filesystem_Structure/allocation_groups.asciidoc>
(define-syntax %xfs-endianness
;; Endianness of XFS file systems.
(identifier-syntax (endianness big)))
(define (xfs-superblock? sblock)
"Return #t when SBLOCK is an XFS superblock."
(bytevector=? (sub-bytevector sblock 0 4)
(string->utf8 "XFSB")))
(define (read-xfs-superblock device)
"Return the raw contents of DEVICE's XFS superblock as a bytevector, or #f
if DEVICE does not contain an XFS file system."
(read-superblock device 0 120 xfs-superblock?))
(define (xfs-superblock-uuid sblock)
"Return the UUID of XFS superblock SBLOCK as a 16-byte bytevector."
(sub-bytevector sblock 32 16))
(define (xfs-superblock-volume-name sblock)
"Return the volume name of XFS superblock SBLOCK as a string of at most 12
characters, or #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 108 12)))
(define (check-xfs-file-system device force? repair)
"Return the health of an unmounted XFS file system on DEVICE. If FORCE? is
false, return 'PASS unconditionally as XFS claims no need for off-line checks.
When FORCE? is true, do perform a thorough check. If REPAIR is false, do not
write to DEVICE. If it's #t, replay the log, check, and fix any errors found.
Otherwise, only replay the log, and check without attempting further repairs."
(define (xfs_repair)
(status:exit-val
(apply system* `("xfs_repair" "-Pv"
,@(match repair
(#t '("-e"))
(_ '("-n"))) ; will miss some errors
,device))))
(if force?
;; xfs_repair fails with exit status 2 if the log is dirty, which is
;; likely in situations where you're running xfs_repair. Only the kernel
;; can replay the log by {,un}mounting it cleanly.
(match (let ((status (xfs_repair)))
(if (and repair (eq? 2 status))
(let ((target "/replay-XFS-log"))
;; The kernel helpfully prints a ‘Mounting…’ notice for us.
(mkdir target)
(mount device target "xfs")
(umount target)
(rmdir target)
(xfs_repair))
status))
(0 'pass)
(4 'errors-corrected)
(_ 'fatal-error))
'pass))
;;;
;;; Partition lookup.
@ -644,16 +782,13 @@ if DEVICE does not contain a NTFS file system."
(loop parts))))))))))
(define (ENOENT-safe proc)
"Wrap the one-argument PROC such that ENOENT errors are caught and lead to a
warning and #f as the result."
"Wrap the one-argument PROC such that ENOENT, EIO, and ENOMEDIUM errors are
caught and lead to a warning and #f as the result."
(lambda (device)
(catch 'system-error
(lambda ()
(proc device))
(lambda args
;; When running on the hand-made /dev,
;; 'disk-partitions' could return partitions for which
;; we have no /dev node. Handle that gracefully.
(let ((errno (system-error-errno args)))
(cond ((= ENOENT errno)
(format (current-error-port)
@ -671,11 +806,10 @@ warning and #f as the result."
(define (partition-field-reader read field)
"Return a procedure that takes a device and returns the value of a FIELD in
the partition superblock or #f."
(let ((read (ENOENT-safe read)))
(lambda (device)
(let ((sblock (read device)))
(and sblock
(field sblock))))))
(lambda (device)
(let ((sblock (read device)))
(and sblock
(field sblock)))))
(define (read-partition-field device partition-field-readers)
"Returns the value of a FIELD in the partition superblock of DEVICE or #f. It
@ -703,7 +837,9 @@ partition field reader that returned a value."
(partition-field-reader read-jfs-superblock
jfs-superblock-volume-name)
(partition-field-reader read-f2fs-superblock
f2fs-superblock-volume-name)))
f2fs-superblock-volume-name)
(partition-field-reader read-xfs-superblock
xfs-superblock-volume-name)))
(define %partition-uuid-readers
(list (partition-field-reader read-iso9660-superblock
@ -725,7 +861,9 @@ partition field reader that returned a value."
(partition-field-reader read-f2fs-superblock
f2fs-superblock-uuid)
(partition-field-reader read-ntfs-superblock
ntfs-superblock-uuid)))
ntfs-superblock-uuid)
(partition-field-reader read-xfs-superblock
xfs-superblock-uuid)))
(define read-partition-label
(cut read-partition-field <> %partition-label-readers))
@ -742,11 +880,14 @@ partition field reader that returned a value."
(define (partition-predicate reader =)
"Return a predicate that returns true if the FIELD of partition header that
was READ is = to the given value."
(lambda (expected)
(lambda (device)
(let ((actual (reader device)))
(and actual
(= actual expected))))))
;; When running on the hand-made /dev, 'disk-partitions' could return
;; partitions for which we have no /dev node. Handle that gracefully.
(let ((reader (ENOENT-safe reader)))
(lambda (expected)
(lambda (device)
(let ((actual (reader device)))
(and actual
(= actual expected)))))))
(define partition-label-predicate
(partition-predicate read-partition-label string=?))
@ -816,8 +957,13 @@ containing ':/')."
(uuid-bytevector spec)
uuid->string))))
(define (check-file-system device type)
"Run a file system check of TYPE on DEVICE."
(define (check-file-system device type force? repair)
"Check an unmounted TYPE file system on DEVICE. Do nothing but warn if it is
mounted. If FORCE? is true, check even when considered unnecessary. If REPAIR
is false, try not to write to DEVICE at all. If it's #t, try to fix all errors
found. Otherwise, fix only those considered safe to repair automatically. Not
all TYPEs support all values or combinations of FORCE? and REPAIR. Don't throw
an exception in such cases but perform the nearest sane action."
(define check-procedure
(cond
((string-prefix? "ext" type) check-ext2-file-system)
@ -828,36 +974,44 @@ containing ':/')."
((string-prefix? "f2fs" type) check-f2fs-file-system)
((string-prefix? "ntfs" type) check-ntfs-file-system)
((string-prefix? "nfs" type) (const 'pass))
((string-prefix? "xfs" type) check-xfs-file-system)
(else #f)))
(if check-procedure
(match (check-procedure device)
('pass
#t)
('errors-corrected
(format (current-error-port)
"File system check corrected errors on ~a; continuing~%"
device))
('reboot-required
(format (current-error-port)
"File system check corrected errors on ~a; rebooting~%"
device)
(sleep 3)
(reboot))
('fatal-error
(format (current-error-port) "File system check on ~a failed~%"
device)
(let ((mount (find (lambda (mount)
(string=? device (mount-source mount)))
(mounts))))
(if mount
(format (current-error-port)
"Refusing to check ~a file system already mounted at ~a~%"
device (mount-point mount))
(match (check-procedure device force? repair)
('pass
#t)
('errors-corrected
(format (current-error-port)
"File system check corrected errors on ~a; continuing~%"
device))
('reboot-required
(format (current-error-port)
"File system check corrected errors on ~a; rebooting~%"
device)
(sleep 3)
(reboot))
('fatal-error
(format (current-error-port) "File system check on ~a failed~%"
device)
;; Spawn a REPL only if someone would be able to interact with it.
(when (isatty? (current-input-port))
(format (current-error-port) "Spawning Bourne-like REPL.~%")
;; Spawn a REPL only if someone might interact with it.
(when (isatty? (current-input-port))
(format (current-error-port) "Spawning Bourne-like REPL.~%")
;; 'current-output-port' is typically connected to /dev/klog (in
;; PID 1), but here we want to make sure we talk directly to the
;; user.
(with-output-to-file "/dev/console"
(lambda ()
(start-repl %bournish-language))))))
;; 'current-output-port' is typically connected to /dev/klog
;; (in PID 1), but here we want to make sure we talk directly
;; to the user.
(with-output-to-file "/dev/console"
(lambda ()
(start-repl %bournish-language))))))))
(format (current-error-port)
"No file system check procedure for ~a; skipping~%"
device)))
@ -886,7 +1040,11 @@ corresponds to the symbols listed in FLAGS."
(()
0))))
(define* (mount-file-system fs #:key (root "/root"))
(define* (mount-file-system fs #:key (root "/root")
(check? (file-system-check? fs))
(skip-check-if-clean?
(file-system-skip-check-if-clean? fs))
(repair (file-system-repair fs)))
"Mount the file system described by FS, a <file-system> object, under ROOT."
(define (mount-nfs source mount-point type flags options)
@ -924,8 +1082,8 @@ corresponds to the symbols listed in FLAGS."
(file-system-mount-flags (statfs source)))
0)))
(options (file-system-options fs)))
(when (file-system-check? fs)
(check-file-system source type))
(when check?
(check-file-system source type (not skip-check-if-clean?) repair))
(catch 'system-error
(lambda ()

4
gnu/build/image.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
@ -61,7 +61,7 @@
(inexact->exact (ceiling (/ size 1024)))))
(define (estimate-partition-size root)
"Given the ROOT directory, evalute and return its size. As this doesn't
"Given the ROOT directory, evaluate and return its size. As this doesn't
take the partition metadata size into account, take a 25% margin."
(* 1.25 (file-size root)))

587
gnu/build/jami-service.scm 100644
View File

@ -0,0 +1,587 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;
;;; This module contains helpers used as part of the jami-service-type
;;; definition.
;;;
;;; Code:
(define-module (gnu build jami-service)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 peg)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (rnrs io ports)
#:autoload (shepherd service) (fork+exec-command)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (account-fingerprint?
account-details->recutil
get-accounts
get-usernames
set-account-details
add-account
account->username
username->account
username->contacts
enable-account
disable-account
add-contact
remove-contact
set-all-moderators
set-moderator
username->all-moderators?
username->moderators
dbus-available-services
dbus-service-available?
%send-dbus-binary
%send-dbus-bus
%send-dbus-user
%send-dbus-group
%send-dbus-debug
send-dbus
with-retries))
;;;
;;; Utilities.
;;;
(define-syntax-rule (with-retries n delay body ...)
"Retry the code in BODY up to N times until it doesn't raise an exception
nor return #f, else raise an error. A delay of DELAY seconds is inserted
before each retry."
(let loop ((attempts 0))
(catch #t
(lambda ()
(let ((result (begin body ...)))
(if (not result)
(error "failed attempt" attempts)
result)))
(lambda args
(if (< attempts n)
(begin
(sleep delay) ;else wait and retry
(loop (+ 1 attempts)))
(error "maximum number of retry attempts reached"
body ... args))))))
(define (alist->list alist)
"Flatten ALIST into a list."
(append-map (match-lambda
(() '())
((key . value)
(list key value)))
alist))
(define account-fingerprint-rx (make-regexp "[0-9A-Fa-f]{40}"))
(define (account-fingerprint? val)
"A Jami account fingerprint is 40 characters long and only contains
hexadecimal characters."
(and (string? val)
(regexp-exec account-fingerprint-rx val)))
;;;
;;; D-Bus reply parser.
;;;
(define (parse-dbus-reply reply)
"Return the parse tree of REPLY, a string returned by the 'dbus-send'
command."
;; Refer to 'man 1 dbus-send' for the grammar reference. Note that the
;; format of the replies doesn't match the format of the input, which is the
;; one documented, but it gives an idea. For an even better reference, see
;; the `print_iter' procedure of the 'dbus-print-message.c' file from the
;; 'dbus' package sources.
(define-peg-string-patterns
"contents <- header (item / container (item / container*)?)
item <-- WS type WS value NL
container <- array / dict / variant
array <-- array-start (item / container)* array-end
dict <-- array-start dict-entry* array-end
dict-entry <-- dict-entry-start item item dict-entry-end
variant <-- variant-start item
type <-- 'string' / 'int16' / 'uint16' / 'int32' / 'uint32' / 'int64' /
'uint64' / 'double' / 'byte' / 'boolean' / 'objpath'
value <-- (!NL .)* NL
header < (!NL .)* NL
variant-start < WS 'variant'
array-start < WS 'array [' NL
array-end < WS ']' NL
dict-entry-start < WS 'dict entry(' NL
dict-entry-end < WS ')' NL
DQ < '\"'
WS < ' '*
NL < '\n'*")
(peg:tree (match-pattern contents reply)))
(define (strip-quotes text)
"Strip the leading and trailing double quotes (\") characters from TEXT."
(let* ((text* (if (string-prefix? "\"" text)
(string-drop text 1)
text))
(text** (if (string-suffix? "\"" text*)
(string-drop-right text* 1)
text*)))
text**))
(define (deserialize-item item)
"Return the value described by the ITEM parse tree as a Guile object."
;; Strings are printed wrapped in double quotes (see the print_iter
;; procedure in dbus-print-message.c).
(match item
(('item ('type "string") ('value value))
(strip-quotes value))
(('item ('type "boolean") ('value value))
(if (string=? "true" value)
#t
#f))
(('item _ ('value value))
value)))
(define (serialize-boolean bool)
"Return the serialized format expected by dbus-send for BOOL."
(format #f "boolean:~:[false~;true~]" bool))
(define (dict->alist dict-parse-tree)
"Translate a dict parse tree to an alist."
(define (tuples->alist tuples)
(map (lambda (x) (apply cons x)) tuples))
(match dict-parse-tree
('dict
'())
(('dict ('dict-entry keys values) ...)
(let ((keys* (map deserialize-item keys))
(values* (map deserialize-item values)))
(tuples->alist (zip keys* values*))))))
(define (array->list array-parse-tree)
"Translate an array parse tree to a list."
(match array-parse-tree
('array
'())
(('array items ...)
(map deserialize-item items))))
;;;
;;; Low-level, D-Bus-related procedures.
;;;
;;; The following parameters are used in the jami-service-type service
;;; definition to conveniently customize the behavior of the send-dbus helper,
;;; even when called indirectly.
(define %send-dbus-binary (make-parameter "dbus-send"))
(define %send-dbus-bus (make-parameter #f))
(define %send-dbus-user (make-parameter #f))
(define %send-dbus-group (make-parameter #f))
(define %send-dbus-debug (make-parameter #f))
(define* (send-dbus #:key service path interface method
bus
dbus-send
user group
timeout
arguments)
"Return the response of DBUS-SEND, else raise an error. Unless explicitly
provided, DBUS-SEND takes the value of the %SEND-DBUS-BINARY parameter. BUS
can be used to specify the bus address, such as 'unix:path=/var/run/jami/bus'.
Alternatively, the %SEND-DBUS-BUS parameter can be used. ARGUMENTS can be
used to pass input values to a D-Bus method call. TIMEOUT is the amount of
time to wait for a reply in milliseconds before giving up with an error. USER
and GROUP allow choosing under which user/group the DBUS-SEND command is
executed. Alternatively, the %SEND-DBUS-USER and %SEND-DBUS-GROUP parameters
can be used instead."
(let* ((command `(,(if dbus-send
dbus-send
(%send-dbus-binary))
,@(if (or bus (%send-dbus-bus))
(list (string-append "--bus="
(or bus (%send-dbus-bus))))
'())
"--print-reply"
,@(if timeout
(list (format #f "--reply-timeout=~d" timeout))
'())
,(string-append "--dest=" service) ;e.g., cx.ring.Ring
,path ;e.g., /cx/ring/Ring/ConfigurationManager
,(string-append interface "." method)
,@(or arguments '())))
(temp-port (mkstemp! (string-copy "/tmp/dbus-send-output-XXXXXXX")))
(temp-file (port-filename temp-port)))
(dynamic-wind
(lambda ()
(let* ((uid (or (and=> (or user (%send-dbus-user))
(compose passwd:uid getpwnam)) -1))
(gid (or (and=> (or group (%send-dbus-group))
(compose group:gid getgrnam)) -1)))
(chown temp-port uid gid)))
(lambda ()
(let ((pid (fork+exec-command command
#:user (or user (%send-dbus-user))
#:group (or group (%send-dbus-group))
#:log-file temp-file)))
(match (waitpid pid)
((_ . status)
(let ((exit-status (status:exit-val status))
(output (call-with-port temp-port get-string-all)))
(if (= 0 exit-status)
output
(error "the send-dbus command exited with: "
command exit-status output)))))))
(lambda ()
(false-if-exception (delete-file temp-file))))))
(define (parse-account-ids reply)
"Return the Jami account IDs from REPLY, which is assumed to be the output
of the Jami D-Bus `getAccountList' method."
(array->list (parse-dbus-reply reply)))
(define (parse-account-details reply)
"Parse REPLY, which is assumed to be the output of the Jami D-Bus
`getAccountDetails' method, and return its content as an alist."
(dict->alist (parse-dbus-reply reply)))
(define (parse-contacts reply)
"Parse REPLY, which is assumed to be the output of the Jamid D-Bus
`getContacts' method, and return its content as an alist."
(match (parse-dbus-reply reply)
('array
'())
(('array dicts ...)
(map dict->alist dicts))))
;;;
;;; Higher-level, D-Bus-related procedures.
;;;
(define (validate-fingerprint fingerprint)
"Validate that fingerprint is 40 characters long."
(unless (account-fingerprint? fingerprint)
(error "Account fingerprint is not valid:" fingerprint)))
(define (dbus-available-services)
"Return the list of available (acquired) D-Bus services."
(let ((reply (parse-dbus-reply
(send-dbus #:service "org.freedesktop.DBus"
#:path "/org/freedesktop/DBus"
#:interface "org.freedesktop.DBus"
#:method "ListNames"))))
;; Remove entries such as ":1.7".
(remove (cut string-prefix? ":" <>)
(array->list reply))))
(define (dbus-service-available? service)
"Predicate to check for the D-Bus SERVICE availability."
(member service (dbus-available-services)))
(define* (send-dbus/configuration-manager #:key method arguments timeout)
"Query the Jami D-Bus ConfigurationManager service."
(send-dbus #:service "cx.ring.Ring"
#:path "/cx/ring/Ring/ConfigurationManager"
#:interface "cx.ring.Ring.ConfigurationManager"
#:method method
#:arguments arguments
#:timeout timeout))
;;; The following methods are for internal use; they make use of the account
;;; ID, an implementation detail of Jami the user should not need to be
;;; concerned with.
(define (get-account-ids)
"Return the available Jami account identifiers (IDs). Account IDs are an
implementation detail used to identify the accounts in Jami."
(parse-account-ids
(send-dbus/configuration-manager #:method "getAccountList")))
(define (id->account-details id)
"Retrieve the account data associated with the given account ID."
(parse-account-details
(send-dbus/configuration-manager
#:method "getAccountDetails"
#:arguments (list (string-append "string:" id)))))
(define (id->volatile-account-details id)
"Retrieve the account data associated with the given account ID."
(parse-account-details
(send-dbus/configuration-manager
#:method "getVolatileAccountDetails"
#:arguments (list (string-append "string:" id)))))
(define (id->account id)
"Retrieve the complete account data associated with the given account ID."
(append (id->volatile-account-details id)
(id->account-details id)))
(define %username-to-id-cache #f)
(define (invalidate-username-to-id-cache!)
(set! %username-to-id-cache #f))
(define (username->id username)
"Return the first account ID corresponding to USERNAME."
(unless (assoc-ref %username-to-id-cache username)
(set! %username-to-id-cache
(append-map
(lambda (id)
(let* ((account (id->account id))
(username (assoc-ref account "Account.username"))
(registered-name (assoc-ref account
"Account.registeredName")))
`(,@(if username
(list (cons username id))
'())
,@(if registered-name
(list (cons registered-name id))
'()))))
(get-account-ids))))
(or (assoc-ref %username-to-id-cache username)
(let ((message (format #f "Could not retrieve a local account ID\
for ~:[username~;fingerprint~]" (account-fingerprint? username))))
(error message username))))
(define (account->username account)
"Return USERNAME, the registered username associated with ACCOUNT, else its
public key fingerprint."
(or (assoc-ref account "Account.registeredName")
(assoc-ref account "Account.username")))
(define (id->username id)
"Return USERNAME, the registered username associated with ID, else its
public key fingerprint, else #f."
(account->username (id->account id)))
(define (get-accounts)
"Return the list of all accounts, as a list of alists."
(map id->account (get-account-ids)))
(define (get-usernames)
"Return the list of the usernames associated with the present accounts."
(map account->username (get-accounts)))
(define (username->account username)
"Return the first account associated with USERNAME, else #f.
USERNAME can be either the account 40 characters public key fingerprint or a
registered username."
(find (lambda (account)
(member username
(list (assoc-ref account "Account.username")
(assoc-ref account "Account.registeredName"))))
(get-accounts)))
(define (add-account archive)
"Import the Jami account ARCHIVE and return its account ID. The archive
should *not* be encrypted with a password. Return the username associated
with the account."
(invalidate-username-to-id-cache!)
(let ((reply (send-dbus/configuration-manager
#:method "addAccount"
#:arguments (list (string-append
"dict:string:string:Account.archivePath,"
archive
",Account.type,RING")))))
;; The account information takes some time to be populated.
(let ((id (deserialize-item (parse-dbus-reply reply))))
(with-retries 20 1
(let ((username (id->username id)))
(if (string-null? username)
#f
username))))))
(define (remove-account username)
"Delete the Jami account associated with USERNAME, the account 40 characters
fingerprint or a registered username."
(let ((id (username->id username)))
(send-dbus/configuration-manager
#:method "removeAccount"
#:arguments (list (string-append "string:" id))))
(invalidate-username-to-id-cache!))
(define* (username->contacts username)
"Return the contacts associated with the account of USERNAME as two values;
the first one being the regular contacts and the second one the banned
contacts. USERNAME can be either the account 40 characters public key
fingerprint or a registered username. The contacts returned are represented
using their 40 characters fingerprint."
(let* ((id (username->id username))
(reply (send-dbus/configuration-manager
#:method "getContacts"
#:arguments (list (string-append "string:" id))))
(all-contacts (parse-contacts reply))
(banned? (lambda (contact)
(and=> (assoc-ref contact "banned")
(cut string=? "true" <>))))
(banned (filter banned? all-contacts))
(not-banned (filter (negate banned?) all-contacts))
(fingerprint (cut assoc-ref <> "id")))
(values (map fingerprint not-banned)
(map fingerprint banned))))
(define* (remove-contact contact username #:key ban?)
"Remove CONTACT, the 40 characters public key fingerprint of a contact, from
the account associated with USERNAME (either a fingerprint or a registered
username). When BAN? is true, also mark the contact as banned."
(validate-fingerprint contact)
(let ((id (username->id username)))
(send-dbus/configuration-manager
#:method "removeContact"
#:arguments (list (string-append "string:" id)
(string-append "string:" contact)
(serialize-boolean ban?)))))
(define (add-contact contact username)
"Add CONTACT, the 40 characters public key fingerprint of a contact, to the
account of USERNAME (either a fingerprint or a registered username)."
(validate-fingerprint contact)
(let ((id (username->id username)))
(send-dbus/configuration-manager
#:method "addContact"
#:arguments (list (string-append "string:" id)
(string-append "string:" contact)))))
(define* (set-account-details details username #:key timeout)
"Set DETAILS, an alist containing the key value pairs to set for the account
of USERNAME, a registered username or account fingerprint. The value of the
parameters not provided are unchanged. TIMEOUT is a value in milliseconds to
pass to the `send-dbus/configuration-manager' procedure."
(let* ((id (username->id username))
(current-details (id->account-details id))
(updated-details (map (match-lambda
((key . value)
(or (and=> (assoc-ref details key)
(cut cons key <>))
(cons key value))))
current-details))
;; dbus-send does not permit sending null strings (it throws a
;; "malformed dictionary" error). Luckily they seem to have the
;; semantic of "default account value" in Jami; so simply drop them.
(updated-details* (remove (match-lambda
((_ . value)
(string-null? value)))
updated-details)))
(send-dbus/configuration-manager
#:timeout timeout
#:method "setAccountDetails"
#:arguments
(list (string-append "string:" id)
(string-append "dict:string:string:"
(string-join (alist->list updated-details*)
","))))))
(define (set-all-moderators enabled? username)
"Set the 'AllModerators' property to enabled? for the account of USERNAME, a
registered username or account fingerprint."
(let ((id (username->id username)))
(send-dbus/configuration-manager
#:method "setAllModerators"
#:arguments
(list (string-append "string:" id)
(serialize-boolean enabled?)))))
(define (username->all-moderators? username)
"Return the 'AllModerators' property for the account of USERNAME, a
registered username or account fingerprint."
(let* ((id (username->id username))
(reply (send-dbus/configuration-manager
#:method "isAllModerators"
#:arguments
(list (string-append "string:" id)))))
(deserialize-item (parse-dbus-reply reply))))
(define (username->moderators username)
"Return the moderators for the account of USERNAME, a registered username or
account fingerprint."
(let* ((id (username->id username))
(reply (send-dbus/configuration-manager
#:method "getDefaultModerators"
#:arguments
(list (string-append "string:" id)))))
(array->list (parse-dbus-reply reply))))
(define (set-moderator contact enabled? username)
"Set the moderator flag to ENABLED? for CONTACT, the 40 characters public
key fingerprint of a contact for the account of USERNAME, a registered
username or account fingerprint."
(validate-fingerprint contact)
(let* ((id (username->id username)))
(send-dbus/configuration-manager #:method "setDefaultModerator"
#:arguments
(list (string-append "string:" id)
(string-append "string:" contact)
(serialize-boolean enabled?)))))
(define (disable-account username)
"Disable the account known by USERNAME, a registered username or account
fingerprint."
(set-account-details '(("Account.enable" . "false")) username
;; Waiting for the reply on this command takes a very
;; long time that trips the default D-Bus timeout value
;; (25 s), for some reason.
#:timeout 60000))
(define (enable-account username)
"Enable the account known by USERNAME, a registered username or account
fingerprint."
(set-account-details '(("Account.enable" . "true")) username))
;;;
;;; Presentation procedures.
;;;
(define (.->_ text)
"Map each period character to underscore characters."
(string-map (match-lambda
(#\. #\_)
(c c))
text))
(define (account-details->recutil account-details)
"Serialize the account-details alist into a recutil string. Period
characters in the keys are normalized to underscore to meet Recutils' format
requirements."
(define (pair->recutil-property pair)
(match pair
((key . value)
(string-append (.->_ key) ": " value))))
(define sorted-account-details
;; Have the account username, display name and alias appear first, for
;; convenience.
(let ((first-items '("Account.username"
"Account.displayName"
"Account.alias")))
(append (map (cut assoc <> account-details) first-items)
(fold alist-delete account-details first-items))))
(string-join (map pair->recutil-property sorted-account-details) "\n"))
;; Local Variables:
;; eval: (put 'with-retries 'scheme-indent-function 2)
;; End:

113
gnu/build/linux-boot.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017, 2019–2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;;
@ -25,6 +25,7 @@
#:autoload (system repl repl) (start-repl)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
@ -44,7 +45,6 @@
make-static-device-nodes
configure-qemu-networking
device-number
boot-system))
;;; Commentary:
@ -134,14 +134,9 @@ succeeds. Return nothing otherwise. The kernel logs any details to dmesg."
;; is found on the command line; our canonicalize-device-spec gives
;; up after 20 seconds. We could emulate the former by looping…
(device (canonicalize-device-spec spec))
(rdev (stat:rdev (stat device)))
;; For backwards compatibility, device numbering is a baroque affair.
;; This is the full 64-bit scheme used by glibc's <sys/sysmacros.h>.
(major (logior (ash (logand #x00000000000fff00 rdev) -8)
(ash (logand #xfffff00000000000 rdev) -32)))
(minor (logior (logand #x00000000000000ff rdev)
(ash (logand #x00000ffffff00000 rdev) -12))))
(format #f "~a:~a" major minor)))
(rdev (stat:rdev (stat device))))
(let-values (((major minor) (device-number->major+minor rdev)))
(format #f "~a:~a" major minor))))
;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device
;; numbers if possible. The kernel will immediately try to resume from it.
@ -390,17 +385,8 @@ networking values.) Return #t if INTERFACE is up, #f otherwise."
(set-network-interface-address sock interface address)
(set-network-interface-flags sock interface (logior flags IFF_UP))
;; Hello! We used to create /etc/resolv.conf here, with "nameserver
;; 10.0.2.3\n". However, with Linux-libre 3.16, we're getting ENOSPC.
;; And since it's actually unnecessary, it's gone.
(logand (network-interface-flags sock interface) IFF_UP)))
(define (device-number major minor)
"Return the device number for the device with MAJOR and MINOR, for use as
the last argument of `mknod'."
(+ (* major 256) minor))
(define (pidof program)
"Return the PID of the first presumed instance of PROGRAM."
(let ((program (basename program)))
@ -411,11 +397,18 @@ the last argument of `mknod'."
(filter-map string->number (scandir "/proc")))))
(define* (mount-root-file-system root type
#:key volatile-root? (flags 0) options)
#:key volatile-root? (flags 0) options
check? skip-check-if-clean? repair)
"Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is
true, mount ROOT read-only and make it an overlay with a writable tmpfs using
the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use
to mount ROOT, and behave the same as for the `mount' procedure."
to mount ROOT, and behave the same as for the `mount' procedure.
If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively.
If SKIP-CHECK-IF-CLEAN? is true, ask fsck to return immediately if ROOT is
marked as clean. If REPAIR is true, fsck may write to ROOT to perform repairs.
If REPAIR is also 'PREEN, ask fsck to perform only those repairs that it
considers safe."
(if volatile-root?
(begin
@ -436,7 +429,8 @@ to mount ROOT, and behave the same as for the `mount' procedure."
(mount "none" "/root" "overlay" 0
"lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
(begin
(check-file-system root type)
(when check?
(check-file-system root type (not skip-check-if-clean?) repair))
(mount root "/root" type flags options)))
;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
@ -537,21 +531,36 @@ upon error."
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(to-load (find-long-option "--load" args))
(root-fs (find root-mount-point? mounts))
(root-fs-type (or (and=> root-fs file-system-type)
"ext4"))
(root-fs-device (and=> root-fs file-system-device))
(root-fs-flags (mount-flags->bit-mask
(or (and=> root-fs file-system-flags)
'())))
(root-options (if root-fs
(file-system-options root-fs)
#f))
;; --root takes precedence over the 'device' field of the root
;; <file-system> record.
(root-device (or (and=> (find-long-option "--root" args)
device-string->file-system-device)
root-fs-device)))
;; If present, ‘--root’ on the kernel command line takes precedence
;; over the ‘device’ field of the root <file-system> record.
(root-device (and=> (find-long-option "--root" args)
device-string->file-system-device))
(root-fs (or (find root-mount-point? mounts)
;; Fall back to fictitious defaults.
(file-system (device (or root-device "/dev/root"))
(mount-point "/")
(type "ext4"))))
(fsck.mode (find-long-option "fsck.mode" args)))
(define (check? fs)
(match fsck.mode
("skip" #f)
("force" #t)
(_ (file-system-check? fs)))) ; assume "auto"
(define (skip-check-if-clean? fs)
(match fsck.mode
("force" #f)
(_ (file-system-skip-check-if-clean? fs))))
(define (repair fs)
(let ((arg (find-long-option "fsck.repair" args)))
(if arg
(match arg
("no" #f)
("yes" #t)
(_ 'preen))
(file-system-repair fs))))
(when (member "--repl" args)
(start-repl))
@ -582,6 +591,16 @@ upon error."
(unless (configure-qemu-networking)
(display "network interface is DOWN\n")))
;; A big ugly hammer, to be used only for debugging and in desperate
;; situations where no proper device synchonisation is possible.
(let ((root-delay (and=> (find-long-option "rootdelay" args)
string->number)))
(when root-delay
(format #t
"Pausing for rootdelay=~a seconds before mounting the root file system...\n"
root-delay)
(sleep root-delay)))
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
(mkdir "/root"))
@ -597,14 +616,24 @@ upon error."
(if root-device
(mount-root-file-system (canonicalize-device-spec root-device)
root-fs-type
(file-system-type root-fs)
#:volatile-root? volatile-root?
#:flags root-fs-flags
#:options root-options)
#:flags (mount-flags->bit-mask
(file-system-flags root-fs))
#:options (file-system-options root-fs)
#:check? (check? root-fs)
#:skip-check-if-clean?
(skip-check-if-clean? root-fs)
#:repair (repair root-fs))
(mount "none" "/root" "tmpfs"))
;; Mount the specified file systems.
(for-each mount-file-system
;; Mount the specified non-root file systems.
(for-each (lambda (fs)
(mount-file-system fs
#:check? (check? fs)
#:skip-check-if-clean?
(skip-check-if-clean? fs)
#:repair (repair fs)))
(remove root-mount-point? mounts))
(setenv "EXT2FS_NO_MTAB_OK" #f)

14
gnu/build/shepherd.scm
View File

@ -24,6 +24,12 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
#:autoload (shepherd service) (fork+exec-command
read-pid-file
exec-command
%precious-signals)
#:autoload (shepherd system) (unblock-signals)
#:export (make-forkexec-constructor/container
fork+exec-command/container))
@ -92,14 +98,6 @@
(file-exists? (file-system-mapping-source mapping)))
mappings)))))
;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
(module-autoload! (current-module)
'(shepherd service)
'(fork+exec-command read-pid-file exec-command
%precious-signals))
(module-autoload! (current-module)
'(shepherd system) '(unblock-signals))
(define* (read-pid-file/container pid pid-file #:key (max-delay 5))
"Read PID-FILE in the container namespaces of PID, which exists in a
separate mount and PID name space. Return the \"outer\" PID. "

2
gnu/build/vm.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>

103
gnu/ci.scm
View File

@ -66,9 +66,15 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (%core-packages
#:export (derivation->job
image->job
%bootstrap-packages
%core-packages
%cross-targets
channel-source->package
arguments->systems
cuirass-jobs))
;;; Commentary:
@ -143,6 +149,14 @@ SYSTEM."
%guile-bootstrap-tarball
%bootstrap-tarballs))
(define %bootstrap-packages
;; Return the list of bootstrap packages from the commencement module.
(filter package?
(module-map
(lambda (sym var)
(variable-ref var))
(resolve-module '(gnu packages commencement)))))
(define (packages-to-cross-build target)
"Return the list of packages to cross-build for TARGET."
;; Don't cross-build the bootstrap tarballs for MinGW.
@ -235,43 +249,48 @@ SYSTEM."
(define (hours hours)
(* 3600 hours))
(define* (image->job store image
#:key name system)
"Return the job for IMAGE on SYSTEM. If NAME is passed, use it as job name,
otherwise use the IMAGE name."
(let* ((image-name (or name
(symbol->string (image-name image))))
(name (string-append image-name "." system))
(drv (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(lower-object (system-image image))))))
(parameterize ((%graft? #f))
(derivation->job name drv))))
(define (image-jobs store system)
"Return a list of jobs that build images for SYSTEM."
(define (->job name drv)
(let ((name (string-append name "." system)))
(parameterize ((%graft? #f))
(derivation->job name drv))))
(define (build-image image)
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(lower-object (system-image image)))))
(define MiB
(expt 2 20))
(if (member system %guix-system-supported-systems)
`(,(->job "usb-image"
(build-image
(image
(inherit efi-disk-image)
(operating-system installation-os))))
,(->job "iso9660-image"
(build-image
(image
(inherit (image-with-label
iso9660-image
(string-append "GUIX_" system "_"
(if (> (string-length %guix-version) 7)
(substring %guix-version 0 7)
%guix-version))))
(operating-system installation-os))))
`(,(image->job store
(image
(inherit efi-disk-image)
(operating-system installation-os))
#:name "usb-image"
#:system system)
,(image->job
store
(image
(inherit (image-with-label
iso9660-image
(string-append "GUIX_" system "_"
(if (> (string-length %guix-version) 7)
(substring %guix-version 0 7)
%guix-version))))
(operating-system installation-os))
#:name "iso9660-image"
#:system system)
;; Only cross-compile Guix System images from x86_64-linux for now.
,@(if (string=? system "x86_64-linux")
(map (lambda (image)
(->job (symbol->string (image-name image))
(build-image image)))
(map (cut image->job store <>
#:system system)
%guix-system-images)
'()))
'()))
@ -357,6 +376,7 @@ SYSTEM."
(>>= (profile-derivation (packages->manifest (list guix)))
(lambda (profile)
(self-contained-tarball "guix-binary" profile
#:profile-name "current-guix"
#:localstatedir? #t
#:compressor
(lookup-compressor "xz")))))
@ -437,6 +457,13 @@ valid."
load-manifest)
manifests))))
(define (arguments->systems arguments)
"Return the systems list from ARGUMENTS."
(match (assoc-ref arguments 'systems)
(#f %cuirass-supported-systems)
((lst ...) lst)
((? string? str) (call-with-input-string str read))))
;;;
;;; Cuirass entry point.
@ -448,10 +475,7 @@ valid."
(assoc-ref arguments 'subset))
(define systems
(match (assoc-ref arguments 'systems)
(#f %cuirass-supported-systems)
((lst ...) lst)
((? string? str) (call-with-input-string str read))))
(arguments->systems arguments))
(define channels
(let ((channels (assq-ref arguments 'channels)))
@ -493,7 +517,7 @@ valid."
(map (lambda (package)
(package-job store (job-name package)
package system))
%core-packages)
(append %bootstrap-packages %core-packages))
(cross-jobs store system)))
('guix
;; Build Guix modules only.
@ -516,6 +540,15 @@ valid."
('tarball
;; Build Guix tarball only.
(tarball-jobs store system))
(('custom . modules)
;; Build custom modules jobs only.
(append-map
(lambda (module)
(let ((proc (module-ref
(resolve-interface module)
'cuirass-jobs)))
(proc store arguments)))
modules))
(('channels . channels)
;; Build only the packages from CHANNELS.
(let ((all (all-packages)))

524
gnu/home-services.scm 100644
View File

@ -0,0 +1,524 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services)
#:use-module (gnu services)
#:use-module (guix channels)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix profiles)
#:use-module (guix sets)
#:use-module (guix ui)
#:use-module (guix discovery)
#:use-module (guix diagnostics)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (home-service-type
home-profile-service-type
home-environment-variables-service-type
home-files-service-type
home-run-on-first-login-service-type
home-activation-service-type
home-run-on-change-service-type
home-provenance-service-type
fold-home-service-types)
#:re-export (service
service-type
service-extension))
;;; Comment:
;;;
;;; This module is similar to (gnu system services) module, but
;;; provides Home Services, which are supposed to be used for building
;;; home-environment.
;;;
;;; Home Services use the same extension as System Services. Consult
;;; (gnu system services) module or manual for more information.
;;;
;;; home-service-type is a root of home services DAG.
;;;
;;; home-profile-service-type is almost the same as profile-service-type, at least
;;; for now.
;;;
;;; home-environment-variables-service-type generates a @file{setup-environment}
;;; shell script, which is expected to be sourced by login shell or other program,
;;; which starts early and spawns all other processes. Home services for shells
;;; automatically add code for sourcing this file, if person do not use those home
;;; services they have to source this script manually in their's shell *profile
;;; file (details described in the manual).
;;;
;;; home-files-service-type is similar to etc-service-type, but doesn't extend
;;; home-activation, because deploy mechanism for config files is pluggable and
;;; can be different for different home environments: The default one is called
;;; symlink-manager (will be introudced in a separate patch series), which creates
;;; links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is
;;; possible to implement alternative approaches like read-only home from Julien's
;;; guix-home-manager.
;;;
;;; home-run-on-first-login-service-type provides an @file{on-first-login} guile
;;; script, which runs provided gexps once, when user makes first login. It can
;;; be used to start user's Shepherd and maybe some other process. It relies on
;;; assumption that /run/user/$UID will be created on login by some login
;;; manager (elogind for example).
;;;
;;; home-activation-service-type provides an @file{activate} guile script, which
;;; do three main things:
;;;
;;; - Sets environment variables to the values declared in
;;; @file{setup-environment} shell script. It's necessary, because user can set
;;; for example XDG_CONFIG_HOME and it should be respected by activation gexp of
;;; symlink-manager.
;;;
;;; - Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store.
;;; Later those variables can be used by activation gexps, for example by
;;; symlink-manager or run-on-change services.
;;;
;;; - Run all activation gexps provided by other home services.
;;;
;;; home-run-on-change-service-type allows to trigger actions during
;;; activation if file or directory specified by pattern is changed.
;;;
;;; Code:
(define (home-derivation entries mextensions)
"Return as a monadic value the derivation of the 'home'
directory containing the given entries."
(mlet %store-monad ((extensions (mapm/accumulate-builds identity
mextensions)))
(lower-object
(file-union "home" (append entries (concatenate extensions))))))
(define home-service-type
;; This is the ultimate service type, the root of the home service
;; DAG. The service of this type is extended by monadic name/item
;; pairs. These items end up in the "home-environment directory" as
;; returned by 'home-environment-derivation'.
(service-type (name 'home)
(extensions '())
(compose identity)
(extend home-derivation)
(default-value '())
(description
"Build the home environment top-level directory,
which in turn refers to everything the home environment needs: its
packages, configuration files, activation script, and so on.")))
(define (packages->profile-entry packages)
"Return a system entry for the profile containing PACKAGES."
;; XXX: 'mlet' is needed here for one reason: to get the proper
;; '%current-target' and '%current-target-system' bindings when
;; 'packages->manifest' is called, and thus when the 'package-inputs'
;; etc. procedures are called on PACKAGES. That way, conditionals in those
;; inputs see the "correct" value of these two parameters. See
;; <https://issues.guix.gnu.org/44952>.
(mlet %store-monad ((_ (current-target-system)))
(return `(("profile" ,(profile
(content (packages->manifest
(map identity
;;(options->transformation transformations)
(delete-duplicates packages eq?))))))))))
;; MAYBE: Add a list of transformations for packages. It's better to
;; place it in home-profile-service-type to affect all profile
;; packages and prevent conflicts, when other packages relies on
;; non-transformed version of package.
(define home-profile-service-type
(service-type (name 'home-profile)
(extensions
(list (service-extension home-service-type
packages->profile-entry)))
(compose concatenate)
(extend append)
(description
"This is the @dfn{home profile} and can be found in
@file{~/.guix-home/profile}. It contains packages and
configuration files that the user has declared in their
@code{home-environment} record.")))
(define (environment-variables->setup-environment-script vars)
"Return a file that can be sourced by a POSIX compliant shell which
initializes the environment. The file will source the home
environment profile, set some default environment variables, and set
environment variables provided in @code{vars}. @code{vars} is a list
of pairs (@code{(key . value)}), @code{key} is a string and
@code{value} is a string or gexp.
If value is @code{#f} variable will be omitted.
If value is @code{#t} variable will be just exported.
For any other, value variable will be set to the @code{value} and
exported."
(define (warn-about-duplicate-defenitions)
(fold
(lambda (x acc)
(when (equal? (car x) (car acc))
(warning
(G_ "duplicate definition for `~a' environment variable ~%") (car x)))
x)
(cons "" "")
(sort vars (lambda (a b)
(string<? (car a) (car b))))))
(warn-about-duplicate-defenitions)
(with-monad
%store-monad
(return
`(("setup-environment"
;; TODO: It's necessary to source ~/.guix-profile too
;; on foreign distros
,(apply mixed-text-file "setup-environment"
"\
HOME_ENVIRONMENT=$HOME/.guix-home
GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
[ -f $PROFILE_FILE ] && . $PROFILE_FILE
case $XDG_DATA_DIRS in
*$HOME_ENVIRONMENT/profile/share*) ;;
*) export XDG_DATA_DIRS=$HOME_ENVIRONMENT/profile/share:$XDG_DATA_DIRS ;;
esac
case $MANPATH in
*$HOME_ENVIRONMENT/profile/share/man*) ;;
*) export MANPATH=$HOME_ENVIRONMENT/profile/share/man:$MANPATH
esac
case $INFOPATH in
*$HOME_ENVIRONMENT/profile/share/info*) ;;
*) export INFOPATH=$HOME_ENVIRONMENT/profile/share/info:$INFOPATH ;;
esac
case $XDG_CONFIG_DIRS in
*$HOME_ENVIRONMENT/profile/etc/xdg*) ;;
*) export XDG_CONFIG_DIRS=$HOME_ENVIRONMENT/profile/etc/xdg:$XDG_CONFIG_DIRS ;;
esac
case $XCURSOR_PATH in
*$HOME_ENVIRONMENT/profile/share/icons*) ;;
*) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;;
esac
"
(append-map
(match-lambda
((key . #f)
'())
((key . #t)
(list "export " key "\n"))
((key . value)
(list "export " key "=" value "\n")))
vars)))))))
(define home-environment-variables-service-type
(service-type (name 'home-environment-variables)
(extensions
(list (service-extension
home-service-type
environment-variables->setup-environment-script)))
(compose concatenate)
(extend append)
(default-value '())
(description "Set the environment variables.")))
(define (files->files-directory files)
"Return a @code{files} directory that contains FILES."
(define (assert-no-duplicates files)
(let loop ((files files)
(seen (set)))
(match files
(() #t)
(((file _) rest ...)
(when (set-contains? seen file)
(raise (formatted-message (G_ "duplicate '~a' entry for files/")
file)))
(loop rest (set-insert file seen))))))
;; Detect duplicates early instead of letting them through, eventually
;; leading to a build failure of "files.drv".
(assert-no-duplicates files)
(file-union "files" files))
(define (files-entry files)
"Return an entry for the @file{~/.guix-home/files}
directory containing FILES."
(with-monad %store-monad
(return `(("files" ,(files->files-directory files))))))
(define home-files-service-type
(service-type (name 'home-files)
(extensions
(list (service-extension home-service-type
files-entry)))
(compose concatenate)
(extend append)
(default-value '())
(description "Configuration files for programs that
will be put in @file{~/.guix-home/files}.")))
(define (compute-on-first-login-script _ gexps)
(gexp->script
"on-first-login"
#~(let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR")
(format #f "/run/user/~a" (getuid))))
(flag-file-path (string-append
xdg-runtime-dir "/on-first-login-executed"))
(touch (lambda (file-name)
(call-with-output-file file-name (const #t)))))
;; XDG_RUNTIME_DIR dissapears on logout, that means such trick
;; allows to launch on-first-login script on first login only
;; after complete logout/reboot.
(when (not (file-exists? flag-file-path))
(begin #$@gexps (touch flag-file-path))))))
(define (on-first-login-script-entry m-on-first-login)
"Return, as a monadic value, an entry for the on-first-login script
in the home environment directory."
(mlet %store-monad ((on-first-login m-on-first-login))
(return `(("on-first-login" ,on-first-login)))))
(define home-run-on-first-login-service-type
(service-type (name 'home-run-on-first-login)
(extensions
(list (service-extension
home-service-type
on-first-login-script-entry)))
(compose identity)
(extend compute-on-first-login-script)
(default-value #f)
(description "Run gexps on first user login. Can be
extended with one gexp.")))
(define (compute-activation-script init-gexp gexps)
(gexp->script
"activate"
#~(let* ((he-init-file (lambda (he) (string-append he "/setup-environment")))
(he-path (string-append (getenv "HOME") "/.guix-home"))
(new-home-env (getenv "GUIX_NEW_HOME"))
(new-home (or new-home-env
;; Path of the activation file if called interactively
(dirname (car (command-line)))))
(old-home-env (getenv "GUIX_OLD_HOME"))
(old-home (or old-home-env
(if (file-exists? (he-init-file he-path))
(readlink he-path)
#f))))
(if (file-exists? (he-init-file new-home))
(let* ((port ((@ (ice-9 popen) open-input-pipe)
(format #f "source ~a && env -0"
(he-init-file new-home))))
(result ((@ (ice-9 rdelim) read-delimited) "" port))
(vars (map (lambda (x)
(let ((si (string-index x #\=)))
(cons (string-take x si)
(string-drop x (1+ si)))))
((@ (srfi srfi-1) remove)
string-null?
(string-split result #\nul)))))
(close-port port)
(map (lambda (x) (setenv (car x) (cdr x))) vars)
(setenv "GUIX_NEW_HOME" new-home)
(setenv "GUIX_OLD_HOME" old-home)
#$@gexps
;; Do not unset env variable if it was set outside.
(unless new-home-env (setenv "GUIX_NEW_HOME" #f))
(unless old-home-env (setenv "GUIX_OLD_HOME" #f)))
(format #t "\
Activation script was either called or loaded by file from this direcotry:
~a
It doesn't seem that home environment is somewhere around.
Make sure that you call ./activate by symlink from -home store item.\n"
new-home)))))
(define (activation-script-entry m-activation)
"Return, as a monadic value, an entry for the activation script
in the home environment directory."
(mlet %store-monad ((activation m-activation))
(return `(("activate" ,activation)))))
(define home-activation-service-type
(service-type (name 'home-activation)
(extensions
(list (service-extension
home-service-type
activation-script-entry)))
(compose identity)
(extend compute-activation-script)
(default-value #f)
(description "Run gexps to activate the current
generation of home environment and update the state of the home
directory. @command{activate} script automatically called during
reconfiguration or generation switching. This service can be extended
with one gexp, but many times, and all gexps must be idempotent.")))
;;;
;;; On-change.
;;;
(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples)
#~(begin
(define (equal-regulars? file1 file2)
"Check if FILE1 and FILE2 are bit for bit identical."
(let* ((cmp-binary #$(file-append
(@ (gnu packages base) diffutils) "/bin/cmp"))
(stats1 (lstat file1))
(stats2 (lstat file2)))
(cond
((= (stat:ino stats1) (stat:ino stats2)) #t)
((not (= (stat:size stats1) (stat:size stats2))) #f)
(else (= (system* cmp-binary file1 file2) 0)))))
(define (equal-symlinks? symlink1 symlink2)
"Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
(string=? (readlink symlink1) (readlink symlink2)))
(define (equal-directories? dir1 dir2)
"Check if DIR1 and DIR2 have the same content."
(define (ordinary-file file)
(not (or (string=? file ".")
(string=? file ".."))))
(let* ((files1 (scandir dir1 ordinary-file))
(files2 (scandir dir2 ordinary-file)))
(if (equal? files1 files2)
(map (lambda (file)
(equal-files?
(string-append dir1 "/" file)
(string-append dir2 "/" file)))
files1)
#f)))
(define (equal-files? file1 file2)
"Compares files, symlinks or directories of the same type."
(case (file-type file1)
((directory) (equal-directories? file1 file2))
((symlink) (equal-symlinks? file1 file2))
((regular) (equal-regulars? file1 file2))
(else
(display "The file type is unsupported by on-change service.\n")
#f)))
(define (file-type file)
(stat:type (lstat file)))
(define (something-changed? file1 file2)
(cond
((and (not (file-exists? file1))
(not (file-exists? file2))) #f)
((or (not (file-exists? file1))
(not (file-exists? file2))) #t)
((not (eq? (file-type file1) (file-type file2))) #t)
(else
(not (equal-files? file1 file2)))))
(define expressions-to-eval
(map
(lambda (x)
(let* ((file1 (string-append
(or (getenv "GUIX_OLD_HOME")
"/gnu/store/non-existing-generation")
"/" (car x)))
(file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x)))
(_ (format #t "Comparing ~a and\n~10t~a..." file1 file2))
(any-changes? (something-changed? file1 file2))
(_ (format #t " done (~a)\n"
(if any-changes? "changed" "same"))))
(if any-changes? (cadr x) "")))
'#$pattern-gexp-tuples))
(if #$eval-gexps?
(begin
(display "Evaling on-change gexps.\n\n")
(for-each primitive-eval expressions-to-eval)
(display "On-change gexps evaluation finished.\n\n"))
(display "\
On-change gexps won't be evaluated, disabled by service
configuration.\n"))))
(define home-run-on-change-service-type
(service-type (name 'home-run-on-change)
(extensions
(list (service-extension
home-activation-service-type
identity)))
(compose concatenate)
(extend compute-on-change-gexp)
(default-value #t)
(description "\
G-expressions to run if the specified files have changed since the
last generation. The extension should be a list of lists where the
first element is the pattern for file or directory that expected to be
changed, and the second element is the G-expression to be evaluated.")))
;;;
;;; Provenance tracking.
;;;
(define home-provenance-service-type
(service-type
(name 'home-provenance)
(extensions
(list (service-extension
home-service-type
(service-extension-compute
(first (service-type-extensions provenance-service-type))))))
(default-value #f) ;the HE config file
(description "\
Store provenance information about the home environment in the home
environment itself: the channels used when building the home
environment, and its configuration file, when available.")))
(define sexp->home-provenance sexp->system-provenance)
(define home-provenance system-provenance)
;;;
;;; Searching
;;;
(define (parent-directory directory)
"Get the parent directory of DIRECTORY"
(string-join (drop-right (string-split directory #\/) 1) "/"))
(define %guix-home-root-directory
;; Absolute file name of the module hierarchy.
(parent-directory (dirname (search-path %load-path "gnu/home-services.scm"))))
(define %service-type-path
;; Search path for service types.
(make-parameter `((,%guix-home-root-directory . "gnu/home-services"))))
(define (all-home-service-modules)
"Return the default set of home-service modules."
(cons (resolve-interface '(gnu home-services))
(all-modules (%service-type-path)
#:warn warn-about-load-error)))
(define* (fold-home-service-types proc seed)
(fold-service-types proc seed (all-home-service-modules)))

109
gnu/home-services/configuration.scm 100644
View File

@ -0,0 +1,109 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services configuration)
#:use-module (gnu services configuration)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 curried-definitions)
#:use-module (ice-9 match)
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:export (filter-configuration-fields
interpose
list-of
list-of-strings?
alist?
string-or-gexp?
serialize-string-or-gexp
text-config?
serialize-text-config
generic-serialize-alist-entry
generic-serialize-alist))
(define* (filter-configuration-fields configuration-fields fields
#:optional negate?)
"Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS.
If NEGATE? is @code{#t}, retrieve all fields except FIELDS."
(filter (lambda (field)
(let ((member? (member (configuration-field-name field) fields)))
(if (not negate?) member? (not member?))))
configuration-fields))
(define* (interpose ls #:optional (delimiter "\n") (grammar 'infix))
"Same as @code{string-join}, but without join and string, returns an
DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values."
(when (not (member grammar '(infix suffix)))
(raise
(formatted-message
(G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.")
grammar)))
(fold-right (lambda (e acc)
(cons e
(if (and (null? acc) (eq? grammar 'infix))
acc
(cons delimiter acc))))
'() ls))
(define (list-of pred?)
"Return a procedure that takes a list and check if all the elements of
the list result in @code{#t} when applying PRED? on them."
(lambda (x)
(if (list? x)
(every pred? x)
#f)))
(define list-of-strings?
(list-of string?))
(define alist? list?)
(define (string-or-gexp? sg) (or (string? sg) (gexp? sg)))
(define (serialize-string-or-gexp field-name val) "")
(define (text-config? config)
(and (list? config) (every string-or-gexp? config)))
(define (serialize-text-config field-name val)
#~(string-append #$@(interpose val "\n" 'suffix)))
(define ((generic-serialize-alist-entry serialize-field) entry)
"Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY."
(match entry
((field . val) (serialize-field field val))))
(define (generic-serialize-alist combine serialize-field fields)
"Generate a configuration from an association list FIELDS.
SERIALIZE-FIELD is a procedure that takes two arguments, it will be
applied on the fields and values of FIELDS using the
@code{generic-serialize-alist-entry} procedure.
COMBINE is a procedure that takes one or more arguments and combines
all the alist entries into one value, @code{string-append} or
@code{append} are usually good candidates for this.
See the @code{serialize-alist} procedure in `@code{(gnu home-services
version-control}' for an example usage.)}"
(apply combine
(map (generic-serialize-alist-entry serialize-field) fields)))

65
gnu/home-services/fontutils.scm 100644
View File

@ -0,0 +1,65 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services fontutils)
#:use-module (gnu home-services)
#:use-module (gnu packages fontutils)
#:use-module (guix gexp)
#:export (home-fontconfig-service-type))
;;; Commentary:
;;;
;;; Services related to fonts. home-fontconfig service provides
;;; fontconfig configuration, which allows fc-* utilities to find
;;; fonts in Guix Home's profile and regenerates font cache on
;;; activation.
;;;
;;; Code:
(define (add-fontconfig-config-file he-symlink-path)
`(("config/fontconfig/fonts.conf"
,(mixed-text-file
"fonts.conf"
"<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig>
<dir>~/.guix-home/profile/share/fonts</dir>
</fontconfig>"))))
(define (regenerate-font-cache-gexp _)
`(("profile/share/fonts"
,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv"))))
(define home-fontconfig-service-type
(service-type (name 'home-fontconfig)
(extensions
(list (service-extension
home-files-service-type
add-fontconfig-config-file)
(service-extension
home-run-on-change-service-type
regenerate-font-cache-gexp)
(service-extension
home-profile-service-type
(const (list fontconfig)))))
(default-value #f)
(description
"Provides configuration file for fontconfig and make
fc-* utilities aware of font packages installed in Guix Home's profile.")))

115
gnu/home-services/mcron.scm 100644
View File

@ -0,0 +1,115 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services mcron)
#:use-module (gnu packages guile-xyz)
#:use-module (gnu home-services)
#:use-module (gnu home-services shepherd)
#:use-module (gnu services shepherd)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (home-mcron-configuration
home-mcron-service-type))
;;; Commentary:
;;
;; Service for the GNU mcron cron job manager.
;;
;; Example configuration, the first job runs mbsync once every ten
;; minutes, the second one writes "Mcron service" to ~/mcron-file once
;; every minute.
;;
;; (service home-mcron-service-type
;; (home-mcron-configuration
;; (jobs (list #~(job '(next-minute
;; (range 0 60 10))
;; (lambda ()
;; (system* "mbsync" "--all")))
;; #~(job next-minute-from
;; (lambda ()
;; (call-with-output-file (string-append (getenv "HOME")
;; "/mcron-file")
;; (lambda (port)
;; (display "Mcron service" port)))))))))
;;
;;; Code:
(define-record-type* <home-mcron-configuration> home-mcron-configuration
make-home-mcron-configuration
home-mcron-configuration?
(package home-mcron-configuration-package ; package
(default mcron))
(jobs home-mcron-configuration-jobs ; list of jobs
(default '())))
(define job-files (@@ (gnu services mcron) job-files))
(define shepherd-schedule-action
(@@ (gnu services mcron) shepherd-schedule-action))
(define home-mcron-shepherd-services
(match-lambda
(($ <home-mcron-configuration> mcron '()) ; no jobs to run
'())
(($ <home-mcron-configuration> mcron jobs)
(let ((files (job-files mcron jobs)))
(list (shepherd-service
(documentation "User cron jobs.")
(provision '(mcron))
(modules `((srfi srfi-1)
(srfi srfi-26)
(ice-9 popen) ; for the 'schedule' action
(ice-9 rdelim)
(ice-9 match)
,@%default-modules))
(start #~(make-forkexec-constructor
(list #$(file-append mcron "/bin/mcron") #$@files)
#:log-file (string-append
(or (getenv "XDG_LOG_HOME")
(format #f "~a/.local/var/log"
(getenv "HOME")))
"/mcron.log")))
(stop #~(make-kill-destructor))
(actions
(list (shepherd-schedule-action mcron files)))))))))
(define home-mcron-profile (compose list home-mcron-configuration-package))
(define (home-mcron-extend config jobs)
(home-mcron-configuration
(inherit config)
(jobs (append (home-mcron-configuration-jobs config)
jobs))))
(define home-mcron-service-type
(service-type (name 'home-mcron)
(extensions
(list (service-extension
home-shepherd-service-type
home-mcron-shepherd-services)
(service-extension
home-profile-service-type
home-mcron-profile)))
(compose concatenate)
(extend home-mcron-extend)
(default-value (home-mcron-configuration))
(description
"Install and configure the GNU mcron cron job manager.")))

634
gnu/home-services/shells.scm 100644
View File

@ -0,0 +1,634 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services shells)
#:use-module (gnu services configuration)
#:use-module (gnu home-services configuration)
#:use-module (gnu home-services utils)
#:use-module (gnu home-services)
#:use-module (gnu packages shells)
#:use-module (gnu packages bash)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (home-shell-profile-service-type
home-shell-profile-configuration
home-bash-service-type
home-bash-configuration
home-bash-extension
home-zsh-service-type
home-zsh-configuration
home-zsh-extension
home-fish-service-type
home-fish-configuration
home-fish-extension))
;;; Commentary:
;;;
;;; This module contains shell related services like Zsh.
;;;
;;; Code:
;;;
;;; Shell profile.
;;;
(define path? string?)
(define (serialize-path field-name val) val)
(define-configuration home-shell-profile-configuration
(profile
(text-config '())
"\
@code{home-shell-profile} is instantiated automatically by
@code{home-environment}, DO NOT create this service manually, it can
only be extended.
@code{profile} is a list of strings or gexps, which will go to
@file{~/.profile}. By default @file{~/.profile} contains the
initialization code, which have to be evaluated by login shell to make
home-environment's profile avaliable to the user, but other commands
can be added to the file if it is really necessary.
In most cases shell's configuration files are preferred places for
user's customizations. Extend home-shell-profile service only if you
really know what you do."))
(define (add-shell-profile-file config)
`(("profile"
,(mixed-text-file
"shell-profile"
"\
HOME_ENVIRONMENT=$HOME/.guix-home
. $HOME_ENVIRONMENT/setup-environment
$HOME_ENVIRONMENT/on-first-login\n"
(serialize-configuration
config
(filter-configuration-fields
home-shell-profile-configuration-fields '(profile)))))))
(define (add-profile-extensions config extensions)
(home-shell-profile-configuration
(inherit config)
(profile
(append (home-shell-profile-configuration-profile config)
extensions))))
(define home-shell-profile-service-type
(service-type (name 'home-shell-profile)
(extensions
(list (service-extension
home-files-service-type
add-shell-profile-file)))
(compose concatenate)
(extend add-profile-extensions)
(default-value (home-shell-profile-configuration))
(description "Create @file{~/.profile}, which is used
for environment initialization of POSIX compliant login shells. This
service type can be extended with a list of strings or gexps.")))
(define (serialize-boolean field-name val) "")
(define (serialize-posix-env-vars field-name val)
#~(string-append
#$@(map
(match-lambda
((key . #f)
"")
((key . #t)
#~(string-append "export " #$key "\n"))
((key . value)
#~(string-append "export " #$key "=" #$value "\n")))
val)))
;;;
;;; Zsh.
;;;
(define-configuration home-zsh-configuration
(package
(package zsh)
"The Zsh package to use.")
(xdg-flavor?
(boolean #t)
"Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes
@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}.
Shell startup process will continue with
@file{$XDG_CONFIG_HOME/zsh/.zshenv}.")
(environment-variables
(alist '())
"Association list of environment variables to set for the Zsh session."
serialize-posix-env-vars)
(zshenv
(text-config '())
"List of strings or gexps, which will be added to @file{.zshenv}.
Used for setting user's shell environment variables. Must not contain
commands assuming the presence of tty or producing output. Will be
read always. Will be read before any other file in @env{ZDOTDIR}.")
(zprofile
(text-config '())
"List of strings or gexps, which will be added to @file{.zprofile}.
Used for executing user's commands at start of login shell (In most
cases the shell started on tty just after login). Will be read before
@file{.zlogin}.")
(zshrc
(text-config '())
"List of strings or gexps, which will be added to @file{.zshrc}.
Used for executing user's commands at start of interactive shell (The
shell for interactive usage started by typing @code{zsh} or by
terminal app or any other program).")
(zlogin
(text-config '())
"List of strings or gexps, which will be added to @file{.zlogin}.
Used for executing user's commands at the end of starting process of
login shell.")
(zlogout
(text-config '())
"List of strings or gexps, which will be added to @file{.zlogout}.
Used for executing user's commands at the exit of login shell. It
won't be read in some cases (if the shell terminates by exec'ing
another process for example)."))
(define (add-zsh-configuration config)
(let* ((xdg-flavor? (home-zsh-configuration-xdg-flavor? config)))
(define prefix-file
(cut string-append
(if xdg-flavor?
"config/zsh/."
"") <>))
(define (filter-fields field)
(filter-configuration-fields home-zsh-configuration-fields
(list field)))
(define (serialize-field field)
(serialize-configuration
config
(filter-fields field)))
(define (file-if-not-empty field)
(let ((file-name (symbol->string field))
(field-obj (car (filter-fields field))))
(if (not (null? ((configuration-field-getter field-obj) config)))
`(,(prefix-file file-name)
,(mixed-text-file
file-name
(serialize-field field)))
'())))
(filter
(compose not null?)
`(,(if xdg-flavor?
`("zshenv"
,(mixed-text-file
"auxiliary-zshenv"
(if xdg-flavor?
"source ${XDG_CONFIG_HOME:-$HOME/.config}/zsh/.zshenv\n"
"")))
'())
(,(prefix-file "zshenv")
,(mixed-text-file
"zshenv"
(if xdg-flavor?
"export ZDOTDIR=${XDG_CONFIG_HOME:-$HOME/.config}/zsh\n"
"")
(serialize-field 'zshenv)
(serialize-field 'environment-variables)))
(,(prefix-file "zprofile")
,(mixed-text-file
"zprofile"
"\
# Setups system and user profiles and related variables
source /etc/profile
# Setups home environment profile
source ~/.profile
# It's only necessary if zsh is a login shell, otherwise profiles will
# be already sourced by bash
"
(serialize-field 'zprofile)))
,@(list (file-if-not-empty 'zshrc)
(file-if-not-empty 'zlogin)
(file-if-not-empty 'zlogout))))))
(define (add-zsh-packages config)
(list (home-zsh-configuration-package config)))
(define-configuration/no-serialization home-zsh-extension
(environment-variables
(alist '())
"Association list of environment variables to set.")
(zshrc
(text-config '())
"List of strings or gexps.")
(zshenv
(text-config '())
"List of strings or gexps.")
(zprofile
(text-config '())
"List of strings or gexps.")
(zlogin
(text-config '())
"List of strings or gexps.")
(zlogout
(text-config '())
"List of strings or gexps."))
(define (home-zsh-extensions original-config extension-configs)
(home-zsh-configuration
(inherit original-config)
(environment-variables
(append (home-zsh-configuration-environment-variables original-config)
(append-map
home-zsh-extension-environment-variables extension-configs)))
(zshrc
(append (home-zsh-configuration-zshrc original-config)
(append-map
home-zsh-extension-zshrc extension-configs)))
(zshenv
(append (home-zsh-configuration-zshenv original-config)
(append-map
home-zsh-extension-zshenv extension-configs)))
(zprofile
(append (home-zsh-configuration-zprofile original-config)
(append-map
home-zsh-extension-zprofile extension-configs)))
(zlogin
(append (home-zsh-configuration-zlogin original-config)
(append-map
home-zsh-extension-zlogin extension-configs)))
(zlogout
(append (home-zsh-configuration-zlogout original-config)
(append-map
home-zsh-extension-zlogout extension-configs)))))
(define home-zsh-service-type
(service-type (name 'home-zsh)
(extensions
(list (service-extension
home-files-service-type
add-zsh-configuration)
(service-extension
home-profile-service-type
add-zsh-packages)))
(compose identity)
(extend home-zsh-extensions)
(default-value (home-zsh-configuration))
(description "Install and configure Zsh.")))
;;;
;;; Bash.
;;;
(define-configuration home-bash-configuration
(package
(package bash)
"The Bash package to use.")
(guix-defaults?
(boolean #t)
"Add sane defaults like reading @file{/etc/bashrc}, coloring output
for @code{ls} provided by guix to @file{.bashrc}.")
(environment-variables
(alist '())
"Association list of environment variables to set for the Bash session."
serialize-posix-env-vars)
(bash-profile
(text-config '())
"List of strings or gexps, which will be added to @file{.bash_profile}.
Used for executing user's commands at start of login shell (In most
cases the shell started on tty just after login). @file{.bash_login}
won't be ever read, because @file{.bash_profile} always present.")
(bashrc
(text-config '())
"List of strings or gexps, which will be added to @file{.bashrc}.
Used for executing user's commands at start of interactive shell (The
shell for interactive usage started by typing @code{bash} or by
terminal app or any other program).")
(bash-logout
(text-config '())
"List of strings or gexps, which will be added to @file{.bash_logout}.
Used for executing user's commands at the exit of login shell. It
won't be read in some cases (if the shell terminates by exec'ing
another process for example)."))
;; TODO: Use value from (gnu system shadow)
(define guix-bashrc
"\
# Bash initialization for interactive non-login shells and
# for remote shells (info \"(bash) Bash Startup Files\").
# Export 'SHELL' to child processes. Programs such as 'screen'
# honor it and otherwise use /bin/sh.
export SHELL
if [[ $- != *i* ]]
then
# We are being invoked from a non-interactive shell. If this
# is an SSH session (as in \"ssh host command\"), source
# /etc/profile so we get PATH and other essential variables.
[[ -n \"$SSH_CLIENT\" ]] && source /etc/profile
# Don't do anything else.
return
fi
# Source the system-wide file.
source /etc/bashrc
# Adjust the prompt depending on whether we're in 'guix environment'.
if [ -n \"$GUIX_ENVIRONMENT\" ]
then
PS1='\\u@\\h \\w [env]\\$ '
else
PS1='\\u@\\h \\w\\$ '
fi
alias ls='ls -p --color=auto'
alias ll='ls -l'
alias grep='grep --color=auto'\n")
(define (add-bash-configuration config)
(define (filter-fields field)
(filter-configuration-fields home-bash-configuration-fields
(list field)))
(define (serialize-field field)
(serialize-configuration
config
(filter-fields field)))
(define* (file-if-not-empty field #:optional (extra-content #f))
(let ((file-name (symbol->string field))
(field-obj (car (filter-fields field))))
(if (or extra-content
(not (null? ((configuration-field-getter field-obj) config))))
`(,(object->snake-case-string file-name)
,(mixed-text-file
(object->snake-case-string file-name)
(if extra-content extra-content "")
(serialize-field field)))
'())))
(filter
(compose not null?)
`(("bash_profile"
,(mixed-text-file
"bash_profile"
"\
# Setups system and user profiles and related variables
# /etc/profile will be sourced by bash automatically
# Setups home environment profile
if [ -f ~/.profile ]; then source ~/.profile; fi
# Honor per-interactive-shell startup file
if [ -f ~/.bashrc ]; then source ~/.bashrc; fi
"
(serialize-field 'bash-profile)
(serialize-field 'environment-variables)))
,@(list (file-if-not-empty
'bashrc
(if (home-bash-configuration-guix-defaults? config)
guix-bashrc
#f))
(file-if-not-empty 'bash-logout)))))
(define (add-bash-packages config)
(list (home-bash-configuration-package config)))
(define-configuration/no-serialization home-bash-extension
(environment-variables
(alist '())
"Association list of environment variables to set.")
(bash-profile
(text-config '())
"List of strings or gexps.")
(bashrc
(text-config '())
"List of strings or gexps.")
(bash-logout
(text-config '())
"List of strings or gexps."))
(define (home-bash-extensions original-config extension-configs)
(home-bash-configuration
(inherit original-config)
(environment-variables
(append (home-bash-configuration-environment-variables original-config)
(append-map
home-bash-extension-environment-variables extension-configs)))
(bash-profile
(append (home-bash-configuration-bash-profile original-config)
(append-map
home-bash-extension-bash-profile extension-configs)))
(bashrc
(append (home-bash-configuration-bashrc original-config)
(append-map
home-bash-extension-bashrc extension-configs)))
(bash-logout
(append (home-bash-configuration-bash-logout original-config)
(append-map
home-bash-extension-bash-logout extension-configs)))))
(define home-bash-service-type
(service-type (name 'home-bash)
(extensions
(list (service-extension
home-files-service-type
add-bash-configuration)
(service-extension
home-profile-service-type
add-bash-packages)))
(compose identity)
(extend home-bash-extensions)
(default-value (home-bash-configuration))
(description "Install and configure GNU Bash.")))
;;;
;;; Fish.
;;;
(define (serialize-fish-aliases field-name val)
#~(string-append
#$@(map (match-lambda
((key . value)
#~(string-append "alias " #$key " \"" #$value "\"\n"))
(_ ""))
val)))
(define (serialize-fish-abbreviations field-name val)
#~(string-append
#$@(map (match-lambda
((key . value)
#~(string-append "abbr --add " #$key " " #$value "\n"))
(_ ""))
val)))
(define (serialize-fish-env-vars field-name val)
#~(string-append
#$@(map (match-lambda
((key . #f)
"")
((key . #t)
#~(string-append "set " #$key "\n"))
((key . value)
#~(string-append "set " #$key " " #$value "\n")))
val)))
(define-configuration home-fish-configuration
(package
(package fish)
"The Fish package to use.")
(config
(text-config '())
"List of strings or gexps, which will be added to
@file{$XDG_CONFIG_HOME/fish/config.fish}.")
(environment-variables
(alist '())
"Association list of environment variables to set in Fish."
serialize-fish-env-vars)
(aliases
(alist '())
"Association list of aliases for Fish, both the key and the value
should be a string. An alias is just a simple function that wraps a
command, If you want something more akin to @dfn{aliases} in POSIX
shells, see the @code{abbreviations} field."
serialize-fish-aliases)
(abbreviations
(alist '())
"Association list of abbreviations for Fish. These are words that,
when typed in the shell, will automatically expand to the full text."
serialize-fish-abbreviations))
(define (fish-files-service config)
`(("config/fish/config.fish"
,(mixed-text-file
"fish-config.fish"
#~(string-append "\
# if we haven't sourced the login config, do it
status --is-login; and not set -q __fish_login_config_sourced
and begin
set --prepend fish_function_path "
#$fish-foreign-env
"/share/fish/functions
fenv source $HOME/.profile
set -e fish_function_path[1]
set -g __fish_login_config_sourced 1
end\n\n")
(serialize-configuration
config
home-fish-configuration-fields)))))
(define (fish-profile-service config)
(list (home-fish-configuration-package config)))
(define-configuration/no-serialization home-fish-extension
(config
(text-config '())
"List of strings or gexps for extending the Fish initialization file.")
(environment-variables
(alist '())
"Association list of environment variables to set.")
(aliases
(alist '())
"Association list of Fish aliases.")
(abbreviations
(alist '())
"Association list of Fish abbreviations."))
(define (home-fish-extensions original-config extension-configs)
(home-fish-configuration
(inherit original-config)
(config
(append (home-fish-configuration-config original-config)
(append-map
home-fish-extension-config extension-configs)))
(environment-variables
(append (home-fish-configuration-environment-variables original-config)
(append-map
home-fish-extension-environment-variables extension-configs)))
(aliases
(append (home-fish-configuration-aliases original-config)
(append-map
home-fish-extension-aliases extension-configs)))
(abbreviations
(append (home-fish-configuration-abbreviations original-config)
(append-map
home-fish-extension-abbreviations extension-configs)))))
;; TODO: Support for generating completion files
;; TODO: Support for installing plugins
(define home-fish-service-type
(service-type (name 'home-fish)
(extensions
(list (service-extension
home-files-service-type
fish-files-service)
(service-extension
home-profile-service-type
fish-profile-service)))
(compose identity)
(extend home-fish-extensions)
(default-value (home-fish-configuration))
(description "\
Install and configure Fish, the friendly interactive shell.")))
(define (generate-home-shell-profile-documentation)
(generate-documentation
`((home-shell-profile-configuration
,home-shell-profile-configuration-fields))
'home-shell-profile-configuration))
(define (generate-home-bash-documentation)
(generate-documentation
`((home-bash-configuration
,home-bash-configuration-fields))
'home-bash-configuration))
(define (generate-home-zsh-documentation)
(generate-documentation
`((home-zsh-configuration
,home-zsh-configuration-fields))
'home-zsh-configuration))
(define (generate-home-fish-documentation)
(string-append
(generate-documentation
`((home-fish-configuration
,home-fish-configuration-fields))
'home-fish-configuration)
"\n\n"
(generate-documentation
`((home-fish-extension
,home-fish-extension-fields))
'home-fish-extension)))

134
gnu/home-services/shepherd.scm 100644
View File

@ -0,0 +1,134 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services shepherd)
#:use-module (gnu home-services)
#:use-module (gnu packages admin)
#:use-module (gnu services shepherd)
#:use-module (guix sets)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:export (home-shepherd-service-type
home-shepherd-configuration)
#:re-export (shepherd-service
shepherd-action))
(define-record-type* <home-shepherd-configuration>
home-shepherd-configuration make-home-shepherd-configuration
home-shepherd-configuration?
(shepherd home-shepherd-configuration-shepherd
(default shepherd)) ; package
(auto-start? home-shepherd-configuration-auto-start?
(default #t))
(services home-shepherd-configuration-services
(default '())))
(define (home-shepherd-configuration-file services shepherd)
"Return the shepherd configuration file for SERVICES. SHEPHERD is used
as shepherd package."
(assert-valid-graph services)
(let ((files (map shepherd-service-file services))
;; TODO: Add compilation of services, it can improve start
;; time.
;; (scm->go (cute scm->go <> shepherd))
)
(define config
#~(begin
(use-modules (srfi srfi-34)
(system repl error-handling))
(apply
register-services
(map
(lambda (file) (load file))
'#$files))
(action 'root 'daemonize)
(format #t "Starting services...~%")
(for-each
(lambda (service) (start service))
'#$(append-map shepherd-service-provision
(filter shepherd-service-auto-start?
services)))
(newline)))
(scheme-file "shepherd.conf" config)))
(define (launch-shepherd-gexp config)
(let* ((shepherd (home-shepherd-configuration-shepherd config))
(services (home-shepherd-configuration-services config)))
(if (home-shepherd-configuration-auto-start? config)
(with-imported-modules '((guix build utils))
#~(let ((log-dir (or (getenv "XDG_LOG_HOME")
(format #f "~a/.local/var/log" (getenv "HOME")))))
((@ (guix build utils) mkdir-p) log-dir)
(system*
#$(file-append shepherd "/bin/shepherd")
"--logfile"
(string-append
log-dir
"/shepherd.log")
"--config"
#$(home-shepherd-configuration-file services shepherd))))
#~"")))
(define (reload-configuration-gexp config)
(let* ((shepherd (home-shepherd-configuration-shepherd config))
(services (home-shepherd-configuration-services config)))
#~(system*
#$(file-append shepherd "/bin/herd")
"load" "root"
#$(home-shepherd-configuration-file services shepherd))))
(define (ensure-shepherd-gexp config)
#~(if (file-exists?
(string-append
(or (getenv "XDG_RUNTIME_DIR")
(format #f "/run/user/~a" (getuid)))
"/shepherd/socket"))
#$(reload-configuration-gexp config)
#$(launch-shepherd-gexp config)))
(define-public home-shepherd-service-type
(service-type (name 'home-shepherd)
(extensions
(list (service-extension
home-run-on-first-login-service-type
launch-shepherd-gexp)
(service-extension
home-activation-service-type
ensure-shepherd-gexp)
(service-extension
home-profile-service-type
(lambda (config)
`(,(home-shepherd-configuration-shepherd config))))))
(compose concatenate)
(extend
(lambda (config extra-services)
(home-shepherd-configuration
(inherit config)
(services
(append (home-shepherd-configuration-services config)
extra-services)))))
(default-value (home-shepherd-configuration))
(description "Configure and install userland Shepherd.")))

247
gnu/home-services/symlink-manager.scm 100644
View File

@ -0,0 +1,247 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services symlink-manager)
#:use-module (gnu home-services)
#:use-module (guix gexp)
#:export (home-symlink-manager-service-type))
;;; Comment:
;;;
;;; symlink-manager cares about configuration files: it backs up files
;;; created by user, removes symlinks and directories created by a
;;; previous generation, and creates new directories and symlinks to
;;; configuration files according to the content of files/ directory
;;; (created by home-files-service) of the current home environment
;;; generation.
;;;
;;; Code:
(define (update-symlinks-script)
(program-file
"update-symlinks"
#~(begin
(use-modules (ice-9 ftw)
(ice-9 curried-definitions)
(ice-9 match)
(srfi srfi-1))
(define ((simplify-file-tree parent) file)
"Convert the result produced by `file-system-tree' to less
verbose and more suitable for further processing format.
Extract dir/file info from stat and compose a relative path to the
root of the file tree.
Sample output:
((dir . \".\")
((dir . \"config\")
((dir . \"config/fontconfig\")
(file . \"config/fontconfig/fonts.conf\"))
((dir . \"config/isync\")
(file . \"config/isync/mbsyncrc\"))))
"
(match file
((name stat) `(file . ,(string-append parent name)))
((name stat children ...)
(cons `(dir . ,(string-append parent name))
(map (simplify-file-tree
(if (equal? name ".")
""
(string-append parent name "/")))
children)))))
(define ((file-tree-traverse preordering) node)
"Traverses the file tree in different orders, depending on PREORDERING.
if PREORDERING is @code{#t} resulting list will contain directories
before files located in those directories, otherwise directory will
appear only after all nested items already listed."
(let ((prepend (lambda (a b) (append b a))))
(match node
(('file . path) (list node))
((('dir . path) . rest)
((if preordering append prepend)
(list (cons 'dir path))
(append-map (file-tree-traverse preordering) rest))))))
(use-modules (guix build utils))
(let* ((config-home (or (getenv "XDG_CONFIG_HOME")
(string-append (getenv "HOME") "/.config")))
(he-path (string-append (getenv "HOME") "/.guix-home"))
(new-he-path (string-append he-path ".new"))
(new-home (getenv "GUIX_NEW_HOME"))
(old-home (getenv "GUIX_OLD_HOME"))
(new-files-path (string-append new-home "/files"))
;; Trailing dot is required, because files itself is symlink and
;; to make file-system-tree works it should be a directory.
(new-files-dir-path (string-append new-files-path "/."))
(home-path (getenv "HOME"))
(backup-dir (string-append home-path "/"
(number->string (current-time))
"-guix-home-legacy-configs-backup"))
(old-tree (if old-home
((simplify-file-tree "")
(file-system-tree
(string-append old-home "/files/.")))
#f))
(new-tree ((simplify-file-tree "")
(file-system-tree new-files-dir-path)))
(get-source-path
(lambda (path)
(readlink (string-append new-files-path "/" path))))
(get-target-path
(lambda (path)
(string-append home-path "/." path)))
(get-backup-path
(lambda (path)
(string-append backup-dir "/." path)))
(directory?
(lambda (path)
(equal? (stat:type (stat path)) 'directory)))
(empty-directory?
(lambda (dir)
(equal? (scandir dir) '("." ".."))))
(symlink-to-store?
(lambda (path)
(and
(equal? (stat:type (lstat path)) 'symlink)
(store-file-name? (readlink path)))))
(backup-file
(lambda (path)
(mkdir-p backup-dir)
(format #t "Backing up ~a..." (get-target-path path))
(mkdir-p (dirname (get-backup-path path)))
(rename-file (get-target-path path) (get-backup-path path))
(display " done\n")))
(cleanup-symlinks
(lambda ()
(let ((to-delete ((file-tree-traverse #f) old-tree)))
(display
"Cleaning up symlinks from previous home-environment.\n\n")
(map
(match-lambda
(('dir . ".")
(display "Cleanup finished.\n\n"))
(('dir . path)
(if (and
(file-exists? (get-target-path path))
(directory? (get-target-path path))
(empty-directory? (get-target-path path)))
(begin
(format #t "Removing ~a..."
(get-target-path path))
(rmdir (get-target-path path))
(display " done\n"))
(format
#t "Skipping ~a (not an empty directory)... done\n"
(get-target-path path))))
(('file . path)
(when (file-exists? (get-target-path path))
;; DO NOT remove the file if it is no longer
;; a symlink to the store, it will be backed
;; up later during create-symlinks phase.
(if (symlink-to-store? (get-target-path path))
(begin
(format #t "Removing ~a..." (get-target-path path))
(delete-file (get-target-path path))
(display " done\n"))
(format
#t
"Skipping ~a (not a symlink to store)... done\n"
(get-target-path path))))))
to-delete))))
(create-symlinks
(lambda ()
(let ((to-create ((file-tree-traverse #t) new-tree)))
(map
(match-lambda
(('dir . ".")
(display
"New symlinks to home-environment will be created soon.\n")
(format
#t "All conflicting files will go to ~a.\n\n" backup-dir))
(('dir . path)
(let ((target-path (get-target-path path)))
(when (and (file-exists? target-path)
(not (directory? target-path)))
(backup-file path))
(if (file-exists? target-path)
(format
#t "Skipping ~a (directory already exists)... done\n"
target-path)
(begin
(format #t "Creating ~a..." target-path)
(mkdir target-path)
(display " done\n")))))
(('file . path)
(when (file-exists? (get-target-path path))
(backup-file path))
(format #t "Symlinking ~a -> ~a..."
(get-target-path path) (get-source-path path))
(symlink (get-source-path path) (get-target-path path))
(display " done\n")))
to-create)))))
(when old-tree
(cleanup-symlinks))
(create-symlinks)
(symlink new-home new-he-path)
(rename-file new-he-path he-path)
(display " done\nFinished updating symlinks.\n\n")))))
(define (update-symlinks-gexp _)
#~(primitive-load #$(update-symlinks-script)))
(define home-symlink-manager-service-type
(service-type (name 'home-symlink-manager)
(extensions
(list
(service-extension
home-activation-service-type
update-symlinks-gexp)))
(default-value #f)
(description "Provide an @code{update-symlinks}
script, which creates symlinks to configuration files and directories
on every activation. If an existing file would be overwritten by a
symlink, backs up that file first.")))

105
gnu/home-services/utils.scm 100644
View File

@ -0,0 +1,105 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services utils)
#:use-module (ice-9 string-fun)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (maybe-object->string
object->snake-case-string
object->camel-case-string
list->human-readable-list))
(define (maybe-object->string object)
"Like @code{object->string} but don't do anyting if OBJECT already is
a string."
(if (string? object)
object
(object->string object)))
;; Snake case: <https://en.wikipedia.org/wiki/Snake_case>
(define* (object->snake-case-string object #:optional (style 'lower))
"Convert the object OBJECT to the equivalent string in ``snake
case''. STYLE can be three `@code{lower}', `@code{upper}', or
`@code{capitalize}', defaults to `@code{lower}'.
@example
(object->snake-case-string 'variable-name 'upper)
@result{} \"VARIABLE_NAME\" @end example"
(if (not (member style '(lower upper capitalize)))
(error 'invalid-style (format #f "~a is not a valid style" style))
(let ((stringified (maybe-object->string object)))
(string-replace-substring
(cond
((equal? style 'lower) stringified)
((equal? style 'upper) (string-upcase stringified))
(else (string-capitalize stringified)))
"-" "_"))))
(define* (object->camel-case-string object #:optional (style 'lower))
"Convert the object OBJECT to the equivalent string in ``camel case''.
STYLE can be three `@code{lower}', `@code{upper}', defaults to
`@code{lower}'.
@example
(object->camel-case-string 'variable-name 'upper)
@result{} \"VariableName\"
@end example"
(if (not (member style '(lower upper)))
(error 'invalid-style (format #f "~a is not a valid style" style))
(let ((stringified (maybe-object->string object)))
(cond
((eq? style 'upper)
(string-concatenate
(map string-capitalize
(string-split stringified (cut eqv? <> #\-)))))
((eq? style 'lower)
(let ((splitted-string (string-split stringified (cut eqv? <> #\-))))
(string-concatenate
(cons (first splitted-string)
(map string-capitalize
(cdr splitted-string))))))))))
(define* (list->human-readable-list lst
#:key
(cumulative? #f)
(proc identity))
"Turn a list LST into a sequence of terms readable by humans.
If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before
the last term.
PROC is a procedure to apply to each of the elements of a list before
turning them into a single human readable string.
@example
(list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt)
@result{} \"1, 2, and 3\"
@end example
yields:"
(let* ((word (if cumulative? "and " "or "))
(init (append (drop-right lst 1))))
(format #f "~a" (string-append
(string-join
(map (compose maybe-object->string proc) init)
", " 'suffix)
word
(maybe-object->string (proc (last lst)))))))

478
gnu/home-services/xdg.scm 100644
View File

@ -0,0 +1,478 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home-services xdg)
#:use-module (gnu services configuration)
#:use-module (gnu home-services configuration)
#:use-module (gnu home-services)
#:use-module (gnu packages freedesktop)
#:use-module (gnu home-services utils)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (rnrs enums)
#:export (home-xdg-base-directories-service-type
home-xdg-base-directories-configuration
home-xdg-base-directories-configuration?
home-xdg-user-directories-service-type
home-xdg-user-directories-configuration
home-xdg-user-directories-configuration?
xdg-desktop-action
xdg-desktop-entry
home-xdg-mime-applications-service-type
home-xdg-mime-applications-configuration))
;;; Commentary:
;;
;; This module contains services related to XDG directories and
;; applications.
;;
;; - XDG base directories
;; - XDG user directories
;; - XDG MIME applications
;;
;;; Code:
;;;
;;; XDG base directories.
;;;
(define (serialize-path field-name val) "")
(define path? string?)
(define-configuration home-xdg-base-directories-configuration
(cache-home
(path "$HOME/.cache")
"Base directory for programs to store user-specific non-essential
(cached) data. Files in this directory can be deleted anytime without
loss of important data.")
(config-home
(path "$HOME/.config")
"Base directory for programs to store configuration files.
Some programs store here log or state files, but it's not desired,
this directory should contain static configurations.")
(data-home
(path "$HOME/.local/share")
"Base directory for programs to store architecture independent
read-only shared data, analogus to @file{/usr/share}, but for user.")
(runtime-dir
(path "${XDG_RUNTIME_DIR:-/run/user/$UID}")
"Base directory for programs to store user-specific runtime files,
like sockets.")
(log-home
(path "$HOME/.local/var/log")
"Base directory for programs to store log files, analogus to
@file{/var/log}, but for user. It is not a part of XDG Base Directory
Specification, but helps to make implementation of home services more
consistent.")
(state-home
(path "$HOME/.local/var/lib")
"Base directory for programs to store state files, like databases,
analogus to @file{/var/lib}, but for user. It is not a part of XDG
Base Directory Specification, but helps to make implementation of home
services more consistent."))
(define (home-xdg-base-directories-environment-variables-service config)
(map
(lambda (field)
(cons (format
#f "XDG_~a"
(object->snake-case-string (configuration-field-name field) 'upper))
((configuration-field-getter field) config)))
home-xdg-base-directories-configuration-fields))
(define (ensure-xdg-base-dirs-on-activation config)
#~(map (lambda (xdg-base-dir-variable)
((@@ (guix build utils) mkdir-p)
(getenv
xdg-base-dir-variable)))
'#$(map (lambda (field)
(format
#f "XDG_~a"
(object->snake-case-string
(configuration-field-name field) 'upper)))
home-xdg-base-directories-configuration-fields)))
(define (last-extension-or-cfg config extensions)
"Picks configuration value from last provided extension. If there
are no extensions use configuration instead."
(or (and (not (null? extensions)) (last extensions)) config))
(define home-xdg-base-directories-service-type
(service-type (name 'home-xdg-base-directories)
(extensions
(list (service-extension
home-environment-variables-service-type
home-xdg-base-directories-environment-variables-service)
(service-extension
home-activation-service-type
ensure-xdg-base-dirs-on-activation)))
(default-value (home-xdg-base-directories-configuration))
(compose identity)
(extend last-extension-or-cfg)
(description "Configure XDG base directories. This
service introduces two additional variables @env{XDG_STATE_HOME},
@env{XDG_LOG_HOME}. They are not a part of XDG specification, at
least yet, but are convinient to have, it improves the consistency
between different home services. The services of this service-type is
instantiated by default, to provide non-default value, extend the
service-type (using @code{simple-service} for example).")))
(define (generate-home-xdg-base-directories-documentation)
(generate-documentation
`((home-xdg-base-directories-configuration
,home-xdg-base-directories-configuration-fields))
'home-xdg-base-directories-configuration))
;;;
;;; XDG user directories.
;;;
(define (serialize-string field-name val)
;; The path has to be quoted
(format #f "XDG_~a_DIR=\"~a\"\n"
(object->snake-case-string field-name 'upper) val))
(define-configuration home-xdg-user-directories-configuration
(desktop
(string "$HOME/Desktop")
"Default ``desktop'' directory, this is what you see on your
desktop when using a desktop environment,
e.g. GNOME (@pxref{XWindow,,,guix.info}).")
(documents
(string "$HOME/Documents")
"Default directory to put documents like PDFs.")
(download
(string "$HOME/Downloads")
"Default directory downloaded files, this is where your Web-broser
will put downloaded files in.")
(music
(string "$HOME/Music")
"Default directory for audio files.")
(pictures
(string "$HOME/Pictures")
"Default directory for pictures and images.")
(publicshare
(string "$HOME/Public")
"Default directory for shared files, which can be accessed by other
users on local machine or via network.")
(templates
(string "$HOME/Templates")
"Default directory for templates. They can be used by graphical
file manager or other apps for creating new files with some
pre-populated content.")
(videos
(string "$HOME/Videos")
"Default directory for videos."))
(define (home-xdg-user-directories-files-service config)
`(("config/user-dirs.conf"
,(mixed-text-file
"user-dirs.conf"
"enabled=False\n"))
("config/user-dirs.dirs"
,(mixed-text-file
"user-dirs.dirs"
(serialize-configuration
config
home-xdg-user-directories-configuration-fields)))))
(define (home-xdg-user-directories-activation-service config)
(let ((dirs (map (lambda (field)
((configuration-field-getter field) config))
home-xdg-user-directories-configuration-fields)))
#~(let ((ensure-dir
(lambda (path)
(mkdir-p
((@@ (ice-9 string-fun) string-replace-substring)
path "$HOME" (getenv "HOME"))))))
(display "Creating XDG user directories...")
(map ensure-dir '#$dirs)
(display " done\n"))))
(define home-xdg-user-directories-service-type
(service-type (name 'home-xdg-user-directories)
(extensions
(list (service-extension
home-files-service-type
home-xdg-user-directories-files-service)
(service-extension
home-activation-service-type
home-xdg-user-directories-activation-service)))
(default-value (home-xdg-user-directories-configuration))
(description "Configure XDG user directories. To
disable a directory, point it to the $HOME.")))
(define (generate-home-xdg-user-directories-documentation)
(generate-documentation
`((home-xdg-user-directories-configuration
,home-xdg-user-directories-configuration-fields))
'home-xdg-user-directories-configuration))
;;;
;;; XDG MIME applications.
;;;
;; Example config
;;
;; (home-xdg-mime-applications-configuration
;; (added '((x-scheme-handler/magnet . torrent.desktop)))
;; (default '((inode/directory . file.desktop)))
;; (removed '((inode/directory . thunar.desktop)))
;; (desktop-entries
;; (list (xdg-desktop-entry
;; (file "file")
;; (name "File manager")
;; (type 'application)
;; (config
;; '((exec . "emacsclient -c -a emacs %u"))))
;; (xdg-desktop-entry
;; (file "text")
;; (name "Text editor")
;; (type 'application)
;; (config
;; '((exec . "emacsclient -c -a emacs %u")))
;; (actions
;; (list (xdg-desktop-action
;; (action 'create)
;; (name "Create an action")
;; (config
;; '((exec . "echo hi"))))))))))
;; See
;; <https://specifications.freedesktop.org/shared-mime-info-spec/shared-mime-info-spec-latest.html>
;; <https://specifications.freedesktop.org/mime-apps-spec/mime-apps-spec-latest.html>
(define (serialize-alist field-name val)
(define (serialize-mimelist-entry key val)
(let ((val (cond
((list? val)
(string-join (map maybe-object->string val) ";"))
((or (string? val) (symbol? val))
val)
(else (raise (formatted-message
(G_ "\
The value of an XDG MIME entry must be a list, string or symbol, was given ~a")
val))))))
(format #f "~a=~a\n" key val)))
(define (merge-duplicates alist acc)
"Merge values that have the same key.
@example
(merge-duplicates '((key1 . value1)
(key2 . value2)
(key1 . value3)
(key1 . value4)) '())
@result{} ((key1 . (value4 value3 value1)) (key2 . value2))
@end example"
(cond
((null? alist) acc)
(else (let* ((head (first alist))
(tail (cdr alist))
(key (first head))
(value (cdr head))
(duplicate? (assoc key acc))
(ensure-list (lambda (x)
(if (list? x) x (list x)))))
(if duplicate?
;; XXX: This will change the order of things,
;; though, it shouldn't be a problem for XDG MIME.
(merge-duplicates
tail
(alist-cons key
(cons value (ensure-list (cdr duplicate?)))
(alist-delete key acc)))
(merge-duplicates tail (cons head acc)))))))
(string-append (if (equal? field-name 'default)
"\n[Default Applications]\n"
(format #f "\n[~a Associations]\n"
(string-capitalize (symbol->string field-name))))
(generic-serialize-alist string-append
serialize-mimelist-entry
(merge-duplicates val '()))))
(define xdg-desktop-types (make-enumeration
'(application
link
directory)))
(define (xdg-desktop-type? type)
(unless (enum-set-member? type xdg-desktop-types)
(raise (formatted-message
(G_ "XDG desktop type must be of of ~a, was given: ~a")
(list->human-readable-list (enum-set->list xdg-desktop-types))
type))))
;; TODO: Add proper docs for this
;; XXX: 'define-configuration' require that fields have a default
;; value.
(define-record-type* <xdg-desktop-action>
xdg-desktop-action make-xdg-desktop-action
xdg-desktop-action?
(action xdg-desktop-action-action) ; symbol
(name xdg-desktop-action-name) ; string
(config xdg-desktop-action-config ; alist
(default '())))
(define-record-type* <xdg-desktop-entry>
xdg-desktop-entry make-xdg-desktop-entry
xdg-desktop-entry?
;; ".desktop" will automatically be added
(file xdg-desktop-entry-file) ; string
(name xdg-desktop-entry-name) ; string
(type xdg-desktop-entry-type) ; xdg-desktop-type
(config xdg-desktop-entry-config ; alist
(default '()))
(actions xdg-desktop-entry-actions ; list of <xdg-desktop-action>
(default '())))
(define desktop-entries? (list-of xdg-desktop-entry?))
(define (serialize-desktop-entries field-name val) "")
(define (serialize-xdg-desktop-entry entry)
"Return a tuple of the file name for ENTRY and the serialized
configuration."
(define (format-config key val)
(let ((val (cond
((list? val)
(string-join (map maybe-object->string val) ";"))
((boolean? val)
(if val "true" "false"))
(else val)))
(key (string-capitalize (maybe-object->string key))))
(list (if (string-suffix? key "?")
(string-drop-right key (- (string-length key) 1))
key)
"=" val "\n")))
(define (serialize-alist config)
(generic-serialize-alist identity format-config config))
(define (serialize-xdg-desktop-action action)
(match action
(($ <xdg-desktop-action> action name config)
`(,(format #f "[Desktop Action ~a]\n"
(string-capitalize (maybe-object->string action)))
,(format #f "Name=~a\n" name)
,@(serialize-alist config)))))
(match entry
(($ <xdg-desktop-entry> file name type config actions)
(list (if (string-suffix? file ".desktop")
file
(string-append file ".desktop"))
`("[Desktop Entry]\n"
,(format #f "Name=~a\n" name)
,(format #f "Type=~a\n"
(string-capitalize (symbol->string type)))
,@(serialize-alist config)
,@(append-map serialize-xdg-desktop-action actions))))))
(define-configuration home-xdg-mime-applications-configuration
(added
(alist '())
"An association list of MIME types and desktop entries which indicate
that the application should used to open the specified MIME type. The
value has to be string, symbol, or list of strings or symbols, this
applies to the `@code{default}', and `@code{removed}' fields as well.")
(default
(alist '())
"An association list of MIME types and desktop entries which indicate
that the application should be the default for opening the specified
MIME type.")
(removed
(alist '())
"An association list of MIME types and desktop entries which indicate
that the application cannot open the specified MIME type.")
(desktop-entries
(desktop-entries '())
"A list of XDG desktop entries to create. See
@code{xdg-desktop-entry}."))
(define (home-xdg-mime-applications-files-service config)
(define (add-xdg-desktop-entry-file entry)
(let ((file (first entry))
(config (second entry)))
(list (format #f "local/share/applications/~a" file)
(apply mixed-text-file
(format #f "xdg-desktop-~a-entry" file)
config))))
(append
`(("config/mimeapps.list"
,(mixed-text-file
"xdg-mime-appplications"
(serialize-configuration
config
home-xdg-mime-applications-configuration-fields))))
(map (compose add-xdg-desktop-entry-file serialize-xdg-desktop-entry)
(home-xdg-mime-applications-configuration-desktop-entries config))))
(define (home-xdg-mime-applications-extension old-config extension-configs)
(define (extract-fields config)
;; return '(added default removed desktop-entries)
(list (home-xdg-mime-applications-configuration-added config)
(home-xdg-mime-applications-configuration-default config)
(home-xdg-mime-applications-configuration-removed config)
(home-xdg-mime-applications-configuration-desktop-entries config)))
(define (append-configs elem acc)
(list (append (first elem) (first acc))
(append (second elem) (second acc))
(append (third elem) (third acc))
(append (fourth elem) (fourth acc))))
;; TODO: Implement procedure to check for duplicates without
;; sacrificing performance.
;;
;; Combine all the alists from 'added', 'default' and 'removed'
;; into one big alist.
(let ((folded-configs (fold append-configs
(extract-fields old-config)
(map extract-fields extension-configs))))
(home-xdg-mime-applications-configuration
(added (first folded-configs))
(default (second folded-configs))
(removed (third folded-configs))
(desktop-entries (fourth folded-configs)))))
(define home-xdg-mime-applications-service-type
(service-type (name 'home-xdg-mime-applications)
(extensions
(list (service-extension
home-files-service-type
home-xdg-mime-applications-files-service)))
(compose identity)
(extend home-xdg-mime-applications-extension)
(default-value (home-xdg-mime-applications-configuration))
(description
"Configure XDG MIME applications, and XDG desktop entries.")))

106
gnu/home.scm 100644
View File

@ -0,0 +1,106 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home)
#:use-module (gnu home-services)
#:use-module (gnu home-services symlink-manager)
#:use-module (gnu home-services shells)
#:use-module (gnu home-services xdg)
#:use-module (gnu home-services fontutils)
#:use-module (gnu services)
#:use-module (guix records)
#:use-module (guix diagnostics)
#:export (home-environment
home-environment?
this-home-environment
home-environment-derivation
home-environment-user-services
home-environment-essential-services
home-environment-services
home-environment-location
home-environment-with-provenance))
;;; Comment:
;;;
;;; This module provides a <home-environment> record for managing
;;; per-user packages and configuration files in the similar way as
;;; <operating-system> do for system packages and configuration files.
;;;
;;; Code:
(define-record-type* <home-environment> home-environment
make-home-environment
home-environment?
this-home-environment
(packages home-environment-packages ; list of (PACKAGE OUTPUT...)
(default '()))
(essential-services home-environment-essential-services ; list of services
(thunked)
(default (home-environment-default-essential-services
this-home-environment)))
(services home-environment-user-services
(default '()))
(location home-environment-location ; <location>
(default (and=> (current-source-location)
source-properties->location))
(innate)))
(define (home-environment-default-essential-services he)
"Return the list of essential services for home environment."
(list
(service home-run-on-first-login-service-type)
(service home-activation-service-type)
(service home-environment-variables-service-type)
(service home-symlink-manager-service-type)
(service home-fontconfig-service-type)
(service home-xdg-base-directories-service-type)
(service home-shell-profile-service-type)
(service home-service-type)
(service home-profile-service-type (home-environment-packages he))))
(define* (home-environment-services he)
"Return all the services of home environment."
(instantiate-missing-services
(append (home-environment-user-services he)
(home-environment-essential-services he))))
(define* (home-environment-derivation he)
"Return a derivation that builds OS."
(let* ((services (home-environment-services he))
(home (fold-services services
#:target-type home-service-type)))
(service-value home)))
(define* (home-environment-with-provenance he config-file)
"Return a variant of HE that stores its own provenance information,
including CONFIG-FILE, if available. This is achieved by adding an instance
of HOME-PROVENANCE-SERVICE-TYPE to its services."
(home-environment
(inherit he)
(services (cons (service home-provenance-service-type config-file)
(home-environment-user-services he)))))

1
gnu/installer.scm
View File

@ -330,6 +330,7 @@ selected keymap."
btrfs-progs
jfsutils ;jfs_mkfs
ntfs-3g ;mkfs.ntfs
xfsprogs ;mkfs.xfs
kbd ;chvt
guix ;guix system init call
util-linux ;mkwap

33
gnu/installer/newt/partition.scm
View File

@ -95,14 +95,17 @@ DEVICES list."
(define (run-label-page button-text button-callback)
"Run a page asking the user to select a partition table label."
(run-listbox-selection-page
#:info-text (G_ "Select a new partition table type. \
;; Force the GPT label if UEFI is supported.
(if (efi-installation?)
"gpt"
(run-listbox-selection-page
#:info-text (G_ "Select a new partition table type. \
Be careful, all data on the disk will be lost.")
#:title (G_ "Partition table")
#:listbox-items '("msdos" "gpt")
#:listbox-item->text identity
#:button-text button-text
#:button-callback-procedure button-callback))
#:title (G_ "Partition table")
#:listbox-items '("msdos" "gpt")
#:listbox-item->text identity
#:button-text button-text
#:button-callback-procedure button-callback)))
(define (run-type-page partition)
"Run a page asking the user to select a partition type."
@ -128,7 +131,7 @@ Be careful, all data on the disk will be lost.")
(run-listbox-selection-page
#:info-text (G_ "Please select the file-system type for this partition.")
#:title (G_ "File-system type")
#:listbox-items '(ext4 btrfs fat16 fat32 jfs ntfs swap)
#:listbox-items '(ext4 btrfs fat16 fat32 jfs ntfs xfs swap)
#:listbox-item->text user-fs-type-name
#:sort-listbox-items? #f
#:button-text (G_ "Exit")
@ -640,8 +643,10 @@ edit it."
default-result))))
((partition? item)
(if (freespace-partition? item)
(run-error-page (G_ "You cannot delete a free space area.")
(G_ "Delete partition"))
(begin
(run-error-page (G_ "You cannot delete a free space area.")
(G_ "Delete partition"))
default-result)
(let* ((disk (partition-disk item))
(number-str (partition-print-number item))
(info-text
@ -706,6 +711,13 @@ by pressing the Exit button.~%~%")))
(run-error-page
(G_ "No root mount point found.")
(G_ "Missing mount point"))
#f)
((cannot-read-uuid? c)
(run-error-page
(format #f (G_ "Cannot read the ~a partition UUID.\
You may need to format it.")
(cannot-read-uuid-partition c))
(G_ "Wrong partition format"))
#f))
(check-user-partitions user-partitions))))
(if user-partitions-ok?
@ -786,6 +798,7 @@ by pressing the Exit button.~%~%")))
(format-user-partitions user-partitions-with-pass)
(syslog "formatted ~a user partitions~%"
(length user-partitions-with-pass))
(syslog "user-partitions: ~a~%" user-partitions)
(destroy-form-and-pop form)
user-partitions))

25
gnu/installer/newt/services.scm
View File

@ -68,6 +68,28 @@ system.")
(condition
(&installer-step-abort)))))))
(define (run-other-services-cbt-page)
"Run a page allowing the user to select other services."
(let ((items (filter (lambda (service)
(not (member (system-service-type service)
'(desktop
network-management
networking))))
%system-services)))
(run-checkbox-tree-page
#:info-text (G_ "You can now select other services to run on your \
system.")
#:title (G_ "Other services")
#:items items
#:selection (map system-service-recommended? items)
#:item->text (compose G_ system-service-name)
#:checkbox-tree-height 9
#:exit-button-callback-procedure
(lambda ()
(raise
(condition
(&installer-step-abort)))))))
(define (run-network-management-page)
"Run a page to select among several network management methods."
(let ((title (G_ "Network management")))
@ -100,4 +122,5 @@ client may be enough for a server.")
(run-networking-cbt-page)
(if (null? desktop)
(list (run-network-management-page))
'()))))
'())
(run-other-services-cbt-page))))

165
gnu/installer/parted.scm
View File

@ -24,8 +24,13 @@
#:use-module (gnu installer newt page)
#:use-module (gnu system uuid)
#:use-module ((gnu build file-systems)
#:select (read-partition-uuid
#:select (canonicalize-device-spec
find-partition-by-label
read-partition-uuid
read-luks-partition-uuid))
#:use-module ((gnu build linux-boot)
#:select (linux-command-line
find-long-option))
#:use-module ((gnu build linux-modules)
#:select (missing-modules))
#:use-module ((gnu system linux-initrd)
@ -70,6 +75,7 @@
small-freespace-partition?
esp-partition?
boot-partition?
efi-installation?
default-esp-mount-point
with-delay-device-in-use?
@ -106,6 +112,9 @@
&no-root-mount-point
no-root-mount-point?
&cannot-read-uuid
cannot-read-uuid?
cannot-read-uuid-partition
check-user-partitions
set-user-partitions-file-name
@ -193,12 +202,8 @@ inferior to MAX-SIZE, #f otherwise."
(define (esp-partition? partition)
"Return #t if partition has the ESP flag, return #f otherwise."
(let* ((disk (partition-disk partition))
(disk-type (disk-disk-type disk))
(has-extended? (disk-type-check-feature
disk-type
DISK-TYPE-FEATURE-EXTENDED)))
(disk-type (disk-disk-type disk)))
(and (data-partition? partition)
(not has-extended?)
(partition-is-flag-available? partition PARTITION-FLAG-ESP)
(partition-get-flag partition PARTITION-FLAG-ESP))))
@ -226,6 +231,7 @@ inferior to MAX-SIZE, #f otherwise."
((fat32) "fat32")
((jfs) "jfs")
((ntfs) "ntfs")
((xfs) "xfs")
((swap) "linux-swap")))
(define (user-fs-type->mount-type fs-type)
@ -233,10 +239,11 @@ inferior to MAX-SIZE, #f otherwise."
(case fs-type
((ext4) "ext4")
((btrfs) "btrfs")
((fat16) "fat")
((fat16) "vfat")
((fat32) "vfat")
((jfs) "jfs")
((ntfs) "ntfs")))
((ntfs) "ntfs")
((xfs) "xfs")))
(define (partition-filesystem-user-type partition)
"Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
@ -251,6 +258,7 @@ of <user-partition> record."
((string=? name "fat32") 'fat32)
((string=? name "jfs") 'jfs)
((string=? name "ntfs") 'ntfs)
((string=? name "xfs") 'xfs)
((or (string=? name "swsusp")
(string=? name "linux-swap(v0)")
(string=? name "linux-swap(v1)"))
@ -337,16 +345,35 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
(with-null-output-ports
(invoke "dmsetup" "remove_all")))
(define (installation-device)
"Return the installation device path."
(let* ((cmdline (linux-command-line))
(root (find-long-option "--root" cmdline)))
(and root
(canonicalize-device-spec (uuid root)))))
(define (non-install-devices)
"Return all the available devices, except the busy one, allegedly the
install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
mounted."
;; FIXME: The install image uses an overlayfs so the install device does not
;; appear as mounted and won't be considered as busy.
(remove (lambda (device)
(let ((file-name (device-path device)))
(device-is-busy? device)))
(devices)))
"Return all the available devices, except the install device."
(define (read-only? device)
(dynamic-wind
(lambda ()
(device-open device))
(lambda ()
(device-read-only? device))
(lambda ()
(device-close device))))
;; If parted reports that a device is read-only it is probably the
;; installation device. However, as this detection does not always work,
;; compare the device path to the installation device path read from the
;; command line.
(let ((install-device (installation-device)))
(remove (lambda (device)
(let ((file-name (device-path device)))
(or (read-only? device)
(and install-device
(string=? file-name install-device)))))
(devices))))
;;
@ -871,7 +898,7 @@ partition."
(format #f "Unable to create partition ~a~%" name)))))))))
(define (force-user-partitions-formatting user-partitions)
"Set the NEED-FORMATING? fields to #t on all <user-partition> records of
"Set the NEED-FORMATTING? fields to #t on all <user-partition> records of
USER-PARTITIONS list and return the updated list."
(map (lambda (p)
(user-partition
@ -918,30 +945,26 @@ exists."
;; disk space. Otherwise, set the swap size to 5% of the disk space.
(swap-size (min default-swap-size five-percent-disk)))
(if has-extended?
;; msdos - remove everything.
(disk-remove-all-partitions disk)
;; gpt - remove everything but esp if it exists.
(for-each
(lambda (partition)
(and (data-partition? partition)
(disk-remove-partition* disk partition)))
non-boot-partitions))
;; Remove everything but esp if it exists.
(for-each
(lambda (partition)
(and (data-partition? partition)
(disk-remove-partition* disk partition)))
non-boot-partitions)
(let* ((start-partition
(and (not has-extended?)
(if (efi-installation?)
(and (not esp-partition)
(user-partition
(fs-type 'fat32)
(esp? #t)
(size new-esp-size)
(mount-point (default-esp-mount-point))))
(if (efi-installation?)
(and (not esp-partition)
(user-partition
(fs-type 'ext4)
(bootable? #t)
(bios-grub? #t)
(size bios-grub-size)))))
(fs-type 'fat32)
(esp? #t)
(size new-esp-size)
(mount-point (default-esp-mount-point))))
(user-partition
(fs-type 'ext4)
(bootable? #t)
(bios-grub? #t)
(size bios-grub-size))))
(new-partitions
(cond
((or (eq? scheme 'entire-root)
@ -1013,15 +1036,48 @@ exists."
(define-condition-type &no-root-mount-point &condition
no-root-mount-point?)
;; Cannot not read the partition UUID.
(define-condition-type &cannot-read-uuid &condition
cannot-read-uuid?
(partition cannot-read-uuid-partition))
(define (check-user-partitions user-partitions)
"Return #t if the USER-PARTITIONS lists contains one <user-partition> record
with a mount-point set to '/', raise &no-root-mount-point condition
otherwise."
(let ((mount-points
(map user-partition-mount-point user-partitions)))
(or (member "/" mount-points)
(raise
(condition (&no-root-mount-point))))))
"Check the following statements:
The USER-PARTITIONS list contains one <user-partition> record with a
mount-point set to '/'. Raise &no-root-mount-point condition otherwise.
All the USER-PARTITIONS with a mount point and that will not be formatted have
a valid UUID. Raise a &cannot-read-uuid condition specifying the faulty
partition otherwise.
Return #t if all the statements are valid."
(define (check-root)
(let ((mount-points
(map user-partition-mount-point user-partitions)))
(or (member "/" mount-points)
(raise
(condition (&no-root-mount-point))))))
(define (check-uuid)
(let ((mount-partitions
(filter user-partition-mount-point user-partitions)))
(every
(lambda (user-partition)
(let ((file-name (user-partition-file-name user-partition))
(need-formatting?
(user-partition-need-formatting? user-partition)))
(or need-formatting?
(read-partition-uuid file-name)
(raise
(condition
(&cannot-read-uuid
(partition file-name)))))))
mount-partitions)))
(and (check-root)
(check-uuid)
#t))
(define (set-user-partitions-file-name user-partitions)
"Set the partition file-name of <user-partition> records in USER-PARTITIONS
@ -1072,6 +1128,11 @@ bit bucket."
(with-null-output-ports
(invoke "mkfs.ntfs" "-F" "-f" partition)))
(define (create-xfs-file-system partition)
"Create an XFS file-system for PARTITION file-name."
(with-null-output-ports
(invoke "mkfs.xfs" "-f" partition)))
(define (create-swap-partition partition)
"Set up swap area on PARTITION file-name."
(with-null-output-ports
@ -1116,7 +1177,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
(define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with
NEED-FORMATING? field set to #t."
NEED-FORMATTING? field set to #t."
(for-each
(lambda (user-partition)
(let* ((need-formatting?
@ -1153,6 +1214,10 @@ NEED-FORMATING? field set to #t."
(and need-formatting?
(not (eq? type 'extended))
(create-ntfs-file-system file-name)))
((xfs)
(and need-formatting?
(not (eq? type 'extended))
(create-xfs-file-system file-name)))
((swap)
(create-swap-partition file-name))
(else
@ -1303,9 +1368,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
;; <operating-system> right above.

18
gnu/installer/services.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,7 +30,6 @@
system-service-packages
desktop-system-service?
networking-system-service?
%system-services
system-services->configuration))
@ -38,7 +38,7 @@
system-service make-system-service
system-service?
(name system-service-name) ;string
(type system-service-type) ;'desktop | 'networking
(type system-service-type) ;'desktop|'networking|…
(recommended? system-service-recommended? ;Boolean
(default #f))
(snippet system-service-snippet ;list of sexps
@ -46,7 +46,6 @@
(packages system-service-packages ;list of sexps
(default '())))
;; This is the list of desktop environments supported as services.
(define %system-services
(let-syntax ((desktop-environment (syntax-rules ()
((_ fields ...)
@ -56,6 +55,7 @@
(G_ (syntax-rules () ;for xgettext
((_ str) str))))
(list
;; This is the list of desktop environments supported as services.
(desktop-environment
(name "GNOME")
(snippet '((service gnome-desktop-service-type))))
@ -118,16 +118,18 @@
(system-service
(name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management)
(snippet '((service dhcp-client-service-type)))))))
(snippet '((service dhcp-client-service-type))))
;; Dealing with documents.
(system-service
(name (G_ "CUPS printing system (no Web interface by default)"))
(type 'document)
(snippet '((service cups-service-type)))))))
(define (desktop-system-service? service)
"Return true if SERVICE is a desktop environment service."
(eq? 'desktop (system-service-type service)))
(define (networking-system-service? service)
"Return true if SERVICE is a desktop environment service."
(eq? 'networking (system-service-type service)))
(define (system-services->configuration services)
"Return the configuration field for SERVICES."
(let* ((snippets (append-map system-service-snippet services))

14
gnu/installer/steps.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,6 +20,7 @@
(define-module (gnu installer steps)
#:use-module (guix records)
#:use-module (guix build utils)
#:use-module (guix i18n)
#:use-module (gnu installer utils)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
@ -234,7 +235,7 @@ found in RESULTS."
'())))
steps))
(modules '((use-modules (gnu))
(use-service-modules desktop networking ssh xorg))))
(use-service-modules cups desktop networking ssh xorg))))
`(,@modules
()
(operating-system ,@configuration))))
@ -245,8 +246,13 @@ found in RESULTS."
(mkdir-p (dirname filename))
(call-with-output-file filename
(lambda (port)
(format port ";; This is an operating system configuration generated~%")
(format port ";; by the graphical installer.~%")
;; TRANSLATORS: This is a comment within a Scheme file. Each line must
;; start with ";; " (two semicolons and a space). Please keep line
;; length below 60 characters.
(display (G_ "\
;; This is an operating system configuration generated
;; by the graphical installer.\n")
port)
(newline port)
(for-each (lambda (part)
(if (null? part)

48
gnu/installer/tests.scm
View File

@ -37,7 +37,8 @@
enter-host-name+passwords
choose-services
choose-partitioning
conclude-installation
start-installation
complete-installation
edit-configuration-file))
@ -219,8 +220,9 @@ ROOT-PASSWORD, and USERS."
(string-contains service "NSS"))))
(choose-network-management-tool?
(lambda (service)
(string-contains service "DHCP"))))
"Converse over PORT to choose networking services."
(string-contains service "DHCP")))
(choose-other-service? (const #f)))
"Converse over PORT to choose services."
(define desktop-environments '())
(converse port
@ -239,7 +241,11 @@ ROOT-PASSWORD, and USERS."
(multiple-choices? #f)
(items ,services))
(null? desktop-environments)
(find choose-network-management-tool? services))))
(find choose-network-management-tool? services))
((checkbox-list (title "Other services") (text _)
(items ,services))
(filter choose-other-service? services))))
(define (edit-configuration-file file)
"Edit FILE, an operating system configuration file generated by the
@ -281,14 +287,19 @@ instrumented for further testing."
(define* (choose-partitioning port
#:key
(encrypted? #t)
(uefi-support? #f)
(passphrase "thepassphrase")
(edit-configuration-file
edit-configuration-file))
"Converse over PORT to choose the partitioning method. When ENCRYPTED? is
true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
When UEFI-SUPPORT? is true, assume that we are running the installation tests
on an UEFI capable machine.
This conversation stops when the user partitions have been formatted, right
before the installer generates the configuration file and shows it in a dialog
box."
box. "
(converse port
((list-selection (title "Partitioning method")
(multiple-choices? #f)
@ -306,11 +317,15 @@ box."
disks))
;; The "Partition table" dialog pops up only if there's not already a
;; partition table.
;; partition table and if the system does not support UEFI.
((list-selection (title "Partition table")
(multiple-choices? #f)
(items _))
;; When UEFI is supported, the partition is forced to GPT by the
;; installer.
(not uefi-support?)
"gpt")
((list-selection (title "Partition scheme")
(multiple-choices? #f)
(items (,one-partition _ ...)))
@ -338,10 +353,10 @@ box."
;; UUIDs before it generates the configuration file.
(values))))
(define (conclude-installation port)
"Conclude the installation by checking over PORT that we get the generated
(define (start-installation port)
"Start the installation by checking over PORT that we get the generated
configuration file, accepting it and starting the installation, and then
receiving the final messages once the 'guix system init' process has
receiving the pause message once the 'guix system init' process has
completed."
;; Assume the previous message received was 'starting-final-step'; here we
;; send the reply to that message, which lets the installer continue.
@ -355,8 +370,19 @@ completed."
(file ,configuration-file))
(edit-configuration-file configuration-file))
((pause) ;"Press Enter to continue."
#t)
((installation-complete) ;congratulations!
(values))))
(define (complete-installation port)
"Complete the installation by replying to the installer pause message and
waiting for the installation-complete message."
;; Assume the previous message received was 'pause'; here we send the reply
;; to that message, which lets the installer continue.
(write #t port)
(newline port)
(force-output port)
(converse port
((installation-complete)
(values))))
;;; Local Variables:

163
gnu/local.mk
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Mark H Weaver <mhw@netris.org>
@ -19,7 +19,7 @@
# Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
# Copyright © 2018, 2019, 2020, 2021 Oleg Pykhalov <go.wigust@gmail.com>
# Copyright © 2018 Stefan Stefanović <stefanx2ovic@gmail.com>
# Copyright © 2018, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
# Copyright © 2018, 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
# Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
# Copyright © 2019, 2020 John Soo <jsoo1@asu.edu>
# Copyright © 2019 Jonathan Brielmaier <jonathan.brielmaier@web.de>
@ -41,6 +41,10 @@
# Copyright © 2020 Vinicius Monego <monego@posteo.net>
# Copyright © 2021 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
# Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
# Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
# Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com>
# Copyright © 2021 Dmitry Polyakov <polyakov@liltechdude.xyz>
# Copyright © 2021 Andrew Tropin <andrew@trop.in>
#
# This file is part of GNU Guix.
#
@ -69,6 +73,16 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
%D%/ci.scm \
%D%/home.scm \
%D%/home-services.scm \
%D%/home-services/symlink-manager.scm \
%D%/home-services/fontutils.scm \
%D%/home-services/configuration.scm \
%D%/home-services/shells.scm \
%D%/home-services/shepherd.scm \
%D%/home-services/mcron.scm \
%D%/home-services/utils.scm \
%D%/home-services/xdg.scm \
%D%/image.scm \
%D%/packages.scm \
%D%/packages/abduco.scm \
@ -184,7 +198,6 @@ GNU_SYSTEM_MODULES = \
%D%/packages/docbook.scm \
%D%/packages/docker.scm \
%D%/packages/documentation.scm \
%D%/packages/drones.scm \
%D%/packages/dunst.scm \
%D%/packages/dvtm.scm \
%D%/packages/easyrpg.scm \
@ -296,6 +309,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/installers.scm \
%D%/packages/ipfs.scm \
%D%/packages/irc.scm \
%D%/packages/irods.scm \
%D%/packages/iso-codes.scm \
%D%/packages/jami.scm \
%D%/packages/java.scm \
@ -307,6 +321,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/jrnl.scm \
%D%/packages/jose.scm \
%D%/packages/julia.scm \
%D%/packages/julia-jll.scm \
%D%/packages/julia-xyz.scm \
%D%/packages/jupyter.scm \
%D%/packages/kawa.scm \
@ -348,6 +363,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/linux.scm \
%D%/packages/lirc.scm \
%D%/packages/lisp.scm \
%D%/packages/lisp-check.scm \
%D%/packages/lisp-xyz.scm \
%D%/packages/llvm.scm \
%D%/packages/lout.scm \
@ -378,6 +394,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/mercury.scm \
%D%/packages/mes.scm \
%D%/packages/messaging.scm \
%D%/packages/minetest.scm \
%D%/packages/mingw.scm \
%D%/packages/microcom.scm \
%D%/packages/moe.scm \
@ -420,6 +437,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/openldap.scm \
%D%/packages/openpgp.scm \
%D%/packages/openstack.scm \
%D%/packages/orange.scm \
%D%/packages/orpheus.scm \
%D%/packages/ots.scm \
%D%/packages/package-management.scm \
@ -427,6 +445,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/parallel.scm \
%D%/packages/pascal.scm \
%D%/packages/password-utils.scm \
%D%/packages/patool.scm \
%D%/packages/patchutils.scm \
%D%/packages/pciutils.scm \
%D%/packages/pcre.scm \
@ -444,6 +463,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/php.scm \
%D%/packages/piet.scm \
%D%/packages/pkg-config.scm \
%D%/packages/plan9.scm \
%D%/packages/plotutils.scm \
%D%/packages/poedit.scm \
%D%/packages/polkit.scm \
@ -471,6 +491,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/toys.scm \
%D%/packages/tryton.scm \
%D%/packages/qt.scm \
%D%/packages/racket.scm \
%D%/packages/radio.scm \
%D%/packages/ragel.scm \
%D%/packages/rails.scm \
@ -484,7 +505,9 @@ GNU_SYSTEM_MODULES = \
%D%/packages/rednotebook.scm \
%D%/packages/regex.scm \
%D%/packages/robotics.scm \
%D%/packages/rocm.scm \
%D%/packages/rpc.scm \
%D%/packages/rpm.scm \
%D%/packages/rrdtool.scm \
%D%/packages/rsync.scm \
%D%/packages/ruby.scm \
@ -550,6 +573,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/tmux.scm \
%D%/packages/tor.scm \
%D%/packages/tv.scm \
%D%/packages/uglifyjs.scm \
%D%/packages/uml.scm \
%D%/packages/unicode.scm \
%D%/packages/unrtf.scm \
@ -597,6 +621,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/base.scm \
%D%/services/certbot.scm \
%D%/services/cgit.scm \
%D%/services/ci.scm \
%D%/services/configuration.scm \
%D%/services/cuirass.scm \
%D%/services/cups.scm \
@ -656,6 +681,7 @@ GNU_SYSTEM_MODULES = \
%D%/system/mapped-devices.scm \
%D%/system/nss.scm \
%D%/system/pam.scm \
%D%/system/setuid.scm \
%D%/system/shadow.scm \
%D%/system/uuid.scm \
%D%/system/vm.scm \
@ -674,6 +700,7 @@ GNU_SYSTEM_MODULES = \
%D%/build/chromium-extension.scm \
%D%/build/cross-toolchain.scm \
%D%/build/image.scm \
%D%/build/jami-service.scm \
%D%/build/file-systems.scm \
%D%/build/hurd-boot.scm \
%D%/build/install.scm \
@ -688,6 +715,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests.scm \
%D%/tests/audio.scm \
%D%/tests/base.scm \
%D%/tests/ci.scm \
%D%/tests/cups.scm \
%D%/tests/databases.scm \
%D%/tests/desktop.scm \
@ -710,6 +738,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/security-token.scm \
%D%/tests/singularity.scm \
%D%/tests/ssh.scm \
%D%/tests/telephony.scm \
%D%/tests/version-control.scm \
%D%/tests/virtualization.scm \
%D%/tests/web.scm
@ -775,7 +804,8 @@ dist_installer_DATA = \
MODULES_NOT_COMPILED += \
%D%/build/locale.scm \
%D%/build/shepherd.scm \
%D%/build/svg.scm
%D%/build/svg.scm \
%D%/tests/data/jami-dummy-account.dat
patchdir = $(guilemoduledir)/%D%/packages/patches
dist_patch_DATA = \
@ -790,6 +820,7 @@ dist_patch_DATA = \
%D%/packages/patches/abseil-cpp-fix-gtest.patch \
%D%/packages/patches/abseil-cpp-fix-strerror_test.patch \
%D%/packages/patches/adb-add-libraries.patch \
%D%/packages/patches/adb-libssl_11-compatibility.patch \
%D%/packages/patches/aegis-constness-error.patch \
%D%/packages/patches/aegis-perl-tempdir1.patch \
%D%/packages/patches/aegis-perl-tempdir2.patch \
@ -803,15 +834,16 @@ dist_patch_DATA = \
%D%/packages/patches/akonadi-not-relocatable.patch \
%D%/packages/patches/akonadi-timestamps.patch \
%D%/packages/patches/allegro-mesa-18.2.5-and-later.patch \
%D%/packages/patches/amule-crypto-6.patch \
%D%/packages/patches/anki-mpv-args.patch \
%D%/packages/patches/antiword-CVE-2014-8123.patch \
%D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch \
%D%/packages/patches/antlr3-3_3-fix-java8-compilation.patch \
%D%/packages/patches/apr-skip-getservbyname-test.patch \
%D%/packages/patches/ark-skip-xar-test.patch \
%D%/packages/patches/aspell-default-dict-dir.patch \
%D%/packages/patches/ath9k-htc-firmware-binutils.patch \
%D%/packages/patches/ath9k-htc-firmware-gcc.patch \
%D%/packages/patches/ath9k-htc-firmware-gcc-compat.patch \
%D%/packages/patches/ath9k-htc-firmware-objcopy.patch \
%D%/packages/patches/audacity-build-with-system-portaudio.patch \
%D%/packages/patches/audacity-add-include.patch \
@ -829,6 +861,7 @@ dist_patch_DATA = \
%D%/packages/patches/audiofile-hurd.patch \
%D%/packages/patches/audiofile-function-signature.patch \
%D%/packages/patches/automake-skip-amhello-tests.patch \
%D%/packages/patches/autotrace-glib-compat.patch \
%D%/packages/patches/avahi-localstatedir.patch \
%D%/packages/patches/avidemux-install-to-lib.patch \
%D%/packages/patches/awesome-reproducible-png.patch \
@ -845,7 +878,7 @@ dist_patch_DATA = \
%D%/packages/patches/bazaar-CVE-2017-14176.patch \
%D%/packages/patches/bc-fix-cross-compilation.patch \
%D%/packages/patches/bear-disable-preinstall-tests.patch \
%D%/packages/patches/bsdiff-CVE-2014-9862.patch \
%D%/packages/patches/brightnessctl-elogind-support.patch \
%D%/packages/patches/bsd-games-2.17-64bit.patch \
%D%/packages/patches/bsd-games-add-configure-config.patch \
%D%/packages/patches/bsd-games-add-wrapper.patch \
@ -858,7 +891,6 @@ dist_patch_DATA = \
%D%/packages/patches/bsd-games-prevent-name-collisions.patch \
%D%/packages/patches/bsd-games-stdio.h.patch \
%D%/packages/patches/beancount-disable-googleapis-fonts.patch \
%D%/packages/patches/beets-werkzeug-compat.patch \
%D%/packages/patches/behave-skip-a-couple-of-tests.patch \
%D%/packages/patches/beignet-correct-file-names.patch \
%D%/packages/patches/biber-fix-encoding-write.patch \
@ -875,7 +907,6 @@ dist_patch_DATA = \
%D%/packages/patches/blender-2.79-python-3.7-fix.patch \
%D%/packages/patches/blender-2.79-python-3.8-fix.patch \
%D%/packages/patches/bpftrace-disable-bfd-disasm.patch \
%D%/packages/patches/busybox-CVE-2021-28831.patch \
%D%/packages/patches/byobu-writable-status.patch \
%D%/packages/patches/cairo-CVE-2018-19876.patch \
%D%/packages/patches/cairo-CVE-2020-35492.patch \
@ -884,6 +915,7 @@ dist_patch_DATA = \
%D%/packages/patches/calibre-remove-test-unrar.patch \
%D%/packages/patches/casync-renameat2-declaration.patch \
%D%/packages/patches/catdoc-CVE-2017-11110.patch \
%D%/packages/patches/ccache-fix-basedir-test.patch \
%D%/packages/patches/circos-remove-findbin.patch \
%D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch \
@ -916,12 +948,15 @@ dist_patch_DATA = \
%D%/packages/patches/combinatorial-blas-io-fix.patch \
%D%/packages/patches/coreutils-ls.patch \
%D%/packages/patches/cpufrequtils-fix-aclocal.patch \
%D%/packages/patches/cpuinfo-system-libraries.patch \
%D%/packages/patches/crawl-upgrade-saves.patch \
%D%/packages/patches/crda-optional-gcrypt.patch \
%D%/packages/patches/clucene-contribs-lib.patch \
%D%/packages/patches/cube-nocheck.patch \
%D%/packages/patches/cups-CVE-2020-10001.patch \
%D%/packages/patches/curl-use-ssl-cert-env.patch \
%D%/packages/patches/curl-7.76-use-ssl-cert-env.patch \
%D%/packages/patches/curl-7.77-tls-priority-string.patch \
%D%/packages/patches/cursynth-wave-rand.patch \
%D%/packages/patches/cvs-CVE-2017-12836.patch \
%D%/packages/patches/cyrus-sasl-ac-try-run-fix.patch \
@ -942,6 +977,7 @@ dist_patch_DATA = \
%D%/packages/patches/desmume-gcc7-fixes.patch \
%D%/packages/patches/dfu-programmer-fix-libusb.patch \
%D%/packages/patches/diffutils-gets-undeclared.patch \
%D%/packages/patches/disarchive-cross-compilation.patch \
%D%/packages/patches/dkimproxy-add-ipv6-support.patch \
%D%/packages/patches/docbook-xsl-nonrecursive-string-subst.patch \
%D%/packages/patches/doc++-include-directives.patch \
@ -958,6 +994,7 @@ dist_patch_DATA = \
%D%/packages/patches/ecl-16-ignore-stderr-write-error.patch \
%D%/packages/patches/ecl-16-libffi.patch \
%D%/packages/patches/efibootmgr-remove-extra-decl.patch \
%D%/packages/patches/efivar-gcc-compat.patch \
%D%/packages/patches/eigen-remove-openmp-error-counting.patch \
%D%/packages/patches/eigen-stabilise-sparseqr-test.patch \
%D%/packages/patches/einstein-build.patch \
@ -974,12 +1011,13 @@ dist_patch_DATA = \
%D%/packages/patches/emacs-hyperbole-toggle-messaging.patch \
%D%/packages/patches/emacs-libgit-use-system-libgit2.patch \
%D%/packages/patches/emacs-source-date-epoch.patch \
%D%/packages/patches/emacs-telega-patch-server-functions.patch \
%D%/packages/patches/emacs-telega-path-placeholder.patch \
%D%/packages/patches/emacs-telega-test-env.patch \
%D%/packages/patches/emacs-wordnut-require-adaptive-wrap.patch \
%D%/packages/patches/enjarify-setup-py.patch \
%D%/packages/patches/enlightenment-fix-setuid-path.patch \
%D%/packages/patches/erlang-man-path.patch \
%D%/packages/patches/esmtp-add-lesmtp.patch \
%D%/packages/patches/eudev-rules-directory.patch \
%D%/packages/patches/evilwm-lost-focus-bug.patch \
%D%/packages/patches/evolution-CVE-2020-11879.patch \
@ -1010,12 +1048,13 @@ dist_patch_DATA = \
%D%/packages/patches/foomatic-filters-CVE-2015-8327.patch \
%D%/packages/patches/foomatic-filters-CVE-2015-8560.patch \
%D%/packages/patches/fontconfig-hurd-path-max.patch \
%D%/packages/patches/fp16-system-libraries.patch \
%D%/packages/patches/fpc-reproducibility.patch \
%D%/packages/patches/fplll-std-fenv.patch \
%D%/packages/patches/freedink-engine-fix-sdl-hints.patch \
%D%/packages/patches/freebayes-devendor-deps.patch \
%D%/packages/patches/freeimage-unbundle.patch \
%D%/packages/patches/fuse-overlapping-headers.patch \
%D%/packages/patches/fxdiv-system-libraries.patch \
%D%/packages/patches/gajim-honour-GAJIM_PLUGIN_PATH.patch \
%D%/packages/patches/ganeti-deterministic-manual.patch \
%D%/packages/patches/ganeti-disable-version-symlinks.patch \
@ -1060,6 +1099,7 @@ dist_patch_DATA = \
%D%/packages/patches/gcc-7-cross-environment-variables.patch \
%D%/packages/patches/gcc-7-cross-toolexeclibdir.patch \
%D%/packages/patches/gcc-8-cross-environment-variables.patch \
%D%/packages/patches/gcc-8-sort-libtool-find-output.patch \
%D%/packages/patches/gcc-8-strmov-store-file-names.patch \
%D%/packages/patches/gcc-9-asan-fix-limits-include.patch \
%D%/packages/patches/gcc-9-strmov-store-file-names.patch \
@ -1085,7 +1125,7 @@ dist_patch_DATA = \
%D%/packages/patches/ghostscript-no-header-id.patch \
%D%/packages/patches/ghostscript-no-header-uuid.patch \
%D%/packages/patches/ghostscript-no-header-creationdate.patch \
%D%/packages/patches/gimp-make-gegl-introspect-optional.patch \
%D%/packages/patches/giara-fix-login.patch \
%D%/packages/patches/glib-appinfo-watch.patch \
%D%/packages/patches/glib-tests-timer.patch \
%D%/packages/patches/glib-CVE-2021-27218.patch \
@ -1156,21 +1196,29 @@ dist_patch_DATA = \
%D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
%D%/packages/patches/gobject-introspection-cc.patch \
%D%/packages/patches/gobject-introspection-girepository.patch \
%D%/packages/patches/go-fix-script-tests.patch \
%D%/packages/patches/go-github-com-urfave-cli-fix-tests.patch \
%D%/packages/patches/go-github-com-urfave-cli-v2-fix-tests.patch \
%D%/packages/patches/go-skip-gc-test.patch \
%D%/packages/patches/gpm-glibc-2.26.patch \
%D%/packages/patches/gpodder-disable-updater.patch \
%D%/packages/patches/gpsbabel-fix-i686-test.patch \
%D%/packages/patches/grantlee-merge-theme-dirs.patch \
%D%/packages/patches/graphviz-CVE-2020-18032.patch \
%D%/packages/patches/grep-timing-sensitive-test.patch \
%D%/packages/patches/grocsvs-dont-use-admiral.patch \
%D%/packages/patches/gromacs-tinyxml2.patch \
%D%/packages/patches/groovy-add-exceptionutilsgenerator.patch \
%D%/packages/patches/grub-cross-system-i686.patch \
%D%/packages/patches/grub-efi-fat-serial-number.patch \
%D%/packages/patches/grub-setup-root.patch \
%D%/packages/patches/grub-verifiers-Blocklist-fallout-cleanup.patch \
%D%/packages/patches/gspell-dash-test.patch \
%D%/packages/patches/gst-libav-64channels-stack-corruption.patch \
%D%/packages/patches/gst-plugins-bad-fix-overflow.patch \
%D%/packages/patches/gst-plugins-base-fix-id3v2-invalid-read.patch \
%D%/packages/patches/gst-plugins-good-fix-test.patch \
%D%/packages/patches/gst-plugins-good-CVE-2021-3497.patch \
%D%/packages/patches/gst-plugins-good-CVE-2021-3498.patch \
%D%/packages/patches/gst-plugins-ugly-fix-out-of-bound-reads.patch \
%D%/packages/patches/guile-1.8-cpp-4.5.patch \
%D%/packages/patches/guile-2.2-skip-oom-test.patch \
%D%/packages/patches/guile-2.2-skip-so-test.patch \
@ -1207,11 +1255,11 @@ dist_patch_DATA = \
%D%/packages/patches/hdf-eos5-remove-gctp.patch \
%D%/packages/patches/hdf-eos5-fix-szip.patch \
%D%/packages/patches/hdf-eos5-fortrantests.patch \
%D%/packages/patches/hexchat-add-libera-chat.patch \
%D%/packages/patches/http-parser-CVE-2020-8287.patch \
%D%/packages/patches/hubbub-sort-entities.patch \
%D%/packages/patches/hurd-cross.patch \
%D%/packages/patches/hurd-xattr.patch \
%D%/packages/patches/hplip-remove-imageprocessor.patch \
%D%/packages/patches/hydra-disable-darcs-test.patch \
%D%/packages/patches/icecat-makeicecat.patch \
%D%/packages/patches/icecat-avoid-bundled-libraries.patch \
@ -1231,11 +1279,14 @@ dist_patch_DATA = \
%D%/packages/patches/imagemagick-WriteTHUMBNAILImage-fix.patch \
%D%/packages/patches/inetutils-hurd.patch \
%D%/packages/patches/inkscape-poppler-0.76.patch \
%D%/packages/patches/instead-use-games-path.patch \
%D%/packages/patches/inkscape-1.1-fix-build-witch-gcc7.5.patch \
%D%/packages/patches/intel-xed-fix-nondeterminism.patch \
%D%/packages/patches/intltool-perl-compatibility.patch \
%D%/packages/patches/iputils-libcap-compat.patch \
%D%/packages/patches/ipxe-reproducible-geniso.patch \
%D%/packages/patches/irrlicht-use-system-libs.patch \
%D%/packages/patches/isc-dhcp-gcc-compat.patch \
%D%/packages/patches/isl-0.11.1-aarch64-support.patch \
%D%/packages/patches/json-c-0.13-CVE-2020-12762.patch \
%D%/packages/patches/json-c-0.12-CVE-2020-12762.patch \
@ -1259,15 +1310,17 @@ dist_patch_DATA = \
%D%/packages/patches/java-xerces-build_dont_unzip.patch \
%D%/packages/patches/java-xerces-xjavac_taskdef.patch \
%D%/packages/patches/jfsutils-add-sysmacros.patch \
%D%/packages/patches/jfsutils-gcc-compat.patch \
%D%/packages/patches/jfsutils-include-systypes.patch \
%D%/packages/patches/jsoncpp-fix-inverted-case.patch \
%D%/packages/patches/julia-SOURCE_DATE_EPOCH-mtime.patch \
%D%/packages/patches/julia-tracker-16-compat.patch \
%D%/packages/patches/kdbusaddons-kinit-file-name.patch \
%D%/packages/patches/libblockdev-glib-compat.patch \
%D%/packages/patches/libffi-3.3-powerpc-fixes.patch \
%D%/packages/patches/libffi-float128-powerpc64le.patch \
%D%/packages/patches/libvirt-add-install-prefix.patch \
%D%/packages/patches/libziparchive-add-includes.patch \
%D%/packages/patches/lksctp-tools-1.0.18-fix-header-file-name.patch \
%D%/packages/patches/localed-xorg-keyboard.patch \
%D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
%D%/packages/patches/kiki-level-selection-crash.patch \
@ -1314,6 +1367,7 @@ dist_patch_DATA = \
%D%/packages/patches/libbonobo-activation-test-race.patch \
%D%/packages/patches/libcaca-CVE-2021-3410-pt1.patch \
%D%/packages/patches/libcaca-CVE-2021-3410-pt2.patch \
%D%/packages/patches/libcacard-unknown-variable.patch \
%D%/packages/patches/libcanberra-sound-theme-freedesktop.patch \
%D%/packages/patches/libcanberra-wayland-crash.patch \
%D%/packages/patches/libcroco-CVE-2020-12825.patch \
@ -1323,6 +1377,7 @@ dist_patch_DATA = \
%D%/packages/patches/libgit2-mtime-0.patch \
%D%/packages/patches/libgnome-encoding.patch \
%D%/packages/patches/libgnomeui-utf8.patch \
%D%/packages/patches/libgrss-CVE-2016-2001.patch \
%D%/packages/patches/libjxr-fix-function-signature.patch \
%D%/packages/patches/libjxr-fix-typos.patch \
%D%/packages/patches/libofa-ftbfs-1.diff \
@ -1357,6 +1412,7 @@ dist_patch_DATA = \
%D%/packages/patches/libutils-remove-damaging-includes.patch \
%D%/packages/patches/libvdpau-va-gl-unbundle.patch \
%D%/packages/patches/libvpx-CVE-2016-2818.patch \
%D%/packages/patches/libxml2-xpath0-Add-option-xpath0.patch \
%D%/packages/patches/libxslt-generated-ids.patch \
%D%/packages/patches/libxt-guix-search-paths.patch \
%D%/packages/patches/lierolibre-check-unaligned-access.patch \
@ -1365,9 +1421,9 @@ dist_patch_DATA = \
%D%/packages/patches/lierolibre-remove-arch-warning.patch \
%D%/packages/patches/lierolibre-try-building-other-arch.patch \
%D%/packages/patches/linbox-fix-pkgconfig.patch \
%D%/packages/patches/linkchecker-tests-require-network.patch \
%D%/packages/patches/linphone-desktop-without-sdk.patch \
%D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
%D%/packages/patches/linux-libre-arm64-generic-pinebook-lcd.patch \
%D%/packages/patches/linux-pam-no-setfsuid.patch \
%D%/packages/patches/lirc-localstatedir.patch \
%D%/packages/patches/lirc-reproducible-build.patch \
@ -1376,6 +1432,9 @@ dist_patch_DATA = \
%D%/packages/patches/llvm-9-fix-bitcast-miscompilation.patch \
%D%/packages/patches/llvm-9-fix-lpad-miscompilation.patch \
%D%/packages/patches/llvm-9-fix-scev-miscompilation.patch \
%D%/packages/patches/llvm-roc-3.0.0-add_libraries.patch \
%D%/packages/patches/llvm-roc-4.0.0-remove-isystem-usr-include.patch \
%D%/packages/patches/llvm-roc-4.2.0-add_Object.patch \
%D%/packages/patches/lm-sensors-hwmon-attrs.patch \
%D%/packages/patches/lrcalc-includes.patch \
%D%/packages/patches/lsh-fix-x11-forwarding.patch \
@ -1388,8 +1447,9 @@ dist_patch_DATA = \
%D%/packages/patches/luajit-no_ldconfig.patch \
%D%/packages/patches/luit-posix.patch \
%D%/packages/patches/lvm2-static-link.patch \
%D%/packages/patches/mailutils-fix-uninitialized-variable.patch \
%D%/packages/patches/mailutils-variable-lookup.patch \
%D%/packages/patches/make-impure-dirs.patch \
%D%/packages/patches/marble-qt-add-qt-headers.patch \
%D%/packages/patches/mariadb-CVE-2021-27928.patch \
%D%/packages/patches/mars-install.patch \
%D%/packages/patches/mars-sfml-2.3.patch \
@ -1402,15 +1462,16 @@ dist_patch_DATA = \
%D%/packages/patches/mcrypt-CVE-2012-4527.patch \
%D%/packages/patches/libmemcached-build-with-gcc7.patch \
%D%/packages/patches/libmhash-hmac-fix-uaf.patch \
%D%/packages/patches/mercurial-hg-extension-path.patch \
%D%/packages/patches/mesa-skip-tests.patch \
%D%/packages/patches/mescc-tools-boot.patch \
%D%/packages/patches/meson-for-build-rpath.patch \
%D%/packages/patches/metabat-fix-compilation.patch \
%D%/packages/patches/mhash-keygen-test-segfault.patch \
%D%/packages/patches/minetest-add-MINETEST_MOD_PATH.patch \
%D%/packages/patches/mingw-w64-6.0.0-gcc.patch \
%D%/packages/patches/mingw-w64-dlltool-temp-prefix.patch \
%D%/packages/patches/mingw-w64-reproducible-gendef.patch \
%D%/packages/patches/minimap2-aarch64-support.patch \
%D%/packages/patches/minisat-friend-declaration.patch \
%D%/packages/patches/minisat-install.patch \
%D%/packages/patches/mit-krb5-hurd.patch \
@ -1420,6 +1481,7 @@ dist_patch_DATA = \
%D%/packages/patches/module-init-tools-moduledir.patch \
%D%/packages/patches/monero-use-system-miniupnpc.patch \
%D%/packages/patches/mono-mdoc-timestamping.patch \
%D%/packages/patches/mosaicatcher-unbundle-htslib.patch \
%D%/packages/patches/mozjs17-aarch64-support.patch \
%D%/packages/patches/mozjs24-aarch64-support.patch \
%D%/packages/patches/mozjs38-pkg-config-version.patch \
@ -1447,14 +1509,18 @@ dist_patch_DATA = \
%D%/packages/patches/netsurf-system-utf8proc.patch \
%D%/packages/patches/netsurf-y2038-tests.patch \
%D%/packages/patches/netsurf-longer-test-timeout.patch \
%D%/packages/patches/nettle-3.5-check-_pkcs1_sec_decrypt-msg-len.patch \
%D%/packages/patches/nettle-3.5-CVE-2021-3580-pt1.patch \
%D%/packages/patches/nettle-3.5-CVE-2021-3580-pt2.patch \
%D%/packages/patches/nfs4-acl-tools-0.3.7-fixpaths.patch \
%D%/packages/patches/ngircd-handle-zombies.patch \
%D%/packages/patches/network-manager-plugin-path.patch \
%D%/packages/patches/nginx-socket-cloexec.patch \
%D%/packages/patches/nnpack-system-libraries.patch \
%D%/packages/patches/nsis-env-passthru.patch \
%D%/packages/patches/nsis-source-date-epoch.patch \
%D%/packages/patches/nss-increase-test-timeout.patch \
%D%/packages/patches/nss-3.56-pkgconfig.patch \
%D%/packages/patches/ntfs-3g-CVE-2019-9755.patch \
%D%/packages/patches/nvi-assume-preserve-path.patch \
%D%/packages/patches/nvi-dbpagesize-binpower.patch \
%D%/packages/patches/nvi-db4.patch \
@ -1469,7 +1535,13 @@ dist_patch_DATA = \
%D%/packages/patches/ocaml-dose3-Fix-for-ocaml-4.06.patch \
%D%/packages/patches/ocaml-dose3-dont-make-printconf.patch \
%D%/packages/patches/ocaml-dose3-Install-mli-cmx-etc.patch \
%D%/packages/patches/ocaml-ppx-variants-ppxlib-api-change.patch \
%D%/packages/patches/omake-fix-non-determinism.patch \
%D%/packages/patches/oneko-remove-nonfree-characters.patch \
%D%/packages/patches/onnx-optimizer-system-library.patch \
%D%/packages/patches/onnx-use-system-googletest.patch \
%D%/packages/patches/onnx-shared-libraries.patch \
%D%/packages/patches/onnx-skip-model-downloads.patch \
%D%/packages/patches/openbabel-fix-crash-on-nwchem-output.patch \
%D%/packages/patches/opencascade-oce-glibc-2.26.patch \
%D%/packages/patches/opencv-fix-build-of-grfmt_jpeg2000.cpp.patch \
@ -1498,7 +1570,7 @@ dist_patch_DATA = \
%D%/packages/patches/pciutils-hurd-fix.patch \
%D%/packages/patches/plasma-framework-fix-KF5PlasmaMacros.cmake.patch \
%D%/packages/patches/ppsspp-disable-upgrade-and-gold.patch \
%D%/packages/patches/samba-fix-fcntl-hint-detection.patch \
%D%/packages/patches/pthreadpool-system-libraries.patch \
%D%/packages/patches/sdcc-disable-non-free-code.patch \
%D%/packages/patches/sdl-pango-api_additions.patch \
%D%/packages/patches/sdl-pango-blit_overflow.patch \
@ -1509,12 +1581,12 @@ dist_patch_DATA = \
%D%/packages/patches/smalltalk-multiplication-overflow.patch \
%D%/packages/patches/sqlite-hurd.patch \
%D%/packages/patches/sunxi-tools-remove-sys-io.patch \
%D%/packages/patches/patchutils-test-perms.patch \
%D%/packages/patches/patch-hurd-path-max.patch \
%D%/packages/patches/perl-autosplit-default-time.patch \
%D%/packages/patches/perl-cross.patch \
%D%/packages/patches/perl-deterministic-ordering.patch \
%D%/packages/patches/perl-finance-quote-unuse-mozilla-ca.patch \
%D%/packages/patches/perl-image-exiftool-CVE-2021-22204.patch \
%D%/packages/patches/perl-io-socket-ssl-openssl-1.0.2f-fix.patch \
%D%/packages/patches/perl-net-amazon-s3-moose-warning.patch \
%D%/packages/patches/perl-net-dns-resolver-programmable-fix.patch \
@ -1527,10 +1599,6 @@ dist_patch_DATA = \
%D%/packages/patches/picard-fix-id3-rename-test.patch \
%D%/packages/patches/picprog-non-intel-support.patch \
%D%/packages/patches/pidgin-add-search-path.patch \
%D%/packages/patches/pinball-const-fix.patch \
%D%/packages/patches/pinball-cstddef.patch \
%D%/packages/patches/pinball-missing-separators.patch \
%D%/packages/patches/pinball-src-deps.patch \
%D%/packages/patches/pinball-system-ltdl.patch \
%D%/packages/patches/pingus-boost-headers.patch \
%D%/packages/patches/pingus-sdl-libs-config.patch \
@ -1542,13 +1610,13 @@ dist_patch_DATA = \
%D%/packages/patches/plib-CVE-2011-4620.patch \
%D%/packages/patches/plib-CVE-2012-4552.patch \
%D%/packages/patches/plotutils-spline-test.patch \
%D%/packages/patches/polkit-CVE-2021-3560.patch \
%D%/packages/patches/portaudio-audacity-compat.patch \
%D%/packages/patches/portmidi-modular-build.patch \
%D%/packages/patches/postgresql-disable-resolve_symlinks.patch \
%D%/packages/patches/procmail-ambiguous-getline-debian.patch \
%D%/packages/patches/procmail-CVE-2014-3618.patch \
%D%/packages/patches/procmail-CVE-2017-16844.patch \
%D%/packages/patches/proot-test-fhs.patch \
%D%/packages/patches/psm-arch.patch \
%D%/packages/patches/psm-disable-memory-stats.patch \
%D%/packages/patches/psm-ldflags.patch \
@ -1582,6 +1650,7 @@ dist_patch_DATA = \
%D%/packages/patches/python-cross-compile.patch \
%D%/packages/patches/python2-larch-coverage-4.0a6-compatibility.patch \
%D%/packages/patches/python-configobj-setuptools.patch \
%D%/packages/patches/python-execnet-read-only-fix.patch \
%D%/packages/patches/python-flask-restful-werkzeug-compat.patch \
%D%/packages/patches/python-keras-integration-test.patch \
%D%/packages/patches/python-pep8-stdlib-tokenize-compat.patch \
@ -1589,27 +1658,32 @@ dist_patch_DATA = \
%D%/packages/patches/python-flint-includes.patch \
%D%/packages/patches/python-libxml2-utf8.patch \
%D%/packages/patches/python-matplotlib-run-under-wayland-gtk3.patch \
%D%/packages/patches/python-mediafile-wavpack.patch \
%D%/packages/patches/python-memcached-syntax-warnings.patch \
%D%/packages/patches/python-mox3-python3.6-compat.patch \
%D%/packages/patches/python-testtools.patch \
%D%/packages/patches/python-onnx-use-system-googletest.patch \
%D%/packages/patches/python-packaging-test-arch.patch \
%D%/packages/patches/python2-parameterized-docstring-test.patch \
%D%/packages/patches/python-paste-remove-timing-test.patch \
%D%/packages/patches/python-pycrypto-CVE-2013-7459.patch \
%D%/packages/patches/python-pycrypto-time-clock.patch \
%D%/packages/patches/python-pyan3-fix-absolute-path-bug.patch \
%D%/packages/patches/python-pyan3-fix-positional-arguments.patch \
%D%/packages/patches/python-pydot-regression-test.patch \
%D%/packages/patches/python2-pygobject-2-deprecation.patch \
%D%/packages/patches/python-pygpgme-fix-pinentry-tests.patch \
%D%/packages/patches/python-pytest-asyncio-python-3.8.patch \
%D%/packages/patches/python-pytorch-runpath.patch \
%D%/packages/patches/python-pytorch-system-libraries.patch \
%D%/packages/patches/python-robotframework-source-date-epoch.patch \
%D%/packages/patches/python-seaborn-kde-test.patch \
%D%/packages/patches/python2-subprocess32-disable-input-test.patch \
%D%/packages/patches/python-unittest2-python3-compat.patch \
%D%/packages/patches/python-unittest2-remove-argparse.patch \
%D%/packages/patches/python-waitress-fix-tests.patch \
%D%/packages/patches/pypy3-7.3.1-fix-tests.patch \
%D%/packages/patches/qemu-build-info-manual.patch \
%D%/packages/patches/qemu-CVE-2021-20203.patch \
%D%/packages/patches/qemu-meson-compat.patch \
%D%/packages/patches/qemu-sphinx-compat.patch \
%D%/packages/patches/qemu-glibc-2.27.patch \
%D%/packages/patches/qemu-glibc-2.30.patch \
%D%/packages/patches/qpdfview-qt515-compat.patch \
@ -1640,13 +1714,19 @@ dist_patch_DATA = \
%D%/packages/patches/ripperx-missing-file.patch \
%D%/packages/patches/rpcbind-CVE-2017-8779.patch \
%D%/packages/patches/rtags-separate-rct.patch \
%D%/packages/patches/racket-sh-via-rktio.patch \
%D%/packages/patches/racket-store-checksum-override.patch \
%D%/packages/patches/racket-minimal-backport-1629887.patch \
%D%/packages/patches/racket-minimal-sh-via-rktio.patch \
%D%/packages/patches/remake-impure-dirs.patch \
%D%/packages/patches/restic-0.9.6-fix-tests-for-go1.15.patch \
%D%/packages/patches/retroarch-LIBRETRO_DIRECTORY.patch \
%D%/packages/patches/rnp-add-version.cmake.patch \
%D%/packages/patches/rnp-disable-ruby-rnp-tests.patch \
%D%/packages/patches/rnp-unbundle-googletest.patch \
%D%/packages/patches/rocm-comgr-3.1.0-dependencies.patch \
%D%/packages/patches/rocm-opencl-runtime-3.10.0-includes.patch \
%D%/packages/patches/rocm-opencl-runtime-4.3-noclinfo.patch \
%D%/packages/patches/rocm-opencl-runtime-4.3-nocltrace.patch \
%D%/packages/patches/rocm-opencl-runtime-4.3-noopencl.patch \
%D%/packages/patches/ruby-sanitize-system-libxml.patch \
%D%/packages/patches/rust-1.19-mrustc.patch \
%D%/packages/patches/rust-1.25-accept-more-detailed-gdb-lines.patch \
@ -1655,13 +1735,15 @@ dist_patch_DATA = \
%D%/packages/patches/rust-bootstrap-stage0-test.patch \
%D%/packages/patches/rust-coresimd-doctest.patch \
%D%/packages/patches/rust-ndarray-remove-blas-src-dep.patch \
%D%/packages/patches/rust-ndarray-0.13-remove-blas-src.patch \
%D%/packages/patches/rust-nettle-disable-vendor.patch \
%D%/packages/patches/rust-nettle-sys-disable-vendor.patch \
%D%/packages/patches/rust-reproducible-builds.patch \
%D%/packages/patches/rust-openssl-sys-no-vendor.patch \
%D%/packages/patches/rxvt-unicode-escape-sequences.patch \
%D%/packages/patches/sbc-fix-build-non-x86.patch \
%D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch \
%D%/packages/patches/sbcl-clml-fix-types.patch \
%D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \
%D%/packages/patches/scalapack-blacs-mpi-deprecations.patch \
%D%/packages/patches/scheme48-tests.patch \
%D%/packages/patches/scotch-build-parallelism.patch \
@ -1683,6 +1765,7 @@ dist_patch_DATA = \
%D%/packages/patches/slim-login.patch \
%D%/packages/patches/slim-display.patch \
%D%/packages/patches/snappy-add-O2-flag-in-CmakeLists.txt.patch \
%D%/packages/patches/snappy-add-inline-for-GCC.patch \
%D%/packages/patches/sphinxbase-fix-doxygen.patch \
%D%/packages/patches/sssd-fix-samba.patch \
%D%/packages/patches/sssd-system-directories.patch \
@ -1725,18 +1808,24 @@ dist_patch_DATA = \
%D%/packages/patches/tipp10-remove-license-code.patch \
%D%/packages/patches/tipp10-qt5.patch \
%D%/packages/patches/tk-find-library.patch \
%D%/packages/patches/tla2tools-build-xml.patch \
%D%/packages/patches/tlf-support-hamlib-4.2+.patch \
%D%/packages/patches/transcode-ffmpeg.patch \
%D%/packages/patches/transmission-honor-localedir.patch \
%D%/packages/patches/transmission-remote-gtk-fix-appstream.patch \
%D%/packages/patches/ttf2eot-cstddef.patch \
%D%/packages/patches/tup-unbundle-dependencies.patch \
%D%/packages/patches/tuxpaint-stamps-path.patch \
%D%/packages/patches/twinkle-bcg729.patch \
%D%/packages/patches/u-boot-nintendo-nes-serial.patch \
%D%/packages/patches/u-boot-rockchip-inno-usb.patch \
%D%/packages/patches/u-boot-sifive-prevent-reloc-initrd-fdt.patch \
%D%/packages/patches/u-boot-riscv64-fix-extlinux.patch \
%D%/packages/patches/ucx-tcp-iface-ioctl.patch \
%D%/packages/patches/udiskie-no-appindicator.patch \
%D%/packages/patches/ungoogled-chromium-extension-search-path.patch \
%D%/packages/patches/ungoogled-chromium-ffmpeg-compat.patch \
%D%/packages/patches/ungoogled-chromium-system-nspr.patch \
%D%/packages/patches/ungoogled-chromium-system-opus.patch \
%D%/packages/patches/unison-fix-ocaml-4.08.patch \
%D%/packages/patches/unknown-horizons-python-3.8-distro.patch \
%D%/packages/patches/unzip-CVE-2014-8139.patch \
@ -1788,11 +1877,11 @@ dist_patch_DATA = \
%D%/packages/patches/vte-CVE-2012-2738-pt1.patch \
%D%/packages/patches/vte-CVE-2012-2738-pt2.patch \
%D%/packages/patches/vtk-fix-freetypetools-build-failure.patch \
%D%/packages/patches/vtk-8-fix-freetypetools-build-failure.patch \
%D%/packages/patches/warsow-qfusion-fix-bool-return-type.patch \
%D%/packages/patches/webkitgtk-share-store.patch \
%D%/packages/patches/webkitgtk-bind-all-fonts.patch \
%D%/packages/patches/websocketpp-fix-for-cmake-3.15.patch \
%D%/packages/patches/wgetpaste-update-bpaste.patch \
%D%/packages/patches/wicd-bitrate-none-fix.patch \
%D%/packages/patches/wicd-get-selected-profile-fix.patch \
%D%/packages/patches/wicd-urwid-1.3.patch \
@ -1814,18 +1903,22 @@ dist_patch_DATA = \
%D%/packages/patches/xf86-video-voodoo-pcitag.patch \
%D%/packages/patches/xfce4-panel-plugins.patch \
%D%/packages/patches/xfce4-settings-defaults.patch \
%D%/packages/patches/xgboost-use-system-dmlc-core.patch \
%D%/packages/patches/xmonad-dynamic-linking.patch \
%D%/packages/patches/xnnpack-system-libraries.patch \
%D%/packages/patches/xplanet-1.3.1-cxx11-eof.patch \
%D%/packages/patches/xplanet-1.3.1-libdisplay_DisplayOutput.cpp.patch \
%D%/packages/patches/xplanet-1.3.1-libimage_gif.c.patch \
%D%/packages/patches/xplanet-1.3.1-xpUtil-Add2017LeapSecond.cpp.patch \
%D%/packages/patches/xpra-4.0.1-systemd-run.patch \
%D%/packages/patches/xpra-4.2-systemd-run.patch \
%D%/packages/patches/xsane-fix-memory-leak.patch \
%D%/packages/patches/xsane-fix-pdf-floats.patch \
%D%/packages/patches/xsane-fix-snprintf-buffer-length.patch \
%D%/packages/patches/xsane-support-ipv6.patch \
%D%/packages/patches/xsane-tighten-default-umask.patch \
%D%/packages/patches/yggdrasil-extra-config.patch \
%D%/packages/patches/ytfzf-programs.patch \
%D%/packages/patches/ytfzf-updates.patch \
%D%/packages/patches/ytnef-CVE-2021-3403.patch \
%D%/packages/patches/ytnef-CVE-2021-3404.patch \
%D%/packages/patches/zstd-CVE-2021-24031_CVE-2021-24032.patch \

5
gnu/machine/digital-ocean.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
@ -234,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 \"/\")
@ -256,7 +257,7 @@ cat > /etc/bootstrap-config.scm << EOF
(service openssh-service-type
(openssh-configuration
(log-level 'debug)
(permit-root-login 'without-password))))
(permit-root-login 'prohibit-password))))
%base-services)))
EOF
# guix pull

41
gnu/machine/ssh.scm
View File

@ -38,6 +38,9 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module ((guix self) #:select (make-config.scm))
#:use-module ((guix inferior)
#:select (inferior-exception?
inferior-exception-arguments))
#:use-module (gcrypt pk-crypto)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@ -443,17 +446,47 @@ have you run 'guix archive --generate-key?'")
(mlet %store-monad ((_ (check-deployment-sanity machine))
(boot-parameters (machine-boot-parameters machine)))
(let* ((os (machine-operating-system machine))
(host (machine-ssh-configuration-host-name
(machine-configuration machine)))
(eval (cut machine-remote-eval machine <>))
(menu-entries (map boot-parameters->menu-entry boot-parameters))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
(lambda (exp)
(lambda (store)
(guard (condition ((inferior-exception? condition)
(values (begin handler ...) store)))
(values (run-with-store store (eval exp))
store)))))
(mbegin %store-monad
(with-roll-back #f
(switch-to-system eval os))
(switch-to-system (eval/error-handling c
(raise (formatted-message
(G_ "\
failed to switch systems while deploying '~a':~%~{~s ~}")
host
(inferior-exception-arguments c))))
os))
(with-roll-back #t
(mbegin %store-monad
(upgrade-shepherd-services eval os)
(install-bootloader eval bootloader-configuration bootcfg)))))))
(upgrade-shepherd-services (eval/error-handling c
(warning (G_ "\
an error occurred while upgrading services on '~a':~%~{~s ~}~%")
host
(inferior-exception-arguments
c)))
os)
(install-bootloader (eval/error-handling c
(raise (formatted-message
(G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
host
(inferior-exception-arguments c))))
bootloader-configuration bootcfg)))))))
;;;
@ -540,4 +573,6 @@ for environment of type '~a'")
;; Local Variables:
;; eval: (put 'remote-let 'scheme-indent-function 1)
;; eval: (put 'with-roll-back 'scheme-indent-function 1)
;; eval: (put 'eval/error-handling 'scheme-indent-function 1)
;; End:

6
gnu/packages/abiword.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -48,7 +48,7 @@
(define-public abiword
(package
(name "abiword")
(version "3.0.4")
(version "3.0.5")
(source
(origin
(method url-fetch)
@ -56,7 +56,7 @@
(string-append "https://www.abisource.com/downloads/abiword/" version
"/source/abiword-" version ".tar.gz"))
(sha256
(base32 "1mx5l716n0z5788i19qmad30cck4v9ggr071cafw2nrf375rcc79"))
(base32 "1d1179pnslijpjhz1q155fsc828rrlqf7lsn2inqsl3hk5z28mqj"))
(patches
(search-patches "abiword-explictly-cast-bools.patch"))))

40
gnu/packages/ada.scm
View File

@ -177,43 +177,3 @@ specification in our Python DSL and Langkit will generate for you an
Ada library with bindings for the C and Python programming languages.")
(home-page "https://github.com/AdaCore/langkit/")
(license license:gpl3+)))) ; and gcc runtime library exception
(define-public python2-libadalang
(let ((commit "9b205e9bacdd50a68117727332e16fbef5f6ac49")
(revision "0"))
(package
(name "python2-libadalang")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/AdaCore/libadalang")
(commit commit)))
(sha256
(base32
"06hsnzj2syqpq2yhg1bb0zil7ydbyqkdmkjbf8j9b5sdgkyh5xrp"))
(file-name (string-append name "-" version "-checkout"))))
(build-system python-build-system)
(native-inputs
`(("python2-langkit" ,python2-langkit)
("python2-quex" ,python2-quex-0.67.3)))
(arguments
`(#:python ,python-2
#:phases
(modify-phases %standard-phases
(replace 'build
(lambda _
(invoke "python2" "ada/manage.py" "generate")
(invoke "python2" "ada/manage.py" "build")))
(replace 'check
(lambda _
(invoke "python2" "ada/manage.py" "test")))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(invoke "python2" "ada/manage.py" "install" out)))))))
(synopsis "Semantic Analysis for Ada in Python")
(description "@code{libadalang} provides a high-performance semantic
engine for the Ada programming language.")
(home-page "https://github.com/AdaCore/libadalang")
(license license:gpl3)))) ; and gcc runtime gcc lib exception

554
gnu/packages/admin.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016, 2018, 2019, 2020 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020, 2021 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2015, 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
@ -17,7 +17,7 @@
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Ben Sturmfels <ben@sturm.com.au>
;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2017 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2017, 2018, 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
@ -29,7 +29,7 @@
;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019, 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021 Michael Rohleder <mike@rohleder.de>
@ -40,6 +40,10 @@
;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;; Copyright © 2021 Hyunseok Kim <lasnesne@lagunposprasihopre.org>
;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -132,11 +136,14 @@
#:use-module (gnu packages qt)
#:use-module (gnu packages readline)
#:use-module (gnu packages ruby)
#:use-module (gnu packages selinux)
#:use-module (gnu packages serialization)
#:use-module (gnu packages ssh)
#:use-module (gnu packages sphinx)
#:use-module (gnu packages tcl)
#:use-module (gnu packages terminals)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages time)
#:use-module (gnu packages tls)
#:use-module (gnu packages version-control)
#:use-module (gnu packages web)
@ -469,6 +476,34 @@ services.")
(license license:public-domain)
(home-page "https://cr.yp.to/daemontools.html")))
(define-public daemonize
(package
(name "daemonize")
(version "1.7.8")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/bmc/daemonize")
(commit (string-append "release-" version))))
(file-name (git-file-name name version))
(sha256
(base32 "0w4g0iyssyw7dd0061881z8s5czcl01mz6v00znax57zfxjqpvnm"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; No tests available.
(home-page "http://software.clapper.org/daemonize/")
(synopsis "Command line utility to run a program as a daemon")
(description
"daemonize runs a command as a Unix daemon. It will close all open file
descriptors, change working directory of the process to the root filesystem,
reset its umask, run in the background, ignore I/O signals, handle
@code{SIGCLD}, etc. Most programs that are designed to be run as daemons do
that work for themselves. However, you’ll occasionally run across one that
does not. When you must run a daemon program that does not properly make
itself into a true Unix daemon, you can use daemonize to force it to run as a
true daemon.")
(license license:bsd-3)))
(define-public dfc
(package
(name "dfc")
@ -602,7 +637,7 @@ console.")
(define-public htop
(package
(name "htop")
(version "3.0.5")
(version "3.1.0")
(source
(origin
(method git-fetch)
@ -610,7 +645,7 @@ console.")
(url "https://github.com/htop-dev/htop")
(commit version)))
(sha256
(base32 "10lp6cbfvigzp6pq5nwj3s3l4vs7cv92krz2r08nwrz8vl6rqdzp"))
(base32 "1ngvidaka6xbfb3l4zxmlksk2ms93fy3sb76w7917kjgn9mh53zz"))
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(inputs
@ -652,14 +687,13 @@ memory, disks, network and processes.")
(define-public bpytop
(package
(name "bpytop")
(version "1.0.63")
(version "1.0.67")
(source
(origin
(method url-fetch)
(uri (pypi-uri "bpytop" version))
(sha256
(base32
"0ql72s842g56rnzdqja6m53lw5y68c4gb540ihp1bjg7x9ycim11"))))
(base32 "1fwmiwvs8ax9az3hbp1p79x6m3wq73pn3vkbhcg9jvps4wv8wcwb"))))
(build-system python-build-system)
(inputs
`(("python-psutil" ,python-psutil)))
@ -674,19 +708,19 @@ memory, disks, network and processes.")
(package-version python))
"/site-packages/bpytop-themes")))
(mkdir-p themes)
(copy-recursively "bpytop-themes" themes)))))))
(copy-recursively "themes" themes)))))))
(home-page
"https://github.com/aristocratos/bpytop")
(synopsis "Resource monitor")
(description "Resource monitor that shows usage and stats for processor,
memory, disks, network and processes. It's a Python port of
memory, disks, network and processes. It's a Python port and continuation of
@command{bashtop}.")
(license license:asl2.0)))
(define-public pies
(package
(name "pies")
(version "1.5")
(version "1.6")
(source
(origin
(method url-fetch)
@ -694,7 +728,7 @@ memory, disks, network and processes. It's a Python port of
version ".tar.bz2"))
(sha256
(base32
"11j168qljsinaj5dwmg7nkm2z1aghi6gc3d0wf0pikflnh2q2wqf"))))
"0ad5bg1czwmr4qw33aszxzc6ll99a9lfs32lyfb1wl5x9s1cc7az"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
@ -791,6 +825,17 @@ hostname.")
#:phases
(modify-phases %standard-phases
,@(if (%current-target-system)
'((add-before 'configure 'set-runtime-shell
(lambda* (#:key inputs #:allow-other-keys)
(let ((shell (string-append
(assoc-ref inputs "bash")
"/bin/bash")))
(setenv "RUNTIME_SHELL" shell)
(substitute* "configure.ac"
(("\\$SHELL")
"$RUNTIME_SHELL"))))))
'())
(add-before 'build 'set-nscd-file-name
(lambda* (#:key inputs #:allow-other-keys)
;; Use the right file name for nscd.
@ -815,7 +860,10 @@ hostname.")
(inputs
`(,@(if (hurd-target?)
'()
`(("linux-pam" ,linux-pam)))))
`(("linux-pam" ,linux-pam)))
,@(if (%current-target-system)
`(("bash" ,bash-minimal))
'())))
(home-page "https://github.com/shadow-maint/shadow")
(synopsis "Authentication-related tools such as passwd, su, and login")
(description
@ -1108,7 +1156,7 @@ connection alive.")
(define-public isc-dhcp
(let* ((bind-major-version "9")
(bind-minor-version "11")
(bind-patch-version "29")
(bind-patch-version "32")
(bind-release-type "") ; for patch release, use "-P"
(bind-release-version "") ; for patch release, e.g. "6"
(bind-version (string-append bind-major-version
@ -1120,14 +1168,15 @@ connection alive.")
bind-release-version)))
(package
(name "isc-dhcp")
(version "4.4.2")
(version "4.4.2-P1")
(source (origin
(method url-fetch)
(uri (string-append "https://ftp.isc.org/isc/dhcp/"
version "/dhcp-" version ".tar.gz"))
(patches (search-patches "isc-dhcp-gcc-compat.patch"))
(sha256
(base32
"08a5003zdxgl41b29zjkxa92h2i40zyjgxg0npvnhpkfl5jcsz0s"))))
"06jsr0cg5rsmyibshrpcb9za0qgwvqccashdma7mlm1rflrh8pmh"))))
(build-system gnu-build-system)
(arguments
`(#:parallel-build? #f
@ -1199,7 +1248,11 @@ connection alive.")
"--owner=root:0"
"--group=root:0")))))
(add-after 'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)
;; TODO(core-updates): native-inputs isn't required anymore.
(lambda* (#:key ,@(if (%current-target-system)
'(native-inputs)
'())
inputs outputs #:allow-other-keys)
;; Install the dhclient script for GNU/Linux and make sure
;; if finds all the programs it needs.
(let* ((out (assoc-ref outputs "out"))
@ -1224,6 +1277,19 @@ connection alive.")
(string-append dir "/bin:"
dir "/sbin"))
(list inetutils net-tools coreutils sed))))
;; TODO(core-updates): should not be required anymore,
;; once <https://issues.guix.gnu.org/49290> has been merged.
,@(if (%current-target-system)
'((for-each
(lambda (file)
(substitute* file
(((assoc-ref native-inputs "bash"))
(assoc-ref inputs "bash"))))
(list (string-append libexec
"/dhclient-script")
(string-append libexec
"/.dhclient-script-real"))))
'())
#t))))))
(native-inputs
@ -1231,6 +1297,11 @@ connection alive.")
("file" ,file)))
(inputs `(("inetutils" ,inetutils)
;; TODO(core-updates): simply make this unconditional
,@(if (%current-target-system)
;; for wrap-program
`(("bash" ,(canonical-package bash-minimal)))
'())
,@(if (hurd-target?) '()
`(("net-tools" ,net-tools)
("iproute" ,iproute)))
@ -1245,12 +1316,12 @@ connection alive.")
"/bind-" bind-version ".tar.gz"))
(sha256
(base32
"01vvkvlhsxz4ffz2fw86z0fsf170b93jjnn5710ai6vfri8wgfy7"))))
"0hhkb4d14hvly2751cxl2s2xyim3bri8qaisgkcm456xfi5wpy6b"))))
("coreutils*" ,coreutils)
("sed*" ,sed)))
(home-page "https://www.isc.org/products/DHCP/")
(home-page "https://www.isc.org/dhcp/")
(synopsis "Dynamic Host Configuration Protocol (DHCP) tools")
(description
"ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a
@ -1259,24 +1330,64 @@ tools: server, client, and relay agent.")
(license license:mpl2.0)
(properties '((cpe-name . "dhcp"))))))
(define-public radvd
(package
(name "radvd")
(version "2.19")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/radvd-project/radvd")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1df827m3vkjq2bcs5y9wg2cygvpdwl8ppl446qqhyym584gz54nl"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("bison" ,bison)
("check" ,check)
("flex" ,flex)
("pkg-config" ,pkg-config)))
(arguments
`(#:configure-flags '("--with-check")))
(home-page "https://radvd.litech.org/")
(synopsis "IPv6 Router Advertisement Daemon")
(description
"The Router Advertisement Daemon (radvd) is run on systems acting as IPv6
routers. It sends Router Advertisement messages specified by RFC 2461
periodically and when requested by a node sending a Router Solicitation
message. These messages are required for IPv6 stateless autoconfiguration.")
(license (license:non-copyleft "file://COPYRIGHT"))))
(define-public libpcap
(package
(name "libpcap")
(version "1.10.0")
(version "1.10.1")
(source (origin
(method url-fetch)
(uri (string-append "https://www.tcpdump.org/release/libpcap-"
version ".tar.gz"))
(sha256
(base32
"07ibr6zzfh1wk5gqcbnlyh6v0dfmhpfd0fqj5y3yxvzf4ckb84ld"))))
"1m5x26vlbymp90k1qh0w3nj2nxzyvfrmfmwpj17k81dgri55ya7d"))))
(build-system gnu-build-system)
(native-inputs
`(("bison" ,bison)
("flex" ,flex)))
(arguments
;; There are some tests in testprogs/, but no automated test suite.
'(#:tests? #f))
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'omit-static-library
;; Neither build nor install libpcap.a.
(lambda _
(substitute* "Makefile.in"
((" libpcap\\.a") "")
((" install-archive ") " ")))))))
(home-page "https://www.tcpdump.org")
(synopsis "Network packet capture library")
(description
@ -1290,14 +1401,14 @@ network statistics collection, security monitoring, network debugging, etc.")
(define-public tcpdump
(package
(name "tcpdump")
(version "4.99.0")
(version "4.99.1")
(source (origin
(method url-fetch)
(uri (string-append "https://www.tcpdump.org/release/tcpdump-"
version ".tar.gz"))
(sha256
(base32
"0hmqh2fx8rgs9v1mk3vpywj61xvkifz260q685xllxr8jmxg3wlc"))))
"1ghfs5gifzrk3813zf9zalfbjs70wg6llz6q31k180r7zf2nkcvr"))))
(build-system gnu-build-system)
(inputs `(("libpcap" ,libpcap)
("openssl" ,openssl)))
@ -1559,7 +1670,7 @@ system administrator.")
(define-public sudo
(package
(name "sudo")
(version "1.9.6p1")
(version "1.9.8p2")
(source (origin
(method url-fetch)
(uri
@ -1569,12 +1680,11 @@ system administrator.")
version ".tar.gz")))
(sha256
(base32
"146alf6cwnzjcckia8m0ibcj9ram2z469f5z7v6vkzpsb30cvsd9"))
"0b8gd15l2g22w4fhhz0gzmq5c8370klanmy2c1p3px6yly6qnfwy"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "lib/zlib")
#t))))
(delete-file-recursively "lib/zlib")))))
(build-system gnu-build-system)
(outputs (list "out"))
(arguments
@ -1627,8 +1737,7 @@ system administrator.")
;; not the task of the build system, and fails.
(substitute* "plugins/sudoers/Makefile.in"
(("^pre-install:" match)
(string-append match "\ndisabled-" match)))
#t)))
(string-append match "\ndisabled-" match))))))
;; XXX: The 'testsudoers' test series expects user 'root' to exist, but
;; the chroot's /etc/passwd doesn't have it. Turn off the tests.
@ -1672,18 +1781,27 @@ commands and their arguments.")
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'configure 'pre-configure
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "GNUmakefile"
(("^\tchown.*$") ""))
;; OpenDoas look for binaries in safepath when a rule specify a
;; relative command, such as “permit keepenv :wheel cmd guix”.
(substitute* "doas.c"
(("safepath =" match)
(string-append match " \""
"/run/setuid-programs:"
"/run/current-system/profile/bin:"
"/run/current-system/profile/sbin:"
"\" ")))
#t))
(replace 'configure
;; The configure script doesn't accept most of the default flags.
(lambda* (#:key configure-flags #:allow-other-keys)
;; The configure script can be told which compiler to use only
;; through environment variables.
(setenv "CC" ,(cc-for-target))
(apply invoke "./configure" configure-flags)))
(add-before 'install 'fix-makefile
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "GNUmakefile"
(("^\tchown.*$") ""))
#t)))
(apply invoke "./configure" configure-flags))))
#:configure-flags
(list (string-append "--prefix=" (assoc-ref %outputs "out"))
"--with-timestamp")
@ -1839,7 +1957,7 @@ command.")
(package
(inherit wpa-supplicant)
(name "wpa-supplicant-gui")
(inputs `(("qtbase" ,qtbase)
(inputs `(("qtbase" ,qtbase-5)
("qtsvg" ,qtsvg)
,@(package-inputs wpa-supplicant)))
(native-inputs
@ -2027,7 +2145,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
(define-public acpica
(package
(name "acpica")
(version "20210331")
(version "20210730")
(source (origin
(method url-fetch)
(uri (string-append
@ -2035,7 +2153,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
version ".tar.gz"))
(sha256
(base32
"1h98pvc9iy1c49cid0ppjwk5zsy2m1xbvfqb72pkwkrd4rn35arx"))))
"02z0492vrpk001m7xcy72lp7sd968lja3wp6jn3q6k9nm46h4v7h"))))
(build-system gnu-build-system)
(native-inputs `(("flex" ,flex)
("bison" ,bison)))
@ -2110,7 +2228,7 @@ system is under heavy load.")
(define-public detox
(package
(name "detox")
(version "1.3.3")
(version "1.4.5")
(source (origin
(method git-fetch)
(uri (git-reference
@ -2119,21 +2237,23 @@ system is under heavy load.")
(file-name (git-file-name name version))
(sha256
(base32
"13mhs62m7bpff45liy65pajq5jg3i12jj90vwdkra94z9mlr2rlz"))))
"116bgpbkh3c96h6vq0880rmnpb5kbnnlvvkpsrcib6928bj8lfvi"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("flex" ,flex)))
(arguments
`(#:tests? #f ;no 'check' target
#:phases (modify-phases %standard-phases
`(#:phases (modify-phases %standard-phases
(add-after 'unpack 'delete-configure
;; The "configure" script is present, but otherwise the
;; project is not bootstrapped: missing install-sh and
;; Makefile.in, so delete it so the bootstrap phase will
;; take over.
(lambda _ (delete-file "configure") #t)))))
(lambda _ (delete-file "configure") #t))
(replace 'check
(lambda _
(invoke "./tests/test.sh" "src/detox"))))))
(home-page "https://github.com/dharple/detox")
(synopsis "Clean up file names")
(description
@ -2382,40 +2502,29 @@ Statsd, Librato and InfluxDB. Graphios can emit Nagios metrics to any number
of supported upstream metrics systems simultaneously.")
(license license:gpl2+)))
(define-public ansible
(define-public ansible-core
(package
(name "ansible")
(version "2.9.18")
(name "ansible-core")
(version "2.11.4")
(source
(origin
(method url-fetch)
(uri (pypi-uri "ansible" version))
(uri (pypi-uri "ansible-core" version))
(sha256
(base32 "0g6rsnh02zq5nizamgakl2wvgz7hk1lpnjn9akldrcpa55vygzjm"))))
(base32
"0jgahcv2pyc5ky0wir55a1h9q9d6rgqj60rqmvlpbj76vz1agsi2"))))
(build-system python-build-system)
(native-inputs
`(("python-bcrypt" ,python-bcrypt)
("python-pynacl" ,python-pynacl)
("python-httplib2" ,python-httplib2)
("python-passlib" ,python-passlib)
("python-nose" ,python-nose)
("python-mock" ,python-mock)
("python-jinja2" ,python-jinja2)
("python-pyyaml" ,python-pyyaml)
("python-paramiko" ,python-paramiko)))
(inputs
`(("python-cryptography" ,python-cryptography)
("python-jinja2" ,python-jinja2)
("python-pyyaml" ,python-pyyaml)
("python-paramiko" ,python-paramiko)))
(arguments
`(#:phases
`(#:modules ((guix build python-build-system)
(guix build utils)
(ice-9 ftw))
#:phases
(modify-phases %standard-phases
;; Several ansible commands (ansible-config, ansible-console, etc.)
;; are just symlinks to a single ansible executable. The ansible
;; executable behaves differently based on the value of
;; sys.argv[0]. This does not work well with our wrap phase, and
;; therefore the following two phases are required as a workaround.
;; are just symlinks to a single ansible executable. The ansible
;; executable behaves differently based on the value of sys.argv[0].
;; This does not work well with our wrap phase, and therefore the
;; following two phases are required as a workaround.
(add-after 'unpack 'hide-wrapping
(lambda _
;; Overwrite sys.argv[0] to hide the wrapper script from it.
@ -2424,27 +2533,138 @@ of supported upstream metrics systems simultaneously.")
(string-append all "
import re
sys.argv[0] = re.sub(r'\\.([^/]*)-real$', r'\\1', sys.argv[0])
")))
#t))
")))))
(add-after 'install 'replace-symlinks
(lambda* (#:key outputs #:allow-other-keys)
;; Replace symlinks with duplicate copies of the ansible
;; executable.
(let ((out (assoc-ref outputs "out")))
;; executable so that sys.argv[0] has the correct value.
(define bin (string-append (assoc-ref outputs "out") "/bin"))
(with-directory-excursion bin
(for-each
(lambda (subprogram)
(delete-file (string-append out "/bin/ansible-" subprogram))
(copy-file (string-append out "/bin/ansible")
(string-append out "/bin/ansible-" subprogram)))
(list "config" "console" "doc" "galaxy"
"inventory" "playbook" "pull" "vault")))
#t)))))
(lambda (ansible-symlink)
(delete-file ansible-symlink)
(copy-file "ansible" ansible-symlink))
(scandir "." (lambda (x)
(and (eq? 'symlink (stat:type (lstat x)))
(string-prefix? "ansible-" x)
(string=? "ansible" (readlink x)))))))))
(add-after 'unpack 'preserve-pythonpath
(lambda _
(substitute* "test/lib/ansible_test/_internal/ansible_util.py"
(("PYTHONPATH=get_ansible_python_path\\(args\\)" all)
(string-append all "+ ':' + os.environ['PYTHONPATH']")))))
(add-after 'unpack 'patch-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "lib/ansible/module_utils/compat/selinux.py"
(("libselinux.so.1" name)
(string-append (assoc-ref inputs "libselinux")
"/lib/" name)))
(substitute* "test/units/modules/test_async_wrapper.py"
(("/usr/bin/python")
(which "python")))))
(replace 'check
;; The environment for the test suite can be tricky to get right.
;; The environment used for Ansible's CI defined in the following
;; Dockerfile can be used as a reference:
;; https://raw.githubusercontent.com/ansible/
;; default-test-container/master/Dockerfile.
(lambda* (#:key inputs outputs tests? #:allow-other-keys)
(when tests?
;; Otherwise Ansible fails to create its config directory.
(setenv "HOME" "/tmp")
(setenv "PATH" (string-append (getenv "PATH") ":"
(assoc-ref outputs "out") "/bin"))
(add-installed-pythonpath inputs outputs)
;; This test module messes up with sys.path and causes many
;; test failures.
(delete-file "test/units/_vendor/test_vendor.py")
;; The test fails when run in the container, for reasons
;; unknown.
(delete-file "test/units/utils/test_display.py")
;; This test fail for reasons unknown.
(delete-file "test/units/cli/test_adhoc.py")
;; The test suite needs to be run with 'ansible-test', which
;; does some extra environment setup. Taken from
;; https://raw.githubusercontent.com/ansible/ansible/\
;; devel/test/utils/shippable/shippable.sh.
(invoke "ansible-test" "units" "-v")))))))
(native-inputs
`(("openssh" ,openssh)
("openssl" ,openssl)
("python-mock" ,python-mock)
("python-pycrypto" ,python-pycrypto)
("python-pytest" ,python-pytest)
("python-pytest-forked" ,python-pytest-forked)
("python-pytest-mock" ,python-pytest-mock)
("python-pytest-xdist" ,python-pytest-xdist)
("python-pytz" ,python-pytz)))
(inputs ;optional dependencies captured in wrap scripts
`(("libselinux" ,libselinux)
("python-paramiko" ,python-paramiko)
("python-passlib" ,python-passlib)
("python-pexpect" ,python-pexpect)
("sshpass" ,sshpass)))
(propagated-inputs ;core dependencies listed in egg-info/requires.txt
`(("python-cryptography" ,python-cryptography)
("python-jinja2" ,python-jinja2)
("python-pyyaml" ,python-pyyaml)
("python-packaging" ,python-packaging) ;for version number parsing
("python-resolvelib" ,python-resolvelib-0.5)))
(home-page "https://www.ansible.com/")
(synopsis "Radically simple IT automation")
(description "Ansible is a radically simple IT automation system. It
handles configuration management, application deployment, cloud provisioning,
ad hoc task execution, and multinode orchestration---including trivializing
things like zero-downtime rolling updates with load balancers.")
(description "Ansible aims to be a radically simple IT automation system.
It handles configuration management, application deployment, cloud
provisioning, ad-hoc task execution, network automation, and multi-node
orchestration. Ansible facilitates complex changes like zero-downtime rolling
updates with load balancers. This package is the core of Ansible, which
provides the following commands:
@itemize
@item ansible
@item ansible-config
@item ansible-connection
@item ansible-console
@item ansible-doc
@item ansible-galaxy
@item ansible-inventory
@item ansible-playbook
@item ansible-pull
@item ansible-test
@item ansible-vault
@end itemize")
(license license:gpl3+)))
(define-public ansible
(package
(name "ansible")
(version "4.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "ansible" version))
(sha256
(base32 "031n22j0lsmh69x6i6gkva81j68b4yzh1pbg3q2h4bknl85q46ag"))))
(build-system python-build-system)
(propagated-inputs
`(("ansible-core" ,ansible-core)))
;; The Ansible collections are found by ansible-core via PYTHONPATH; the
;; following search path ensures that they are found even when Python is
;; not present in the profile.
(native-search-paths
;; XXX: Attempting to use (package-native-search-paths python)
;; here would cause an error about python being an unbound
;; variable in the tests/cpan.scm test.
(list (search-path-specification
(variable "PYTHONPATH")
(files (list "lib/python3.8/site-packages")))))
(home-page "https://www.ansible.com/")
(synopsis "Radically simple IT automation")
(description "Ansible aims to be a radically simple IT automation system.
It handles configuration management, application deployment, cloud
provisioning, ad-hoc task execution, network automation, and multi-node
orchestration. Ansible facilitates complex changes like zero-downtime rolling
updates with load balancers. This package provides a curated set of
community-maintained Ansible collections, which contain playbooks, roles,
modules and plugins that extend Ansible.")
(license license:gpl3+)))
(define-public debops
@ -2803,14 +3023,14 @@ done with the @code{auditctl} utility.")
(define-public nmap
(package
(name "nmap")
(version "7.80")
(version "7.91")
(source (origin
(method url-fetch)
(uri (string-append "https://nmap.org/dist/nmap-" version
".tar.bz2"))
(sha256
(base32
"1aizfys6l9f9grm82bk878w56mg0zpkfns3spzj157h98875mypw"))
"001kb5xadqswyw966k2lqi6jr6zz605jpp9w4kmm272if184pk0q"))
(modules '((guix build utils)))
(snippet
'(begin
@ -2886,6 +3106,7 @@ tool. It is also useful for tasks such as network inventory, managing service
upgrade schedules, and monitoring host or service uptime. It also provides an
advanced netcat implementation (ncat), a utility for comparing scan
results (ndiff), and a packet generation and response analysis tool (nping).")
;; See <https://github.com/nmap/nmap/issues/2199#issuecomment-792048244>.
;; This package uses nmap's bundled versions of libdnet and liblinear, which
;; both use a 3-clause BSD license.
(license (list license:nmap license:bsd-3))))
@ -3035,7 +3256,7 @@ produce uniform output across heterogeneous networks.")
`(#:tests? #f ; no tests
#:make-flags
(list (string-append "PREFIX=" (assoc-ref %outputs "out"))
"CC=gcc")
,(string-append "CC=" (cc-for-target)))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; no configure script
@ -3305,7 +3526,7 @@ buffers.")
(define-public igt-gpu-tools
(package
(name "igt-gpu-tools")
(version "1.25")
(version "1.26")
(source
(origin
(method git-fetch)
@ -3314,7 +3535,7 @@ buffers.")
(commit (string-append "igt-gpu-tools-" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1lvhkdhilw0fn4nzkpfwvrhiv8d92h811qs2v6ac3p5w7v86a9zm"))))
(base32 "0m124pqv7zna25jnvk566c4kk628jr0w8mgnp8mr5xqz9cprgczm"))))
(build-system meson-build-system)
(arguments
`(#:tests? #f)) ; many of the tests try to load kernel modules
@ -3344,52 +3565,6 @@ Intel DRM Driver.")
(supported-systems '("i686-linux" "x86_64-linux"))
(license license:expat)))
(define-public fabric
(package
(name "fabric")
(version "1.14.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Fabric" version))
(sha256
(base32
"1a3ndlpdw6bhn8fcw1jgznl117a8pnr84az9rb5fwnrypf1ph2b6"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2 ; Python 2 only
#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(invoke
"nosetests" "-v" "tests/"
;; This test hangs indefinitely when run on a single core VM
;; (see GNU bug #26647 and Debian bug #850230).
"--exclude=test_nested_execution_with_explicit_ports"
;; This test randomly fails in certain environments causing too
;; much noise to be useful (see Debian bug #854686).
"--exclude=test_should_use_sentinel_for_tasks_that_errored"))))))
(native-inputs
`(("python2-fudge" ,python2-fudge) ; Requires < 1.0
("python2-jinja2" ,python2-jinja2) ; Requires < 3.0
("python2-nose" ,python2-nose) ; Requires < 2.0
("python2-pynacl" ,python2-pynacl)
("python2-bcrypt" ,python2-bcrypt)))
(propagated-inputs
`(("python2-paramiko" ,python2-paramiko)))
(home-page "https://www.fabfile.org/")
(synopsis "Simple Pythonic remote execution and deployment tool")
(description
"Fabric is designed to upload files and run shell commands on a number of
servers in parallel or serially. These commands are grouped in tasks (which
are regular Python functions) and specified in a @dfn{fabfile}.
It is similar to Capistrano, except it's implemented in Python and doesn't
expect you to be deploying Rails applications. Fabric is a simple, Pythonic
tool for remote execution and deployment.")
(license license:bsd-2)))
(define-public neofetch
(package
(name "neofetch")
@ -3567,14 +3742,14 @@ information tool.")
(define-public nnn
(package
(name "nnn")
(version "3.6")
(version "4.1.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/jarun/nnn/releases/download/v"
version "/nnn-v" version ".tar.gz"))
(sha256
(base32 "1dbq16cdipij5ws59ab3alfmxli7n4wx28ip7gsyq8ncxg598l47"))))
(base32 "1fnf35s3b2nfp18s712n5vhg6idx4rfgwdfv74nc2933v9l2dq7h"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)
@ -3585,33 +3760,26 @@ information tool.")
`(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure script
(add-after 'unpack 'patch-pkg-config
(lambda _
(substitute* "Makefile"
(("pkg-config")
(or (which "pkg-config")
(string-append ,(%current-target-system)
"-pkg-config"))))
#t)))
(delete 'configure)) ; no configure script
#:make-flags
(list
(string-append "PREFIX="
(assoc-ref %outputs "out"))
(string-append "CC=" ,(cc-for-target)))))
(string-append "CC=" ,(cc-for-target))
(string-append "PKG_CONFIG=" ,(pkg-config-for-target)))))
(home-page "https://github.com/jarun/nnn")
(synopsis "Terminal file browser")
(description "@command{nnn} is a fork of @command{noice}, a blazing-fast
lightweight terminal file browser with easy keyboard shortcuts for
navigation, opening files and running tasks. There is no config file and
mime associations are hard-coded. The incredible user-friendliness and speed
make it a perfect utility on modern distros.")
(description
"@command{nnn} is a fork of @command{noice}, a fast and minimal text
terminal file browser with keyboard shortcuts for navigation, opening files and
running tasks. There is no configuration file and MIME associations are
hard-coded.")
(license license:bsd-2)))
(define-public thermald
(package
(name "thermald")
(version "2.4.3")
(version "2.4.6")
(source
(origin
(method git-fetch)
@ -3620,7 +3788,7 @@ make it a perfect utility on modern distros.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1ibihgpmx038xci0k2h471scs5ssn7z5kcvjrfz63qf2ppdf9yh8"))))
(base32 "1lgaky8cmxbi17zpymy2v9wgknx1g92bq50j6kfpsm8qgb7djjb6"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@ -3634,13 +3802,7 @@ make it a perfect utility on modern distros.")
(modify-phases %standard-phases
(add-before 'bootstrap 'no-early-./configure
(lambda _
(setenv "NO_CONFIGURE" "yet")
;; XXX thd_trip_point.h redefines "__STDC_LIMIT_MACROS" after
;; <xz>/include/lzma.h. ./configure forcibly appends -Werror
;; to CXXFLAGS, overriding any -Wno-error we'd add.
(substitute* "configure.ac"
(("-Werror") ""))
#t)))))
(setenv "NO_CONFIGURE" "yet"))))))
(native-inputs
`(("autoconf" ,autoconf)
("autoconf-archive" ,autoconf-archive)
@ -3809,7 +3971,7 @@ Python loading in HPC environments.")
(let ((real-name "inxi"))
(package
(name "inxi-minimal")
(version "3.3.03-1")
(version "3.3.06-1")
(source
(origin
(method git-fetch)
@ -3818,7 +3980,7 @@ Python loading in HPC environments.")
(commit version)))
(file-name (git-file-name real-name version))
(sha256
(base32 "1pahns10i5farw47v9v8cykrk5arq8218vpsa8c0bmaia0rf2n1q"))))
(base32 "1qk40iyrdp52vmbiqwxicvlcycm2v2bf1gg4lzq0b4619sd6d1m7"))))
(build-system trivial-build-system)
(inputs
`(("bash" ,bash-minimal)
@ -4019,7 +4181,7 @@ cache of unix and unix-like systems.")
(define-public solaar
(package
(name "solaar")
(version "1.0.5")
(version "1.0.6")
(source (origin
(method git-fetch)
(uri (git-reference
@ -4028,7 +4190,7 @@ cache of unix and unix-like systems.")
(file-name (git-file-name name version))
(sha256
(base32
"17gkr2lf1kzp1198gcdr30j3c8xd81kg7ly12aar1jrgi6lc7klk"))))
"04zclzfc31l2fj5shcsngnmcvcmmhnc567l3wb9yfhs8k39k9kb2"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -4057,7 +4219,7 @@ Logitech Unifying Receiver.")
(package
(name "lynis")
;; Also update the ‘lynis-sdk’ input to the commit matching this release.
(version "3.0.3")
(version "3.0.5")
(source
(origin
(method git-fetch)
@ -4066,7 +4228,7 @@ Logitech Unifying Receiver.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "0sdjh2f1563qalp740vkaaxdxl56ny98h168cggpm10h2yq366gr"))
(base32 "11kl54hbvjl7q2i1jz8a726vlkdmknvbp4zac3j4fgljg27qp410"))
(modules '((guix build utils)))
(snippet
'(begin
@ -4083,10 +4245,10 @@ Logitech Unifying Receiver.")
(method git-fetch)
(uri (git-reference
(url "https://github.com/CISOfy/lynis-sdk")
(commit "ea7a39774fbd71113a1955cf1a4937b489935174")))
(commit "99f79c4deb4cb2221d7fccfe82baf58c0a55b9e7")))
(file-name (git-file-name "lynis-sdk" version))
(sha256
(base32 "0q5j2myshjkz9qwvcg8n7c33yw2cp80yvzhckd60qmzabv4g4qb5"))))))
(base32 "1nc2rhzj6l08d2mnjrzkm4mxla1mjkddcxl8n05c1kdz9ycn6cpl"))))))
(arguments
`(#:phases
(modify-phases %standard-phases
@ -4253,7 +4415,7 @@ file-types for easier parsing in scripts.")
(define-public jtbl
(package
(name "jtbl")
(version "1.1.6")
(version "1.1.7")
(source (origin
(method git-fetch)
(uri (git-reference
@ -4262,7 +4424,7 @@ file-types for easier parsing in scripts.")
(file-name (git-file-name name version))
(sha256
(base32
"1zzd7rd63xva50f22d1rfja4r302aizrafarhwm67vv181swvdya"))))
"19i21fqz2m40cds9pb17brjxkczqagmx2f7mfb0xdvbygaply5wz"))))
(build-system python-build-system)
(inputs
`(("python-tabulate" ,python-tabulate)))
@ -4391,14 +4553,14 @@ Netgear devices.")
(define-public atop
(package
(name "atop")
(version "2.5.0")
(version "2.6.0")
(source (origin
(method url-fetch)
(uri (string-append "https://www.atoptool.nl/download/atop-"
version ".tar.gz"))
(sha256
(base32
"0crzz4i2nabyh7d6xg7fvl65qls87nbca5ihidp3nijhrrbi14ab"))))
"0wlg0n0h9vwpjp2dcb623jvvqck422jrjpq9mbpzg4hnawxcmhly"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no test suite
@ -4590,3 +4752,49 @@ the XMODEM/YMODEM/ZMODEM file transfer protocols.")
setup, maintenance, supervision, or any long-running processes.")
(home-page "https://github.com/leahneukirchen/nq")
(license license:public-domain)))
(define-public lsofgraph
(let ((commit "1d414bdc727c00a8c6cbfffc3c43128c60d6f0de")
(revision "1"))
(package
(name "lsofgraph")
(version (git-version "0.0.1" revision commit)) ;no upstream release
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/zevv/lsofgraph")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"058x04yp6bc77hbl3qchqm7pa8f9vqfl9jryr88m8pzl7kvpif54"))))
(build-system trivial-build-system)
(inputs
`(("lua" ,lua)))
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
;; copy source
(copy-recursively (assoc-ref %build-inputs "source") ".")
;; patch-shebang phase
(setenv "PATH"
(string-append (assoc-ref %build-inputs "lua") "/bin"
":" (getenv "PATH")))
(substitute* "lsofgraph"
(("#!/usr/bin/env lua")
(string-append "#!" (which "lua"))))
;; install phase
(install-file "lsofgraph" (string-append %output "/bin"))
(let ((doc (string-append
%output "/share/doc/" ,name "-" ,version)))
(mkdir-p doc)
(install-file "LICENSE" doc)
(install-file "README.md" doc))
#t)))
(home-page "https://github.com/zevv/lsofgraph")
(synopsis "Convert @code{lsof} output to @code{graphviz}")
(description "Utility to convert @code{lsof} output to a graph showing
FIFO and UNIX interprocess communication.")
(license license:bsd-2))))

2
gnu/packages/aidc.scm
View File

@ -195,7 +195,7 @@ C/C++ programs to use its capabilities without restrictions or overhead.")
("imagemagick" ,imagemagick)
("libjpeg" ,libjpeg-turbo)
("python" ,python)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("qtx11extras" ,qtx11extras)
("v4l-utils" ,v4l-utils)))
(synopsis "Bar code reader")

145
gnu/packages/algebra.scm
View File

@ -3,11 +3,11 @@
;;; Copyright © 2013, 2015, 2017, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2014, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2018, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017–2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2019 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017, 2019, 2021 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@ -34,6 +34,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages bison)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages cpp)
@ -59,6 +60,7 @@
#:use-module (gnu packages tex)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages xiph)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (guix build-system ant)
#:use-module (guix build-system gnu)
@ -76,7 +78,7 @@
(define-public mpfrcx
(package
(name "mpfrcx")
(version "0.6")
(version "0.6.3")
(source (origin
(method url-fetch)
(uri (string-append
@ -84,7 +86,7 @@
version ".tar.gz"))
(sha256
(base32
"0gz5rma9al2jrifpknqkcnd9dkf8l05jcxy3s4ghwhd4y3h5dwia"))))
"1545vgizpypqi2rrriad0ybqv0qwbn9zr0ibxpk00gha9ihv7acx"))))
(build-system gnu-build-system)
(propagated-inputs
`(("gmp" ,gmp)
@ -235,7 +237,7 @@ the real span of the lattice.")
(define-public pari-gp
(package
(name "pari-gp")
(version "2.13.1")
(version "2.13.2")
(source (origin
(method url-fetch)
(uri (string-append
@ -243,11 +245,11 @@ the real span of the lattice.")
version ".tar.gz"))
(sha256
(base32
"1cgwdpw8b797883z9y92ixxjkv72kiy65zsw2qqf5and1kbzgv41"))))
"095s7vdlsxmxa0n0l1a082m6gjaypqfqkaj99z8j7dx0ji89hy8n"))))
(build-system gnu-build-system)
(native-inputs
`(("texlive" ,(texlive-union
(list texlive-amsfonts)))))
(list texlive-amsfonts/patched)))))
(inputs `(("gmp" ,gmp)
("libx11" ,libx11)
("perl" ,perl)
@ -341,7 +343,7 @@ precision.")
(define-public giac
(package
(name "giac")
(version "1.7.0-1")
(version "1.7.0-33")
(source
(origin
(method url-fetch)
@ -353,7 +355,7 @@ precision.")
"~parisse/debian/dists/stable/main/source/"
"giac_" version ".tar.gz"))
(sha256
(base32 "0s926aza2larfz02hrhdlpxn77yjlrhjg844b3fhwz11yj942p9q"))))
(base32 "0kz2q5vjynplbybn6j3qk11ww1dr72pqsm9gp9w2hb3h9gv4gk9w"))))
(build-system gnu-build-system)
(arguments
`(#:modules ((ice-9 ftw)
@ -366,14 +368,12 @@ precision.")
(lambda _
(substitute* (cons "micropython-1.12/xcas/Makefile"
(find-files "doc" "^Makefile"))
(("/bin/cp") (which "cp")))
#t))
(("/bin/cp") (which "cp")))))
(add-after 'unpack 'disable-failing-test
;; FIXME: Test failing. Not sure why.
(lambda _
(substitute* "check/Makefile.in"
(("chk_fhan11") ""))
#t))
(("chk_fhan11") ""))))
(add-after 'install 'fix-doc
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
@ -386,13 +386,11 @@ precision.")
;; Remove duplicate documentation in
;; "%out/share/doc/giac/", where Xcas does not expect
;; to find it.
(delete-file-recursively (string-append out "/share/doc/giac"))
#t)))
(delete-file-recursively (string-append out "/share/doc/giac")))))
(add-after 'install 'remove-unnecessary-executable
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(delete-file (string-append out "/bin/xcasnew"))
#t))))))
(delete-file (string-append out "/bin/xcasnew"))))))))
(inputs
;; TODO: Add libnauty, unbundle "libmicropython.a".
`(("fltk" ,fltk)
@ -1071,6 +1069,33 @@ features, and more.")
"# Do not build the tests for unsupported features.\n"))
#t)))))))
(define-public eigen-for-tensorflow-lite
;; This commit was taken from
;; tensorflow/lite/tools/cmake/modules/eigen.cmake
(let ((commit "d10b27fe37736d2944630ecd7557cefa95cf87c9")
(revision "1"))
(package (inherit eigen)
(name "eigen-for-tensorflow-lite")
(version (git-version "3.3.7" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/libeigen/eigen")
(commit commit)))
(sha256
(base32
"0v8a20cwvwmp3hw4275b37frw33v92z0mr8f4dn6y8k0rz92hrrf"))
(file-name (git-file-name name version))
(modules '((guix build utils)))
(snippet
;; Ther are test failures in the "unsupported" directory, but
;; maintainers say it's unsupported anyway, so just skip
;; them.
'(begin
(substitute* "unsupported/CMakeLists.txt"
(("add_subdirectory\\(test.*")
"# Do not build the tests for unsupported features.\n")))))))))
(define-public xtensor
(package
(name "xtensor")
@ -1244,6 +1269,47 @@ objects.")
;; safe side, we drop them for now.
(license license:gpl2+)))
(define-public gappa
(package
(name "gappa")
(version "1.3.5")
(source (origin
(method url-fetch)
(uri (string-append "https://gforge.inria.fr/frs/download.php/latestfile/"
"2699/gappa-" version ".tar.gz"))
(sha256
(base32
"0q1wdiwqj6fsbifaayb1zkp20bz8a1my81sqjsail577jmzwi07w"))))
(build-system gnu-build-system)
(inputs
`(("boost" ,boost)
("gmp" ,gmp)
("mpfr" ,mpfr)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-remake-shell
(lambda _
(substitute* "remake.cpp"
(("/bin/sh") (which "sh")))
#t))
(replace 'build
(lambda _ (invoke "./remake" "-s" "-d")))
(replace 'install
(lambda _ (invoke "./remake" "-s" "-d" "install")))
(replace 'check
(lambda _ (invoke "./remake" "check"))))))
(home-page "http://gappa.gforge.inria.fr/")
(synopsis "Proof generator for arithmetic properties")
(description "Gappa is a tool intended to help verifying and formally
proving properties on numerical programs dealing with floating-point or
fixed-point arithmetic. It has been used to write robust floating-point
filters for CGAL and it is used to certify elementary functions in CRlibm.
While Gappa is intended to be used directly, it can also act as a backend
prover for the Why3 software verification platform or as an automatic tactic
for the Coq proof assistant.")
(license (list license:gpl3+ license:cecill-c)))) ; either/or
(define-public givaro
(package
(name "givaro")
@ -1607,3 +1673,48 @@ no more than about 20 bits long).")
(@dfn{DCT}), Discrete Sine Transform (@dfn{DST}) and Discrete Hartley Transform
(@dfn{DHT}).")
(license license:gpl2+)))
(define-public sollya
(package
(name "sollya")
(version "7.0")
(source (origin
(method url-fetch)
(uri (string-append "https://www.sollya.org/releases/"
"sollya-" version "/sollya-" version ".tar.bz2"))
(sha256
(base32
"11290ivi9h665cxi8f1shlavhy10vzb8s28m57hrcgnxyxqmhx0m"))))
(build-system gnu-build-system)
(inputs
`(("fplll" ,fplll)
("gmp" ,gmp)
("gnuplot" ,gnuplot)
("libxml2" ,libxml2)
("mpfi" ,mpfi)
("mpfr" ,mpfr)))
(arguments
`(#:configure-flags
(list (string-append "--docdir=${datadir}/doc/sollya-" ,version))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-test-shebang
(lambda _
(substitute* (list "tests-tool/Makefile.in"
"tests-lib/Makefile.in")
(("#!/bin/sh") (string-append "#!" (which "sh"))))
#t))
(add-before 'build 'patch-gnuplot-reference
(lambda _
(substitute* "general.c"
(("\"gnuplot\"") (string-append "\"" (which "gnuplot") "\"")))
#t)))))
(home-page "https://www.sollya.org")
(synopsis "Development environment for safe floating-point code")
(description "Sollya is a computer program whose purpose is to
provide an environment for safe floating-point code development. It
is particularly targeted to the automated implementation of
mathematical floating-point libraries (libm). Amongst other features,
it offers a certified infinity norm, an automatic polynomial
implementer, and a fast Remez algorithm.")
(license license:cecill-c)))

6
gnu/packages/android.scm
View File

@ -4,12 +4,11 @@
;;; Copyright © 2016, 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019, 2020 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Sergey Trofimov <sarg@sarg.org.ru>
;;;
;;; This file is part of GNU Guix.
@ -148,6 +147,7 @@ use their packages mostly unmodified in our Android NDK build system.")
"libutils-remove-damaging-includes.patch"
"libutils-add-includes.patch"
"adb-add-libraries.patch"
"adb-libssl_11-compatibility.patch"
"libziparchive-add-includes.patch"))))
(define (android-platform-system-extras version)
@ -388,7 +388,7 @@ various Android core host applications.")
`(("android-libbase" ,android-libbase)
("android-libcutils" ,android-libcutils)
("android-liblog" ,android-liblog)
("openssl" ,openssl-1.0)))
("openssl" ,openssl)))
(home-page "https://developer.android.com/studio/command-line/adb.html")
(synopsis "Android Debug Bridge")
(description

84
gnu/packages/animation.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018–2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
;;; Copyright © 2020, 2021 Vinicius Monego <monego@posteo.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,10 +25,12 @@
#:use-module (guix git-download)
#:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages assembly)
#:use-module (gnu packages autotools)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
@ -45,6 +47,8 @@
#:use-module (gnu packages image)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages jemalloc)
#:use-module (gnu packages networking)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
@ -174,7 +178,7 @@ C++ @dfn{Standard Template Library} (STL).")
("imagemagick" ,imagemagick)
("libxml++" ,libxml++)
("libsigc++" ,libsigc++)
("mlt" ,mlt)
("mlt" ,mlt-6)
("openexr" ,openexr)
("pango" ,pango)))
(native-inputs
@ -320,6 +324,78 @@ audio or video backends, ensuring good performance.")
(home-page "https://www.gnu.org/software/gnash/")
(license license:gpl3+))))
;; This package provides a standalone (no browser plugin) version of
;; Lightspark.
(define-public lightspark
(package
(name "lightspark")
(version "0.8.5")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/lightspark/lightspark")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "00535ndzjbz5xyr95cih01wlkc2mgvg60bv6amz4lnnglk0c5v0p"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ;requires Adobe Flex SDK, see README.tests
;; Disable browser plugins because neither NPAPI nor PPAPI is
;; supported in the browsers we have.
#:configure-flags
'("-DCOMPILE_NPAPI_PLUGIN=FALSE"
"-DCOMPILE_PPAPI_PLUGIN=FALSE")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'prepare-build-environment
(lambda _
;; Use relative etc path.
(substitute* "CMakeLists.txt" (("\\/etc") "etc"))))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(invoke "./tests")))))))
(native-inputs
`(("gettext" ,gettext-minimal)
("glib:bin" ,glib "bin")
("nasm" ,nasm)
("perl" ,perl)
("pkg-config" ,pkg-config)
("python" ,python-wrapper)))
(inputs
`(("cairo" ,cairo)
("curl" ,curl)
("ffmpeg" ,ffmpeg)
("freeglut" ,freeglut)
("glew" ,glew)
("glibmm" ,glibmm)
("gnash" ,gnash)
("gnutls" ,gnutls)
("libjpeg" ,libjpeg-turbo)
("openssl" ,openssl)
("pango" ,pango)
("pcre2" ,pcre2)
("rtmpdump" ,rtmpdump)
("sdl2" ,sdl2)
("sdl2-mixer" ,sdl2-mixer)
("zlib" ,zlib)))
(home-page "https://lightspark.github.io/")
(synopsis "Flash player implementation")
(description
"Lightspark is a Flash player implementation for playing files in the SWF
format. It supports SWF files written on all versions of the ActionScript
language.")
;; NOTE: The bundled pugixml is a fork specific to Lightspark and
;; incompatible with the one we have.
;; FIXME: we also have jxrlib, but the build fails to find JXRMeta.h so we
;; use the bundled one for now.
(license (list license:lgpl3+ ;lightspark
license:mpl2.0 ;avmplus
license:bsd-2 ;jxrlib
license:expat)))) ;pugixml, PerlinNoise
(define-public papagayo
(let ((commit "e143684b30e59fe4a554f965cb655d23cbe93ee7")
(revision "1"))
@ -374,7 +450,7 @@ audio or video backends, ensuring good performance.")
qt)))
#t))))))
(inputs
`(("qt" ,qtbase)
`(("qt" ,qtbase-5)
("qtmultimedia" ,qtmultimedia)
("libsndfile" ,libsndfile)))
(native-inputs
@ -404,7 +480,7 @@ waveform until they line up with the proper sounds.")
"0b1nwiwyg01087q318vymg4si76dw41ykxbn2zwd6dqbxzbpr1dh"))))
(build-system gnu-build-system)
(inputs
`(("qtbase" ,qtbase)
`(("qtbase" ,qtbase-5)
("qtxmlpatterns" ,qtxmlpatterns)
("qtmultimedia" ,qtmultimedia)
("qtsvg" ,qtsvg)))

4
gnu/packages/antivirus.scm
View File

@ -44,14 +44,14 @@
(define-public clamav
(package
(name "clamav")
(version "0.103.2")
(version "0.103.3")
(source (origin
(method url-fetch)
(uri (string-append "https://www.clamav.net/downloads/production/"
"clamav-" version ".tar.gz"))
(sha256
(base32
"1lhv4xw89sszi519agvc9mi6jz5aiivm9yr6lciy8qk2csnd1dfl"))
"1sba4zccgwjqk29b5qkgfc9gm794hmk6j7bpj8wilgcz8hc3svlz"))
(modules '((guix build utils)))
(snippet
'(begin

21
gnu/packages/aspell.scm
View File

@ -12,6 +12,7 @@
;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Noah Landis <noahlandis@posteo.net>
;;; Copyright © 2021 Sergiu Ivanov <sivanov@colimite.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -202,10 +203,10 @@ dictionaries, including personal ones.")
(define-public aspell-dict-en
(aspell-dictionary "en" "English"
#:version "2019.10.06-0"
#:version "2020.12.07-0"
#:sha256
(base32
"1zai9wrqwgb9z9vfgb22qhrvxvg73jg0ix44j1khm2f6m96lncr4")))
"1cwzqkm8gr1w51rpckwlvb43sb0b5nbwy7s8ns5vi250515773sc")))
(define-public aspell-dict-eo
(aspell-dictionary "eo" "Esperanto"
@ -356,6 +357,14 @@ dictionaries, including personal ones.")
(base32
"137i4njvnslab6l4s291s11xijr5jsy75lbdph32f9y183lagy9m")))
(define-public aspell-dict-ro
(aspell-dictionary "ro" "Romanian"
#:version "3.3-2"
#:prefix "aspell5-"
#:sha256
(base32
"0gb8j9iy1acdl11jq76idgc2lbc1rq3w04favn8cyh55d1v8phsk")))
;;;
;;; Hunspell packages made from the Aspell word lists.
@ -388,6 +397,10 @@ dictionaries, including personal ones.")
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'make-reproducible
(lambda _
(substitute* "speller/README_en.txt.sh"
(("\\bdate\\b") ""))))
(delete 'configure)
(delete 'check)
(replace 'build
@ -476,14 +489,14 @@ under permissive licensing terms. See the 'Copyright' file."))))
(define-public ispell
(package
(name "ispell")
(version "3.4.02")
(version "3.4.04")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.cs.hmc.edu/~geoff/tars/ispell-"
version ".tar.gz"))
(sha256
(base32 "0b6rqzqjdhwf323sf1dv8qzx5pxa5asz618922r59zjp65660yb6"))))
(base32 "0gp1rwn8grkvz28wgisc2j9w9svldnaiahl3lyis118xabqddg47"))))
(build-system gnu-build-system)
(arguments
`(#:parallel-build? #f

4
gnu/packages/assembly.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
;;; Copyright © 2019 Andy Tai <atai@atai.org>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Christopher Lemmer Webber <cwebber@dustycloud.org>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2020 B. Wilson <elaexuotee@wilsonb.com>
;;;
;;; This file is part of GNU Guix.
@ -228,7 +228,7 @@ It has macro abilities and focuses on operating system portability.")
(build-system gnu-build-system)
(arguments
`(#:parallel-build? #f ; They use submakes wrong
#:make-flags (list "CC=gcc"
#:make-flags (list ,(string-append "CC=" (cc-for-target))
(string-append "PREFIX="
(assoc-ref %outputs "out")))
#:system "i686-linux" ; Standalone ld86 had problems otherwise

85
gnu/packages/astronomy.scm
View File

@ -4,7 +4,7 @@
;;; Copyright © 2018, 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 by Amar Singh <nly@disroot.org>
;;; Copyright © 2020 R Veera Kumar <vkor@vkten.in>
;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -228,7 +228,7 @@ astronomical image-processing packages like Drizzle, Swarp or SExtractor.")
(define-public gnuastro
(package
(name "gnuastro")
(version "0.14")
(version "0.15")
(source
(origin
(method url-fetch)
@ -236,7 +236,7 @@ astronomical image-processing packages like Drizzle, Swarp or SExtractor.")
version ".tar.lz"))
(sha256
(base32
"1xp6n42qxv0x6yigi2w2l5k8006smv27lhrcssysgsvzbydghzg5"))))
"1jjr3ixxbpsr5m4s7ahh12ymcnlvjzwcp02ya16b1lvzrz1wmhy4"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--disable-static")))
@ -401,7 +401,7 @@ deconvolution). Such post-processing is not performed by Stackistry.")
(define-public stellarium
(package
(name "stellarium")
(version "0.21.0")
(version "0.21.1")
(source
(origin
(method url-fetch)
@ -409,10 +409,10 @@ deconvolution). Such post-processing is not performed by Stackistry.")
"/releases/download/v" version
"/stellarium-" version ".tar.gz"))
(sha256
(base32 "04vg2asj9gygwnrs32scqc8192ln2lyqa9v7cjqk8zd4frkwszwp"))))
(base32 "049jlc8vx06pad5h2syrmf7f1l346yr5iraai0wkn8s8pk30j8q7"))))
(build-system cmake-build-system)
(inputs
`(("qtbase" ,qtbase)
`(("qtbase" ,qtbase-5)
("qtlocation" ,qtlocation)
("qtmultimedia" ,qtmultimedia)
("qtscript" ,qtscript)
@ -421,7 +421,7 @@ deconvolution). Such post-processing is not performed by Stackistry.")
(native-inputs
`(("gettext" ,gettext-minimal) ; xgettext is used at compile time
("perl" ,perl) ; for pod2man
("qtbase" ,qtbase) ; Qt MOC is needed at compile time
("qtbase" ,qtbase-5) ; Qt MOC is needed at compile time
("qttools" ,qttools)))
(arguments
`(#:test-target "test"
@ -792,10 +792,43 @@ provide you with detailed information about each pass.")
(home-page "http://gpredict.oz9aec.net/index.php")
(license license:gpl2+)))
(define-public sgp4
;; No tagged releases, use commit directly.
(let ((commit "ca9d4d97af4ee62461de6f13e0c85d1dc6000040")
(revision "1"))
(package
(name "sgp4")
(version (git-version "0.0.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/dnwrnr/sgp4")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "1xwfa6papmd2qz5w0hwzvijmzvp9np8dlw3q3qz4bmsippzjv8p7"))))
(build-system cmake-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
;; Tests fails, probably because of a few "(e <= -0.001)" errors.
;; Or maybe this is not the right way to run the tests?
;; (invoke "runtest/runtest")
#t)))))
(home-page "https://github.com/dnwrnr/sgp4")
(synopsis "Simplified perturbations models library")
(description
"This is a library implementing the simplified perturbations model.
It can be used to calculate the trajectory of satellites.")
(license license:asl2.0))))
(define-public indi
(package
(name "indi")
(version "1.8.9")
(version "1.9.1")
(source
(origin
(method git-fetch)
@ -804,7 +837,7 @@ provide you with detailed information about each pass.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "0nw4b2cdsg244slcm3yf1v11jlxbbjrpvi6ax90svs7rlandz8jv"))))
(base32 "0zhsm60hgnmy9lvwckijf6f6yikbvdbxy2qlgclv09p14lgr6wd9"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags
@ -816,17 +849,15 @@ provide you with detailed information about each pass.")
(string-append "-DUDEVRULES_INSTALL_DIR=" out "/lib/udev/rules.d")))
#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(chdir "test")
(invoke "ctest")
(chdir "..")
#t))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(with-directory-excursion "test"
(invoke "ctest")))))
(add-before 'install 'set-install-directories
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(mkdir-p (string-append out "/lib/udev/rules.d")))
#t)))))
(mkdir-p (string-append out "/lib/udev/rules.d"))))))))
(native-inputs
`(("googletest" ,googletest)))
(inputs
@ -887,13 +918,13 @@ JPL ephemerides use to predict raw (x,y,z) planetary positions.")
(define-public python-pyerfa
(package
(name "python-pyerfa")
(version "1.7.2")
(version "1.7.3")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pyerfa" version))
(sha256
(base32 "1s78mdyrxha2jcckfs0wg5ynkf0pwh1bw9mmh99vprinxh9n4xri"))
(base32 "1jqqrxvrgly4r0br5f6dsy8nab2xmhz915vp6md5f31ysr2sdwvc"))
(modules '((guix build utils)))
(snippet
'(begin
@ -953,13 +984,13 @@ of stand-alone functions and classes.")
(define-public python-asdf
(package
(name "python-asdf")
(version "2.7.2")
(version "2.7.4")
(source
(origin
(method url-fetch)
(uri (pypi-uri "asdf" version))
(sha256
(base32 "1y47zhkd90i8wmm2i35amfl0rvjqlb3fcx90xp7n9kr2z0byzyzg"))))
(base32 "1mj52l2m8pbhiqacgjakjpvqi8kyx470yw151lcsswbq5wp0rsc6"))))
(build-system python-build-system)
(arguments
;; TODO: (Sharlatan-20210207T165820+0000): Tests depend on astropy, astropy
@ -1011,23 +1042,23 @@ astronomical images, especially when there is no WCS information available.")
(define-public python-skyfield
(package
(name "python-skyfield")
(version "1.38")
(version "1.39")
(source
(origin
(method url-fetch)
(uri (pypi-uri "skyfield" version))
(sha256
(base32 "1qi1l8qn6irdv6w41qq30s2yjwak7h6ayywr1pry9gwcm2c25bv5"))))
(base32 "1qh3k7g9dm6idppk87hnwxpx9a22xx98vav0zk31p6291drak3as"))))
(build-system python-build-system)
(arguments
;; NOTE: (Sharlatan-20210207T163305+0000): tests depend on custom test
;; framework https://github.com/brandon-rhodes/assay
`(#:tests? #f))
(inputs
`(("certifi" ,python-certifi)
("jplephem" ,python-jplephem)
("numpy" ,python-numpy)
("sgp4" ,python-sgp4)))
`(("python-certifi" ,python-certifi)
("python-jplephem" ,python-jplephem)
("python-numpy" ,python-numpy)
("python-sgp4" ,python-sgp4)))
(home-page "https://rhodesmill.org/skyfield/")
(synopsis "Astronomy for Python")
(description

306
gnu/packages/audio.scm
View File

@ -21,18 +21,18 @@
;;; Copyright © 2019, 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2019, 2021 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019, 2021 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Alexandros Theodotou <alex@zrythm.org>
;;; Copyright © 2019 Christopher Lemmer Webber <cwebber@dustycloud.org>
;;; Copyright © 2019 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2019 Jan Wielkiewicz <tona_kosmicznego_smiecia@interia.pl>
;;; Copyright © 2019 Hartmt Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2019, 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2020 Jonathan Frederickson <jonathan@terracrypt.net>
;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
;;; Copyright © 2020, 2021 Vinicius Monego <monego@posteo.net>
;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
;;;
;;; This file is part of GNU Guix.
@ -78,12 +78,14 @@
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnunet) ; libmicrohttpd
#:use-module (gnu packages gperf)
#:use-module (gnu packages groff)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages image)
#:use-module (gnu packages libbsd)
#:use-module (gnu packages libffi)
#:use-module (gnu packages libusb)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
@ -107,6 +109,7 @@
#:use-module (gnu packages serialization)
#:use-module (gnu packages telephony)
#:use-module (gnu packages linphone)
#:use-module (gnu packages linux)
#:use-module (gnu packages tls)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages video)
@ -302,7 +305,7 @@ Linux kernel.")
(define-public libopenmpt
(package
(name "libopenmpt")
(version "0.5.4")
(version "0.5.9")
(source
(origin
(method url-fetch)
@ -310,7 +313,7 @@ Linux kernel.")
(string-append "https://download.openmpt.org/archive/libopenmpt/src/"
"libopenmpt-" version "+release.autotools.tar.gz"))
(sha256
(base32 "0h7gpjx1221jwsq3k91p8zhf1h77qaxyasakc88s3g57vawhckgk"))))
(base32 "0h86p8mnpm98vc4v6jbvrmm02fch7dnn332i26fg3a2s1738m04d"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@ -407,7 +410,7 @@ by MusicIP.")
(define-public libtimidity
(package
(name "libtimidity")
(version "0.2.6")
(version "0.2.7")
(source
(origin
(method url-fetch)
@ -415,7 +418,7 @@ by MusicIP.")
(string-append "https://sourceforge.net/projects/" name "/files/"
name "/" version "/" name "-" version ".tar.gz"))
(sha256
(base32 "0p2px0m907gi1zpdr0l9adq25jl89j85c11ag9s2g4yc6n1nhgfm"))))
(base32 "0sif6lxa058b1mg19zwjm8rl2sg8cg0443k4dgi65clz0jy7qi16"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f)) ; XXX: LibTiMidity could not be initialised
@ -495,7 +498,7 @@ implementation of Adaptive Multi Rate Narrowband and Wideband
("jack" ,jack-1)
("ladspa" ,ladspa)
("liblo" ,liblo)
("qtbase" ,qtbase)))
("qtbase" ,qtbase-5)))
(native-inputs
`(("pkg-config" ,pkg-config)
("qttools" ,qttools)))
@ -568,7 +571,7 @@ streams from live audio.")
(define-public ardour
(package
(name "ardour")
(version "6.6")
(version "6.8")
(source (origin
(method git-fetch)
(uri (git-reference
@ -586,7 +589,7 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
#t)))
(sha256
(base32
"0k5rxh8b3d8si3lj01gfqj0pmd448d8sj4asnb205mwhwbfgn0cp"))
"16x7bkzbrk0rgywq5vrkhf2z3jj08jw1bvaq9vwlf2b4h4sd7i4s"))
(file-name (string-append name "-" version))))
(build-system waf-build-system)
(arguments
@ -981,21 +984,18 @@ tools (analyzer, mono/stereo tools, crossovers).")
(define-public caps-plugins-lv2
(package
(name "caps-plugins-lv2")
(version "0.9.24") ; version that has been ported.
(version "0.9.26")
(source
(origin
;; The Github project hasn't tagged a release.
(method git-fetch)
(uri (git-reference
;; Actually https://github.com/moddevices/caps-lv2.git, but it's
;; missing fixes for newer glibc, so using the origin of a pull
;; request regarding this issue:
(url "https://github.com/jujudusud/caps-lv2")
(commit "9c9478b7fbd8f9714f552ebe2a6866398b0babfb")))
(url "https://github.com/moddevices/caps-lv2.git")
(commit "5d52a0c6e8863c058c2aab2dea9f901a90d96eb9")))
(file-name (git-file-name name version))
(sha256
(base32
"1idfnazin3cca41zw1a8vwgnxjnkrap7bxxjamjqvgpmvydgcam1"))))
"0hdl7n3ra5gqgwkdfqkw8dj9gb1cgb76bn1v91w06d2w4lj9s8xa"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no check target
@ -1022,7 +1022,7 @@ generators of mostly elementary and occasionally exotic nature.")
(define-public infamous-plugins
(package
(name "infamous-plugins")
(version "0.2.04")
(version "0.3.0")
(source (origin
(method git-fetch)
(uri (git-reference
@ -1031,7 +1031,7 @@ generators of mostly elementary and occasionally exotic nature.")
(file-name (git-file-name name version))
(sha256
(base32
"0hmqk80w4qxq09iag7b7srf2g0wigkyhzq0ywxvhz2iz0hq9k0dh"))))
"1r72agk5nxf5k0mghcc2j90z43j5d9i7rqjmf49jfyqnd443isip"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; there are no tests
@ -1041,6 +1041,12 @@ generators of mostly elementary and occasionally exotic nature.")
(lambda _
(substitute* (find-files "." "CMakeLists.txt")
(("-msse2 -mfpmath=sse") ""))
#t))
(add-after 'unpack 'fix-build-with-newer-lv2
(lambda _
;; https://github.com/ssj71/infamousPlugins/commit/4c7275b1fa8ea3296446421cbd29ec2df66588c0
(substitute* (find-files "src" ".*\\.cxx")
(("_LV2UI_Descriptor") "LV2UI_Descriptor"))
#t)))))
(inputs
`(("cairo" ,cairo)
@ -2141,7 +2147,7 @@ synchronous execution of all clients, and low latency operation.")
("gtk2" ,gtk+-2)
("gtk3" ,gtk+)
("gtkmm" ,gtkmm-2)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("jack" ,jack-1)))
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -2339,6 +2345,18 @@ implementation of the Open Sound Control (@dfn{OSC}) protocol.")
(sha256
(base32 "156c2dgh6jrsyfn1y89nslvaxm4yifmxridsb708yvkaym02w2l8"))))
(build-system cmake-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
;; The header that pkg-config expects is include/rtaudio/RtAudio.h,
;; but this package installs it as include/RtAudio.h by default.
(add-after 'install 'fix-inc-path
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(inc (string-append out "/include")))
(mkdir-p (string-append inc "/rtaudio"))
(rename-file (string-append inc "/RtAudio.h")
(string-append inc "/rtaudio/RtAudio.h"))))))))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
@ -2419,6 +2437,99 @@ included are the command line utilities @code{send_osc} and @code{dump_osc}.")
(define-public python2-pyliblo
(package-with-python2 python-pyliblo))
(define-public python-soundfile
(package
(name "python-soundfile")
(version "0.10.3.post1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "SoundFile" version))
(sha256
(base32
"0yqhrfz7xkvqrwdxdx2ydy4h467sk7z3gf984y1x2cq7cm1gy329"))))
(build-system python-build-system)
(propagated-inputs
`(("python-cffi" ,python-cffi)
("python-numpy" ,python-numpy)
("libsndfile" ,libsndfile)))
(native-inputs
`(("python-pytest" ,python-pytest)))
(arguments
`(#:tests? #f ; missing OGG support
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "soundfile.py"
(("_find_library\\('sndfile'\\)")
(string-append "\"" (assoc-ref inputs "libsndfile")
"/lib/libsndfile.so\""))))))))
(home-page "https://github.com/bastibe/SoundFile")
(synopsis "Python bindings for libsndfile")
(description "This package provides python bindings for libsndfile based on
CFFI and NumPy.")
(license license:expat)))
(define-public python-python3-midi
(package
(name "python-python3-midi")
(version "0.2.5")
(source
(origin
(method url-fetch)
(uri (pypi-uri "python3_midi" version))
(sha256
(base32
"1z9j1w7mpn3xhkcpxmqm5rvmj6nffb5rf14bv7n3sdh07nf6n7sf"))))
(build-system python-build-system)
(home-page "https://github.com/NFJones/python3-midi")
(synopsis "Python MIDI API")
(description "This package provides a python API to read and write MIDI
files.")
(license license:expat)))
(define-public audio-to-midi
(package
(name "audio-to-midi")
(version "2020.7")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/NFJones/audio-to-midi")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"12wf17abn3psbsg2r2lk0xdnk8n5cd5rrvjlpxjnjfhd09n7qqgm"))))
(build-system python-build-system)
(propagated-inputs
`(("python-cffi" ,python-cffi)
("python-cython" ,python-cython)
("python-numpy" ,python-numpy)
("python-progressbar2" ,python-progressbar2)
("python-pycparser" ,python-pycparser)
("python-python3-midi" ,python-python3-midi)
("python-soundfile" ,python-soundfile)))
(native-inputs
`(("libsndfile" ,libsndfile)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-versions
(lambda _
(substitute* "requirements.txt" (("==") ">=")))))))
(home-page "https://github.com/NFJones/audio-to-midi")
(synopsis "Convert audio to multichannel MIDI.")
(description "@command{audio-to-midi} converts audio files to multichannel
MIDI files. It accomplishes this by performing FFTs on all channels of the
audio data at user-specified time steps. It then separates the resulting
frequency analysis into equivalence classes which correspond to the twelve tone
scale; the volume of each class being the average volume of its constituent
frequencies. This data is then formatted to MIDI and written to disk.")
(license license:expat)))
(define-public lilv
(package
(name "lilv")
@ -2718,22 +2829,22 @@ different audio devices such as ALSA or PulseAudio.")
(define-public qjackctl
(package
(name "qjackctl")
(version "0.9.1")
(version "0.9.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/qjackctl/qjackctl/"
version "/qjackctl-" version ".tar.gz"))
(sha256
(base32
"0m72kglwwvn91dxnka4lx765p3r0bcpqw251svymxr2wxjc4rgjg"))))
(build-system gnu-build-system)
"186rg3j67rac9ds1r7gnrib2d0smgv15cmr5gwb7v83mywcp1gzy"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f)) ; no check target
(inputs
`(("jack" ,jack-1)
("alsa-lib" ,alsa-lib)
("portaudio" ,portaudio)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("qtx11extras" ,qtx11extras)))
(native-inputs
`(("pkg-config" ,pkg-config)
@ -2767,11 +2878,11 @@ into various outputs and to start, stop and configure jackd")
(string-append "PREFIX="
(assoc-ref outputs "out"))))))))
(native-inputs
`(("qtbase" ,qtbase))) ; for qmake
`(("qtbase" ,qtbase-5))) ; for qmake
(inputs
`(("jack" ,jack-1)
("libsndfile" ,libsndfile)
("qtbase" ,qtbase)))
("qtbase" ,qtbase-5)))
(home-page "https://sourceforge.net/projects/qjackrcd/")
(synopsis "Stereo audio recorder for JACK")
(description "QJackRcd is a simple graphical stereo recorder for JACK
@ -2880,7 +2991,7 @@ link REQUIRED)"))
("boost" ,boost)
("boost-sync" ,boost-sync)
("yaml-cpp" ,yaml-cpp)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("qtdeclarative" ,qtdeclarative)
("qtsvg" ,qtsvg)
("qtwebchannel" ,qtwebchannel)
@ -3082,7 +3193,7 @@ the Turtle syntax.")
`(("lv2" ,lv2)
("gtk+" ,gtk+-2)
("gtk+" ,gtk+)
("qt" ,qtbase)))
("qt" ,qtbase-5)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "https://drobilla.net/software/suil/")
@ -3558,7 +3669,7 @@ interface.")
("pkg-config" ,pkg-config)))
(inputs
`(("fluidsynth" ,fluidsynth)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("qtx11extras" ,qtx11extras)))
(home-page "https://qsynth.sourceforge.io")
(synopsis "Graphical user interface for FluidSynth")
@ -4314,7 +4425,7 @@ representations.")
(define-public cava
(package
(name "cava")
(version "0.7.3")
(version "0.7.4")
(source (origin
(method git-fetch)
(uri (git-reference
@ -4323,7 +4434,7 @@ representations.")
(file-name (git-file-name name version))
(sha256
(base32
"04j5hb29hivcbk542sfsx9m57dbnj2s6qpvy9fs488zvgjbgxrai"))))
"1mziklmqifhnb4kg9ia2r56r8wjn6xp40bkpf484hsgqvnrccl86"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)
@ -4466,7 +4577,7 @@ library.")
(define-public faudio
(package
(name "faudio")
(version "21.04")
(version "21.09")
(source
(origin
(method git-fetch)
@ -4475,7 +4586,7 @@ library.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "1g3zp7igh4ns31sqnxddxqhgibijngkbcqqsj23i9d1lah6k4747"))))
(base32 "0411fj5b9gvjz1z1gpvy07hkm7rz2nmwggw2v3hbn7ran7w3w5zy"))))
(arguments
'(#:tests? #f ; No tests.
#:configure-flags '("-DGSTREAMER=ON")))
@ -4734,7 +4845,7 @@ as is the case with audio plugins.")
;; (ModuleNotFoundError: No module named 'PyQt5')
("python-wrapper" ,python-wrapper)
("libx11" ,libx11)
("qtbase" ,qtbase)
("qtbase" ,qtbase-5)
("zlib" ,zlib)
;; For WRAP-SCRIPT above.
@ -4801,7 +4912,7 @@ in the package.")
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.zrythm.org/git/libaudec")
(url "https://git.zrythm.org/zrythm/libaudec")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
@ -4822,7 +4933,7 @@ in the package.")
(description "libaudec is a wrapper library over ffmpeg, sndfile and
libsamplerate for reading and resampling audio files, based on Robin Gareus'
@code{audio_decoder} code.")
(home-page "https://git.zrythm.org/cgit/libaudec")
(home-page "https://git.zrythm.org/zrythm/libaudec")
(license license:agpl3+)))
(define-public lv2lint
@ -4901,7 +5012,7 @@ with the provided metadata and adhere to well-known best practices.")
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.zrythm.org/git/ztoolkit")
(url "https://git.zrythm.org/zrythm/ztoolkit")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
@ -4922,7 +5033,7 @@ the user and provides a high-level API for managing the UI and custom
widgets. ZToolkit is written in C and was created to be used for building
audio plugin UIs, where the dependencies often need to be kept to a
minimum.")
(home-page "https://git.zrythm.org/cgit/ztoolkit/")
(home-page "https://git.zrythm.org/zrythm/ztoolkit")
(license license:agpl3+)))
(define-public libinstpatch
@ -5036,6 +5147,32 @@ digital radio.")
(home-page "https://www.rowetel.com/?page_id=452")
(license license:lgpl2.1)))
(define-public mbelib
;; No release since 2016, use commit directly.
(let ((commit "9a04ed5c78176a9965f3d43f7aa1b1f5330e771f")
(revision "1"))
(package
(name "mbelib")
(version (git-version "1.3.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/szechyjs/mbelib")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "0a7xmf87xnjzm5b437j2vnwv39x0ascja1j04c5wj6xs1529gw8h"))))
(build-system cmake-build-system)
(home-page "https://github.com/szechyjs/mbelib")
(synopsis "P25 Phase 1 and ProVoice vocoder")
(description
"The mbelib library provides support for the 7200x4400 bit/s codec used
in P25 Phase 1, the 7100x4400 bit/s codec used in ProVoice and the @emph{Half
Rate} 3600x2250 bit/s vocoder used in various radio systems.")
(license (list license:bsd-3 ; test/ framework
license:isc))))) ; the rest
(define-public ableton-link
(package
(name "ableton-link")
@ -5067,7 +5204,7 @@ digital radio.")
`(("catch" ,catch-framework)
("python" ,python) ;for running tests
("portaudio" ,portaudio) ;for portaudio examples
("qtbase" ,qtbase) ;for Qt examples
("qtbase" ,qtbase-5) ;for Qt examples
("qtdeclarative" ,qtdeclarative)
("qttools" ,qttools)))
(inputs
@ -5140,14 +5277,18 @@ while still staying in time.")
(define-public butt
(package
(name "butt")
(version "0.1.29")
(version "0.1.31")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/butt/butt/butt-"
version "/butt-" version ".tar.gz"))
(sha256
(base32
"0nbz0z4d7krvhmnwn10594gwc61gn2dlb5fazmynjfisrfdswqlg"))))
"19zvdi5vr6vqnrpc60jir7550nz9a5x1c61lh13355cdny2zp28z"))
(modules '((guix build utils)))
(snippet
'(substitute* "src/butt.cpp"
((".*zica.*") "")))))
(build-system gnu-build-system)
(arguments
`(#:phases
@ -5184,9 +5325,88 @@ while still staying in time.")
version "_manual.pdf"))
(sha256
(base32
"1hhgdhdg5s86hjcbwh856gcd3kcch0i5xgi3i3v02zz3xmzl7gg3"))))))
"0a0kgd069whfp1v8xgw6qm67w02n8b7b4h5ay5665wgq947hxanp"))))))
(home-page "https://danielnoethen.de/butt/")
(synopsis "Audio streaming tool")
(description "Butt is a tool to stream audio to a ShoutCast or
Icecast server.")
(license license:gpl2+)))
(define-public siggen
(package
(name "siggen")
(version "2.3.10")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/bleskodev/siggen")
(commit "a407611b59d59c7770bbe62ba9b8e9a948cf3210")))
(file-name (git-file-name name version))
(sha256
(base32
"0szhgfd9kddr6qsz0imp0x66jjn6ry236f35vjl82ivc1v2bllcb"))))
(build-system gnu-build-system)
(arguments
`(#:make-flags (list (string-append "INSDIR=" %output "/bin")
(string-append "MANDIR=" %output "/share/man"))
#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
;; Patch misc.c to prevent a segfault.
(add-after 'unpack 'patch-segfault
(lambda _
(substitute* "misc.c"
(("#include <stdio.h>\n" all)
(string-append all "#include <string.h>\n")))))
(delete 'configure)
(replace 'install
(lambda* (#:key make-flags outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(for-each (lambda (dir)
(mkdir-p (string-append out dir)))
(list "/bin" "/share/man/man1" "/share/man/man5"))
(apply invoke "make" "sysinstall" make-flags)))))))
(inputs
`(("ncurses" ,ncurses)))
(native-inputs
`(("groff" ,groff-minimal) ; for nroff
("util-linux" ,util-linux))) ; for col
(home-page "https://github.com/bleskodev/siggen")
(synopsis "Signal generation tools")
(description "siggen is a set of tools for imitating a laboratory signal
generator, generating audio signals out of Linux's /dev/dsp audio
device. There is support for mono and/or stereo and 8 or 16 bit samples.")
(license license:gpl2)))
(define-public mda-lv2
(package
(name "mda-lv2")
(version "1.2.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://download.drobilla.net/mda-lv2-"
version ".tar.bz2"))
(sha256
(base32 "1nspk2j11l65m5r9z5isw8j749vh9a89wgx8mkrrq15f4iq12rnd"))))
(build-system waf-build-system)
(arguments
`(#:tests? #f ; There are no tests.
#:configure-flags
(list (string-append "--prefix="
(assoc-ref %outputs "out")))))
(inputs
`(("lv2" ,lv2)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(native-search-paths
(list (search-path-specification
(variable "LV2_PATH")
(files '("lib/lv2")))))
(home-page "https://drobilla.net/software/mda-lv2")
(synopsis "Audio plug-in pack for LV2")
(description
"MDA-LV2 is an LV2 port of the MDA plugins. It includes effects and a few
instrument plugins.")
(license license:gpl3+)))

35
gnu/packages/authentication.scm
View File

@ -24,6 +24,8 @@
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages security-token)
#:use-module (gnu packages tls)
#:use-module (gnu packages xml)
#:use-module (guix build-system gnu)
#:use-module (guix download)
#:use-module (guix git-download)
@ -33,19 +35,21 @@
(define-public oath-toolkit
(package
(name "oath-toolkit")
(version "2.6.6")
(version "2.6.7")
(source
(origin
(method url-fetch)
(uri (string-append "https://download.savannah.nongnu.org/releases/"
name "/" name "-" version ".tar.gz"))
(sha256
(base32 "0v4lrgip08b8xlivsfn3mwql3nv8hmcpzrn6pi3xp88vqwav6s7x"))))
(base32 "1aa620k05lsw3l3slkp2mzma40q3p9wginspn9zk8digiz7dzv9n"))))
(build-system gnu-build-system)
(arguments
;; TODO ‘--enable-pskc’ causes xmlsec-related test suite failures.
`(#:configure-flags
(list "--enable-pam")
(list "--enable-pam"
"--enable-pskc"
"--with-xmlsec-crypto-engine=openssl")
#:phases
(modify-phases %standard-phases
(add-after 'install 'delete-static-libraries
@ -55,16 +59,16 @@
(for-each delete-file (find-files lib "\\.a$"))
#t))))))
(native-inputs
`(("pkg-config" ,pkg-config)))
`(("pkg-config" ,pkg-config)
;; XXX: Perhaps this should be propagated from xmlsec.
("libltdl" ,libltdl)))
(inputs
`(("linux-pam" ,linux-pam))) ; for --enable-pam
`(("linux-pam" ,linux-pam)
("openssl" ,openssl)
("xmlsec-openssl" ,xmlsec-openssl)))
(home-page "https://www.nongnu.org/oath-toolkit/")
(synopsis "One-time password (OTP) components")
;; TODO Add the following items after they've been enabled.
;; @item @command{pskctool}, a command-line tool for manipulating secret key
;; files in the Portable Symmetric Key Container (@dfn{PSKC}) format
;; described in RFC6030.
;; @item @code{libpskc}, a shared and static C library for PSKC handling.
(description
"The @dfn{OATH} (Open AuTHentication) Toolkit provides various components
for building one-time password (@dfn{OTP}) authentication systems:
@ -72,11 +76,18 @@ for building one-time password (@dfn{OTP}) authentication systems:
@itemize
@item @command{oathtool}, a command-line tool for generating & validating OTPs.
@item @code{liboath}, a C library for OATH handling.
@item @command{pskctool}, a command-line tool for manipulating secret key
files in the Portable Symmetric Key Container (@dfn{PSKC}) format
described in RFC6030.
@item @code{libpskc}, a shared and static C library for PSKC handling.
@item @code{pam_oath}, a PAM module for pluggable login authentication.
@end itemize
Supported technologies include the event-based @dfn{HOTP} algorithm (RFC4226)
and the time-based @dfn{TOTP} algorithm (RFC6238).")
Supported technologies include the event-based @acronym{HOTP, Hash-based Message
Authentication Code One-Time Password} algorithm (RFC4226), the time-based
@acronym{TOTP, Time-based One-Time Password} algorithm (RFC6238), and
@acronym{PSKC, Portable Symmetric Key Container} (RFC6030) to manage secret key
data.")
(license (list license:lgpl2.1+ ; the libraries (liboath/ & libpskc/)
license:gpl3+)))) ; the tools (everything else)

13
gnu/packages/autotools.scm
View File

@ -135,7 +135,18 @@ know anything about Autoconf or M4.")
(find-files "bin"
(lambda (file stat)
(executable-file? file)))))
#t))))))))
#t))
(add-after 'install 'unpatch-shebangs
(lambda* (#:key outputs #:allow-other-keys)
;; Scripts that "autoconf -i" installs (config.guess,
;; config.sub, and install-sh) must use a regular shebang
;; rather than a reference to the store. Restore it.
;; TODO: Move this phase to 'autoconf-2.69'.
(let* ((out (assoc-ref outputs "out"))
(build-aux (string-append
out "/share/autoconf/build-aux")))
(substitute* (find-files build-aux)
(("^#!.*/bin/sh") "#!/bin/sh")))))))))))
(define-public autoconf autoconf-2.69)

4
gnu/packages/aux-files/linux-libre/4.14-arm.conf
View File

@ -875,12 +875,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=m
CONFIG_CPU_FREQ_GOV_USERSPACE=m

4
gnu/packages/aux-files/linux-libre/4.14-i686.conf
View File

@ -763,12 +763,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y

6
gnu/packages/aux-files/linux-libre/4.14-x86_64.conf
View File

@ -786,12 +786,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y
@ -879,7 +879,7 @@ CONFIG_HOTPLUG_PCI_SHPC=m
#
# PCI host controller drivers
#
# CONFIG_VMD is not set
CONFIG_VMD=m
#
# PCI Endpoint

4
gnu/packages/aux-files/linux-libre/4.19-arm.conf
View File

@ -688,12 +688,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=m
CONFIG_CPU_FREQ_GOV_USERSPACE=m

4
gnu/packages/aux-files/linux-libre/4.19-arm64.conf
View File

@ -520,12 +520,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=m
CONFIG_CPU_FREQ_GOV_USERSPACE=m

4
gnu/packages/aux-files/linux-libre/4.19-i686.conf
View File

@ -535,12 +535,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y

6
gnu/packages/aux-files/linux-libre/4.19-x86_64.conf
View File

@ -538,12 +538,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y
@ -630,7 +630,7 @@ CONFIG_HOTPLUG_PCI_SHPC=y
#
# Cadence PCIe controllers support
#
# CONFIG_VMD is not set
CONFIG_VMD=m
#
# DesignWare PCI Core Support

4
gnu/packages/aux-files/linux-libre/4.9-i686.conf
View File

@ -714,12 +714,12 @@ CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_STAT_DETAILS=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y

6
gnu/packages/aux-files/linux-libre/4.9-x86_64.conf
View File

@ -723,12 +723,12 @@ CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_STAT_DETAILS=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y
@ -816,7 +816,7 @@ CONFIG_HOTPLUG_PCI_SHPC=m
# PCI host controller drivers
#
# CONFIG_PCIE_DW_PLAT is not set
# CONFIG_VMD is not set
CONFIG_VMD=m
# CONFIG_ISA_BUS is not set
CONFIG_ISA_DMA_API=y
CONFIG_AMD_NB=y

4
gnu/packages/aux-files/linux-libre/5.10-arm.conf
View File

@ -648,12 +648,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=m
CONFIG_CPU_FREQ_GOV_USERSPACE=m

4
gnu/packages/aux-files/linux-libre/5.10-arm64.conf
View File

@ -544,12 +544,12 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=m
CONFIG_CPU_FREQ_GOV_USERSPACE=m

6
gnu/packages/aux-files/linux-libre/5.10-i686.conf
View File

@ -574,10 +574,10 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y
@ -10612,7 +10612,7 @@ CONFIG_BRANCH_PROFILE_NONE=y
CONFIG_BLK_DEV_IO_TRACE=y
CONFIG_KPROBE_EVENTS=y
# CONFIG_KPROBE_EVENTS_ON_NOTRACE is not set
# CONFIG_UPROBE_EVENTS is not set
CONFIG_UPROBE_EVENTS=y
CONFIG_BPF_EVENTS=y
CONFIG_DYNAMIC_EVENTS=y
CONFIG_PROBE_EVENTS=y

8
gnu/packages/aux-files/linux-libre/5.10-x86_64.conf
View File

@ -589,10 +589,10 @@ CONFIG_CPU_FREQ=y
CONFIG_CPU_FREQ_GOV_ATTR_SET=y
CONFIG_CPU_FREQ_GOV_COMMON=y
CONFIG_CPU_FREQ_STAT=y
CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
CONFIG_CPU_FREQ_GOV_POWERSAVE=y
CONFIG_CPU_FREQ_GOV_USERSPACE=y
@ -2104,7 +2104,7 @@ CONFIG_HOTPLUG_PCI_SHPC=y
#
# PCI controller drivers
#
# CONFIG_VMD is not set
CONFIG_VMD=m
CONFIG_PCI_HYPERV_INTERFACE=m
#
@ -10620,7 +10620,7 @@ CONFIG_BRANCH_PROFILE_NONE=y
CONFIG_BLK_DEV_IO_TRACE=y
CONFIG_KPROBE_EVENTS=y
# CONFIG_KPROBE_EVENTS_ON_NOTRACE is not set
# CONFIG_UPROBE_EVENTS is not set
CONFIG_UPROBE_EVENTS=y
CONFIG_BPF_EVENTS=y
CONFIG_DYNAMIC_EVENTS=y
CONFIG_PROBE_EVENTS=y

Some files were not shown because too many files have changed in this diff Show More