From 2a010ba81d9af05b3ba12f21a8f673ee32ce73fd Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 23 Jul 2022 17:06:02 +0200 Subject: [PATCH 01/91] gnu: Add daikichi. * gnu/packages/toys.scm (daikichi): New variable. --- gnu/packages/toys.scm | 45 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/gnu/packages/toys.scm b/gnu/packages/toys.scm index fb2f367490..051b4a885d 100644 --- a/gnu/packages/toys.scm +++ b/gnu/packages/toys.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2017, 2018, 2020–2022 Tobias Geerinckx-Rice ;;; Copyright © 2019 Jesse Gibbons ;;; Copyright © 2019, 2020, 2021 Timotej Lazar -;;; Copyright © 2019 Liliana Marie Prikler +;;; Copyright © 2019, 2022 Liliana Marie Prikler ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2021 Leo Famulari ;;; @@ -23,22 +23,65 @@ (define-module (gnu packages toys) #:use-module (gnu packages) + #:use-module (gnu packages base) + #:use-module (gnu packages bash) #:use-module (gnu packages bison) #:use-module (gnu packages flex) #:use-module (gnu packages gtk) #:use-module (gnu packages man) + #:use-module (gnu packages multiprecision) #:use-module (gnu packages ncurses) #:use-module (gnu packages perl) + #:use-module (gnu packages pretty-print) #:use-module (gnu packages pkg-config) #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module (guix build-system gnu) + #:use-module (guix build-system meson) #:use-module (guix download) + #:use-module (guix gexp) #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix utils)) +(define-public daikichi + (package + (name "daikichi") + (version "0.3.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://gitlab.com/lilyp/daikichi") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1y35f1qpxl743s0s83dg5ivkvprv19mqn0azm14k3y8pmp6cs52z")))) + (build-system meson-build-system) + (arguments + (list #:phases + #~(modify-phases %standard-phases + (add-after 'unpack 'hard-code-test-paths + (lambda* (#:key inputs #:allow-other-keys) + (substitute* (list "test-dat.in" "test-strings.in") + (("(basename|cmp|diff|mktemp|rm|sed|seq)" cmd) + (search-input-file inputs + (string-append "bin/" cmd))))))))) + (inputs (list bash-minimal coreutils sed + fmt gmp)) + (native-inputs (list pkg-config)) + (home-page "https://gitlab.com/lilyp/daikichi") + (synopsis "Display random fortunes") + (description "Daikichi is an alternative implementation of +@command{fortune}, which displays random quotes from a database. +This package provides just the utilities and no quotes.") + (license license:gpl3+) + (native-search-paths + (list (search-path-specification + (variable "DAIKICHI_FORTUNE_PATH") + (files '("share/fortunes"))))))) + (define-public lolcat (let ((commit "35dca3d0a381496d7195cd78f5b24aa7b62f2154") (revision "0")) From 560b365c2c569f5b7603c9b33b7f982ad97be770 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 23 Jul 2022 17:11:16 +0200 Subject: [PATCH 02/91] gnu: Add fortunes-jkirchartz. * gnu/packages/toys.scm (fortunes-jkirchartz): New variable. --- gnu/packages/toys.scm | 54 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/gnu/packages/toys.scm b/gnu/packages/toys.scm index 051b4a885d..8967c0c25b 100644 --- a/gnu/packages/toys.scm +++ b/gnu/packages/toys.scm @@ -37,6 +37,7 @@ (define-module (gnu packages toys) #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module (guix build-system gnu) + #:use-module (guix build-system copy) #:use-module (guix build-system meson) #:use-module (guix download) #:use-module (guix gexp) @@ -82,6 +83,59 @@ (define-public daikichi (variable "DAIKICHI_FORTUNE_PATH") (files '("share/fortunes"))))))) +(define-public fortunes-jkirchartz + ;; No public release. + ;; Note to updaters: Please ensure that new quotes do not bring harm + ;; rather than fortune. + (let ((commit "2e32ba0a57e3842dc06c8128d880ab4c8ec3aefc") + (revision "0")) + (package + (name "fortunes-jkirchartz") + (version (git-version "0" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/JKirchartz/fortunes") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1ym4ldzww5yfd76q7zvhi491bqlykfjnc215bqx1cbj0c8ndb2l4")) + (snippet + #~(for-each delete-file + ;; incompatible license + '("BibleAbridged"))))) + (build-system copy-build-system) + (native-inputs (list daikichi gnu-make)) + (arguments + (list #:install-plan + #~`(("." "share/fortunes" #:include-regexp ("\\.dat$"))) + #:phases + #~(modify-phases %standard-phases + (add-after 'unpack 'patch-source + (lambda* (#:key inputs native-inputs #:allow-other-keys) + (substitute* "showerthoughts" + (("<") "<") + ((">") ">") + (("&") "&")) + (substitute* "Makefile" + (("strfile") "daikichi pack")))) + (add-before 'install 'build + (lambda _ + (invoke "make"))) + (add-after 'build 'check + (lambda* (#:key inputs tests? #:allow-other-keys) + (when tests? + (apply + invoke + (search-input-file inputs "libexec/daikichi/test-dat") + (find-files "." "\\.dat$")))))))) + (home-page "https://github.com/JKirchartz/fortunes") + (synopsis "Collection of fortunes") + (description "This package contains a large collection of quotes to +display via @command{fortune}, drawn from sources all around the world.") + (license license:unlicense)))) + (define-public lolcat (let ((commit "35dca3d0a381496d7195cd78f5b24aa7b62f2154") (revision "0")) From 6b6b947b6133c40f86800dc0d36a59e16ac169fc Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 23 Jul 2022 17:13:41 +0200 Subject: [PATCH 03/91] gnu: Remove fortune-mod. Since the addition of fortune-jkirchartz, it is no longer necessary to keep around a package that propagates various non-nice things. For a complete list, see . * gnu/packages/games.scm (fortune-mod): Delete variable. --- gnu/packages/games.scm | 73 ------------------------------------------ 1 file changed, 73 deletions(-) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index 5dc7298acb..77929aa790 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -7691,79 +7691,6 @@ (define-public rinutils (description "This package provides C11 / gnu11 utilities C library") (license license:expat))) -(define-public fortune-mod - (package - (name "fortune-mod") - (version "3.14.0") - (source - (origin - (method git-fetch) - (uri (git-reference - (url "https://github.com/shlomif/fortune-mod") - (commit (string-append "fortune-mod-" version)))) - (file-name (git-file-name name version)) - (sha256 - (base32 "1f2zif3s6vddbhph4jr1cymdsn7gagg59grrxs0yap6myqmy8shg")))) - (build-system cmake-build-system) - (arguments - (list #:configure-flags - #~(let ((fortunes (string-append #$output "/share/fortunes"))) - (list (string-append "-DLOCALDIR=" fortunes) - (string-append "-DLOCALODIR=" fortunes "/off") - (string-append "-DCOOKIEDIR=" fortunes) - (string-append "-DOCOOKIEDIR=" fortunes "/off"))) - #:test-target "check" - #:phases - #~(modify-phases %standard-phases - (add-after 'unpack 'enter-build-directory - (lambda _ - (chdir "fortune-mod"))) - (add-after 'enter-build-directory 'symlink-rinutils - (lambda _ - (mkdir-p "rinutils") - (symlink #$(this-package-native-input "rinutils") - "rinutils/rinutils"))) - (add-after 'enter-build-directory 'copy-cmake-modules - (lambda _ - (copy-file #$shlomif-cmake-modules - (string-append "cmake/" - (strip-store-file-name - #$shlomif-cmake-modules))))) - (add-after 'enter-build-directory 'delete-failing-test - (lambda _ - ;; TODO: Valgrind tests fail for some reason. Similar issue? - ;; https://github.com/shlomif/fortune-mod/issues/21 - (delete-file "tests/data/valgrind.t") - (with-output-to-file "tests/scripts/split-valgrind.pl" - (const #t)))) - (add-after 'install 'fix-install-directory - ;; Move fortune from "games/" to "bin/" and remove the - ;; former. This is easier than patching CMakeLists.txt - ;; since the tests hard-code the location as well. - (lambda _ - (with-directory-excursion #$output - (rename-file "games/fortune" "bin/fortune") - (rmdir "games"))))))) - (inputs (list recode)) - (native-inputs - (list perl - ;; For generating the documentation. - docbook-xml-5 - docbook-xsl - perl-app-xml-docbook-builder - ;; The following are only needed for tests. - perl-file-find-object - perl-test-differences - perl-class-xsaccessor - perl-io-all - perl-test-runvalgrind - rinutils)) - (home-page "https://www.shlomifish.org/open-source/projects/fortune-mod/") - (synopsis "The Fortune Cookie program from BSD games") - (description "Fortune is a command-line utility which displays a random -quotation from a collection of quotes.") - (license license:bsd-4))) - (define xonotic-data (package (name "xonotic-data") From 5e174805742b2bec9f5a06c9dd208c60b9af5c14 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 23 Jul 2022 17:16:35 +0200 Subject: [PATCH 04/91] gnu: Remove rinutils. This package was introduced as native input to the now removed fortune-mod, so let's remove it as well. * gnu/packages/games.scm (rinutils): Delete variable. --- gnu/packages/games.scm | 59 ------------------------------------------ 1 file changed, 59 deletions(-) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index 77929aa790..e39b30ce83 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -7632,65 +7632,6 @@ (define shlomif-cmake-modules (sha256 (base32 "05xdikw5ln0yh8p5chsmd8qnndmxg5b5vjlfpdqrjcb1ncqzywkc")))) -(define-public rinutils - (package - (name "rinutils") - (version "0.10.1") - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://github.com/shlomif/rinutils") - (commit version))) - (file-name (git-file-name name version)) - (sha256 - (base32 - "0r90kncf6mvyklifpdsnm50iya7w2951nz35nlgndmqnr82gvdwf")))) - (build-system cmake-build-system) - (arguments - (list #:phases - #~(modify-phases %standard-phases - (add-after 'unpack 'copy-cmake-modules - (lambda _ - (copy-file #$shlomif-cmake-modules - (string-append "cmake/" - (strip-store-file-name - #$shlomif-cmake-modules))))) - (replace 'check - (lambda* (#:key tests? #:allow-other-keys) - (when tests? - (with-directory-excursion "../source" - (setenv "FCS_TEST_BUILD" "1") - (setenv "RINUTILS_TEST_BUILD" "1") - ;; TODO: Run tests after setting RINUTILS_TEST_TIDY to `1', - ;; which requires tidy-all. - ;; (setenv "RINUTILS_TEST_TIDY" "1") - (invoke "perl" - "CI-testing/continuous-integration-testing.pl")))))))) - (native-inputs - (list perl - ;; The following are needed only for tests. - perl-class-xsaccessor - perl-file-find-object - perl-io-all - perl-test-differences - perl-test-runvalgrind - pkg-config)) - (inputs - (list cmocka - perl-env-path - perl-inline - perl-inline-c - perl-string-shellquote - perl-test-trailingspace - perl-file-find-object-rule - perl-text-glob - perl-number-compare - perl-moo)) - (home-page "https://www.shlomifish.org/open-source/projects/") - (synopsis "C11 / gnu11 utilities C library") - (description "This package provides C11 / gnu11 utilities C library") - (license license:expat))) - (define xonotic-data (package (name "xonotic-data") From f592decd4d823a973600d4cdd9f3f7d3ea610429 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 23 Jul 2022 17:17:32 +0200 Subject: [PATCH 05/91] gnu: Remove shlomif-cmake-modules. This origin was added for the now removed fortune-mod, so let's remove it as well. * gnu/packages/games.scm (shlomif-cmake-modules): Delete variable. --- gnu/packages/games.scm | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index e39b30ce83..fe66343a4c 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -7622,16 +7622,6 @@ (define-public crispy-doom original.") (home-page "https://www.chocolate-doom.org/wiki/index.php/Crispy_Doom"))) -(define shlomif-cmake-modules - (origin - (method url-fetch) - (uri (string-append - "https://raw.githubusercontent.com/shlomif/shlomif-cmake-modules/" - "89f05caf86078f783873975525230cf4fecede8a" - "/shlomif-cmake-modules/Shlomif_Common.cmake")) - (sha256 - (base32 "05xdikw5ln0yh8p5chsmd8qnndmxg5b5vjlfpdqrjcb1ncqzywkc")))) - (define xonotic-data (package (name "xonotic-data") From b9322d78194fe76ef1586e5dc6fc30d0707d7310 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 28 Aug 2022 22:46:12 +0200 Subject: [PATCH 06/91] gnu: emacs-crdt: Update to 0.3.3. * gnu/packages/emacs-xyz.scm (emacs-crdt): Update to 0.3.3. --- gnu/packages/emacs-xyz.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/emacs-xyz.scm b/gnu/packages/emacs-xyz.scm index c35912a26b..90ee485f1e 100644 --- a/gnu/packages/emacs-xyz.scm +++ b/gnu/packages/emacs-xyz.scm @@ -19836,8 +19836,8 @@ (define-public emacs-elisp-refs (define-public emacs-crdt ;; XXX: Upstream does not always tag new releases. The commit below ;; corresponds exactly to latest version bump. - (let ((commit "2feb88ea9a2589946014878790af585cad9f28fc") - (version "0.3.2")) + (let ((commit "480f60fdda9e40848920fa460b59dfba23fa06e5") + (version "0.3.3")) (package (name "emacs-crdt") (version version) @@ -19849,7 +19849,7 @@ (define-public emacs-crdt (commit commit))) (file-name (git-file-name name version)) (sha256 - (base32 "1fc98kl5qm7h5hrd70g61zzbdinnbf0zvk9rghf6w78ndp6lv7fz")))) + (base32 "10hb2xwv8ylkm4cla2q5l11r1m1s1j4ywiwvy9x5884gxvbpbbph")))) (build-system emacs-build-system) (home-page "https://code.librehq.com/qhong/crdt.el") (synopsis "Real-time collaborative editing environment") From 0811d2cb8dff5de9f535e14726c9874ec2f4a96c Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sun, 21 Aug 2022 10:41:15 +0200 Subject: [PATCH 07/91] bootloader: Convert device in menu-entry to proper sexp. Previously, menu-entry->sexp didn't try to convert `device` to a proper sexp, which was inserted directly into the boot parameters G-exp, leading to a G-exp input error. Now convert both uuid and file-system-label possibilities to sexps, and add parsing code to sexp->menu-entry. This fixes #57307. * gnu/bootloader.scm (menu-entry->sexp, sexp->menu-entry): Take non-string devices into account. Signed-off-by: Marius Bakke --- gnu/bootloader.scm | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 70e1836179..2eec48693c 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2019, 2021 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2022 Josselin Poiret ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,8 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu bootloader) + #:use-module (gnu system file-systems) + #:use-module (gnu system uuid) #:use-module (guix discovery) #:use-module (guix gexp) #:use-module (guix profiles) @@ -104,12 +107,19 @@ (define-record-type* (define (menu-entry->sexp entry) "Return ENTRY serialized as an sexp." + (define (device->sexp device) + (match device + ((? uuid? uuid) + `(uuid ,(uuid-type uuid) ,(uuid->string uuid))) + ((? file-system-label? label) + `(label ,(file-system-label->string label))) + (_ device))) (match entry (($ label device mount-point linux linux-arguments initrd #f ()) `(menu-entry (version 0) (label ,label) - (device ,device) + (device ,(device->sexp device)) (device-mount-point ,mount-point) (linux ,linux) (linux-arguments ,linux-arguments) @@ -118,7 +128,7 @@ (define (menu-entry->sexp entry) multiboot-kernel multiboot-arguments multiboot-modules) `(menu-entry (version 0) (label ,label) - (device ,device) + (device ,(device->sexp device)) (device-mount-point ,mount-point) (multiboot-kernel ,multiboot-kernel) (multiboot-arguments ,multiboot-arguments) @@ -127,6 +137,13 @@ (define (menu-entry->sexp entry) (define (sexp->menu-entry sexp) "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a record." + (define (sexp->device device-sexp) + (match device-sexp + (('uuid type uuid-string) + (uuid uuid-string type)) + (('label label) + (file-system-label label)) + (_ device-sexp))) (match sexp (('menu-entry ('version 0) ('label label) ('device device) @@ -135,7 +152,7 @@ (define (sexp->menu-entry sexp) ('initrd initrd) _ ...) (menu-entry (label label) - (device device) + (device (sexp->device device)) (device-mount-point mount-point) (linux linux) (linux-arguments linux-arguments) @@ -148,7 +165,7 @@ (define (sexp->menu-entry sexp) ('multiboot-modules multiboot-modules) _ ...) (menu-entry (label label) - (device device) + (device (sexp->device device)) (device-mount-point mount-point) (multiboot-kernel multiboot-kernel) (multiboot-arguments multiboot-arguments) From 3294fa2ba451c7d5ef42a5d9fac780877f364bc7 Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sun, 21 Aug 2022 10:41:16 +0200 Subject: [PATCH 08/91] tests: Add test for menu-entry roundtrips as sexps. * tests/boot-parameters.scm (%uuid-menu-entry, %file-system-label-menu-entry): New variables. ("menu-entry roundtrip, uuid", "menu-entry roundtrip, file-system-label"): New tests. Signed-off-by: Marius Bakke --- tests/boot-parameters.scm | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm index 8e48e1775e..03a1d01aff 100644 --- a/tests/boot-parameters.scm +++ b/tests/boot-parameters.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas +;;; Copyright © 2022 Josselin Poiret ;;; ;;; This file is part of GNU Guix. ;;; @@ -303,4 +304,26 @@ (define operating-system-boot-parameters (operating-system-boot-parameters %default-operating-system %default-root-device))) +(define %uuid-menu-entry + (menu-entry + (label "test") + (device (uuid "6d5b13d4-6092-46d0-8be4-073dc07413cc")) + (linux "/boot/bzImage") + (initrd "/boot/initrd.cpio.gz"))) + +(define %file-system-label-menu-entry + (menu-entry + (label "test") + (device (file-system-label "test-label")) + (linux "/boot/bzImage") + (initrd "/boot/initrd.cpio.gz"))) + +(test-equal "menu-entry roundtrip, uuid" + %uuid-menu-entry + (sexp->menu-entry (menu-entry->sexp %uuid-menu-entry))) + +(test-equal "menu-entry roundtrip, file-system-label" + %file-system-label-menu-entry + (sexp->menu-entry (menu-entry->sexp %file-system-label-menu-entry))) + (test-end "boot-parameters") From ba0dbe3bf2ae4e036a6974489d30bd7f1571a13a Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 25 Aug 2022 22:50:14 -0400 Subject: [PATCH 09/91] gexp: directory-union: Fix documentation. * guix/gexp.scm (directory-union): Fix documentation. --- guix/gexp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index ef92223048..73595a216b 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -2140,8 +2140,8 @@ (define* (directory-union name things colliding files. RESOLVE-COLLISION must return the chosen file or #f, in which case the colliding entry is skipped altogether. -When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET? -is true, the derivation will not print anything." +When COPY? is true, copy files instead of creating symlinks. When QUIET? is +true, the derivation will not print anything." (define symlink (if copy? (gexp (lambda (old new) From 3c2d2b453832167df02f4aa25de4857a003fbecf Mon Sep 17 00:00:00 2001 From: muradm Date: Tue, 23 Aug 2022 23:13:55 +0300 Subject: [PATCH 10/91] gnu: security: Add fail2ban-service-type. * gnu/services/security.scm: New module. * gnu/tests/security.scm: New module. * gnu/local.mk: Add new security module and tests. * doc/guix.text: Add fail2ban-service-type documentation. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 249 +++++++++++++++++++++++ gnu/local.mk | 3 + gnu/services/security.scm | 415 ++++++++++++++++++++++++++++++++++++++ gnu/tests/security.scm | 221 ++++++++++++++++++++ 4 files changed, 888 insertions(+) create mode 100644 gnu/services/security.scm create mode 100644 gnu/tests/security.scm diff --git a/doc/guix.texi b/doc/guix.texi index 7bce8a567c..4f6973518f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -36311,6 +36311,255 @@ Extra command line options for @code{nix-service-type}. @end table @end deftp +@cindex Fail2Ban +@subsubheading Fail2Ban service + +@uref{http://www.fail2ban.org/, @code{fail2ban}} scans log files +(e.g. @code{/var/log/apache/error_log}) and bans IP addresses that show +malicious signs -- repeated password failures, attempts to make use of +exploits, etc. + +@code{fail2ban-service-type} service type is provided by the @code{(gnu +services security)} module. + +This service type runs the @code{fail2ban} daemon. It can be configured +in various ways, which are: + +@table @asis +@item Basic configuration +The basic parameters of the Fail2Ban service can be configured via its +@code{fail2ban} configuration, which is documented below. + +@item User-specified jail extensions +The @code{fail2ban-jail-service} function can be used to add new +Fail2Ban jails. + +@item Shepherd extension mechanism +Service developers can extend the @code{fail2ban-service-type} service +type itself via the usual service extension mechanism. +@end table + +@defvr {Scheme Variable} fail2ban-service-type + +This is the type of the service that runs @code{fail2ban} daemon. Below +is an example of a basic, explicit configuration: + +@lisp +(append + (list + (service fail2ban-service-type + (fail2ban-configuration + (extra-jails + (list + (fail2ban-jail-configuration + (name "sshd") + (enabled #t)))))) + ;; There is no implicit dependency on an actual SSH + ;; service, so you need to provide one. + (service openssh-service-type)) + %base-services) +@end lisp +@end defvr + +@deffn {Scheme Procedure} fail2ban-jail-service @var{svc-type} @var{jail} +Extend @var{svc-type}, a @code{} object with @var{jail}, a +@code{fail2ban-jail-configuration} object. + +For example: + +@lisp +(append + (list + (service + ;; The 'fail2ban-jail-service' procedure can extend any service type + ;; with a fail2ban jail. This removes the requirement to explicitly + ;; extend services with fail2ban-service-type. + (fail2ban-jail-service + openssh-service-type + (fail2ban-jail-configuration + (name "sshd") + (enabled #t))) + (openssh-configuration ...)))) +@end lisp +@end deffn + +Below is the reference for the different @code{jail-service-type} +configuration records. + +@c The documentation is to be auto-generated via +@c 'generate-documentation'. See at the bottom of (gnu services +@c security). + +@deftp {Data Type} fail2ban-configuration +Available @code{fail2ban-configuration} fields are: + +@table @asis +@item @code{fail2ban} (default: @code{fail2ban}) (type: package) +The @code{fail2ban} package to use. It is used for both binaries and as +base default configuration that is to be extended with +@code{} objects. + +@item @code{run-directory} (default: @code{"/var/run/fail2ban"}) (type: string) +The state directory for the @code{fail2ban} daemon. + +@item @code{jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations) +Instances of @code{} collected from +extensions. + +@item @code{extra-jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations) +Instances of @code{} explicitly provided. + +@item @code{extra-content} (type: maybe-string) +Extra raw content to add to the end of the @file{jail.local} file. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-ignore-cache-configuration +Available @code{fail2ban-ignore-cache-configuration} fields are: + +@table @asis +@item @code{key} (type: string) +Cache key. + +@item @code{max-count} (type: integer) +Cache size. + +@item @code{max-time} (type: integer) +Cache time. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-action-configuration +Available @code{fail2ban-jail-action-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Action name. + +@item @code{arguments} (default: @code{()}) (type: list-of-arguments) +Action arguments. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-configuration +Available @code{fail2ban-jail-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Required name of this jail configuration. + +@item @code{enabled?} (default: @code{#t}) (type: boolean) +Whether this jail is enabled. + +@item @code{backend} (type: maybe-symbol) +Backend to use to detect changes in the @code{ogpath}. The default is +'auto. To consult the defaults of the jail configuration, refer to the +@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package. + +@item @code{max-retry} (type: maybe-integer) +The number of failures before a host get banned (e.g. @code{(max-retry +5)}). + +@item @code{max-matches} (type: maybe-integer) +The number of matches stored in ticket (resolvable via tag +@code{}) in action. + +@item @code{find-time} (type: maybe-string) +The time window during which the maximum retry count must be reached for +an IP address to be banned. A host is banned if it has generated +@code{max-retry} during the last @code{find-time} seconds (e.g. +@code{(find-time "10m")}). It can be provided in seconds or using +Fail2Ban's "time abbreviation format", as described in @command{man 5 +jail.conf}. + +@item @code{ban-time} (type: maybe-string) +The duration, in seconds or time abbreviated format, that a ban should +last. (e.g. @code{(ban-time "10m")}). + +@item @code{ban-time-increment?} (type: maybe-boolean) +Whether to consider past bans to compute increases to the default ban +time of a specific IP address. + +@item @code{ban-time-factor} (type: maybe-string) +The coefficient to use to compute an exponentially growing ban time. + +@item @code{ban-time-formula} (type: maybe-string) +This is the formula used to calculate the next value of a ban time. + +@item @code{ban-time-multipliers} (type: maybe-string) +Used to calculate next value of ban time instead of formula. + +@item @code{ban-time-max-time} (type: maybe-string) +The maximum number of seconds a ban should last. + +@item @code{ban-time-rnd-time} (type: maybe-string) +The maximum number of seconds a randomized ban time should last. This +can be useful to stop ``clever'' botnets calculating the exact time an +IP address can be unbanned again. + +@item @code{ban-time-overall-jails?} (type: maybe-boolean) +When true, it specifies the search of an IP address in the database +should be made across all jails. Otherwise, only the current jail of +the ban IP address is considered. + +@item @code{ignore-self?} (type: maybe-boolean) +Never ban the local machine's own IP address. + +@item @code{ignore-ip} (default: @code{()}) (type: list-of-strings) +A list of IP addresses, CIDR masks or DNS hosts to ignore. +@code{fail2ban} will not ban a host which matches an address in this +list. + +@item @code{ignore-cache} (type: maybe-fail2ban-ignore-cache-configuration) +Provide cache parameters for the ignore failure check. + +@item @code{filter} (type: maybe-fail2ban-jail-filter-configuration) +The filter to use by the jail, specified via a +@code{} object. By default, jails +have names matching their filter name. + +@item @code{log-time-zone} (type: maybe-string) +The default time zone for log lines that do not have one. + +@item @code{log-encoding} (type: maybe-symbol) +The encoding of the log files handled by the jail. Possible values are: +@code{'ascii}, @code{'utf-8} and @code{'auto}. + +@item @code{log-path} (default: @code{()}) (type: list-of-strings) +The file names of the log files to be monitored. + +@item @code{action} (default: @code{()}) (type: list-of-fail2ban-jail-actions) +A list of @code{}. + +@item @code{extra-content} (type: maybe-string) +Extra content for the jail configuration. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-filter-configuration +Available @code{fail2ban-jail-filter-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Filter to use. + +@item @code{mode} (type: maybe-string) +Mode for filter. + +@end table + +@end deftp + +@c End of auto-generated fail2ban documentation. + @node Setuid Programs @section Setuid Programs diff --git a/gnu/local.mk b/gnu/local.mk index 027cb8e3cb..fcbbdbd1fb 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -51,6 +51,7 @@ # Copyright © 2022 Remco van 't Veer # Copyright © 2022 Artyom V. Poptsov # Copyright © 2022 John Kehayias +# Copyright © 2022 muradm # # This file is part of GNU Guix. # @@ -672,6 +673,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/nfs.scm \ %D%/services/pam-mount.scm \ %D%/services/science.scm \ + %D%/services/security.scm \ %D%/services/security-token.scm \ %D%/services/shepherd.scm \ %D%/services/sound.scm \ @@ -756,6 +758,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/package-management.scm \ %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ + %D%/tests/security.scm \ %D%/tests/security-token.scm \ %D%/tests/singularity.scm \ %D%/tests/ssh.scm \ diff --git a/gnu/services/security.scm b/gnu/services/security.scm new file mode 100644 index 0000000000..1e0360c07f --- /dev/null +++ b/gnu/services/security.scm @@ -0,0 +1,415 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 muradm +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services security) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix ui) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (fail2ban-configuration + fail2ban-ignore-cache-configuration + fail2ban-jail-action-configuration + fail2ban-jail-configuration + fail2ban-jail-filter-configuration + fail2ban-jail-service + fail2ban-service-type)) + +(define-configuration/no-serialization fail2ban-ignore-cache-configuration + (key string "Cache key.") + (max-count integer "Cache size.") + (max-time integer "Cache time.")) + +(define serialize-fail2ban-ignore-cache-configuration + (match-lambda + (($ _ key max-count max-time) + (format #f "key=\"~a\", max-count=~d, max-time=~d" + key max-count max-time)))) + +(define-maybe/no-serialization string) + +(define-configuration/no-serialization fail2ban-jail-filter-configuration + (name string "Filter to use.") + (mode maybe-string "Mode for filter.")) + +(define serialize-fail2ban-jail-filter-configuration + (match-lambda + (($ _ name mode) + (format #f "~a~@[[mode=~a]~]" name (maybe-value mode))))) + +(define (argument? a) + (and (pair? a) + (string? (car a)) + (or (string? (cdr a)) + (list-of-strings? (cdr a))))) + +(define list-of-arguments? (list-of argument?)) + +(define-configuration/no-serialization fail2ban-jail-action-configuration + (name string "Action name.") + (arguments (list-of-arguments '()) "Action arguments.")) + +(define list-of-fail2ban-jail-actions? + (list-of fail2ban-jail-action-configuration?)) + +(define (serialize-fail2ban-jail-action-configuration-arguments args) + (let* ((multi-value + (lambda (v) + (format #f "~a" (string-join v ",")))) + (any-value + (lambda (v) + (if (list? v) (string-append "\"" (multi-value v) "\"") v))) + (key-value + (lambda (e) + (format #f "~a=~a" (car e) (any-value (cdr e)))))) + (format #f "~a" (string-join (map key-value args) ",")))) + +(define serialize-fail2ban-jail-action-configuration + (match-lambda + (($ _ name arguments) + (format + #f "~a~a" + name + (if (null? arguments) "" + (format + #f "[~a]" + (serialize-fail2ban-jail-action-configuration-arguments + arguments))))))) + +(define fail2ban-backend->string + (match-lambda + ('auto "auto") + ('pyinotify "pyinotify") + ('gamin "gamin") + ('polling "polling") + ('systemd "systemd") + (unknown + (leave (G_ "fail2ban: '~a' is not a supported backend~%") unknown)))) + +(define fail2ban-log-encoding->string + (match-lambda + ('auto "auto") + ('utf-8 "utf-8") + ('ascii "ascii") + (unknown + (leave (G_ "fail2ban: '~a' is not a supported log encoding~%") unknown)))) + +(define (fail2ban-jail-configuration-serialize-field-name name) + (cond ((symbol? name) + (fail2ban-jail-configuration-serialize-field-name + (symbol->string name))) + ((string-suffix? "?" name) + (fail2ban-jail-configuration-serialize-field-name + (string-drop-right name 1))) + ((string-prefix? "ban-time-" name) + (fail2ban-jail-configuration-serialize-field-name + (string-append "bantime." (substring name 9)))) + ((string-contains name "-") + (fail2ban-jail-configuration-serialize-field-name + (string-filter (lambda (c) (equal? c #\-)) name))) + (else name))) + +(define (fail2ban-jail-configuration-serialize-string field-name value) + #~(string-append + #$(fail2ban-jail-configuration-serialize-field-name field-name) + " = " #$value "\n")) + +(define (fail2ban-jail-configuration-serialize-integer field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (number->string value))) + +(define (fail2ban-jail-configuration-serialize-boolean field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (if value "true" "false"))) + +(define (fail2ban-jail-configuration-serialize-backend field-name value) + (if (maybe-value-set? value) + (fail2ban-jail-configuration-serialize-string + field-name (fail2ban-backend->string value)) + "")) + +(define (fail2ban-jail-configuration-serialize-fail2ban-ignore-cache-configuration field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (serialize-fail2ban-ignore-cache-configuration value))) + +(define (fail2ban-jail-configuration-serialize-fail2ban-jail-filter-configuration field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (serialize-fail2ban-jail-filter-configuration value))) + +(define (fail2ban-jail-configuration-serialize-log-encoding field-name value) + (if (maybe-value-set? value) + (fail2ban-jail-configuration-serialize-string + field-name (fail2ban-log-encoding->string value)) + "")) + +(define (fail2ban-jail-configuration-serialize-list-of-strings field-name value) + (if (null? value) + "" + (fail2ban-jail-configuration-serialize-string + field-name (string-join value " ")))) + +(define (fail2ban-jail-configuration-serialize-list-of-fail2ban-jail-actions field-name value) + (if (null? value) + "" + (fail2ban-jail-configuration-serialize-string + field-name (string-join + (map serialize-fail2ban-jail-action-configuration value) "\n")))) + +(define (fail2ban-jail-configuration-serialize-symbol field-name value) + (fail2ban-jail-configuration-serialize-string field-name (symbol->string value))) + +(define (fail2ban-jail-configuration-serialize-extra-content field-name value) + (if (maybe-value-set? value) + (string-append "\n" value "\n") + "")) + +(define-maybe integer (prefix fail2ban-jail-configuration-)) +(define-maybe string (prefix fail2ban-jail-configuration-)) +(define-maybe boolean (prefix fail2ban-jail-configuration-)) +(define-maybe symbol (prefix fail2ban-jail-configuration-)) +(define-maybe fail2ban-ignore-cache-configuration (prefix fail2ban-jail-configuration-)) +(define-maybe fail2ban-jail-filter-configuration (prefix fail2ban-jail-configuration-)) + +(define-configuration fail2ban-jail-configuration + (name + string + "Required name of this jail configuration.") + (enabled? + (boolean #t) + "Whether this jail is enabled.") + (backend + maybe-symbol + "Backend to use to detect changes in the @code{ogpath}. The default is +'auto. To consult the defaults of the jail configuration, refer to the +@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package." +fail2ban-jail-configuration-serialize-backend) + (max-retry + maybe-integer + "The number of failures before a host get banned +(e.g. @code{(max-retry 5)}).") + (max-matches + maybe-integer + "The number of matches stored in ticket (resolvable via +tag @code{}) in action.") + (find-time + maybe-string + "The time window during which the maximum retry count must be reached for +an IP address to be banned. A host is banned if it has generated +@code{max-retry} during the last @code{find-time} +seconds (e.g. @code{(find-time \"10m\")}). It can be provided in seconds or +using Fail2Ban's \"time abbreviation format\", as described in @command{man 5 +jail.conf}.") + (ban-time + maybe-string + "The duration, in seconds or time abbreviated format, that a ban should last. +(e.g. @code{(ban-time \"10m\")}).") + (ban-time-increment? + maybe-boolean + "Whether to consider past bans to compute increases to the default ban time +of a specific IP address.") + (ban-time-factor + maybe-string + "The coefficient to use to compute an exponentially growing ban time.") + (ban-time-formula + maybe-string + "This is the formula used to calculate the next value of a ban time.") + (ban-time-multipliers + maybe-string + "Used to calculate next value of ban time instead of formula.") + (ban-time-max-time + maybe-string + "The maximum number of seconds a ban should last.") + (ban-time-rnd-time + maybe-string + "The maximum number of seconds a randomized ban time should last. This can +be useful to stop ``clever'' botnets calculating the exact time an IP address +can be unbanned again.") + (ban-time-overall-jails? + maybe-boolean + "When true, it specifies the search of an IP address in the database should +be made across all jails. Otherwise, only the current jail of the ban IP +address is considered.") + (ignore-self? + maybe-boolean + "Never ban the local machine's own IP address.") + (ignore-ip + (list-of-strings '()) + "A list of IP addresses, CIDR masks or DNS hosts to ignore. +@code{fail2ban} will not ban a host which matches an address in this list.") + (ignore-cache + maybe-fail2ban-ignore-cache-configuration + "Provide cache parameters for the ignore failure check.") + (filter + maybe-fail2ban-jail-filter-configuration + "The filter to use by the jail, specified via a +@code{} object. By default, jails have +names matching their filter name.") + (log-time-zone + maybe-string + "The default time zone for log lines that do not have one.") + (log-encoding + maybe-symbol + "The encoding of the log files handled by the jail. +Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}." +fail2ban-jail-configuration-serialize-log-encoding) + (log-path + (list-of-strings '()) + "The file names of the log files to be monitored.") + (action + (list-of-fail2ban-jail-actions '()) + "A list of @code{}.") + (extra-content + maybe-string + "Extra content for the jail configuration." + fail2ban-jail-configuration-serialize-extra-content) + (prefix fail2ban-jail-configuration-)) + +(define list-of-fail2ban-jail-configurations? + (list-of fail2ban-jail-configuration?)) + +(define (serialize-fail2ban-jail-configuration config) + #~(string-append + #$(format #f "[~a]\n" (fail2ban-jail-configuration-name config)) + #$(serialize-configuration + config fail2ban-jail-configuration-fields))) + +(define-configuration/no-serialization fail2ban-configuration + (fail2ban + (package fail2ban) + "The @code{fail2ban} package to use. It is used for both binaries and as +base default configuration that is to be extended with +@code{} objects.") + (run-directory + (string "/var/run/fail2ban") + "The state directory for the @code{fail2ban} daemon.") + (jails + (list-of-fail2ban-jail-configurations '()) + "Instances of @code{} collected from +extensions.") + (extra-jails + (list-of-fail2ban-jail-configurations '()) + "Instances of @code{} explicitly provided.") + (extra-content + maybe-string + "Extra raw content to add to the end of the @file{jail.local} file.")) + +(define (serialize-fail2ban-configuration config) + (let* ((jails (fail2ban-configuration-jails config)) + (extra-jails (fail2ban-configuration-extra-jails config)) + (extra-content (fail2ban-configuration-extra-content config))) + (interpose + (append (map serialize-fail2ban-jail-configuration + (append jails extra-jails)) + (list (if (maybe-value-set? extra-content) + extra-content + "")))))) + +(define (config->fail2ban-etc-directory config) + (let* ((fail2ban (fail2ban-configuration-fail2ban config)) + (jail-local (apply mixed-text-file "jail.local" + (serialize-fail2ban-configuration config)))) + (directory-union + "fail2ban-configuration" + (list (computed-file + "etc-fail2ban" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (let ((etc (string-append #$output "/etc"))) + (mkdir-p etc) + (symlink #$(file-append fail2ban "/etc/fail2ban") + (string-append etc "/fail2ban")))))) + (computed-file + "etc-fail2ban-jail.local" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (define etc/fail2ban (string-append #$output + "/etc/fail2ban")) + (mkdir-p etc/fail2ban) + (symlink #$jail-local (string-append etc/fail2ban + "/jail.local"))))))))) + +(define (fail2ban-shepherd-service config) + (match-record config + (fail2ban run-directory) + (let* ((fail2ban-server (file-append fail2ban "/bin/fail2ban-server")) + (pid-file (in-vicinity run-directory "fail2ban.pid")) + (socket-file (in-vicinity run-directory "fail2ban.sock")) + (config-dir (file-append (config->fail2ban-etc-directory config) + "/etc/fail2ban")) + (fail2ban-action (lambda args + #~(lambda _ + (invoke #$fail2ban-server + "-c" #$config-dir + "-p" #$pid-file + "-s" #$socket-file + "-b" + #$@args))))) + + ;; TODO: Add 'reload' action. + (list (shepherd-service + (provision '(fail2ban)) + (documentation "Run the fail2ban daemon.") + (requirement '(user-processes)) + (modules `((ice-9 match) + ,@%default-modules)) + (start (fail2ban-action "start")) + (stop (fail2ban-action "stop"))))))) + +(define fail2ban-service-type + (service-type (name 'fail2ban) + (extensions + (list (service-extension shepherd-root-service-type + fail2ban-shepherd-service))) + (compose concatenate) + (extend (lambda (config jails) + (fail2ban-configuration + (inherit config) + (jails (append (fail2ban-configuration-jails config) + jails))))) + (default-value (fail2ban-configuration)) + (description "Run the fail2ban server."))) + +(define (fail2ban-jail-service svc-type jail) + "Convenience procedure to add a fail2ban service extension to SVC-TYPE, a + object. The fail2ban extension is specified by JAIL, a + object." + (service-type + (inherit svc-type) + (extensions + (append (service-type-extensions svc-type) + (list (service-extension fail2ban-service-type + (lambda _ (list jail)))))))) + + +;;; +;;; Documentation generation. +;;; +(define (generate-doc) + (configuration->documentation 'fail2ban-configuration) + (configuration->documentation 'fail2ban-ignore-cache-configuration) + (configuration->documentation 'fail2ban-jail-action-configuration) + (configuration->documentation 'fail2ban-jail-configuration) + (configuration->documentation 'fail2ban-jail-filter-configuration)) diff --git a/gnu/tests/security.scm b/gnu/tests/security.scm new file mode 100644 index 0000000000..ca6c857899 --- /dev/null +++ b/gnu/tests/security.scm @@ -0,0 +1,221 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 muradm +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests security) + #:use-module (guix gexp) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services security) + #:use-module (gnu services ssh) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:export (%test-fail2ban-basic + %test-fail2ban-extension + %test-fail2ban-simple)) + + +;;; +;;; fail2ban tests +;;; + +(define-syntax-rule (fail2ban-test test-name test-os tests-more ...) + (lambda () + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette) + (guix build utils)) + #~(begin + (use-modules (srfi srfi-64) + (gnu build marionette)) + + (define marionette (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin test-name) + + (test-assert "fail2ban running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'fail2ban)) + marionette)) + + (test-assert "fail2ban socket ready" + (wait-for-unix-socket + "/var/run/fail2ban/fail2ban.sock" marionette)) + + (test-assert "fail2ban running after restart" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (restart-service 'fail2ban)) + marionette)) + + (test-assert "fail2ban socket ready after restart" + (wait-for-unix-socket + "/var/run/fail2ban/fail2ban.sock" marionette)) + + (test-assert "fail2ban pid ready" + (marionette-eval + '(file-exists? "/var/run/fail2ban/fail2ban.pid") + marionette)) + + (test-assert "fail2ban log file" + (marionette-eval + '(file-exists? "/var/log/fail2ban.log") + marionette)) + + tests-more ... + + (test-end)))) + + (gexp->derivation test-name test))) + +(define run-fail2ban-basic-test + (fail2ban-test + "fail2ban-basic-test" + + (simple-operating-system + (service fail2ban-service-type)))) + +(define %test-fail2ban-basic + (system-test + (name "fail2ban-basic") + (description "Test basic fail2ban running capability.") + (value (run-fail2ban-basic-test)))) + +(define %fail2ban-server-cmd + (program-file + "fail2ban-server-cmd" + #~(begin + (let ((cmd #$(file-append fail2ban "/bin/fail2ban-server"))) + (apply execl cmd cmd `("-p" "/var/run/fail2ban/fail2ban.pid" + "-s" "/var/run/fail2ban/fail2ban.sock" + ,@(cdr (program-arguments)))))))) + +(define run-fail2ban-simple-test + (fail2ban-test + "fail2ban-basic-test" + + (simple-operating-system + (service fail2ban-service-type (fail2ban-configuration + (jails (list (fail2ban-jail-configuration + (name "sshd"))))))) + + (test-equal "fail2ban sshd jail running status output" + '("Status for the jail: sshd" + "|- Filter" + "| |- Currently failed:\t0" + "| |- Total failed:\t0" + "| `- File list:\t/var/log/secure" + "`- Actions" + " |- Currently banned:\t0" + " |- Total banned:\t0" + " `- Banned IP list:\t" + "") + (marionette-eval + '(begin + (use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports)) + (let ((call-command + (lambda (cmd) + (let* ((err-cons (pipe)) + (port (with-error-to-port (cdr err-cons) + (lambda () (open-input-pipe cmd)))) + (_ (setvbuf (car err-cons) 'block + (* 1024 1024 16))) + (result (read-delimited "" port))) + (close-port (cdr err-cons)) + (values result (read-delimited "" (car err-cons))))))) + (string-split + (call-command + (string-join (list #$%fail2ban-server-cmd "status" "sshd") " ")) + #\newline))) + marionette)) + + (test-equal "fail2ban sshd jail running exit code" + 0 + (marionette-eval + '(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd")) + marionette)))) + +(define %test-fail2ban-simple + (system-test + (name "fail2ban-simple") + (description "Test simple fail2ban running capability.") + (value (run-fail2ban-simple-test)))) + +(define run-fail2ban-extension-test + (fail2ban-test + "fail2ban-extension-test" + + (simple-operating-system + (service (fail2ban-jail-service openssh-service-type (fail2ban-jail-configuration + (name "sshd") (enabled? #t))) + (openssh-configuration))) + + (test-equal "fail2ban sshd jail running status output" + '("Status for the jail: sshd" + "|- Filter" + "| |- Currently failed:\t0" + "| |- Total failed:\t0" + "| `- File list:\t/var/log/secure" + "`- Actions" + " |- Currently banned:\t0" + " |- Total banned:\t0" + " `- Banned IP list:\t" + "") + (marionette-eval + '(begin + (use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports)) + (let ((call-command + (lambda (cmd) + (let* ((err-cons (pipe)) + (port (with-error-to-port (cdr err-cons) + (lambda () (open-input-pipe cmd)))) + (_ (setvbuf (car err-cons) 'block + (* 1024 1024 16))) + (result (read-delimited "" port))) + (close-port (cdr err-cons)) + (values result (read-delimited "" (car err-cons))))))) + (string-split + (call-command + (string-join (list #$%fail2ban-server-cmd "status" "sshd") " ")) + #\newline))) + marionette)) + + (test-equal "fail2ban sshd jail running exit code" + 0 + (marionette-eval + '(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd")) + marionette)))) + +(define %test-fail2ban-extension + (system-test + (name "fail2ban-extension") + (description "Test extension fail2ban running capability.") + (value (run-fail2ban-extension-test)))) From 12bb1c6db1a4163baf18e7434bac010b59c06ac8 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 7 Aug 2022 17:55:54 -0400 Subject: [PATCH 11/91] gnu: accountsservice: Update to 22.08.8, enable doc and test suite. * gnu/packages/freedesktop.scm (accountsservice): Update to 22.08.8. [tests?]: Delete argument. [configure-flags]: Remove obsolete "-Dsystemd" flag. Add "-Ddocbook=true" and "-Dgtk_doc=true". [phases]{patch-docbook-references}: New phase. {patch-/bin/cat}: Delete and merge into... [patch-paths]: ... this phase, renamed from pre-configure. Use search-input-file. [native-inputs]: Add docbook-xml-4.1.2, docbook-xsl, gtk-doc, libxml2, libxslt, python-dbusmock, python-pygobject, vala and xmlto. --- gnu/packages/freedesktop.scm | 85 +++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 34 deletions(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index 037a247243..8ebd0e5359 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -27,7 +27,7 @@ ;;; Copyright © 2021 Robby Zambito ;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2021 John Kehayias -;;; Copyright © 2021, 2021 Maxim Cournoyer +;;; Copyright © 2021, 2021, 2022 Maxim Cournoyer ;;; Copyright © 2022 Daniel Meißner ;;; Copyright © 2022 muradm ;;; @@ -1435,7 +1435,7 @@ (define-public udisks (define-public accountsservice (package (name "accountsservice") - (version "0.6.55") + (version "22.08.8") (source (origin (method url-fetch) @@ -1443,45 +1443,62 @@ (define-public accountsservice "accountsservice/accountsservice-" version ".tar.xz")) (sha256 - (base32 "16wwd633jak9ajyr1f1h047rmd09fhf3kzjz6g5xjsz0lwcj8azz")))) + (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch")))) (build-system meson-build-system) (arguments - `(#:tests? #f ; XXX: tests require DocBook 4.1.2 - #:configure-flags + `(#:configure-flags '("--localstatedir=/var" - "-Dsystemdsystemunitdir=/tmp/empty" - "-Dsystemd=false" - "-Delogind=true") + "-Delogind=true" + "-Ddocbook=true" + "-Dgtk_doc=true" + "-Dsystemdsystemunitdir=/tmp/empty") #:phases (modify-phases %standard-phases - (add-after 'unpack 'patch-/bin/cat - (lambda _ - (substitute* "src/user.c" - (("/bin/cat") (which "cat"))))) - (add-before - 'configure 'pre-configure - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "meson_post_install.py" - (("in dst_dirs") "in []")) - (let ((shadow (assoc-ref inputs "shadow"))) - (substitute* '("src/user.c" "src/daemon.c") - (("/usr/sbin/usermod") - (string-append shadow "/sbin/usermod")) - (("/usr/sbin/useradd") - (string-append shadow "/sbin/useradd")) - (("/usr/sbin/userdel") - (string-append shadow "/sbin/userdel")) - (("/usr/bin/passwd") - (string-append shadow "/bin/passwd")) - (("/usr/bin/chage") - (string-append shadow "/bin/chage"))))))))) + (add-after 'unpack 'patch-docbook-references + ;; Having XML_CATALOG_FILES set is not enough; xmlto does not seem + ;; to honor it. + (lambda* (#:key inputs #:allow-other-keys) + (substitute* (find-files "." "\\.xml(\\.in)?$") + (("http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd") + (search-input-file inputs "share/xml/dbus-1/introspect.dtd")) + (("http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd") + (search-input-file inputs "xml/dtd/docbook/docbookx.dtd"))))) + (add-after 'unpack 'patch-paths + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "meson_post_install.py" + (("in dst_dirs") "in []")) + (substitute* '("src/user.c" "src/daemon.c") + (("/bin/cat") + (search-input-file inputs "bin/cat")) + (("/usr/sbin/usermod") + (search-input-file inputs "sbin/usermod")) + (("/usr/sbin/useradd") + (search-input-file inputs "sbin/useradd")) + (("/usr/sbin/userdel") + (search-input-file inputs "sbin/userdel")) + (("/usr/bin/passwd") + (search-input-file inputs "bin/passwd")) + (("/usr/bin/chage") + (search-input-file inputs "bin/chage")))))))) (native-inputs - `(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc. - ("gobject-introspection" ,gobject-introspection) - ("intltool" ,intltool) - ("pkg-config" ,pkg-config))) + (list docbook-xml-4.1.2 + docbook-xsl + `(,glib "bin") ; for gdbus-codegen, etc. + gobject-introspection + gtk-doc + intltool + libxml2 ;for XML_CATALOG_FILES + libxslt + pkg-config + python-dbusmock + python-pygobject + vala + xmlto)) (inputs - (list dbus elogind polkit shadow)) + (list dbus + elogind + polkit + shadow)) (home-page "https://www.freedesktop.org/wiki/Software/AccountsService/") (synopsis "D-Bus interface for user account query and manipulation") (description From 6da5eed4e7e5859d158b835aee6c337fdcdc58c2 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 7 Aug 2022 23:54:05 -0400 Subject: [PATCH 12/91] gnu: accountsservice: Provide a means to locate extensions. * gnu/packages/patches/accountsservice-extensions.patch: New patch. * gnu/packages/freedesktop.scm (accountsservice)[source]: Apply it. [phases]{wrap-with-xdg-data-dirs}: New phase. --- gnu/local.mk | 1 + gnu/packages/freedesktop.scm | 12 +++++++-- .../patches/accountsservice-extensions.patch | 25 +++++++++++++++++++ 3 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/accountsservice-extensions.patch diff --git a/gnu/local.mk b/gnu/local.mk index fcbbdbd1fb..462aa7c731 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -843,6 +843,7 @@ dist_patch_DATA = \ %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/accountsservice-extensions.patch \ %D%/packages/patches/aegis-constness-error.patch \ %D%/packages/patches/aegis-perl-tempdir1.patch \ %D%/packages/patches/aegis-perl-tempdir2.patch \ diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index 8ebd0e5359..ab6fb480a7 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1443,7 +1443,8 @@ (define-public accountsservice "accountsservice/accountsservice-" version ".tar.xz")) (sha256 - (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch")))) + (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch")) + (patches (search-patches "accountsservice-extensions.patch")))) (build-system meson-build-system) (arguments `(#:configure-flags @@ -1479,7 +1480,14 @@ (define-public accountsservice (("/usr/bin/passwd") (search-input-file inputs "bin/passwd")) (("/usr/bin/chage") - (search-input-file inputs "bin/chage")))))))) + (search-input-file inputs "bin/chage"))))) + (add-after 'install 'wrap-with-xdg-data-dirs + ;; This is to allow accountsservice finding extensions, which + ;; should be installed to the system profile. + (lambda* (#:key outputs #:allow-other-keys) + (wrap-program (search-input-file outputs "libexec/accounts-daemon") + '("XDG_DATA_DIRS" prefix + ("/run/current-system/profile/share")))))))) (native-inputs (list docbook-xml-4.1.2 docbook-xsl diff --git a/gnu/packages/patches/accountsservice-extensions.patch b/gnu/packages/patches/accountsservice-extensions.patch new file mode 100644 index 0000000000..2cfab580e3 --- /dev/null +++ b/gnu/packages/patches/accountsservice-extensions.patch @@ -0,0 +1,25 @@ +Patch from NixOS retrieved from +https://raw.githubusercontent.com/NixOS/nixpkgs/master/pkgs/development/libraries/accountsservice/drop-prefix-check-extensions.patch. + +diff --git a/src/extensions.c b/src/extensions.c +index 038dcb2..830465d 100644 +--- a/src/extensions.c ++++ b/src/extensions.c +@@ -121,16 +121,7 @@ daemon_read_extension_directory (GHashTable *ifaces, + continue; + } + +- /* Ensure it looks like "../../dbus-1/interfaces/${name}" */ +- const gchar * const prefix = "../../dbus-1/interfaces/"; +- if (g_str_has_prefix (symlink, prefix) && g_str_equal (symlink + strlen (prefix), name)) { +- daemon_read_extension_file (ifaces, filename); +- } +- else { +- g_warning ("Found accounts service vendor extension symlink %s, but it must be exactly " +- "equal to '../../dbus-1/interfaces/%s' for forwards-compatibility reasons.", +- filename, name); +- } ++ daemon_read_extension_file (ifaces, filename); + } + + g_dir_close (dir); From 9376411fbe5be440c40ee6ea9b8dd2f2d3429f7b Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 7 Aug 2022 09:50:39 -0400 Subject: [PATCH 13/91] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper. * gnu/packages/display-managers.scm (lightdm-gtk-greeter) [build-system]: Use glib-or-gtk-build-system. [phases]{wrap-program}: Add GDK_PIXBUF_MODULE_FILE to wrapper. [inputs]: Add librsvg. --- gnu/packages/display-managers.scm | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 6c1c5b6c25..53002f2122 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -37,6 +37,7 @@ (define-module (gnu packages display-managers) #:use-module (guix build-system cmake) #:use-module (guix build-system qt) #:use-module (guix build-system gnu) + #:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system trivial) #:use-module (guix packages) #:use-module (guix utils) @@ -347,7 +348,7 @@ (define-public lightdm-gtk-greeter (sha256 (base32 "04q62mvr97l9gv8h37hfarygqc7p0498ig7xclcg4kxkqw0b7yxy")))) - (build-system gnu-build-system) + (build-system glib-or-gtk-build-system) (arguments (list #:configure-flags @@ -376,6 +377,14 @@ (define-public lightdm-gtk-greeter (glib #$(this-package-input "glib"))) (wrap-program (search-input-file outputs "sbin/lightdm-gtk-greeter") + ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is + ;; available at all times even outside of profiles, such as + ;; when used in the lightdm-service-type. Otherwise, it + ;; wouldn't be able to display its own icons. + `("GDK_PIXBUF_MODULE_FILE" = + (,(search-input-file + inputs + "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache"))) `("XDG_DATA_DIRS" ":" prefix ,(cons "/run/current-system/profile/share" (map (lambda (pkg) @@ -388,12 +397,13 @@ (define-public lightdm-gtk-greeter (native-inputs (list exo intltool pkg-config xfce4-dev-tools)) (inputs - (list bash-minimal ;for wrap-program + (list at-spi2-core + bash-minimal ;for wrap-program + gtk+ + guile-3.0 + librsvg lightdm - shared-mime-info - at-spi2-core - glib - gtk+)) + shared-mime-info)) (synopsis "GTK+ greeter for LightDM") (home-page "https://github.com/xubuntu/lightdm-gtk-greeter") (description "This package provides a LightDM greeter implementation using From 0d23e9cda2a3777c035c36846fe7b994c818114b Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 00:54:22 -0400 Subject: [PATCH 14/91] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is. * gnu/packages/display-managers.scm (lightdm-gtk-greeter) [configure-flags]: Install binaries to bin/, so the wrap phase of glib-or-gtk handles them. [phases]{wrap-program}: Delete. {custom-wrap}: New phase, wrapping the wrapper with a few extra environment variables. --- gnu/packages/display-managers.scm | 54 +++++++++++++++---------------- 1 file changed, 26 insertions(+), 28 deletions(-) diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 53002f2122..11d5c519ea 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -54,6 +54,7 @@ (define-module (gnu packages display-managers) #:use-module (gnu packages gnome) #:use-module (gnu packages gnupg) #:use-module (gnu packages gtk) + #:use-module (gnu packages guile) #:use-module (gnu packages image) #:use-module (gnu packages kde-frameworks) #:use-module (gnu packages linux) @@ -353,6 +354,9 @@ (define-public lightdm-gtk-greeter (list #:configure-flags #~(list "--disable-indicator-services-command" ;requires upstart + ;; Put the binary under /bin rather than /sbin, so that it gets + ;; wrapped by the glib-or-gtk-wrap phase. + (string-append "--sbindir=" #$output "/bin") (string-append "--enable-at-spi-command=" (search-input-file %build-inputs "libexec/at-spi-bus-launcher"))) @@ -367,35 +371,29 @@ (define-public lightdm-gtk-greeter (("Exec=lightdm-gtk-greeter") (string-append "Exec=" (search-input-file - outputs "sbin/lightdm-gtk-greeter")))))) - (add-after 'fix-.desktop-file 'wrap-program - ;; Mimic glib-or-gtk build system which doesn't wrap files in - ;; /sbin. - (lambda* (#:key outputs inputs #:allow-other-keys) - (let ((gtk #$(this-package-input "gtk+")) - (shared-mime-info #$(this-package-input "shared-mime-info")) - (glib #$(this-package-input "glib"))) - (wrap-program (search-input-file - outputs "sbin/lightdm-gtk-greeter") - ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is - ;; available at all times even outside of profiles, such as - ;; when used in the lightdm-service-type. Otherwise, it - ;; wouldn't be able to display its own icons. - `("GDK_PIXBUF_MODULE_FILE" = - (,(search-input-file - inputs - "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache"))) - `("XDG_DATA_DIRS" ":" prefix - ,(cons "/run/current-system/profile/share" - (map (lambda (pkg) - (string-append pkg "/share")) - (list gtk shared-mime-info glib)))) - `("GTK_PATH" ":" prefix (,gtk)) - `("GIO_EXTRA_MODULES" ":" prefix (,gtk)) - '("XCURSOR_PATH" ":" prefix - ("/run/current-system/profile/share/icons"))))))))) + outputs "bin/lightdm-gtk-greeter")))))) + (add-after 'glib-or-gtk-wrap 'custom-wrap + (lambda* (#:key outputs #:allow-other-keys) + (wrap-script (search-input-file + outputs "bin/lightdm-gtk-greeter") + ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is + ;; available at all times even outside of profiles, such as + ;; when used in the lightdm-service-type. Otherwise, it + ;; wouldn't be able to display its own icons. + `("GDK_PIXBUF_MODULE_FILE" = + (,(search-input-file + outputs + "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache"))) + `("XDG_DATA_DIRS" ":" prefix + (,(string-append "/run/current-system/profile/share:" + (getenv "XDG_DATA_DIRS")))) + '("XCURSOR_PATH" ":" prefix + ("/run/current-system/profile/share/icons")))))))) (native-inputs - (list exo intltool pkg-config xfce4-dev-tools)) + (list exo + intltool + pkg-config + xfce4-dev-tools)) (inputs (list at-spi2-core bash-minimal ;for wrap-program From d0046bc13ba8c5e532c2193149a6747eb60467a3 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 01:04:12 -0400 Subject: [PATCH 15/91] gnu: lightdm-gtk-greeter: Enable libklavier support. * gnu/packages/display-managers.scm (lightdm-gtk-greeter) [configure-flags]: Add '--with-libxklavier'. [inputs]: Add libxklavier. --- gnu/packages/display-managers.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 11d5c519ea..e8f7f68c46 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -357,6 +357,7 @@ (define-public lightdm-gtk-greeter ;; Put the binary under /bin rather than /sbin, so that it gets ;; wrapped by the glib-or-gtk-wrap phase. (string-append "--sbindir=" #$output "/bin") + (string-append "--with-libxklavier") (string-append "--enable-at-spi-command=" (search-input-file %build-inputs "libexec/at-spi-bus-launcher"))) @@ -400,6 +401,7 @@ (define-public lightdm-gtk-greeter gtk+ guile-3.0 librsvg + libxklavier lightdm shared-mime-info)) (synopsis "GTK+ greeter for LightDM") From 20c8fb042c0d1c2b96e1a84e37011fb3eecf6258 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 01:05:29 -0400 Subject: [PATCH 16/91] gnu: lightdm-gtk-greeter: Adjust default config file path. * gnu/packages/display-managers.scm (lightdm-gtk-greeter) [phases]{customize-default-config-path}: New phase. --- gnu/packages/display-managers.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index e8f7f68c46..6fbefafe7d 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -364,6 +364,14 @@ (define-public lightdm-gtk-greeter #:phases #~(modify-phases %standard-phases + (add-after 'unpack 'customize-default-config-path + (lambda _ + (substitute* "src/Makefile.in" + ;; Have the default config directory sourced from + ;; /etc/lightdm/lightdm-gtk-greeter.conf, which is where the + ;; lightdm service writes it. + (("\\$\\(sysconfdir)/lightdm/lightdm-gtk-greeter.conf") + "/etc/lightdm/lightdm-gtk-greeter.conf")))) (add-after 'install 'fix-.desktop-file (lambda* (#:key outputs #:allow-other-keys) (substitute* (search-input-file From 0e76781df4be465caca9da59d467c926eb65a0da Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 01:06:28 -0400 Subject: [PATCH 17/91] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value. * gnu/packages/display-managers.scm (lightdm-gtk-greeter) [configure-flags]: Add the '--launch-immediately' option to the at-spi-bus-launcher to match what is used in the source. --- gnu/packages/display-managers.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 6fbefafe7d..d6cf9445c6 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -360,8 +360,8 @@ (define-public lightdm-gtk-greeter (string-append "--with-libxklavier") (string-append "--enable-at-spi-command=" (search-input-file - %build-inputs "libexec/at-spi-bus-launcher"))) - + %build-inputs "libexec/at-spi-bus-launcher") + " --launch-immediately")) #:phases #~(modify-phases %standard-phases (add-after 'unpack 'customize-default-config-path From da3c784c68d9d3d0ec12eaaa98deaaf51ddb4c36 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 10:24:42 -0400 Subject: [PATCH 18/91] gnu: lightdm: Apply patch to fix a problem with VNC integration. * gnu/packages/patches/lightdm-vncserver-check.patch: New patch. * gnu/local.mk (dist_patch_DATA): Register it. * gnu/packages/display-managers.scm (lightdm): Apply it. --- gnu/local.mk | 1 + gnu/packages/display-managers.scm | 7 +- .../patches/lightdm-vncserver-check.patch | 66 +++++++++++++++++++ 3 files changed, 71 insertions(+), 3 deletions(-) create mode 100644 gnu/packages/patches/lightdm-vncserver-check.patch diff --git a/gnu/local.mk b/gnu/local.mk index 462aa7c731..6a55ecc8d8 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1360,6 +1360,7 @@ dist_patch_DATA = \ %D%/packages/patches/librime-fix-build-with-gcc10.patch \ %D%/packages/patches/libvirt-add-install-prefix.patch \ %D%/packages/patches/libziparchive-add-includes.patch \ + %D%/packages/patches/lightdm-vncserver-check.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 \ diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index d6cf9445c6..022e0509aa 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -268,7 +268,8 @@ (define-public lightdm (file-name (git-file-name name version)) (sha256 (base32 - "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn")))) + "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn")) + (patches (search-patches "lightdm-vncserver-check.patch")))) (build-system gnu-build-system) (arguments '(#:parallel-tests? #f ; fails when run in parallel @@ -303,8 +304,8 @@ (define-public lightdm (unsetenv "LC_ALL")))))) (inputs (list audit - bash-minimal ;for cross-compilation - coreutils-minimal ;ditto + bash-minimal ;for cross-compilation + coreutils-minimal ;ditto linux-pam shadow ;for sbin/nologin libgcrypt diff --git a/gnu/packages/patches/lightdm-vncserver-check.patch b/gnu/packages/patches/lightdm-vncserver-check.patch new file mode 100644 index 0000000000..0e31ff3d68 --- /dev/null +++ b/gnu/packages/patches/lightdm-vncserver-check.patch @@ -0,0 +1,66 @@ +Honor the Xvnc command specified in the config instead of using a hard-coded +default. + +Submitted upstream at: https://github.com/canonical/lightdm/pull/265 + +diff --git a/src/lightdm.c b/src/lightdm.c +index 74f9ff2d..0ccfcd78 100644 +--- a/src/lightdm.c ++++ b/src/lightdm.c +@@ -349,27 +349,42 @@ start_display_manager (void) + /* Start the VNC server */ + if (config_get_boolean (config_get_instance (), "VNCServer", "enabled")) + { +- g_autofree gchar *path = g_find_program_in_path ("Xvnc"); +- if (path) ++ /* Validate that a the VNC command is available. */ ++ g_autofree gchar *command = config_get_string (config_get_instance (), "VNCServer", "command"); ++ if (command) + { +- vnc_server = vnc_server_new (); +- if (config_has_key (config_get_instance (), "VNCServer", "port")) ++ g_auto(GStrv) tokens = g_strsplit (command, " ", 2); ++ if (!g_find_program_in_path (tokens[0])) + { +- gint port = config_get_integer (config_get_instance (), "VNCServer", "port"); +- if (port > 0) +- vnc_server_set_port (vnc_server, port); ++ g_warning ("Can't start VNC server; command '%s' not found", tokens[0]); ++ return; + } +- g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address"); +- vnc_server_set_listen_address (vnc_server, listen_address); +- g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL); +- +- g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server)); +- vnc_server_start (vnc_server); + } + else +- g_warning ("Can't start VNC server, Xvnc is not in the path"); ++ { ++ /* Fallback to 'Xvnc'. */ ++ if (!g_find_program_in_path ("Xvnc")) { ++ g_warning ("Can't start VNC server; 'Xvnc' command not found"); ++ return; ++ } ++ } ++ ++ vnc_server = vnc_server_new (); ++ if (config_has_key (config_get_instance (), "VNCServer", "port")) ++ { ++ gint port = config_get_integer (config_get_instance (), "VNCServer", "port"); ++ if (port > 0) ++ vnc_server_set_port (vnc_server, port); ++ } ++ g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address"); ++ vnc_server_set_listen_address (vnc_server, listen_address); ++ g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL); ++ ++ g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server)); ++ vnc_server_start (vnc_server); + } + } ++ + static void + service_ready_cb (DisplayManagerService *service) + { From a4fd1840ab16086d6b9c4001b510d73ef5727222 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 15:47:21 -0400 Subject: [PATCH 19/91] gnu: lightdm: Apply patch to allow using VNC options. * gnu/packages/patches/lightdm-arguments-ordering.patch: New patch. * gnu/local.mk (dist_patch_DATA): Register it. * gnu/packages/display-managers.scm (lightdm): Apply it. --- gnu/local.mk | 1 + gnu/packages/display-managers.scm | 3 +- .../patches/lightdm-arguments-ordering.patch | 54 +++++++++++++++++++ 3 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/lightdm-arguments-ordering.patch diff --git a/gnu/local.mk b/gnu/local.mk index 6a55ecc8d8..396f227188 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1360,6 +1360,7 @@ dist_patch_DATA = \ %D%/packages/patches/librime-fix-build-with-gcc10.patch \ %D%/packages/patches/libvirt-add-install-prefix.patch \ %D%/packages/patches/libziparchive-add-includes.patch \ + %D%/packages/patches/lightdm-arguments-ordering.patch \ %D%/packages/patches/lightdm-vncserver-check.patch \ %D%/packages/patches/localed-xorg-keyboard.patch \ %D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \ diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 022e0509aa..2a0a72d145 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -269,7 +269,8 @@ (define-public lightdm (sha256 (base32 "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn")) - (patches (search-patches "lightdm-vncserver-check.patch")))) + (patches (search-patches "lightdm-arguments-ordering.patch" + "lightdm-vncserver-check.patch")))) (build-system gnu-build-system) (arguments '(#:parallel-tests? #f ; fails when run in parallel diff --git a/gnu/packages/patches/lightdm-arguments-ordering.patch b/gnu/packages/patches/lightdm-arguments-ordering.patch new file mode 100644 index 0000000000..c3b513a19a --- /dev/null +++ b/gnu/packages/patches/lightdm-arguments-ordering.patch @@ -0,0 +1,54 @@ +When providing the VNCServer command as 'Xvnc -SecurityTypes None', +the formatted command line used would look like: + + Xvnc -SecurityTypes None :1 -auth /var/run/lightdm/root/:1 + +which is invalid (the display number must appear first). + +Submitted upstream at: https://github.com/canonical/lightdm/pull/265 + + src/x-server-local.c | 14 +++++++++++++- + 1 file changed, 13 insertions(+), 1 deletion(-) + +diff --git a/src/x-server-local.c b/src/x-server-local.c +index 7c4ab870..6c540d18 100644 +--- a/src/x-server-local.c ++++ b/src/x-server-local.c +@@ -463,14 +463,20 @@ x_server_local_start (DisplayServer *display_server) + l_debug (display_server, "Logging to %s", log_file); + + g_autofree gchar *absolute_command = get_absolute_command (priv->command); ++ g_auto(GStrv) tokens = g_strsplit (absolute_command, " ", 2); ++ const gchar* binary = tokens[0]; ++ const gchar *extra_options = tokens[1]; ++ + if (!absolute_command) + { + l_debug (display_server, "Can't launch X server %s, not found in path", priv->command); + stopped_cb (priv->x_server_process, X_SERVER_LOCAL (server)); + return FALSE; + } +- g_autoptr(GString) command = g_string_new (absolute_command); ++ g_autoptr(GString) command = g_string_new (binary); + ++ /* The display argument must be given first when the X server used ++ * is Xvnc. */ + g_string_append_printf (command, " :%d", priv->display_number); + + if (priv->config_file) +@@ -513,6 +519,12 @@ x_server_local_start (DisplayServer *display_server) + if (X_SERVER_LOCAL_GET_CLASS (server)->add_args) + X_SERVER_LOCAL_GET_CLASS (server)->add_args (server, command); + ++ /* Any extra user options provided via the VNCServer 'command' ++ * config option are appended last, so the user can override any ++ * of the above. */ ++ if (extra_options) ++ g_string_append_printf (command, " %s", extra_options); ++ + process_set_command (priv->x_server_process, command->str); + + l_debug (display_server, "Launching X Server"); +-- +2.36.1 + From b096b939f74913cfed5ed3efb5701a9132854760 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 9 Aug 2022 16:17:45 -0400 Subject: [PATCH 20/91] gnu: lightdm: Apply patch to fix color depth issue with VNC. * gnu/packages/patches/lightdm-vnc-color-depth.patch: New patch. * gnu/local.mk (dist_patch_DATA): Register it. * gnu/packages/display-managers.scm (lightdm): Apply it. --- gnu/local.mk | 1 + gnu/packages/display-managers.scm | 3 +- .../patches/lightdm-vnc-color-depth.patch | 81 +++++++++++++++++++ 3 files changed, 84 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/lightdm-vnc-color-depth.patch diff --git a/gnu/local.mk b/gnu/local.mk index 396f227188..a9aebe5193 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1362,6 +1362,7 @@ dist_patch_DATA = \ %D%/packages/patches/libziparchive-add-includes.patch \ %D%/packages/patches/lightdm-arguments-ordering.patch \ %D%/packages/patches/lightdm-vncserver-check.patch \ + %D%/packages/patches/lightdm-vnc-color-depth.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 \ diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm index 2a0a72d145..137bd2739e 100644 --- a/gnu/packages/display-managers.scm +++ b/gnu/packages/display-managers.scm @@ -270,7 +270,8 @@ (define-public lightdm (base32 "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn")) (patches (search-patches "lightdm-arguments-ordering.patch" - "lightdm-vncserver-check.patch")))) + "lightdm-vncserver-check.patch" + "lightdm-vnc-color-depth.patch")))) (build-system gnu-build-system) (arguments '(#:parallel-tests? #f ; fails when run in parallel diff --git a/gnu/packages/patches/lightdm-vnc-color-depth.patch b/gnu/packages/patches/lightdm-vnc-color-depth.patch new file mode 100644 index 0000000000..cd69977d6a --- /dev/null +++ b/gnu/packages/patches/lightdm-vnc-color-depth.patch @@ -0,0 +1,81 @@ +There is no longer support for 8 bit color depth in TigerVNC (see: +https://github.com/TigerVNC/tigervnc/commit/e86d8720ba1e79b486ca29a5c2b27fa25811e6a2); +using it causes a fatal error. + +Submitted upstream at: https://github.com/canonical/lightdm/pull/265. + +diff --git a/data/lightdm.conf b/data/lightdm.conf +index 0df38429..60e3e8b4 100644 +--- a/data/lightdm.conf ++++ b/data/lightdm.conf +@@ -160,4 +160,4 @@ + #listen-address= + #width=1024 + #height=768 +-#depth=8 ++#depth=24 +diff --git a/src/x-server-xvnc.c b/src/x-server-xvnc.c +index 68340d53..27ca4454 100644 +--- a/src/x-server-xvnc.c ++++ b/src/x-server-xvnc.c +@@ -127,7 +127,7 @@ x_server_xvnc_init (XServerXVNC *server) + XServerXVNCPrivate *priv = x_server_xvnc_get_instance_private (server); + priv->width = 1024; + priv->height = 768; +- priv->depth = 8; ++ priv->depth = 24; + } + + static void +diff --git a/tests/scripts/vnc-command.conf b/tests/scripts/vnc-command.conf +index 0f1e25fd..335956d9 100644 +--- a/tests/scripts/vnc-command.conf ++++ b/tests/scripts/vnc-command.conf +@@ -19,7 +19,7 @@ command=Xvnc -option + #?VNC-CLIENT CONNECT + + # Xvnc server starts +-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=TRUE ++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=TRUE + + # Daemon connects when X server is ready + #?*XVNC-0 INDICATE-READY +diff --git a/tests/scripts/vnc-guest.conf b/tests/scripts/vnc-guest.conf +index 431bb244..ce2b97db 100644 +--- a/tests/scripts/vnc-guest.conf ++++ b/tests/scripts/vnc-guest.conf +@@ -21,7 +21,7 @@ user-session=default + #?VNC-CLIENT CONNECT + + # Xvnc server starts +-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE ++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE + + # Daemon connects when X server is ready + #?*XVNC-0 INDICATE-READY +diff --git a/tests/scripts/vnc-login.conf b/tests/scripts/vnc-login.conf +index cdfe17b8..f0d65b7f 100644 +--- a/tests/scripts/vnc-login.conf ++++ b/tests/scripts/vnc-login.conf +@@ -21,7 +21,7 @@ user-session=default + #?VNC-CLIENT CONNECT + + # Xvnc server starts +-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE ++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE + + # Daemon connects when X server is ready + #?*XVNC-0 INDICATE-READY +diff --git a/tests/scripts/vnc-open-file-descriptors.conf b/tests/scripts/vnc-open-file-descriptors.conf +index 753c84dd..e5d35730 100644 +--- a/tests/scripts/vnc-open-file-descriptors.conf ++++ b/tests/scripts/vnc-open-file-descriptors.conf +@@ -21,7 +21,7 @@ user-session=default + #?VNC-CLIENT CONNECT + + # Xvnc server starts +-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE ++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE + + # Daemon connects when X server is ready + #?*XVNC-0 INDICATE-READY From 697b797160f8145f282767cedd66be2d7297fe1e Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 12 Aug 2022 08:53:46 -0400 Subject: [PATCH 21/91] marionette: Improve the error message of 'wait-for-screen-text'. * gnu/build/marionette.scm (wait-for-screen-text): Return the last OCR'd text when the predicate fails to match instead of the not useful predicate object. --- gnu/build/marionette.scm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 4f409166db..24170bbd30 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016-2022 Ludovic Courtès ;;; Copyright © 2018 Chris Marusich +;;; Copyright © 2022 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -308,13 +309,14 @@ (define start (define end (+ start timeout)) - (let loop () + (let loop ((last-text #f)) (if (> (car (gettimeofday)) end) - (error "'wait-for-screen-text' timeout" predicate) - (or (predicate (marionette-screen-text marionette #:ocrad ocrad)) - (begin - (sleep 1) - (loop)))))) + (error "'wait-for-screen-text' timeout" 'ocr-text: last-text) + (let ((text (marionette-screen-text marionette #:ocrad ocrad))) + (or (predicate text) + (begin + (sleep 1) + (loop text))))))) (define %qwerty-us-keystrokes ;; Maps "special" characters to their keystrokes. From 42fee6d0f176aea5d208e3e6d8b5270abcf4173c Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 12 Aug 2022 11:23:29 -0400 Subject: [PATCH 22/91] build: marionette: Add support for Tesseract OCR. * gnu/build/marionette.scm (invoke-ocrad-ocr): New procedure. (invoke-tesseract-ocr): Likewise. (marionette-screen-text): Rename the #:ocrad argument to #:ocr. Dispatch the matching OCR invocation procedure. (wait-for-screen-text): Rename the #:ocrad argument to #:ocr. * gnu/tests/base.scm (run-basic-test): Adjust accordingly. * gnu/tests/install.scm (enter-luks-passphrase): Likewise. (enter-luks-passphrase-for-home): Likewise. --- gnu/build/marionette.scm | 65 +++++++++++++++++++++++----------------- gnu/tests/base.scm | 4 +-- gnu/tests/install.scm | 8 ++--- 3 files changed, 44 insertions(+), 33 deletions(-) diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 24170bbd30..06b699bd7b 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -268,39 +268,50 @@ (define (marionette-control command marionette) ;; The "quit" command terminates QEMU immediately, with no output. (unless (string=? command "quit") (wait-for-monitor-prompt monitor))))) -(define* (marionette-screen-text marionette - #:key - (ocrad "ocrad")) - "Take a screenshot of MARIONETTE, perform optical character -recognition (OCR), and return the text read from the screen as a string. Do -this by invoking OCRAD (file name for GNU Ocrad's command)" - (define (random-file-name) - (string-append "/tmp/marionette-screenshot-" - (number->string (random (expt 2 32)) 16) - ".ppm")) +(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")) + "Invoke the OCRAD command on image, and return the recognized text." + (let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image)) + (text (get-string-all pipe))) + (unless (zero? (close-pipe pipe)) + (error "'ocrad' failed" ocrad)) + text)) - (let ((image (random-file-name))) +(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract")) + "Invoke the TESSERACT command on IMAGE, and return the recognized text." + (let* ((output-basename (tmpnam)) + (output-basename* (string-append output-basename ".txt"))) (dynamic-wind (const #t) (lambda () - (marionette-control (string-append "screendump " image) - marionette) - - ;; Tell Ocrad to invert the image colors (make it black on white) and - ;; to scale the image up, which significantly improves the quality of - ;; the result. In spite of this, be aware that OCR confuses "y" and - ;; "V" and sometimes erroneously introduces white space. - (let* ((pipe (open-pipe* OPEN_READ ocrad - "-i" "-s" "10" image)) - (text (get-string-all pipe))) - (unless (zero? (close-pipe pipe)) - (error "'ocrad' failed" ocrad)) - text)) + (let ((exit-val (status:exit-val + (system* tesseract image output-basename)))) + (unless (zero? exit-val) + (error "'tesseract' failed" tesseract)) + (call-with-input-file output-basename* get-string-all))) (lambda () - (false-if-exception (delete-file image)))))) + (false-if-exception (delete-file output-basename)) + (false-if-exception (delete-file output-basename*)))))) + +(define* (marionette-screen-text marionette #:key (ocr "ocrad")) + "Take a screenshot of MARIONETTE, perform optical character +recognition (OCR), and return the text read from the screen as a string. Do +this by invoking OCR, which should be the file name of GNU Ocrad's +@command{ocrad} or Tesseract OCR's @command{tesseract} command." + (define image (string-append (tmpnam) ".ppm")) + ;; Use the QEMU Monitor to save an image of the screen to the host. + (marionette-control (string-append "screendump " image) marionette) + ;; Process it via the OCR. + (cond + ((string-contains ocr "ocrad") + (invoke-ocrad-ocr image #:ocrad ocr)) + ((string-contains ocr "tesseract") + (invoke-tesseract-ocr image #:tesseract ocr)) + (else (error "unsupported ocr command")))) (define* (wait-for-screen-text marionette predicate - #:key (timeout 30) (ocrad "ocrad")) + #:key + (ocr "ocrad") + (timeout 30)) "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded." (define start @@ -312,7 +323,7 @@ (define end (let loop ((last-text #f)) (if (> (car (gettimeofday)) end) (error "'wait-for-screen-text' timeout" 'ocr-text: last-text) - (let ((text (marionette-screen-text marionette #:ocrad ocrad))) + (let ((text (marionette-screen-text marionette #:ocr ocr))) (or (predicate text) (begin (sleep 1) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 353d6d415a..636b127fb8 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -341,7 +341,7 @@ (define (user-owned? file) (wait-for-screen-text marionette (lambda (text) (string-contains text "Password")) - #:ocrad + #:ocr #$(file-append ocrad "/bin/ocrad")) (marionette-type (string-append password "\n\n") marionette)) @@ -510,7 +510,7 @@ (define (entry->list entry) (test-assert "screen text" (let ((text (marionette-screen-text marionette - #:ocrad + #:ocr #$(file-append ocrad "/bin/ocrad")))) ;; Check whether the welcome message and shell prompt are diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index fbb97d451c..4e0e274e66 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -784,7 +784,7 @@ (define (bios-boot-screen? text) ;; At this point we have no choice but to use OCR to determine ;; when the passphrase should be entered. (wait-for-screen-text #$marionette passphrase-prompt? - #:ocrad #$ocrad) + #:ocr #$ocrad) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) @@ -792,7 +792,7 @@ (define (bios-boot-screen? text) ;; we can then be sure we match the "Enter passphrase" prompt from ;; 'cryptsetup', in the initrd. (wait-for-screen-text #$marionette (negate bios-boot-screen?) - #:ocrad #$ocrad + #:ocr #$ocrad #:timeout 20))) (test-assert "enter LUKS passphrase for the initrd" @@ -800,7 +800,7 @@ (define (bios-boot-screen? text) ;; XXX: Here we use OCR as well but we could instead use QEMU ;; '-serial stdio' and run it in an input pipe, (wait-for-screen-text #$marionette passphrase-prompt? - #:ocrad #$ocrad + #:ocr #$ocrad #:timeout 60) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) @@ -999,7 +999,7 @@ (define (passphrase-prompt? text) ;; XXX: Here we use OCR as well but we could instead use QEMU ;; '-serial stdio' and run it in an input pipe, (wait-for-screen-text #$marionette passphrase-prompt? - #:ocrad #$ocrad + #:ocr #$ocrad #:timeout 120) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) From 0ea62e84a787fe94cfeadf67ef27ea995a382b84 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 3 Aug 2022 23:41:35 -0400 Subject: [PATCH 23/91] services: Add lightdm-service-type. * gnu/services/lightdm.scm: New service. * tests/services/lightdm.scm: Test it. * doc/guix.texi (X Window): Document it. * gnu/local.mk (GNU_SYSTEM_MODULES): Register it. Co-authored-by: L p R n d n Co-authored-by: Ricardo Wurmus --- Makefile.am | 1 + doc/guix.texi | 202 +++++++++++ gnu/local.mk | 1 + gnu/services/lightdm.scm | 687 +++++++++++++++++++++++++++++++++++++ gnu/tests/lightdm.scm | 160 +++++++++ tests/services/lightdm.scm | 52 +++ 6 files changed, 1103 insertions(+) create mode 100644 gnu/services/lightdm.scm create mode 100644 gnu/tests/lightdm.scm create mode 100644 tests/services/lightdm.scm diff --git a/Makefile.am b/Makefile.am index 8df8222573..502ca73866 100644 --- a/Makefile.am +++ b/Makefile.am @@ -533,6 +533,7 @@ SCM_TESTS = \ tests/services.scm \ tests/services/file-sharing.scm \ tests/services/configuration.scm \ + tests/services/lightdm.scm \ tests/services/linux.scm \ tests/services/telephony.scm \ tests/sets.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 4f6973518f..7199ff6bc2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21278,6 +21278,208 @@ Relogin after logout. @end table @end deftp +@cindex lightdm, graphical login manager +@cindex display manager, lightdm +@defvr {Scheme Variable} lightdm-service-type +This is the type of the service to run the +@url{https://github.com/canonical/lightdm,LightDM display manager}. Its +value must be a @code{lightdm-configuration} record, which is documented +below. Among its distinguishing features are TigerVNC integration for +easily remoting your desktop as well as support for the XDMCP protocol, +which can be used by remote clients to start a session from the login +manager. + +In its most basic form, it can be used simply as: + +@lisp +(service lightdm-service-type) +@end lisp + +A more elaborate example making use of the VNC capabilities and enabling +more features and verbose logs could look like: + +@lisp +(service lightdm-service-type + (lightdm-configuration + (allow-empty-passwords? #t) + (xdmcp? #t) + (vnc-server? #t) + (vnc-server-command + (file-append tigervnc-server "/bin/Xvnc" + " -SecurityTypes None")) + (seats + (list (lightdm-seat-configuration + (name "*") + (user-session "ratpoison")))))) +@end lisp +@end defvr + +@c The LightDM service documentation can be auto-generated via the +@c 'generate-doc' procedure at the bottom of the (gnu services lightdm) +@c module. +@c %start of fragment +@deftp {Data Type} lightdm-configuration +Available @code{lightdm-configuration} fields are: + +@table @asis +@item @code{lightdm} (default: @code{lightdm}) (type: file-like) +The lightdm package to use. + +@item @code{allow-empty-passwords?} (default: @code{#f}) (type: boolean) +Whether users not having a password set can login. + +@item @code{debug?} (default: @code{#f}) (type: boolean) +Enable verbose output. + +@item @code{xorg-configuration} (type: xorg-configuration) +The default Xorg server configuration to use to generate the Xorg server +start script. It can be refined per seat via the @code{xserver-command} +of the @code{} record, if desired. + +@item @code{greeters} (type: list-of-greeter-configurations) +The LightDM greeter configurations specifying the greeters to use. + +@item @code{seats} (type: list-of-seat-configurations) +The seat configurations to use. A LightDM seat is akin to a user. + +@item @code{xdmcp?} (default: @code{#f}) (type: boolean) +Whether a XDMCP server should listen on port UDP 177. + +@item @code{xdmcp-listen-address} (type: maybe-string) +The host or IP address the XDMCP server listens for incoming +connections. When unspecified, listen on for any hosts/IP addresses. + +@item @code{vnc-server?} (default: @code{#f}) (type: boolean) +Whether a VNC server is started. + +@item @code{vnc-server-command} (type: file-like) +The Xvnc command to use for the VNC server, it's possible to provide +extra options not otherwise exposed along the command, for example to +disable security: + +@lisp +(vnc-server-command (file-append tigervnc-server "/bin/Xvnc" + " -SecurityTypes None" )) +@end lisp + +Or to set a PasswordFile for the classic (unsecure) VncAuth +mecanism: + +@lisp +(vnc-server-command (file-append tigervnc-server "/bin/Xvnc" + " -PasswordFile /var/lib/lightdm/.vnc/passwd")) +@end lisp + +The password file should be manually created using the +@command{vncpasswd} command. Note that LightDM will create new sessions +for VNC users, which means they need to authenticate in the same way as +local users would. + +@item @code{vnc-server-listen-address} (type: maybe-string) +The host or IP address the VNC server listens for incoming connections. +When unspecified, listen for any hosts/IP addresses. + +@item @code{vnc-server-port} (default: @code{5900}) (type: number) +The TCP port the VNC server should listen to. + +@item @code{extra-config} (default: @code{()}) (type: list-of-strings) +Extra configuration values to append to the LightDM configuration file. + +@end table +@end deftp + + +@c %end of fragment +@c %start of fragment + +@deftp {Data Type} lightdm-gtk-greeter-configuration +Available @code{lightdm-gtk-greeter-configuration} fields are: + +@table @asis +@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like) +The lightdm-gtk-greeter package to use. + +@item @code{assets} @ +(default: @code{(adwaita-icon-theme gnome-themes-extrahicolor-icon-theme)}) @ +(type: list-of-file-likes) +The list of packages complementing the greeter, such as package +providing icon themes. + +@item @code{theme-name} (default: @code{"Adwaita"}) (type: string) +The name of the theme to use. + +@item @code{icon-theme-name} (default: @code{"Adwaita"}) (type: string) +The name of the icon theme to use. + +@item @code{cursor-theme-name} (default: @code{"Adwaita"}) (type: string) +The name of the cursor theme to use. + +@item @code{cursor-theme-size} (default: @code{16}) (type: number) +The size to use for the the cursor theme. + +@item @code{allow-debugging?} (type: maybe-boolean) +Set to #t to enable debug log level. + +@item @code{background} (type: file-like) +The background image to use. + +@item @code{at-spi-enabled?} (default: @code{#f}) (type: boolean) +Enable accessibility support through the Assistive Technology Service +Provider Interface (AT-SPI). + +@item @code{a11y-states} @ +(default: @code{(contrast font keyboard reader)}) (type: list-of-a11y-states) +The accessibility features to enable, given as list of symbols. + +@item @code{reader} (type: maybe-file-like) +The command to use to launch a screen reader. + +@item @code{extra-config} (default: @code{()}) (type: list-of-strings) +Extra configuration values to append to the LightDM GTK Greeter +configuration file. + +@end table +@end deftp + +@c %end of fragment +@c %start of fragment + +@deftp {Data Type} lightdm-seat-configuration +Available @code{lightdm-seat-configuration} fields are: + +@table @asis +@item @code{name} (type: seat-name) +The name of the seat. An asterisk (*) can be used in the name to apply +the seat configuration to all the seat names it matches. + +@item @code{user-session} (type: maybe-string) +The session to use by default. The session name must be provided as a +lowercase string, such as @code{"gnome"}, @code{"ratpoison"}, etc. + +@item @code{type} (default: @code{local}) (type: seat-type) +The type of the seat, either the @code{local} or @code{xremote} symbol. + +@item @code{autologin-user} (type: maybe-string) +The username to automatically log in with by default. + +@item @code{greeter-session} @ +(default: @code{lightdm-gtk-greeter}) (type: greeter-session) +The greeter session to use, specified as a symbol. Currently, only +@code{lightdm-gtk-greeter} is supported. + +@item @code{xserver-command} (type: maybe-file-like) +The Xorg server command to run. + +@item @code{session-wrapper} (type: file-like) +The xinitrc session wrapper to use. + +@item @code{extra-config} (default: @code{()}) (type: list-of-strings) +Extra configuration values to append to the seat configuration section. + +@end table +@end deftp +@c %end of fragment + @cindex Xorg, configuration @deftp {Data Type} xorg-configuration diff --git a/gnu/local.mk b/gnu/local.mk index a9aebe5193..b67dfac4e7 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -661,6 +661,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/guix.scm \ %D%/services/hurd.scm \ %D%/services/kerberos.scm \ + %D%/services/lightdm.scm \ %D%/services/linux.scm \ %D%/services/lirc.scm \ %D%/services/virtualization.scm \ diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm new file mode 100644 index 0000000000..07f2e808dd --- /dev/null +++ b/gnu/services/lightdm.scm @@ -0,0 +1,687 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019, 2020 L p R n d n +;;; Copyright © 2020 Ricardo Wurmus +;;; Copyright © 2022 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services lightdm) + #:use-module (gnu artwork) + #:use-module (gnu packages admin) + #:use-module (gnu packages display-managers) + #:use-module (gnu packages freedesktop) + #:use-module (gnu packages gnome) + #:use-module (gnu packages vnc) + #:use-module (gnu packages xorg) + #:use-module (gnu services configuration) + #:use-module (gnu services dbus) + #:use-module (gnu services desktop) + #:use-module (gnu services shepherd) + #:use-module (gnu services xorg) + #:use-module (gnu services) + #:use-module (gnu system pam) + #:use-module (gnu system shadow) + #:use-module (guix diagnostics) + #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix records) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (lightdm-seat-configuration + lightdm-seat-configuration? + lightdm-seat-configuration-name + lightdm-seat-configuration-type + lightdm-seat-configuration-user-session + lightdm-seat-configuration-autologin-user + lightdm-seat-configuration-greeter-session + lightdm-seat-configuration-xserver-command + lightdm-seat-configuration-session-wrapper + lightdm-seat-configuration-extra-config + + lightdm-gtk-greeter-configuration + lightdm-gtk-greeter-configuration? + lightdm-gtk-greeter-configuration-lightdm-gtk-greeter + lightdm-gtk-greeter-configuration-assets + lightdm-gtk-greeter-configuration-theme-name + lightdm-gtk-greeter-configuration-icon-theme-name + lightdm-gtk-greeter-configuration-cursor-theme-name + lightdm-gtk-greeter-configuration-allow-debug + lightdm-gtk-greeter-configuration-background + lightdm-gtk-greeter-configuration-a11y-states + lightdm-gtk-greeter-configuration-reader + lightdm-gtk-greeter-configuration-extra-config + + lightdm-configuration + lightdm-configuration? + lightdm-configuration-lightdm + lightdm-configuration-allow-empty-passwords? + lightdm-configuration-xorg-configuration + lightdm-configuration-greeters + lightdm-configuration-seats + lightdm-configuration-xdmcp? + lightdm-configuration-xdmcp-listen-address + lightdm-configuration-vnc-server? + lightdm-configuration-vnc-server-command + lightdm-configuration-vnc-server-listen-address + lightdm-configuration-vnc-server-port + lightdm-configuration-extra-config + + lightdm-service-type)) + +;;; +;;; Greeters. +;;; + +(define list-of-file-likes? + (list-of file-like?)) + +(define %a11y-states '(contrast font keyboard reader)) + +(define (a11y-state? value) + (memq value %a11y-states)) + +(define list-of-a11y-states? + (list-of a11y-state?)) + +(define-maybe boolean) + +(define (serialize-boolean name value) + (define (strip-trailing-? name) + ;; field? -> field + (let ((str (symbol->string name))) + (if (string-suffix? "?" str) + (string-drop-right str 1) + str))) + (format #f "~a=~:[false~;true~]~%" (strip-trailing-? name) value)) + +(define-maybe file-like) + +(define (serialize-file-like name value) + #~(format #f "~a=~a~%" '#$name #$value)) + +(define (serialize-list-of-a11y-states name value) + (format #f "~a=~a~%" name (string-join (map symbol->string value) ";"))) + +(define (serialize-string name value) + (format #f "~a=~a~%" name value)) + +(define (serialize-number name value) + (format #f "~a=~a~%" name value)) + +(define (serialize-list-of-strings _ value) + (string-join value "\n")) + +(define-configuration lightdm-gtk-greeter-configuration + (lightdm-gtk-greeter + (file-like lightdm-gtk-greeter) + "The lightdm-gtk-greeter package to use." + empty-serializer) + (assets + (list-of-file-likes (list adwaita-icon-theme + gnome-themes-extra + ;; FIXME: hicolor-icon-theme should be in the + ;; packages of the desktop templates. + hicolor-icon-theme)) + "The list of packages complementing the greeter, such as package providing +icon themes." + empty-serializer) + (theme-name + (string "Adwaita") + "The name of the theme to use.") + (icon-theme-name + (string "Adwaita") + "The name of the icon theme to use.") + (cursor-theme-name + (string "Adwaita") + "The name of the cursor theme to use.") + (cursor-theme-size + (number 16) + "The size to use for the the cursor theme.") + (allow-debugging? + maybe-boolean + "Set to #t to enable debug log level.") + (background + (file-like (file-append %artwork-repository + "/backgrounds/guix-checkered-16-9.svg")) + "The background image to use.") + ;; FIXME: This should be enabled by default, but it currently doesn't work, + ;; failing to connect to D-Bus, causing the login to fail. + (at-spi-enabled? + (boolean #f) + "Enable accessibility support through the Assistive Technology Service +Provider Interface (AT-SPI).") + (a11y-states + (list-of-a11y-states %a11y-states) + "The accessibility features to enable, given as list of symbols.") + (reader + maybe-file-like + "The command to use to launch a screen reader.") + (extra-config + (list-of-strings '()) + "Extra configuration values to append to the LightDM GTK Greeter +configuration file.")) + +(define (strip-class-name-brackets name) + "Remove the '<<' and '>>' brackets from NAME, a symbol." + (let ((name* (symbol->string name))) + (if (and (string-prefix? "<<" name*) + (string-suffix? ">>" name*)) + (string->symbol (string-drop (string-drop-right name* 2) 2)) + (error "unexpected class name" name*)))) + +(define (config->name config) + "Return the constructor name (a symbol) from CONFIG." + (strip-class-name-brackets (class-name (class-of config)))) + +(define (greeter-configuration->greeter-fields config) + "Return the fields of CONFIG, a greeter configuration." + (match config + ;; Note: register any new greeter configuration here. + ((? lightdm-gtk-greeter-configuration?) + lightdm-gtk-greeter-configuration-fields))) + +(define (greeter-configuration->packages config) + "Return the list of greeter packages, including assets, used by CONFIG, a +greeter configuration." + (match config + ;; Note: register any new greeter configuration here. + ((? lightdm-gtk-greeter-configuration?) + (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config) + (lightdm-gtk-greeter-configuration-assets config))))) + +;;; TODO: Implement directly in (gnu services configuration), perhaps by +;;; making the FIELDS argument optional. +(define (serialize-configuration* config) + "Like `serialize-configuration', but not requiring to provide a FIELDS +argument." + (define fields (greeter-configuration->greeter-fields config)) + (serialize-configuration config fields)) + +(define (greeter-configuration->conf-name config) + "Return the file name of CONFIG, a greeter configuration." + (format #f "~a.conf" (greeter-configuration->greeter-session config))) + +(define (greeter-configuration->file config) + "Serialize CONFIG into a file under the output directory, so that it can be +easily added to XDG_CONF_DIRS." + (computed-file + (greeter-configuration->conf-name config) + #~(begin + (call-with-output-file #$output + (lambda (port) + (format port (string-append + "[greeter]\n" + #$(serialize-configuration* config)))))))) + + +;;; +;;; Seats. +;;; + +(define seat-name? string?) + +(define (serialize-seat-name _ value) + (format #f "[Seat:~a]~%" value)) + +(define (seat-type? type) + (memq type '(local xremote))) + +(define (serialize-seat-type name value) + (format #f "~a=~a~%" name value)) + +(define-maybe seat-type) + +(define (greeter-session? value) + (memq value '(lightdm-gtk-greeter))) + +(define (serialize-greeter-session name value) + (format #f "~a=~a~%" name value)) + +(define-maybe greeter-session) + +(define-maybe string) + +;;; Note: all the fields except for the seat name should be 'maybe's, since +;;; the real default value is set by the %lightdm-seat-default define later, +;;; and this avoids repeating ourselves in the serialized configuration file. +(define-configuration lightdm-seat-configuration + (name + seat-name + "The name of the seat. An asterisk (*) can be used in the name +to apply the seat configuration to all the seat names it matches.") + (user-session + maybe-string + "The session to use by default. The session name must be provided as a +lowercase string, such as @code{\"gnome\"}, @code{\"ratpoison\"}, etc.") + (type + (seat-type 'local) + "The type of the seat, either the @code{local} or @code{xremote} symbol.") + (autologin-user + maybe-string + "The username to automatically log in with by default.") + (greeter-session + (greeter-session 'lightdm-gtk-greeter) + "The greeter session to use, specified as a symbol. Currently, only +@code{lightdm-gtk-greeter} is supported.") + ;; Note: xserver-command must be lazily computed, so that it can be + ;; overridden via 'lightdm-configuration-xorg-configuration'. + (xserver-command + maybe-file-like + "The Xorg server command to run.") + (session-wrapper + (file-like (xinitrc)) + "The xinitrc session wrapper to use.") + (extra-config + (list-of-strings '()) + "Extra configuration values to append to the seat configuration section.")) + +(define (greeter-session->greater-configuration-pred identifier) + "Return the predicate to check if a configuration is of the type specifying +a greeter identified by IDENTIFIER." + (match identifier + ;; Note: register any new greeter identifier here. + ('lightdm-gtk-greeter + lightdm-gtk-greeter-configuration?))) + +(define (greeter-configuration->greeter-session config) + "Given CONFIG, a greeter configuration object, return its identifier, +a symbol." + (let ((suffix "-configuration") + (greeter-conf-name (config->name config))) + (string->symbol (string-drop-right (symbol->string greeter-conf-name) + (string-length suffix))))) + +(define list-of-seat-configurations? + (list-of lightdm-seat-configuration?)) + + +;;; +;;; LightDM. +;;; + +(define (greeter-configuration? config) + (or (lightdm-gtk-greeter-configuration? config) + ;; Note: register any new greeter configuration here. + )) + +(define (list-of-greeter-configurations? greeter-configs) + (and ((list-of greeter-configuration?) greeter-configs) + ;; Greeter configurations must also not be provided more than once. + (let* ((types (map (cut (compose class-name class-of) <>) + greeter-configs)) + (dupes (filter (lambda (type) + (< 1 (count (cut eq? type <>) types))) + types))) + (unless (null? dupes) + (leave (G_ "duplicate greeter configurations: ~a~%") dupes))))) + +(define-configuration/no-serialization lightdm-configuration + (lightdm + (file-like lightdm) + "The lightdm package to use.") + (allow-empty-passwords? + (boolean #f) + "Whether users not having a password set can login.") + (debug? + (boolean #f) + "Enable verbose output.") + (xorg-configuration + (xorg-configuration (xorg-configuration)) + "The default Xorg server configuration to use to generate the Xorg server +start script. It can be refined per seat via the @code{xserver-command} of +the @code{} record, if desired.") + (greeters + (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration))) + "The LightDM greeter configurations specifying the greeters to use.") + (seats + (list-of-seat-configurations (list (lightdm-seat-configuration + (name "*")))) + "The seat configurations to use. A LightDM seat is akin to a user.") + (xdmcp? + (boolean #f) + "Whether a XDMCP server should listen on port UDP 177.") + (xdmcp-listen-address + maybe-string + "The host or IP address the XDMCP server listens for incoming connections. +When unspecified, listen on for any hosts/IP addresses.") + (vnc-server? + (boolean #f) + "Whether a VNC server is started.") + (vnc-server-command + (file-like (file-append tigervnc-server "bin/Xvnc")) + "The Xvnc command to use for the VNC server, it's possible to provide extra +options not otherwise exposed along the command, for example to disable +security: +@lisp +(vnc-server-command + (file-append tigervnc-server \"/bin/Xvnc\" + \" -SecurityTypes None\" )) +@end lisp + +Or to set a PasswordFile for the classic (unsecure) VncAuth mecanism: +@lisp +(vnc-server-command + (file-append tigervnc-server \"/bin/Xvnc\" + \" -PasswordFile /var/lib/lightdm/.vnc/passwd\")) +@end lisp +The password file should be manually created using the @command{vncpasswd} +command. + +Note that LightDM will create new sessions for VNC users, which means they +need to authenticate in the same way as local users would. +") + (vnc-server-listen-address + maybe-string + "The host or IP address the VNC server listens for incoming connections. +When unspecified, listen for any hosts/IP addresses.") + (vnc-server-port + (number 5900) + "The TCP port the VNC server should listen to.") + (extra-config + (list-of-strings '()) + "Extra configuration values to append to the LightDM configuration file.")) + +(define (lightdm-configuration->greeters-config-dir config) + "Return a directory containing all the serialized greeter configurations +from CONFIG, a object." + (file-union "etc-lightdm" + (append-map (lambda (g) + `((,(greeter-configuration->conf-name g) + ,(greeter-configuration->file g)))) + (lightdm-configuration-greeters config)))) + +(define (lightdm-configuration->packages config) + "Return all the greeter packages and their assets defined in CONFIG, a + object, as well as the lightdm package itself." + (cons (lightdm-configuration-lightdm config) + (append-map greeter-configuration->packages + (lightdm-configuration-greeters config)))) + +(define (validate-lightdm-configuration config) + "Sanity check CONFIG, a record instance." + ;; This is required to make inter-field validations, such as between the + ;; seats and greeters. + (let* ((seats (lightdm-configuration-seats config)) + (greeter-sessions (delete-duplicates + (map lightdm-seat-configuration-greeter-session + seats) + eq?)) + (greeter-configurations (lightdm-configuration-greeters config)) + (missing-greeters + (filter-map + (lambda (id) + (define pred (greeter-session->greater-configuration-pred id)) + (if (find pred greeter-configurations) + #f ;happy path + id)) + greeter-sessions))) + (unless (null? missing-greeters) + (leave (G_ "no greeter configured for seat greeter sessions: ~a~%") + missing-greeters)))) + +(define (lightdm-configuration-file config) + (match-record config + (xorg-configuration seats + xdmcp? xdmcp-listen-address + vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port + extra-config) + (apply + mixed-text-file + "lightdm.conf" " +# +# General configuration +# +[LightDM] +greeter-user=lightdm +sessions-directory=/run/current-system/profile/share/xsessions\ +:/run/current-system/profile/share/wayland-sessions +remote-sessions-directory=/run/current-system/profile/share/remote-sessions +" + #~(string-join '#$extra-config "\n") + " +# +# XDMCP Server configuration +# +[XDMCPServer] +enabled=" (if xdmcp? "true" "false") "\n" +(if (maybe-value-set? xdmcp-listen-address) + (format #f "xdmcp-listen-address=~a" xdmcp-listen-address) + "") " + +# +# VNC Server configuration +# +[VNCServer] +enabled=" (if vnc-server? "true" "false") " +command=" vnc-server-command " +port=" (number->string vnc-server-port) "\n" +(if (maybe-value-set? vnc-server-listen-address) + (format #f "vnc-server-listen-address=~a" vnc-server-listen-address) + "") " + +# +# Seat configuration. +# +" + (map (lambda (seat) + ;; This complication exists to propagate a default value for + ;; the 'xserver-command' field of the seats. Having a + ;; 'xorg-configuration' field at the root of the + ;; lightdm-configuration enables the use of + ;; 'set-xorg-configuration' and can be more convenient. + (let ((seat* (if (maybe-value-set? + (lightdm-seat-configuration-xserver-command seat)) + seat + (lightdm-seat-configuration + (inherit seat) + (xserver-command (xorg-start-command + xorg-configuration)))))) + (serialize-configuration seat* + lightdm-seat-configuration-fields))) + seats)))) + +(define %lightdm-accounts + (list (user-group (name "lightdm") (system? #t)) + (user-account + (name "lightdm") + (group "lightdm") + (system? #t) + (comment "LightDM user") + (home-directory "/var/lib/lightdm") + (shell (file-append shadow "/sbin/nologin"))))) + +(define %lightdm-activation + ;; Ensure /var/lib/lightdm is owned by the "lightdm" user. Adapted from the + ;; %gdm-activation. + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (define (ensure-ownership directory) + (let* ((lightdm (getpwnam "lightdm")) + (uid (passwd:uid lightdm)) + (gid (passwd:gid lightdm)) + (st (stat directory #f))) + ;; Recurse into directory only if it has wrong ownership. + (when (and st + (or (not (= uid (stat:uid st))) + (not (= gid (stat:gid st))))) + (for-each (lambda (file) + (chown file uid gid)) + (find-files "directory" + #:directories? #t))))) + + (when (not (stat "/var/lib/lightdm-data" #f)) + (mkdir-p "/var/lib/lightdm-data")) + (for-each ensure-ownership + '("/var/lib/lightdm" + "/var/lib/lightdm-data"))))) + +(define (lightdm-pam-service config) + "Return a PAM service for @command{lightdm}." + (unix-pam-service "lightdm" + #:login-uid? #t + #:allow-empty-passwords? + (lightdm-configuration-allow-empty-passwords? config))) + +(define (lightdm-greeter-pam-service) + "Return a PAM service for @command{lightdm-greeter}." + (pam-service + (name "lightdm-greeter") + (auth (list + ;; Load environment from /etc/environment and ~/.pam_environment. + (pam-entry (control "required") (module "pam_env.so")) + ;; Always let the greeter start without authentication. + (pam-entry (control "required") (module "pam_permit.so")))) + ;; No action required for account management + (account (list (pam-entry (control "required") (module "pam_permit.so")))) + ;; Prohibit changing password. + (password (list (pam-entry (control "required") (module "pam_deny.so")))) + ;; Setup session. + (session (list (pam-entry (control "required") (module "pam_unix.so")))))) + +(define (lightdm-autologin-pam-service) + "Return a PAM service for @command{lightdm-autologin}}." + (pam-service + (name "lightdm-autologin") + (auth + (list + ;; Block login if user is globally disabled. + (pam-entry (control "required") (module "pam_nologin.so")) + (pam-entry (control "required") (module "pam_succeed_if.so") + (arguments (list "uid >= 1000"))) + ;; Allow access without authentication. + (pam-entry (control "required") (module "pam_permit.so")))) + ;; Stop autologin if account requires action. + (account (list (pam-entry (control "required") (module "pam_unix.so")))) + ;; Prohibit changing password. + (password (list (pam-entry (control "required") (module "pam_deny.so")))) + ;; Setup session. + (session (list (pam-entry (control "required") (module "pam_unix.so")))))) + +(define (lightdm-pam-services config) + (list (lightdm-pam-service config) + (lightdm-greeter-pam-service) + (lightdm-autologin-pam-service))) + +(define (lightdm-shepherd-service config) + "Return a for LightDM using CONFIG." + + (validate-lightdm-configuration config) + + (define lightdm-command + #~(list #$(file-append (lightdm-configuration-lightdm config) + "/sbin/lightdm") + #$@(if (lightdm-configuration-debug? config) + #~("--debug") + #~()) + "--config" + #$(lightdm-configuration-file config))) + + (define lightdm-paths + (let ((lightdm (lightdm-configuration-lightdm config))) + #~(string-join + '#$(map (lambda (dir) + (file-append lightdm dir)) + '("/bin" "/sbin" "/libexec")) + ":"))) + + (define greeters-config-dir + (lightdm-configuration->greeters-config-dir config)) + + (define data-dirs + ;; LightDM itself needs to be in XDG_DATA_DIRS for the accountsservice + ;; interface it provides to be picked up. The greeters must also be in + ;; XDG_DATA_DIRS to be found. + (let ((packages (lightdm-configuration->packages config))) + #~(string-join '#$(map (cut file-append <> "/share") packages) + ":"))) + + (list + (shepherd-service + (documentation "LightDM display manager") + (requirement '(dbus-system user-processes host-name)) + (provision '(lightdm display-manager xorg-server)) + (respawn? #f) + (start + #~(lambda () + ;; Note: sadly, environment variables defined for 'lightdm' are + ;; cleared and/or overridden by /etc/profile by its spawned greeters, + ;; so an out-of-band means such as /etc is required. + (fork+exec-command #$lightdm-command + ;; Lightdm needs itself in its PATH. + #:environment-variables + (list + ;; It knows to look for greeter configurations in + ;; XDG_CONFIG_DIRS... + (string-append "XDG_CONFIG_DIRS=" + #$greeters-config-dir) + ;; ... and for greeter .desktop files as well as + ;; lightdm accountsservice interface in + ;; XDG_DATA_DIRS. + (string-append "XDG_DATA_DIRS=" + #$data-dirs) + (string-append "PATH=" #$lightdm-paths))))) + (stop #~(make-kill-destructor))))) + +(define lightdm-service-type + (handle-xorg-configuration + lightdm-configuration + (service-type + (name 'lightdm) + (default-value (lightdm-configuration)) + (extensions + (list (service-extension pam-root-service-type lightdm-pam-services) + (service-extension shepherd-root-service-type + lightdm-shepherd-service) + (service-extension activation-service-type + (const %lightdm-activation)) + (service-extension dbus-root-service-type + (compose list lightdm-configuration-lightdm)) + (service-extension polkit-service-type + (compose list lightdm-configuration-lightdm)) + (service-extension account-service-type + (const %lightdm-accounts)) + ;; Add 'lightdm' to the system profile, so that its + ;; 'share/accountsservice' D-Bus service extension directory can be + ;; found via the 'XDG_DATA_DIRS=/run/current-system/profile/share' + ;; environment variable set in the wrapper of the + ;; libexec/accounts-daemon binary of the accountsservice package. + ;; This daemon is spawned by D-Bus, and there's little we can do to + ;; affect its environment. For more reading, see: + ;; https://github.com/NixOS/nixpkgs/issues/45059. + (service-extension profile-service-type + lightdm-configuration->packages) + ;; This is needed for the greeter itself to find its configuration, + ;; because XDG_CONF_DIRS gets overridden by /etc/profile. + (service-extension + etc-service-type + (lambda (config) + `(("lightdm" + ,(lightdm-configuration->greeters-config-dir config))))))) + (description "Run @code{lightdm}, the LightDM graphical login manager.")))) + + +;;; +;;; Generate documentation. +;;; +(define (generate-doc) + (configuration->documentation 'lightdm-configuration) + (configuration->documentation 'lightdm-gtk-greeter-configuration) + (configuration->documentation 'lightdm-seat-configuration)) diff --git a/gnu/tests/lightdm.scm b/gnu/tests/lightdm.scm new file mode 100644 index 0000000000..431b388e7e --- /dev/null +++ b/gnu/tests/lightdm.scm @@ -0,0 +1,160 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Maxim Cournoyer . +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests lightdm) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (gnu packages) + #:use-module (gnu packages ocr) + #:use-module (gnu packages ratpoison) + #:use-module (gnu packages vnc) + #:use-module (gnu packages xorg) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services dbus) + #:use-module (gnu services desktop) + #:use-module (gnu services networking) + #:use-module (gnu services lightdm) + #:use-module (gnu services ssh) + #:use-module (gnu services xorg) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (srfi srfi-1) + #:export (%test-lightdm)) + +(define minimal-desktop-services + (list polkit-wheel-service + (service upower-service-type) + (accountsservice-service) + (service polkit-service-type) + (elogind-service) + (dbus-service) + x11-socket-directory-service)) + +(define %lightdm-os + (operating-system + (inherit %simple-os) + (packages (cons* ocrad ratpoison xterm %base-packages)) + (services + (cons* (service lightdm-service-type + (lightdm-configuration + (allow-empty-passwords? #t) + (debug? #t) + (xdmcp? #t) + (vnc-server? #t) + (vnc-server-command + (file-append tigervnc-server "/bin/Xvnc" + " -SecurityTypes None")) + (greeters (list (lightdm-gtk-greeter-configuration + (allow-debugging? #t)))) + (seats (list (lightdm-seat-configuration + (name "*") + (user-session "ratpoison")))))) + + ;; For debugging. + (service dhcp-client-service-type) + (service openssh-service-type + (openssh-configuration + (permit-root-login #t) + (allow-empty-passwords? #t))) + (append minimal-desktop-services + (remove (lambda (service) + (eq? (service-kind service) guix-service-type)) + %base-services)))))) + +(define (run-lightdm-test) + "Run tests in %LIGHTDM-OS." + + (define os (marionette-operating-system + %lightdm-os + #:imported-modules (source-module-closure + '((gnu services herd))))) + + (define vm (virtual-machine os)) + + (define test + (with-imported-modules (source-module-closure + '((gnu build marionette))) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-26) + (srfi srfi-64)) + + (let ((marionette (make-marionette (list #$vm)))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "lightdm") + + (test-assert "service is running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'lightdm)) + marionette)) + + (test-assert "service can be stopped" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (stop-service 'lightdm)) + marionette)) + + (test-assert "service can be restarted" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (restart-service 'lightdm)) + marionette)) + + (test-assert "login screen is displayed" + ;; GNU Ocrad fails to recognize the "Log In" button text, so use + ;; Tesseract. + (wait-for-screen-text marionette + (cut string-contains <> "Log In") + #:ocr #$(file-append tesseract-ocr + "/bin/tesseract"))) + + (test-assert "can connect to TCP port 5900 on IPv4" + (wait-for-tcp-port 5900 marionette)) + + ;; The VNC server fails to listen to IPv6 due to "Error binding to + ;; address [::]:5900: Address already in use" (see: + ;; https://github.com/canonical/lightdm/issues/266). + (test-expect-fail 1) + (test-assert "can connect to TCP port 5900 on IPv6" + (wait-for-tcp-port 5900 marionette + #:address + `(make-socket-address + AF_INET6 + (inet-pton AF_INET6 "::1") + 5900))) + + (test-end))))) + + (gexp->derivation "lightdm-test" test)) + +(define %test-lightdm + (system-test + (name "lightdm") + (description "Basic tests for the LightDM service.") + (value (run-lightdm-test)))) diff --git a/tests/services/lightdm.scm b/tests/services/lightdm.scm new file mode 100644 index 0000000000..283df2befc --- /dev/null +++ b/tests/services/lightdm.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (tests services lightdm) + #:use-module (guix diagnostics) + #:use-module (gnu services lightdm) + #:use-module (srfi srfi-64)) + +;;; Tests for the (gnu services lightdm) module. + +;;; Access some internals for whitebox testing. +(define validate-lightdm-configuration (@@ (gnu services lightdm) + validate-lightdm-configuration)) + +(test-begin "lightdm-service") + +(test-equal "error on missing greeter" + 'ok + (catch 'quit + (lambda () + (validate-lightdm-configuration (lightdm-configuration (greeters '())))) + (lambda _ + 'ok))) + +(test-equal "error when a greeter has multiple configurations" + 'ok + (catch 'quit + (lambda () + (lightdm-configuration + (greeters (list (lightdm-gtk-greeter-configuration + (theme-name "boring")) + (lightdm-gtk-greeter-configuration + (theme-name "blue")))))) + (lambda _ + 'ok))) + +(test-end "lightdm-service") From 75d73172904f3b6a0fc077297b5a00750af3b16c Mon Sep 17 00:00:00 2001 From: Andrew Tropin Date: Mon, 29 Aug 2022 09:20:18 +0300 Subject: [PATCH 24/91] gnu: fennel: Update to 1.2.0. * gnu/packages/lua.scm (fennel): Update to 1.2.0. [arguments]: Migrate to gexps. --- gnu/packages/lua.scm | 75 +++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 40 deletions(-) diff --git a/gnu/packages/lua.scm b/gnu/packages/lua.scm index afebc6bc1f..c3bb1e8f5b 100644 --- a/gnu/packages/lua.scm +++ b/gnu/packages/lua.scm @@ -1179,48 +1179,43 @@ (define-public emilua (license license:boost1.0))) (define-public fennel - ;; The 1.0.0 release had a bug where fennel installed under 5.4 no matter - ;; what lua was used to compile it. There has since been an update that - ;; corrects this issue, so we can rely on the version of the lua input to - ;; determine where the fennel.lua file got installed to. - (let ((commit "03c1c95f2a79e45a9baf607f96a74c693b8b70f4") - (revision "0")) - (package - (name "fennel") - (version (git-version "1.0.0" revision commit)) - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://git.sr.ht/~technomancy/fennel") - (commit commit))) - (file-name (git-file-name name version)) - (sha256 - (base32 - "1znp38h5q819gvcyl248zwvjsljfxdxdk8n82fnj6lyibiiqzgvx")))) - (build-system gnu-build-system) - (arguments - '(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) - #:tests? #t ; even on cross-build - #:test-target "test" - #:phases - (modify-phases %standard-phases - (delete 'configure) - (add-after 'build 'patch-fennel - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "fennel" - (("/usr/bin/env .*lua") - (search-input-file inputs "/bin/lua"))))) - (delete 'check) - (add-after 'install 'check - (assoc-ref %standard-phases 'check))))) - (inputs (list lua)) - (home-page "https://fennel-lang.org/") - (synopsis "Lisp that compiles to Lua") - (description - "Fennel is a programming language that brings together the speed, + (package + (name "fennel") + (version "1.2.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://git.sr.ht/~technomancy/fennel") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0klqxhgc9s6rm2xbn2fyzw9nzdas65g84js7s69by0gv2jzalyad")))) + (build-system gnu-build-system) + (arguments + (list #:make-flags #~(list (string-append "PREFIX=" + (assoc-ref %outputs "out"))) + #:tests? #t ;even on cross-build + #:test-target "test" + #:phases #~(modify-phases %standard-phases + (delete 'configure) + (add-after 'build 'patch-fennel + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "fennel" + (("/usr/bin/env .*lua") + (search-input-file inputs "/bin/lua"))))) + (delete 'check) + (add-after 'install 'check + (assoc-ref %standard-phases + 'check))))) + (inputs (list lua)) + (home-page "https://fennel-lang.org/") + (synopsis "Lisp that compiles to Lua") + (description + "Fennel is a programming language that brings together the speed, simplicity, and reach of Lua with the flexibility of a Lisp syntax and macro system.") - (license license:expat)))) + (license license:expat))) (define-public fnlfmt (package From de66e215804de9a0521732f641c5670258a248eb Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Mon, 29 Aug 2022 09:21:21 +0300 Subject: [PATCH 25/91] gnu: r-keggrest: Update to 1.36.3. * gnu/packages/bioconductor.scm (r-keggrest): Update to 1.36.3. --- gnu/packages/bioconductor.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/bioconductor.scm b/gnu/packages/bioconductor.scm index 7aee0c55c3..2a3776e8b5 100644 --- a/gnu/packages/bioconductor.scm +++ b/gnu/packages/bioconductor.scm @@ -4647,14 +4647,14 @@ (define-public r-interactivedisplaybase (define-public r-keggrest (package (name "r-keggrest") - (version "1.36.2") + (version "1.36.3") (source (origin (method url-fetch) (uri (bioconductor-uri "KEGGREST" version)) (sha256 (base32 - "1rn03w8y80prbvzahkvf8275haiymnjj1ijcgn55p3d0sb54yzgw")))) + "0lzb3z6pzm323q70931b7220ygml7jb4g81dybwa79wqiqz15pni")))) (properties `((upstream-name . "KEGGREST"))) (build-system r-build-system) (propagated-inputs From a52473e219a867adef89a35aa323e7136691f5d2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 29 Aug 2022 10:32:42 +0200 Subject: [PATCH 26/91] gnu: wireshark: Update to 3.6.7. * gnu/packages/networking.scm (wireshark): Update to 3.6.7. --- gnu/packages/networking.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/networking.scm b/gnu/packages/networking.scm index 2fea1b2b59..c16ae00ec4 100644 --- a/gnu/packages/networking.scm +++ b/gnu/packages/networking.scm @@ -1727,14 +1727,14 @@ (define-public whois (define-public wireshark (package (name "wireshark") - (version "3.6.2") + (version "3.6.7") (source (origin (method url-fetch) (uri (string-append "https://www.wireshark.org/download/src/wireshark-" version ".tar.xz")) (sha256 - (base32 "03n34jh4318y3q14jclxfxi4r7b9l393w9fw9bq57ydff9aim42x")))) + (base32 "1idpxnh8vrvan3g0ymaa24bd4iyxi19xrr76sdrrpxx2r8shmqfc")))) (build-system cmake-build-system) (arguments `(#:phases From cc6c079230c0d4a68a386174596af0890112f219 Mon Sep 17 00:00:00 2001 From: Nikolay Korotkiy Date: Fri, 19 Aug 2022 09:56:54 +0300 Subject: [PATCH 27/91] gnu: cmus: Update to 2.10.0. * gnu/packages/music.scm (cmus): Update to 2.10.0. Signed-off-by: Efraim Flashner --- gnu/packages/music.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index e1de632dda..5b6440455e 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -565,7 +565,7 @@ (define-public strawberry (define-public cmus (package (name "cmus") - (version "2.9.1") + (version "2.10.0") (source (origin (method git-fetch) (uri (git-reference @@ -574,7 +574,7 @@ (define-public cmus (file-name (git-file-name name version)) (sha256 (base32 - "0zjkimni2fhv4yskrjrgj6b74f33rfj58zgd7khwrz4z8nf88j0w")))) + "0csj59q2n7hz9zihq92kb4kzvb51rgzl65y6vd0chq6j3li1pb8x")))) (build-system gnu-build-system) (arguments `(#:tests? #f ; cmus does not include tests From 3aac843826877b2131e17f61ee7290e537b751a8 Mon Sep 17 00:00:00 2001 From: jgart Date: Sun, 28 Aug 2022 15:28:02 -0500 Subject: [PATCH 28/91] gnu: Add cl-safe-read. * gnu/packages/lisp-xyz.scm (cl-safe-read, ecl-safe-read, sbcl-safe-read): New variables. Signed-off-by: Guillaume Le Vaillant --- gnu/packages/lisp-xyz.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/gnu/packages/lisp-xyz.scm b/gnu/packages/lisp-xyz.scm index 6018c4deff..2170a9e267 100644 --- a/gnu/packages/lisp-xyz.scm +++ b/gnu/packages/lisp-xyz.scm @@ -22762,6 +22762,37 @@ (define-public ecl-trivial-custom-debugger ;; Tests fail on ECL: https://github.com/phoe/trivial-custom-debugger/issues/3 '(#:tests? #f)))) +(define-public sbcl-safe-read + (let ((commit "d25f08597b34d7aaeb86b045d57f7b020a5bb5f0") + (revision "0")) + (package + (name "sbcl-safe-read") + (version (git-version "0.1" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/phoe/safe-read") + (commit commit))) + (file-name (git-file-name "cl-safe-read" version)) + (sha256 + (base32 "1r9k8danfnqgpbn2vb90n6wdc6jd92h1ig565yplrbh6232lhi26")))) + (build-system asdf-build-system/sbcl) + (inputs + (list sbcl-local-time sbcl-trivial-garbage)) + (home-page "https://github.com/phoe/safe-read/") + (synopsis "Safer variant of READ") + (description + "This package provides a safer variant of @code{READ} secure against +internbombing, excessive input and macro characters.") + (license license:bsd-2)))) + +(define-public cl-safe-read + (sbcl-package->cl-source-package sbcl-safe-read)) + +(define-public ecl-safe-read + (sbcl-package->ecl-package sbcl-safe-read)) + (define-public sbcl-ospm (package (name "sbcl-ospm") From f4f225e4826b7039adc1937f9b32df80b99c2ad1 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Mon, 29 Aug 2022 17:04:25 +0300 Subject: [PATCH 29/91] gnu: accountsservice: Adjust inputs. This fixes the builds of gdm and some other packages. * gnu/packages/freedesktop.scm (accountsservice)[inputs]: Move polkit ... [propagated-inputs]: ... to here. --- gnu/packages/freedesktop.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index ab6fb480a7..a902fac153 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1505,8 +1505,9 @@ (define-public accountsservice (inputs (list dbus elogind - polkit shadow)) + (propagated-inputs + (list polkit)) ; listed in Requires.private (home-page "https://www.freedesktop.org/wiki/Software/AccountsService/") (synopsis "D-Bus interface for user account query and manipulation") (description From ae9b3d7cf1e8c61a57c3d1a6af5a52d02497be4e Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 16:53:59 +0200 Subject: [PATCH 30/91] gnu: Remove ruby@2.4. * gnu/packages/ruby.scm (ruby-2.4): Remove variable. --- gnu/packages/ruby.scm | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index cc95bd8d6e..621f8a49c3 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -230,25 +230,6 @@ (define-public ruby-2.5 (base32 "1w2qncacm7h3f3il1whghdabwnv9fvwmz9f1a9vcg32006ljyzx8")))))) -(define-public ruby-2.4 - (package - (inherit ruby-2.6) - (version "2.4.10") - (source - (origin - (method url-fetch) - (uri (string-append "http://cache.ruby-lang.org/pub/ruby/" - (version-major+minor version) - "/ruby-" version ".tar.xz")) - (sha256 - (base32 - "1prhqlgik1zmw9lakl6hkriqslspw48pvhxff17h7ns42p8qwrnm")) - (modules '((guix build utils))) - (snippet `(begin - ;; Remove bundled libffi - (delete-file-recursively "ext/fiddle/libffi-3.2.1") - #t)))))) - (define-public ruby ruby-2.7) (define-public mruby From 8ab712526598ac5d485a08c02e6b16faced3df84 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 16:54:18 +0200 Subject: [PATCH 31/91] gnu: Remove ruby@2.5. * gnu/packages/ruby.scm (ruby-2.5): Remove variable. --- gnu/packages/ruby.scm | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 621f8a49c3..a30777ce01 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -216,20 +216,6 @@ (define-public ruby-3.1 (base32 "1akcl7vhmwfm6ybj7493kzy58ykh2r39ri9f4xfm2xmhg1msmvvs")))))) -(define-public ruby-2.5 - (package - (inherit ruby-2.6) - (version "2.5.9") - (source - (origin - (method url-fetch) - (uri (string-append "http://cache.ruby-lang.org/pub/ruby/" - (version-major+minor version) - "/ruby-" version ".tar.xz")) - (sha256 - (base32 - "1w2qncacm7h3f3il1whghdabwnv9fvwmz9f1a9vcg32006ljyzx8")))))) - (define-public ruby ruby-2.7) (define-public mruby From a500e1a061d82b3812d98a186c1fbb86390ba7a6 Mon Sep 17 00:00:00 2001 From: Remco van 't Veer Date: Wed, 29 Jun 2022 17:54:00 +0200 Subject: [PATCH 32/91] gnu: ruby: Update to 2.6.10 [security fixes]. Includes fixes for: CVE-2022-28739, CVE-2021-41819, CVE-2021-41817, CVE-2021-31810, CVE-2021-32066, CVE-2021-28965, CVE-2020-25613, and CVE-2020-10933. * gnu/packages/ruby.scm (ruby-2.6): Update to 2.6.10. Signed-off-by: Marius Bakke --- gnu/packages/ruby.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index a30777ce01..ea025a18c3 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -29,6 +29,7 @@ ;;; Copyright © 2020 Tomás Ortín Fernández ;;; Copyright © 2021 Giovanni Biscuolo ;;; Copyright © 2022 Philip McGrath +;;; Copyright © 2022 Remco van 't Veer ;;; ;;; This file is part of GNU Guix. ;;; @@ -100,7 +101,7 @@ (define %prawn-project-licenses (define-public ruby-2.6 (package (name "ruby") - (version "2.6.5") + (version "2.6.10") (source (origin (method url-fetch) @@ -109,7 +110,7 @@ (define-public ruby-2.6 "/ruby-" version ".tar.xz")) (sha256 (base32 - "0qhsw2mr04f3lqinkh557msr35pb5rdaqy4vdxcj91flgxqxmmnm")) + "1wn12klc44hn2nh5v1lkqbdyvljip6qhwjqvkkf8zf112gaxxn2z")) (modules '((guix build utils))) (snippet `(begin ;; Remove bundled libffi From 2654acea2744b5949cd3308f7929754ebb884555 Mon Sep 17 00:00:00 2001 From: Remco van 't Veer Date: Wed, 29 Jun 2022 17:55:55 +0200 Subject: [PATCH 33/91] gnu: ruby: Update to 3.0.4 [security fixes]. Includes fixes for: CVE-2022-28738, CVE-2022-28739, CVE-2021-41819, CVE-2021-41816, and CVE-2021-41817. * gnu/packages/ruby.scm (ruby-3.0): Update to 3.0.4. Signed-off-by: Marius Bakke --- gnu/packages/ruby.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index ea025a18c3..45d4ecdec9 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -192,7 +192,7 @@ (define-public ruby-2.7 (define-public ruby-3.0 (package (inherit ruby-2.7) - (version "3.0.2") + (version "3.0.4") (source (origin (method url-fetch) @@ -201,7 +201,7 @@ (define-public ruby-3.0 "/ruby-" version ".tar.xz")) (sha256 (base32 - "0h2w2ms4gx2s96v3lzdr3add94bd2qqkhdjzaycmaqhg21rpf3jp")))))) + "1w7jpq3flnm007z5kj8kixgm8l4smb80w8ak4993a12j0irzq8lf")))))) (define-public ruby-3.1 (package From 939c998160f1ec109b5c65b307de8e15b266ba57 Mon Sep 17 00:00:00 2001 From: Remco van 't Veer Date: Wed, 29 Jun 2022 17:56:17 +0200 Subject: [PATCH 34/91] gnu: ruby: Update to 3.1.2 [security fixes]. Includes fixes for: CVE-2022-28738, and CVE-2022-28739. * gnu/packages/ruby.scm (ruby-3.1): Update to 3.1.2. Signed-off-by: Marius Bakke --- gnu/packages/ruby.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 45d4ecdec9..e38d5da0a9 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -206,7 +206,7 @@ (define-public ruby-3.0 (define-public ruby-3.1 (package (inherit ruby-2.7) - (version "3.1.1") + (version "3.1.2") (source (origin (method url-fetch) @@ -215,7 +215,7 @@ (define-public ruby-3.1 "/ruby-" version ".tar.xz")) (sha256 (base32 - "1akcl7vhmwfm6ybj7493kzy58ykh2r39ri9f4xfm2xmhg1msmvvs")))))) + "0amzqczgvr51ilcqfgw0n41hrfanzi0wh8k6am3x5dm1z0bx046a")))))) (define-public ruby ruby-2.7) From 83c86fa446933ea905801de132ec6c36a99fd422 Mon Sep 17 00:00:00 2001 From: Remco van 't Veer Date: Wed, 29 Jun 2022 20:00:37 +0200 Subject: [PATCH 35/91] gnu: ruby: Replace with 2.7.6 [security fixes]. Includes fixes for: CVE-2022-28739, CVE-2021-41816, and CVE-2021-41817. * gnu/packages/ruby.scm (ruby-2.7-fixed): New variable. (ruby-2.7)[replacement]: Graft. Signed-off-by: Marius Bakke --- gnu/packages/ruby.scm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index e38d5da0a9..a37a8dda24 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -155,6 +155,7 @@ (define-public ruby-2.7 (package (inherit ruby-2.6) (version "2.7.4") + (replacement ruby-2.7-fixed) ; security fixes (source (origin (inherit (package-source ruby-2.6)) @@ -189,6 +190,20 @@ (define-public ruby-2.7 (native-inputs (list autoconf)))) +(define ruby-2.7-fixed + (package + (inherit ruby-2.7) + (version "2.7.6") + (source + (origin + (inherit (package-source ruby-2.7)) + (uri (string-append "https://cache.ruby-lang.org/pub/ruby/" + (version-major+minor version) + "/ruby-" version ".tar.gz")) + (sha256 + (base32 + "042xrdk7hsv4072bayz3f8ffqh61i8zlhvck10nfshllq063n877")))))) + (define-public ruby-3.0 (package (inherit ruby-2.7) From 608f9efc34aa31d00260fbed6845f2cc9a176b17 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 17:26:21 +0200 Subject: [PATCH 36/91] gnu: tesseract-ocr: Propagate leptonica. * gnu/packages/ocr.scm (tesseract-ocr)[inputs]: Move LEPTONICA ... [propagated-inputs]: ... here. --- gnu/packages/ocr.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gnu/packages/ocr.scm b/gnu/packages/ocr.scm index 21d257ef24..0382e0d869 100644 --- a/gnu/packages/ocr.scm +++ b/gnu/packages/ocr.scm @@ -177,9 +177,11 @@ (define eng.traineddata (inputs (list cairo icu4c - leptonica pango python-wrapper)) + (propagated-inputs + ;; Required by tesseract.pc. + (list leptonica)) (native-search-paths (list (search-path-specification (variable "TESSDATA_PREFIX") (files (list "share/tesseract-ocr/tessdata")) From f26b9d5ced516343d0c6bb8534d2043f34b7ddd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pierre-Henry=20Fr=C3=B6hring?= Date: Wed, 17 Aug 2022 00:31:19 +0200 Subject: [PATCH 37/91] gnu: mupdf: Update to 1.20.3. * Copy/paste is fixed. The build now uses the patched version of freeglut that is included in the thirdparty directory so that copy/paste works. * gnu/packages/pdf.scm (mupdf)[source](snippet): Preserve freeglut. [inputs]: Add LIBXRANDR and LIBXI. [arguments]: Explicitly add configure flags for system libraries. Signed-off-by: Marius Bakke --- gnu/packages/pdf.scm | 64 +++++++++++++++++++++++++++----------------- 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm index 39266a2822..94fba57b23 100644 --- a/gnu/packages/pdf.scm +++ b/gnu/packages/pdf.scm @@ -731,20 +731,20 @@ (define-public python-pydyf (define-public mupdf (package (name "mupdf") - (version "1.19.1") + (version "1.20.3") (source (origin (method url-fetch) (uri (string-append "https://mupdf.com/downloads/archive/" - "mupdf-" version "-source.tar.xz")) + "mupdf-" version "-source.tar.lz")) (sha256 - (base32 "0gl0wf16m1cafs20h3v1f4ysf7zlbijjyd6s1r1krwvlzriwdsmm")) + (base32 + "0s0qclxxdjis04mczgz0fhfpv0j8llk48g82zlfrk0daz0zgcwvg")) (modules '((guix build utils))) (snippet #~(begin - ;; Remove bundled software. - (let* ((keep (list "extract" - "lcms2")) ; different from our lcms2 package + ;; Remove bundled software. Keep patched variants. + (let* ((keep (list "extract" "freeglut" "lcms2")) (from "thirdparty") (kept (string-append from "~temp"))) (mkdir-p kept) @@ -757,7 +757,9 @@ (define-public mupdf (build-system gnu-build-system) (inputs (list curl - freeglut + libxrandr + libxi + freeglut ;for GL/gl.h freetype gumbo-parser harfbuzz @@ -773,24 +775,36 @@ (define-public mupdf (list pkg-config)) (arguments (list - #:tests? #f ; no check target - #:make-flags - #~(list "verbose=yes" - (string-append "CC=" #$(cc-for-target)) - "XCFLAGS=-fpic" - "USE_SYSTEM_LIBS=yes" - "USE_SYSTEM_MUJS=yes" - "shared=yes" - ;; Even with the linkage patch we must fix RUNPATH. - (string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib") - (string-append "prefix=" #$output)) - #:phases - #~(modify-phases %standard-phases - (delete 'configure)))) ; no configure script + #:tests? #f ;no check target + #:make-flags + #~(list "verbose=yes" + (string-append "CC=" #$(cc-for-target)) + "XCFLAGS=-fpic" + "USE_SYSTEM_FREETYPE=yes" + "USE_SYSTEM_GUMBO=yes" + "USE_SYSTEM_HARFBUZZ=yes" + "USE_SYSTEM_JBIG2DEC=yes" + "USE_SYSTEM_JPEGXR=no # not available" + "USE_SYSTEM_LCMS2=no # lcms2mt is strongly preferred" + "USE_SYSTEM_LIBJPEG=yes" + "USE_SYSTEM_MUJS=no # not available" + "USE_SYSTEM_OPENJPEG=yes" + "USE_SYSTEM_ZLIB=yes" + "USE_SYSTEM_GLUT=no" + "USE_SYSTEM_CURL=yes" + "USE_SYSTEM_LEPTONICA=yes" + "USE_SYSTEM_TESSERACT=yes" + "USE_SYSTEM_MUJS=yes" + "shared=yes" + (string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib") + (string-append "prefix=" #$output)) + #:phases + #~(modify-phases %standard-phases + (delete 'configure)))) ;no configure script (home-page "https://mupdf.com") (synopsis "Lightweight PDF viewer and toolkit") (description - "MuPDF is a C library that implements a PDF and XPS parsing and + "MuPDF is a C library that implements a PDF and XPS parsing and rendering engine. It is used primarily to render pages into bitmaps, but also provides support for other operations such as searching and listing the table of contents and hyperlinks. @@ -799,9 +813,9 @@ (define-public mupdf line tools for batch rendering @command{pdfdraw}, rewriting files @command{pdfclean}, and examining the file structure @command{pdfshow}.") (license (list license:agpl3+ - license:bsd-3 ; resources/cmaps - license:x11 ; thirdparty/lcms2 - license:silofl1.1 ; resources/fonts/{han,noto,sil,urw} + license:bsd-3 ;resources/cmaps + license:x11 ;thirdparty/lcms2 + license:silofl1.1 ;resources/fonts/{han,noto,sil,urw} license:asl2.0)))) ; resources/fonts/droid (define-public qpdf From 7c9cf349f30a5aa937f6f9f5ac3f492f97466938 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 17:07:44 +0200 Subject: [PATCH 38/91] gnu: zathura-pdf-mupdf: Update to 0.3.9. * gnu/packages/pdf.scm (zathura-pdf-mupdf): Update to 0.3.9. [inputs]: Add GUMBO-PARSER and TESSERACT-OCR. [arguments]: Remove obsolete configure flag. Adjust mupdf substitutions. --- gnu/packages/pdf.scm | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm index 94fba57b23..964408424d 100644 --- a/gnu/packages/pdf.scm +++ b/gnu/packages/pdf.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2016 Roel Janssen ;;; Copyright © 2016 Nikita ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2022 Efraim Flashner -;;; Copyright © 2016, 2017 Marius Bakke +;;; Copyright © 2016, 2017, 2022 Marius Bakke ;;; Copyright © 2016, 2017, 2019 Ludovic Courtès ;;; Copyright © 2016 Julien Lepiller ;;; Copyright © 2016, 2019 Arun Isaac @@ -82,6 +82,7 @@ (define-module (gnu packages pdf) #:use-module (gnu packages lua) #:use-module (gnu packages man) #:use-module (gnu packages markup) + #:use-module (gnu packages ocr) #:use-module (gnu packages pcre) #:use-module (gnu packages perl) #:use-module (gnu packages photo) @@ -518,7 +519,7 @@ (define-public zathura-djvu (define-public zathura-pdf-mupdf (package (name "zathura-pdf-mupdf") - (version "0.3.6") + (version "0.3.9") (source (origin (method url-fetch) (uri @@ -526,39 +527,39 @@ (define-public zathura-pdf-mupdf "/download/zathura-pdf-mupdf-" version ".tar.xz")) (sha256 (base32 - "1r3v37k9fl2rxipvacgxr36llywvy7n20a25h3ajlyk70697sa66")))) + "01vw0lrcj9g7d5h2xvm4xb08mvfld4syfr381fjrbdj52zm9bxvp")))) (native-inputs (list pkg-config)) (inputs - `(("jbig2dec" ,jbig2dec) + `(("gumbo-parser" ,gumbo-parser) + ("jbig2dec" ,jbig2dec) ("libjpeg" ,libjpeg-turbo) ("mujs" ,mujs) ("mupdf" ,mupdf) ("openjpeg" ,openjpeg) ("openssl" ,openssl) + ("tesseract" ,tesseract-ocr) ("zathura" ,zathura))) (build-system meson-build-system) (arguments `(#:tests? #f ; package does not contain tests #:configure-flags (list (string-append "-Dplugindir=" (assoc-ref %outputs "out") - "/lib/zathura") - "-Dlink-external=true") + "/lib/zathura")) #:phases (modify-phases %standard-phases (add-after 'unpack 'remove-libmupdfthird.a-requirement (lambda _ ;; Ignore a missing (apparently superfluous) static library. (substitute* "meson.build" - ((".*mupdfthird.*") "")) - #t)) - (add-before 'configure 'add-mujs-to-dependencies + (("mupdfthird = .*") + "") + ((", mupdfthird") + "")))) + (add-after 'unpack 'fix-mupdf-detection (lambda _ - ;; Add mujs to the 'build_dependencies'. (substitute* "meson.build" - (("^ libopenjp2 = dependency.*" x) - (string-append x " mujs = cc.find_library('mujs')\n")) - (("^ libopenjp2") - " libopenjp2, mujs"))))))) + (("dependency\\('mupdf', required: false\\)") + "cc.find_library('mupdf')"))))))) (home-page "https://pwmt.org/projects/zathura-pdf-mupdf/") (synopsis "PDF support for zathura (mupdf backend)") (description "The zathura-pdf-mupdf plugin adds PDF support to zathura From be01b13fb71525e7db722ed107f205a75b90c0f0 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 17:34:27 +0200 Subject: [PATCH 39/91] gnu: zathura-pdf-mupdf: Remove input labels. * gnu/packages/pdf.scm (zathura-pdf-mupdf)[inputs]: Remove labels. --- gnu/packages/pdf.scm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm index 964408424d..14f75d9ef9 100644 --- a/gnu/packages/pdf.scm +++ b/gnu/packages/pdf.scm @@ -530,15 +530,15 @@ (define-public zathura-pdf-mupdf "01vw0lrcj9g7d5h2xvm4xb08mvfld4syfr381fjrbdj52zm9bxvp")))) (native-inputs (list pkg-config)) (inputs - `(("gumbo-parser" ,gumbo-parser) - ("jbig2dec" ,jbig2dec) - ("libjpeg" ,libjpeg-turbo) - ("mujs" ,mujs) - ("mupdf" ,mupdf) - ("openjpeg" ,openjpeg) - ("openssl" ,openssl) - ("tesseract" ,tesseract-ocr) - ("zathura" ,zathura))) + (list gumbo-parser + jbig2dec + libjpeg-turbo + mujs + mupdf + openjpeg + openssl + tesseract-ocr + zathura)) (build-system meson-build-system) (arguments `(#:tests? #f ; package does not contain tests From 6e83d294ce30116c313eb0126108c31de151a9cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= Date: Mon, 29 Aug 2022 18:00:30 +0200 Subject: [PATCH 40/91] gnu: emacs-clang-format: Remove inherited propagated inputs. * gnu/packages/llvm.scm (emacs-clang-format)[propagated-inputs]: Remove them. --- gnu/packages/llvm.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/packages/llvm.scm b/gnu/packages/llvm.scm index 2d3ee79339..0f4890af8c 100644 --- a/gnu/packages/llvm.scm +++ b/gnu/packages/llvm.scm @@ -24,6 +24,7 @@ ;;; Copyright © 2021 Maxim Cournoyer ;;; Copyright © 2022 Greg Hogan ;;; Copyright © 2022 John Kehayias +;;; Copyright © 2022 Clément Lassieur ;;; ;;; This file is part of GNU Guix. ;;; @@ -1842,6 +1843,7 @@ (define-public emacs-clang-format (build-system emacs-build-system) (inputs (list clang)) + (propagated-inputs '()) (arguments `(#:phases (modify-phases %standard-phases From 72cfcf1735224710c4515d64fafc00413a2a6be2 Mon Sep 17 00:00:00 2001 From: Luis Felipe Date: Wed, 13 Jul 2022 11:23:02 -0500 Subject: [PATCH 41/91] gnu: Add python-django-cleanup. * gnu/packages/django.scm (python-django-cleanup): New variable. Signed-off-by: Marius Bakke --- gnu/packages/django.scm | 51 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm index 0eb9ccf0f3..091d619a41 100644 --- a/gnu/packages/django.scm +++ b/gnu/packages/django.scm @@ -1361,3 +1361,54 @@ (define-public python-django-svg-image-form-field models that use Django's standard @code{ImageField}, in addition to the image files already supported by it.") (license license:expat))) + +(define-public python-django-cleanup + (package + (name "python-django-cleanup") + (version "6.0.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/un1t/django-cleanup") + (commit (string-append version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 "0c1nghn1bnlq0a4d3sy3s363ksqsnxksixbimdy3cc6a0vk4sjps")))) + (build-system python-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-tests-settings + (lambda* (#:key inputs #:allow-other-keys) + ;; django-cleanup optionally integrates with + ;; sorl-thumbnail, which is not available in Guix yet, so + ;; this patch comments it out to avoid import failures in + ;; test settings. + (substitute* "django_cleanup/testapp/settings.py" + (("'sorl\\.thumbnail',") "# 'sorl.thumbnail',")))) + (replace 'check + (lambda* (#:key tests? inputs outputs #:allow-other-keys) + (when tests? + (add-installed-pythonpath inputs outputs) + ;; Add CWD to PYTHONPATH so that the tests can find the + ;; testapp package in the source. + (setenv "PYTHONPATH" (getcwd)) + (invoke "pytest"))))))) + (native-inputs + (list ;; python-django-sorl-thumbnail ; TODO: Add to Guix. + python-easy-thumbnails + python-pillow + python-pytest + python-pytest-cov + python-pytest-django + python-pytest-xdist)) + (propagated-inputs + (list python-django)) + (home-page "https://github.com/un1t/django-cleanup") + (synopsis "Automatically deletes unused media files") + (description "This application automatically deletes user-uploaded +files when a model is modified or deleted. It works for FileField, +ImageField and their subclasses. Files set as default values for any +FileField are not deleted.") + (license license:expat))) From ed9558b17a720bef7a91a5afd3b49380717a73ea Mon Sep 17 00:00:00 2001 From: Michael Rohleder Date: Sun, 28 Aug 2022 15:58:23 +0200 Subject: [PATCH 42/91] gnu: rr: Update to 5.6.0. * gnu/packages/debug.scm (rr): Update to 5.6.0. [arguments]<#:configure-flags>: Add -rpath to zlib to satisfy validate-runpath. [inputs]: Add zlib. Signed-off-by: Marius Bakke --- gnu/packages/debug.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/gnu/packages/debug.scm b/gnu/packages/debug.scm index 80685900eb..b3ddfbdee6 100644 --- a/gnu/packages/debug.scm +++ b/gnu/packages/debug.scm @@ -621,7 +621,7 @@ (define-public remake (define-public rr (package (name "rr") - (version "5.5.0") + (version "5.6.0") (source (origin (method git-fetch) (uri (git-reference @@ -629,7 +629,7 @@ (define-public rr (commit version))) (sha256 (base32 - "079x891axkiy8qbvjar9vbaldlx7pm9p0i3nq6infdc66nc69635")) + "0sdpsd7bcbmx9gmp7lv71znzxz708wm8qxq5apbyc6hh80z4fzqz")) (file-name (git-file-name name version)))) (build-system cmake-build-system) (arguments @@ -641,7 +641,9 @@ (define-public rr ;; Satisfy the ‘validate-runpath’ phase. This isn't a direct ;; consequence of clearing CMAKE_INSTALL_RPATH. (string-append "-DCMAKE_EXE_LINKER_FLAGS=-Wl,-rpath=" - (assoc-ref %build-inputs "capnproto") "/lib") + (assoc-ref %build-inputs "capnproto") + "/lib,-rpath=" (assoc-ref %build-inputs "zlib") + "/lib") ,@(if (and (not (%current-target-system)) (member (%current-system) '("x86_64-linux" "aarch64-linux"))) @@ -666,7 +668,7 @@ (define-public rr (native-inputs (list pkg-config ninja which)) (inputs - (list gdb capnproto python python-pexpect)) + (list gdb capnproto python python-pexpect zlib)) (home-page "https://rr-project.org/") (synopsis "Record and reply debugging framework") (description From 309935a0164d44f0a9c0a02459b53c2dd936b7e3 Mon Sep 17 00:00:00 2001 From: Michael Rohleder Date: Sun, 28 Aug 2022 02:04:04 +0200 Subject: [PATCH 43/91] gnu: uncrustify: Update to 0.75.1. * gnu/packages/code.scm (uncrustify): Update to 0.75.1. Signed-off-by: Marius Bakke --- gnu/packages/code.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/packages/code.scm b/gnu/packages/code.scm index f4855e12e9..cc0abedd35 100644 --- a/gnu/packages/code.scm +++ b/gnu/packages/code.scm @@ -16,6 +16,7 @@ ;;; Copyright © 2020 Julien Lepiller ;;; Copyright © 2021 lu hui ;;; Copyright © 2021, 2022 Foo Chuan Wei +;;; Copyright © 2022 Michael Rohleder ;;; ;;; This file is part of GNU Guix. ;;; @@ -744,7 +745,7 @@ (define-public makefile2graph (define-public uncrustify (package (name "uncrustify") - (version "0.74.0") + (version "0.75.1") (source (origin (method git-fetch) (uri (git-reference @@ -753,7 +754,7 @@ (define-public uncrustify (file-name (git-file-name name version)) (sha256 (base32 - "0v48vhmzxjzysbf0vhxzayl2pkassvbabvwg84xd6b8n5i74ijxd")))) + "1mzzzd4alajjdshbjd2a5mddqcpag8yyss72n09mfpialzyf7g60")))) (build-system cmake-build-system) (native-inputs `(("python" ,python-wrapper))) From 52aa21cc9a15cdbbae1c72b8fd28adeb66791a9b Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 17:15:44 +0200 Subject: [PATCH 44/91] gnu: gnupg: Use mirror URL. In commit 38747a27f36dbaadadb1399ec085d88e48c97555, the package switched from a mirror:// URL to a ftp:// URL, but there doesn't appear to have been any particular reason for that. * gnu/packages/gnupg.scm (gnupg)[source]{uri}: Use a mirror:// again. Signed-off-by: Marius Bakke --- gnu/packages/gnupg.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 90215a6877..f9f39d6116 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -288,7 +288,7 @@ (define-public gnupg (replacement gnupg/fixed) (source (origin (method url-fetch) - (uri (string-append "ftp://ftp.gnupg.org/gcrypt/gnupg/gnupg-" version + (uri (string-append "mirror://gnupg/gnupg/gnupg-" version ".tar.bz2")) (patches (search-patches "gnupg-default-pinentry.patch")) (sha256 From 5831155175614726685edab7efa60ce48e4da1f5 Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Thu, 25 Aug 2022 20:17:55 +0200 Subject: [PATCH 45/91] gnu: snakemake-7: Fix cluster execution bug * gnu/packages/python-xyz.scm (snakemake-7)[arguments]: Revise the patch for the cluster execution script Signed-off-by: Marius Bakke --- gnu/packages/python-xyz.scm | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 30645fc4a0..0accf918ee 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -9739,15 +9739,14 @@ (define-public snakemake-7 ;; For cluster execution Snakemake will call Python. Since there is ;; no suitable GUIX_PYTHONPATH set, cluster execution will fail. We ;; fix this by calling the snakemake wrapper instead. - - ;; XXX: There is another instance of sys.executable on line 692, but - ;; it is not clear how to patch it. (add-after 'unpack 'call-wrapper-not-wrapped-snakemake (lambda* (#:key outputs #:allow-other-keys) (substitute* "snakemake/executors/__init__.py" - (("\\{sys.executable\\} -m snakemake") - (string-append (assoc-ref outputs "out") - "/bin/snakemake"))))) + (("self\\.get_python_executable\\(\\),") + "") + (("\"-m snakemake\"") + (string-append "\"" (assoc-ref outputs "out") + "/bin/snakemake" "\""))))) (replace 'check (lambda* (#:key tests? #:allow-other-keys) (when tests? From 6a31fb6e7b2bc6daba973d440ea4480d57ee6597 Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Thu, 25 Aug 2022 20:46:59 +0200 Subject: [PATCH 46/91] gnu: snakemake-6: Convert dependencies to propagated-inputs * gnu/packages/python-xyz.scm (snakemake-6)[inputs]: Change to ... [propagated-inputs]: ... this, to ensure that "python -m snakemake" works (because snakemake uses it internally). Signed-off-by: Marius Bakke --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 0accf918ee..a8248e3ec8 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -9688,7 +9688,7 @@ (define-public snakemake-6 ;; because there are no AWS credentials. (delete-file "tests/test_tibanna.py") (invoke "pytest"))))))) - (inputs + (propagated-inputs (list python-appdirs python-configargparse python-connection-pool From 9529384c92e6427e7d277ffaa391405ef6ab22f3 Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Thu, 25 Aug 2022 20:47:32 +0200 Subject: [PATCH 47/91] gnu: snakemake-7: Convert dependencies to propagated-inputs * gnu/packages/python-xyz.scm (snakemake-7)[inputs]: Change to ... [propagated-inputs]: ... this, to ensure that "python -m snakemake" works (because snakemake uses it internally). Signed-off-by: Marius Bakke --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index a8248e3ec8..f58677993c 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -9758,7 +9758,7 @@ (define-public snakemake-7 ;; to the Google Storage service. (delete-file "tests/test_google_lifesciences.py") (invoke "pytest"))))))) - (inputs + (propagated-inputs (list python-appdirs python-configargparse python-connection-pool From acbf2f9def5ce181fab09abec0978f1d2c1bcb33 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Thu, 18 Aug 2022 10:11:36 +0200 Subject: [PATCH 48/91] gnu: libvirt: Use absolute dnsmasq. Fixes . Reported by Lars-Dominik Braun . * gnu/packages/virtualization.scm (libvirt)[arguments]: Substitute the absolute dnsmasq file name. Disable one test. Co-authored-by: Marius Bakke --- gnu/packages/virtualization.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm index d451b8529e..005421aaec 100644 --- a/gnu/packages/virtualization.scm +++ b/gnu/packages/virtualization.scm @@ -1311,9 +1311,16 @@ (define-public libvirt (substitute* "scripts/meson-install-dirs.py" (("destdir = .*") "destdir = '/tmp'")))) + (add-after 'unpack 'use-absolute-dnsmasq + (lambda* (#:key inputs #:allow-other-keys) + (let ((dnsmasq (search-input-file inputs "sbin/dnsmasq"))) + (substitute* "src/util/virdnsmasq.c" + (("#define DNSMASQ \"dnsmasq\"") + (string-append "#define DNSMASQ \"" dnsmasq "\"")))))) (add-before 'configure 'disable-broken-tests (lambda _ (let ((tests (list "commandtest" ; hangs idly + "networkxml2conftest" ; fails with absolute dnsmasq "qemuxml2argvtest" ; fails "virnetsockettest"))) ; tries to network (substitute* "tests/meson.build" From 3e0abde17be944153be57ab5faeefc645266d39d Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 20:08:38 +0200 Subject: [PATCH 49/91] tests: libvirt: Ensure the default network can be started. * gnu/tests/virtualization.scm (run-libvirt-test): Run commands to create and start the default network. --- gnu/packages/virtualization.scm | 2 +- gnu/tests/virtualization.scm | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm index 005421aaec..73e6f89166 100644 --- a/gnu/packages/virtualization.scm +++ b/gnu/packages/virtualization.scm @@ -14,7 +14,7 @@ ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020, 2021 Brice Waegeneire ;;; Copyright © 2020 Mathieu Othacehe -;;; Copyright © 2020, 2021 Marius Bakke +;;; Copyright © 2020, 2021, 2022 Marius Bakke ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer ;;; Copyright © 2020 Brett Gilio ;;; Copyright © 2021 Leo Famulari diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 4bd56e5d9d..557f30db4f 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -106,6 +106,26 @@ (define marionette "-c" "qemu:///system" "connect")) marionette)) + (test-eq "create default network" + 0 + (marionette-eval + '(begin + (chdir "/tmp") + (system* #$(file-append libvirt "/bin/virsh") + "-c" "qemu:///system" "net-define" + #$(file-append libvirt + "/etc/libvirt/qemu/networks/default.xml"))) + marionette)) + + (test-eq "start default network" + 0 + (marionette-eval + '(begin + (chdir "/tmp") + (system* #$(file-append libvirt "/bin/virsh") + "-c" "qemu:///system" "net-start" "default")) + marionette)) + (test-end)))) (gexp->derivation "libvirt-test" test)) From eb52b240eb58627cc76a03244c45502c4ec3c50e Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 21:21:40 +0200 Subject: [PATCH 50/91] gnu: Add missing copyright line. This is a follow-up to commit 3e0abde17be944153be57ab5faeefc645266d39d. * gnu/tests/virtualization.scm: Add copyright header for myself. --- gnu/tests/virtualization.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 557f30db4f..60789fbb5b 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2020-2022 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2021 Pierre Langlois +;;; Copyright © 2022 Marius Bakke ;;; ;;; This file is part of GNU Guix. ;;; From 9096bc28a30d48486efa13488ac4814b2ccd0fa2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 28 Aug 2022 23:03:34 +0200 Subject: [PATCH 51/91] services: provenance: Use 'current-channels' to obtain provenance data. Previously, build-time metadata from (guix config) would be ignored when available--e.g., when running /run/current-system/profile/bin/guix. This is a followup to 316fc2acbb112bfa572ae30f95a93bcd56621234. * gnu/services.scm (provenance-entry): Use 'current-channels' instead of 'current-profile' + 'profile-channels'. --- gnu/services.scm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/gnu/services.scm b/gnu/services.scm index cc2540ee50..2abef557d4 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -482,11 +482,8 @@ (define (provenance-file channels config-file) (define (provenance-entry config-file) "Return system entries describing the operating system provenance: the channels in use and CONFIG-FILE, if it is true." - (define profile - (current-profile)) - (define channels - (and=> profile profile-channels)) + (current-channels)) (mbegin %store-monad (let ((config-file (cond ((string? config-file) From b08439809f0868a74d0bd0e14d45cb3e5dd46a8c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 28 Aug 2022 23:05:57 +0200 Subject: [PATCH 52/91] reconfigure: Use 'current-channels' to obtain provenance data. Previously, build-time metadata from (guix config) would be ignored when available--e.g., when running /run/current-system/profile/bin/guix. This is a followup to 316fc2acbb112bfa572ae30f95a93bcd56621234. * guix/scripts/system/reconfigure.scm (check-forward-update): Use 'current-channels' rather than 'current-profile' + 'profile-channels'. --- guix/scripts/system/reconfigure.scm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 9ca66687ee..9bd26a39ee 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -34,7 +34,7 @@ (define-module (guix scripts system reconfigure) #:use-module (guix monads) #:use-module (guix store) #:use-module ((guix self) #:select (make-config.scm)) - #:autoload (guix describe) (current-profile) + #:autoload (guix describe) (current-channels) #:use-module (guix channels) #:autoload (guix git) (update-cached-checkout) #:use-module (guix i18n) @@ -372,8 +372,7 @@ (define* (check-forward-update #:optional 'guix system describe' by default) and the target commit (as returned by 'guix describe')." (define new - (or (and=> (current-profile) profile-channels) - '())) + (current-channels)) (when (null? current-channels) (warning (G_ "cannot determine provenance for current system~%"))) From 1cf6cb9503a846d2ae52585ced522061f7fffe1e Mon Sep 17 00:00:00 2001 From: "Paul A. Patience" Date: Sun, 24 Jul 2022 12:02:47 +0000 Subject: [PATCH 53/91] gnu: Add mmg. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/graphics.scm (mmg): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/graphics.scm | 103 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/gnu/packages/graphics.scm b/gnu/packages/graphics.scm index 9a378e76a6..931a558e8a 100644 --- a/gnu/packages/graphics.scm +++ b/gnu/packages/graphics.scm @@ -2182,6 +2182,109 @@ (define-public azpainter ") (license license:gpl3+))) +(define-public mmg + (package + (name "mmg") + (version "5.6.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/MmgTools/mmg") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 "173biz5skbwg27i5w6layg7mydjzv3rmi1ywhra4rx9rjf5c0cc5")))) + (build-system cmake-build-system) + (outputs '("out" "lib" "doc")) + (arguments + (list #:configure-flags + #~(list (string-append "-DCMAKE_INSTALL_PREFIX=" #$output:lib) + (string-append "-DCMAKE_INSTALL_RPATH=" #$output:lib "/lib") + ;; The build doesn't honor -DCMAKE_INSTALL_BINDIR, hence + ;; the adjust-bindir phase. + ;;(string-append "-DCMAKE_INSTALL_BINDIR=" #$output "/bin") + "-DBUILD_SHARED_LIBS=ON" + "-DBUILD_TESTING=ON" + ;; The longer tests are for continuous integration and + ;; depend on input data which must be downloaded. + "-DONLY_VERY_SHORT_TESTS=ON" + ;; TODO: Add Elas (from + ;; https://github.com/ISCDtoolbox/LinearElasticity). + "-DUSE_ELAS=OFF" + ;; TODO: Figure out how to add VTK to inputs without + ;; causing linking errors in ASLI of the form: + ;; + ;; ld: /gnu/store/…-vtk-9.0.1/lib/libvtkWrappingPythonCore-9.0.so.1: + ;; undefined reference to `PyUnicode_InternFromString' + ;; + ;; Also, adding VTK to inputs requires adding these as well: + ;; + ;; double-conversion eigen expat freetype gl2ps glew hdf5 + ;; jsoncpp libjpeg-turbo libpng libtheora libtiff libx11 + ;; libxml2 lz4 netcdf proj python sqlite zlib + "-DUSE_VTK=OFF") + #:phases + #~(modify-phases %standard-phases + (add-after 'build 'build-doc + (lambda _ + ;; Fontconfig wants to write to a cache directory. + (setenv "HOME" "/tmp") + (invoke "make" "doc"))) + (add-after 'install 'install-doc + (lambda _ + (copy-recursively + "../source/doc/man" (string-append #$output + "/share/man/man1")) + (copy-recursively + "doc" (string-append #$output:doc "/share/doc/" + #$name "-" #$version)))) + (add-after 'install 'adjust-bindir + (lambda _ + (let ((src (string-append #$output:lib "/bin")) + (dst (string-append #$output "/bin"))) + (copy-recursively src dst) + (delete-file-recursively src)))) + ;; Suffixing program names with build information, i.e., + ;; optimization flags and whether debug symbols were generated, + ;; is unusual and fragilizes scripts calling these programs. + (add-after 'adjust-bindir 'fix-program-names + (lambda _ + (with-directory-excursion (string-append #$output "/bin") + (rename-file "mmg2d_O3d" "mmg2d") + (rename-file "mmg3d_O3d" "mmg3d") + (rename-file "mmgs_O3d" "mmgs"))))))) + (native-inputs + ;; For the documentation + (list doxygen graphviz + ;; TODO: Fix failing LaTeX invocation (which results in equations + ;; being inserted literally into PNGs rather than being typeset). + ;;texlive-tiny + )) + (inputs + (list scotch)) + (home-page "http://www.mmgtools.org/") + (synopsis "Surface and volume remeshers") + (description "Mmg is a collection of applications and libraries for +bidimensional and tridimensional surface and volume remeshing. It consists +of: + +@itemize +@item the @code{mmg2d} application and library: mesh generation from a set of +edges, adaptation and optimization of a bidimensional triangulation and +isovalue discretization; + +@item the @code{mmgs} application and library: adaptation and optimization of +a surface triangulation and isovalue discretization; + +@item the @code{mmg3d} application and library: adaptation and optimization of +a tetrahedral mesh, isovalue discretization and Lagrangian movement; + +@item the @code{mmg} library gathering the @code{mmg2d}, @code{mmgs} and +@code{mmg3d} libraries. +@end itemize") + (license license:lgpl3+))) + (define-public f3d ;; There have been many improvements since the last tagged version (1.2.1, ;; released in December 2021), including support for the Alembic file From 05246c691bd9843d190d4b4b7e116dc19fe20520 Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:18 +0200 Subject: [PATCH 54/91] gnu: Add swftools. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/animation.scm (swftools): Add variable. Co-authored-by: Ludovic Courtès --- gnu/packages/animation.scm | 99 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) diff --git a/gnu/packages/animation.scm b/gnu/packages/animation.scm index b8524681fa..a1932b5f06 100644 --- a/gnu/packages/animation.scm +++ b/gnu/packages/animation.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2018–2021 Tobias Geerinckx-Rice ;;; Copyright © 2019 Pkill -9 ;;; Copyright © 2020, 2021, 2022 Vinicius Monego +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +48,7 @@ (define-module (gnu packages animation) #:use-module (gnu packages image) #:use-module (gnu packages imagemagick) #:use-module (gnu packages jemalloc) + #:use-module (gnu packages mp3) #:use-module (gnu packages networking) #:use-module (gnu packages pcre) #:use-module (gnu packages perl) @@ -495,3 +497,100 @@ (define-public pencil2d lets you create traditional hand-drawn animations (cartoons) using both bitmap and vector graphics.") (license license:gpl2))) + +(define-public swftools + ;; Last release of swftools was 0.9.2 on 2012-04-21 - it is really old and + ;; does not compile with what's available in guix, master on the other hand works. + (let ((commit "772e55a271f66818b06c6e8c9b839befa51248f4") + (revision "1")) + (package + (name "swftools") + (version (git-version "0.9.2" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/matthiaskramm/swftools") + (commit commit))) + (sha256 + (base32 "0a8a29rn7gpxnba3spnvkpdgr7mdlssvr273mzw5b2wjvbzard3w")) + (file-name (git-file-name name version)) + (modules '((guix build utils))) + (snippet + '(begin + ;; XXX: Swftools includes the source tarball of an old version of + ;; xpdf. + + ;; To fix a linking error I followed the workaround in: + ;; https://github.com/matthiaskramm/swftools/issues/178 + ;; and implented it as a two-step snippet because substitute* + ;; does not match multiline regexes. + (substitute* "lib/lame/quantize.c" + ;; move inline keywords to the same line as their function headers + (("^inline.*\n") "inline ")) + (substitute* "lib/lame/quantize.c" + ;; make this particular function not inline + (("inline (void bitpressure_strategy1)" _ f) f)))))) + (build-system gnu-build-system) + (arguments + (list #:tests? #f)) ; no rule for check + (inputs (list zlib freetype giflib libjpeg-turbo lame)) + (home-page "http://www.swftools.org") + (synopsis "Collection of utilities for working with Adobe Flash files") + + ;; XXX: This package will built all of swftools' tools but one: PDF2SWF, + ;; purposefuly commented out of the description below. + (description "SWFTools is a collection of utilities for working with +Adobe Flash files (SWF files). The tool collection includes programs for +reading SWF files, combining them, and creating them from other content (like +images, sound files, videos or sourcecode). The current collection is + comprised of the programs detailed below: + +@itemize +@comment PDF2SWF is not currentlybeing build alongside other tools. The next +@comment two lines should be uncommented if this will ever get fixed. +@comment @item +@comment @command{pdf2swf} A PDF to SWF Converter. + +@item +@command{swfcombine} A multi-function tool for inserting, contatenating, +stacking and changing parameters in SWFs. + +@item +@command{swfstrings} Scans SWFs for text data. +@item +@command{swfdump} Prints out various informations about SWFs. + +@item +@command{jpeg2swf} Takes one or more JPEG pictures and generates a SWF +slideshow from them. + +@item +@command{png2swf} Like JPEG2SWF, only for PNGs. + +@item +@command{gif2swf} Converts GIFs to SWF. Also able to handle animated GIFs. + +@item +@command{wav2swf} Converts WAV audio files to SWFs, using the LAME MP3 + encoder library. + +@item +@command{font2swf} Converts font files (TTF, Type1) to SWF. + +@item +@command{swfbbox} Allows to read out, optimize and readjust SWF bounding boxes. + +@item +@command{swfc} A tool for creating SWF files from simple script files. Supports +both ActionScript 2.0 aand 3.0. + +@item +@command{swfextract} Allows to extract Movieclips, Sounds, Images etc. from SWF + files. + +@item +@command{as3compile} A standalone ActionScript 3.0 compiler. Mostly compatible + with Flex. +@end itemize") + (license license:gpl2+)))) From e1ea628776e9a2b6e3c54256e959d04af9ee9513 Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:19 +0200 Subject: [PATCH 55/91] gnu: Add python-xvfbwrapper. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-check.scm (python-xvfbwrapper): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/python-check.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/gnu/packages/python-check.scm b/gnu/packages/python-check.scm index 7cc266fbce..d7a7a90706 100644 --- a/gnu/packages/python-check.scm +++ b/gnu/packages/python-check.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2021 Bonface Munyoki Kilyungi ;;; Copyright © 2022 Malte Frank Gerdes ;;; Copyright © 2022 Felix Gruber +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -2373,3 +2374,24 @@ (define-public python-pycotap attachments). @end itemize") (license license:expat))) + +(define-public python-xvfbwrapper + (package + (name "python-xvfbwrapper") + (version "0.2.9") + (source (origin + (method url-fetch) + (uri (pypi-uri "xvfbwrapper" version)) + (sha256 + (base32 + "097wxhvp01ikqpg1z3v8rqhss6f1vwr399zpz9a05d2135bsxx5w")))) + (build-system python-build-system) + (propagated-inputs (list xorg-server-for-tests)) + (home-page "https://github.com/cgoldberg/xvfbwrapper") + (synopsis "Python module for controlling virtual displays with Xvfb") + (description + "Xvfb (X virtual framebuffer) is a display server implementing +the X11 display server protocol. It runs in memory and does not require a +physical display. Only a network layer is necessary. Xvfb is useful for +running acceptance tests on headless servers.") + (license license:expat))) From 619af9f3076fbfb29f4c44e38a74bc1c5808624c Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:20 +0200 Subject: [PATCH 56/91] gnu: Add python-mpv. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-xyz.scm (python-mpv): Add variable. Co-authored-by: Ludovic Courtès --- gnu/packages/python-xyz.scm | 63 +++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index f58677993c..1907b863ff 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -127,6 +127,7 @@ ;;; Copyright © 2022 Philip McGrath ;;; Copyright © 2022 Marek Felšöci ;;; Copyright © 2022 Hilton Chain +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -30430,6 +30431,68 @@ (define-public python-bsdiff4 and @code{bspatch4}.") (license license:bsd-2))) +(define-public python-mpv + (package + (name "python-mpv") + (version "1.0.1") + (source + (origin + ;; python-mpv from pypi does not include the tests directory. + (method git-fetch) + (uri (git-reference + (url "https://github.com/jaseg/python-mpv") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "10w6j3n62ap45sf6q487kz8z6g58sha37i14fa2hhng794z7a8jh")) + (modules '((guix build utils))) + (snippet + #~(begin + ;; One of the tests never completes, so neutering it using + ;; early return allows other test to run without issue. + (substitute* "tests/test_mpv.py" + ;; Note the typo in "prooperty" - this was fixed later in + ;; upstream but has no effect on whether the tests hangs or not. + (("test_wait_for_prooperty_event_overflow.*" line) + ;; The long whitespace between \n and return is to match the + ;; identation level, which is significant in python. + (string-append line "\n return\n"))))))) + (build-system python-build-system) + (arguments + (list #:phases + #~(modify-phases %standard-phases + (add-before 'build 'patch-reference-to-mpv + (lambda* (#:key inputs #:allow-other-keys) + ;; Without an absolute path it is not able find and + ;; load the libmpv library. + (substitute* "mpv.py" + (("sofile = .*") + (string-append "sofile = \"" + (search-input-file inputs "/lib/libmpv.so") + "\"\n"))))) + (add-before 'check 'prepare-for-tests + (lambda _ + ;; Fontconfig throws errors when it has no cache dir to use. + (setenv "XDG_CACHE_HOME" (getcwd)) + ;; Some tests fail without a writable and readable HOME. + (setenv "HOME" (getcwd))))))) + (native-inputs + (list python-xvfbwrapper)) ; needed for tests only + (inputs (list mpv)) + (propagated-inputs (list python-pillow)) ; for raw screenshots + (home-page "https://github.com/jaseg/python-mpv") + (synopsis "Python interface to the mpv media player") + (description + "python-mpv is a ctypes-based python interface to the mpv media player. +It gives you more or less full control of all features of the player, just +as the lua interface does.") + ;; From the project's README: + ;; python-mpv inherits the underlying libmpv's license, which can be either + ;; GPLv2 or later (default) or LGPLv2.1 or later. For details, see the mpv + ;; copyright page. + (license license:gpl2+))) + (define-public python-biblib (let ((upstream-version "0.1.0") (commit "ab0e857b9198fe425ec9b02fcc293b5d9fd0c406") From 5920196e47343403ea43f49c19b637fe62a11220 Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:21 +0200 Subject: [PATCH 57/91] gnu: opencv: Build Python bindings. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/image-processing.scm (opencv)[arguments]: Change variable. Signed-off-by: Ludovic Courtès --- gnu/packages/image-processing.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/gnu/packages/image-processing.scm b/gnu/packages/image-processing.scm index 3dfe086af8..0225f72651 100644 --- a/gnu/packages/image-processing.scm +++ b/gnu/packages/image-processing.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2021 Guillaume Le Vaillant ;;; Copyright © 2021 Ivan Gankevich ;;; Copyright © 2022 Maxim Cournoyer +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -511,6 +512,9 @@ (define-public opencv ;; DISPATCH is the list of optional dispatches. "-DCPU_BASELINE=SSE2" + ;; Build Python bindings. + "-DBUILD_opencv_python3=ON" + ,@(match (%current-system) ("x86_64-linux" '("-DCPU_DISPATCH=NEON;VFPV3;FP16;SSE;SSE2;SSE3;SSSE3;SSE4_1;SSE4_2;POPCNT;AVX;FP16;AVX2;FMA3;AVX_512F;AVX512_SKX" From f82a8873d3f4c9b0760846b8d3495135de78e389 Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:22 +0200 Subject: [PATCH 58/91] gnu: python-cloudscraper: Update to 1.2.60. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-web.scm (python-cloudscraper): Update to 1.2.60 [propagated-inputs]: Change python-pyparsing to its mainstream version. Co-authored-by: Ludovic Courtès --- gnu/packages/python-web.scm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm index d060d5b27c..df63602236 100644 --- a/gnu/packages/python-web.scm +++ b/gnu/packages/python-web.scm @@ -54,6 +54,7 @@ ;;; Copyright © 2022 Antero Mejr ;;; Copyright © 2022 Luis Henrique Gomes Higino ;;; Copyright © 2022 Nicolas Graves +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -6270,17 +6271,16 @@ (define-public python-http-ece (define-public python-cloudscraper (package (name "python-cloudscraper") - (version "1.2.58") + (version "1.2.60") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/VeNoMouS/cloudscraper") - ;; Corresponds to 1.2.58 - (commit "f3a3d067ea8b5238e9a0948aed0c3fa0d9c29b96"))) + (commit version))) (file-name (git-file-name name version)) (sha256 - (base32 "18fbp086imabjxly04rrchbf6n6m05bpd150zxbw7z2w3mjnpsqd")) + (base32 "00cmxgwdm0x1j4a4ipwvpzih735hdzidljbijk1b3laj3dgvnvsm")) (modules '((guix build utils))) (snippet '(with-directory-excursion "cloudscraper" @@ -6320,7 +6320,7 @@ (define-public python-cloudscraper python-requests python-requests-toolbelt python-responses - python-pyparsing-2.4.7)) + python-pyparsing)) (native-inputs (list python-pytest)) (home-page "https://github.com/venomous/cloudscraper") From 9b8507df11f5ca3d13e49dc0588d3522d28fa9e4 Mon Sep 17 00:00:00 2001 From: Tomasz Jeneralczyk Date: Sun, 14 Aug 2022 14:46:23 +0200 Subject: [PATCH 59/91] gnu: Add hydrus-network. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/image-viewers.scm (hydrus-network): Add variable. Co-authored-by: Ludovic Courtès --- gnu/packages/image-viewers.scm | 136 +++++++++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) diff --git a/gnu/packages/image-viewers.scm b/gnu/packages/image-viewers.scm index 52c9584f67..23175472ef 100644 --- a/gnu/packages/image-viewers.scm +++ b/gnu/packages/image-viewers.scm @@ -25,6 +25,7 @@ ;;; Copyright © 2021 dissent ;;; Copyright © 2022 Michael Rohleder ;;; Copyright © 2022 Maxim Cournoyer +;;; Copyright © 2022 Tomasz Jeneralczyk ;;; ;;; This file is part of GNU Guix. ;;; @@ -55,6 +56,7 @@ (define-module (gnu packages image-viewers) #:use-module (guix build-system qt) #:use-module (gnu packages autotools) #:use-module (gnu packages algebra) + #:use-module (gnu packages animation) #:use-module (gnu packages backup) #:use-module (gnu packages base) #:use-module (gnu packages bash) @@ -85,14 +87,20 @@ (define-module (gnu packages image-viewers) #:use-module (gnu packages photo) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages python-check) + #:use-module (gnu packages python-compression) + #:use-module (gnu packages python-crypto) + #:use-module (gnu packages python-web) #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages suckless) #:use-module (gnu packages terminals) + #:use-module (gnu packages upnp) #:use-module (gnu packages version-control) #:use-module (gnu packages video) #:use-module (gnu packages web) #:use-module (gnu packages xdisorg) + #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module (gnu packages)) @@ -973,3 +981,131 @@ (define-public xzgv (description "xzgv is a fast image viewer that provides extensive keyboard support.") (license license:gpl2+))) + +(define-public hydrus-network + (package + (name "hydrus-network") + (version "495") ;upstream has a weekly release cycle + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/hydrusnetwork/hydrus") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "03zhrcmjzbk37sl9nwjahfmr8aflss84c4xhg5ci5b8jvbbqmr1j")) + (modules '((guix build utils))) + (snippet + ;; Remove pre-built binaries from bin/. + #~(for-each delete-file (find-files "bin" "^swfrender"))))) + (build-system python-build-system) + (arguments + (list + #:phases + #~(let ((static-dir "/share/hydrus/static")) + (modify-phases %standard-phases + ;; Hydrus is a python program but does not uses setup.py or any + ;; other build system to build itself - it's delivered ready to + ;; run from the source. + (replace 'check + (lambda _ + (setenv "DISPLAY" ":0") + (setenv "XDG_CACHE_HOME" (getcwd)) + (setenv "HOME" (getcwd)) + (invoke "xvfb-run" "python" "test.py"))) + ;; XXX: program help files are not built. Updating + ;; python-pymdown-extensions to its latest version might be the + ;; solution, but this would require also packaging its new build + ;; system that is not present in guix yet. + (delete 'build) + (add-before 'install 'patch-variables + (lambda* (#:key outputs inputs #:allow-other-keys) + (let ((ffmpeg (search-input-file inputs "/bin/ffmpeg")) + (swfrender (search-input-file inputs "/bin/swfrender")) + (upnpc (search-input-file inputs "/bin/upnpc")) + (out (assoc-ref outputs "out"))) + (with-directory-excursion "hydrus" + ;; Without this the program would incorrectly assume + ;; that it uses user's ffmpeg binary when it isn't. + (substitute* "client/ClientController.py" + (("if (HydrusVideoHandling\\.FFMPEG_PATH).*" _ var) + (string-append "if " var " == \"" ffmpeg "\":\n"))) + (with-directory-excursion "core" + (substitute* "HydrusConstants.py" + (("STATIC_DIR = .*") + (string-append "STATIC_DIR = \"" out static-dir "\"\n"))) + (substitute* "HydrusFlashHandling.py" + (("SWFRENDER_PATH = .*\n") + (string-append "SWFRENDER_PATH = \"" swfrender "\"\n"))) + (substitute* "HydrusVideoHandling.py" + (("FFMPEG_PATH = .*\n") + (string-append "FFMPEG_PATH = \"" ffmpeg "\"\n"))) + (substitute* "networking/HydrusNATPunch.py" + (("UPNPC_PATH = .*\n") + (string-append "UPNPC_PATH = \"" upnpc "\"\n")))))))) + ;; Since everything lives in hydrus's root directory, it needs to + ;; be spread out to comply with guix's expectations. + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (client (string-append out "/bin/hydrus")) + (server (string-append out "/bin/hydrus-server"))) + (copy-recursively "static" + (string-append out static-dir)) + (copy-recursively "hydrus" + (string-append out + "/lib/python" + (python-version + #$(this-package-input "python")) + "/site-packages/hydrus")) + (mkdir (string-append out "/bin")) + (copy-file "client.py" client) + (chmod client #o0555) + (copy-file "server.py" server) + (chmod server #o0555)))))))) + ;; All native-inputs are only needed for the the check phase + (native-inputs + (list xvfb-run + python-nose + python-mock + python-httmock)) + ;; All python packages were taken from static/build_files/linux/requirements.txt + (propagated-inputs + (list python-beautifulsoup4 + python-cbor2 + python-chardet + python-cloudscraper + python-html5lib + python-lxml + python-lz4 + python-numpy + opencv ; its python bindings are a drop-in replacement for opencv-python-headless + python-pillow + python-psutil + python-pylzma + python-pyopenssl + ;; Since hydrus' version 494 it supports python-pyside-6 but it's not yet + ;; in guix. pyside-2 is still supported as a fallback. + python-pyside-2 + python-pysocks + python-mpv + python-pyyaml + python-qtpy + python-requests + python-send2trash + python-service-identity + python-six + python-twisted)) + (inputs + (list swftools ffmpeg miniupnpc python)) + (synopsis "Organize your media with tags like a dektop booru") + (description + "The hydrus network client is an application written for +internet-fluent media nerds who have large image/swf/webm collections. +It browses with tags instead of folders, a little like a booru on your desktop. +Advanced users can share tags and files anonymously through custom servers that +any user may run. Everything is free and privacy is the first concern.") + (home-page "https://hydrusnetwork.github.io/hydrus/") + (license license:wtfpl2))) From e214e87cc5e0bd0d3325aab1c9086354f6570e9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= Date: Tue, 30 Aug 2022 14:43:21 +0800 Subject: [PATCH 60/91] Revert "reconfigure: Use 'current-channels' to obtain provenance data." This fixes . This reverts commit b08439809f0868a74d0bd0e14d45cb3e5dd46a8c. --- guix/scripts/system/reconfigure.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 9bd26a39ee..9ca66687ee 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -34,7 +34,7 @@ (define-module (guix scripts system reconfigure) #:use-module (guix monads) #:use-module (guix store) #:use-module ((guix self) #:select (make-config.scm)) - #:autoload (guix describe) (current-channels) + #:autoload (guix describe) (current-profile) #:use-module (guix channels) #:autoload (guix git) (update-cached-checkout) #:use-module (guix i18n) @@ -372,7 +372,8 @@ (define* (check-forward-update #:optional 'guix system describe' by default) and the target commit (as returned by 'guix describe')." (define new - (current-channels)) + (or (and=> (current-profile) profile-channels) + '())) (when (null? current-channels) (warning (G_ "cannot determine provenance for current system~%"))) From f126f23b132148192b2c9a89032a5831af0b3c52 Mon Sep 17 00:00:00 2001 From: Reza Alizadeh Majd Date: Sun, 28 Aug 2022 12:34:46 +0430 Subject: [PATCH 61/91] bootloader: Add device-tree-support? option. In some specific cases where the device tree file is already loaded in RAM, it can be preferable that the bootloader does not try to use a device tree from the Linux kernel tree. * gnu/bootloader.scm ()[device-tree-support?]: New field. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Add FDTDIR line based on field of . * doc/guix.texi (Bootloader Configuration)[device-tree-support?]: Add documentation for the new field. --- doc/guix.texi | 9 +++++++++ gnu/bootloader.scm | 6 +++++- gnu/bootloader/extlinux.scm | 12 ++++++++++-- 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 7199ff6bc2..3c575dad11 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -37439,6 +37439,15 @@ corresponds to COM1 (@pxref{Serial terminal,,, grub,GNU GRUB manual}). The speed of the serial interface, as an integer. For GRUB, the default value is chosen at run-time; currently GRUB chooses 9600@tie{}bps (@pxref{Serial terminal,,, grub,GNU GRUB manual}). + +@item @code{device-tree-support?} (default: @code{#t}) +Whether to support Linux @uref{https://en.wikipedia.org/wiki/Devicetree, +device tree} files loading. + +This option in enabled by default. In some cases involving the +@code{u-boot} bootloader, where the device tree has already been loaded +in RAM, it can be handy to disable the option by setting it to +@code{#f}. @end table @end deftp diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 2eec48693c..7d076ec51c 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2019, 2021 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2022 Josselin Poiret +;;; Copyright © 2022 Reza Alizadeh Majd ;;; ;;; This file is part of GNU Guix. ;;; @@ -72,6 +73,7 @@ (define-module (gnu bootloader) bootloader-configuration-terminal-inputs bootloader-configuration-serial-unit bootloader-configuration-serial-speed + bootloader-configuration-device-tree-support? %bootloaders lookup-bootloader-by-name @@ -232,7 +234,9 @@ (define-record-type* (serial-unit bootloader-configuration-serial-unit ;integer | #f (default #f)) (serial-speed bootloader-configuration-serial-speed ;integer | #f - (default #f))) + (default #f)) + (device-tree-support? bootloader-configuration-device-tree-support? + (default #t))) ;boolean (define-deprecated (bootloader-configuration-target config) bootloader-configuration-targets diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm index 6b5ff298e7..d9b6d8bf8a 100644 --- a/gnu/bootloader/extlinux.scm +++ b/gnu/bootloader/extlinux.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 David Craven ;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2022 Reza Alizadeh Majd ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,6 +39,9 @@ (define* (extlinux-configuration-file config entries (define all-entries (append entries (bootloader-configuration-menu-entries config))) + (define with-fdtdir? + (bootloader-configuration-device-tree-support? config)) + (define (menu-entry->gexp entry) (let ((label (menu-entry-label entry)) (kernel (menu-entry-linux entry)) @@ -46,12 +50,16 @@ (define (menu-entry->gexp entry) #~(format port "LABEL ~a MENU LABEL ~a KERNEL ~a - FDTDIR ~a/lib/dtbs + ~a INITRD ~a APPEND ~a ~%" #$label #$label - #$kernel (dirname #$kernel) #$initrd + #$kernel + (if #$with-fdtdir? + (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs") + "") + #$initrd (string-join (list #$@kernel-arguments))))) (define builder From 93ed34977eba26fbb74881bbb3d9af9b3118a663 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 29 Aug 2022 22:24:24 +0200 Subject: [PATCH 62/91] bootloader: Wrap lines. * gnu/bootloader (): Wrap lines, no functional change. --- gnu/bootloader.scm | 54 ++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 26 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 7d076ec51c..77c05e8946 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 David Craven -;;; Copyright © 2017, 2020 Mathieu Othacehe +;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2019, 2021 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen @@ -212,31 +212,33 @@ (define-with-syntax-properties (warn-target-field-deprecation (define-record-type* bootloader-configuration make-bootloader-configuration bootloader-configuration? - (bootloader bootloader-configuration-bootloader) ; - (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 - (default '())) - (default-entry bootloader-configuration-default-entry ;integer - (default 0)) - (timeout bootloader-configuration-timeout ;seconds as integer - (default 5)) - (keyboard-layout bootloader-configuration-keyboard-layout ; | #f - (default #f)) - (theme bootloader-configuration-theme ;bootloader-specific theme - (default #f)) - (terminal-outputs bootloader-configuration-terminal-outputs ;list of symbols - (default '(gfxterm))) - (terminal-inputs bootloader-configuration-terminal-inputs ;list of symbols - (default '())) - (serial-unit bootloader-configuration-serial-unit ;integer | #f - (default #f)) - (serial-speed bootloader-configuration-serial-speed ;integer | #f - (default #f)) - (device-tree-support? bootloader-configuration-device-tree-support? - (default #t))) ;boolean + (bootloader + bootloader-configuration-bootloader) ; + (targets %bootloader-configuration-targets + (default #f)) ;list of strings + (target %bootloader-configuration-target ;deprecated + (default #f) + (sanitize warn-target-field-deprecation)) + (menu-entries bootloader-configuration-menu-entries + (default '())) ;list of + (default-entry bootloader-configuration-default-entry + (default 0)) ;integer + (timeout bootloader-configuration-timeout + (default 5)) ;seconds as integer + (keyboard-layout bootloader-configuration-keyboard-layout + (default #f)) ; | #f + (theme bootloader-configuration-theme + (default #f)) ;bootloader-specific theme + (terminal-outputs bootloader-configuration-terminal-outputs + (default '(gfxterm))) ;list of symbols + (terminal-inputs bootloader-configuration-terminal-inputs + (default '())) ;list of symbols + (serial-unit bootloader-configuration-serial-unit + (default #f)) ;integer | #f + (serial-speed bootloader-configuration-serial-speed + (default #f)) ;integer | #f + (device-tree-support? bootloader-configuration-device-tree-support? + (default #t))) ;boolean (define-deprecated (bootloader-configuration-target config) bootloader-configuration-targets From 65ce5fe2fb1783c5eae7b439f79627fdb5e9c578 Mon Sep 17 00:00:00 2001 From: Thiago Jung Bauermann Date: Sun, 21 Aug 2022 03:11:24 -0300 Subject: [PATCH 63/91] guix system: Use standard cross and native build options. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change prevents guix system from erroring out with an ugly backtrace when it's passed an invalid value to the “--system” or “--target” option. It also adds the “--list-systems” and “--list-targets” options. The manual section about guix system doesn't mention the “--target” option, so add it there. * guix/scripts/system (show-help): Call show-cross-build-options-help and show-native-build-options-help. (%options): Remove own implementation of “system” and “target” options and use the ones in %standard-cross-build-options and %standard-native-build-options. * doc/guix.texi (Invoking guix system): Document “--target” option. Signed-off-by: Mathieu Othacehe --- doc/guix.texi | 5 +++++ guix/scripts/system.scm | 16 +++++++--------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3c575dad11..957b9a668e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38021,6 +38021,11 @@ Installation Image}). Attempt to build for @var{system} instead of the host system type. This works as per @command{guix build} (@pxref{Invoking guix build}). +@item --target=@var{triplet} +Cross-build for @var{triplet}, which must be a valid GNU triplet, such +as @code{"aarch64-linux-gnu"} (@pxref{Specifying target triplets, GNU +configuration triplets,, autoconf, Autoconf}). + @item --derivation @itemx -d Return the derivation file name of the given operating system without diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index be6e839941..443e9d3282 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1046,6 +1046,10 @@ (define (show-help) for 'describe' and 'list-generations', list installed packages matching REGEXP")) (newline) + (show-cross-build-options-help) + (newline) + (show-native-build-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -1136,14 +1140,6 @@ (define %options (let ((level (string->number* arg))) (alist-cons 'verbosity level (alist-delete 'verbosity result))))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '("target") #t #f - (lambda (opt name arg result) - (alist-cons 'target arg - (alist-delete 'target result eq?)))) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) @@ -1153,7 +1149,9 @@ (define %options (option '(#\I "list-installed") #f #t (lambda (opt name arg result) (alist-cons 'list-installed (or arg "") result))) - %standard-build-options)) + (append %standard-build-options + %standard-cross-build-options + %standard-native-build-options))) (define %default-options ;; Alist of default option values. From 81681f2d4a5fadb215488b39e6812c36d687f616 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:34 +0200 Subject: [PATCH 64/91] gnu: ghc-statistics: Properly enable tests. The comment states there are test failures and hence it is implied that the intent was to disable tests, not enable them, but tests pass and the code below enabled tests instead of disabling them. Remove #:tests? #true to satisfy the tests-true linter. * gnu/packages/haskell-xyz.scm (ghc-statistics)[arguments]{#:tests?}: Remove. Signed-off-by: Mathieu Othacehe --- gnu/packages/haskell-xyz.scm | 3 --- 1 file changed, 3 deletions(-) diff --git a/gnu/packages/haskell-xyz.scm b/gnu/packages/haskell-xyz.scm index 0ce47e0902..039f4871f2 100644 --- a/gnu/packages/haskell-xyz.scm +++ b/gnu/packages/haskell-xyz.scm @@ -12000,9 +12000,6 @@ (define-public ghc-statistics (base32 "0j9awbg47fzb58k5z2wgkp6a0042j7hqrl1g6lyflrbsfswdp5n4")))) (build-system haskell-build-system) - (arguments - '(;; Two tests fail: "Discrete CDF is OK" and "Quantile is CDF inverse". - #:tests? #t)) (inputs (list ghc-aeson ghc-async From a282c9844cd53d6a53b29ad740a95a39a30c1106 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:35 +0200 Subject: [PATCH 65/91] gnu: julia-arrayinterface: Don't ask to run tests when cross-compiling. * gnu/packages/julia-xyz.scm (julia-arrayinterface)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/julia-xyz.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/julia-xyz.scm b/gnu/packages/julia-xyz.scm index e5b159245c..a0adde6435 100644 --- a/gnu/packages/julia-xyz.scm +++ b/gnu/packages/julia-xyz.scm @@ -165,7 +165,8 @@ (define-public julia-arrayinterface ;; Expression: @inferred(ArrayInterface.size(Rnr)) === (StaticInt(4),) ;; Evaluated: (static(2),) === (static(4),) ;; Disable as stopgap. - (list #:tests? (not (target-x86-32?)))) + (list #:tests? (not (or (%current-target-system) + (target-x86-32?))))) (propagated-inputs (list julia-ifelse julia-requires From d38a0024710d83d829a1057b9445c7864346c73c Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:36 +0200 Subject: [PATCH 66/91] gnu: julia-forwarddiff: Don't ask to run tests when cross-compiling. * gnu/packages/julia-xyz.scm (julia-forwarddiff)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/julia-xyz.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/julia-xyz.scm b/gnu/packages/julia-xyz.scm index a0adde6435..4fa711b808 100644 --- a/gnu/packages/julia-xyz.scm +++ b/gnu/packages/julia-xyz.scm @@ -2049,7 +2049,8 @@ (define-public julia-forwarddiff ;; Expression: dual_isapprox(FDNUM ^ PRIMAL, exp(PRIMAL * log(FDNUM))) ;; ERROR: LoadError: LoadError: There was an error during testing ;; Disable as stopgap. - (list #:tests? (not (target-x86-32?)))) + (list #:tests? (not (or (%current-target-system) + (target-x86-32?))))) (inputs ;required for tests (list julia-calculus julia-difftests)) From 55e88a27592b5b453df9511fe55d9311e2895efd Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:37 +0200 Subject: [PATCH 67/91] gnu: julia-reversediff: Don't ask to run tests when cross-compiling. * gnu/packages/julia-xyz.scm (julia-reversediff)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/julia-xyz.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/julia-xyz.scm b/gnu/packages/julia-xyz.scm index 4fa711b808..a4b3fe2a66 100644 --- a/gnu/packages/julia-xyz.scm +++ b/gnu/packages/julia-xyz.scm @@ -4660,7 +4660,8 @@ (define-public julia-reversediff ;; Expression: hash(tr_float, hash(1)) === hash(v_float, hash(1)) ;; MethodError: no method matching decompose(::ReverseDiff.TrackedReal{Float64, Float64, Nothing}) ;; Disable as stopgap. - (list #:tests? (not (target-x86-32?)))) + (list #:tests? (not (or (%current-target-system) + (target-x86-32?))))) (propagated-inputs (list julia-diffresults julia-diffrules From 5192bead3266784d9bc98cc7a0522cf7580f175c Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:38 +0200 Subject: [PATCH 68/91] gnu: julia-interpolations: Don't ask to run tests when cross-compiling. * gnu/packages/julia-xyz.scm (julia-interpolations)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/julia-xyz.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/julia-xyz.scm b/gnu/packages/julia-xyz.scm index a4b3fe2a66..6aa185486b 100644 --- a/gnu/packages/julia-xyz.scm +++ b/gnu/packages/julia-xyz.scm @@ -2939,7 +2939,8 @@ (define-public julia-interpolations ;; Got exception outside of a @test ;; OverflowError: 96908232 * 106943408 overflowed for type Int32 ;; Disable as stopgap. - #:tests? (not (target-x86-32?)))) + #:tests? (not (or (%current-target-system) + (target-x86-32?))))) (propagated-inputs (list julia-axisalgorithms julia-offsetarrays From 0168c65de4ec9f25d5de76998474bedfd2baa7a0 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:39 +0200 Subject: [PATCH 69/91] gnu: proot: Don't ask to run tests when cross-compiling. * gnu/packages/linux.scm (proot)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/linux.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index d8f1f6912e..b5a2737730 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -7687,9 +7687,9 @@ (define-public proot ;; Disable the test suite on armhf-linux, as there are too many ;; failures to keep track of (see for example: ;; https://github.com/proot-me/proot/issues/286). - `(#:tests? ,(not (string-prefix? "armhf" - (or (%current-target-system) - (%current-system)))) + `(#:tests? ,(not (or (%current-target-system) + (string-prefix? "armhf" + (or (%current-system))))) #:make-flags '("-C" "src") #:phases (modify-phases %standard-phases (add-after 'unpack 'patch-sources From 80a75c53570a7d4af3d30f441feff8bcce5aa53a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:40 +0200 Subject: [PATCH 70/91] gnu: python-fonttools-full: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-fonttools-full)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 1907b863ff..8843d10638 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -11305,7 +11305,7 @@ (define-public python-fonttools-full (arguments (substitute-keyword-arguments (package-arguments python-fonttools) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases '%standard-phases) `(modify-phases ,phases (replace 'check From dbd5612c9045fe1d64ea01ee863163eebbe5748c Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:41 +0200 Subject: [PATCH 71/91] gnu: python-path: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-path)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 8843d10638..d5d15bb46c 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -12382,7 +12382,7 @@ (define-public python-path (substitute-keyword-arguments (package-arguments python-path-bootstrap) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (replace 'check From c548ff6a30705d648e9a704f87001c5090cc8204 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:42 +0200 Subject: [PATCH 72/91] gnu: python-jaraco-functools: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-jaraco-functools)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index d5d15bb46c..a78005e011 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -8306,7 +8306,7 @@ (define-public python-jaraco-functools (substitute-keyword-arguments (package-arguments python-jaraco-functools-bootstrap) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (replace 'check From 7d49984da4347532d5a15ec79edafce5d5a97955 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:43 +0200 Subject: [PATCH 73/91] gnu: python-pip-run: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-pip-run)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index a78005e011..e25054da5f 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -12505,7 +12505,7 @@ (define-public python-pip-run (arguments (substitute-keyword-arguments (package-arguments python-pip-run-bootstrap) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (replace 'check From 321620d15ba0400be0253c0423aea633d374ab7b Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:44 +0200 Subject: [PATCH 74/91] gnu: python-jupyter-client: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-jupyter-client)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index e25054da5f..7a91321528 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -8706,7 +8706,7 @@ (define-public python-jupyter-client (arguments (substitute-keyword-arguments (package-arguments base) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (replace 'check From d720aa4a88c77d1ba84c05e404ceae8589d9c110 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:45 +0200 Subject: [PATCH 75/91] gnu: python-jaraco-context: Don't ask to run tests when cross-compiling. * gnu/packages/python-xyz.scm (python-jaraco-context)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/python-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 7a91321528..9b3d5edb93 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -8255,7 +8255,7 @@ (define-public python-jaraco-context (substitute-keyword-arguments (package-arguments python-jaraco-context-bootstrap) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (replace 'check From d8b960983da9aeeb9a69d73f446b89cef778f546 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:46 +0200 Subject: [PATCH 76/91] gnu: ruby-rubocop: Don't ask to run tests when cross-compiling. * gnu/packages/ruby.scm (ruby-rubocop)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/ruby.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index a37a8dda24..d2c2a931a1 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -7211,7 +7211,8 @@ (define-public ruby-rubocop (arguments `(#:test-target "default" ;; TODO: Figure out why test hangs. - #:tests? ,(not (target-riscv64?)) + #:tests? ,(not (or (%current-target-system) + (target-riscv64?))) #:phases (modify-phases %standard-phases (add-before 'check 'set-home From f60653a0efc5fa27229bf51fa66baa60c80260a5 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:47 +0200 Subject: [PATCH 77/91] gnu: rust: Don't ask to run tests when cross-compiling. * gnu/packages/rust.scm (rust-1.57)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/rust.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/rust.scm b/gnu/packages/rust.scm index 67dc5cdaf3..5801a00f2b 100644 --- a/gnu/packages/rust.scm +++ b/gnu/packages/rust.scm @@ -654,7 +654,7 @@ (define rust-1.57 (arguments (substitute-keyword-arguments (package-arguments base-rust) ((#:tests? _ #f) - #t) + (not (%current-target-system))) ((#:phases phases) `(modify-phases ,phases (add-after 'unpack 'relax-gdb-auto-load-safe-path From 01df491f6db552dca22c00d3bd452d5a7eacb46a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 28 Aug 2022 16:47:48 +0200 Subject: [PATCH 78/91] gnu: yt-dlp: Don't ask to run tests when cross-compiling. * gnu/packages/video.scm (yt-dlp)[arguments]{#:tests?}: When cross-compiling, set to #false. Signed-off-by: Mathieu Othacehe --- gnu/packages/video.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 556eb46df4..28eb4aada4 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -2500,7 +2500,7 @@ (define-public yt-dlp (base32 "07qz1zdndlpki0asw35zk5hdjcwpl3n1g54nxg4yb1iykbyv7rll")))) (arguments (substitute-keyword-arguments (package-arguments youtube-dl) - ((#:tests? _) #t) + ((#:tests? _) (not (%current-target-system))) ((#:phases phases) #~(modify-phases #$phases ;; See the comment for the corresponding phase in youtube-dl. From 6beadc82df204f315d06ea35f2e232bb32f8e440 Mon Sep 17 00:00:00 2001 From: Tobias Kortkamp Date: Fri, 26 Aug 2022 12:14:58 +0200 Subject: [PATCH 79/91] gnu: wayland-protocols: Fix cross-compilation * gnu/packages/freedesktop.scm (wayland-protocols): Fix cross-compilation [native-inputs]: Add pkg-config-for-build and wayland. Signed-off-by: Mathieu Othacehe --- gnu/packages/freedesktop.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index a902fac153..d9f48b791a 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1074,8 +1074,11 @@ (define-public wayland-protocols (build-system meson-build-system) (inputs (list wayland)) - (native-inputs - (list pkg-config python)) + (native-inputs (cons* pkg-config python + (if (%current-target-system) + (list pkg-config-for-build + wayland) ; for wayland-scanner + '()))) (synopsis "Wayland protocols") (description "Wayland-Protocols contains Wayland protocols that add functionality not available in the Wayland core protocol. Such protocols either From c4acaf412064568a546034871a9e0d3888aa7937 Mon Sep 17 00:00:00 2001 From: Nicolas Graves Date: Fri, 12 Aug 2022 10:58:48 +0200 Subject: [PATCH 80/91] etc: Add tempel snippets. * etc/snippets/tempel/scheme-mode: New file. * etc/snippets/tempel/text-mode: New file. * etc/snippets/scheme-mode: Moved from here... * etc/snippets/yas/scheme-mode: ... to here. * etc/snippets/text-mode: Moved from here... * etc/snippets/yas/text-mode: ... to here. * doc/contributing.texi ("The Perfect Setup"): Adjust yasnippet setup accordingly. Add tempel setup. Signed-off-by: Liliana Marie Prikler --- doc/contributing.texi | 18 +++- etc/snippets/tempel/scheme-mode | 80 ++++++++++++++ etc/snippets/tempel/text-mode | 101 ++++++++++++++++++ .../{ => yas}/scheme-mode/guix-bzr-reference | 0 .../{ => yas}/scheme-mode/guix-cvs-reference | 0 .../{ => yas}/scheme-mode/guix-git-reference | 0 .../{ => yas}/scheme-mode/guix-hg-reference | 0 .../{ => yas}/scheme-mode/guix-origin | 0 .../{ => yas}/scheme-mode/guix-package | 0 .../{ => yas}/scheme-mode/guix-svn-reference | 0 .../guix-commit-message-add-cl-package | 0 .../text-mode/guix-commit-message-add-package | 0 .../guix-commit-message-remove-package | 0 .../guix-commit-message-rename-package | 0 .../guix-commit-message-update-package | 0 .../guix-commit-message-use-https-home-page | 0 16 files changed, 195 insertions(+), 4 deletions(-) create mode 100644 etc/snippets/tempel/scheme-mode create mode 100644 etc/snippets/tempel/text-mode rename etc/snippets/{ => yas}/scheme-mode/guix-bzr-reference (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-cvs-reference (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-git-reference (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-hg-reference (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-origin (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-package (100%) rename etc/snippets/{ => yas}/scheme-mode/guix-svn-reference (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-add-cl-package (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-add-package (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-remove-package (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-rename-package (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-update-package (100%) rename etc/snippets/{ => yas}/text-mode/guix-commit-message-use-https-home-page (100%) diff --git a/doc/contributing.texi b/doc/contributing.texi index 02c7c5ae59..b1d236c011 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -320,15 +320,25 @@ s-expression, etc. @cindex reducing boilerplate We also provide templates for common git commit messages and package definitions in the @file{etc/snippets} directory. These templates can -be used with @url{https://joaotavora.github.io/yasnippet/, YASnippet} to -expand short trigger strings to interactive text snippets. You may want -to add the snippets directory to the @var{yas-snippet-dirs} variable in +be used to expand short trigger strings to interactive text snippets. If +you use @url{https://joaotavora.github.io/yasnippet/, YASnippet}, you +may want to add the @file{etc/snippets/yas} snippets directory to the +@var{yas-snippet-dirs} variable. If you use +@url{https://github.com/minad/tempel/, Tempel}, you may want to add the +@file{etc/snippets/tempel/*} path to the @var{tempel-path} variable in Emacs. @lisp ;; @r{Assuming the Guix checkout is in ~/src/guix.} +;; @r{Yasnippet configuration} (with-eval-after-load 'yasnippet - (add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets")) + (add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets/yas")) +;; @r{Tempel configuration} +(with-eval-after-load 'tempel + ;; Ensure tempel-path is a list -- it may also be a string. + (unless (listp 'tempel-path) + (setq tempel-path (list tempel-path))) + (add-to-list 'tempel-path "~/src/guix/etc/snippets/tempel/*")) @end lisp The commit message snippets depend on @url{https://magit.vc/, Magit} to diff --git a/etc/snippets/tempel/scheme-mode b/etc/snippets/tempel/scheme-mode new file mode 100644 index 0000000000..74157e098a --- /dev/null +++ b/etc/snippets/tempel/scheme-mode @@ -0,0 +1,80 @@ +-*- mode: lisp-data -*- + +scheme-mode + +(package... + "(define-public " (s name) + n> "(package" + n > "(name \"" (s name) "\")" + n > "(version \"" p "\")" + n > "(source origin...)" + n > "(build-system " (p "gnu") "-build-system)" + n > "(home-page \"" p "\")" + n > "(synopsis \"" p "\")" + n > "(description \"" p "\")" + n > "(license license:" (p "unknown") ")))" n) + +(origin... + "(origin" + n> "(method " (p "url-fetch" method) ")" + n> "(uri " (cl-case (and method (intern method)) + ('git-fetch "git-reference...") + ('svn-fetch "svn-reference...") + ('hg-fetch "hg-reference...") + ('cvs-fetch "cvs-reference...") + ('bzr-fetch "bzr-reference...") + (t "\"https://...\"")) + ")" + n> + (cl-case (and method (intern method)) + ('git-fetch + (insert "(file-name (git-file-name name version))") + (newline) + (indent-according-to-mode)) + ('hg-fetch + (insert "(file-name (hg-file-name name version))") + (newline) + (indent-according-to-mode)) + ('svn-fetch + (insert "(file-name (string-append name \"-\" version \"-checkout\"))") + (newline) + (indent-according-to-mode)) + ('cvs-fetch + (insert "(file-name (string-append name \"-\" version \"-checkout\"))") + (newline) + (indent-according-to-mode)) + ('bzr-fetch + (insert "(file-name (string-append name \"-\" version \"-checkout\"))") + (newline) + (indent-according-to-mode)) + (t "")) + > "(sha256" + n > "(base32 \"" + ;; hash of an empty directory + (p "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5") "\")))") + +(git-reference... + "(git-reference" + n> "(url \"" p "\")" + n> "(commit \"" p "\"))") + +(svn-reference... + "(svn-reference" + n> "(url \"" p "\")" + n> "(revision \"" p "\"))") + +(cvs-reference... + "(cvs-reference" + n> "(root-directory \"" p "\")" + n> "(module \"" p "\")" + n> "(revision \"" p "\"))") + +(hg-reference... + "(hg-reference" + n> "(url \"" p "\")" + n> "(changeset \"" p "\"))") + +(bzr-reference... + "(bzr-reference" + n> "(url \"" p "\")" + n> "(revision \"" p "\"))") diff --git a/etc/snippets/tempel/text-mode b/etc/snippets/tempel/text-mode new file mode 100644 index 0000000000..a1400aac69 --- /dev/null +++ b/etc/snippets/tempel/text-mode @@ -0,0 +1,101 @@ +-*- mode: lisp-data -*- + +text-mode :when (and (fboundp 'git-commit-mode) (git-commit-mode)) + +(add\ + "gnu: Add " + (p + (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (when (re-search-forward "\\+(define-public \\(\\S-+\\)" nil 'noerror) + (match-string-no-properties 1))) + var ) "." n n + "* " (car (magit-staged-files)) " (" (s var ) "): New variable.") + +(remove\ + "gnu: Remove " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (when (re-search-forward "\\-(define-public \\(\\S-+\\)" nil 'noerror) + (match-string-no-properties 1))) + var) "." n n + "* " (car (magit-staged-files)) " (" (s var) "): Delete variable.") + +(rename\ + "gnu: " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (beginning-of-buffer) + (when (search-forward "-(define-public " nil 'noerror) + (thing-at-point 'sexp 'no-properties))) + prev-var) + ": Rename package to " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (beginning-of-buffer) + (when (search-forward "+(define-public " nil 'noerror) + (thing-at-point 'sexp 'no-properties))) + new-var) "." n n + "* " (car (magit-staged-files)) " (" (s prev-var) "): Define in terms of" n + "'deprecated-package'." n + "(" (s new-var) "): New variable, formerly known as \"" (s prev-var) "\".") + +(update\ + "gnu: " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)" nil 'noerror) + (match-string-no-properties 1))) + var) + ": Update to " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (search-forward "name" nil 'noerror) + (search-forward "+" nil 'noerror) ; first change + (when (and (search-forward "version " nil 'noerror) + (looking-at-p "\"")) + (let ((end (save-excursion (search-forward "\")" nil 'noerror)))) + (when end + (forward-char) + (buffer-substring-no-properties (point) (- end 2)))))) + version) "." n n + "* " (car (magit-staged-files)) " (" (s var) "): Update to " (s version) "." + (mapconcat (lambda (file) (concat "* " file)) (cdr (magit-staged-files))) n) + +(addcl\ + "gnu: Add cl-" + (p (replace-regexp-in-string + "^cl-" "" (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (beginning-of-buffer) + (when (search-forward "+(define-public " nil 'noerror) + (replace-regexp-in-string + "^sbcl-" "" + (thing-at-point 'sexp 'no-properties))))) + var) "." n n + "* " (car (magit-staged-files)) + " (cl-" (s var) ", ecl-" (s var) ", sbcl-" (s var) "): New variables.") + +(https\ + "gnu: " + (p (with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)" nil 'noerror) + (match-string-no-properties 1))) + var) + ": Use HTTPS home page." n n + "* " (car (magit-staged-files)) " (" (s var) ")[home-page]: Use HTTPS." n + (mapconcat (lambda (file) (concat "* " file)) (cdr (magit-staged-files))) n) diff --git a/etc/snippets/scheme-mode/guix-bzr-reference b/etc/snippets/yas/scheme-mode/guix-bzr-reference similarity index 100% rename from etc/snippets/scheme-mode/guix-bzr-reference rename to etc/snippets/yas/scheme-mode/guix-bzr-reference diff --git a/etc/snippets/scheme-mode/guix-cvs-reference b/etc/snippets/yas/scheme-mode/guix-cvs-reference similarity index 100% rename from etc/snippets/scheme-mode/guix-cvs-reference rename to etc/snippets/yas/scheme-mode/guix-cvs-reference diff --git a/etc/snippets/scheme-mode/guix-git-reference b/etc/snippets/yas/scheme-mode/guix-git-reference similarity index 100% rename from etc/snippets/scheme-mode/guix-git-reference rename to etc/snippets/yas/scheme-mode/guix-git-reference diff --git a/etc/snippets/scheme-mode/guix-hg-reference b/etc/snippets/yas/scheme-mode/guix-hg-reference similarity index 100% rename from etc/snippets/scheme-mode/guix-hg-reference rename to etc/snippets/yas/scheme-mode/guix-hg-reference diff --git a/etc/snippets/scheme-mode/guix-origin b/etc/snippets/yas/scheme-mode/guix-origin similarity index 100% rename from etc/snippets/scheme-mode/guix-origin rename to etc/snippets/yas/scheme-mode/guix-origin diff --git a/etc/snippets/scheme-mode/guix-package b/etc/snippets/yas/scheme-mode/guix-package similarity index 100% rename from etc/snippets/scheme-mode/guix-package rename to etc/snippets/yas/scheme-mode/guix-package diff --git a/etc/snippets/scheme-mode/guix-svn-reference b/etc/snippets/yas/scheme-mode/guix-svn-reference similarity index 100% rename from etc/snippets/scheme-mode/guix-svn-reference rename to etc/snippets/yas/scheme-mode/guix-svn-reference diff --git a/etc/snippets/text-mode/guix-commit-message-add-cl-package b/etc/snippets/yas/text-mode/guix-commit-message-add-cl-package similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-add-cl-package rename to etc/snippets/yas/text-mode/guix-commit-message-add-cl-package diff --git a/etc/snippets/text-mode/guix-commit-message-add-package b/etc/snippets/yas/text-mode/guix-commit-message-add-package similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-add-package rename to etc/snippets/yas/text-mode/guix-commit-message-add-package diff --git a/etc/snippets/text-mode/guix-commit-message-remove-package b/etc/snippets/yas/text-mode/guix-commit-message-remove-package similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-remove-package rename to etc/snippets/yas/text-mode/guix-commit-message-remove-package diff --git a/etc/snippets/text-mode/guix-commit-message-rename-package b/etc/snippets/yas/text-mode/guix-commit-message-rename-package similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-rename-package rename to etc/snippets/yas/text-mode/guix-commit-message-rename-package diff --git a/etc/snippets/text-mode/guix-commit-message-update-package b/etc/snippets/yas/text-mode/guix-commit-message-update-package similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-update-package rename to etc/snippets/yas/text-mode/guix-commit-message-update-package diff --git a/etc/snippets/text-mode/guix-commit-message-use-https-home-page b/etc/snippets/yas/text-mode/guix-commit-message-use-https-home-page similarity index 100% rename from etc/snippets/text-mode/guix-commit-message-use-https-home-page rename to etc/snippets/yas/text-mode/guix-commit-message-use-https-home-page From 0928b82070d495a413a1df873cfc817b673cd4d1 Mon Sep 17 00:00:00 2001 From: Nicolas Graves Date: Fri, 12 Aug 2022 10:58:49 +0200 Subject: [PATCH 81/91] etc: Add tempel snippet for :phases. * etc/snippets/tempel/scheme-mode (:phases, add-before\ , add-after\ ) (replace\ ): New snippets. Signed-off-by: Liliana Marie Prikler --- etc/snippets/tempel/scheme-mode | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/etc/snippets/tempel/scheme-mode b/etc/snippets/tempel/scheme-mode index 74157e098a..54cb8e40a9 100644 --- a/etc/snippets/tempel/scheme-mode +++ b/etc/snippets/tempel/scheme-mode @@ -78,3 +78,12 @@ scheme-mode "(bzr-reference" n> "(url \"" p "\")" n> "(revision \"" p "\"))") + +(:phases\ "#:phases (modify-phases %standard-phases" + n> p ")") + +(add-before\ "(add-before '" p " '" p + n > p ")") +(add-after\ "(add-after '" p " '" p + n > p ")") +(replace\ "(replace '" p " " p")") From 47c11772dfe840a536ed7ec438fe832878f51054 Mon Sep 17 00:00:00 2001 From: Nicolas Graves Date: Fri, 12 Aug 2022 10:58:51 +0200 Subject: [PATCH 82/91] etc: Update yasnippet build system list. * etc/snippets/yas/scheme-mode/guix-package (build-system): Add chicken-build-system, minetest-build-system, rebar-build-system and renpy-build-system. Signed-off-by: Liliana Marie Prikler --- etc/snippets/yas/scheme-mode/guix-package | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/etc/snippets/yas/scheme-mode/guix-package b/etc/snippets/yas/scheme-mode/guix-package index 9ff6f997d1..724a392f81 100644 --- a/etc/snippets/yas/scheme-mode/guix-package +++ b/etc/snippets/yas/scheme-mode/guix-package @@ -11,6 +11,7 @@ "ant-build-system" "asdf-build-system" "cargo-build-system" + "chicken-build-system" "clojure-build-system" "cmake-build-system" "copy-build-system" @@ -27,6 +28,7 @@ "linux-module-build-system" "maven-build-system" "meson-build-system" + "minetest-build-system" "minify-build-system" "node-build-system" "ocaml-build-system" @@ -35,6 +37,8 @@ "qt-build-system" "r-build-system" "rakudo-build-system" + "rebar-build-system" + "renpy-build-system" "ruby-build-system" "scons-build-system" "texlive-build-system" From 466038b2e552f5550252afb1a22e3936bc455cfc Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Tue, 30 Aug 2022 16:13:23 +0300 Subject: [PATCH 83/91] gnu: vim: Update to 9.0.0325. * gnu/packages/vim.scm (vim): Update to 9.0.0325. --- gnu/packages/vim.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/vim.scm b/gnu/packages/vim.scm index a07c681cb3..f19b47c50d 100644 --- a/gnu/packages/vim.scm +++ b/gnu/packages/vim.scm @@ -77,7 +77,7 @@ (define-module (gnu packages vim) (define-public vim (package (name "vim") - (version "9.0.0235") + (version "9.0.0325") (source (origin (method git-fetch) (uri (git-reference @@ -86,7 +86,7 @@ (define-public vim (file-name (git-file-name name version)) (sha256 (base32 - "1fshlggcq1fw4cbsgmagwxkmdiwv2cla0vds383z49ayqgqnamnj")))) + "18m3lhp7d8a0n3bx0kqn082gqrh7lyar1ndvwq79gj73fz5c19vh")))) (build-system gnu-build-system) (arguments `(#:test-target "test" From 77c07d9a6149f41870684df587e1fee5dad78acd Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 29 Aug 2022 23:58:02 +0200 Subject: [PATCH 84/91] gnu: babl: Update to 0.1.96. * gnu/packages/gimp.scm (babl): Update to 0.1.96. --- gnu/packages/gimp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/gimp.scm b/gnu/packages/gimp.scm index a2a991ba4c..8de98b7eba 100644 --- a/gnu/packages/gimp.scm +++ b/gnu/packages/gimp.scm @@ -175,7 +175,7 @@ (define-public mrg (define-public babl (package (name "babl") - (version "0.1.92") + (version "0.1.96") (source (origin (method url-fetch) (uri (list (string-append "https://download.gimp.org/pub/babl/" @@ -189,7 +189,7 @@ (define-public babl "/babl-" version ".tar.xz"))) (sha256 (base32 - "1hd2i1s7fng33msxiafavk3zb4zb9jk61w8qmmsn6jwl51876rzn")))) + "1xj5hlmm834lb84rpjlfxbqnm5piswgzhjas4h8z90x9b7j3yrrk")))) (build-system meson-build-system) (arguments `(#:configure-flags From 997a51bee8bcc894a057c21f24d34a7125c2e85f Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 30 Aug 2022 14:13:32 +0200 Subject: [PATCH 85/91] gnu: mercurial: Update to 6.2.1. * gnu/packages/version-control.scm (mercurial): Update to 6.2.1. [source](patches): Add patch for compatibility with OpenSSL 3.0. [arguments]: Patch /usr/bin/env and /bin/sh unconditionally in all tests. Disable four more tests. [inputs]: Change from PYTHON to PYTHON-WRAPPER. * gnu/packages/patches/mercurial-openssl-compat.patch: New file. * gnu/local.mk (dist_patch_DATA): Adjust accordingly. --- gnu/local.mk | 3 +- .../patches/mercurial-openssl-compat.patch | 89 +++++++++++++++++++ gnu/packages/version-control.scm | 34 ++++--- 3 files changed, 115 insertions(+), 11 deletions(-) create mode 100644 gnu/packages/patches/mercurial-openssl-compat.patch diff --git a/gnu/local.mk b/gnu/local.mk index b67dfac4e7..4e872e7cb0 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1510,7 +1510,8 @@ dist_patch_DATA = \ %D%/packages/patches/libmemcached-build-with-gcc7.patch \ %D%/packages/patches/libmhash-hmac-fix-uaf.patch \ %D%/packages/patches/libsigrokdecode-python3.9-fix.patch \ - %D%/packages/patches/mercurial-hg-extension-path.patch \ + %D%/packages/patches/mercurial-hg-extension-path.patch \ + %D%/packages/patches/mercurial-openssl-compat.patch \ %D%/packages/patches/mesa-opencl-all-targets.patch \ %D%/packages/patches/mesa-skip-tests.patch \ %D%/packages/patches/meson-allow-dirs-outside-of-prefix.patch \ diff --git a/gnu/packages/patches/mercurial-openssl-compat.patch b/gnu/packages/patches/mercurial-openssl-compat.patch new file mode 100644 index 0000000000..139356f285 --- /dev/null +++ b/gnu/packages/patches/mercurial-openssl-compat.patch @@ -0,0 +1,89 @@ +Tweak cipher selection to make TLS < 1.2 work with OpenSSL 3. + +Taken from Debian: + + https://salsa.debian.org/python-team/packages/mercurial/-/blob/debian/master/debian/patches/openssl_3_cipher_tlsv1.patch + +--- a/mercurial/sslutil.py ++++ b/mercurial/sslutil.py +@@ -117,17 +117,17 @@ def _hostsettings(ui, hostname): + ciphers = ui.config(b'hostsecurity', b'%s:ciphers' % bhostname, ciphers) + + # If --insecure is used, we allow the use of TLS 1.0 despite config options. + # We always print a "connection security to %s is disabled..." message when + # --insecure is used. So no need to print anything more here. + if ui.insecureconnections: + minimumprotocol = b'tls1.0' + if not ciphers: +- ciphers = b'DEFAULT' ++ ciphers = b'DEFAULT:@SECLEVEL=0' + + s[b'minimumprotocol'] = minimumprotocol + s[b'ciphers'] = ciphers + + # Look for fingerprints in [hostsecurity] section. Value is a list + # of : strings. + fingerprints = ui.configlist( + b'hostsecurity', b'%s:fingerprints' % bhostname +@@ -621,17 +621,17 @@ def wrapserversocket( + + # Improve forward secrecy. + sslcontext.options |= getattr(ssl, 'OP_SINGLE_DH_USE', 0) + sslcontext.options |= getattr(ssl, 'OP_SINGLE_ECDH_USE', 0) + + # In tests, allow insecure ciphers + # Otherwise, use the list of more secure ciphers if found in the ssl module. + if exactprotocol: +- sslcontext.set_ciphers('DEFAULT') ++ sslcontext.set_ciphers('DEFAULT:@SECLEVEL=0') + elif util.safehasattr(ssl, b'_RESTRICTED_SERVER_CIPHERS'): + sslcontext.options |= getattr(ssl, 'OP_CIPHER_SERVER_PREFERENCE', 0) + # pytype: disable=module-attr + sslcontext.set_ciphers(ssl._RESTRICTED_SERVER_CIPHERS) + # pytype: enable=module-attr + + if requireclientcert: + sslcontext.verify_mode = ssl.CERT_REQUIRED +--- a/tests/test-https.t ++++ b/tests/test-https.t +@@ -356,19 +356,19 @@ Start servers running supported TLS vers + $ cat ../hg1.pid >> $DAEMON_PIDS + $ hg serve -p $HGPORT2 -d --pid-file=../hg2.pid --certificate=$PRIV \ + > --config devel.serverexactprotocol=tls1.2 + $ cat ../hg2.pid >> $DAEMON_PIDS + $ cd .. + + Clients talking same TLS versions work + +- $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.0 --config hostsecurity.ciphers=DEFAULT id https://localhost:$HGPORT/ ++ $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.0 --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 id https://localhost:$HGPORT/ + 5fed3813f7f5 +- $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.1 --config hostsecurity.ciphers=DEFAULT id https://localhost:$HGPORT1/ ++ $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.1 --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 id https://localhost:$HGPORT1/ + 5fed3813f7f5 + $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.2 id https://localhost:$HGPORT2/ + 5fed3813f7f5 + + Clients requiring newer TLS version than what server supports fail + + $ P="$CERTSDIR" hg id https://localhost:$HGPORT/ + (could not negotiate a common security protocol (tls1.1+) with localhost; the likely cause is Mercurial is configured to be more secure than the server can support) +@@ -400,17 +400,17 @@ Clients requiring newer TLS version than + + $ hg --config hostsecurity.minimumprotocol=tls1.2 id --insecure https://localhost:$HGPORT1/ + warning: connection security to localhost is disabled per current settings; communication is susceptible to eavesdropping and tampering + 5fed3813f7f5 + + The per-host config option overrides the default + + $ P="$CERTSDIR" hg id https://localhost:$HGPORT/ \ +- > --config hostsecurity.ciphers=DEFAULT \ ++ > --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 \ + > --config hostsecurity.minimumprotocol=tls1.2 \ + > --config hostsecurity.localhost:minimumprotocol=tls1.0 + 5fed3813f7f5 + + The per-host config option by itself works + + $ P="$CERTSDIR" hg id https://localhost:$HGPORT/ \ + > --config hostsecurity.localhost:minimumprotocol=tls1.2 diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 277ea2835b..cd84dfd0cc 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -1735,15 +1735,16 @@ (define-public pre-commit (define-public mercurial (package (name "mercurial") - (version "5.8.1") + (version "6.2.1") (source (origin (method url-fetch) (uri (string-append "https://www.mercurial-scm.org/" "release/mercurial-" version ".tar.gz")) - (patches (search-patches "mercurial-hg-extension-path.patch")) + (patches (search-patches "mercurial-hg-extension-path.patch" + "mercurial-openssl-compat.patch")) (sha256 (base32 - "16xi4bmjqzi7ig8sfa5mnypfpbbbiyafmmqrs4nxmgc743za7fl1")))) + "1nl2726szaxyrxlyssrsir5c6vb4ci0i6g969i6xaahw1nidgica")))) (build-system gnu-build-system) (arguments `(#:make-flags @@ -1753,13 +1754,11 @@ (define-public mercurial (delete 'configure) (add-after 'unpack 'patch-tests (lambda _ - (substitute* '("tests/test-extdiff.t" - "tests/test-logtoprocess.t" - "tests/test-patchbomb.t" - "tests/test-run-tests.t" - "tests/test-transplant.t") + (substitute* (find-files "tests" "\\.(t|py)$") (("/bin/sh") - (which "sh"))))) + (which "sh")) + (("/usr/bin/env") + (which "env"))))) (replace 'check (lambda* (#:key tests? #:allow-other-keys) (with-directory-excursion "tests" @@ -1770,6 +1769,12 @@ (define-public mercurial ;; PATH from before (that's why we are building it!)? "test-hghave.t" + ;; This test creates a shebang spanning multiple + ;; lines which is difficult to substitute. It + ;; only tests the test runner itself, which gets + ;; thoroughly tested during the check phase anyway. + "test-run-tests.t" + ;; These tests fail because the program is not ;; connected to a TTY in the build container. "test-nointerrupt.t" @@ -1778,6 +1783,15 @@ (define-public mercurial ;; FIXME: This gets killed but does not receive an interrupt. "test-commandserver.t" + ;; These tests get unexpected warnings about using + ;; deprecated functionality in Python, but otherwise + ;; succeed; try enabling for later Mercurial versions. + "test-demandimport.py" + "test-patchbomb-tls.t" + ;; Similarly, this gets a more informative error + ;; message from Python 3.10 than it expects. + "test-http-bad-server.t" + ;; Only works when run in a hg-repo, not in an ;; extracted tarball "test-doctest.py" @@ -1808,7 +1822,7 @@ (define-public mercurial ;; The following inputs are only needed to run the tests. python-nose unzip which)) (inputs - (list python)) + (list python-wrapper)) ;; Find third-party extensions. (native-search-paths (list (search-path-specification From 27e366292ddf435d61a6d2ecc8aa123d975899ef Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 30 Aug 2022 17:28:48 +0200 Subject: [PATCH 86/91] gnu: accountsservice: Remove obsolete input. * gnu/packages/freedesktop.scm (accountsservice)[native-inputs]: Remove INTLTOOL. Add GETTEXT-MINIMAL. --- gnu/packages/freedesktop.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index d9f48b791a..83ae11c575 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1494,10 +1494,10 @@ (define-public accountsservice (native-inputs (list docbook-xml-4.1.2 docbook-xsl + gettext-minimal `(,glib "bin") ; for gdbus-codegen, etc. gobject-introspection gtk-doc - intltool libxml2 ;for XML_CATALOG_FILES libxslt pkg-config From d2d3c8f9bf8a221cdaf61502cb96b30fa8a67358 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 30 Aug 2022 17:29:59 +0200 Subject: [PATCH 87/91] gnu: accountsservice: Don't reference the build-time coreutils. * gnu/packages/freedesktop.scm (accountsservice)[inputs]: Add COREUTILS-MINIMAL. --- gnu/packages/freedesktop.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index 83ae11c575..fed6e54cbb 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1506,7 +1506,8 @@ (define-public accountsservice vala xmlto)) (inputs - (list dbus + (list coreutils-minimal + dbus elogind shadow)) (propagated-inputs From b2696a7211000baaac7d7d4864c23946e0e6fbee Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 30 Aug 2022 17:31:21 +0200 Subject: [PATCH 88/91] gnu: accountsservice: Actually run the test suite. * gnu/packages/freedesktop.scm (accountsservice)[native-inputs]: Add PYTHON. --- gnu/packages/freedesktop.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index fed6e54cbb..d7cd2cdf40 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1501,10 +1501,13 @@ (define-public accountsservice libxml2 ;for XML_CATALOG_FILES libxslt pkg-config - python-dbusmock - python-pygobject vala - xmlto)) + xmlto + + ;; For the tests. + python + python-dbusmock + python-pygobject)) (inputs (list coreutils-minimal dbus From c19a432652f2fb544eaf918fe287aa898748d76c Mon Sep 17 00:00:00 2001 From: msimonin Date: Tue, 30 Aug 2022 11:00:19 +0200 Subject: [PATCH 89/91] gnu: Add python-grid5000. * gnu/packages/python-web.scm (python-grid5000): New variable. Signed-off-by: Marius Bakke --- gnu/packages/python-web.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm index df63602236..4234b4bcab 100644 --- a/gnu/packages/python-web.scm +++ b/gnu/packages/python-web.scm @@ -55,6 +55,7 @@ ;;; Copyright © 2022 Luis Henrique Gomes Higino ;;; Copyright © 2022 Nicolas Graves ;;; Copyright © 2022 Tomasz Jeneralczyk +;;; Copyright © 2022 msimonin ;;; ;;; This file is part of GNU Guix. ;;; @@ -7786,3 +7787,28 @@ (define-public python-whatthepatch (description "This package provides a library to parse and apply patches.") (license license:expat))) + +(define-public python-grid5000 + (package + (name "python-grid5000") + (version "1.2.3") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://gitlab.inria.fr/msimonin/python-grid5000") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + "097pm8b68ihk29xz9zv29b1x0bhgjb4lfj8zxk2grbsh7wr9dipg"))) + (build-system python-build-system) + (native-inputs (list python-wheel)) + (propagated-inputs (list python-requests python-ipython python-pyyaml)) + (arguments + (list #:tests? #f)) ; No tests. + (home-page "https://pypi.org/project/python-grid5000/") + (synopsis "Grid5000 python client") + (description + "python-grid5000 is a python package wrapping the Grid5000 REST API. +You can use it as a library in your python project or you can explore the +Grid5000 resources interactively using the embedded shell.") + (license license:gpl3+))) From 9b5b1dde32b9526cd39b51978209ba3e61b6c785 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 19 Aug 2022 09:20:06 -0400 Subject: [PATCH 90/91] services: gitolite: Relax permissions on service user home directory. Fixes https://issues.guix.gnu.org/56444 * gnu/services/version-control.scm (gitolite-activation): Modify permissions on home directory so that git group has read access. Reported-by: Evgeny Pisemsky Experienced by David Thompson for years, wondering what was wrong. Thanks for finding the root cause, Evgeny! :) --- gnu/services/version-control.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index defbd65c36..17a5f9c867 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -331,6 +331,14 @@ (define gitolite-activation (strip-store-file-name admin-pubkey)))) (rc-file #$(string-append home "/.gitolite.rc"))) + ;; activate-users+groups in (gnu build activation) sets the + ;; permission flags of home directories to #o700 and mentions that + ;; services needing looser permissions should chmod it during + ;; service activation. We also want the git group to be able to + ;; read from the gitolite home directory, so a chmod'ing we will + ;; go! + (chmod #$home #o750) + (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file) (copy-file #$rc-file rc-file) ;; ensure gitolite's user can read the configuration From db2444ad824ab529fd9e850dbae42359009ac4a2 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 30 Aug 2022 18:40:03 +0200 Subject: [PATCH 91/91] gnu: Introduce versioned 'openssl-1.1' variable. ...and use it in packages that do not yet support 3.0. * gnu/packages/tls.scm (openssl): Rename to ... (openssl-1.1): ... this. (openssl/fixed): Inherit from OPENSSL-1.1. (openssl-3.0): Likewise. (openssl): Turn into alias for OPENSSL-1.1. * gnu/packages/ruby.scm (ruby-2.6)[inputs]: Change from OPENSSL to OPENSSL-1.1. (ruby-3.0)[inputs]: Change "openssl" input to OPENSSL. (ruby-3.1): Inherit from RUBY-3.0. * gnu/packages/python.scm (python-2.7)[inputs]: Change from OPENSSL to OPENSSL-1.1. (python-3.9)[inputs]: Replace "openssl" with OPENSSL. * gnu/packages/python-crypto.scm (python-cryptography)[inputs]: Change from OPENSSL to OPENSSL-1.1. * gnu/packages/databases.scm (mariadb)[inputs]: Likewise. * gnu/packages/node.scm (node)[native-inputs, inputs]: Likewise. (node-lts)[native-inputs]: Likewise. --- gnu/packages/databases.scm | 2 +- gnu/packages/node.scm | 6 +++--- gnu/packages/python-crypto.scm | 2 +- gnu/packages/python.scm | 5 ++++- gnu/packages/ruby.scm | 9 ++++++--- gnu/packages/tls.scm | 10 ++++++---- 6 files changed, 21 insertions(+), 13 deletions(-) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index 209ad0f278..7edf0fed2d 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -1153,7 +1153,7 @@ (define-public mariadb ("libaio" ,libaio) ("libxml2" ,libxml2) ("ncurses" ,ncurses) - ("openssl" ,openssl) + ("openssl" ,openssl-1.1) ("pam" ,linux-pam) ("pcre2" ,pcre2) ("xz" ,xz) diff --git a/gnu/packages/node.scm b/gnu/packages/node.scm index 2839348554..4e9daa522d 100644 --- a/gnu/packages/node.scm +++ b/gnu/packages/node.scm @@ -290,7 +290,7 @@ (define-public node icu4c libuv `(,nghttp2 "lib") - openssl + openssl-1.1 zlib ;; Regular build-time dependencies. perl @@ -867,7 +867,7 @@ (define-public node-lts icu4c-71 libuv-for-node `(,nghttp2 "lib") - openssl + openssl-1.1 zlib ;; Regular build-time dependencies. perl @@ -884,7 +884,7 @@ (define-public node-lts llhttp-bootstrap brotli `(,nghttp2 "lib") - openssl + openssl-1.1 python-wrapper ;; for node-gyp (supports python3) zlib)))) diff --git a/gnu/packages/python-crypto.scm b/gnu/packages/python-crypto.scm index 5e78417042..dc9079cd41 100644 --- a/gnu/packages/python-crypto.scm +++ b/gnu/packages/python-crypto.scm @@ -608,7 +608,7 @@ (define-public python-cryptography (add-after 'unpack 'set-no-rust (lambda _ (setenv "CRYPTOGRAPHY_DONT_BUILD_RUST" "1")))))) - (inputs (list openssl)) + (inputs (list openssl-1.1)) (native-inputs (list python-cryptography-vectors python-hypothesis diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 23407e4e84..6b571f6d12 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -388,7 +388,7 @@ (define-public python-2.7 gdbm libffi ; for ctypes sqlite ; for sqlite extension - openssl + openssl-1.1 readline zlib tcl @@ -556,6 +556,9 @@ (define-public python-3.9 (map cdr outputs))))) (replace 'install-sitecustomize.py ,(customize-site version)))))) + (inputs + (modify-inputs (package-inputs python-2.7) + (replace "openssl" openssl))) (native-inputs `(("tzdata" ,tzdata-for-tests) ("unzip" ,unzip) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index d2c2a931a1..a2cafbf1f1 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -138,7 +138,7 @@ (define-public ruby-2.6 (("/bin/sh") (which "sh"))) #t))))) (inputs - (list readline openssl libffi gdbm)) + (list readline openssl-1.1 libffi gdbm)) (propagated-inputs (list zlib)) (native-search-paths @@ -216,11 +216,14 @@ (define-public ruby-3.0 "/ruby-" version ".tar.xz")) (sha256 (base32 - "1w7jpq3flnm007z5kj8kixgm8l4smb80w8ak4993a12j0irzq8lf")))))) + "1w7jpq3flnm007z5kj8kixgm8l4smb80w8ak4993a12j0irzq8lf")))) + (inputs + (modify-inputs (package-inputs ruby-2.7) + (replace "openssl" openssl))))) (define-public ruby-3.1 (package - (inherit ruby-2.7) + (inherit ruby-3.0) (version "3.1.2") (source (origin diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index 4ee75ace3d..7f61bd790b 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -415,7 +415,7 @@ (define (target->openssl-target target) (error "unsupported openssl target architecture"))))) (string-append kernel "-" arch)))) -(define-public openssl +(define-public openssl-1.1 (package (name "openssl") (version "1.1.1l") @@ -545,7 +545,7 @@ (define-public openssl (define openssl/fixed (package - (inherit openssl) + (inherit openssl-1.1) (name "openssl") (version "1.1.1q") (source (origin @@ -564,7 +564,7 @@ (define openssl/fixed (define-public openssl-3.0 (package - (inherit openssl) + (inherit openssl-1.1) (version "3.0.5") (source (origin (method url-fetch) @@ -580,7 +580,7 @@ (define-public openssl-3.0 (base32 "0yja085lygkdxbf4k4rckkj9r24p8dgix8avqljnbbbixydqszda")))) (arguments - (substitute-keyword-arguments (package-arguments openssl) + (substitute-keyword-arguments (package-arguments openssl-1.1) ((#:phases phases '%standard-phases) #~(modify-phases #$phases (add-before 'configure 'configure-perl @@ -590,6 +590,8 @@ (define-public openssl-3.0 "/bin/perl")))))))) (license license:asl2.0))) +(define-public openssl openssl-1.1) + (define-public bearssl (package (name "bearssl")