me/guix
Archived
1
0
Fork 0
Code Activity

Merge tracking branch 'master' into gnome-team.

Browse source
This commit is contained in:
Liliana Marie Prikler 2023-08-27 08:11:03 +02:00
commit baf5b07454
No known key found for this signature in database
GPG key ID: 442A84B8C70E2F87
90 changed files with 21109 additions and 1188 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
Makefile.am
View file

@ -7,7 +7,7 @@
# Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> # Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
# Copyright © 2017 Leo Famulari <leo@famulari.name> # Copyright © 2017 Leo Famulari <leo@famulari.name>
# Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> # Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
# Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> # Copyright © 2017, 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
# Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> # Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
# Copyright © 2018 Nikita <nikita@n0.is> # Copyright © 2018 Nikita <nikita@n0.is>
# Copyright © 2018 Julien Lepiller <julien@lepiller.eu> # Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
@ -698,8 +698,7 @@ EXTRA_DIST += \
build-aux/compile-all.scm \ build-aux/compile-all.scm \
build-aux/compile-as-derivation.scm \ build-aux/compile-as-derivation.scm \
build-aux/config.rpath \ build-aux/config.rpath \
build-aux/convert-xref.scm \ build-aux/convert-xref.scm \
build-aux/cuirass/hurd-manifest.scm \
build-aux/generate-authors.scm \ build-aux/generate-authors.scm \
build-aux/test-driver.scm \ build-aux/test-driver.scm \
build-aux/update-NEWS.scm \ build-aux/update-NEWS.scm \
@ -709,6 +708,7 @@ EXTRA_DIST += \
etc/guix-install.sh \ etc/guix-install.sh \
etc/historical-authorizations \ etc/historical-authorizations \
etc/news.scm \ etc/news.scm \
etc/hurd-manifest.scm \
etc/kernels-manifest.scm \ etc/kernels-manifest.scm \
etc/release-manifest.scm \ etc/release-manifest.scm \
etc/source-manifest.scm \ etc/source-manifest.scm \
@ -776,15 +776,30 @@ endef
# in <https://issues.guix.gnu.org/48963>. Each 'eval' call below creates a # in <https://issues.guix.gnu.org/48963>. Each 'eval' call below creates a
# 'make-*-go' phony target that builds the corresponding subset. # 'make-*-go' phony target that builds the corresponding subset.
first_half := \ first_fifth := \
gnu/packages/a% gnu/packages/b% gnu/packages/c% gnu/packages/d% \ gnu/packages/a% gnu/packages/b% gnu/packages/c%
gnu/packages/e% gnu/packages/f% gnu/packages/g% gnu/packages/h% \
gnu/packages/i% gnu/packages/j% gnu/packages/k% gnu/packages/l% second_fifth := \
gnu/packages/d% gnu/packages/e% gnu/packages/f%
third_fifth := \
gnu/packages/g% gnu/packages/h% gnu/packages/i%
fourth_fifth := \
gnu/packages/j% gnu/packages/k% gnu/packages/l% gnu/packages/m% \
gnu/packages/n% gnu/packages/o%
MODULES_CORE := guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULES))) MODULES_CORE := guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULES)))
MODULES_PACKAGES1 := $(filter $(first_half),$(MODULES)) MODULES_PACKAGES1 := $(filter $(first_fifth),$(MODULES))
MODULES_PACKAGES2 := $(filter-out $(first_half),$(filter gnu/packages/%,$(MODULES))) MODULES_PACKAGES2 := $(filter $(second_fifth),$(MODULES))
MODULES_PACKAGES := $(MODULES_PACKAGES1) $(MODULES_PACKAGES2) MODULES_PACKAGES3 := $(filter $(third_fifth),$(MODULES))
MODULES_PACKAGES4 := $(filter $(fourth_fifth),$(MODULES))
MODULES_PACKAGES5 := $(filter-out $(first_fifth) $(second_fifth) \
$(third_fifth) $(fourth_fifth), \
$(filter gnu/packages/%,$(MODULES)))
MODULES_PACKAGES := $(MODULES_PACKAGES1) $(MODULES_PACKAGES2) \
$(MODULES_PACKAGES3) $(MODULES_PACKAGES4) \
$(MODULES_PACKAGES5)
MODULES_SYSTEM := gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES))) MODULES_SYSTEM := gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES)))
MODULES_CLI := $(filter guix/scripts/%,$(MODULES)) MODULES_CLI := $(filter guix/scripts/%,$(MODULES))
MODULES_PO := guix/build/po.scm MODULES_PO := guix/build/po.scm
@ -804,7 +819,27 @@ $(eval $(call guile-compilation-rule,make-packages2-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES1)))) $(words $(MODULES_CORE) $(MODULES_PACKAGES1))))
.PHONY: make-packages2-go .PHONY: make-packages2-go
make-packages-go: make-packages1-go make-packages2-go $(eval $(call guile-compilation-rule,make-packages3-go, \
$(MODULES_PACKAGES3) make-core-go make-packages1-go make-packages2-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES1) $(MODULES_PACKAGES2))))
.PHONY: make-packages3-go
$(eval $(call guile-compilation-rule,make-packages4-go, \
$(MODULES_PACKAGES4) make-core-go make-packages1-go make-packages2-go \
make-packages3-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES1) $(MODULES_PACKAGES2) \
$(MODULES_PACKAGES3))))
.PHONY: make-packages4-go
$(eval $(call guile-compilation-rule,make-packages5-go, \
$(MODULES_PACKAGES5) make-core-go make-packages1-go make-packages2-go \
make-packages3-go make-packages4-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES1) $(MODULES_PACKAGES2) \
$(MODULES_PACKAGES3) $(MODULES_PACKAGES4))))
.PHONY: make-packages5-go
make-packages-go: make-packages1-go make-packages2-go \
make-packages3-go make-packages4-go make-packages5-go
.PHONY: make-packages-go .PHONY: make-packages-go
$(eval $(call guile-compilation-rule,make-system-go, \ $(eval $(call guile-compilation-rule,make-system-go, \

14
doc/guix-cookbook.texi
View file

@ -2019,17 +2019,23 @@ One can run:
mathieu@@cervin:~$ guix system --list-image-types mathieu@@cervin:~$ guix system --list-image-types
The available image types are: The available image types are:
- unmatched-raw
- rock64-raw
- pinebook-pro-raw - pinebook-pro-raw
- pine64-raw - pine64-raw
- novena-raw - novena-raw
- hurd-raw - hurd-raw
- hurd-qcow2 - hurd-qcow2
- qcow2 - qcow2
- uncompressed-iso9660
- efi-raw
- arm64-raw
- arm32-raw
- iso9660 - iso9660
- uncompressed-iso9660
- tarball
- efi-raw
- mbr-raw
- docker
- wsl2
- raw-with-offset
- efi32-raw
@end example @end example
and by writing an @code{operating-system} file based on and by writing an @code{operating-system} file based on

150
doc/guix.texi
View file

@ -96,7 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
Copyright @copyright{} 2021 Hui Lu@* Copyright @copyright{} 2021 Hui Lu@*
Copyright @copyright{} 2021 pukkamustard@* Copyright @copyright{} 2021 pukkamustard@*
Copyright @copyright{} 2021 Alice Brenon@* Copyright @copyright{} 2021 Alice Brenon@*
Copyright @copyright{} 2021, 2022 Josselin Poiret@* Copyright @copyright{} 2021-2023 Josselin Poiret@*
Copyright @copyright{} 2021, 2023 muradm@* Copyright @copyright{} 2021, 2023 muradm@*
Copyright @copyright{} 2021, 2022 Andrew Tropin@* Copyright @copyright{} 2021, 2022 Andrew Tropin@*
Copyright @copyright{} 2021 Sarah Morgensen@* Copyright @copyright{} 2021 Sarah Morgensen@*
@ -450,6 +450,8 @@ Home Services
* Mail: Mail Home Services. Services for managing mail. * Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging. * Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media. * Media: Media Home Services. Services for managing media.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
Platforms Platforms
@ -1405,7 +1407,7 @@ The system types the remote machine supports---e.g., @code{(list
"x86_64-linux" "i686-linux")}. "x86_64-linux" "i686-linux")}.
@item user @item user
The user account to use when connecting to the remote machine over SSH. The user account on the remote machine to use when connecting over SSH.
Note that the SSH key pair must @emph{not} be passphrase-protected, to Note that the SSH key pair must @emph{not} be passphrase-protected, to
allow non-interactive logins. allow non-interactive logins.
@ -1499,6 +1501,11 @@ archives of files from the store (@pxref{Invoking guix archive}):
# guix archive --generate-key # guix archive --generate-key
@end example @end example
@quotation Note
This key pair is not related to the SSH key pair that was previously
mentioned in the description of the @code{build-machine} data type.
@end quotation
@noindent @noindent
Each build machine must authorize the key of the master machine so that Each build machine must authorize the key of the master machine so that
it accepts store items it receives from the master: it accepts store items it receives from the master:
@ -6264,6 +6271,14 @@ building or downloading any missing package, and runs the
guix shell python python-numpy -- python3 guix shell python python-numpy -- python3
@end example @end example
Note that it is necessary to include the main @code{python} package in
this command even if it is already installed into your environment.
This is so that the shell environment knows to set @env{PYTHONPATH} and
other related variables. The shell environment cannot check the
previously installed environment, because then it would be
non-deterministic. This is true for most libraries: their corresponding
language package should be included in the shell invocation.
@quotation Note @quotation Note
@cindex shebang, for @command{guix shell} @cindex shebang, for @command{guix shell}
@command{guix shell} can be also be used as a script interpreter, also @command{guix shell} can be also be used as a script interpreter, also
@ -18042,6 +18057,10 @@ administrator's choice; reconfiguring does @emph{not} change their name.
@item @code{home-directory} @item @code{home-directory}
This is the name of the home directory for the account. This is the name of the home directory for the account.
@item @code{home-directory-permissions} (default: @code{#o700})
The permission bits for the home directory. By default, full access is
granted to the user account and all other access is denied.
@item @code{create-home-directory?} (default: @code{#t}) @item @code{create-home-directory?} (default: @code{#t})
Indicates whether the home directory of this account should be created Indicates whether the home directory of this account should be created
if it does not exist yet. if it does not exist yet.
@ -21303,6 +21322,8 @@ client.
@end table @end table
@end deftp @end deftp
@cindex Syncthing, file synchronization service
@cindex backup service, Syncthing
The @code{(gnu services syncthing)} module provides the following services: The @code{(gnu services syncthing)} module provides the following services:
@cindex syncthing @cindex syncthing
@ -21320,7 +21341,14 @@ syncthing} daemon, The value for this service type is a
(syncthing-configuration (user "alice"))) (syncthing-configuration (user "alice")))
@end lisp @end lisp
@quotation Note
This service is also available for Guix Home, where it runs directly
with your user privileges (@pxref{Networking Home Services,
@code{home-syncthing-service-type}}).
@end quotation
See below for details about @code{syncthing-configuration}. See below for details about @code{syncthing-configuration}.
@end defvar
@deftp {Data Type} syncthing-configuration @deftp {Data Type} syncthing-configuration
Data type representing the configuration for @code{syncthing-service-type}. Data type representing the configuration for @code{syncthing-service-type}.
@ -21350,7 +21378,6 @@ directory is @file{$HOME} of the specified Syncthing @code{user}.
@end table @end table
@end deftp @end deftp
@end defvar
Furthermore, @code{(gnu services ssh)} provides the following services. Furthermore, @code{(gnu services ssh)} provides the following services.
@cindex SSH @cindex SSH
@ -25084,12 +25111,11 @@ String or G-exp denoting an mcron schedule for the periodic
@command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}). @command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}).
@item @code{excluded-directories} (default @code{%default-file-database-excluded-directories}) @item @code{excluded-directories} (default @code{%default-file-database-excluded-directories})
List of directories to ignore when building the file database. By List of regular expressions of directories to ignore when building the
default, this includes @file{/tmp} and @file{/gnu/store}, which should file database. By default, this includes @file{/tmp} and @file{/gnu/store};
instead be indexed by @command{guix locate} (@pxref{Invoking guix the latter should instead be indexed by @command{guix locate} (@pxref{Invoking
locate}). This list is passed to the @option{--prunepaths} option of guix locate}). This list is passed to the @option{--prunepaths} option of
@command{updatedb} (@pxref{Invoking updatedb,,, find, @command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils}).
GNU@tie{}Findutils}).
@end table @end table
@end deftp @end deftp
@ -39082,6 +39108,12 @@ implementation of DICT server (@pxref{Dicod,,, dico, GNU Dico Manual}).
You can add @command{open localhost} to your @file{~/.dico} file to make You can add @command{open localhost} to your @file{~/.dico} file to make
@code{localhost} the default server for @command{dico} client @code{localhost} the default server for @command{dico} client
(@pxref{Initialization File,,, dico, GNU Dico Manual}). (@pxref{Initialization File,,, dico, GNU Dico Manual}).
@quotation Note
This service is also available for Guix Home, where it runs directly
with your user privileges (@pxref{Miscellaneous Home Services,
@code{home-dicod-service-type}}).
@end quotation
@end defvar @end defvar
@deftp {Data Type} dicod-configuration @deftp {Data Type} dicod-configuration
@ -40864,7 +40896,7 @@ QEMU monitor and the VM.
@cindex image, creating disk images @cindex image, creating disk images
The @code{image} command can produce various image types. The image The @code{image} command can produce various image types. The image
type can be selected using the @option{--image-type} option. It type can be selected using the @option{--image-type} option. It
defaults to @code{efi-raw}. When its value is @code{iso9660}, the defaults to @code{mbr-raw}. When its value is @code{iso9660}, the
@option{--label} option can be used to specify a volume ID with @option{--label} option can be used to specify a volume ID with
@code{image}. By default, the root file system of a disk image is @code{image}. By default, the root file system of a disk image is
mounted non-volatile; the @option{--volatile} option can be provided to mounted non-volatile; the @option{--volatile} option can be provided to
@ -40883,7 +40915,7 @@ qemu-system-x86_64 -enable-kvm -hda /tmp/my-image.qcow2 -m 1000 \
-bios $(guix build ovmf)/share/firmware/ovmf_x64.bin -bios $(guix build ovmf)/share/firmware/ovmf_x64.bin
@end example @end example
When using the @code{efi-raw} image type, a raw disk image is produced; When using the @code{mbr-raw} image type, a raw disk image is produced;
it can be copied as is to a USB stick, for instance. Assuming it can be copied as is to a USB stick, for instance. Assuming
@code{/dev/sdc} is the device corresponding to a USB stick, one can copy @code{/dev/sdc} is the device corresponding to a USB stick, one can copy
the image to it using the following command: the image to it using the following command:
@ -41021,7 +41053,7 @@ of the image.
For the @code{image} action, create an image with given @var{type}. For the @code{image} action, create an image with given @var{type}.
When this option is omitted, @command{guix system} uses the When this option is omitted, @command{guix system} uses the
@code{efi-raw} image type. @code{mbr-raw} image type.
@cindex ISO-9660 format @cindex ISO-9660 format
@cindex CD image format @cindex CD image format
@ -42972,15 +43004,17 @@ services)}.
* Mail: Mail Home Services. Services for managing mail. * Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging. * Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media. * Media: Media Home Services. Services for managing media.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu @end menu
@c In addition to that Home Services can provide @c In addition to that Home Services can provide
@node Essential Home Services @node Essential Home Services
@subsection Essential Home Services @subsection Essential Home Services
There are a few essential home services defined in There are a few essential home services defined in
@code{(gnu services)}, they are mostly for internal use and are required @code{(gnu home services)}, they are mostly for internal use and are
to build a home environment, but some of them will be useful for the end required to build a home environment, but some of them will be useful
user. for the end user.
@cindex environment variables @cindex environment variables
@ -44561,6 +44595,82 @@ kodi} for more information.
@end table @end table
@end deftp @end deftp
@node Networking Home Services
@subsection Networking Home Services
This section lists services somewhat networking-related that you may use
with Guix Home.
@cindex Syncthing, file synchronization service
@cindex backup service, Syncthing
The @code{(gnu home services syncthing)} module provides a service to
set up the @uref{Syncthing, https://syncthing.net} continuous file
backup service.
@defvar home-syncthing-service-type
This is the service type for the @command{syncthing} daemon; it is the
Home counterpart of the @code{syncthing-service-type} system service
(@pxref{Networking Services, @code{syncthing-service-type}}). The value
for this service type is a @command{syncthing-configuration}.
Here is how you would set it up with the default configuration:
@lisp
(service home-syncthing-service-type)
@end lisp
For a custom configuration, wrap you @code{syncthing-configuration} in
@code{for-home}, as in this example:
@lisp
(service home-syncthing-service-type
(for-home
(syncthing-configuration (logflags 5))))
@end lisp
For details about @code{syncthing-configuration}, check out the
documentation of the system service (@pxref{Networking Services,
@code{syncthing-service-type}}).
@end defvar
@node Miscellaneous Home Services
@subsection Miscellaneous Home Services
This section lists Home services that lack a better place.
@subsubheading Dictionary Service
@cindex dictionary service, for Home
The @code{(gnu home services dict)} module provides the following service:
@defvar home-dicod-service-type
This is the type of the service that runs the @command{dicod} daemon, an
implementation of DICT server (@pxref{Dicod,,, dico, GNU Dico Manual}).
You can add @command{open localhost} to your @file{~/.dico} file to make
@code{localhost} the default server for @command{dico} client
(@pxref{Initialization File,,, dico, GNU Dico Manual}).
@end defvar
This service is a direct mapping of the @code{dicod-service-type} system
service (@pxref{Miscellaneous Services, Dictionary Service}). You can
use it like this:
@lisp
(service home-dicod-service-type)
@end lisp
You may specify a custom configuration by providing a
@code{dicod-configuration} record, exactly like for
@code{dicod-service-type}, but wrapping it in @code{for-home}:
@lisp
(service home-dicod-service-type
(for-home
(dicod-configuration @dots{})))
@end lisp
@node Invoking guix home @node Invoking guix home
@section Invoking @command{guix home} @section Invoking @command{guix home}
@ -45095,7 +45205,7 @@ then directly boot from it, without any kind of installation procedure.
The @command{guix system image} command is able to turn an operating The @command{guix system image} command is able to turn an operating
system definition into a bootable image. This command supports system definition into a bootable image. This command supports
different image types, such as @code{efi-raw}, @code{iso9660} and different image types, such as @code{mbr-raw}, @code{iso9660} and
@code{docker}. Any modern @code{x86_64} machine will probably be able @code{docker}. Any modern @code{x86_64} machine will probably be able
to boot from an @code{iso9660} image. However, there are a few machines to boot from an @code{iso9660} image. However, there are a few machines
out there that require specific image types. Those machines, in general out there that require specific image types. Those machines, in general
@ -45447,6 +45557,10 @@ record.
There are several @code{image-type} records provided by the @code{(gnu There are several @code{image-type} records provided by the @code{(gnu
system image)} and the @code{(gnu system images @dots{})} modules. system image)} and the @code{(gnu system images @dots{})} modules.
@defvar mbr-raw-image-type
Build an image based on the @code{mbr-disk-image} image.
@end defvar
@defvar efi-raw-image-type @defvar efi-raw-image-type
Build an image based on the @code{efi-disk-image} image. Build an image based on the @code{efi-disk-image} image.
@end defvar @end defvar
@ -45456,7 +45570,7 @@ Build an image based on the @code{efi32-disk-image} image.
@end defvar @end defvar
@defvar qcow2-image-type @defvar qcow2-image-type
Build an image based on the @code{efi-disk-image} image but with the Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format. @code{compressed-qcow2} image format.
@end defvar @end defvar
@ -45527,7 +45641,7 @@ wsl -d Guix
So, if we get back to the @code{guix system image} command taking an So, if we get back to the @code{guix system image} command taking an
@code{operating-system} declaration as argument. By default, the @code{operating-system} declaration as argument. By default, the
@code{efi-raw-image-type} is used to turn the provided @code{mbr-raw-image-type} is used to turn the provided
@code{operating-system} into an actual bootable image. @code{operating-system} into an actual bootable image.
To use a different @code{image-type}, the @code{--image-type} option can To use a different @code{image-type}, the @code{--image-type} option can

4
doc/local.mk
View file

@ -229,8 +229,8 @@ $(srcdir)/%D%/guix.1: scripts/guix.in $(sub_commands_mans)
# The 'case' ensures the man pages are only generated if the corresponding # The 'case' ensures the man pages are only generated if the corresponding
# source script (the first prerequisite) has been changed. The $(GOBJECTS) # source script (the first prerequisite) has been changed. The $(GOBJECTS)
# prerequisite is solely meant to force these docs to be made only after all # prerequisite is solely meant to force these docs to be made only after all
# Guile modules have been compiled. # Guile modules have been compiled. We also need the guix script to exist.
$(srcdir)/%D%/guix-%.1: guix/scripts/%.scm $(GOBJECTS) $(srcdir)/%D%/guix-%.1: scripts/guix guix/scripts/%.scm $(GOBJECTS)
-@case '$?' in \ -@case '$?' in \
*$<*) $(AM_V_P) && set -x || echo " HELP2MAN $@"; \ *$<*) $(AM_V_P) && set -x || echo " HELP2MAN $@"; \
$(gen_man) --output="$@" "guix $*";; \ $(gen_man) --output="$@" "guix $*";; \

0
build-aux/cuirass/hurd-manifest.scm → etc/hurd-manifest.scm
View file

50
etc/teams/qt/common.scm Normal file
View file

@ -0,0 +1,50 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; This file returns a manifest of packages related to linux-libre.
;;; Simplistically, it selects packages whose names begin with "linux-libre".
;;; It is used to assist continuous integration of the kernel packages.
(use-modules (guix packages)
(guix profiles)
(guix utils)
(gnu packages))
(define* (qt-packages-manifest #:key major-version negate-version-test?)
"Return a manifest of Qt packages for MAJOR-VERSION, or any version if left
unspecified. If NEGATE-VERSION-TEST? is true, select all the Qt packages
*not* matching MAJOR-VERSION."
(manifest
(map package->manifest-entry
(fold-packages
(lambda (package lst)
(let ((uri (and=> (package-source package)
(lambda (x)
(and (origin? x)
(origin-uri x))))))
(if (and uri
(string? uri)
(string-prefix? "mirror://qt/" uri)
(if major-version
((if negate-version-test? not identity)
(string=? major-version (version-major
(package-version package))))
#t))
(cons package lst)
lst)))
'()))))

34
etc/teams/qt/qt-manifest.scm Normal file
View file

@ -0,0 +1,34 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; This file returns a manifest of packages related to linux-libre.
;;; Simplistically, it selects packages whose names begin with "linux-libre".
;;; It is used to assist continuous integration of the kernel packages.
(load "common.scm")
;;; Commentary:
;;;
;;; This manifest can be used to update the latest Qt packages collection, via
;;; e.g.:
;;;
;;; ./pre-inst-env guix refresh -u -m etc/teams/qt/qt-manifest.scm
;;;
;;; Code:
(qt-packages-manifest #:major-version "5" #:negate-version-test? #t)

34
etc/teams/qt/qt5-manifest.scm Normal file
View file

@ -0,0 +1,34 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;;; This file returns a manifest of packages related to linux-libre.
;;; Simplistically, it selects packages whose names begin with "linux-libre".
;;; It is used to assist continuous integration of the kernel packages.
(load "common.scm")
;;; Commentary:
;;;
;;; This manifest can be used to update the Qt 5 packages collection, via
;;; e.g.:
;;;
;;; ./pre-inst-env guix refresh -u -m etc/teams/qt/qt5-manifest.scm --target-version=5.15.10
;;;
;;; Code:
(qt-packages-manifest #:major-version "5")

6
gnu/build/activation.scm
View file

@ -162,14 +162,14 @@ owner-writable in HOME."
group records) are all available." group records) are all available."
(define (make-home-directory user) (define (make-home-directory user)
(let ((home (user-account-home-directory user)) (let ((home (user-account-home-directory user))
(home-permissions (user-account-home-directory-permissions user))
(pwd (getpwnam (user-account-name user)))) (pwd (getpwnam (user-account-name user))))
(mkdir-p home) (mkdir-p home)
;; Always set ownership and permissions for home directories of system ;; Always set ownership and permissions for home directories of system
;; accounts. If a service needs looser permissions on its home ;; accounts.
;; directories, it can always chmod it in an activation snippet.
(chown home (passwd:uid pwd) (passwd:gid pwd)) (chown home (passwd:uid pwd) (passwd:gid pwd))
(chmod home #o700))) (chmod home home-permissions)))
(define system-accounts (define system-accounts
(filter (lambda (user) (filter (lambda (user)

23
gnu/ci.scm
View file

@ -421,9 +421,9 @@ valid. Append SUFFIX to the job name."
(map channel-url channels))) (map channel-url channels)))
arguments)) arguments))
(define (manifests->jobs store manifests) (define (manifests->jobs store manifests systems)
"Return the list of jobs for the entries in MANIFESTS, a list of file "Return the list of jobs for the entries in MANIFESTS, a list of file
names." names, for each one of SYSTEMS."
(define (load-manifest manifest) (define (load-manifest manifest)
(save-module-excursion (save-module-excursion
(lambda () (lambda ()
@ -434,11 +434,12 @@ names."
(string-append (manifest-entry-name entry) "-" (string-append (manifest-entry-name entry) "-"
(manifest-entry-version entry))) (manifest-entry-version entry)))
(define (manifest-entry->job entry) (define (manifest-entry->job entry system)
(let* ((obj (manifest-entry-item entry)) (let* ((obj (manifest-entry-item entry))
(drv (parameterize ((%graft? #f)) (drv (parameterize ((%graft? #f))
(run-with-store store (run-with-store store
(lower-object obj)))) (lower-object obj system)
#:system system)))
(max-silent-time (or (and (package? obj) (max-silent-time (or (and (package? obj)
(assoc-ref (package-properties obj) (assoc-ref (package-properties obj)
'max-silent-time)) 'max-silent-time))
@ -450,11 +451,13 @@ names."
#:max-silent-time max-silent-time #:max-silent-time max-silent-time
#:timeout timeout))) #:timeout timeout)))
(map manifest-entry->job (let ((entries (delete-duplicates
(delete-duplicates (append-map (compose manifest-entries load-manifest)
(append-map (compose manifest-entries load-manifest) manifests)
manifests) manifest-entry=?)))
manifest-entry=?))) (append-map (lambda (system)
(map (cut manifest-entry->job <> system) entries))
systems)))
(define (arguments->systems arguments) (define (arguments->systems arguments)
"Return the systems list from ARGUMENTS." "Return the systems list from ARGUMENTS."
@ -576,7 +579,7 @@ names."
(('manifests . rest) (('manifests . rest)
;; Build packages in the list of manifests. ;; Build packages in the list of manifests.
(let ((manifests (arguments->manifests rest channels))) (let ((manifests (arguments->manifests rest channels)))
(manifests->jobs store manifests))) (manifests->jobs store manifests systems)))
(else (else
(error "unknown subset" subset)))) (error "unknown subset" subset))))
systems))) systems)))

69
gnu/home/services.scm
View file

@ -33,6 +33,7 @@
#:use-module (guix diagnostics) #:use-module (guix diagnostics)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (guix memoization)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -63,11 +64,16 @@
lookup-home-service-types lookup-home-service-types
home-provenance home-provenance
define-service-type-mapping
system->home-service-type
%initialize-gettext) %initialize-gettext)
#:re-export (service #:re-export (service
service-type service-type
service-extension)) service-extension
for-home
for-home?))
;;; Comment: ;;; Comment:
;;; ;;;
@ -513,6 +519,67 @@ directory. @command{activate} script automatically called during
reconfiguration or generation switching. This service can be extended reconfiguration or generation switching. This service can be extended
with one gexp, but many times, and all gexps must be idempotent."))) with one gexp, but many times, and all gexps must be idempotent.")))
;;;
;;; Service type graph rewriting.
;;;
(define (service-type-mapping proc)
"Return a procedure that applies PROC to map a service type graph to another
one."
(define (rewrite extension)
(match (proc (service-extension-target extension))
(#f #f)
(target
(service-extension target
(service-extension-compute extension)))))
(define replace
(mlambdaq (type)
(service-type
(inherit type)
(name (symbol-append 'home- (service-type-name type)))
(location (service-type-location type))
(extensions (filter-map rewrite (service-type-extensions type))))))
replace)
(define %system/home-service-type-mapping
;; Mapping of System to Home services.
(make-hash-table))
(define system->home-service-type
;; Map the given System service type to the corresponding Home service type.
(let ()
(define (replace type)
(define replacement
(hashq-ref %system/home-service-type-mapping type
*unspecified*))
(if (eq? replacement *unspecified*)
type
replacement))
(service-type-mapping replace)))
(define-syntax define-service-type-mapping
(syntax-rules (=>)
((_ system-type => home-type)
(hashq-set! %system/home-service-type-mapping
system-type home-type))))
(define-syntax define-service-type-mappings
(syntax-rules (=>)
((_ (system-type => home-type) ...)
(begin
(define-service-type-mapping system-type => home-type)
...))))
(define-service-type-mappings
(system-service-type => home-service-type)
(activation-service-type => home-activation-service-type)
(profile-service-type => home-profile-service-type))
;;; ;;;
;;; On-change. ;;; On-change.

32
gnu/home/services/dict.scm Normal file
View file

@ -0,0 +1,32 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home services dict)
#:use-module (gnu home services)
#:use-module (gnu services)
#:use-module (gnu services dict)
#:use-module ((gnu system shadow) #:select (account-service-type))
#:export (home-dicod-service-type)
#:re-export (dicod-configuration))
(define home-dicod-service-type
(service-type
(inherit (system->home-service-type
(remove-service-extensions dicod-service-type
(list account-service-type))))
(default-value (for-home (dicod-configuration)))))

96
gnu/home/services/mcron.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,16 +20,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home services mcron) (define-module (gnu home services mcron)
#:use-module (gnu packages guile-xyz)
#:use-module (gnu home services) #:use-module (gnu home services)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu home services shepherd) #:use-module (gnu home services shepherd)
#:use-module (guix records) #:use-module (gnu services mcron) ;for the service mapping
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (home-mcron-configuration #:export (home-mcron-configuration
home-mcron-service-type)) home-mcron-service-type))
@ -55,86 +49,16 @@
;; ;;
;;; Code: ;;; Code:
(define list-of-gexps? (define-syntax-rule (home-mcron-configuration fields ...)
(list-of gexp?)) ;; Macro provided for backward compatibility.
(for-home (mcron-configuration fields ...)))
(define-configuration/no-serialization home-mcron-configuration
(mcron (file-like mcron) "The mcron package to use.")
(jobs
(list-of-gexps '())
"This is a list of gexps (@pxref{G-Expressions}), where each gexp
corresponds to an mcron job specification (@pxref{Syntax, mcron job
specifications,, mcron, GNU@tie{}mcron}).")
(log? (boolean #t) "Log messages to standard output.")
(log-format
(string "~1@*~a ~a: ~a~%")
"@code{(ice-9 format)} format string for log messages. The default value
produces messages like \"@samp{@var{pid} @var{name}:
@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
Each message is also prefixed by a timestamp by GNU Shepherd."))
(define job-files (@@ (gnu services mcron) job-files))
(define shepherd-schedule-action
(@@ (gnu services mcron) shepherd-schedule-action))
(define (home-mcron-shepherd-services config)
(match-record config <home-mcron-configuration>
(mcron jobs log? log-format)
(if (null? jobs)
'() ;no jobs to run
(let ((files (job-files mcron jobs)))
(list (shepherd-service
(documentation "User cron jobs.")
(provision '(mcron))
(modules `((srfi srfi-1)
(srfi srfi-26)
(ice-9 popen) ;for the 'schedule' action
(ice-9 rdelim)
(ice-9 match)
,@%default-modules))
(start #~(make-forkexec-constructor
(list (string-append #$mcron "/bin/mcron")
#$@(if log?
#~("--log" "--log-format" #$log-format)
#~())
#$@files)
#:log-file (string-append
(or (getenv "XDG_STATE_HOME")
(format #f "~a/.local/state"
(getenv "HOME")))
"/log/mcron.log")))
(stop #~(make-kill-destructor))
(actions
(list (shepherd-schedule-action mcron files)))))))))
(define home-mcron-profile (compose list home-mcron-configuration-mcron))
(define (home-mcron-extend config jobs)
(home-mcron-configuration
(inherit config)
(jobs (append (home-mcron-configuration-jobs config)
jobs))))
(define home-mcron-service-type (define home-mcron-service-type
(service-type (name 'home-mcron) (service-type
(extensions (inherit (system->home-service-type mcron-service-type))
(list (service-extension (default-value (for-home (mcron-configuration)))))
home-shepherd-service-type
home-mcron-shepherd-services)
(service-extension
home-profile-service-type
home-mcron-profile)))
(compose concatenate)
(extend home-mcron-extend)
(default-value (home-mcron-configuration))
(description
"Install and configure the GNU mcron cron job manager.")))
(define-service-type-mapping
;;; mcron-service-type => home-mcron-service-type)
;;; Generate documentation.
;;;
(define (generate-doc)
(configuration->documentation 'home-mcron-configuration))
;;; mcron.scm ends here ;;; mcron.scm ends here

4
gnu/home/services/shepherd.scm
View file

@ -141,7 +141,7 @@ as shepherd package."
(define (shepherd-xdg-configuration-files config) (define (shepherd-xdg-configuration-files config)
`(("shepherd/init.scm" ,(home-shepherd-configuration-file config)))) `(("shepherd/init.scm" ,(home-shepherd-configuration-file config))))
(define-public home-shepherd-service-type (define home-shepherd-service-type
(service-type (name 'home-shepherd) (service-type (name 'home-shepherd)
(extensions (extensions
(list (service-extension (list (service-extension
@ -168,4 +168,6 @@ as shepherd package."
(default-value (home-shepherd-configuration)) (default-value (home-shepherd-configuration))
(description "Configure and install userland Shepherd."))) (description "Configure and install userland Shepherd.")))
(define-service-type-mapping
shepherd-root-service-type => home-shepherd-service-type)

8
gnu/home/services/ssh.scm
View file

@ -203,6 +203,9 @@
first)))) first))))
(memq keyword ssh-match-keywords)))) (memq keyword ssh-match-keywords))))
(define (serialize-match-criteria _ value)
(string-append "Match " value "\n"))
(define-maybe match-criteria) (define-maybe match-criteria)
(define-configuration openssh-host (define-configuration openssh-host
@ -214,7 +217,7 @@ top-level options.")
(host-name (host-name
maybe-string maybe-string
"Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.") "Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.")
(match-criteria ;TODO implement stricter match-criteria rules (match-criteria
maybe-match-criteria maybe-match-criteria
"When specified, this string denotes the set of hosts to which the entry "When specified, this string denotes the set of hosts to which the entry
applies, superseding the @code{host-name} field. Its first element must be applies, superseding the @code{host-name} field. Its first element must be
@ -288,8 +291,7 @@ through before connecting to the server.")
(G_ "define either 'name' or 'match-criteria', not both"))) (G_ "define either 'name' or 'match-criteria', not both")))
(string-append "Host " (openssh-host-name config) "\n")) (string-append "Host " (openssh-host-name config) "\n"))
(if (maybe-value-set? (openssh-host-match-criteria config)) (if (maybe-value-set? (openssh-host-match-criteria config))
(string-append (serialize-match-criteria #t (openssh-host-match-criteria config))
"Match " (string-join (openssh-host-match-criteria config) " ") "\n")
(raise (raise
(formatted-message (formatted-message
(G_ "define either 'name' or 'match-criteria' once"))))) (G_ "define either 'name' or 'match-criteria' once")))))

30
gnu/home/services/syncthing.scm Normal file
View file

@ -0,0 +1,30 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home services syncthing)
#:use-module (gnu services)
#:use-module (gnu home services)
#:use-module (gnu services syncthing)
#:export (home-syncthing-service-type)
#:re-export (syncthing-configuration
syncthing-configuration?))
(define home-syncthing-service-type
(service-type
(inherit (system->home-service-type syncthing-service-type))
(default-value (for-home (syncthing-configuration)))))

7
gnu/local.mk
View file

@ -92,6 +92,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \ %D%/home.scm \
%D%/home/services.scm \ %D%/home/services.scm \
%D%/home/services/desktop.scm \ %D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/symlink-manager.scm \ %D%/home/services/symlink-manager.scm \
%D%/home/services/fontutils.scm \ %D%/home/services/fontutils.scm \
%D%/home/services/gnupg.scm \ %D%/home/services/gnupg.scm \
@ -104,6 +105,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \ %D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \ %D%/home/services/sound.scm \
%D%/home/services/ssh.scm \ %D%/home/services/ssh.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \ %D%/home/services/mcron.scm \
%D%/home/services/utils.scm \ %D%/home/services/utils.scm \
%D%/home/services/xdg.scm \ %D%/home/services/xdg.scm \
@ -1598,7 +1600,6 @@ dist_patch_DATA = \
%D%/packages/patches/mcrypt-CVE-2012-4527.patch \ %D%/packages/patches/mcrypt-CVE-2012-4527.patch \
%D%/packages/patches/libmemcached-build-with-gcc7.patch \ %D%/packages/patches/libmemcached-build-with-gcc7.patch \
%D%/packages/patches/libmhash-hmac-fix-uaf.patch \ %D%/packages/patches/libmhash-hmac-fix-uaf.patch \
%D%/packages/patches/libsigrokdecode-python3.9-fix.patch \
%D%/packages/patches/maturin-no-cross-compile.patch \ %D%/packages/patches/maturin-no-cross-compile.patch \
%D%/packages/patches/mecab-variable-param.patch \ %D%/packages/patches/mecab-variable-param.patch \
%D%/packages/patches/memtest86+-build-reproducibly.patch \ %D%/packages/patches/memtest86+-build-reproducibly.patch \
@ -1728,11 +1729,12 @@ dist_patch_DATA = \
%D%/packages/patches/python-pypdf-annotate-tests-appropriately.patch \ %D%/packages/patches/python-pypdf-annotate-tests-appropriately.patch \
%D%/packages/patches/python-sip-include-dirs.patch \ %D%/packages/patches/python-sip-include-dirs.patch \
%D%/packages/patches/python-sgmllib3k-assertions.patch \ %D%/packages/patches/python-sgmllib3k-assertions.patch \
%D%/packages/patches/python-shiboken-2-compat.patch \
%D%/packages/patches/python-telingo-fix-comparison.patch \ %D%/packages/patches/python-telingo-fix-comparison.patch \
%D%/packages/patches/python-typeguard-python3.10.patch \ %D%/packages/patches/python-typeguard-python3.10.patch \
%D%/packages/patches/python-w3lib-fix-test-failure.patch \ %D%/packages/patches/python-w3lib-fix-test-failure.patch \
%D%/packages/patches/python-wxwidgets-type-errors.patch \ %D%/packages/patches/python-wxwidgets-type-errors.patch \
%D%/packages/patches/qtdeclarative-5-disable-qmlcache.patch \
%D%/packages/patches/qtdeclarative-disable-qmlcache.patch \
%D%/packages/patches/quodlibet-fix-invalid-glob.patch \ %D%/packages/patches/quodlibet-fix-invalid-glob.patch \
%D%/packages/patches/quodlibet-fix-mtime-tests.patch \ %D%/packages/patches/quodlibet-fix-mtime-tests.patch \
%D%/packages/patches/qxlsx-fix-include-directory.patch \ %D%/packages/patches/qxlsx-fix-include-directory.patch \
@ -1878,7 +1880,6 @@ dist_patch_DATA = \
%D%/packages/patches/quagga-reproducible-build.patch \ %D%/packages/patches/quagga-reproducible-build.patch \
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \ %D%/packages/patches/quickswitch-fix-dmenu-check.patch \
%D%/packages/patches/quilt-grep-compat.patch \ %D%/packages/patches/quilt-grep-compat.patch \
%D%/packages/patches/qtwayland-gcc-11.patch \
%D%/packages/patches/qtwayland-dont-recreate-callbacks.patch \ %D%/packages/patches/qtwayland-dont-recreate-callbacks.patch \
%D%/packages/patches/qtwayland-cleanup-callbacks.patch \ %D%/packages/patches/qtwayland-cleanup-callbacks.patch \
%D%/packages/patches/ragel-char-signedness.patch \ %D%/packages/patches/ragel-char-signedness.patch \

40
gnu/packages/admin.scm
View file

@ -60,6 +60,7 @@
;;; Copyright © 2023 Yovan Naumovski <yovan@gorski.stream> ;;; Copyright © 2023 Yovan Naumovski <yovan@gorski.stream>
;;; Copyright © 2023 Alexey Abramov <levenson@mmer.org> ;;; Copyright © 2023 Alexey Abramov <levenson@mmer.org>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;; Copyright © 2023 Tobias Kortkamp <tobias.kortkamp@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -97,7 +98,9 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages acl)
#:use-module (gnu packages algebra) #:use-module (gnu packages algebra)
#:use-module (gnu packages attr)
#:use-module (gnu packages autogen) #:use-module (gnu packages autogen)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages base) #:use-module (gnu packages base)
@ -174,6 +177,7 @@
#:use-module (gnu packages tcl) #:use-module (gnu packages tcl)
#:use-module (gnu packages terminals) #:use-module (gnu packages terminals)
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages textutils)
#:use-module (gnu packages time) #:use-module (gnu packages time)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages version-control) #:use-module (gnu packages version-control)
@ -5914,3 +5918,39 @@ Discover other RouterOS devices or @command{mactelnetd} hosts.
;; Note: applies to src/md5.{c,h} ;; Note: applies to src/md5.{c,h}
;; This file is likely to be gone in the next release. ;; This file is likely to be gone in the next release.
license:zlib)))) license:zlib))))
(define-public bfs
(package
(name "bfs")
(version "3.0.1")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/tavianator/bfs")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"1ffma9p82bl0ai4h439cnhvcyyy8x593m27xlf16gsg6knpldm58"))))
(build-system gnu-build-system)
(arguments
(list #:make-flags #~(list (string-append "CC="
#$(cc-for-target))
(string-append "PREFIX="
#$output) "bfs")
#:phases #~(modify-phases %standard-phases
(delete 'configure)
(add-before 'check 'disable-exec-no-path-test
(lambda _
;; This test unsets PATH. It then probably cannot find
;; echo since it's not inside _PATH_STDPATH (?). We
;; delete the test to disable it.
(delete-file "tests/posix/exec_nopath.sh"))))))
(inputs (list acl attr libcap oniguruma))
(synopsis "Breadth-first search for your files")
(description
"Bfs is a variant of the UNIX @command{find} command that operates
breadth-first rather than depth-first. It is otherwise compatible with many
versions of command{find}, including POSIX, GNU, and *BSD find.")
(home-page "https://tavianator.com/projects/bfs.html")
(license license:bsd-0)))

42
gnu/packages/audio.scm
View file

@ -45,6 +45,7 @@
;;; Copyright © 2023 Sharlatan Hellseher <sharlatanus@gmail.com> ;;; Copyright © 2023 Sharlatan Hellseher <sharlatanus@gmail.com>
;;; Copyright © 2023 Gabriel Wicki <gabriel@erlikon.ch> ;;; Copyright © 2023 Gabriel Wicki <gabriel@erlikon.ch>
;;; Copyright © 2023 Zheng Junjie <873216071@qq.com> ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
;;; Copyright © 2023 Parnikkapore <poomklao@yahoo.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -116,7 +117,9 @@
#:use-module (gnu packages pulseaudio) ;libsndfile, libsamplerate #:use-module (gnu packages pulseaudio) ;libsndfile, libsamplerate
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages python-build) #:use-module (gnu packages python-build)
#:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-science) #:use-module (gnu packages python-science)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz) #:use-module (gnu packages python-xyz)
#:use-module (gnu packages qt) #:use-module (gnu packages qt)
#:use-module (gnu packages rdf) #:use-module (gnu packages rdf)
@ -4691,6 +4694,45 @@ flavors EBU R128, ATSC A/85, and ReplayGain 2.0. It helps normalizing the
loudness of audio and video files to the same level.") loudness of audio and video files to the same level.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public r128gain
(package
(name "r128gain")
(version "1.0.7")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/desbma/r128gain.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0zqclskkjb9hfdw9gq6iq4bs9dl1wj9nr8v1jz6s885379q9l8i7"))))
(build-system python-build-system)
(arguments
(list
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'hardcode-ffmpeg
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "r128gain/__init__.py"
(("ffmpeg_path or \"ffmpeg\"")
(string-append "ffmpeg_path or \""
(search-input-file inputs "bin/ffmpeg")
"\""))))))))
(inputs (list python-crcmod python-ffmpeg-python python-mutagen
python-tqdm ffmpeg))
(native-inputs (list python-future python-requests))
(home-page "https://github.com/desbma/r128gain")
(synopsis "Fast audio loudness scanner & tagger")
(description
"r128gain is a multi platform command line tool to scan your audio
files and tag them with loudness metadata (ReplayGain v2 or Opus R128 gain
format), to allow playback of several tracks or albums at a similar
loudness level. r128gain can also be used as a Python module from other
Python projects to scan and/or tag audio files.")
;; 'setup.py' claims LGPL2+, 'LICENSE' is LGPLv2.1.
(license license:lgpl2.1+)))
(define-public filteraudio (define-public filteraudio
(let ((revision "1") (let ((revision "1")
(commit "2fc669581e2a0ff87fba8de85861b49133306094")) (commit "2fc669581e2a0ff87fba8de85861b49133306094"))

4
gnu/packages/base.scm
View file

@ -967,6 +967,10 @@ the store.")
;; library is empty by some criterion (such as their file ;; library is empty by some criterion (such as their file
;; size equaling eight bytes) rather than hardcoding them ;; size equaling eight bytes) rather than hardcoding them
;; by name. ;; by name.
;; XXX: We forgot librt.a for the current version! In
;; the meantime, gcc-toolchain provides it, but remove
;; that fix once librt.a is added here.
(define empty-static-libraries (define empty-static-libraries
'("libpthread.a" "libdl.a" "libutil.a" "libanl.a")) '("libpthread.a" "libdl.a" "libutil.a" "libanl.a"))
(define (empty-static-library? file) (define (empty-static-library? file)

4
gnu/packages/check.scm
View file

@ -978,7 +978,7 @@ generation.")
(define-public googlebenchmark (define-public googlebenchmark
(package (package
(name "googlebenchmark") (name "googlebenchmark")
(version "1.5.3") (version "1.8.2")
(home-page "https://github.com/google/benchmark") (home-page "https://github.com/google/benchmark")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -987,7 +987,7 @@ generation.")
(file-name (git-file-name "google-benchmark" version)) (file-name (git-file-name "google-benchmark" version))
(sha256 (sha256
(base32 (base32
"1hls0aqqj5cfldn9jfpvzjhpxkhrydrz9crp477rwllwjsybdxw7")))) "1p72bw7xcd88d8268fmmzji59408f552fbiv37jmsixml5dmq9wv"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:configure-flags (list "-DBUILD_SHARED_LIBS=ON" '(#:configure-flags (list "-DBUILD_SHARED_LIBS=ON"

12
gnu/packages/chemistry.scm
View file

@ -87,7 +87,6 @@
(native-inputs (native-inputs
(list eigen (list eigen
mmtf-cpp mmtf-cpp
msgpack
googletest googletest
pkg-config pkg-config
pybind11)) pybind11))
@ -248,7 +247,7 @@ molecules.")
(define-public mmtf-cpp (define-public mmtf-cpp
(package (package
(name "mmtf-cpp") (name "mmtf-cpp")
(version "1.0.0") (version "1.1.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -258,11 +257,13 @@ molecules.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"17ylramda69plf5w0v5hxbl4ggkdi5s15z55cv0pljl12yvyva8l")))) "0rs2f1ppgqz663c3m22p8wsq6z839bj59zy29chci46ypfhwv6ph"))))
(build-system cmake-build-system) (build-system cmake-build-system)
;; Tests require the soon-to-be-deprecated version 1 of the catch-framework. ;; Tests require the soon-to-be-deprecated version 1 of the catch-framework.
(arguments (arguments '(#:tests? #f))
'(#:tests? #f)) ;; There is no support for modern msgpack versions yet (see:
;; https://github.com/rcsb/mmtf-cpp/issues/44).
(propagated-inputs (list msgpack)) ;included by mmtf/structure_data.hpp
(home-page "https://mmtf.rcsb.org/") (home-page "https://mmtf.rcsb.org/")
(synopsis "C++ API for the Macromolecular Transmission Format") (synopsis "C++ API for the Macromolecular Transmission Format")
(description "This package is a library for the (description "This package is a library for the
@ -574,7 +575,6 @@ symmetries written in C. Spglib can be used to:
glew glew
libxml2 libxml2
mmtf-cpp mmtf-cpp
msgpack
python-pyqt python-pyqt
glm glm
netcdf)) netcdf))

7
gnu/packages/commencement.scm
View file

@ -3561,6 +3561,13 @@ COREUTILS-FINAL vs. COREUTILS, etc."
(union-build (assoc-ref %outputs "static") (union-build (assoc-ref %outputs "static")
(list (assoc-ref %build-inputs (list (assoc-ref %build-inputs
"libc-static"))) "libc-static")))
;; XXX Remove once an empty librt.a is added to
;; libc:out.
(copy-file
(string-append (assoc-ref %outputs "out")
"/lib/libpthread.a")
(string-append (assoc-ref %outputs "out")
"/lib/librt.a"))
#t)))) #t))))
(native-search-paths (native-search-paths

38
gnu/packages/disk.scm
View file

@ -530,6 +530,44 @@ which respectively make and check MS-DOS FAT file systems.")
and a @command{fsck.vfat} compatibility symlink for use in an initrd.") and a @command{fsck.vfat} compatibility symlink for use in an initrd.")
(license (package-license dosfstools)))) (license (package-license dosfstools))))
(define-public hdparm
(package
(name "hdparm")
(version "9.65")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/hdparm/hdparm/"
"hdparm-" version ".tar.gz"))
(sha256
(base32
"0jssagggg52ssl9kg99m88afghj7bm1854vyf4p96q6h23wjjjfi"))))
(build-system gnu-build-system)
(arguments
(list #:make-flags
#~(list (string-append "binprefix=" #$output)
(string-append "manprefix=" #$output)
(string-append "CC=" #$(cc-for-target))
;; Let Guix strip binaries and not break cross-compilation.
"STRIP=true")
#:phases
#~(modify-phases %standard-phases
(delete 'configure)) ; no configure script
#:tests? #f)) ; no test suite
(home-page "https://sourceforge.net/projects/hdparm/")
(synopsis "View and tune ATA disk drive parameters")
(description
"@command{hdparm} is a command-line utility to control ATA controllers and
disk drives. It can increase performance and/or reliability by careful tuning
of hardware settings like power and acoustic management, DMA modes, and caching.
It can also display detailed device information, or be used as a simple
performance benchmarking tool.
@command{hdparm} provides a command line interface to various Linux kernel
interfaces provided by the SATA/ATA/SAS @code{libata} subsystem, and the older
IDE driver subsystem. Many external USB drive enclosures with SCSI-ATA Command
Translation (@dfn{SAT}) are also supported.")
(license (license:non-copyleft "file://LICENSE.TXT"))))
(define-public sdparm (define-public sdparm
(package (package
(name "sdparm") (name "sdparm")

83
gnu/packages/electronics.scm
View file

@ -79,49 +79,48 @@ to take care of the OS-specific details when writing software that uses serial p
(license license:lgpl3+))) (license license:lgpl3+)))
(define-public libsigrokdecode (define-public libsigrokdecode
(package (let ((commit "e6962b3fe8260382bb9932a1cfdd7ee7090ce267")
(name "libsigrokdecode") (revision "0"))
(version "0.5.3") (package
(source (origin (name "libsigrokdecode")
(method url-fetch) (version (git-version "0.5.3" revision commit))
(uri (string-append (source (origin
"http://sigrok.org/download/source/libsigrokdecode/libsigrokdecode-" (method git-fetch)
version ".tar.gz")) (uri (git-reference
(sha256 (url "https://github.com/sigrokproject/libsigrokdecode")
(base32 (commit commit)))
"1h1zi1kpsgf6j2z8j8hjpv1q7n49i3fhqjn8i178rka3cym18265")) (file-name (git-file-name name version))
(patches (sha256
(search-patches "libsigrokdecode-python3.9-fix.patch")))) (base32
(outputs '("out" "doc")) "0ik93p6k8hpv8ahchjnmir8paz2w718y1j8pnmrmagjx8vvqd9y6"))))
(arguments (outputs '("out" "doc"))
`(#:phases (arguments
(modify-phases %standard-phases `(#:phases
(replace 'bootstrap (modify-phases %standard-phases
(lambda _ (add-after 'build 'build-doc
(invoke "autoconf") (lambda _
(invoke "aclocal") (invoke "doxygen")
(invoke "automake" "-ac"))) #t))
(add-after 'build 'build-doc (add-after 'install 'install-doc
(lambda _ (lambda* (#:key outputs #:allow-other-keys)
(invoke "doxygen") (copy-recursively "doxy/html-api"
#t)) (string-append (assoc-ref outputs "doc")
(add-after 'install 'install-doc "/share/doc/libsigrokdecode"))
(lambda* (#:key outputs #:allow-other-keys) #t)))))
(copy-recursively "doxy/html-api" (native-inputs
(string-append (assoc-ref outputs "doc") (list check doxygen graphviz pkg-config automake autoconf libtool))
"/share/doc/libsigrokdecode")) ;; libsigrokdecode.pc lists "python" in Requires.private, and "glib" in
#t))))) ;; Requires.
(native-inputs (propagated-inputs
(list check doxygen graphviz pkg-config automake autoconf)) (list glib python))
;; libsigrokdecode.pc lists "python" in Requires.private, and "glib" in Requires. (build-system gnu-build-system)
(propagated-inputs (home-page "https://www.sigrok.org/wiki/Libsigrokdecode")
(list glib python)) (synopsis
(build-system gnu-build-system) "Library providing (streaming) protocol decoding functionality")
(home-page "https://www.sigrok.org/wiki/Libsigrokdecode") (description
(synopsis "Library providing (streaming) protocol decoding functionality") "Libsigrokdecode is a shared library written in C, which provides
(description "Libsigrokdecode is a shared library written in C, which provides
(streaming) protocol decoding functionality.") (streaming) protocol decoding functionality.")
(license license:gpl3+))) (license license:gpl3+))))
(define-public sigrok-firmware-fx2lafw (define-public sigrok-firmware-fx2lafw
(package (package

171
gnu/packages/emacs-xyz.scm
View file

@ -11290,39 +11290,38 @@ interface.")
(license license:expat))) (license license:expat)))
(define-public emacs-orderless (define-public emacs-orderless
(let ((commit "004cee6b8e01f8eb0cb1c683d0a637b14890600f")) (package
(package (name "emacs-orderless")
(name "emacs-orderless") (version "1.0")
(version "1.0") (source
(source (origin
(origin (method git-fetch)
(method git-fetch) (uri (git-reference
(uri (git-reference (url "https://github.com/oantolin/orderless")
(url "https://github.com/oantolin/orderless") (commit version)))
(commit commit))) (sha256
(sha256 (base32 "1jmwyici90v82gqjq44n0scrwhmg05pi9yplkn4bpss80c83dxp4"))
(base32 "115bwqi2yc44bgvcl7lha8p2s6jgh5hksn4wa9s0kpfxhi14jwmy")) (file-name (git-file-name name version))))
(file-name (git-file-name name version)))) (build-system emacs-build-system)
(build-system emacs-build-system) (arguments
(arguments (list
(list #:phases
#:phases #~(modify-phases %standard-phases
#~(modify-phases %standard-phases (add-after 'install 'makeinfo
(add-after 'install 'makeinfo (lambda _
(lambda _ (invoke "makeinfo" "orderless.texi")
(invoke "makeinfo" "orderless.texi") (install-file "orderless.info"
(install-file "orderless.info" (string-append #$output "/share/info")))))))
(string-append #$output "/share/info"))))))) (native-inputs
(native-inputs (list texinfo))
(list texinfo)) (home-page "https://github.com/oantolin/orderless")
(home-page "https://github.com/oantolin/orderless") (synopsis "Emacs completion style that matches multiple regexps in any order")
(synopsis "Emacs completion style that matches multiple regexps in any order") (description "This package provides an orderless completion style that
(description "This package provides an orderless completion style that
divides the pattern into space-separated components, and matches candidates divides the pattern into space-separated components, and matches candidates
that match all of the components in any order. Each component can match in that match all of the components in any order. Each component can match in
any one of several ways: literally, as a regexp, as an initialism, in the flex any one of several ways: literally, as a regexp, as an initialism, in the flex
style, or as multiple word prefixes.") style, or as multiple word prefixes.")
(license license:gpl3+)))) (license license:gpl3+)))
(define-public emacs-consult (define-public emacs-consult
(package (package
@ -24410,31 +24409,29 @@ downloading manager for Emacs.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-helpful (define-public emacs-helpful
(let ((commit "1c98f6f06a85def5d34c735f8cd407f20cebddf9") (package
(revision "1")) (name "emacs-helpful")
(package (version "0.21")
(name "emacs-helpful") (source
(version (git-version "0.19" revision commit)) (origin
(source (method git-fetch)
(origin (uri (git-reference
(method git-fetch) (url "https://github.com/Wilfred/helpful")
(uri (git-reference (commit version)))
(url "https://github.com/Wilfred/helpful") (file-name (git-file-name name version))
(commit commit))) (sha256
(file-name (git-file-name name version)) (base32 "03afgdbs5nmhw833svrqky7fmfs1zlvqzcj7j5g29sakivs60xqc"))))
(sha256 (build-system emacs-build-system)
(base32 "18b5hjfji51zxjrxhkklxx3j9svk295awmxv8n95mp8ilas2kd3l")))) (propagated-inputs
(build-system emacs-build-system) (list emacs-dash emacs-elisp-refs emacs-f emacs-s))
(propagated-inputs (native-inputs
(list emacs-dash emacs-elisp-refs emacs-f emacs-s)) (list emacs-ert-runner emacs-undercover))
(native-inputs (arguments
(list emacs-ert-runner emacs-undercover)) `(#:tests? #t
(arguments #:test-command '("ert-runner")))
`(#:tests? #t (home-page "https://github.com/Wilfred/helpful")
#:test-command '("ert-runner"))) (synopsis "More contextual information in Emacs help")
(home-page "https://github.com/Wilfred/helpful") (description "@code{helpful} is an alternative to the built-in Emacs help
(synopsis "More contextual information in Emacs help")
(description "@code{helpful} is an alternative to the built-in Emacs help
that provides much more contextual information. that provides much more contextual information.
@itemize @itemize
@ -24453,7 +24450,7 @@ functions.
@item Trace, disassemble functions from inside Helpful. This is discoverable @item Trace, disassemble functions from inside Helpful. This is discoverable
and doesn't require memorisation of commands. and doesn't require memorisation of commands.
@end itemize\n") @end itemize\n")
(license license:gpl3+)))) (license license:gpl3+)))
(define-public emacs-logview (define-public emacs-logview
(package (package
@ -32445,6 +32442,29 @@ simple but powerful Org contents.")
on the HTML back-end.") on the HTML back-end.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-ox-html-stable-ids
(package
(name "emacs-ox-html-stable-ids")
(version "0.1.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://codeberg.org/jkreeftmeijer/ox-html-stable-ids.el")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"1slfc1hx6mgx6rb0h0hz7200dmpqr04sz8009r6cy7msp2b91hg7"))))
(build-system emacs-build-system)
(license license:gpl3)
(home-page "https://jeffkreeftmeijer.com/ox-html-stable-ids")
(synopsis "Stable IDs for ox-html.el")
(description
"Ox-html-stable-ids is an Org export extension package that generates
HTML with stable ID attributes instead of the random IDs Org's exporter uses
by default.")))
(define-public emacs-wc-mode (define-public emacs-wc-mode
(package (package
(name "emacs-wc-mode") (name "emacs-wc-mode")
@ -34171,25 +34191,28 @@ shift-reduce parser function.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-hide-mode-line (define-public emacs-hide-mode-line
(package ;; XXX: Commit below refers to the un-tagged latest release.
(name "emacs-hide-mode-line") (let ((commit "bc5d293576c5e08c29e694078b96a5ed85631942"))
(version "1.0.2") (package
(source (origin (name "emacs-hide-mode-line")
(method git-fetch) (version "1.0.3")
(uri (git-reference (source (origin
(url "https://github.com/hlissner/emacs-hide-mode-line") (method git-fetch)
(commit (string-append "v" version)))) (uri (git-reference
(file-name (git-file-name name version)) (url "https://github.com/hlissner/emacs-hide-mode-line")
(sha256 (commit commit)))
(base32 (file-name (git-file-name name version))
"0dfzjgxfkcw4wisbyldsm1km18pfp9j8xgadn6qnsz11l55bpgyp")))) (sha256
(build-system emacs-build-system) (base32
(synopsis "Emacs plugin that hides the mode-line") "12mfhg0r3gvy59ijy44vsircn251nmisp04k9vvgd2yhykpsr1j6"))))
(description "A minor mode that hides the mode-line in your current (build-system emacs-build-system)
buffer. It can be used to toggle an alternative mode-line, toggle its visibility, (home-page "https://github.com/hlissner/emacs-hide-mode-line")
or simply disable the mode-line in buffers where it is not very useful.") (synopsis "Emacs plugin that hides the mode-line")
(home-page "https://github.com/hlissner/emacs-hide-mode-line") (description
(license license:expat))) "A minor mode that hides the mode-line in your current buffer. It can be
used to toggle an alternative mode-line, toggle its visibility, or simply
disable the mode-line in buffers where it is not very useful.")
(license license:expat))))
(define-public emacs-helm-cider (define-public emacs-helm-cider
(package (package

9
gnu/packages/embedded.scm
View file

@ -1460,19 +1460,20 @@ debugging them, and more.")
(define-public ebusd (define-public ebusd
(package (package
(name "ebusd") (name "ebusd")
(version "3.4") (version "23.2")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/john30/ebusd") (url "https://github.com/john30/ebusd")
(commit (string-append "v" version)))) (commit version)))
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version "-checkout"))
(sha256 (sha256
(base32 (base32
"0iva70bam7wdx60bpd3an9kxr28zxlvp3vprivgqshwwdhqa0hzp")))) "1zqnxk6vgszlf410pypsjjliiy9wawy585fm7v25mka47i6iqafq"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:configure-flags '("--localstatedir=/var")
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'install 'install-config (add-after 'install 'install-config
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)

7
gnu/packages/engineering.scm
View file

@ -4214,7 +4214,7 @@ form, numpad.
(define-public rizin (define-public rizin
(package (package
(name "rizin") (name "rizin")
(version "0.5.2") (version "0.6.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -4222,7 +4222,7 @@ form, numpad.
version "/rizin-src-v" version ".tar.xz")) version "/rizin-src-v" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"18zca3iwdif200wiivm065fs0a5g520q6380205cijca7ky81avi")))) "14bcmjx64pgi9zj4zb7yppx69l1ykjwgf2q41s5672m7z354f1kn"))))
(build-system meson-build-system) (build-system meson-build-system)
(arguments (arguments
(list (list
@ -4250,13 +4250,10 @@ form, numpad.
(lambda _ (lambda _
;; Skip integration tests, which require prebuilt binaries at: ;; Skip integration tests, which require prebuilt binaries at:
;; <https://github.com/rizinorg/rizin-testbins>. ;; <https://github.com/rizinorg/rizin-testbins>.
;; And 2 of them are failing, reported upstream:
;; <https://github.com/rizinorg/rizin/issues/2905>.
(substitute* "test/meson.build" (substitute* "test/meson.build"
(("subdir\\('integration'\\)") "")) (("subdir\\('integration'\\)") ""))
;;; Skip failing tests. ;;; Skip failing tests.
(substitute* "test/unit/meson.build" (substitute* "test/unit/meson.build"
(("'analysis_var',\n") "")
(("'bin_mach0',\n") "") (("'bin_mach0',\n") "")
(("'hash',\n") ""))))))) (("'hash',\n") "")))))))
(native-inputs (list pkg-config)) (native-inputs (list pkg-config))

44
gnu/packages/fcitx5.scm
View file

@ -87,7 +87,7 @@ client.")
(define-public fcitx5 (define-public fcitx5
(package (package
(name "fcitx5") (name "fcitx5")
(version "5.0.23") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -95,13 +95,10 @@ client.")
"https://download.fcitx-im.org/fcitx5/fcitx5/fcitx5-" "https://download.fcitx-im.org/fcitx5/fcitx5/fcitx5-"
version "_dict.tar.xz")) version "_dict.tar.xz"))
(sha256 (sha256
(base32 "1w26v0a8qizv8flpkmg04b42kwym6ca1a1chng7j2j1xizjhiw0p")))) (base32 "1a1d3bcxddv3hsmffgf608arhamia17bq82q932sy5zl9j8s423y"))))
(build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags (list #:configure-flags #~(list "-DUSE_SYSTEMD=OFF")))
(list (string-append "-DCLDR_DIR=" (build-system cmake-build-system)
(assoc-ref %build-inputs "unicode-cldr-common")
"/share/unicode/cldr"))))
(inputs (inputs
`(("cairo" ,cairo) `(("cairo" ,cairo)
("cairo-xcb" ,cairo-xcb) ("cairo-xcb" ,cairo-xcb)
@ -115,16 +112,11 @@ client.")
("iso-codes" ,iso-codes) ("iso-codes" ,iso-codes)
("json-c" ,json-c) ("json-c" ,json-c)
("libevent" ,libevent) ("libevent" ,libevent)
("libpthread-stubs" ,libpthread-stubs)
("libuuid" ,util-linux "lib") ("libuuid" ,util-linux "lib")
("libx11" ,libx11)
("libxcb" ,libxcb) ("libxcb" ,libxcb)
("libxfixes" ,libxfixes)
("libxinerama" ,libxinerama)
("libxkbcommon" ,libxkbcommon) ("libxkbcommon" ,libxkbcommon)
("libxkbfile" ,libxkbfile) ("libxkbfile" ,libxkbfile)
("pango" ,pango) ("pango" ,pango)
("unicode-cldr-common" ,unicode-cldr-common)
("wayland" ,wayland) ("wayland" ,wayland)
("wayland-protocols" ,wayland-protocols) ("wayland-protocols" ,wayland-protocols)
("xcb-imdkit" ,xcb-imdkit) ("xcb-imdkit" ,xcb-imdkit)
@ -172,14 +164,14 @@ client.")
(define-public libime (define-public libime
(package (package
(name "libime") (name "libime")
(version "1.0.17") (version "1.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download.fcitx-im.org/fcitx5/libime/libime-" (uri (string-append "https://download.fcitx-im.org/fcitx5/libime/libime-"
version "_dict.tar.xz")) version "_dict.tar.xz"))
(sha256 (sha256
(base32 "00d191nghqkcxky5i2j5v8105ckhfh0bdjbkk8swyndjp35bn54f")))) (base32 "0jqr9riwygr3c9qzs8hx46smhgys68bf6m70fmam819903a9gpf0"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(inputs (inputs
(list fcitx5 boost)) (list fcitx5 boost))
@ -194,7 +186,7 @@ editors.")
(define-public fcitx5-gtk (define-public fcitx5-gtk
(package (package
(name "fcitx5-gtk") (name "fcitx5-gtk")
(version "5.0.23") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -202,7 +194,7 @@ editors.")
"/fcitx5-gtk/fcitx5-gtk-" "/fcitx5-gtk/fcitx5-gtk-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 "0s08j8y7bxn9hjz9xkza2fal24r9az2p7js7v86nbjmvy7klq4md")))) (base32 "0rc4iwqb7ydysm95qpncfd8kvyzk36cfxwg1h0cjn98v3fxjf8kw"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
(list (list
@ -312,7 +304,7 @@ IM module for GTK+3 applications.
(define-public fcitx5-qt (define-public fcitx5-qt
(package (package
(name "fcitx5-qt") (name "fcitx5-qt")
(version "5.0.17") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -320,7 +312,7 @@ IM module for GTK+3 applications.
"/fcitx5-qt/fcitx5-qt-" "/fcitx5-qt/fcitx5-qt-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 "1x4iks052jn6dcwd1lv1i9cpwh3l3qnnd3phryfsg4kn4yhyfs22")))) (base32 "02gnzwf0mlshmh1hw8c1866643qmdqazwjz339jq0c3ll61f8m7h"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags
@ -347,7 +339,7 @@ for Qt based application.")
(define-public fcitx5-anthy (define-public fcitx5-anthy
(package (package
(name "fcitx5-anthy") (name "fcitx5-anthy")
(version "5.0.14") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -355,7 +347,7 @@ for Qt based application.")
"/fcitx5-anthy/fcitx5-anthy-" "/fcitx5-anthy/fcitx5-anthy-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 "1dx7ajygdy244lwyv3fv14b4wdg3csppxhk8p0g2zwjfvxq4v1qa")))) (base32 "0hzk3v36ph6f2nnlqqyw08w3qakbcb71y572ff09cy5b20vb29dp"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:tests? #f)) ;; no tests `(#:tests? #f)) ;; no tests
@ -371,7 +363,7 @@ the Anthy input method.")
(define-public fcitx5-chinese-addons (define-public fcitx5-chinese-addons
(package (package
(name "fcitx5-chinese-addons") (name "fcitx5-chinese-addons")
(version "5.0.17") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -379,7 +371,7 @@ the Anthy input method.")
"/fcitx5-chinese-addons/fcitx5-chinese-addons-" "/fcitx5-chinese-addons/fcitx5-chinese-addons-"
version "_dict.tar.xz")) version "_dict.tar.xz"))
(sha256 (sha256
(base32 "0vilq49q02hrim0dg4z3rm6p3ma8v4smh0r5q5rrj6bkyf1apivx")))) (base32 "1akf4qqvck7m93i0183ffb7jfsz0rq4f3bkf89vfxlqp4i7lfw5l"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags
@ -435,7 +427,7 @@ including input methods previous bundled inside Fcitx 4:
(define-public fcitx5-configtool (define-public fcitx5-configtool
(package (package
(name "fcitx5-configtool") (name "fcitx5-configtool")
(version "5.0.17") (version "5.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -443,7 +435,7 @@ including input methods previous bundled inside Fcitx 4:
"https://download.fcitx-im.org/fcitx5" "https://download.fcitx-im.org/fcitx5"
"/fcitx5-configtool/fcitx5-configtool-" version ".tar.xz")) "/fcitx5-configtool/fcitx5-configtool-" version ".tar.xz"))
(sha256 (sha256
(base32 "1mc6axvkv2i396v7hyqllpiv5rdnf8vvqg9bkb66ljni4dnikdpq")))) (base32 "0xv5kckm6bsbavw0s2iqg128fv7j8sh49lpwc0acqrdmwj49x1pz"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags
@ -545,7 +537,7 @@ for Fcitx 5 with following color variants:
(define-public fcitx5-rime (define-public fcitx5-rime
(package (package
(name "fcitx5-rime") (name "fcitx5-rime")
(version "5.0.16") (version "5.1.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download.fcitx-im.org/fcitx5" (uri (string-append "https://download.fcitx-im.org/fcitx5"
@ -553,7 +545,7 @@ for Fcitx 5 with following color variants:
".tar.xz")) ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0d3qikdcm55p7qjfgiidx1a0zij3sv4s6j7vxxmxwyynjl5xjxjh")))) "1h6vh5pkak8l528l2d2nw5gy6zqa2sy3ris3xzkakb8kmgyjd3da"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f ;no tests '(#:tests? #f ;no tests

2
gnu/packages/file-systems.scm
View file

@ -1730,7 +1730,7 @@ Dropbox API v2.")
#~(begin (use-modules (guix build utils)) #~(begin (use-modules (guix build utils))
;; Don't check for package updates. ;; Don't check for package updates.
(substitute* "dbxfs/main.py" (substitute* "dbxfs/main.py"
(("if version") "if false")))))) (("if version") "if False"))))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
'(#:tests? #f)) ; tests requires safefs '(#:tests? #f)) ; tests requires safefs

48
gnu/packages/games.scm
View file

@ -430,7 +430,7 @@ mouse and joystick control, and original music.")
`(#:tests? #f ; no check target `(#:tests? #f ; no check target
#:make-flags #:make-flags
(list "CC=gcc" (list "CC=gcc"
"CFLAGS=-D_FILE_OFFSET_BITS=64" "CFLAGS=-D_FILE_OFFSET_BITS=64 -fcommon"
(string-append "PREFIX=" (assoc-ref %outputs "out"))) (string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
@ -713,7 +713,8 @@ canyons and wait for the long I-shaped block to clear four rows at a time.")
(list ncurses)) (list ncurses))
(arguments (arguments
`(#:tests? #f ;no tests `(#:tests? #f ;no tests
#:make-flags '("CC=gcc") #:make-flags '("CC=gcc"
"CFLAGS=-O2 -DHAVE_IPV6 -g -Wall -fcommon")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(delete 'configure) ;no configure script (delete 'configure) ;no configure script
@ -1541,7 +1542,7 @@ effects and music to make a completely free game.")
(define-public freedroidrpg (define-public freedroidrpg
(package (package
(name "freedroidrpg") (name "freedroidrpg")
(version "1.0rc2") (version "1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1552,7 +1553,7 @@ effects and music to make a completely free game.")
"freedroidRPG-" major+minor "/" "freedroidRPG-" major+minor "/"
"freedroidRPG-" version ".tar.gz"))) "freedroidRPG-" version ".tar.gz")))
(sha256 (sha256
(base32 "10jknaad2ph9j5bs4jxvpnl8rq5yjlq0nasv98f4mki2hh8yiczy")))) (base32 "1kxvyg70r9x8q40kn5lr3h1q60d6jx9mkvxls4aflj22b45vg5br"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list (list
@ -1890,7 +1891,13 @@ built-in level editor.")
version "_src.tar.gz")) version "_src.tar.gz"))
(sha256 (sha256
(base32 (base32
"18vp2ygvn0s0jz8rm585jqf6hjqkam1ximq81k0r9hpmfj7wb88f")))) "18vp2ygvn0s0jz8rm585jqf6hjqkam1ximq81k0r9hpmfj7wb88f"))
(modules '((guix build utils)))
(snippet
;; Fix a missing include for std::map.
#~(substitute* "src/shared/impl/lua_func_wrapper.cpp"
(("#include \"misc[.]hpp\"" x)
(string-append "#include <map>\n" x))))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:make-flags '(#:make-flags
@ -2011,7 +2018,7 @@ such as chess or stockfish.")
(define-public gnubg (define-public gnubg
(package (package
(name "gnubg") (name "gnubg")
(version "1.06.002") (version "1.07.001")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -2019,10 +2026,10 @@ such as chess or stockfish.")
version "-sources.tar.gz")) version "-sources.tar.gz"))
(sha256 (sha256
(base32 (base32
"11xwhcli1h12k6rnhhyq4jphzrhfik7i8ah3k32pqw803460n6yf")))) "07l2srlm05c99l4pppba8l54bnh000ns2rih5h8rzbcw84lrffbj"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (list ;; XXX: Build with an older Pango for 'pango_font_get_hb_font' and (inputs (list ;; XXX: Build with an older Pango for 'pango_font_get_hb_font' and
;; 'pango_coverage_get_type'. Try removing this for versions > 1.06.002. ;; 'pango_coverage_get_type'. Try removing this for versions > 1.07.001.
pango-1.42 pango-1.42
glib glib
readline readline
@ -2376,7 +2383,7 @@ Every puzzle has a complete solution, although there may be more than one.")
#t)))) #t))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '("--disable-cpu-opt") '(#:configure-flags '("--disable-cpu-opt" "CFLAGS=-fcommon")
#:make-flags `(,(string-append "gamesdir=" #:make-flags `(,(string-append "gamesdir="
(assoc-ref %outputs "out") "/bin")) (assoc-ref %outputs "out") "/bin"))
#:phases #:phases
@ -6508,7 +6515,7 @@ emerges from a sewer hole and pulls her below ground.")
(define-public cdogs-sdl (define-public cdogs-sdl
(package (package
(name "cdogs-sdl") (name "cdogs-sdl")
(version "1.4.0") (version "1.5.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -6517,13 +6524,21 @@ emerges from a sewer hole and pulls her below ground.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1505z8rli59i1ych4rzwbf4dvhv72icdj22n1xarb8xfyz0wyp3b")))) (base32 "1i1akay3ad2bkiqa7vfkh3qyhiqax8ikp1v6lfjysvxg65wkqdvc"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags (list
(list (string-append "-DCDOGS_DATA_DIR=" #:configure-flags
(assoc-ref %outputs "out") #~(list (string-append "-DCDOGS_DATA_DIR=" #$output
"/share/cdogs-sdl/")))) "/share/cdogs-sdl/"))
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'patch-install-directory
(lambda _
(substitute* "CMakeLists.txt"
(("set\\(DATA_INSTALL_DIR \".\"\\)")
(string-append "set(DATA_INSTALL_DIR \""
#$output "/share/cdogs-sdl\")"))))))))
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))
(inputs (inputs
@ -8242,7 +8257,8 @@ ncurses for text display.")
physfs physfs
python python
python-pyyaml python-pyyaml
(sdl-union (list sdl2 sdl2-image sdl2-mixer)) sdl2
sdl2-image
suitesparse)) suitesparse))
(home-page "https://naev.org/") (home-page "https://naev.org/")
(synopsis "Game about space exploration, trade and combat") (synopsis "Game about space exploration, trade and combat")

2
gnu/packages/geo.scm
View file

@ -2434,7 +2434,7 @@ track your position right from your laptop.")
("gdal" ,gdal) ("gdal" ,gdal)
("proj" ,proj) ("proj" ,proj)
("qtbase" ,qtbase-5) ("qtbase" ,qtbase-5)
("qtimageformats" ,qtimageformats) ("qtimageformats" ,qtimageformats-5)
("qtlocation" ,qtlocation) ("qtlocation" ,qtlocation)
("qtsensors" ,qtsensors) ("qtsensors" ,qtsensors)
("zlib" ,zlib))) ("zlib" ,zlib)))

40
gnu/packages/glib.scm
View file

@ -1238,6 +1238,46 @@ Some codes examples can be find at:
(home-page "https://dbus-cxx.github.io/") (home-page "https://dbus-cxx.github.io/")
(license license:gpl3))) (license license:gpl3)))
(define-public sdbus-c++
;; Use the latest commit, which includes unreleased fixes to the pkg-config
;; file.
(package
(name "sdbus-c++")
(version "1.3.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/Kistler-Group/sdbus-cpp")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"03maivi3nj4g5wcydk9ih703ivmqkc93yip47wlyjni6dhikzzsb"))))
(build-system cmake-build-system)
(arguments
(list
;; Avoid the integration test, which requires a system bus.
#:test-target "sdbus-c++-unit-tests"
#:configure-flags #~(list "-DBUILD_CODE_GEN=ON"
"-DBUILD_TESTS=ON"
;; Do not install tests.
"-DTESTS_INSTALL_PATH=/tmp"
"-DCMAKE_VERBOSE_MAKEFILE=ON")
#:phases #~(modify-phases %standard-phases
(add-after 'unpack 'do-not-install-tests
(lambda _
(substitute* "tests/CMakeLists.txt"
(("/etc/dbus-1/system.d") "/tmp")))))))
(native-inputs (list googletest pkg-config))
(inputs (list expat))
(propagated-inputs (list elogind)) ;required by sdbus-c++.pc
(home-page "https://github.com/Kistler-Group/sdbus-cpp")
(synopsis "High-level C++ D-Bus library")
(description "@code{sdbus-c++} is a high-level C++ D-Bus library designed
to provide easy-to-use yet powerful API in modern C++. It adds another layer
of abstraction on top of @code{sd-bus}, the C D-Bus implementation by systemd.")
(license license:lgpl2.1+)))
(define-public appstream-glib (define-public appstream-glib
(package (package
(name "appstream-glib") (name "appstream-glib")

6
gnu/packages/ibus.scm
View file

@ -349,7 +349,7 @@ Chinese pinyin input methods.")
(define-public ibus-anthy (define-public ibus-anthy
(package (package
(name "ibus-anthy") (name "ibus-anthy")
(version "1.5.14") (version "1.5.15")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -357,13 +357,13 @@ Chinese pinyin input methods.")
version "/ibus-anthy-" version ".tar.gz")) version "/ibus-anthy-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"16vd0k8wm13s38869jqs3dnwmjvywgn0snnpyi41m28binhlssf8")) "12yrgqiq6mqc8jr49dgkk3d7mdnyqic4xs597biwjjkahgaydi2q"))
(patches (search-patches "ibus-anthy-fix-tests.patch")))) (patches (search-patches "ibus-anthy-fix-tests.patch"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
(list (list
;; The test suite hangs (see: ;; The test suite hangs (see:
;; https://github.com/ibus/ibus-anthy/issues/28). ;; https://github.com/ibus/ibus-anthy/pull/35).
#:tests? #f #:tests? #f
#:configure-flags #:configure-flags
;; Use absolute exec path in the anthy.xml. ;; Use absolute exec path in the anthy.xml.

2
gnu/packages/image-viewers.scm
View file

@ -730,7 +730,7 @@ Poppler-Qt5 binding, PDF documents.")
(native-inputs (native-inputs
(list qttools-5)) (list qttools-5))
(inputs (inputs
(list qtbase-5 qtimageformats qtsvg-5)) (list qtbase-5 qtimageformats-5 qtsvg-5))
(home-page "https://interversehq.com/qview/") (home-page "https://interversehq.com/qview/")
(synopsis "Convenient and minimal image viewer") (synopsis "Convenient and minimal image viewer")
(description "qView is a Qt image viewer designed with visually (description "qView is a Qt image viewer designed with visually

4
gnu/packages/instrumentation.scm
View file

@ -341,14 +341,14 @@ many probes which instrument numerous interesting parts of Linux.")
(define-public lttng-ust (define-public lttng-ust
(package (package
(name "lttng-ust") (name "lttng-ust")
(version "2.13.4") (version "2.13.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://lttng.org/files/lttng-ust/" (uri (string-append "https://lttng.org/files/lttng-ust/"
"lttng-ust-" version ".tar.bz2")) "lttng-ust-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"165kz3zsklynkxdkcbkwhw7cccdgmgmld35h1cf9hvn5bpn853v9")))) "1mffy0fmr8h8kfghjadxa7nhzfwxjh7h1k97kslpmb3kvnb4bq77"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
(list numactl)) (list numactl))

8
gnu/packages/irc.scm
View file

@ -264,14 +264,14 @@ Conferencing} and @acronym{ICB, Internet Citizen's Band}.")
(define-public weechat (define-public weechat
(package (package
(name "weechat") (name "weechat")
(version "4.0.2") (version "4.0.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://weechat.org/files/src/weechat-" (uri (string-append "https://weechat.org/files/src/weechat-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0g026j47140h8kqyh3l0367fq9194wdx8q7f4na0kj14s3h8wr0f")))) "1xmnks152ixn0ycs0h6dzvir3vl1wkvxahg7hjdk785dnmwljpxf"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(outputs '("out" "doc")) (outputs '("out" "doc"))
(native-inputs (native-inputs
@ -484,14 +484,14 @@ highlighted.
(define-public sic (define-public sic
(package (package
(name "sic") (name "sic")
(version "1.2") (version "1.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://dl.suckless.org/tools/" (uri (string-append "http://dl.suckless.org/tools/"
name "-" version ".tar.gz")) name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"11aiavxp44yayibc58bvimi8mrxvbw1plbci8cnbl4syk42zj1xc")))) "1lk57mrrqgky37bjsnp72s8libywzsrbbjq8bpmz4xdw7smqyirh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no tests `(#:tests? #f ; no tests

4
gnu/packages/libusb.scm
View file

@ -561,14 +561,14 @@ over USB.")
(define-public libmtp (define-public libmtp
(package (package
(name "libmtp") (name "libmtp")
(version "1.1.20") (version "1.1.21")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/libmtp/libmtp/" version (uri (string-append "mirror://sourceforge/libmtp/libmtp/" version
"/libmtp-" version ".tar.gz")) "/libmtp-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1l2npk3b5v9cxhs2g01w3b13mxvin881cr085r0cyi2p5yn1s6f9")))) "19vj10la88lrhdfdcpkad7aiii01q59y5wj700dwjj4gijmsbzy4"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))

92
gnu/packages/linux.scm
View file

@ -113,6 +113,7 @@
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (gnu packages datastructures) #:use-module (gnu packages datastructures)
#:use-module (gnu packages dbm) #:use-module (gnu packages dbm)
#:use-module (gnu packages disk)
#:use-module (gnu packages docbook) #:use-module (gnu packages docbook)
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages elf) #:use-module (gnu packages elf)
@ -487,7 +488,7 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
;; The current "stable" kernels. That is, the most recently released major ;; The current "stable" kernels. That is, the most recently released major
;; versions that are still supported upstream. ;; versions that are still supported upstream.
(define-public linux-libre-6.4-version "6.4.10") (define-public linux-libre-6.4-version "6.4.11")
(define-public linux-libre-6.4-gnu-revision "gnu") (define-public linux-libre-6.4-gnu-revision "gnu")
(define deblob-scripts-6.4 (define deblob-scripts-6.4
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -497,7 +498,7 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "1rwm09anyn4py1g877f9vh6ya86y2hfvlqx51bpa53dci5k0b0ds"))) (base32 "1rwm09anyn4py1g877f9vh6ya86y2hfvlqx51bpa53dci5k0b0ds")))
(define-public linux-libre-6.4-pristine-source (define-public linux-libre-6.4-pristine-source
(let ((version linux-libre-6.4-version) (let ((version linux-libre-6.4-version)
(hash (base32 "0fgjym6y0zj7wz1byqhxmv3pc3wq412vm1dxbj4gv23pm6r3y2wq"))) (hash (base32 "0609lhgc42j9id2vvdpv8n7djabp46p2mridf9s0sg3x16snhssl")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-6.4))) deblob-scripts-6.4)))
@ -505,7 +506,7 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
;; The "longterm" kernels — the older releases with long-term upstream support. ;; The "longterm" kernels — the older releases with long-term upstream support.
;; Here are the support timelines: ;; Here are the support timelines:
;; <https://www.kernel.org/category/releases.html> ;; <https://www.kernel.org/category/releases.html>
(define-public linux-libre-6.1-version "6.1.45") (define-public linux-libre-6.1-version "6.1.46")
(define-public linux-libre-6.1-gnu-revision "gnu") (define-public linux-libre-6.1-gnu-revision "gnu")
(define deblob-scripts-6.1 (define deblob-scripts-6.1
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -515,12 +516,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "1c73516nbhnz0cxjz38b5794dxygb8sznv9idiibw7ablmjbhd11"))) (base32 "1c73516nbhnz0cxjz38b5794dxygb8sznv9idiibw7ablmjbhd11")))
(define-public linux-libre-6.1-pristine-source (define-public linux-libre-6.1-pristine-source
(let ((version linux-libre-6.1-version) (let ((version linux-libre-6.1-version)
(hash (base32 "14piy4cwv18a0yqp4gkrvr51z4zccyhab29n9ybxinkxdqwl68xx"))) (hash (base32 "15m228bllks2p8gpsmvplx08yxzp7bij9fnmnafqszylrk7ppxpm")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-6.1))) deblob-scripts-6.1)))
(define-public linux-libre-5.15-version "5.15.126") (define-public linux-libre-5.15-version "5.15.127")
(define-public linux-libre-5.15-gnu-revision "gnu") (define-public linux-libre-5.15-gnu-revision "gnu")
(define deblob-scripts-5.15 (define deblob-scripts-5.15
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -530,12 +531,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "1c3lm0j401lv2lk39dmr4mlf5ic173snm7cc0cckl6czyvxr5ysy"))) (base32 "1c3lm0j401lv2lk39dmr4mlf5ic173snm7cc0cckl6czyvxr5ysy")))
(define-public linux-libre-5.15-pristine-source (define-public linux-libre-5.15-pristine-source
(let ((version linux-libre-5.15-version) (let ((version linux-libre-5.15-version)
(hash (base32 "0vzdncrvwqxzjkpgf3gjxvl8iwz92szfyzc33cayx28ghjwsmx5d"))) (hash (base32 "09lgj9hs1cjxg84hb7avras4rlsx18igr69mx433l9hv6issbl5d")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-5.15))) deblob-scripts-5.15)))
(define-public linux-libre-5.10-version "5.10.190") (define-public linux-libre-5.10-version "5.10.191")
(define-public linux-libre-5.10-gnu-revision "gnu1") (define-public linux-libre-5.10-gnu-revision "gnu1")
(define deblob-scripts-5.10 (define deblob-scripts-5.10
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -545,12 +546,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "0nnp46mn32yk436swd2qh34igmzinfgkwvbzp3lqyy45f06hbc2j"))) (base32 "0nnp46mn32yk436swd2qh34igmzinfgkwvbzp3lqyy45f06hbc2j")))
(define-public linux-libre-5.10-pristine-source (define-public linux-libre-5.10-pristine-source
(let ((version linux-libre-5.10-version) (let ((version linux-libre-5.10-version)
(hash (base32 "15zmz9pg91gph2dhigjf1z3w6gkv1kwslki5dpzhgzs03pq3swi9"))) (hash (base32 "1hk2x5dgvfq9v6161v25wz5qpzgyvqbx34xbm7ww8z4ish76cm6b")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-5.10))) deblob-scripts-5.10)))
(define-public linux-libre-5.4-version "5.4.253") (define-public linux-libre-5.4-version "5.4.254")
(define-public linux-libre-5.4-gnu-revision "gnu1") (define-public linux-libre-5.4-gnu-revision "gnu1")
(define deblob-scripts-5.4 (define deblob-scripts-5.4
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -560,12 +561,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "0sw67b2pk3lng4y67diqqnhxaggnp3nbkx8dxc5fs27rinfxr4m1"))) (base32 "0sw67b2pk3lng4y67diqqnhxaggnp3nbkx8dxc5fs27rinfxr4m1")))
(define-public linux-libre-5.4-pristine-source (define-public linux-libre-5.4-pristine-source
(let ((version linux-libre-5.4-version) (let ((version linux-libre-5.4-version)
(hash (base32 "1rr6mnkbw6gwdm9bqjhf4z2xqr458fn2qdv5b4mgm65a15gvmchz"))) (hash (base32 "1iyrm2xql15ifhy2b939ywrrc44yd41b79sjjim4vqxmc6lqsq2i")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-5.4))) deblob-scripts-5.4)))
(define-public linux-libre-4.19-version "4.19.291") (define-public linux-libre-4.19-version "4.19.292")
(define-public linux-libre-4.19-gnu-revision "gnu1") (define-public linux-libre-4.19-gnu-revision "gnu1")
(define deblob-scripts-4.19 (define deblob-scripts-4.19
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -575,12 +576,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "1425mhkfxn18vxn05bb4h3li7x1jl7l1hf1zi8xhnqv3wa31h9wl"))) (base32 "1425mhkfxn18vxn05bb4h3li7x1jl7l1hf1zi8xhnqv3wa31h9wl")))
(define-public linux-libre-4.19-pristine-source (define-public linux-libre-4.19-pristine-source
(let ((version linux-libre-4.19-version) (let ((version linux-libre-4.19-version)
(hash (base32 "0cxmq8mrkw179jb8sqvad3dskllwn579g2lxcjn21jyqsf85nwz6"))) (hash (base32 "0dr12v4jqmzxcqdghqqjny5zp3g4dx9lxqrl9d4fxz23s79ji5rl")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-4.19))) deblob-scripts-4.19)))
(define-public linux-libre-4.14-version "4.14.322") (define-public linux-libre-4.14-version "4.14.323")
(define-public linux-libre-4.14-gnu-revision "gnu1") (define-public linux-libre-4.14-gnu-revision "gnu1")
(define deblob-scripts-4.14 (define deblob-scripts-4.14
(linux-libre-deblob-scripts (linux-libre-deblob-scripts
@ -590,7 +591,7 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(base32 "1faagsj4i31z2bp83hflx3q9vrddjnn37a3ah2b47iaplva7z1nd"))) (base32 "1faagsj4i31z2bp83hflx3q9vrddjnn37a3ah2b47iaplva7z1nd")))
(define-public linux-libre-4.14-pristine-source (define-public linux-libre-4.14-pristine-source
(let ((version linux-libre-4.14-version) (let ((version linux-libre-4.14-version)
(hash (base32 "1r71g5p0cnbi0nixv91nyhv24dqmvh49rqb2lnbhsdq81fqm8ssm"))) (hash (base32 "1g2fh0mn1sv0kq2hh3pynmx2fjai7hdwhf4fnaspl7j5n88902kg")))
(make-linux-libre-source version (make-linux-libre-source version
(%upstream-linux-source version hash) (%upstream-linux-source version hash)
deblob-scripts-4.14))) deblob-scripts-4.14)))
@ -3121,27 +3122,6 @@ early boot when entropy may be low, especially in virtualised environments.")
(license (list license:bsd-3 ; or (license (list license:bsd-3 ; or
license:gpl2+)))) license:gpl2+))))
(define-public lsscsi
(package
(name "lsscsi")
(version "0.32")
(source (origin
(method url-fetch)
(uri (string-append
"http://sg.danny.cz/scsi/lsscsi-" version ".tar.xz"))
(sha256
(base32
"0jp458m2b3wckr18qkln69i01152qlwz33zm49103lq8fgx0n6d4"))))
(build-system gnu-build-system)
(synopsis "Lists information about SCSI or NVMe devices in Linux")
(home-page "https://sg.danny.cz/scsi/lsscsi.html")
(description
"@command{lsscsi} lists SCSI logical units or SCSI targets. It can
also list NVMe namespaces or controllers and show the relationship between a
device's primary node name, its SCSI generic (sg) node name and its kernel
name.")
(license license:gpl2)))
(define-public ebtables (define-public ebtables
(package (package
(name "ebtables") (name "ebtables")
@ -5149,44 +5129,6 @@ existing Docker images. Singularity requires kernel support for container
isolation or root privileges.") isolation or root privileges.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public hdparm
(package
(name "hdparm")
(version "9.65")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/hdparm/hdparm/"
"hdparm-" version ".tar.gz"))
(sha256
(base32
"0jssagggg52ssl9kg99m88afghj7bm1854vyf4p96q6h23wjjjfi"))))
(build-system gnu-build-system)
(arguments
(list #:make-flags
#~(list (string-append "binprefix=" #$output)
(string-append "manprefix=" #$output)
(string-append "CC=" #$(cc-for-target))
;; Let Guix strip binaries and not break cross-compilation.
"STRIP=true")
#:phases
#~(modify-phases %standard-phases
(delete 'configure)) ; no configure script
#:tests? #f)) ; no test suite
(home-page "https://sourceforge.net/projects/hdparm/")
(synopsis "View and tune ATA disk drive parameters")
(description
"@command{hdparm} is a command-line utility to control ATA controllers and
disk drives. It can increase performance and/or reliability by careful tuning
of hardware settings like power and acoustic management, DMA modes, and caching.
It can also display detailed device information, or be used as a simple
performance benchmarking tool.
@command{hdparm} provides a command line interface to various Linux kernel
interfaces provided by the SATA/ATA/SAS @code{libata} subsystem, and the older
IDE driver subsystem. Many external USB drive enclosures with SCSI-ATA Command
Translation (@dfn{SAT}) are also supported.")
(license (license:non-copyleft "file://LICENSE.TXT"))))
(define-public libnvme (define-public libnvme
(package (package
(name "libnvme") (name "libnvme")
@ -10146,7 +10088,7 @@ with the value and the symbolic name.")
(define-public tp-smapi-module (define-public tp-smapi-module
(package (package
(name "tp-smapi-module") (name "tp-smapi-module")
(version "0.43") (version "0.44")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -10155,7 +10097,7 @@ with the value and the symbolic name.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1rjb0njckczc2mj05cagvj0lkyvmyk6bw7wkiinv81lw8m90g77g")))) "0kzbks07bh5jbi1n311zp9cbp1xxyzi7nys8wq1k0k5ig81h9w6k"))))
(build-system linux-module-build-system) (build-system linux-module-build-system)
(arguments (arguments
`(#:tests? #f)) ;there are none. `(#:tests? #f)) ;there are none.

22
gnu/packages/lisp-xyz.scm
View file

@ -5487,25 +5487,25 @@ client and server.")
(sbcl-package->cl-source-package sbcl-trivial-arguments)) (sbcl-package->cl-source-package sbcl-trivial-arguments))
(define-public sbcl-trivial-clipboard (define-public sbcl-trivial-clipboard
(let ((commit "13b53720306c0e6a13eccf4674d28ee5361127ae")) (let ((commit "6ddf8d5dff8f5c2102af7cd1a1751cbe6408377b")
(revision "6"))
(package (package
(name "sbcl-trivial-clipboard") (name "sbcl-trivial-clipboard")
(version (git-version "0.0.0.0" "5" commit)) (version (git-version "0.0.0" revision commit))
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/snmsts/trivial-clipboard") (url "https://github.com/snmsts/trivial-clipboard")
(commit commit))) (commit commit)))
(file-name (git-file-name "trivial-clipboard" version)) (file-name (git-file-name "cl-trivial-clipboard" version))
(sha256 (sha256
(base32 (base32 "04qmm69zyx8rs23pfhgzgxn0j108byv3b7skfdv0h01a76wlhplz"))))
"0l198m1gg2ixc43lqjq1ffd80s1sjxhqf1w83qqa1cn51rra2jp8"))))
(build-system asdf-build-system/sbcl) (build-system asdf-build-system/sbcl)
(inputs (inputs
;; Pick xsel instead of xclip because its closure size is slightly ;; Pick xsel instead of xclip because its closure size is slightly
;; smaller. ;; smaller.
(list xsel)) (list wl-clipboard xsel))
(native-inputs (native-inputs
(list sbcl-fiveam)) (list sbcl-fiveam))
(arguments (arguments
@ -5515,7 +5515,15 @@ client and server.")
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/text.lisp" (substitute* "src/text.lisp"
(("\"xsel\"") (("\"xsel\"")
(string-append "\"" (assoc-ref inputs "xsel") "/bin/xsel\"")))))))) (string-append "\"" (assoc-ref inputs "xsel") "/bin/xsel\""))
(("\"wl-copy\"")
(string-append "\""
(assoc-ref inputs "wl-clipboard")
"/bin/wl-copy\""))
(("\"wl-paste\"")
(string-append "\""
(assoc-ref inputs "wl-clipboard")
"/bin/wl-paste\""))))))))
(home-page "https://github.com/snmsts/trivial-clipboard") (home-page "https://github.com/snmsts/trivial-clipboard")
(synopsis "Access system clipboard in Common Lisp") (synopsis "Access system clipboard in Common Lisp")
(description (description

4
gnu/packages/mail.scm
View file

@ -647,7 +647,7 @@ operating systems.")
(define-public neomutt (define-public neomutt
(package (package
(name "neomutt") (name "neomutt")
(version "20220429") (version "20230517")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -656,7 +656,7 @@ operating systems.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "106m6al48m22gl8848z8d0hsg2qiaz74vgy4f37hycl4v5d3n5ic")))) (base32 "0kjllp2scgmpkl8yd0hwz6jmm98hr2r7qkb75ps9753fl96i4bfn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
(list cyrus-sasl (list cyrus-sasl

20
gnu/packages/maths.scm
View file

@ -1553,26 +1553,6 @@ extremely large and complex data collections.")
(base32 "14gih7kmjx4h3lc7pg4fwcl28hf1qqkf2x7rljpxqvzkjrqbxi00")) (base32 "14gih7kmjx4h3lc7pg4fwcl28hf1qqkf2x7rljpxqvzkjrqbxi00"))
(patches (search-patches "hdf5-config-date.patch")))))) (patches (search-patches "hdf5-config-date.patch"))))))
(define-public hdf5-1.12
(package
(inherit hdf5-1.8)
(version "1.12.2")
(source
(origin
(method url-fetch)
(uri (list (string-append "https://support.hdfgroup.org/ftp/HDF5/releases/"
"hdf5-" (version-major+minor version)
"/hdf5-" version "/src/hdf5-"
version ".tar.bz2")
(string-append "https://support.hdfgroup.org/ftp/HDF5/"
"current"
(apply string-append
(take (string-split version #\.) 2))
"/src/hdf5-" version ".tar.bz2")))
(sha256
(base32 "1zlawdzb0gsvcxif14fwr5ap2gk4b6j02wirr2hcx8hkcbivp20s"))
(patches (search-patches "hdf5-config-date.patch"))))))
(define-public hdf5-1.14 (define-public hdf5-1.14
(package (package
(inherit hdf5-1.8) (inherit hdf5-1.8)

4
gnu/packages/mpd.scm
View file

@ -615,7 +615,7 @@ mpdevil loads all tags and covers on demand.")
(define-public mympd (define-public mympd
(package (package
(name "mympd") (name "mympd")
(version "11.0.2") (version "11.0.4")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -624,7 +624,7 @@ mpdevil loads all tags and covers on demand.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0n6dyy6znzicm5v9mkcghm3lwi6zwysnpr0drvacqprr0r5l596a")))) "0ki9az71x35548mnl5assb0hgli3bvrbzv0fb5dfli4q5i1z8fmq"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
(list (list

14
gnu/packages/music.scm
View file

@ -3780,15 +3780,15 @@ event-based scripts for scrobbling, notifications, etc.")
(define-public picard (define-public picard
(package (package
(name "picard") (name "picard")
(version "2.9") (version "2.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"https://musicbrainz.osuosl.org/pub/musicbrainz/" "https://data.musicbrainz.org/pub/musicbrainz/"
"picard/picard-" version ".tar.gz")) "picard/picard-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0afiziaq49sq1dx5r3qis4ymhhkrqlrkfnb6f7gcksj0kwljvsw9")))) "1f1nf53xm94jam8w86a8hx69ilzddjibf29c7f1i353fr6k6bqvs"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
(list (list
@ -3806,12 +3806,10 @@ event-based scripts for scrobbling, notifications, etc.")
(string-append (string-append
"pyfpcalc', '" "pyfpcalc', '"
(assoc-ref inputs "chromaprint") "/bin/fpcalc"))))) (assoc-ref inputs "chromaprint") "/bin/fpcalc")))))
(add-before 'check 'delete-failing-test ;; pipe tests require writable $HOME.
(add-before 'check 'set-HOME
(lambda _ (lambda _
;; FIXME: This test fails in build environment. (setenv "HOME" "/tmp"))))))
;; util/pipe.read_from_pipe:244: pipe reader exception:
;; ERROR: Pipe doesn't exist
(delete-file "test/test_util_pipe.py"))))))
(native-inputs (native-inputs
(list gettext-minimal python-dateutil)) (list gettext-minimal python-dateutil))
(inputs (inputs

15
gnu/packages/networking.scm
View file

@ -4502,7 +4502,7 @@ on hub/switched networks. It is based on @acronym{ARP} packets, it will send
(define-public phantomsocks (define-public phantomsocks
(package (package
(name "phantomsocks") (name "phantomsocks")
(version "0.0.0-20230405135900-a54ae9f3611e") (version "0.0.0-20230811053544-53b995bdab83")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -4511,7 +4511,7 @@ on hub/switched networks. It is based on @acronym{ARP} packets, it will send
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1qgv8dcrsyzjzppvdk0n5kkyaypcjm1hcn9lb29ahvbhm70cpm6a")))) "1jc9qldi4f9s6n4ggaphyilxjymrz95hwd060jhj260x2hkdywl9"))))
(build-system go-build-system) (build-system go-build-system)
(arguments (arguments
(list #:install-source? #f (list #:install-source? #f
@ -4519,13 +4519,12 @@ on hub/switched networks. It is based on @acronym{ARP} packets, it will send
#:build-flags #~'("-tags" #$(if (target-linux?) #:build-flags #~'("-tags" #$(if (target-linux?)
"rawsocket" "rawsocket"
"pcap")))) "pcap"))))
(propagated-inputs
(list go-github-com-google-gopacket
go-github-com-macronut-go-tproxy))
(inputs (inputs
(if (target-linux?) (append (if (target-linux?)
'() '()
(list libpcap))) (list libpcap))
(list go-github-com-google-gopacket
go-github-com-macronut-go-tproxy)))
(home-page "https://github.com/macronut/phantomsocks") (home-page "https://github.com/macronut/phantomsocks")
(synopsis "Internet censorship circumvention tool") (synopsis "Internet censorship circumvention tool")
(description (description

52
gnu/packages/package-management.scm
View file

@ -174,8 +174,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to ;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this. ;; start precisely like this.
(let ((version "1.4.0") (let ((version "1.4.0")
(commit "44bbfc24e4bcc48d0e3343cd3d83452721af8c36") (commit "4dfdd822102690b5687acf28365ab707b68d9476")
(revision 7)) (revision 10))
(package (package
(name "guix") (name "guix")
@ -191,7 +191,7 @@
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"08gq04pphapr3i0gzdilp8l87rpxlh2p768qrn1fw92fmw727xf7")) "1p21gz2lr7iqvma1m83k2r04w201rzvk31d5kfn2qkr9l0gds4cx"))
(file-name (string-append "guix-" version "-checkout")))) (file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
@ -263,6 +263,46 @@ $(prefix)/etc/openrc\n")))
(substitute* "tests/gexp.scm" (substitute* "tests/gexp.scm"
(("2\\.0") "3.0"))))) (("2\\.0") "3.0")))))
'()) '())
,@(if (system-hurd?)
`((add-after 'unpack 'disable-tests/hurd
(lambda _
(substitute* "Makefile.am"
(("tests/derivations.scm") "")
(("tests/grafts.scm") "")
(("tests/graph.scm") "")
(("tests/lint.scm") "")
(("tests/nar.scm") "")
(("tests/offload.scm") "")
(("tests/pack.scm") "")
(("tests/packages.scm") "")
(("tests/processes.scm") "")
(("tests/publish.scm") "")
(("tests/pypi.scm") "")
(("tests/size.scm") "")
(("tests/store.scm") "")
(("tests/substitute.scm") "")
(("tests/syscalls.scm") "")
(("tests/union.scm") "")
(("tests/guix-build.sh") "")
(("tests/guix-build-branch.sh") "")
(("tests/guix-hash.sh") "")
(("tests/guix-locate.sh") "")
(("tests/guix-pack.sh") "")
(("tests/guix-pack-relocatable.sh") "")
(("tests/guix-package-aliases.sh") "")
(("tests/guix-package-net.sh") "")
(("tests/guix-home.sh") "")
(("tests/guix-archive.sh") "")
(("tests/guix-environment.sh") "")
(("tests/guix-package.sh") "")
(("tests/guix-refresh.sh") "")
(("tests/guix-shell.sh") "")
(("tests/guix-shell-export-manifest.sh") "")
(("tests/guix-system.sh") "")
(("tests/guix-graph.sh") "")
(("tests/guix-gc.sh") "")
(("tests/guix-daemon.sh") "")))))
'())
(add-before 'build 'use-host-compressors (add-before 'build 'use-host-compressors
(lambda* (#:key inputs target #:allow-other-keys) (lambda* (#:key inputs target #:allow-other-keys)
(when target (when target
@ -1410,8 +1450,8 @@ environments.")
"0k9zkdyyzir3fvlbcfcqy17k28b51i20rpbjwlx2i1mwd2pw9cxc"))))))) "0k9zkdyyzir3fvlbcfcqy17k28b51i20rpbjwlx2i1mwd2pw9cxc")))))))
(define-public guix-build-coordinator (define-public guix-build-coordinator
(let ((commit "f39f16000469429745bd8aff3cd4d59b7c489fa1") (let ((commit "06a44693c4f25109f945e5aa6c7c4670df72b690")
(revision "86")) (revision "87"))
(package (package
(name "guix-build-coordinator") (name "guix-build-coordinator")
(version (git-version "0" revision commit)) (version (git-version "0" revision commit))
@ -1422,7 +1462,7 @@ environments.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"1lmbwbza87xzbvmzw44sgpscmqjfl5kpgfl79n7hzwa1icqqb7mg")) "1g9dq7nzndrws82dajxapajhd2c7zmk7kmi7fbga9qd414pwfv92"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

16
gnu/packages/patches/ibus-anthy-fix-tests.patch
View file

@ -1,17 +1,14 @@
Submitted upstream: https://github.com/ibus/ibus-anthy/pull/35 Submitted upstream: https://github.com/ibus/ibus-anthy/pull/35
diff --git a/tests/test-build.sh b/tests/test-build.sh diff --git a/tests/test-build.sh b/tests/test-build.sh
index e83b78f..a0efe32 100755 index e83b78f..bbfa7e1 100755
--- a/tests/test-build.sh --- a/tests/test-build.sh
+++ b/tests/test-build.sh +++ b/tests/test-build.sh
@@ -63,26 +63,27 @@ parse_args() @@ -63,26 +63,33 @@ parse_args()
done; done;
} }
+maybe_install_pycotap() { +maybe_install_pycotap() {
+ # Check if pycotap is already available.
+ python3 -m pycotap >/dev/null && return 0
+
+ # Red Hat specific hint. + # Red Hat specific hint.
+ if test -f /etc/redhat-release ; then + if test -f /etc/redhat-release ; then
+ if ! rpm -q --quiet python3-pycotap; then + if ! rpm -q --quiet python3-pycotap; then
@ -19,6 +16,15 @@ index e83b78f..a0efe32 100755
+ exit -1 + exit -1
+ fi + fi
+ fi; + fi;
+
+ # Check if pycotap is already available.
+ if ! python3 -m pycotap >/dev/null; then
+ echo "pycotap not found; installing via pip"
+ if ! pip install pycotap --user; then
+ echo "failed to install pycotap"
+ exit -1
+ fi
+ fi
+} +}
+ +
init_environment() init_environment()

19
gnu/packages/patches/libsigrokdecode-python3.9-fix.patch
View file

@ -1,19 +0,0 @@
From: Dan Horák <dan@danny.cz>
Subject: Add support for Python 3.9
Origin: upstream, https://sigrok.org/gitweb/?p=libsigrokdecode.git;a=commitdiff;h=9b0ad5177bd692f7556a4756bdbd2da81d9c34ce
Bug-Debian: https://bugs.debian.org/972769
diff --git a/configure.ac b/configure.ac
index f9958b3..2917cb3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -100,7 +100,7 @@ SR_PKG_CHECK_SUMMARY([srd_pkglibs_summary])
# first, since usually only that variant will add "-lpython3.8".
# https://docs.python.org/3/whatsnew/3.8.html#debug-build-uses-the-same-abi-as-release-build
SR_PKG_CHECK([python3], [SRD_PKGLIBS],
- [python-3.8-embed], [python-3.8 >= 3.8], [python-3.7 >= 3.7], [python-3.6 >= 3.6], [python-3.5 >= 3.5], [python-3.4 >= 3.4], [python-3.3 >= 3.3], [python-3.2 >= 3.2], [python3 >= 3.2])
+ [python-3.9-embed], [python-3.8-embed], [python-3.8 >= 3.8], [python-3.7 >= 3.7], [python-3.6 >= 3.6], [python-3.5 >= 3.5], [python-3.4 >= 3.4], [python-3.3 >= 3.3], [python-3.2 >= 3.2], [python3 >= 3.2])
AS_IF([test "x$sr_have_python3" = xno],
[AC_MSG_ERROR([Cannot find Python 3 development headers.])])

15
gnu/packages/patches/python-shiboken-2-compat.patch
View file

@ -1,15 +0,0 @@
Backport a fix from 5.15.9, mentioned in [1].
[1] https://bugreports.qt.io/browse/PYSIDE-2176
--- pyside-setup-opensource-src-5.15.8/sources/shiboken2/libshiboken/pep384impl.cpp 2023-04-24 11:05:48.770934499 +0200
+++ pyside-setup-opensource-src-5.15.8/sources/shiboken2/libshiboken/pep384impl.cpp 2023-04-24 11:04:51.566943936 +0200
@@ -751,7 +751,7 @@
#endif // IS_PY2
Shiboken::AutoDecRef privateobj(PyObject_GetAttr(
reinterpret_cast<PyObject *>(Py_TYPE(self)), Shiboken::PyMagicName::name()));
-#ifndef Py_LIMITED_API
+#ifdef IS_PY2
return _Py_Mangle(privateobj, name);
#else
// PYSIDE-1436: _Py_Mangle is no longer exposed; implement it always.

16
gnu/packages/patches/qtdeclarative-5-disable-qmlcache.patch Normal file
View file

@ -0,0 +1,16 @@
Retrieved from
https://github.com/NixOS/nixpkgs/raw/master/pkgs/development/libraries/qt-5/5.15/qtdeclarative-default-disable-qmlcache.patch
diff --git a/src/qml/qml/qqmltypeloader.cpp b/src/qml/qml/qqmltypeloader.cpp
index 1d66e75..827567a 100644
--- a/src/qml/qml/qqmltypeloader.cpp
+++ b/src/qml/qml/qqmltypeloader.cpp
@@ -727,7 +727,7 @@ bool QQmlTypeLoader::Blob::isDebugging() const
bool QQmlTypeLoader::Blob::diskCacheEnabled() const
{
- return (!disableDiskCache() && !isDebugging()) || forceDiskCache();
+ return forceDiskCache();
}
bool QQmlTypeLoader::Blob::qmldirDataAvailable(const QQmlRefPointer<QQmlQmldirData> &data, QList<QQmlError> *errors)

16
gnu/packages/patches/qtdeclarative-disable-qmlcache.patch Normal file
View file

@ -0,0 +1,16 @@
Retrieved from
https://raw.githubusercontent.com/NixOS/nixpkgs/master/pkgs/development/libraries/qt-6/patches/qtdeclarative-default-disable-qmlcache.patch
diff --git a/src/qml/jsruntime/qv4engine.cpp b/src/qml/jsruntime/qv4engine.cpp
index 852cde9e..165f1b57 100644
--- a/src/qml/jsruntime/qv4engine.cpp
+++ b/src/qml/jsruntime/qv4engine.cpp
@@ -2093,7 +2093,7 @@ void ExecutionEngine::registerModule(const QString &_name, const QJSValue &modul
bool ExecutionEngine::diskCacheEnabled() const
{
- return (!disableDiskCache() && !debugger()) || forceDiskCache();
+ return forceDiskCache();
}
void ExecutionEngine::callInContext(QV4::Function *function, QObject *self,

18
gnu/packages/patches/qtwayland-gcc-11.patch
View file

@ -1,18 +0,0 @@
Add missing import for newer libstdc++.
Taken from upstream:
https://github.com/qt/qtwayland/commit/1aa6ec2c778504d96543f6cdc2b9199a7b066fc1
diff --git a/tests/auto/client/shared/corecompositor.cpp b/tests/auto/client/shared/corecompositor.cpp
index 5c6c83baa..fa9b7662a 100644
--- a/tests/auto/client/shared/corecompositor.cpp
+++ b/tests/auto/client/shared/corecompositor.cpp
@@ -27,6 +27,7 @@
****************************************************************************/
#include "corecompositor.h"
+#include <thread>
namespace MockCompositor {

3
gnu/packages/photo.scm
View file

@ -567,7 +567,8 @@ developer. It manages your digital negatives in a database, lets you view
them through a zoomable lighttable and enables you to develop raw images them through a zoomable lighttable and enables you to develop raw images
and enhance them.") and enhance them.")
;; See src/is_supported_platform.h for supported platforms. ;; See src/is_supported_platform.h for supported platforms.
(supported-systems '("x86_64-linux" "aarch64-linux" "powerpc64le-linux")) (supported-systems '("x86_64-linux" "aarch64-linux" "powerpc64le-linux"
"riscv64-linux"))
(properties (properties
'((release-monitoring-url . "https://github.com/darktable-org/darktable/releases"))) '((release-monitoring-url . "https://github.com/darktable-org/darktable/releases")))
(license (list license:gpl3+ ;Darktable itself (license (list license:gpl3+ ;Darktable itself

5
gnu/packages/pkg-config.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -171,14 +172,14 @@ exec ~a \"$@\""
(define-public pkgconf (define-public pkgconf
(package (package
(name "pkgconf") (name "pkgconf")
(version "1.9.3") (version "2.0.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://distfiles.dereferenced.org/" (uri (string-append "https://distfiles.dereferenced.org/"
name "/" name "-" version ".tar.xz")) name "/" name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"17b9cl2s99pzgblaj0yg49k3m0by5x78vwg4879vckymhys5bcsz")))) "00a4cv1f8cxsb4jhpgxxrwrl92b1zdsirqn0gqvva7i5izpjanpa"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (list #:tests? #f)) ;TODO: package kyua (arguments (list #:tests? #f)) ;TODO: package kyua
(home-page "http://pkgconf.org/") (home-page "http://pkgconf.org/")

16
gnu/packages/python-crypto.scm
View file

@ -735,7 +735,7 @@ ECB and OFB).")
(define-public python-asn1crypto (define-public python-asn1crypto
(package (package
(name "python-asn1crypto") (name "python-asn1crypto")
(version "1.4.0") (version "1.5.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -745,18 +745,20 @@ ECB and OFB).")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"19abibn6jw20mzi1ln4n9jjvpdka8ygm4m439hplyrdfqbvgm01r")))) "1qsg06qrqnzixmrm65ibg503y2gffd675h1si4jgh92s315w1jrk"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
'(#:phases (modify-phases %standard-phases '(#:phases (modify-phases %standard-phases
(replace 'check (replace 'check
(lambda _ (lambda* (#:key tests? #:allow-other-keys)
(invoke "python" "run.py" "tests")))))) (when tests?
(invoke "python" "run.py" "tests")))))))
(home-page "https://github.com/wbond/asn1crypto") (home-page "https://github.com/wbond/asn1crypto")
(synopsis "ASN.1 parser and serializer in Python") (synopsis "ASN.1 parser and serializer in Python")
(description "asn1crypto is an ASN.1 parser and serializer with definitions (description
for private keys, public keys, certificates, CRL, OCSP, CMS, PKCS#3, PKCS#7, "@code{asn1crypto} is an ASN.1 parser and serializer with definitions for
PKCS#8, PKCS#12, PKCS#5, X.509 and TSP.") private keys, public keys, certificates, CRL, OCSP, CMS, PKCS#3, PKCS#7, PKCS#8,
PKCS#12, PKCS#5, X.509 and TSP.")
(license license:expat))) (license license:expat)))
(define-public python-pynacl (define-public python-pynacl

8
gnu/packages/python-web.scm
View file

@ -5008,7 +5008,7 @@ for URL parsing and changing.")
(define-public python-canvasapi (define-public python-canvasapi
(package (package
(name "python-canvasapi") (name "python-canvasapi")
(version "2.2.0") (version "3.2.0")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -5017,9 +5017,9 @@ for URL parsing and changing.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0i13wrq2czcaz3h98pvnsl237104v611y9636jf32b1nn76sbp0p")))) "1vbd3ndhmxi8scxgxs6sc7r0rdaliqd80384n06nyb3haqz25inm"))))
(build-system python-build-system) (build-system pyproject-build-system)
(propagated-inputs (list python-pytz python-requests)) (propagated-inputs (list python-arrow python-pytz python-requests))
(native-inputs (list python-requests-mock)) (native-inputs (list python-requests-mock))
(home-page "https://github.com/ucfopen/canvasapi") (home-page "https://github.com/ucfopen/canvasapi")
(synopsis "API wrapper for the Canvas LMS") (synopsis "API wrapper for the Canvas LMS")

48
gnu/packages/python-xyz.scm
View file

@ -139,6 +139,7 @@
;;; Copyright © 2023 Dominik Delgado Steuter <d@delgado.nrw> ;;; Copyright © 2023 Dominik Delgado Steuter <d@delgado.nrw>
;;; Copyright © 2023 Ivan Vilata-i-Balaguer <ivan@selidor.net> ;;; Copyright © 2023 Ivan Vilata-i-Balaguer <ivan@selidor.net>
;;; Copyright © 2023 Ontje Lünsdorf <ontje.luensdorf@dlr.de> ;;; Copyright © 2023 Ontje Lünsdorf <ontje.luensdorf@dlr.de>
;;; Copyright © 2023 Parnikkapore <poomklao@yahoo.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -8940,6 +8941,53 @@ converting, and viewing many of the proprietary file formats used to store
experimental data and metadata at the Laboratory for Fluorescence Dynamics.") experimental data and metadata at the Laboratory for Fluorescence Dynamics.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public python-ffmpeg-python
;; The latest release (0.2.0) is old and its test suite crashs on Python 3.10.
(let ((commit "df129c7ba30aaa9ffffb81a48f53aa7253b0b4e6") (revision "0"))
(package
(name "python-ffmpeg-python")
(version (git-version "0.2.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/kkroening/ffmpeg-python.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"1zj4ac37n4igfj21zy405mdlvbpv6jyb12wfpszf8zkhhj2qby4c"))))
(build-system python-build-system)
(arguments
(list
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'hardcode-ffmpeg
(lambda* (#:key inputs #:allow-other-keys)
(define ffmpeg (search-input-file inputs "bin/ffmpeg"))
(substitute* "ffmpeg/_run.py"
(("cmd='ffmpeg'")
(string-append "cmd='" ffmpeg "'")))
(substitute* "ffmpeg/tests/test_ffmpeg.py"
(("out_file.compile\\(\\) == \\['ffmpeg'")
(string-append "out_file.compile() == ['" ffmpeg "'")))))
;; Some tests fail with ffmpeg 5+
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(invoke "pytest" "-vv"
"-k" "not test_pipe and not test__probe")))))))
(inputs (list ffmpeg))
(propagated-inputs (list python-future))
(native-inputs (list python-future python-numpy python-pytest
python-pytest-mock python-pytest-runner))
(home-page "https://github.com/kkroening/ffmpeg-python")
(synopsis "Python bindings for FFmpeg with complex filtering support")
(description
"ffmpeg-python allows you to write FFmpeg filtergraphs in familiar
Python terms, taking care of running ffmpeg with the correct command-line
arguments. It handles arbitrarily large (directed-acyclic) signal graphs.")
(license license:asl2.0))))
(define-public python-imageio-ffmpeg (define-public python-imageio-ffmpeg
(package (package
(name "python-imageio-ffmpeg") (name "python-imageio-ffmpeg")

648
gnu/packages/qt.scm
View file

File diff suppressed because it is too large Load diff

4
gnu/packages/screen.scm
View file

@ -43,14 +43,14 @@
(define-public screen (define-public screen
(package (package
(name "screen") (name "screen")
(version "4.9.0") (version "4.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/screen/screen-" (uri (string-append "mirror://gnu/screen/screen-"
version ".tar.gz")) version ".tar.gz"))
(patches (search-patches "screen-hurd-path-max.patch")) (patches (search-patches "screen-hurd-path-max.patch"))
(sha256 (sha256
(base32 "1x1hqy4h47i7hk85f779lkwkm7gkq8h8mxwd0znkh5adpf0m4czr")))) (base32 "0sdc0ms6qxm4gbx0caw7pwghj5aw1h8syvxdhkac0w95qkiz7ki6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
(list autoconf automake texinfo)) (list autoconf automake texinfo))

30
gnu/packages/scsi.scm
View file

@ -19,8 +19,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages scsi) (define-module (gnu packages scsi)
#:use-module ((guix licenses) #:use-module ((guix licenses) #:prefix license:)
#:select (gpl2+ bsd-2 bsd-3 lgpl2.1+))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
@ -70,7 +69,7 @@ used in C and C++ programs to interact with SCSI devices.")
;; "3 clause" to the newer "2 clause" version on 20180119. To save space ;; "3 clause" to the newer "2 clause" version on 20180119. To save space
;; various source code files refer to a file called "BSD_LICENSE" [...]." ;; various source code files refer to a file called "BSD_LICENSE" [...]."
;; Some files (like sg_compare_and_write.c) retain their 3-clause headers! ;; Some files (like sg_compare_and_write.c) retain their 3-clause headers!
(license (list gpl2+ bsd-2 bsd-3)))) (license (list license:gpl2+ license:bsd-2 license:bsd-3))))
(define-public libiscsi (define-public libiscsi
(package (package
@ -97,6 +96,27 @@ synchronous layer is also provided for ease of use for simpler applications.")
(license (list (license (list
;; For the src, examples and test-tool directories, except ;; For the src, examples and test-tool directories, except
;; src/ld_iscsi.c. ;; src/ld_iscsi.c.
gpl2+ license:gpl2+
;; For the lib and include directories. ;; For the lib and include directories.
lgpl2.1+)))) license:lgpl2.1+))))
(define-public lsscsi
(package
(name "lsscsi")
(version "0.32")
(source (origin
(method url-fetch)
(uri (string-append
"http://sg.danny.cz/scsi/lsscsi-" version ".tar.xz"))
(sha256
(base32
"0jp458m2b3wckr18qkln69i01152qlwz33zm49103lq8fgx0n6d4"))))
(build-system gnu-build-system)
(synopsis "Lists information about SCSI or NVMe devices in Linux")
(home-page "https://sg.danny.cz/scsi/lsscsi.html")
(description
"@command{lsscsi} lists SCSI logical units or SCSI targets. It can
also list NVMe namespaces or controllers and show the relationship between a
device's primary node name, its SCSI generic (sg) node name and its kernel
name.")
(license license:gpl2)))

113
gnu/packages/syncthing.scm
View file

@ -46,7 +46,7 @@
(define-public syncthing (define-public syncthing
(package (package
(name "syncthing") (name "syncthing")
(version "1.23.4") (version "1.23.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/syncthing/syncthing" (uri (string-append "https://github.com/syncthing/syncthing"
@ -54,83 +54,72 @@
"/syncthing-source-v" version ".tar.gz")) "/syncthing-source-v" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1yi9adlp30myizlmv7a118cwrm6w1qfv09b0z7x1b7n4i8pqi8h6")))) "03myinspq61aiis29mq0xjigj5rh5jd8m0d9xakf43vi7pqgwjbc"))))
(build-system go-build-system) (build-system go-build-system)
;; The primary Syncthing executable goes to "out", while the auxiliary ;; The primary Syncthing executable goes to "out", while the auxiliary
;; server programs and utility tools go to "utils". This reduces the size ;; server programs and utility tools go to "utils". This reduces the size
;; of "out" by ~144 MiB. ;; of "out" by ~144 MiB.
(outputs '("out" "utils")) (outputs '("out" "utils"))
(arguments (arguments
`(#:modules ((srfi srfi-26) ; for cut (list #:modules '((srfi srfi-26) ; for cut
(guix build utils) (guix build utils)
(guix build go-build-system)) (guix build go-build-system))
#:go ,go-1.19 #:go go-1.19
#:import-path "github.com/syncthing/syncthing" #:import-path "github.com/syncthing/syncthing"
;; We don't need to install the source code for end-user applications. ;; We don't need to install the source code for end-user applications.
#:install-source? #f #:install-source? #f
#:phases #:phases
(modify-phases %standard-phases #~(modify-phases %standard-phases
(add-before 'build 'increase-test-timeout (add-before 'build 'increase-test-timeout
(lambda _ (lambda _
(substitute* "src/github.com/syncthing/syncthing/build.go" (substitute* "src/github.com/syncthing/syncthing/build.go"
(("120s") "999s")) (("120s") "999s"))))
#t))
(replace 'build (replace 'build
(lambda _ (lambda _
(with-directory-excursion "src/github.com/syncthing/syncthing" (with-directory-excursion "src/github.com/syncthing/syncthing"
;; XXX The only way to build Syncthing without its automatic ;; XXX The only way to build Syncthing without its automatic
;; updater and to build the utilities is to "build all" and then ;; updater and to build the utilities is to "build all" and then
;; "build syncthing" again with -no-upgrade. ;; "build syncthing" again with -no-upgrade.
;; https://github.com/syncthing/syncthing/issues/6118 ;; https://github.com/syncthing/syncthing/issues/6118
(invoke "go" "run" "build.go") (invoke "go" "run" "build.go")
(delete-file "bin/syncthing") (delete-file "bin/syncthing")
(invoke "go" "run" "build.go" "-no-upgrade" "build" "syncthing")))) (invoke "go" "run" "build.go" "-no-upgrade" "build" "syncthing"))))
(replace 'check (replace 'check
(lambda* (#:key tests? #:allow-other-keys) (lambda* (#:key tests? #:allow-other-keys)
(when tests? (when tests?
(with-directory-excursion "src/github.com/syncthing/syncthing" (with-directory-excursion "src/github.com/syncthing/syncthing"
(invoke "go" "run" "build.go" "test"))) (invoke "go" "run" "build.go" "test")))))
#t))
(replace 'install (replace 'install
(lambda* (#:key outputs #:allow-other-keys) (lambda _
(let ((out (assoc-ref outputs "out")) (with-directory-excursion "src/github.com/syncthing/syncthing/bin"
(utils (assoc-ref outputs "utils"))) (install-file "../syncthing" (string-append #$output "/bin"))
(with-directory-excursion "src/github.com/syncthing/syncthing/bin" (for-each (cut install-file <> (string-append #$output:utils "/bin/"))
(install-file "../syncthing" (string-append out "/bin")) '("stcompdirs" "stcrashreceiver"
(for-each (cut install-file <> (string-append utils "/bin/")) "stdisco" "stdiscosrv" "stevents" "stfileinfo"
'("stcompdirs" "stcrashreceiver" "stfinddevice" "stfindignored" "stgenfiles"
"stdisco" "stdiscosrv" "stevents" "stfileinfo" "strelaypoolsrv" "strelaysrv" "stsigtool"
"stfinddevice" "stfindignored" "stgenfiles" "stvanity" "stwatchfile" "uraggregate" "ursrv")))))
"strelaypoolsrv" "strelaysrv" "stsigtool"
"stvanity" "stwatchfile" "uraggregate" "ursrv"))
#t))))
(add-after 'install 'install-docs (add-after 'install 'install-docs
(lambda* (#:key outputs #:allow-other-keys) (lambda _
(let* ((out (assoc-ref outputs "out")) (let ((man (string-append #$output "/share/man"))
(utils (assoc-ref outputs "utils")) (man:utils (string-append #$output:utils "/share/man")))
(man "/share/man")
(man-section (string-append man "/man"))
(src "src/github.com/syncthing/syncthing/man/"))
;; Install all the man pages to "out". ;; Install all the man pages to "out".
(for-each (for-each
(lambda (file) (lambda (file)
(install-file file (install-file file
(string-append out man-section (string-append man "/man" (string-take-right file 1))))
(string-take-right file 1)))) (find-files "src/github.com/syncthing/syncthing/man" "\\.[1-9]"))
(find-files src "\\.[1-9]"))
;; Copy all the man pages to "utils" ;; Copy all the man pages to "utils"
(copy-recursively (string-append out man) (copy-recursively man man:utils)
(string-append utils man))
;; Delete extraneous man pages from "out" and "utils", ;; Delete extraneous man pages from "out" and "utils",
;; respectively. ;; respectively.
(delete-file (string-append out man "/man1/stdiscosrv.1")) (delete-file (string-append man "/man1/stdiscosrv.1"))
(delete-file (string-append out man "/man1/strelaysrv.1")) (delete-file (string-append man "/man1/strelaysrv.1"))
(delete-file (string-append utils man "/man1/syncthing.1")) (delete-file (string-append man:utils "/man1/syncthing.1"))))))))
#t))))))
(synopsis "Decentralized continuous file system synchronization") (synopsis "Decentralized continuous file system synchronization")
(description "Syncthing is a peer-to-peer file synchronization tool that (description "Syncthing is a peer-to-peer file synchronization tool that
supports a wide variety of computing platforms. It uses the Block Exchange supports a wide variety of computing platforms. It uses the Block Exchange

2
gnu/packages/telegram.scm
View file

@ -517,7 +517,7 @@ Telegram project, for its use in telegram desktop client.")
qrcodegen-cpp qrcodegen-cpp
qtbase-5 qtbase-5
qtdeclarative-5 qtdeclarative-5
qtimageformats qtimageformats-5
qtsvg-5 qtsvg-5
qtwayland-5 qtwayland-5
range-v3 range-v3

95
gnu/packages/terminals.scm
View file

@ -33,6 +33,7 @@
;;; Copyright © 2022 Felipe Balbi <balbi@kernel.org> ;;; Copyright © 2022 Felipe Balbi <balbi@kernel.org>
;;; Copyright © 2022 ( <paren@disroot.org> ;;; Copyright © 2022 ( <paren@disroot.org>
;;; Copyright © 2022 jgart <jgart@dismail.de> ;;; Copyright © 2022 jgart <jgart@dismail.de>
;;; Copyright © 2023 Aaron Covrig <aaron.covrig.us@ieee.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -1339,50 +1340,54 @@ while also supporting native scrolling and @command{tmux} control mode
(deprecated-package "wterm" foot)) (deprecated-package "wterm" foot))
(define-public tilix (define-public tilix
(package (let ((commit "8726e9e9426e6b05c8cadfe7fe5205e8cbc910e3")
(name "tilix") (revision "0"))
(version "1.9.5") (package
(source (name "tilix")
(origin ;; No release in over a year so include commits that fix glibc related
(method git-fetch) ;; build issues.
(uri (git-reference (version (git-version "1.9.5" revision commit))
(url "https://github.com/gnunn1/tilix") (source (origin
(commit version))) (method git-fetch)
(file-name (git-file-name name version)) (uri (git-reference
(sha256 (url "https://github.com/gnunn1/tilix")
(base32 "1ij3ix6yhi8hicxvglrxjyyv8bch9birrgsr8ml6jfh3hvk4pxdh")))) (commit commit)))
(build-system meson-build-system) (file-name (git-file-name name version))
(arguments (sha256
`(#:glib-or-gtk? #t (base32
#:phases "0vbjfk6zn9r56nxhlgy77szv7ai061ds53hsz9zba0v9kyzzcdml"))))
(modify-phases %standard-phases (build-system meson-build-system)
(add-after 'unpack 'set-env-variables (arguments
(lambda _ `(#:glib-or-gtk? #t
(setenv "CC" ,(cc-for-target)))) #:phases
(add-after 'unpack 'skip-gtk-update-icon-cache (modify-phases %standard-phases
(lambda _ (add-after 'unpack 'set-env-variables
(substitute* "meson_post_install.py" (lambda _
(("gtk-update-icon-cache") (which "true")) (setenv "CC" ,(cc-for-target))))
(("update-desktop-database") (which "true")))))))) (add-after 'unpack 'skip-gtk-update-icon-cache
(inputs (lambda _
(list dbus (substitute* "meson_post_install.py"
dconf (("gtk-update-icon-cache") (which "true"))
gsettings-desktop-schemas (("update-desktop-database") (which "true"))))))))
gtk+ (inputs
gtkd (list dbus
ldc dconf
libsecret gsettings-desktop-schemas
libunwind gtk+
vte)) gtkd
(native-inputs ldc
(list appstream libsecret
gettext-minimal libunwind
(list glib "bin") vte))
ldc (native-inputs
pkg-config)) (list appstream
(home-page "https://gnunn1.github.io/tilix-web/") gettext-minimal
(synopsis "Tiling terminal emulator") (list glib "bin")
(description "Tilix is a tiling terminal emulator following the ldc
pkg-config))
(home-page "https://gnunn1.github.io/tilix-web/")
(synopsis "Tiling terminal emulator")
(description "Tilix is a tiling terminal emulator following the
Gnome Human Interface Guidelines. Its features include: Gnome Human Interface Guidelines. Its features include:
@enumerate @enumerate
@item Layout terminals in any fashion by splitting them horizontally or @item Layout terminals in any fashion by splitting them horizontally or
@ -1394,7 +1399,7 @@ windows.
terminal are replicated to the others. terminal are replicated to the others.
@item Supports notifications when processes are completed out of view. @item Supports notifications when processes are completed out of view.
@end enumerate") @end enumerate")
(license license:mpl2.0))) (license license:mpl2.0))))
(define-public tio (define-public tio
(package (package

18934
gnu/packages/tex.scm
View file

File diff suppressed because it is too large Load diff

7
gnu/packages/texlive.scm
View file

@ -3,7 +3,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016, 2018, 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2018-2021, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2016 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
@ -313,8 +313,9 @@ This package contains the binaries.")
(texlive-bin (assoc-ref inputs "texlive-bin")) (texlive-bin (assoc-ref inputs "texlive-bin"))
(texbin (string-append texlive-bin "/bin")) (texbin (string-append texlive-bin "/bin"))
(tlpkg (string-append texlive-bin "/share/tlpkg"))) (tlpkg (string-append texlive-bin "/share/tlpkg")))
;; LuaJIT is not ported to powerpc64* yet. ;; LuaJIT is not ported to some systems yet.
(if ,(target-ppc64le?) (if ,(or (target-ppc64le?)
(target-riscv64?))
(substitute* fmtutilcnf (substitute* fmtutilcnf
(("^(luajittex|luajithbtex|mfluajit)" m) (("^(luajittex|luajithbtex|mfluajit)" m)
(string-append "#! " m)))) (string-append "#! " m))))

27
gnu/packages/tree-sitter.scm
View file

@ -5,6 +5,7 @@
;;; Copyright © 2022 Aleksandr Vityazev <avityazev@posteo.org> ;;; Copyright © 2022 Aleksandr Vityazev <avityazev@posteo.org>
;;; Copyright © 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2023 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr> ;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -358,6 +359,13 @@ will be used in description and synopsis."
#:commit commit #:commit commit
#:inputs (list tree-sitter-c)))) #:inputs (list tree-sitter-c))))
(define-public tree-sitter-cmake
(tree-sitter-grammar
"cmake" "CMake"
"1z49jdachwxwbzrrapskpi2kxq3ydihfj45ab9892gbamfij2zp5"
"0.4.1"
#:repository-url "https://github.com/uyha/tree-sitter-cmake"))
(define-public tree-sitter-elixir (define-public tree-sitter-elixir
;; No tags at all, version in the source code is 0.19.0 ;; No tags at all, version in the source code is 0.19.0
(let ((commit "b20eaa75565243c50be5e35e253d8beb58f45d56") (let ((commit "b20eaa75565243c50be5e35e253d8beb58f45d56")
@ -390,6 +398,13 @@ will be used in description and synopsis."
"054fmpf47cwh59gbg00sc0nl237ba4rnxi73miz39yqzcs87055r" "054fmpf47cwh59gbg00sc0nl237ba4rnxi73miz39yqzcs87055r"
"0.19.1")) "0.19.1"))
(define-public tree-sitter-dockerfile
(tree-sitter-grammar
"dockerfile" "Dockerfile"
"0kf4c4xs5naj8lpcmr3pbdvwj526wl9p6zphxxpimbll7qv6qfnd"
"0.1.2"
#:repository-url "https://github.com/camdencheek/tree-sitter-dockerfile"))
(define-public tree-sitter-elm (define-public tree-sitter-elm
(tree-sitter-grammar (tree-sitter-grammar
"elm" "Elm" "elm" "Elm"
@ -528,6 +543,18 @@ will be used in description and synopsis."
"0.7.1" "0.7.1"
#:repository-url "https://github.com/ikatyang/tree-sitter-markdown")) #:repository-url "https://github.com/ikatyang/tree-sitter-markdown"))
(define-public tree-sitter-meson
;; tag 1.2 is Aug 24,2022 this commit is Feb 28,2023
(let ((commit "3d6dfbdb2432603bc84ca7dc009bb39ed9a8a7b1")
(revision "0"))
(tree-sitter-grammar
"meson" "Meson"
"1rn7r76h65d41354czyccm59d1j9nzybcrjvjh934lpr59qrw61m"
(git-version "1.2" revision commit)
#:repository-url "https://github.com/Decodetalkers/tree-sitter-meson"
#:commit commit
#:license license:expat)))
(define-public tree-sitter-org (define-public tree-sitter-org
;; There are a lot of additions, the last tag was placed a while ago ;; There are a lot of additions, the last tag was placed a while ago
(let ((commit "081179c52b3e8175af62b9b91dc099d010c38770") (let ((commit "081179c52b3e8175af62b9b91dc099d010c38770")

5
gnu/packages/video.scm
View file

@ -1701,6 +1701,11 @@ operate properly.")
;; --enable-libzvbi enable teletext support via libzvbi [no] ;; --enable-libzvbi enable teletext support via libzvbi [no]
;; --enable-opencl enable OpenCL code ;; --enable-opencl enable OpenCL code
#~(list #~(list
#$@(if (target-powerpc?)
;; These tests fail on powerpc64-le (see:
;; https://trac.ffmpeg.org/ticket/9604).
'("--ignore-tests=checkasm-sw_scale,filter-scale2ref_keep_aspect")
'())
"--enable-gpl" ;enable optional gpl licensed parts "--enable-gpl" ;enable optional gpl licensed parts
"--enable-shared" "--enable-shared"
"--enable-frei0r" "--enable-frei0r"

16
gnu/packages/xdisorg.scm
View file

@ -275,7 +275,7 @@ program.")
(define-public autorandr (define-public autorandr
(package (package
(name "autorandr") (name "autorandr")
(version "1.10.1") (version "1.14")
(home-page "https://github.com/phillipberndt/autorandr") (home-page "https://github.com/phillipberndt/autorandr")
(source (source
(origin (origin
@ -285,7 +285,7 @@ program.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0msw9b1hdy3gbq9w5d04mfizhyirz1c648x84mlcbzl8salm7vpg")))) (base32 "0yb0rnv37xymjhg54mk7zw3h9501f45ykc1754mxy1q3bm0fgva6"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))
@ -1117,7 +1117,7 @@ shows it again when the mouse cursor moves or a mouse button is pressed.")
(define-public xlockmore (define-public xlockmore
(package (package
(name "xlockmore") (name "xlockmore")
(version "5.68") (version "5.72")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (list (string-append "http://sillycycle.com/xlock/" (uri (list (string-append "http://sillycycle.com/xlock/"
@ -1128,7 +1128,7 @@ shows it again when the mouse cursor moves or a mouse button is pressed.")
"xlockmore-" version ".tar.xz"))) "xlockmore-" version ".tar.xz")))
(sha256 (sha256
(base32 (base32
"0vndfwccnvkaaraprjam8pmx0aj55va0ag64q6snxw83nbf1ywrh")))) "0wn77ri29rhk1w3wik2hpqb8lks1pyqzdk6d583mawxfcxcrf4fm"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list (list
@ -2661,14 +2661,14 @@ temperature of the screen.")
(define-public xsecurelock (define-public xsecurelock
(package (package
(name "xsecurelock") (name "xsecurelock")
(version "1.7.0") (version "1.8.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"https://github.com/google/xsecurelock/releases" "https://github.com/google/xsecurelock/releases"
"/download/v" version "/xsecurelock-" version ".tar.gz")) "/download/v" version "/xsecurelock-" version ".tar.gz"))
(sha256 (sha256
(base32 "0s2q69g1xhvs18q2jhcval5vpa9j0kkrdv02r176vvxvdms7hhc7")))) (base32 "1i7vhzysirr5kra15vd501b79k0jgs11lkb9ck3hx6vicxm204d3"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags
@ -3552,7 +3552,7 @@ light filter or night light.")
(define-public ydotool (define-public ydotool
(package (package
(name "ydotool") (name "ydotool")
(version "1.0.1") (version "1.0.4")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -3561,7 +3561,7 @@ light filter or night light.")
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1h19dh7kai0iikssr7sq0wfkh0sb18dylyfg7c3dkwc158cdg9cr")))) (base32 "0y2n1r6hx0ar1yn636a7j4ywm17qqji84ryhdina3kriwx3sgmij"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments '(#:tests? #f)) ; no tests (arguments '(#:tests? #f)) ; no tests
(native-inputs (list scdoc)) (native-inputs (list scdoc))

28
gnu/packages/xfce.scm
View file

@ -891,6 +891,34 @@ GIT integration to Thunar, it adds Subversion and GIT actions to the context
menu.") menu.")
(license gpl2+))) (license gpl2+)))
(define-public thunarx-python
(package
(name "thunarx-python")
(version "0.5.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://archive.xfce.org/src/bindings/"
name "/" (version-major+minor version)
"/" name "-" version ".tar.bz2"))
(sha256
(base32 "08lz9pvx006a2fypg2q38p61jbhy0yswz8cizlxpiwfcqsvhpnln"))))
(build-system gnu-build-system)
(native-inputs
(list pkg-config which))
(inputs
(list exo
thunar
python
python-pygobject
libxfce4ui
gtk+))
(home-page "https://gitlab.xfce.org/bindings/thunarx-python")
(synopsis "Python Bindings for Thunar")
(description
"These bindings allow one to create python plugins for Thunar.")
(license gpl2+)))
(define-public xfwm4 (define-public xfwm4
(package (package
(name "xfwm4") (name "xfwm4")

25
gnu/services.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
@ -86,6 +86,10 @@
instantiate-missing-services instantiate-missing-services
fold-services fold-services
remove-service-extensions
for-home
for-home?
service-error? service-error?
missing-value-service-error? missing-value-service-error?
missing-value-service-error-type missing-value-service-error-type
@ -1225,4 +1229,23 @@ TARGET-TYPE; return the root service adjusted accordingly."
(G_ "more than one target service of type '~a'") (G_ "more than one target service of type '~a'")
(service-type-name target-type))))))))) (service-type-name target-type)))))))))
(define (remove-service-extensions type lst)
"Return TYPE, a service type, without any of the service extensions
targeting one of the types in LST."
(service-type
(inherit type)
(extensions (remove (lambda (extension)
(memq (service-extension-target extension) lst))
(service-type-extensions type)))))
(define-syntax-parameter for-home?
;; Whether the configuration being defined is for a Home service.
(identifier-syntax #f))
(define-syntax-rule (for-home exp ...)
"Mark EXP, which typically defines a service configuration, as targeting a
Home service rather than a System service."
(syntax-parameterize ((for-home? (identifier-syntax #t)))
exp ...))
;;; services.scm ends here. ;;; services.scm ends here.

31
gnu/services/admin.scm
View file

@ -22,7 +22,7 @@
(define-module (gnu services admin) (define-module (gnu services admin)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module ((gnu packages base) #:use-module ((gnu packages base)
#:select (canonical-package findutils)) #:select (canonical-package findutils coreutils sed))
#:use-module (gnu packages certs) #:use-module (gnu packages certs)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (gnu services) #:use-module (gnu services)
@ -290,7 +290,7 @@ Old log files are removed or compressed according to the configuration.")
"10 23 * * 0") "10 23 * * 0")
(define %default-file-database-excluded-directories (define %default-file-database-excluded-directories
;; Directories excluded from the 'locate' database. ;; Regexps of directories excluded from the 'locate' database.
(list (%store-prefix) (list (%store-prefix)
"/tmp" "/var/tmp" "/var/cache" ".*/\\.cache" "/tmp" "/var/tmp" "/var/cache" ".*/\\.cache"
"/run/udev")) "/run/udev"))
@ -319,10 +319,10 @@ is taken.")
@command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}).") @command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}).")
(excluded-directories (excluded-directories
(string-list %default-file-database-excluded-directories) (string-list %default-file-database-excluded-directories)
"List of directories to ignore when building the file database. By "List of regular expressions of directories to ignore when building the
default, this includes @file{/tmp} and @file{/gnu/store}, which should instead file database. By default, this includes @file{/tmp} and @file{/gnu/store};
be indexed by @command{guix locate} (@pxref{Invoking guix locate}). This list the latter should instead be indexed by @command{guix locate} (@pxref{Invoking
is passed to the @option{--prunepaths} option of guix locate}). This list is passed to the @option{--prunepaths} option of
@command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils}).")) @command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils})."))
(define (file-database-mcron-jobs configuration) (define (file-database-mcron-jobs configuration)
@ -330,11 +330,20 @@ is passed to the @option{--prunepaths} option of
(package schedule excluded-directories) (package schedule excluded-directories)
(let ((updatedb (program-file (let ((updatedb (program-file
"updatedb" "updatedb"
#~(execl #$(file-append package "/bin/updatedb") #~(begin
"updatedb" ;; 'updatedb' is a shell script that expects various
#$(string-append "--prunepaths=" ;; commands in $PATH.
(string-join (setenv "PATH"
excluded-directories)))))) (string-append #$package "/bin:"
#$(canonical-package coreutils)
"/bin:"
#$(canonical-package sed)
"/bin"))
(execl #$(file-append package "/bin/updatedb")
"updatedb"
#$(string-append "--prunepaths="
(string-join
excluded-directories)))))))
(list #~(job #$schedule #$updatedb))))) (list #~(job #$schedule #$updatedb)))))
(define file-database-service-type (define file-database-service-type

84
gnu/services/dict.scm
View file

@ -56,7 +56,9 @@
(handlers dicod-configuration-handlers ;list of <dicod-handler> (handlers dicod-configuration-handlers ;list of <dicod-handler>
(default '())) (default '()))
(databases dicod-configuration-databases ;list of <dicod-database> (databases dicod-configuration-databases ;list of <dicod-database>
(default (list %dicod-database:gcide)))) (default (list %dicod-database:gcide)))
(home-service? dicod-configuration-home-service? ;boolean
(default for-home?) (innate)))
(define-record-type* <dicod-handler> (define-record-type* <dicod-handler>
dicod-handler make-dicod-handler dicod-handler make-dicod-handler
@ -73,12 +75,24 @@
(complex? dicod-database-complex? (default #f)) (complex? dicod-database-complex? (default #f))
(options dicod-database-options (default '()))) (options dicod-database-options (default '())))
(define %dicod-gcide-index
;; The GCIDE pre-built index. The Dico 'gcide' module can build it lazily;
;; do it upfront so there's no need for a writable directory at run-time.
(computed-file "dicod-gcide-index"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(mkdir #$output)
(invoke #+(file-append dico "/libexec/idxgcide")
#+(file-append gcide "/share/gcide")
#$output)))))
(define %dicod-database:gcide (define %dicod-database:gcide
(dicod-database (dicod-database
(name "gcide") (name "gcide")
(handler "gcide") (handler "gcide")
(options (list #~(string-append "dbdir=" #$gcide "/share/gcide") (options (list #~(string-append "dbdir=" #$gcide "/share/gcide")
"idxdir=/var/run/dicod")))) #~(string-append "idxdir=" #$%dicod-gcide-index)))))
(define %dicod-accounts (define %dicod-accounts
(list (user-group (list (user-group
@ -137,55 +151,43 @@ database {
(apply mixed-text-file "dicod.conf" (configuration->text config))) (apply mixed-text-file "dicod.conf" (configuration->text config)))
(define %dicod-activation
#~(begin
(use-modules (guix build utils))
(let ((user (getpwnam "dicod"))
(rundir "/var/run/dicod"))
(mkdir-p rundir)
(chown rundir (passwd:uid user) (passwd:gid user)))))
(define (dicod-shepherd-service config) (define (dicod-shepherd-service config)
(let* ((dicod.conf (dicod-configuration-file config)) (let* ((dicod.conf (dicod-configuration-file config))
(interfaces (dicod-configuration-interfaces config)) (interfaces (dicod-configuration-interfaces config))
(home-service? (dicod-configuration-home-service? config))
(mappings `(,@(if home-service?
'()
(list (file-system-mapping
(source "/dev/log")
(target source))))
,(file-system-mapping
(source dicod.conf)
(target source))))
(dicod (least-authority-wrapper (dicod (least-authority-wrapper
(file-append (dicod-configuration-dico config) (file-append (dicod-configuration-dico config)
"/bin/dicod") "/bin/dicod")
#:name "dicod" #:name "dicod"
#:mappings (list (file-system-mapping #:mappings mappings
(source "/var/run/dicod")
(target source)
(writable? #t))
(file-system-mapping
(source "/dev/log")
(target source))
(file-system-mapping
(source dicod.conf)
(target source)))
#:namespaces (delq 'net %namespaces)))) #:namespaces (delq 'net %namespaces))))
(list (shepherd-service (list (shepherd-service
(provision '(dicod)) (provision '(dicod))
(requirement '(user-processes)) (requirement (if home-service?
'()
'(user-processes)))
(documentation "Run the dicod daemon.") (documentation "Run the dicod daemon.")
(start #~(if (defined? 'make-inetd-constructor) (start #~(make-inetd-constructor
(make-inetd-constructor (list #$dicod "--inetd" "--foreground"
(list #$dicod "--inetd" "--foreground" (string-append "--config=" #$dicod.conf))
(string-append "--config=" #$dicod.conf)) (map (lambda (interface)
(map (lambda (interface) (endpoint
(endpoint (addrinfo:addr
(addrinfo:addr (car (getaddrinfo interface "dict")))))
(car (getaddrinfo interface "dict"))))) '#$interfaces)
'#$interfaces) #:requirements '#$requirement
#:requirements '#$requirement #:user #$(and (not home-service?) "dicod")
#:user "dicod" #:group "dicod" #:group #$(and (not home-service?) "dicod")
#:service-name-stem "dicod") #:service-name-stem "dicod"))
(make-forkexec-constructor (stop #~(make-inetd-destructor))
(list #$dicod "--foreground"
(string-append "--config=" #$dicod.conf))
#:user "dicod" #:group "dicod")))
(stop #~(if (defined? 'make-inetd-destructor)
(make-inetd-destructor)
(make-kill-destructor)))
(actions (list (shepherd-configuration-action dicod.conf))))))) (actions (list (shepherd-configuration-action dicod.conf)))))))
(define dicod-service-type (define dicod-service-type
@ -194,8 +196,6 @@ database {
(extensions (extensions
(list (service-extension account-service-type (list (service-extension account-service-type
(const %dicod-accounts)) (const %dicod-accounts))
(service-extension activation-service-type
(const %dicod-activation))
(service-extension shepherd-root-service-type (service-extension shepherd-root-service-type
dicod-shepherd-service))) dicod-shepherd-service)))
(default-value (dicod-configuration)) (default-value (dicod-configuration))

6
gnu/services/guix.scm
View file

@ -365,6 +365,7 @@
#:guile guile)) #:guile guile))
#:user #$user #:user #$user
#:group #$group #:group #$group
#:directory "/var/lib/guix-build-coordinator"
#:pid-file "/var/run/guix-build-coordinator/pid" #:pid-file "/var/run/guix-build-coordinator/pid"
;; Allow time for migrations to run ;; Allow time for migrations to run
#:pid-file-timeout 60 #:pid-file-timeout 60
@ -440,7 +441,7 @@
(shepherd-service (shepherd-service
(documentation "Guix Build Coordinator Agent") (documentation "Guix Build Coordinator Agent")
(provision '(guix-build-coordinator-agent)) (provision '(guix-build-coordinator-agent))
(requirement '(networking)) (requirement '(networking user-processes))
(start (start
#~(lambda _ #~(lambda _
(parameterize ((%current-logfile-date-format "")) (parameterize ((%current-logfile-date-format ""))
@ -697,6 +698,7 @@ ca-certificates.crt file in the system profile."
#:user #$user #:user #$user
#:group #$group #:group #$group
#:directory "/var/lib/guix-data-service"
#:pid-file "/var/run/guix-data-service/pid" #:pid-file "/var/run/guix-data-service/pid"
#:environment-variables #:environment-variables
`(,(string-append `(,(string-append
@ -716,6 +718,7 @@ ca-certificates.crt file in the system profile."
#$@extra-process-jobs-options) #$@extra-process-jobs-options)
#:user #$user #:user #$user
#:group #$group #:group #$group
#:directory "/var/lib/guix-data-service"
#:environment-variables #:environment-variables
`("HOME=/var/lib/guix-data-service" `("HOME=/var/lib/guix-data-service"
"GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
@ -972,6 +975,7 @@ ca-certificates.crt file in the system profile."
'())) '()))
#:user #$user #:user #$user
#:group #$group #:group #$group
#:directory "/var/lib/nar-herder"
#:pid-file "/var/run/nar-herder/pid" #:pid-file "/var/run/nar-herder/pid"
#:environment-variables #:environment-variables
`(,(string-append `(,(string-append

4
gnu/services/linux.scm
View file

@ -174,6 +174,7 @@ representation."
(shepherd-service (shepherd-service
(documentation "Run the Early OOM daemon.") (documentation "Run the Early OOM daemon.")
(provision '(earlyoom)) (provision '(earlyoom))
(requirement '(user-processes))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
'#$(earlyoom-configuration->command-line-args config) '#$(earlyoom-configuration->command-line-args config)
#:log-file "/var/log/earlyoom.log")) #:log-file "/var/log/earlyoom.log"))
@ -192,7 +193,8 @@ representation."
(compose list earlyoom-shepherd-service)) (compose list earlyoom-shepherd-service))
(service-extension rottlog-service-type (service-extension rottlog-service-type
(const %earlyoom-log-rotation)))) (const %earlyoom-log-rotation))))
(description "Run @command{earlyoom}, the Early OOM daemon."))) (description "Run @command{earlyoom}, a daemon that quickly responds to
@acronym{OOM, out-of-memory} conditions by terminating relevant processes.")))
;;; ;;;

81
gnu/services/mcron.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;; ;;;
@ -20,10 +20,8 @@
(define-module (gnu services mcron) (define-module (gnu services mcron)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu packages guile-xyz) #:use-module (gnu packages guile-xyz)
#:use-module (guix deprecation)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -37,6 +35,7 @@
mcron-configuration-log-file mcron-configuration-log-file
mcron-configuration-log-format mcron-configuration-log-format
mcron-configuration-date-format mcron-configuration-date-format
mcron-configuration-home-service?
mcron-service-type)) mcron-service-type))
@ -55,40 +54,34 @@
;;; ;;;
;;; Code: ;;; Code:
(define list-of-gexps? ;; Configuration of mcron.
(list-of gexp?)) ;; XXX: 'define-configuration' cannot be used here due to the need for
;; 'thunked' and 'innate' fields as well as 'this-mcron-configuration'.
(define-record-type* <mcron-configuration> mcron-configuration
make-mcron-configuration
mcron-configuration?
this-mcron-configuration
(define-maybe/no-serialization string) (mcron mcron-configuration-mcron ;file-like
(default mcron))
(jobs mcron-configuration-jobs ;list of gexps
(default '()))
(log? mcron-configuration-log? ;Boolean
(default #t))
(log-file mcron-configuration-log-file ;string | gexp
(thunked)
(default
(if (mcron-configuration-home-service?
this-mcron-configuration)
#~(string-append %user-log-dir "/mcron.log")
"/var/log/mcron.log")))
(log-format mcron-configuration-log-format ;string
(default "~1@*~a ~a: ~a~%"))
(date-format mcron-configuration-date-format ;string | #f
(default #f))
(define-configuration/no-serialization mcron-configuration (home-service? mcron-configuration-home-service?
(mcron (default for-home?) (innate)))
(file-like mcron)
"The mcron package to use.")
(jobs
(list-of-gexps '())
"This is a list of gexps (@pxref{G-Expressions}), where each gexp
corresponds to an mcron job specification (@pxref{Syntax, mcron job
specifications,, mcron, GNU@tie{}mcron}).")
(log?
(boolean #t)
"Log messages to standard output.")
(log-file
(string "/var/log/mcron.log")
"Log file location.")
(log-format
(string "~1@*~a ~a: ~a~%")
"@code{(ice-9 format)} format string for log messages. The default value
produces messages like @samp{@var{pid} @var{name}: @var{message}}
(@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
Each message is also prefixed by a timestamp by GNU Shepherd.")
(date-format
maybe-string
"@code{(srfi srfi-19)} format string for date."))
(define (job-files mcron jobs) (define (job-files mcron jobs)
"Return a list of file-like object for JOBS, a list of gexps." "Return a list of file-like object for JOBS, a list of gexps."
@ -158,24 +151,27 @@ files."
(define (mcron-shepherd-services config) (define (mcron-shepherd-services config)
(match-record config <mcron-configuration> (match-record config <mcron-configuration>
(mcron jobs log? log-file log-format date-format) (mcron jobs log? log-file log-format date-format home-service?)
(if (eq? jobs '()) (if (eq? jobs '())
'() ;nothing to do '() ;nothing to do
(let ((files (job-files mcron jobs))) (let ((files (job-files mcron jobs)))
(list (shepherd-service (list (shepherd-service
(provision '(mcron)) (provision '(mcron))
(requirement '(user-processes)) (requirement (if home-service?
'()
'(user-processes)))
(modules `((srfi srfi-1) (modules `((srfi srfi-1)
(srfi srfi-26) (srfi srfi-26)
(ice-9 popen) ;for the 'schedule' action (ice-9 popen) ;for the 'schedule' action
(ice-9 rdelim) (ice-9 rdelim)
(ice-9 match) (ice-9 match)
((shepherd support) #:select (%user-log-dir))
,@%default-modules)) ,@%default-modules))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$(file-append mcron "/bin/mcron") (list #$(file-append mcron "/bin/mcron")
#$@(if log? #$@(if log?
`("--log" "--log-format" ,log-format `("--log" "--log-format" ,log-format
,@(if (maybe-value-set? date-format) ,@(if date-format
(list "--date-format" (list "--date-format"
date-format) date-format)
'())) '()))
@ -209,15 +205,10 @@ files."
(extend (lambda (config jobs) (extend (lambda (config jobs)
(mcron-configuration (mcron-configuration
(inherit config) (inherit config)
(home-service?
(mcron-configuration-home-service? config))
(jobs (append (mcron-configuration-jobs config) (jobs (append (mcron-configuration-jobs config)
jobs))))) jobs)))))
(default-value (mcron-configuration)))) ;empty job list (default-value (mcron-configuration)))) ;empty job list
;;;
;;; Generate documentation.
;;;
(define (generate-doc)
(configuration->documentation 'mcron-configuration))
;;; mcron.scm ends here ;;; mcron.scm ends here

56
gnu/services/syncthing.scm
View file

@ -49,35 +49,41 @@
(group syncthing-configuration-group ;string (group syncthing-configuration-group ;string
(default "users")) (default "users"))
(home syncthing-configuration-home ;string (home syncthing-configuration-home ;string
(default #f))) (default #f))
(home-service? syncthing-configuration-home-service?
(default for-home?) (innate)))
(define syncthing-shepherd-service (define syncthing-shepherd-service
(match-lambda (match-record-lambda <syncthing-configuration>
(($ <syncthing-configuration> syncthing arguments logflags user group home) (syncthing arguments logflags user group home home-service?)
(list (list
(shepherd-service (shepherd-service
(provision (list (string->symbol (string-append "syncthing-" user)))) (provision (if home-service?
(documentation "Run syncthing.") '(syncthing)
(requirement '(loopback)) (list (string->symbol
(start #~(make-forkexec-constructor (string-append "syncthing-" user)))))
(append (list (string-append #$syncthing "/bin/syncthing") (documentation "Run syncthing.")
"--no-browser" (requirement (if home-service? '() '(loopback)))
"--no-restart" (start #~(make-forkexec-constructor
(string-append "--logflags=" (number->string #$logflags))) (append (list (string-append #$syncthing "/bin/syncthing")
'#$arguments) "--no-browser"
#:user #$user "--no-restart"
#:group #$group (string-append "--logflags=" (number->string #$logflags)))
#:environment-variables '#$arguments)
(append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user)))) #:user #$(and (not home-service?) user)
"SSL_CERT_DIR=/etc/ssl/certs" #:group #$(and (not home-service?) group)
"SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt") #:environment-variables
(remove (lambda (str) (append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user))))
"SSL_CERT_DIR=/etc/ssl/certs"
"SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt")
(filter (negate ;XXX: 'remove' is not in (guile)
(lambda (str)
(or (string-prefix? "HOME=" str) (or (string-prefix? "HOME=" str)
(string-prefix? "SSL_CERT_DIR=" str) (string-prefix? "SSL_CERT_DIR=" str)
(string-prefix? "SSL_CERT_FILE=" str))) (string-prefix? "SSL_CERT_FILE=" str))))
(environ))))) (environ)))))
(respawn? #f) (respawn? #f)
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define syncthing-service-type (define syncthing-service-type
(service-type (name 'syncthing) (service-type (name 'syncthing)

3
gnu/system/accounts.scm
View file

@ -29,6 +29,7 @@
user-account-supplementary-groups user-account-supplementary-groups
user-account-comment user-account-comment
user-account-home-directory user-account-home-directory
user-account-home-directory-permissions
user-account-create-home-directory? user-account-create-home-directory?
user-account-shell user-account-shell
user-account-system? user-account-system?
@ -70,6 +71,8 @@
(comment user-account-comment (default "")) (comment user-account-comment (default ""))
(home-directory user-account-home-directory (thunked) (home-directory user-account-home-directory (thunked)
(default (default-home-directory this-record))) (default (default-home-directory this-record)))
(home-directory-permissions user-account-home-directory-permissions
(default #o700))
(create-home-directory? user-account-create-home-directory? ;Boolean (create-home-directory? user-account-create-home-directory? ;Boolean
(default #t)) (default #t))
(shell user-account-shell ; gexp (shell user-account-shell ; gexp

11
gnu/system/examples/plasma.tmpl
View file

@ -1,7 +1,7 @@
;; This is an operating system configuration template ;; This is an operating system configuration template
;; for a "desktop" setup with Plasma. ;; for a "desktop" setup with Plasma.
(use-modules (gnu) (gnu system nss)) (use-modules (gnu) (gnu system nss) (srfi srfi-1))
(use-service-modules desktop sddm xorg ssh) (use-service-modules desktop sddm xorg ssh)
(use-package-modules certs gnome ssh admin fonts) (use-package-modules certs gnome ssh admin fonts)
(use-package-modules qt xorg tmux linux) (use-package-modules qt xorg tmux linux)
@ -57,8 +57,13 @@
(service sddm-service-type (service sddm-service-type
(sddm-configuration (sddm-configuration
(theme "breeze"))) (theme "breeze")))
(modify-services %desktop-services
(delete gdm-service-type)))) ;; Remove GDM if it's among %DESKTOP-SERVICES; on other
;; architectures, %DESKTOP-SERVICES contains SDDM instead.
(remove (lambda (service)
(memq (service-kind service)
(list gdm-service-type sddm-service-type)))
%desktop-services)))
;; Allow resolution of '.local' host names with mDNS. ;; Allow resolution of '.local' host names with mDNS.
(name-service-switch %mdns-host-lookup-nss)) (name-service-switch %mdns-host-lookup-nss))

19
gnu/system/image.scm
View file

@ -76,6 +76,7 @@
esp32-partition esp32-partition
root-partition root-partition
mbr-disk-image
efi-disk-image efi-disk-image
iso9660-image iso9660-image
docker-image docker-image
@ -84,6 +85,7 @@
raw-with-offset-disk-image raw-with-offset-disk-image
image-with-os image-with-os
mbr-raw-image-type
efi-raw-image-type efi-raw-image-type
efi32-raw-image-type efi32-raw-image-type
qcow2-image-type qcow2-image-type
@ -145,6 +147,15 @@ parent image record."
(flags '(boot)) (flags '(boot))
(initializer (gexp initialize-root-partition)))) (initializer (gexp initialize-root-partition))))
(define mbr-disk-image
(image-without-os
(format 'disk-image)
(partition-table-type 'mbr)
(partitions
(list (partition
(inherit root-partition)
(offset root-offset))))))
(define efi-disk-image (define efi-disk-image
(image-without-os (image-without-os
(format 'disk-image) (format 'disk-image)
@ -201,6 +212,11 @@ set to the given OS."
(inherit base-image) (inherit base-image)
(operating-system os))) (operating-system os)))
(define mbr-raw-image-type
(image-type
(name 'mbr-raw)
(constructor (cut image-with-os mbr-disk-image <>))))
(define efi-raw-image-type (define efi-raw-image-type
(image-type (image-type
(name 'efi-raw) (name 'efi-raw)
@ -216,8 +232,7 @@ set to the given OS."
(name 'qcow2) (name 'qcow2)
(constructor (cut image-with-os (constructor (cut image-with-os
(image (image
(inherit efi-disk-image) (inherit mbr-disk-image)
(partition-table-type 'mbr)
(name 'image.qcow2) (name 'image.qcow2)
(format 'compressed-qcow2)) (format 'compressed-qcow2))
<>)))) <>))))

4
gnu/tests/install.scm
View file

@ -229,7 +229,7 @@ reboot\n")
(gnu installer tests) (gnu installer tests)
(guix combinators)))) (guix combinators))))
(uefi-support? #f) (uefi-support? #f)
(installation-image-type 'efi-raw) (installation-image-type 'mbr-raw)
(install-size 'guess) (install-size 'guess)
(target-size (* 2200 MiB)) (target-size (* 2200 MiB))
(number-of-disks 1)) (number-of-disks 1))
@ -291,7 +291,7 @@ such as for RAID systems."
'("-bios" #$uefi-firmware) '("-bios" #$uefi-firmware)
'()) '())
#$@(cond #$@(cond
((eq? 'efi-raw installation-image-type) ((eq? 'mbr-raw installation-image-type)
#~("-drive" #~("-drive"
,(string-append "file=" #$image ,(string-append "file=" #$image
",if=virtio,readonly"))) ",if=virtio,readonly")))

15
guix/download.scm
View file

@ -51,7 +51,10 @@
;;; Code: ;;; Code:
(define %mirrors (define %mirrors
;; Mirror lists used when `mirror://' URLs are passed. ;; Mirror lists used when `mirror://' URLs are passed. The first mirror
;; entry of each set should ideally be the most authoritative one, as that's
;; what the generic HTML updater will pick to look for updates, with
;; possible exceptions when the authoritative mirror is too slow.
(let* ((gnu-mirrors (let* ((gnu-mirrors
'(;; This one redirects to a (supposedly) nearby and (supposedly) '(;; This one redirects to a (supposedly) nearby and (supposedly)
;; up-to-date mirror. ;; up-to-date mirror.
@ -358,7 +361,15 @@
"https://mirror.esc7.net/pub/OpenBSD/") "https://mirror.esc7.net/pub/OpenBSD/")
(mate (mate
"https://pub.mate-desktop.org/releases/" "https://pub.mate-desktop.org/releases/"
"http://pub.mate-desktop.org/releases/")))) "http://pub.mate-desktop.org/releases/")
(qt
"https://mirrors.ocf.berkeley.edu/qt/official_releases/"
"https://ftp.jaist.ac.jp/pub/qtproject/official_releases/"
"https://ftp.nluug.nl/languages/qt/official_releases/"
"https://mirrors.cloud.tencent.com/qt/official_releases/"
"https://mirrors.sjtug.sjtu.edu.cn/qt/official_releases/"
"https://qtproject.mirror.liquidtelecom.com/official_releases/"
"https://download.qt.io/official_releases/")))) ;slow
(define %mirror-file (define %mirror-file
;; Copy of the list of mirrors to a file. This allows us to keep a single ;; Copy of the list of mirrors to a file. This allows us to keep a single

330
guix/gnu-maintenance.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
@ -61,6 +63,7 @@
gnu-package? gnu-package?
uri-mirror-rewrite uri-mirror-rewrite
rewrite-url
release-file? release-file?
releases releases
@ -255,8 +258,7 @@ network to check in GNU's database."
(make-regexp "^.*-.*[0-9](-|~|\\.)?(alpha|beta|rc|RC|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) (make-regexp "^.*-.*[0-9](-|~|\\.)?(alpha|beta|rc|RC|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
(define (release-file? project file) (define (release-file? project file)
"Return #f if FILE is not a release tarball of PROJECT, otherwise return "Return true if FILE is a release tarball of PROJECT."
true."
(and (not (member (file-extension file) (and (not (member (file-extension file)
'("sig" "sign" "asc" '("sig" "sign" "asc"
"md5sum" "sha1sum" "sha256sum"))) "md5sum" "sha1sum" "sha256sum")))
@ -265,12 +267,21 @@ true."
;; Filter out unrelated files, like `guile-www-1.1.1'. ;; Filter out unrelated files, like `guile-www-1.1.1'.
;; Case-insensitive for things like "TeXmacs" vs. "texmacs". ;; Case-insensitive for things like "TeXmacs" vs. "texmacs".
;; The "-src" suffix is for "freefont-src-20120503.tar.gz". ;; The "-src" suffix is for "freefont-src-20120503.tar.gz".
;; The '-everywhere-src' suffix is for Qt modular components.
(and=> (match:substring match 1) (and=> (match:substring match 1)
(lambda (name) (lambda (name)
(or (string-ci=? name project) (or (string-ci=? name project)
(string-ci=? name (string-ci=? name (string-append project "-src"))
(string-append project (string-ci=?
"-src"))))))) name (string-append project "-everywhere-src"))
;; For older Qt releases such as version 5.
(string-ci=?
name (string-append
project "-everywhere-opensource-src"))
;; For Qt Creator.
(string-ci=?
name (string-append
project "-opensource-src")))))))
(not (regexp-exec %alpha-tarball-rx file)) (not (regexp-exec %alpha-tarball-rx file))
(let ((s (tarball-sans-extension file))) (let ((s (tarball-sans-extension file)))
(regexp-exec %package-name-rx s)))) (regexp-exec %package-name-rx s))))
@ -483,14 +494,133 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
(_ (_
links)))) links))))
(define* (import-html-release package (define (url->links url)
"Return the unique links on the HTML page accessible at URL."
(let* ((uri (string->uri url))
(port (http-fetch/cached uri #:ttl 3600))
(sxml (html->sxml port)))
(close-port port)
(delete-duplicates (html-links sxml))))
(define (canonicalize-url url base-url)
"Make relative URL absolute, by appending URL to BASE-URL as required. If
URL is a directory instead of a file, it should be suffixed with a slash (/)."
(cond ((and=> (string->uri url) uri-scheme)
;; Fully specified URL.
url)
((string-prefix? "//" url)
;; Full URL lacking a URI scheme. Reuse the URI scheme of the
;; document that contains the URL.
(string-append (symbol->string (uri-scheme (string->uri base-url)))
":" url))
((string-prefix? "/" url)
;; Absolute URL.
(let ((uri (string->uri base-url)))
(uri->string
(build-uri (uri-scheme uri)
#:host (uri-host uri)
#:port (uri-port uri)
#:path url))))
;; URL is relative to BASE-URL, which is assumed to be a directory.
((string-suffix? "/" base-url)
(string-append base-url url))
(else
;; URL is relative to BASE-URL, which is assumed to denote a file
;; within a directory.
(string-append (dirname base-url) "/" url))))
(define (strip-trailing-slash s)
"Strip any trailing slash from S, a string."
(if (string-suffix? "/" s)
(string-drop-right s 1)
s))
;;; TODO: Extend to support the RPM and GNOME version schemes?
(define %version-rx "[0-9.]+")
(define* (rewrite-url url version #:key to-version)
"Rewrite URL so that the URL path components matching the current VERSION or
VERSION-MAJOR.VERSION-MINOR are updated with that of the latest version found
by crawling the corresponding URL directories. Alternatively, when TO-VERSION
is specified, rewrite version matches directly to it without crawling URL.
For example, the URL
\"https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz\" could be
rewritten to something like
\"https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz\"."
;; XXX: major-minor may be #f if version is not a triplet but a single
;; number such as "2".
(let* ((major-minor (false-if-exception (version-major+minor version)))
(to-major-minor (false-if-exception
(and=> to-version version-major+minor)))
(uri (string->uri url))
(url-prefix (string-drop-right url (string-length (uri-path uri))))
(url-prefix-components (string-split url-prefix #\/))
(path (uri-path uri))
;; Strip a forward slash on the path to avoid a double slash when
;; string-joining later.
(path (if (string-prefix? "/" path)
(string-drop path 1)
path))
(path-components (string-split path #\/)))
(string-join
(reverse
(fold
(lambda (s parents)
(if to-version
;; Direct rewrite case; the archive is assumed to exist.
(let ((u (string-replace-substring s version to-version)))
(cons (if (and major-minor to-major-minor)
(string-replace-substring u major-minor to-major-minor)
u)
parents))
;; More involved HTML crawl case.
(let* ((pattern (if major-minor
(format #f "(~a|~a)" version major-minor)
(format #f "(~a)" version)))
(m (string-match pattern s)))
(if m
;; Crawl parent and rewrite current component.
(let* ((parent-url (string-join (reverse parents) "/"))
(links (url->links parent-url))
;; The pattern matching the version.
(pattern (string-append "^" (match:prefix m)
"(" %version-rx ")"
(match:suffix m) "$"))
(candidates (filter-map
(lambda (l)
;; Links may be followed by a
;; trailing '/' in the case of
;; directories.
(and-let*
((l (strip-trailing-slash l))
(m (string-match pattern l))
(v (match:substring m 1)))
(cons v l)))
links)))
;; Retrieve the item having the largest version.
(if (null? candidates)
(error "no candidates found in rewrite-url")
(cons (cdr (first (sort candidates
(lambda (x y)
(version>? (car x)
(car y))))))
parents)))
;; No version found in path component; continue.
(cons s parents)))))
(reverse url-prefix-components)
path-components))
"/")))
(define* (import-html-release base-url package
#:key #:key
(version #f) rewrite-url?
(base-url "https://kernel.org/pub") version
(directory (string-append "/" package)) (directory (string-append
"/" (package-upstream-name package)))
file->signature) file->signature)
"Return an <upstream-source> for the latest release of PACKAGE (a string) on "Return an <upstream-source> for the latest release of PACKAGE under
SERVER under DIRECTORY, or #f. Optionally include a VERSION string to fetch a DIRECTORY at BASE-URL, or #f. Optionally include a VERSION string to fetch a
specific version. specific version.
BASE-URL should be the URL of an HTML page, typically a directory listing as BASE-URL should be the URL of an HTML page, typically a directory listing as
@ -499,14 +629,23 @@ found on 'https://kernel.org/pub'.
When FILE->SIGNATURE is omitted or #f, guess the detached signature file name, When FILE->SIGNATURE is omitted or #f, guess the detached signature file name,
if any. Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source if any. Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
file URL and must return the corresponding signature URL, or #f it signatures file URL and must return the corresponding signature URL, or #f it signatures
are unavailable." are unavailable.
(let* ((uri (string->uri (if (string-null? directory)
base-url When REWRITE-URL? is #t, versioned components in BASE-URL and/or DIRECTORY are
(string-append base-url directory "/")))) also updated to the latest version, as explained in the doc of the
(port (http-fetch/cached uri #:ttl 3600)) \"rewrite-url\" procedure used."
(sxml (html->sxml port)) (let* ((current-version (package-version package))
(links (delete-duplicates (html-links sxml)))) (name (package-upstream-name package))
(url (if (string-null? directory)
base-url
(string-append base-url directory "/")))
(url (if rewrite-url?
(rewrite-url url current-version #:to-version version)
url))
(links (map (cut canonicalize-url <> url) (url->links url))))
(define (file->signature/guess url) (define (file->signature/guess url)
"Return the first link that matches a signature extension, else #f."
(let ((base (basename url))) (let ((base (basename url)))
(any (lambda (link) (any (lambda (link)
(any (lambda (extension) (any (lambda (extension)
@ -517,41 +656,13 @@ are unavailable."
links))) links)))
(define (url->release url) (define (url->release url)
(let* ((base (basename url)) "Return an <upstream-source> object if a release file was found at URL,
(base-url (string-append base-url directory)) else #f. URL is assumed to fully specified."
(url (cond ((and=> (string->uri url) uri-scheme) ;full URL? (let ((base (basename url)))
url) (and (release-file? name base)
;; full URL, except for URI scheme. Reuse the URI
;; scheme of the document that contains the link.
((string-prefix? "//" url)
(string-append
(symbol->string (uri-scheme (string->uri base-url)))
":" url))
((string-prefix? "/" url) ;absolute path?
(let ((uri (string->uri base-url)))
(uri->string
(build-uri (uri-scheme uri)
#:host (uri-host uri)
#:port (uri-port uri)
#:path url))))
;; URL is a relative path and BASE-URL may or may not
;; end in slash.
((string-suffix? "/" base-url)
(string-append base-url url))
(else
;; If DIRECTORY is non-empty, assume BASE-URL
;; denotes a directory; otherwise, assume BASE-URL
;; denotes a file within a directory, and that URL
;; is relative to that directory.
(string-append (if (string-null? directory)
(dirname base-url)
base-url)
"/" url)))))
(and (release-file? package base)
(let ((version (tarball->version base))) (let ((version (tarball->version base)))
(upstream-source (upstream-source
(package package) (package name)
(version version) (version version)
;; uri-mirror-rewrite: Don't turn nice mirror:// URIs into ftp:// ;; uri-mirror-rewrite: Don't turn nice mirror:// URIs into ftp://
;; URLs during "guix refresh -u". ;; URLs during "guix refresh -u".
@ -563,22 +674,21 @@ are unavailable."
(define candidates (define candidates
(filter-map url->release links)) (filter-map url->release links))
(close-port port)
(match candidates (match candidates
(() #f) (() #f)
((first . _) ((first . _)
(if version (if version
;; find matching release version and return it ;; Find matching release version and return it.
(find (lambda (upstream) (find (lambda (upstream)
(string=? (upstream-source-version upstream) version)) (string=? (upstream-source-version upstream) version))
(coalesce-sources candidates)) (coalesce-sources candidates))
;; Select the most recent release and return it. ;; Select the most recent release and return it.
(reduce (lambda (r1 r2) (reduce (lambda (r1 r2)
(if (version>? (upstream-source-version r1) (if (version>? (upstream-source-version r1)
(upstream-source-version r2)) (upstream-source-version r2))
r1 r2)) r1 r2))
first first
(coalesce-sources candidates))))))) (coalesce-sources candidates)))))))
;;; ;;;
@ -652,20 +762,20 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
(tarballs (filter (lambda (file) (tarballs (filter (lambda (file)
(string=? version (tarball->version file))) (string=? version (tarball->version file)))
relevant))) relevant)))
(match tarballs (match tarballs
(() #f) (() #f)
(_ (_
(upstream-source (upstream-source
(package name) (package name)
(version version) (version version)
(urls (map (lambda (file) (urls (map (lambda (file)
(string-append "mirror://gnu/" (string-append "mirror://gnu/"
(string-drop file (string-drop file
(string-length "/gnu/")))) (string-length "/gnu/"))))
;; Sort so that the tarball with the same compression ;; Sort so that the tarball with the same compression
;; format as currently used in PACKAGE comes first. ;; format as currently used in PACKAGE comes first.
(sort tarballs better-tarball?))) (sort tarballs better-tarball?)))
(signature-urls (map (cut string-append <> ".sig") urls)))))))) (signature-urls (map (cut string-append <> ".sig") urls))))))))
(define %package-name-rx (define %package-name-rx
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
@ -726,13 +836,11 @@ to fetch a specific version."
(match (origin-uri (package-source package)) (match (origin-uri (package-source package))
((? string? uri) uri) ((? string? uri) uri)
((uri mirrors ...) uri)))) ((uri mirrors ...) uri))))
(package (package-upstream-name package))
(directory (dirname (uri-path uri)))) (directory (dirname (uri-path uri))))
;; Note: We use the default 'file->signature', which adds ".sig", ".asc", ;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
;; or whichever detached signature naming scheme PACKAGE uses. ;; or whichever detached signature naming scheme PACKAGE uses.
(import-html-release package (import-html-release %savannah-base package
#:version version #:version version
#:base-url %savannah-base
#:directory directory))) #:directory directory)))
(define* (latest-sourceforge-release package #:key (version #f)) (define* (latest-sourceforge-release package #:key (version #f))
@ -808,7 +916,7 @@ to fetch a specific version."
(string-append "/pub/xorg/" (dirname (uri-path uri))))))) (string-append "/pub/xorg/" (dirname (uri-path uri)))))))
(define* (import-kernel.org-release package #:key (version #f)) (define* (import-kernel.org-release package #:key (version #f))
"Return the latest release of PACKAGE, the name of a kernel.org package. "Return the latest release of PACKAGE, a Linux kernel package.
Optionally include a VERSION string to fetch a specific version." Optionally include a VERSION string to fetch a specific version."
(define %kernel.org-base (define %kernel.org-base
;; This URL and sub-directories thereof are nginx-generated directory ;; This URL and sub-directories thereof are nginx-generated directory
@ -822,35 +930,49 @@ Optionally include a VERSION string to fetch a specific version."
(match (origin-uri (package-source package)) (match (origin-uri (package-source package))
((? string? uri) uri) ((? string? uri) uri)
((uri mirrors ...) uri)))) ((uri mirrors ...) uri))))
(package (package-upstream-name package))
(directory (dirname (uri-path uri)))) (directory (dirname (uri-path uri))))
(import-html-release package (import-html-release %kernel.org-base package
#:version version #:version version
#:base-url %kernel.org-base
#:directory directory #:directory directory
#:file->signature file->signature))) #:file->signature file->signature)))
(define html-updatable-package? ;;; These sites are disallowed for the generic HTML updater as there are
;; Return true if the given package may be handled by the generic HTML ;;; better means to query them.
;; updater. (define %disallowed-hosting-sites
(let ((hosting-sites '("github.com" "github.io" "gitlab.com" '("github.com" "github.io" "gitlab.com"
"notabug.org" "sr.ht" "gitlab.inria.fr" "notabug.org" "sr.ht" "gitlab.inria.fr"
"ftp.gnu.org" "download.savannah.gnu.org" "ftp.gnu.org" "download.savannah.gnu.org"
"pypi.org" "crates.io" "rubygems.org" "pypi.org" "crates.io" "rubygems.org"
"bioconductor.org"))) "bioconductor.org"))
(define http-url?
(url-predicate (lambda (url)
(match (string->uri url)
(#f #f)
(uri
(let ((scheme (uri-scheme uri))
(host (uri-host uri)))
(and (memq scheme '(http https))
(not (member host hosting-sites)))))))))
(lambda (package) (define (http-url? url)
(or (assoc-ref (package-properties package) 'release-monitoring-url) "Return URL if URL has HTTP or HTTPS as its protocol. If URL uses the
(http-url? package))))) special mirror:// protocol, substitute it with the first HTTP or HTTPS URL
prefix from its set."
(match (string->uri url)
(#f #f)
(uri
(let ((scheme (uri-scheme uri))
(host (uri-host uri)))
(or (and (memq scheme '(http https))
;; HOST may contain prefixes, e.g. "profanity-im.github.io",
;; hence the suffix-based test below.
(not (any (cut string-suffix? <> host)
%disallowed-hosting-sites))
url)
(and (eq? scheme 'mirror)
(and=> (find http-url?
(assoc-ref %mirrors
(string->symbol host)))
(lambda (url)
(string-append (strip-trailing-slash url)
(uri-path uri))))))))))
(define (html-updatable-package? package)
"Return true if the given package may be handled by the generic HTML
updater."
(or (assoc-ref (package-properties package) 'release-monitoring-url)
((url-predicate http-url?) package)))
(define* (import-html-updatable-release package #:key (version #f)) (define* (import-html-updatable-release package #:key (version #f))
"Return the latest release of PACKAGE. Do that by crawling the HTML page of "Return the latest release of PACKAGE. Do that by crawling the HTML page of
@ -858,6 +980,9 @@ the directory containing its source tarball. Optionally include a VERSION
string to fetch a specific version." string to fetch a specific version."
(let* ((uri (string->uri (let* ((uri (string->uri
(match (origin-uri (package-source package)) (match (origin-uri (package-source package))
((? (cut string-prefix? "mirror://" <>) url)
;; Retrieve the authoritative HTTP URL from a mirror.
(http-url? url))
((? string? url) url) ((? string? url) url)
((url _ ...) url)))) ((url _ ...) url))))
(custom (assoc-ref (package-properties package) (custom (assoc-ref (package-properties package)
@ -867,12 +992,11 @@ string to fetch a specific version."
"://" (uri-host uri)))) "://" (uri-host uri))))
(directory (if custom (directory (if custom
"" ""
(dirname (uri-path uri)))) (dirname (uri-path uri)))))
(package (package-upstream-name package)))
(false-if-networking-error (false-if-networking-error
(import-html-release package (import-html-release base package
#:rewrite-url? #t
#:version version #:version version
#:base-url base
#:directory directory)))) #:directory directory))))
(define %gnu-updater (define %gnu-updater

36
guix/graph.scm
View file

@ -29,6 +29,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 string-fun)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:export (node-type #:export (node-type
node-type? node-type?
@ -49,6 +50,7 @@
%graph-backends %graph-backends
%d3js-backend %d3js-backend
%graphviz-backend %graphviz-backend
%graphml-backend
lookup-backend lookup-backend
graph-backend? graph-backend?
@ -328,6 +330,37 @@ nodeArray.push(nodes[\"~a\"]);~%"
emit-cypher-prologue emit-cypher-epilogue emit-cypher-prologue emit-cypher-epilogue
emit-cypher-node emit-cypher-edge)) emit-cypher-node emit-cypher-edge))
;;;
;;; GraphML export.
;;;
(define (emit-graphml-prologue name port)
(format port "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns
http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">
<graph id=\"G\" edgedefault=\"directed\">~%"))
(define (emit-graphml-epilogue port)
(format port " </graph>
</graphml>"))
(define (emit-graphml-node id label port)
(format port " <node id=\"~a\"/>~%"
(string-replace-substring (object->string id) "\"" "\\\"")))
(define (emit-graphml-edge id1 id2 port)
(format port " <edge source=\"~a\" target=\"~a\"/>~%"
(string-replace-substring (object->string id1) "\"" "\\\"")
(string-replace-substring (object->string id2) "\"" "\\\"")))
(define %graphml-backend
(graph-backend "graphml"
"Generate GraphML."
emit-graphml-prologue emit-graphml-epilogue
emit-graphml-node emit-graphml-edge))
;;; ;;;
@ -337,7 +370,8 @@ nodeArray.push(nodes[\"~a\"]);~%"
(define %graph-backends (define %graph-backends
(list %graphviz-backend (list %graphviz-backend
%d3js-backend %d3js-backend
%cypher-backend)) %cypher-backend
%graphml-backend))
(define (lookup-backend name) (define (lookup-backend name)
"Return the graph backend called NAME. Raise an error if it is not found." "Return the graph backend called NAME. Raise an error if it is not found."

2
guix/profiles.scm
View file

@ -1786,7 +1786,7 @@ MANIFEST."
(if (string-prefix? "texlive-" name) (if (string-prefix? "texlive-" name)
(cons (gexp-input thing output) (cons (gexp-input thing output)
(append-map entry->texlive-input deps)) (append-map entry->texlive-input deps))
'())))) (append-map entry->texlive-input deps)))))
(define texlive-scripts-entry? (define texlive-scripts-entry?
(match-lambda (match-lambda
(($ <manifest-entry> name version output thing deps) (($ <manifest-entry> name version output thing deps)

2
guix/scripts/system.scm
View file

@ -1169,7 +1169,7 @@ Some ACTIONS support additional ARGS.\n"))
(debug . 0) (debug . 0)
(verbosity . #f) ;default (verbosity . #f) ;default
(validate-reconfigure . ,ensure-forward-reconfigure) (validate-reconfigure . ,ensure-forward-reconfigure)
(image-type . efi-raw) (image-type . mbr-raw)
(image-size . guess) (image-size . guess)
(install-bootloader? . #t) (install-bootloader? . #t)
(label . #f) (label . #f)

5
guix/ssh.scm
View file

@ -175,8 +175,9 @@ to SSH server at '~a'")
(disconnect! session) (disconnect! session)
(raise (condition (raise (condition
(&message (&message
(message (format #f (G_ "SSH authentication failed for '~a': ~a~%") (message (format #f (G_ "SSH authentication failed for '~a@~a': ~a~%")
host (get-error session))))))))))) (session-get session 'user) host
(get-error session)))))))))))
(x (x
;; Connection failed or timeout expired. ;; Connection failed or timeout expired.
(raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%") (raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%")

48
tests/gnu-maintenance.scm
View file

@ -40,7 +40,10 @@
("exiv2" "exiv2-0.27.3-Source.tar.gz") ("exiv2" "exiv2-0.27.3-Source.tar.gz")
("mpg321" "mpg321_0.3.2.orig.tar.gz") ("mpg321" "mpg321_0.3.2.orig.tar.gz")
("bvi" "bvi-1.4.1.src.tar.gz") ("bvi" "bvi-1.4.1.src.tar.gz")
("hostscope" "hostscope-V2.1.tgz"))) ("hostscope" "hostscope-V2.1.tgz")
("qtbase" "qtbase-everywhere-src-6.5.2.tar.xz")
("qtbase" "qtbase-everywhere-opensource-src-5.15.10.tar.xz")
("qt-creator" "qt-creator-opensource-src-11.0.1.tar.xz")))
(every (lambda (project+file) (every (lambda (project+file)
(not (apply release-file? project+file))) (not (apply release-file? project+file)))
'(("guile" "guile-www-1.1.1.tar.gz") '(("guile" "guile-www-1.1.1.tar.gz")
@ -147,4 +150,47 @@
(equal? (list expected-signature-url) (equal? (list expected-signature-url)
(upstream-source-signature-urls update)))))) (upstream-source-signature-urls update))))))
(test-equal "rewrite-url, to-version specified"
"https://download.qt.io/official_releases/qt/6.5/6.5.2/\
submodules/qtbase-everywhere-src-6.5.2.tar.xz"
(rewrite-url "https://download.qt.io/official_releases/qt/6.3/6.3.2/\
submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
(test-equal "rewrite-url, without to-version"
"https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
(with-http-server
;; First reply, crawling https://dist.libuv.org/dist/.
`((200 "\
<!DOCTYPE html>
<html>
<head><title>Index of dist</title></head>
<body>
<a href=\"../\">../</a>
<a href=\"v1.44.0/\" title=\"v1.44.0/\">v1.44.0/</a>
<a href=\"v1.44.1/\" title=\"v1.44.1/\">v1.44.1/</a>
<a href=\"v1.44.2/\" title=\"v1.44.2/\">v1.44.2/</a>
<a href=\"v1.45.0/\" title=\"v1.45.0/\">v1.45.0/</a>
<a href=\"v1.46.0/\" title=\"v1.46.0/\">v1.46.0/</a>
</body>
</html>")
;; Second reply, crawling https://dist.libuv.org/dist/v1.46.0/.
(200 "\
<!DOCTYPE html>
<html>
<head><title>Index of dist/v1.46.0</title></head>
<body>
<a href=\"../\">../</a>
<a href=\"libuv-v1.46.0-dist.tar.gz\" title=\"libuv-v1.46.0-dist.tar.gz\">
libuv-v1.46.0-dist.tar.gz</a>
<a href=\"libuv-v1.46.0-dist.tar.gz.sign\"
title=\"libuv-v1.46.0-dist.tar.gz.sign\">libuv-v1.46.0-dist.tar.gz.sign</a>
<a href=\"libuv-v1.46.0.tar.gz\" title=\"libuv-v1.46.0.tar.gz\">
libuv-v1.46.0.tar.gz</a>
<a href=\"libuv-v1.46.0.tar.gz.sign\" title=\"libuv-v1.46.0.tar.gz.sign\">
libuv-v1.46.0.tar.gz.sign</a>
</body>
</html>"))
(rewrite-url "https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
"1.45.0")))
(test-end) (test-end)

24
tests/graph.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -377,7 +377,8 @@ edges."
(((labels packages _ ...) ...) (((labels packages _ ...) ...)
packages))))))))) packages)))))))))
(test-assert "node-transitive-edges + node-back-edges" (test-equal "node-transitive-edges + node-back-edges"
'()
(run-with-store %store (run-with-store %store
(let ((packages (fold-packages cons '())) (let ((packages (fold-packages cons '()))
(bootstrap? (lambda (package) (bootstrap? (lambda (package)
@ -386,17 +387,22 @@ edges."
"bootstrap.scm"))) "bootstrap.scm")))
(trivial? (lambda (package) (trivial? (lambda (package)
(eq? (package-build-system package) (eq? (package-build-system package)
trivial-build-system)))) trivial-build-system)))
(system-specific? (lambda (package)
(memq #:system (package-arguments package)))))
(mlet %store-monad ((edges (node-back-edges %bag-node-type packages))) (mlet %store-monad ((edges (node-back-edges %bag-node-type packages)))
(let* ((glibc (canonical-package glibc)) (let* ((glibc (canonical-package glibc))
(dependents (node-transitive-edges (list glibc) edges)) (dependents (node-transitive-edges (list glibc) edges))
(diff (lset-difference eq? packages dependents))) (diff (lset-difference eq? packages dependents)))
;; All the packages depend on libc, except bootstrap packages and ;; All the packages depend on libc, except bootstrap packages, some
;; some that use TRIVIAL-BUILD-SYSTEM. ;; packages that use TRIVIAL-BUILD-SYSTEM, and some that target a
(return (null? (remove (lambda (package) ;; specific system and thus may depend on a different libc package
(or (trivial? package) ;; object.
(bootstrap? package))) (return (remove (lambda (package)
diff)))))))) (or (trivial? package)
(bootstrap? package)
(system-specific? package)))
diff)))))))
(test-assert "node-transitive-edges, no duplicates" (test-assert "node-transitive-edges, no duplicates"
(run-with-store %store (run-with-store %store

2
tests/guix-home.sh
View file

@ -224,5 +224,5 @@ EOF
# #
guix home search mcron | grep "^name: home-mcron" guix home search mcron | grep "^name: home-mcron"
guix home search job manager | grep "^name: home-mcron" guix home search scheduling daemon | grep "^name: home-mcron"
) )

2
tests/guix-shell.sh
View file

@ -48,7 +48,7 @@ guix shell -s armhf-linux intelmetool -n && false
# opens a couple of extra FDs. # opens a couple of extra FDs.
initial_fd_list="$(echo /proc/$$/fd/*)" initial_fd_list="$(echo /proc/$$/fd/*)"
fd_list="$(guix shell --bootstrap guile-bootstrap -- \ fd_list="$(guix shell --bootstrap guile-bootstrap -- \
"$SHELL" -c 'echo /proc/$$/fd/*')" bash -c 'echo /proc/$$/fd/*')"
test "$(echo $fd_list | wc -w)" -le "$(echo $initial_fd_list | wc -w)" test "$(echo $fd_list | wc -w)" -le "$(echo $initial_fd_list | wc -w)"
# Ignoring unauthorized files. # Ignoring unauthorized files.