me/guix
Archived
1
0
Fork 0
Code Activity

Merge branch 'master' into staging

Browse source
This commit is contained in:
Marius Bakke 2022-12-02 19:13:45 +01:00
commit f2b6350a50
No known key found for this signature in database
GPG key ID: A2A06DF2A33A54FA
92 changed files with 7347 additions and 3917 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -237,6 +237,7 @@ MODULES = \
guix/build/waf-build-system.scm \ guix/build/waf-build-system.scm \
guix/build/haskell-build-system.scm \ guix/build/haskell-build-system.scm \
guix/build/julia-build-system.scm \ guix/build/julia-build-system.scm \
guix/build/kconfig.scm \
guix/build/linux-module-build-system.scm \ guix/build/linux-module-build-system.scm \
guix/build/store-copy.scm \ guix/build/store-copy.scm \
guix/build/json.scm \ guix/build/json.scm \
@ -439,6 +440,8 @@ EXAMPLES = \
gnu/system/examples/desktop.tmpl \ gnu/system/examples/desktop.tmpl \
gnu/system/examples/lightweight-desktop.tmpl \ gnu/system/examples/lightweight-desktop.tmpl \
gnu/system/examples/docker-image.tmpl \ gnu/system/examples/docker-image.tmpl \
gnu/system/examples/raspberry-pi-64.tmpl \
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl \
gnu/system/examples/vm-image.tmpl gnu/system/examples/vm-image.tmpl
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go) GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)

7
doc/contributing.texi
View file

@ -1089,11 +1089,16 @@ and then to browse them ``by hand'' using @code{car}, @code{cdr},
notably the fact that it is hard to read, error-prone, and a hindrance notably the fact that it is hard to read, error-prone, and a hindrance
to proper type error reports. to proper type error reports.
@findex define-record-type*
@findex match-record
@cindex pattern matching
Guix code should define appropriate data types (for instance, using Guix code should define appropriate data types (for instance, using
@code{define-record-type*}) rather than abuse lists. In addition, it @code{define-record-type*}) rather than abuse lists. In addition, it
should use pattern matching, via Guile’s @code{(ice-9 match)} module, should use pattern matching, via Guile’s @code{(ice-9 match)} module,
especially when matching lists (@pxref{Pattern Matching,,, guile, GNU especially when matching lists (@pxref{Pattern Matching,,, guile, GNU
Guile Reference Manual}). Guile Reference Manual}); pattern matching for records is better done
using @code{match-record} from @code{(guix records)}, which, unlike
@code{match}, verifies field names at macro-expansion time.
@node Formatting Code @node Formatting Code
@subsection Formatting Code @subsection Formatting Code

77
doc/guix.texi
View file

@ -18409,9 +18409,6 @@ udev rules can be provided as a list of files through the @var{rules}
variable. The procedures @code{udev-rule}, @code{udev-rules-service} variable. The procedures @code{udev-rule}, @code{udev-rules-service}
and @code{file->udev-rule} from @code{(gnu services base)} simplify the and @code{file->udev-rule} from @code{(gnu services base)} simplify the
creation of such rule files. creation of such rule files.
The @command{herd rules udev} command, as root, returns the name of the
directory containing all the active udev rules.
@end deffn @end deffn
@deffn {Scheme Procedure} udev-rule [@var{file-name} @var{contents}] @deffn {Scheme Procedure} udev-rule [@var{file-name} @var{contents}]
@ -18940,9 +18937,8 @@ gexps to introduce job definitions that are passed to mcron
;; job's action as a Scheme procedure. ;; job's action as a Scheme procedure.
#~(job '(next-hour '(3)) #~(job '(next-hour '(3))
(lambda () (lambda ()
(execl (string-append #$findutils "/bin/updatedb") (system* (string-append #$findutils "/bin/updatedb")
"updatedb" "--prunepaths=/tmp /var/tmp /gnu/store"))
"--prunepaths=/tmp /var/tmp /gnu/store"))
"updatedb")) "updatedb"))
(define garbage-collector-job (define garbage-collector-job
@ -18980,6 +18976,12 @@ the job would appear as ``Lambda function'' in the output of
@command{herd schedule mcron}, which is not nearly descriptive enough! @command{herd schedule mcron}, which is not nearly descriptive enough!
@end quotation @end quotation
@quotation Tip
Avoid calling the Guile procedures @code{execl}, @code{execle} or
@code{execlp} inside a job specification, else mcron won't be able to
output the completion status of the job.
@end quotation
For more complex jobs defined in Scheme where you need control over the top For more complex jobs defined in Scheme where you need control over the top
level, for instance to introduce a @code{use-modules} form, you can move your level, for instance to introduce a @code{use-modules} form, you can move your
code to a separate program using the @code{program-file} procedure of the code to a separate program using the @code{program-file} procedure of the
@ -19581,6 +19583,10 @@ This is the list of available plugins for virtual private networks
(VPNs). An example of this is the @code{network-manager-openvpn} (VPNs). An example of this is the @code{network-manager-openvpn}
package, which allows NetworkManager to manage VPNs @i{via} OpenVPN. package, which allows NetworkManager to manage VPNs @i{via} OpenVPN.
@item @code{iwd?} (default: @code{#f})
NetworkManager will use iwd as a backend for wireless networking if this
option is set to @code{#t}, otherwise it will use wpa-supplicant.
@end table @end table
@end deftp @end deftp
@ -37991,8 +37997,9 @@ The type of a bootloader configuration declaration.
@cindex BIOS, bootloader @cindex BIOS, bootloader
The bootloader to use, as a @code{bootloader} object. For now The bootloader to use, as a @code{bootloader} object. For now
@code{grub-bootloader}, @code{grub-efi-bootloader}, @code{grub-bootloader}, @code{grub-efi-bootloader},
@code{grub-efi-netboot-bootloader}, @code{grub-efi-removable-bootloader}, @code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
@code{extlinux-bootloader} and @code{u-boot-bootloader} are supported. @code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
and @code{u-boot-bootloader} are supported.
@cindex ARM, bootloaders @cindex ARM, bootloaders
@cindex AArch64, bootloaders @cindex AArch64, bootloaders
@ -38001,15 +38008,29 @@ modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
of bootloaders for a wide range of ARM and AArch64 systems, using the of bootloaders for a wide range of ARM and AArch64 systems, using the
@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}. @uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
@vindex grub-bootloader
@code{grub-bootloader} allows you to boot in particular Intel-based machines
in ``legacy'' BIOS mode.
@vindex grub-efi-bootloader @vindex grub-efi-bootloader
@code{grub-efi-bootloader} allows to boot on modern systems using the @code{grub-efi-bootloader} allows to boot on modern systems using the
@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should @dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
use if the installation image contains a @file{/sys/firmware/efi} directory use if the installation image contains a @file{/sys/firmware/efi} directory
when you boot it on your system. when you boot it on your system.
@vindex grub-bootloader @vindex grub-efi-removable-bootloader
@code{grub-bootloader} allows you to boot in particular Intel-based machines @code{grub-efi-removable-bootloader} allows you to boot your system from
in ``legacy'' BIOS mode. removable media by writing the GRUB file to the UEFI-specification location of
@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
This is also useful for some UEFI firmwares that ``forget'' their configuration
from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
be used if the @file{/sys/firmware/efi} directory is available.
@quotation Note
This @emph{will} overwrite the GRUB file from any other operating systems that
also place their GRUB file in the UEFI-specification location; making them
unbootable.
@end quotation
@vindex grub-efi-netboot-bootloader @vindex grub-efi-netboot-bootloader
@code{grub-efi-netboot-bootloader} allows you to boot your system over network @code{grub-efi-netboot-bootloader} allows you to boot your system over network
@ -38018,9 +38039,10 @@ build a diskless Guix system.
The installation of the @code{grub-efi-netboot-bootloader} generates the The installation of the @code{grub-efi-netboot-bootloader} generates the
content of the TFTP root directory at @code{targets} (@pxref{Bootloader content of the TFTP root directory at @code{targets} (@pxref{Bootloader
Configuration, @code{targets}}), to be served by a TFTP server. You may Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
want to mount your TFTP server directories onto the @code{targets} to served by a TFTP server. You may want to mount your TFTP server directories
move the required files to the TFTP server automatically. onto the @code{targets} to move the required files to the TFTP server
automatically during installation.
If you plan to use an NFS root file system as well (actually if you mount the If you plan to use an NFS root file system as well (actually if you mount the
store from an NFS share), then the TFTP server needs to serve the file store from an NFS share), then the TFTP server needs to serve the file
@ -38049,25 +38071,34 @@ this constellation the symlinks will work.
For other constellations you will have to program your own bootloader For other constellations you will have to program your own bootloader
installer, which then takes care to make necessary files from the store installer, which then takes care to make necessary files from the store
accessible through TFTP, for example by copying them into the TFTP root accessible through TFTP, for example by copying them into the TFTP root
directory to your @code{targets}. directory for your @code{targets}.
It is important to note that symlinks pointing outside the TFTP root directory It is important to note that symlinks pointing outside the TFTP root directory
may need to be allowed in the configuration of your TFTP server. Further the may need to be allowed in the configuration of your TFTP server. Further the
store link exposes the whole store through TFTP@. Both points need to be store link exposes the whole store through TFTP@. Both points need to be
considered carefully for security aspects. considered carefully for security aspects. It is advised to disable any TFTP
write access!
Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
the system.
Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
NFS servers, you also need a properly configured DHCP server to make the booting NFS servers, you also need a properly configured DHCP server to make the booting
over netboot possible. For all this we can currently only recommend you to look over netboot possible. For all this we can currently only recommend you to look
for instructions about @acronym{PXE, Preboot eXecution Environment}. for instructions about @acronym{PXE, Preboot eXecution Environment}.
@vindex grub-efi-removable-bootloader If a local EFI System Partition (ESP) or a similar partition with a FAT
@code{grub-efi-removable-bootloader} allows you to boot your system from file system is mounted in @code{targets}, then symlinks cannot be
removable media by writing the GRUB file to the UEFI-specification location of created. In this case everything will be prepared for booting from
@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}. local storage, matching the behavior of @code{grub-efi-bootloader}, with
This is also useful for some UEFI firmwares that ``forget'' their configuration the difference that all GRUB binaries are copied to @code{targets},
from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only necessary for booting over the network.
be used if the @file{/sys/firmware/efi} directory is available.
@vindex grub-efi-netboot-removable-bootloader
@code{grub-efi-netboot-removable-bootloader} is identical to
@code{grub-efi-netboot-bootloader} with the exception that the
sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
comply with the UEFI specification for removable media.
@quotation Note @quotation Note
This @emph{will} overwrite the GRUB file from any other operating systems that This @emph{will} overwrite the GRUB file from any other operating systems that

9
etc/snippets/yas/log-edit-mode/guix-vc-commit-message-add-package Normal file
View file

@ -0,0 +1,9 @@
# -*- mode: snippet -*-
# name: guix-vc-commit-message-add-package
# key: add
# --
gnu: Add ${1:`(when (string-match "\\+(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}.
* `(car (log-edit-files))` ($1): New variable.
`(mapconcat (lambda (file) (concat "* " file)) (cdr (log-edit-files)) "\n")`

9
etc/snippets/yas/log-edit-mode/guix-vc-commit-message-remove-package Normal file
View file

@ -0,0 +1,9 @@
# -*- mode: snippet -*-
# name: guix-vc-commit-message-remove-package
# key: remove
# --
gnu: Remove ${1:`(when (string-match "\\-(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}.
* `(car (log-edit-files))` ($1): Delete variable.
`(mapconcat (lambda (file) (concat "* " file)) (cdr (log-edit-files)) "\n")`

14
etc/snippets/yas/log-edit-mode/guix-vc-commit-message-rename-package Normal file
View file

@ -0,0 +1,14 @@
# -*- mode: snippet -*-
# name: guix-vc-commit-message-rename-package
# key: rename
# --
gnu: ${1:`(when (string-match "\\-(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))
`}: Rename package to ${2:`
(when (string-match "\\+(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}.
* `(car (log-edit-files))` ($1): Define in terms of
'deprecated-package'.
($2): New variable, formerly known as "$1".
`(mapconcat (lambda (file) (concat "* " file)) (cdr (log-edit-files)) "\n")`

12
etc/snippets/yas/log-edit-mode/guix-vc-commit-message-update-package Normal file
View file

@ -0,0 +1,12 @@
# -*- mode: snippet -*-
# name: guix-vc-commit-message-update-package
# key: update
# --
gnu: ${1:`(when (string-match "^[ ]*(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}: Update to ${2:`
(when (string-match "^\\+[ ]*(version \"\\(.*\\)\"" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}.
* `(car (log-edit-files))` ($1): Update to $2.$0
`(mapconcat (lambda (file) (concat "* " file)) (cdr (log-edit-files)) "\n")`

9
etc/snippets/yas/log-edit-mode/guix-vc-commit-message-use-https-home-page Normal file
View file

@ -0,0 +1,9 @@
# -*- mode: snippet -*-
# name: guix-vc-commit-message-use-https-home-page
# key: https
# --
gnu: ${1:`(when (string-match "^[ ]*(define-public \\(\\S-+\\)" vc-patch-string)
(match-string-no-properties 1 vc-patch-string))`}: Use HTTPS home page URI.
* `(car (log-edit-files))` ($1)[home-page]: Use HTTPS URI.
`(mapconcat (lambda (file) (concat "* " file)) (cdr (log-edit-files)) "\n")`

3
etc/teams.scm.in
View file

@ -393,7 +393,8 @@ and Thunderbird."
"The Racket language and Racket-based languages, Racket packages, "The Racket language and Racket-based languages, Racket packages,
Racket's variant of Chez Scheme, and development of a Racket build system and Racket's variant of Chez Scheme, and development of a Racket build system and
importer." importer."
#:scope (list "gnu/packages/racket.scm"))) #:scope (list "gnu/packages/chez.scm"
"gnu/packages/racket.scm")))
(define-member (person "Thiago Jung Bauermann" (define-member (person "Thiago Jung Bauermann"

105
gnu/bootloader.scm
View file

@ -322,26 +322,22 @@ instead~%")))
(force %bootloaders)) (force %bootloaders))
(leave (G_ "~a: no such bootloader~%") name))) (leave (G_ "~a: no such bootloader~%") name)))
(define (efi-bootloader-profile files bootloader-package hooks) (define (efi-bootloader-profile packages files hooks)
"Creates a profile with BOOTLOADER-PACKAGE and a directory collection/ with "Creates a profile from the lists of PACKAGES and FILES from the store.
links to additional FILES from the store. This collection is meant to be used This profile is meant to be used by the bootloader-installer.
by the bootloader installer.
FILES is a list of file or directory names from the store, which will be FILES is a list of file or directory names from the store, which will be
symlinked into the collection/ directory. If a directory name ends with '/', symlinked into the profile. If a directory name ends with '/', then the
then the directory content instead of the directory itself will be symlinked directory content instead of the directory itself will be symlinked into the
into the collection/ directory. profile.
FILES may contain file like objects produced by functions like plain-file, FILES may contain file like objects produced by procedures like plain-file,
local-file, etc., or package contents produced with file-append. local-file, etc., or package contents produced with file-append.
HOOKS lists additional hook functions to modify the profile." HOOKS lists additional hook functions to modify the profile."
(define (bootloader-collection manifest) (define (efi-bootloader-profile-hook manifest)
(define build (define build
(with-imported-modules '((guix build utils) (with-imported-modules '((guix build utils))
(ice-9 ftw)
(srfi srfi-1)
(srfi srfi-26))
#~(begin #~(begin
(use-modules ((guix build utils) (use-modules ((guix build utils)
#:select (mkdir-p strip-store-file-name)) #:select (mkdir-p strip-store-file-name))
@ -365,8 +361,7 @@ HOOKS lists additional hook functions to modify the profile."
(define (name-is-store-entry? name) (define (name-is-store-entry? name)
"Return #t if NAME is a direct store entry and nothing inside." "Return #t if NAME is a direct store entry and nothing inside."
(not (string-index (strip-store-file-name name) #\/))) (not (string-index (strip-store-file-name name) #\/)))
(let* ((collection (string-append #$output "/collection")) (let* ((files '#$files)
(files '#$files)
(directories (filter name-ends-with-/? files)) (directories (filter name-ends-with-/? files))
(names-from-directories (names-from-directories
(append-map (lambda (directory) (append-map (lambda (directory)
@ -374,11 +369,11 @@ HOOKS lists additional hook functions to modify the profile."
directories)) directories))
(names (append names-from-directories (names (append names-from-directories
(remove name-ends-with-/? files)))) (remove name-ends-with-/? files))))
(mkdir-p collection) (mkdir-p #$output)
(if (every file-exists? names) (if (every file-exists? names)
(begin (begin
(for-each (lambda (name) (for-each (lambda (name)
(symlink-to name collection (symlink-to name #$output
(if (name-is-store-entry? name) (if (name-is-store-entry? name)
strip-store-file-name strip-store-file-name
basename))) basename)))
@ -386,57 +381,63 @@ HOOKS lists additional hook functions to modify the profile."
#t) #t)
#f))))) #f)))))
(gexp->derivation "bootloader-collection" (gexp->derivation "efi-bootloader-profile"
build build
#:local-build? #t #:local-build? #t
#:substitutable? #f #:substitutable? #f
#:properties #:properties
`((type . profile-hook) `((type . profile-hook)
(hook . bootloader-collection)))) (hook . efi-bootloader-profile-hook))))
(profile (content (packages->manifest (list bootloader-package))) (profile (content (packages->manifest packages))
(name "bootloader-profile") (name "efi-bootloader-profile")
(hooks (append (list bootloader-collection) hooks)) (hooks (cons efi-bootloader-profile-hook hooks))
(locales? #f) (locales? #f)
(allow-collisions? #f) (allow-collisions? #f)
(relative-symlinks? #f))) (relative-symlinks? #f)))
(define* (efi-bootloader-chain files (define* (efi-bootloader-chain final-bootloader
final-bootloader
#:key #:key
(packages '())
(files '())
(hooks '()) (hooks '())
installer) installer
"Define a bootloader chain with FINAL-BOOTLOADER as the final bootloader and disk-image-installer)
certain directories and files from the store given in the list of FILES. "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
and optional directories and files from the store given in the list of FILES.
FILES may contain file like objects produced by functions like plain-file, The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
local-file, etc., or package contents produced with file-append. They will be in an efi-bootloader-profile, which will be passed to the INSTALLER.
collected inside a directory collection/ inside a generated bootloader profile,
which will be passed to the INSTALLER. FILES may contain file-like objects produced by procedures like plain-file,
local-file, etc., or package contents produced with file-append.
If a directory name in FILES ends with '/', then the directory content instead If a directory name in FILES ends with '/', then the directory content instead
of the directory itself will be symlinked into the collection/ directory. of the directory itself will be symlinked into the efi-bootloader-profile.
The procedures in the HOOKS list can be used to further modify the bootloader The procedures in the HOOKS list can be used to further modify the bootloader
profile. It is possible to pass a single function instead of a list. profile. It is possible to pass a single function instead of a list.
If the INSTALLER argument is used, then this function will be called to install If the INSTALLER argument is used, then this gexp procedure will be called to
the bootloader. Otherwise the installer of the FINAL-BOOTLOADER will be called." install the efi-bootloader-profile. Otherwise the installer of the
(let* ((final-installer (or installer FINAL-BOOTLOADER will be called.
(bootloader-installer final-bootloader)))
(profile (efi-bootloader-profile files If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
(bootloader-package final-bootloader) to install the efi-bootloader-profile into a disk image. Otherwise the
(if (list? hooks) disk-image-installer of the FINAL-BOOTLOADER will be called."
hooks (bootloader
(list hooks))))) (inherit final-bootloader)
(bootloader (name "efi-bootloader-chain")
(inherit final-bootloader) (package
(package profile) (efi-bootloader-profile (cons (bootloader-package final-bootloader)
(installer packages)
#~(lambda (bootloader target mount-point) files
(#$final-installer bootloader target mount-point) (if (list? hooks)
(copy-recursively hooks
(string-append bootloader "/collection") (list hooks))))
(string-append mount-point target) (installer
#:follow-symlinks? #t (or installer
#:log (%make-void-port "w"))))))) (bootloader-installer final-bootloader)))
(disk-image-installer
(or disk-image-installer
(bootloader-disk-image-installer final-bootloader)))))

220
gnu/bootloader/grub.scm
View file

@ -53,13 +53,14 @@
grub-theme-gfxmode grub-theme-gfxmode
install-grub-efi-removable install-grub-efi-removable
install-grub-efi-netboot make-grub-efi-netboot-installer
grub-bootloader grub-bootloader
grub-efi-bootloader grub-efi-bootloader
grub-efi-removable-bootloader grub-efi-removable-bootloader
grub-efi32-bootloader grub-efi32-bootloader
grub-efi-netboot-bootloader grub-efi-netboot-bootloader
grub-efi-netboot-removable-bootloader
grub-mkrescue-bootloader grub-mkrescue-bootloader
grub-minimal-bootloader grub-minimal-bootloader
@ -353,7 +354,7 @@ code."
((or #f (? string?)) ((or #f (? string?))
#~(format #f "search --file --set ~a" #$file))))) #~(format #f "search --file --set ~a" #$file)))))
(define* (grub-configuration-file config entries (define* (make-grub-configuration grub config entries
#:key #:key
(locale #f) (locale #f)
(system (%current-system)) (system (%current-system))
@ -453,9 +454,7 @@ menuentry ~s {
(define locale-config (define locale-config
(let* ((entry (first all-entries)) (let* ((entry (first all-entries))
(device (menu-entry-device entry)) (device (menu-entry-device entry))
(mount-point (menu-entry-device-mount-point entry)) (mount-point (menu-entry-device-mount-point entry)))
(bootloader (bootloader-configuration-bootloader config))
(grub (bootloader-package bootloader)))
#~(let ((locale #$(and locale #~(let ((locale #$(and locale
(locale-definition-source (locale-definition-source
(locale-name->definition locale)))) (locale-name->definition locale))))
@ -481,8 +480,6 @@ set lang=~a~%"
(define keyboard-layout-config (define keyboard-layout-config
(let* ((layout (bootloader-configuration-keyboard-layout config)) (let* ((layout (bootloader-configuration-keyboard-layout config))
(grub (bootloader-package
(bootloader-configuration-bootloader config)))
(keymap* (and layout (keymap* (and layout
(keyboard-layout-file layout #:grub grub))) (keyboard-layout-file layout #:grub grub)))
(entry (first all-entries)) (entry (first all-entries))
@ -533,6 +530,16 @@ fi~%"))))
#:options '(#:local-build? #t #:options '(#:local-build? #t
#:substitutable? #f))) #:substitutable? #f)))
(define (grub-configuration-file config . args)
(let* ((bootloader (bootloader-configuration-bootloader config))
(grub (bootloader-package bootloader)))
(apply make-grub-configuration grub config args)))
(define (grub-efi-configuration-file . args)
(apply make-grub-configuration grub-efi args))
(define grub-cfg "/boot/grub/grub.cfg")
;;; ;;;
@ -674,42 +681,31 @@ fi~%"))))
((target-arm?) "--target=arm-efi")) ((target-arm?) "--target=arm-efi"))
"--efi-directory" target-esp))))) "--efi-directory" target-esp)))))
(define (install-grub-efi-netboot subdir) (define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
"Define a grub-efi-netboot bootloader installer for installation in SUBDIR, "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
which is usually efi/Guix or efi/boot." its files in SUBDIR and its configuration file in GRUB-CFG.
(let* ((system (string-split (nix-system->gnu-triplet
(or (%current-target-system) As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
(%current-system))) installer basically copies all files from the bootloader-package (or profile)
#\-)) into the bootloader-target directory.
(arch (first system))
(boot-efi-link (match system Additionally for network booting over TFTP, two relative symlinks to the store
;; These are the supportend systems and the names and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
;; defined by the UEFI standard for removable media. not be located on a FAT file-system.
(("i686" _ ...) "/bootia32.efi")
(("x86_64" _ ...) "/bootx64.efi") If the bootloader-target does not support symlinks, then it is assumed to be a
(("arm" _ ...) "/bootarm.efi") kind of EFI System Partition (ESP). In this case an intermediate configuration
(("aarch64" _ ...) "/bootaa64.efi") file is created with the help of GRUB-EFI to load the GRUB-CFG.
(("riscv" _ ...) "/bootriscv32.efi")
(("riscv64" _ ...) "/bootriscv64.efi") The installer is usable for any efi-bootloader-chain, which prepares the
;; Other systems are not supported, although defined. bootloader-profile in a way ready for copying.
;; (("riscv128" _ ...) "/bootriscv128.efi")
;; (("ia64" _ ...) "/bootia64.efi") The installer does not manipulate the system's 'UEFI Boot Manager'.
((_ ...) #f)))
(core-efi (string-append The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
;; This is the arch dependent file name of GRUB, e.g. arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
;; i368-efi/core.efi or arm64-efi/core.efi. grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
(match arch directory TARGET for the system whose root is mounted at MOUNT-POINT.
("i686" "i386")
("aarch64" "arm64")
("riscv" "riscv32")
(_ arch))
"-efi/core.efi")))
(with-imported-modules
'((guix build union))
#~(lambda (bootloader target mount-point)
"Install the BOOTLOADER, which must be the package grub, as e.g.
bootx64.efi or bootaa64.efi into SUBDIR, which is usually efi/Guix or efi/boot,
below the directory TARGET for the system whose root is mounted at MOUNT-POINT.
MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point' MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
or '/' for other 'guix system' commands. or '/' for other 'guix system' commands.
@ -719,17 +715,19 @@ bootloader-configuration in:
(operating-system (operating-system
(bootloader (bootloader-configuration (bootloader (bootloader-configuration
(targets '(\"/boot\")) (targets '(\"/boot/efi\"))
…)) …))
…) …)
TARGET is required to be an absolute directory name, usually mounted via NFS, TARGET is required to be an absolute directory name, usually mounted via NFS,
and finally needs to be provided by a TFTP server as the TFTP root directory. and finally needs to be provided by a TFTP server as
the TFTP root directory.
Usually the installer will be used to prepare network booting over TFTP. Then
GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
load more files from the store like tftp://server/gnu/store/…-linux…/Image. load more files from the store like tftp://server/gnu/store/…-linux…/Image.
To make this possible two symlinks will be created. The first symlink points To make this possible two symlinks are created. The first symlink points
relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix. MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
@ -739,34 +737,80 @@ paths on the TFTP server side are unknown.
It is also important to note that both symlinks will point outside the TFTP root It is also important to note that both symlinks will point outside the TFTP root
directory and that the TARGET/%store-prefix symlink makes the whole store directory and that the TARGET/%store-prefix symlink makes the whole store
accessible via TFTP. Possibly the TFTP server must be configured accessible via TFTP. Possibly the TFTP server must be configured to allow
to allow accesses outside its TFTP root directory. This may need to be accesses outside its TFTP root directory. This all may need to be considered
considered for security aspects." for security aspects. It is advised to disable any TFTP write access!
(use-modules ((guix build union) #:select (symlink-relative)))
(let* ((net-dir (string-append mount-point target "/")) The installer can also be used to prepare booting from local storage, if the
(sub-dir (string-append net-dir #$subdir "/")) underlying file-system, like FAT on an EFI System Partition (ESP), does not
(store (string-append mount-point (%store-prefix))) support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
(store-link (string-append net-dir (%store-prefix))) created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
(grub-cfg (string-append mount-point "/boot/grub/grub.cfg")) symlink to the store is not needed in this case."
(grub-cfg-link (string-append sub-dir (basename grub-cfg))) (with-imported-modules '((guix build union))
(boot-efi-link (string-append sub-dir #$boot-efi-link))) #~(lambda (bootloader target mount-point)
;; Prepare the symlink to the store. ;; In context of a disk image creation TARGET will be #f and an
(mkdir-p (dirname store-link)) ;; installer is expected to do necessary installations on MOUNT-POINT,
(false-if-exception (delete-file store-link)) ;; which will become the root file system. If TARGET is #f, this
(symlink-relative store store-link) ;; installer has nothing to do, as it only cares about the EFI System
;; Prepare the symlink to the grub.cfg, which points into the store. ;; Partition (ESP).
(mkdir-p (dirname grub-cfg-link)) (when target
(false-if-exception (delete-file grub-cfg-link)) (use-modules ((guix build union) #:select (symlink-relative))
(symlink-relative grub-cfg grub-cfg-link) (ice-9 popen)
;; Install GRUB, which refers to the grub.cfg, with support for (ice-9 rdelim))
;; encrypted partitions, (let* ((mount-point/target (string-append mount-point target "/"))
(setenv "GRUB_ENABLE_CRYPTODISK" "y") ;; When installing Guix, it is common to mount TARGET below
(invoke/quiet (string-append bootloader "/bin/grub-mknetdir") ;; MOUNT-POINT rather than the root directory.
(string-append "--net-directory=" net-dir) (bootloader-target (if (file-exists? mount-point/target)
(string-append "--subdir=" #$subdir)) mount-point/target
;; Prepare the bootloader symlink, which points to core.efi of GRUB. target))
(false-if-exception (delete-file boot-efi-link)) (store (string-append mount-point (%store-prefix)))
(symlink #$core-efi boot-efi-link)))))) (store-link (string-append bootloader-target (%store-prefix)))
(grub-cfg (string-append mount-point #$grub-cfg))
(grub-cfg-link (string-append bootloader-target
#$subdir "/"
(basename grub-cfg))))
;; Copy the bootloader into the bootloader-target directory.
;; Should we beforehand recursively delete any existing file?
(copy-recursively bootloader bootloader-target
#:follow-symlinks? #t
#:log (%make-void-port "w"))
;; For TFTP we need to install additional relative symlinks.
;; If we install on an EFI System Partition (ESP) or some other FAT
;; file-system, then symlinks cannot be created and are not needed.
;; Therefore we ignore exceptions when trying.
;; Prepare the symlink to the grub.cfg.
(mkdir-p (dirname grub-cfg-link))
(false-if-exception (delete-file grub-cfg-link))
(if (unspecified?
(false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
;; Symlinks are supported.
(begin
;; Prepare the symlink to the store.
(mkdir-p (dirname store-link))
(false-if-exception (delete-file store-link))
(symlink-relative store store-link))
;; Creating symlinks does not seem to be supported. Probably
;; an ESP is used. Add a script to search and load the actual
;; grub.cfg.
(let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
(port (open-pipe* OPEN_READ probe "--target=fs_uuid"
grub-cfg))
(search-root
(match (read-line port)
((? eof-object?)
;; There is no UUID available. As a fallback search
;; everywhere for the grub.cfg.
(string-append "search --file --set " #$grub-cfg))
(fs-uuid
;; The UUID to load the grub.cfg from is known.
(string-append "search --fs-uuid --set " fs-uuid))))
(load-grub-cfg (string-append "configfile " #$grub-cfg)))
(close-pipe port)
(with-output-to-file grub-cfg-link
(lambda ()
(display (string-join (list search-root
load-grub-cfg)
"\n")))))))))))
@ -784,7 +828,7 @@ considered for security aspects."
(package grub) (package grub)
(installer install-grub) (installer install-grub)
(disk-image-installer install-grub-disk-image) (disk-image-installer install-grub-disk-image)
(configuration-file "/boot/grub/grub.cfg") (configuration-file grub-cfg)
(configuration-file-generator grub-configuration-file))) (configuration-file-generator grub-configuration-file)))
(define grub-minimal-bootloader (define grub-minimal-bootloader
@ -794,11 +838,12 @@ considered for security aspects."
(define grub-efi-bootloader (define grub-efi-bootloader
(bootloader (bootloader
(inherit grub-bootloader) (name 'grub-efi)
(package grub-efi)
(installer install-grub-efi) (installer install-grub-efi)
(disk-image-installer #f) (disk-image-installer #f)
(name 'grub-efi) (configuration-file grub-cfg)
(package grub-efi))) (configuration-file-generator grub-configuration-file)))
(define grub-efi-removable-bootloader (define grub-efi-removable-bootloader
(bootloader (bootloader
@ -813,11 +858,22 @@ considered for security aspects."
(name 'grub-efi32) (name 'grub-efi32)
(package grub-efi32))) (package grub-efi32)))
(define grub-efi-netboot-bootloader (define (make-grub-efi-netboot-bootloader name subdir)
(bootloader (bootloader
(inherit grub-efi-bootloader) (name name)
(name 'grub-efi-netboot-bootloader) (package (make-grub-efi-netboot (symbol->string name) subdir))
(installer (install-grub-efi-netboot "efi/Guix")))) (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
(disk-image-installer #f)
(configuration-file grub-cfg)
(configuration-file-generator grub-efi-configuration-file)))
(define grub-efi-netboot-bootloader
(make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
"efi/Guix"))
(define grub-efi-netboot-removable-bootloader
(make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
"efi/boot"))
(define grub-mkrescue-bootloader (define grub-mkrescue-bootloader
(bootloader (bootloader

46
gnu/build/hurd-boot.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -127,6 +127,9 @@ set."
(define (translated? file-name) (define (translated? file-name)
"Return true if a translator is installed on FILE-NAME." "Return true if a translator is installed on FILE-NAME."
;; On GNU/Hurd, 'getxattr' in glibc opens the file without O_NOTRANS, and
;; then, for "gnu.translator", it calls 'file_get_translator', resulting in
;; EOPNOTSUPP (conversely, 'showtrans' opens the file with O_NOTRANS).
(if (string-contains %host-type "linux-gnu") (if (string-contains %host-type "linux-gnu")
(passive-translator-xattr? file-name) (passive-translator-xattr? file-name)
(passive-translator-installed? file-name))) (passive-translator-installed? file-name)))
@ -210,31 +213,34 @@ set."
;; 'fd_to_filename' in libc expects it. ;; 'fd_to_filename' in libc expects it.
("dev/fd" ("/hurd/magic" "--directory" "fd") #o555) ("dev/fd" ("/hurd/magic" "--directory" "fd") #o555)
("dev/tty1" ("/hurd/term" "/dev/tty1" "hurdio" "/dev/vcs/1/console") ;; Create a number of ttys; syslogd writes to tty12 by default.
#o666) ;; FIXME: Creating /dev/tty12 leads the console client to switch to
("dev/tty2" ("/hurd/term" "/dev/tty2" "hurdio" "/dev/vcs/2/console") ;; tty12 when syslogd starts, which is confusing for users. Thus, do
#o666) ;; not create tty12.
("dev/tty3" ("/hurd/term" "/dev/tty3" "hurdio" "/dev/vcs/3/console") ,@(map (lambda (n)
#o666) (let ((n (number->string n)))
`(,(string-append "dev/tty" n)
("/hurd/term" ,(string-append "/dev/tty" n)
"hurdio" ,(string-append "/dev/vcs/" n "/console"))
#o666)))
(iota 11 1))
("dev/ptyp0" ("/hurd/term" "/dev/ptyp0" "pty-master" "/dev/ttyp0") ,@(append-map (lambda (n)
#o666) (let ((n (number->string n)))
("dev/ptyp1" ("/hurd/term" "/dev/ptyp1" "pty-master" "/dev/ttyp1") `((,(string-append "dev/ptyp" n)
#o666) ("/hurd/term" ,(string-append "/dev/ptyp" n)
("dev/ptyp2" ("/hurd/term" "/dev/ptyp2" "pty-master" "/dev/ttyp2") "pty-master" ,(string-append "/dev/ttyp" n))
#o666) #o666)
("dev/ttyp0" ("/hurd/term" "/dev/ttyp0" "pty-slave" "/dev/ptyp0") (,(string-append "dev/ttyp" n)
#o666) ("/hurd/term" ,(string-append "/dev/ttyp" n)
("dev/ttyp1" ("/hurd/term" "/dev/ttyp1" "pty-slave" "/dev/ptyp1") "pty-slave" ,(string-append "/dev/ptyp" n))
#o666) #o666))))
("dev/ttyp2" ("/hurd/term" "/dev/ttyp2" "pty-slave" "/dev/ptyp2") (iota 10 0))))
#o666)))
(for-each scope-set-translator servers) (for-each scope-set-translator servers)
(mkdir* "dev/vcs/1") (mkdir* "dev/vcs/1")
(mkdir* "dev/vcs/2") (mkdir* "dev/vcs/2")
(mkdir* "dev/vcs/2")
(rename-file (scope "dev/console") (scope "dev/console-")) (rename-file (scope "dev/console") (scope "dev/console-"))
(for-each scope-set-translator devices) (for-each scope-set-translator devices)

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

@ -77,35 +77,35 @@ Each message is also prefixed by a timestamp by GNU Shepherd."))
(define shepherd-schedule-action (define shepherd-schedule-action
(@@ (gnu services mcron) shepherd-schedule-action)) (@@ (gnu services mcron) shepherd-schedule-action))
(define home-mcron-shepherd-services (define (home-mcron-shepherd-services config)
(match-lambda (match-record config <home-mcron-configuration>
(($ <home-mcron-configuration> mcron '()) ; no jobs to run (mcron jobs log? log-format)
'()) (if (null? jobs)
(($ <home-mcron-configuration> mcron jobs log? log-format) '() ;no jobs to run
(let ((files (job-files mcron jobs))) (let ((files (job-files mcron jobs)))
(list (shepherd-service (list (shepherd-service
(documentation "User cron jobs.") (documentation "User cron jobs.")
(provision '(mcron)) (provision '(mcron))
(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)
,@%default-modules)) ,@%default-modules))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$mcron "/bin/mcron") (list (string-append #$mcron "/bin/mcron")
#$@(if log? #$@(if log?
#~("--log" "--log-format" #$log-format) #~("--log" "--log-format" #$log-format)
#~()) #~())
#$@files) #$@files)
#:log-file (string-append #:log-file (string-append
(or (getenv "XDG_LOG_HOME") (or (getenv "XDG_LOG_HOME")
(format #f "~a/.local/var/log" (format #f "~a/.local/var/log"
(getenv "HOME"))) (getenv "HOME")))
"/mcron.log"))) "/mcron.log")))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
(actions (actions
(list (shepherd-schedule-action mcron files))))))))) (list (shepherd-schedule-action mcron files)))))))))
(define home-mcron-profile (compose list home-mcron-configuration-mcron)) (define home-mcron-profile (compose list home-mcron-configuration-mcron))

50
gnu/home/services/shells.scm
View file

@ -25,6 +25,7 @@
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -479,31 +480,30 @@ with text blocks from other extensions and the base service.")
with text blocks from other extensions and the base service.")) with text blocks from other extensions and the base service."))
(define (home-bash-extensions original-config extension-configs) (define (home-bash-extensions original-config extension-configs)
(match original-config (match-record original-config <home-bash-configuration>
(($ <home-bash-configuration> _ _ environment-variables aliases (environment-variables aliases bash-profile bashrc bash-logout)
bash-profile bashrc bash-logout) (home-bash-configuration
(home-bash-configuration (inherit original-config)
(inherit original-config) (environment-variables
(environment-variables (append environment-variables
(append environment-variables (append-map
(append-map home-bash-extension-environment-variables extension-configs)))
home-bash-extension-environment-variables extension-configs))) (aliases
(aliases (append aliases
(append aliases (append-map
(append-map home-bash-extension-aliases extension-configs)))
home-bash-extension-aliases extension-configs))) (bash-profile
(bash-profile (append bash-profile
(append bash-profile (append-map
(append-map home-bash-extension-bash-profile extension-configs)))
home-bash-extension-bash-profile extension-configs))) (bashrc
(bashrc (append bashrc
(append bashrc (append-map
(append-map home-bash-extension-bashrc extension-configs)))
home-bash-extension-bashrc extension-configs))) (bash-logout
(bash-logout (append bash-logout
(append bash-logout (append-map
(append-map home-bash-extension-bash-logout extension-configs))))))
home-bash-extension-bash-logout extension-configs)))))))
(define home-bash-service-type (define home-bash-service-type
(service-type (name 'home-bash) (service-type (name 'home-bash)

52
gnu/home/services/xdg.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021, 2022 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -35,10 +35,24 @@
#:export (home-xdg-base-directories-service-type #:export (home-xdg-base-directories-service-type
home-xdg-base-directories-configuration home-xdg-base-directories-configuration
home-xdg-base-directories-configuration? home-xdg-base-directories-configuration?
home-xdg-base-directories-configuration-cache-home
home-xdg-base-directories-configuration-config-home
home-xdg-base-directories-configuration-data-home
home-xdg-base-directories-configuration-state-home
home-xdg-base-directories-configuration-log-home
home-xdg-base-directories-configuration-runtime-dir
home-xdg-user-directories-service-type home-xdg-user-directories-service-type
home-xdg-user-directories-configuration home-xdg-user-directories-configuration
home-xdg-user-directories-configuration? home-xdg-user-directories-configuration?
home-xdg-user-directories-configuration-desktop
home-xdg-user-directories-configuration-documents
home-xdg-user-directories-configuration-download
home-xdg-user-directories-configuration-music
home-xdg-user-directories-configuration-pictures
home-xdg-user-directories-configuration-publicshare
home-xdg-user-directories-configuration-templates
home-xdg-user-directories-configuration-videos
xdg-desktop-action xdg-desktop-action
xdg-desktop-entry xdg-desktop-entry
@ -383,25 +397,25 @@ configuration."
(define (serialize-alist config) (define (serialize-alist config)
(generic-serialize-alist append format-config config)) (generic-serialize-alist append format-config config))
(define (serialize-xdg-desktop-action action) (define (serialize-xdg-desktop-action desktop-action)
(match action (match-record desktop-action <xdg-desktop-action>
(($ <xdg-desktop-action> action name config) (action name config)
`(,(format #f "[Desktop Action ~a]\n" `(,(format #f "[Desktop Action ~a]\n"
(string-capitalize (maybe-object->string action))) (string-capitalize (maybe-object->string action)))
,(format #f "Name=~a\n" name) ,(format #f "Name=~a\n" name)
,@(serialize-alist config))))) ,@(serialize-alist config))))
(match entry (match-record entry <xdg-desktop-entry>
(($ <xdg-desktop-entry> file name type config actions) (file name type config actions)
(list (if (string-suffix? file ".desktop") (list (if (string-suffix? file ".desktop")
file file
(string-append file ".desktop")) (string-append file ".desktop"))
`("[Desktop Entry]\n" `("[Desktop Entry]\n"
,(format #f "Name=~a\n" name) ,(format #f "Name=~a\n" name)
,(format #f "Type=~a\n" ,(format #f "Type=~a\n"
(string-capitalize (symbol->string type))) (string-capitalize (symbol->string type)))
,@(serialize-alist config) ,@(serialize-alist config)
,@(append-map serialize-xdg-desktop-action actions)))))) ,@(append-map serialize-xdg-desktop-action actions)))))
(define-configuration home-xdg-mime-applications-configuration (define-configuration home-xdg-mime-applications-configuration
(added (added

4
gnu/local.mk
View file

@ -1345,6 +1345,7 @@ dist_patch_DATA = \
%D%/packages/patches/jami-fix-unit-tests-build.patch \ %D%/packages/patches/jami-fix-unit-tests-build.patch \
%D%/packages/patches/jami-libjami-headers-search.patch \ %D%/packages/patches/jami-libjami-headers-search.patch \
%D%/packages/patches/jami-no-webengine.patch \ %D%/packages/patches/jami-no-webengine.patch \
%D%/packages/patches/jami-sip-contacts.patch \
%D%/packages/patches/jami-sip-unregister.patch \ %D%/packages/patches/jami-sip-unregister.patch \
%D%/packages/patches/jami-xcb-link.patch \ %D%/packages/patches/jami-xcb-link.patch \
%D%/packages/patches/jamvm-1.5.1-aarch64-support.patch \ %D%/packages/patches/jamvm-1.5.1-aarch64-support.patch \
@ -1822,6 +1823,7 @@ dist_patch_DATA = \
%D%/packages/patches/ruby-mustache-1.1.1-fix-race-condition-tests.patch \ %D%/packages/patches/ruby-mustache-1.1.1-fix-race-condition-tests.patch \
%D%/packages/patches/ruby-sanitize-system-libxml.patch \ %D%/packages/patches/ruby-sanitize-system-libxml.patch \
%D%/packages/patches/rustc-1.54.0-src.patch \ %D%/packages/patches/rustc-1.54.0-src.patch \
%D%/packages/patches/rust-1.64-fix-riscv64-bootstrap.patch \
%D%/packages/patches/rust-adblock-ignore-live-tests.patch \ %D%/packages/patches/rust-adblock-ignore-live-tests.patch \
%D%/packages/patches/i3status-rust-enable-unstable-features.patch \ %D%/packages/patches/i3status-rust-enable-unstable-features.patch \
%D%/packages/patches/rust-ndarray-remove-blas-src-dep.patch \ %D%/packages/patches/rust-ndarray-remove-blas-src-dep.patch \
@ -1836,7 +1838,6 @@ dist_patch_DATA = \
%D%/packages/patches/sbcl-aserve-fix-rfe12668.patch \ %D%/packages/patches/sbcl-aserve-fix-rfe12668.patch \
%D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch \ %D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch \
%D%/packages/patches/sbcl-clml-fix-types.patch \ %D%/packages/patches/sbcl-clml-fix-types.patch \
%D%/packages/patches/sbcl-fix-build-on-arm64-with-clisp-as-host.patch \
%D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \ %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \
%D%/packages/patches/scalapack-gcc-10-compilation.patch \ %D%/packages/patches/scalapack-gcc-10-compilation.patch \
%D%/packages/patches/scheme48-tests.patch \ %D%/packages/patches/scheme48-tests.patch \
@ -1867,7 +1868,6 @@ dist_patch_DATA = \
%D%/packages/patches/spectre-meltdown-checker-find-kernel.patch \ %D%/packages/patches/spectre-meltdown-checker-find-kernel.patch \
%D%/packages/patches/sphinxbase-fix-doxygen.patch \ %D%/packages/patches/sphinxbase-fix-doxygen.patch \
%D%/packages/patches/spice-vdagent-glib-2.68.patch \ %D%/packages/patches/spice-vdagent-glib-2.68.patch \
%D%/packages/patches/sssd-optional-systemd.patch \
%D%/packages/patches/sssd-system-directories.patch \ %D%/packages/patches/sssd-system-directories.patch \
%D%/packages/patches/steghide-fixes.patch \ %D%/packages/patches/steghide-fixes.patch \
%D%/packages/patches/suitesparse-mongoose-cmake.patch \ %D%/packages/patches/suitesparse-mongoose-cmake.patch \

4
gnu/packages/admin.scm
View file

@ -1175,7 +1175,7 @@ would need and has several interesting built-in capabilities.")
(define-public netcat-openbsd (define-public netcat-openbsd
(package (package
(name "netcat-openbsd") (name "netcat-openbsd")
(version "1.218-5") (version "1.219-1")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -1184,7 +1184,7 @@ would need and has several interesting built-in capabilities.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0hpbmz9m2q22a6qgbn9590z2x96xgffim8g0m1v47mariz3pqhlc")))) "1fhrmnbdl6bgsjk02vi78zy9i486mmniymbbbhdkzl8zfjbjkpxc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no test suite `(#:tests? #f ; no test suite

6
gnu/packages/assembly.scm
View file

@ -144,8 +144,10 @@ debugging information in STABS, DWARF 2, and CodeView 8 formats.")
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (list zlib)) (native-inputs (list zlib))
(arguments (arguments
;; Some tests fail when run in parallel. `(#:configure-flags
`(#:parallel-tests? #f)) (list "--disable-static")
;; Some tests fail when run in parallel.
#:parallel-tests? #f))
(synopsis "Library for generating assembly code at runtime") (synopsis "Library for generating assembly code at runtime")
(description (description
"GNU Lightning is a library that generates assembly language code at "GNU Lightning is a library that generates assembly language code at

54
gnu/packages/astronomy.scm
View file

@ -89,6 +89,58 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1)) #:use-module (srfi srfi-1))
(define-public alfa
(package
(name "alfa")
(version "2.2")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rwesson/ALFA")
(commit (string-append "v" version))))
(sha256
(base32
"0aqxqar36822mh373awsl79j7zn8vik4yddyydsxv0c76gn4i2k3"))
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(arguments
(list #:parallel-build? #f
#:make-flags #~(list (string-append "PREFIX="
#$output)
(string-append "VERSION="
#$version))
#:phases #~(modify-phases %standard-phases
(delete 'configure)
(delete 'check)
(add-after 'install 'post-install-check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(invoke "make" "fittest")))))))
(inputs (list cfitsio gfortran))
(home-page "https://nebulousresearch.org/codes/alfa/")
(synopsis "Automated line fitting algorithm")
(description
"This package provides @acronym{ALFA, Automatic line fitting algorithm},
which can identify and fit hundreds of lines in emission line spectra in just a
few seconds with following features:
@itemize
@item A population of synthetic spectra is generated using a reference line
catalogue.
@item The goodness of fit for each synthetic spectrum is calculated. The best
sets of parameters are retained and the rest discarded.
@item A new population of synthetic spectra is obtained by averaging pairs of
the best performers.
@item A small fraction of the parameters of the lines in the new generation are
randomly altered.
@item The process repeats until a good fit is obtained.
@end itemize")
(license license:gpl3)))
(define-public aocommon (define-public aocommon
(let ((commit "7329a075271edab8f6264db649e81e62b2b6ae5e") (let ((commit "7329a075271edab8f6264db649e81e62b2b6ae5e")
(revision "1")) (revision "1"))
@ -1873,7 +1925,7 @@ It can be used to calculate the trajectory of satellites.")
(native-inputs (native-inputs
(list boost pkg-config)) (list boost pkg-config))
(inputs (inputs
(list cfitsio freeimage glew wxwidgets)) (list cfitsio freeimage glew wxwidgets-3.0))
(home-page "https://github.com/GreatAttractor/imppg") (home-page "https://github.com/GreatAttractor/imppg")
(synopsis "Astronomical Image Post-Proccessor (ImPPG)") (synopsis "Astronomical Image Post-Proccessor (ImPPG)")
(description (description

2
gnu/packages/audio.scm
View file

@ -892,7 +892,7 @@ engineers, musicians, soundtrack editors and composers.")
#t)))) #t))))
(build-system cmake-build-system) (build-system cmake-build-system)
(inputs (inputs
(list wxwidgets-3.1 (list wxwidgets
gtk+ gtk+
alsa-lib alsa-lib
jack-1 jack-1

4
gnu/packages/backup.scm
View file

@ -1088,14 +1088,14 @@ interactive mode.")
(define-public btrbk (define-public btrbk
(package (package
(name "btrbk") (name "btrbk")
(version "0.32.4") (version "0.32.5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://digint.ch/download/btrbk/releases/" (uri (string-append "https://digint.ch/download/btrbk/releases/"
"btrbk-" version ".tar.xz")) "btrbk-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1nl6cbzqkc2srwi1428vijq69rp5cdx7484zcx61ph0rnhg9srfc")))) "1d4zqf5klad55gdzzldipsjrhpprixzjmn03g66df5h2d28l1zpi"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list (list

89
gnu/packages/bioconductor.scm
View file

@ -2454,13 +2454,13 @@ plants. The method has been specifically designed to:
(define-public r-alpine (define-public r-alpine
(package (package
(name "r-alpine") (name "r-alpine")
(version "1.22.0") (version "1.24.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "alpine" version)) (uri (bioconductor-uri "alpine" version))
(sha256 (sha256
(base32 (base32
"1nl1hxwakh5m9rqm3ksn2jzknsj9xnwl51bmc30knknm4q35wdv9")))) "0rjnwljh4c2f7ml0m14pllns4pvyjwwf23qsn6zjygm5x04bapf0"))))
(properties `((upstream-name . "alpine"))) (properties `((upstream-name . "alpine")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -4216,18 +4216,19 @@ mapping.")
(define-public r-nmf (define-public r-nmf
(package (package
(name "r-nmf") (name "r-nmf")
(version "0.24.0") (version "0.25")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "NMF" version)) (uri (cran-uri "NMF" version))
(sha256 (sha256
(base32 (base32
"14yxra6in5c1md5nr75y8cdmh9pg0lxqabqflvlhgg1vbg9i2628")))) "0kdl7yz4v7pms6y2lff4x5w7pwkx54488qx0v539qmvcbxv1if98"))))
(properties `((upstream-name . "NMF"))) (properties `((upstream-name . "NMF")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
(list r-cluster (list r-cluster
r-codetools
r-biobase r-biobase
r-biocmanager r-biocmanager
r-bigmemory ; suggested r-bigmemory ; suggested
@ -4238,7 +4239,6 @@ mapping.")
r-foreach r-foreach
r-ggplot2 r-ggplot2
r-gridbase r-gridbase
r-pkgmaker
r-rcolorbrewer r-rcolorbrewer
r-registry r-registry
r-reshape2 r-reshape2
@ -4787,13 +4787,13 @@ only one command.")
(define-public r-biocparallel (define-public r-biocparallel
(package (package
(name "r-biocparallel") (name "r-biocparallel")
(version "1.32.1") (version "1.32.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "BiocParallel" version)) (uri (bioconductor-uri "BiocParallel" version))
(sha256 (sha256
(base32 (base32
"1fkfbs0n0sdssli7ibrswkfag080kgv8n1zf6ssxx729g1fz3m3h")))) "0z2g3p6ip4g865na9bmqaa7w2s52769pmjr3hpiv6x8bhifh3nm5"))))
(properties (properties
`((upstream-name . "BiocParallel"))) `((upstream-name . "BiocParallel")))
(build-system r-build-system) (build-system r-build-system)
@ -6010,6 +6010,42 @@ reduction (between group analysis) and joint dimension reduction of two
datasets (coinertia analysis).") datasets (coinertia analysis).")
(license license:artistic2.0))) (license license:artistic2.0)))
(define-public r-metaneighbor
(package
(name "r-metaneighbor")
(version "1.18.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "MetaNeighbor" version))
(sha256
(base32
"1gjjp5qlmv26sd3fvrd8cgv3invckxr8ldjpizpqm4mxjzifxwpm"))))
(properties `((upstream-name . "MetaNeighbor")))
(build-system r-build-system)
(propagated-inputs
(list r-beanplot
r-dplyr
r-ggplot2
r-gplots
r-igraph
r-matrix
r-matrixstats
r-rcolorbrewer
r-singlecellexperiment
r-summarizedexperiment
r-tibble
r-tidyr))
(native-inputs (list r-knitr))
(home-page "https://bioconductor.org/packages/MetaNeighbor")
(synopsis "Single cell replicability analysis")
(description
"This package implements a method to rapidly assess cell type identity using
both functional and random gene sets and it allows users to quantify cell type
replicability across datasets using neighbor voting. @code{MetaNeighbor} works
on the basis that cells of the same type should have more similar gene expression
profiles than cells of different types.")
(license license:expat)))
(define-public r-methylkit (define-public r-methylkit
(package (package
(name "r-methylkit") (name "r-methylkit")
@ -8765,6 +8801,41 @@ representations of analysis results in order to provide additional
information.") information.")
(license license:lgpl3))) (license license:lgpl3)))
(define-public r-glmgampoi
(package
(name "r-glmgampoi")
(version "1.10.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "glmGamPoi" version))
(sha256
(base32
"12jbqigg4k2ngrk2anbrrxrwkp57bbzdz492lg8lc6w1gygp5yip"))))
(properties `((upstream-name . "glmGamPoi")))
(build-system r-build-system)
(propagated-inputs
(list r-beachmat
r-biocgenerics
r-delayedarray
r-delayedmatrixstats
r-hdf5array
r-matrixgenerics
r-matrixstats
r-rcpp
r-rcpparmadillo
r-rlang
r-singlecellexperiment
r-summarizedexperiment))
(native-inputs (list r-knitr))
(home-page "https://github.com/const-ae/glmGamPoi")
(synopsis "Fit a Gamma-Poisson Generalized Linear Model")
(description
"Fit linear models to overdispersed count data. The package can estimate
the overdispersion and fit repeated models for matrix input. It is designed
to handle large input datasets as they typically occur in single cell RNA-seq
experiments.")
(license license:gpl3)))
(define-public r-rots (define-public r-rots
(package (package
(name "r-rots") (name "r-rots")
@ -17820,14 +17891,14 @@ the Bioconductor project.")
(define-public r-biodb (define-public r-biodb
(package (package
(name "r-biodb") (name "r-biodb")
(version "1.6.0") (version "1.6.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "biodb" version)) (uri (bioconductor-uri "biodb" version))
(sha256 (sha256
(base32 (base32
"08ahz3v2xbhwfh89dbnhhcdm0x5qv4hibi8wknlqf5x8gqm5j5w6")))) "0mbqsias2ajw29d1wgl10y2cjqv3slrsgifccz0kh9l5r6bk28vz"))))
(properties `((upstream-name . "biodb"))) (properties `((upstream-name . "biodb")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs

97
gnu/packages/bioinformatics.scm
View file

@ -57,6 +57,7 @@
#:use-module (guix build-system meson) #:use-module (guix build-system meson)
#:use-module (guix build-system ocaml) #:use-module (guix build-system ocaml)
#:use-module (guix build-system perl) #:use-module (guix build-system perl)
#:use-module (guix build-system pyproject)
#:use-module (guix build-system python) #:use-module (guix build-system python)
#:use-module (guix build-system qt) #:use-module (guix build-system qt)
#:use-module (guix build-system r) #:use-module (guix build-system r)
@ -10601,6 +10602,102 @@ traditional read alignments) and massively-parallel stochastic collapsed
variational inference.") variational inference.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public python-fanc
(package
(name "python-fanc")
(version "0.9.25")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/vaquerizaslab/fanc")
;; There are no tags. This commit corresponds to
;; version 0.9.25.
(commit "e2205346c13ea5349681dff21adeb271d4ea5261")))
(file-name (git-file-name name version))
(sha256
(base32
"0rxq24p852iiayi0083fyigvc30as695rha71q6xd4s2ij1k9mqi"))))
(build-system pyproject-build-system)
(arguments
(list
#:phases
'(modify-phases %standard-phases
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(invoke "pytest" "-vv"
"-k"
;; XXX: These all fail because they fail to read
;; the included test_{cooler,juicer}.hic files.
(string-append "not test_edges_iter"
" and not test_get_edges_uncorrected"
" and not test_get_edges"))))))))
(propagated-inputs
(list python-biopython
python-cooler
python-deprecated
python-future
python-genomic-regions
python-gridmap
python-h5py
python-intervaltree
python-matplotlib
python-msgpack
python-msgpack-numpy
python-numpy
python-pandas
python-pillow
python-progressbar2
python-pybedtools
python-pybigwig
python-pysam
python-pytest
python-pyyaml
python-scikit-image
python-scikit-learn
python-scipy
python-seaborn
python-tables))
(native-inputs
(list python-cython))
(home-page "https://github.com/vaquerizaslab/fanc")
(synopsis "Framework for the analysis of C-data")
(description
"FAN-C provides a pipeline for analysing Hi-C data starting at
mapped paired-end sequencing reads.")
(license license:gpl3+)))
(define-public python-genomic-regions
(package
(name "python-genomic-regions")
(version "0.0.10")
(source (origin
(method url-fetch)
(uri (pypi-uri "genomic_regions" version))
(sha256
(base32
"0hz811iyd1prml1r90qyzimmwyjwycwkjqw4vnl12bxy61rfzjz5"))))
(build-system pyproject-build-system)
(propagated-inputs
(list python-future
python-intervaltree
python-numpy
python-pandas
python-pybedtools
python-pybigwig
python-pytest
python-msgpack-numpy
python-cython
python-msgpack
python-pysam))
(home-page "https://pypi.org/project/genomic-regions/")
(synopsis "Consistently handle genomic regions")
(description "This package aims to simplify working with genomic region /
interval data by providing a common interface that lets you access a wide
selection of file types and formats for handling genomic region data---all
using the same syntax.")
(license license:expat)))
(define-public python-loompy (define-public python-loompy
(package (package
(name "python-loompy") (name "python-loompy")

809
gnu/packages/bootloaders.scm
View file

File diff suppressed because it is too large Load diff

89
gnu/packages/build-tools.scm
View file

@ -204,8 +204,8 @@ programs and other files depend.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public gn (define-public gn
(let ((commit "e327ffdc503815916db2543ec000226a8df45163") (let ((commit "1c4151ff5c1d6fbf7fa800b8d4bb34d3abc03a41")
(revision "1819")) ;as returned by `git describe`, used below (revision "2072")) ;as returned by `git describe`, used below
(package (package
(name "gn") (name "gn")
(version (git-version "0.0" revision commit)) (version (git-version "0.0" revision commit))
@ -215,49 +215,56 @@ programs and other files depend.")
(uri (git-reference (url home-page) (commit commit))) (uri (git-reference (url home-page) (commit commit)))
(sha256 (sha256
(base32 (base32
"0kvlfj3www84zp1vmxh76x8fdjm9hyk8lkh2vdsidafpmm75fphr")) "02621c9nqpr4pwcapy31x36l5kbyd0vdgd0wdaxj5p8hrxk67d6b"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases (modify-phases %standard-phases (list #:phases
(add-before 'configure 'set-build-environment #~(modify-phases %standard-phases
(lambda _ (add-before 'configure 'set-build-environment
(setenv "CC" "gcc") (setenv "CXX" "g++") (lambda _
(setenv "AR" "ar"))) (setenv "CC" "gcc")
(replace 'configure (setenv "CXX" "g++")
(lambda _ (setenv "AR" "ar")))
(invoke "python" "build/gen.py" (replace 'configure
"--no-last-commit-position"))) (lambda _
(add-after 'configure 'create-last-commit-position (invoke "python" "build/gen.py"
(lambda _ "--no-last-commit-position")))
;; Create "last_commit_position.h" to avoid a dependency (add-after 'configure 'create-last-commit-position
;; on 'git' (and the checkout..). (lambda _
(call-with-output-file "out/last_commit_position.h" ;; Mimic GenerateLastCommitPosition from gen.py.
(lambda (port) (call-with-output-file "out/last_commit_position.h"
(format port (lambda (port)
(string-append (format port
"#define LAST_COMMIT_POSITION_NUM ~a\n" "// Generated by Guix.
"#define LAST_COMMIT_POSITION \"~a (~a)\"\n")
,revision ,revision ,(string-take commit 8)))))) #ifndef OUT_LAST_COMMIT_POSITION_H_
(replace 'build #define OUT_LAST_COMMIT_POSITION_H_
(lambda _
(invoke "ninja" "-C" "out" "gn" #define LAST_COMMIT_POSITION_NUM ~a
"-j" (number->string (parallel-job-count))))) #define LAST_COMMIT_POSITION \"~a (~a)\"
(replace 'check
(lambda* (#:key tests? #:allow-other-keys) #endif // OUT_LAST_COMMIT_POSITION_H_
(if tests? "
(begin #$revision #$revision
(invoke "ninja" "-C" "out" "gn_unittests" #$(string-take commit 12))))))
"-j" (number->string (parallel-job-count))) (replace 'build
(invoke "./out/gn_unittests")) (lambda _
(format #t "test suite not run~%")))) (invoke "ninja" "-C" "out" "gn"
(replace 'install "-j" (number->string (parallel-job-count)))))
(lambda* (#:key outputs #:allow-other-keys) (replace 'check
(let ((out (assoc-ref outputs "out"))) (lambda* (#:key tests? #:allow-other-keys)
(install-file "out/gn" (string-append out "/bin")))))))) (if tests?
(begin
(invoke "ninja" "-C" "out" "gn_unittests"
"-j" (number->string (parallel-job-count)))
(invoke "./out/gn_unittests"))
(format #t "test suite not run~%"))))
(replace 'install
(lambda _
(install-file "out/gn" (string-append #$output "/bin")))))))
(native-inputs (native-inputs
`(("ninja" ,ninja) (list ninja python-wrapper))
("python" ,python-wrapper)))
(synopsis "Generate Ninja build files") (synopsis "Generate Ninja build files")
(description (description
"GN is a tool that collects information about a project from @file{.gn} "GN is a tool that collects information about a project from @file{.gn}

2
gnu/packages/cdrom.scm
View file

@ -516,7 +516,7 @@ capacity is user-selectable.")
#t))) #t)))
#:tests? #f)) ; No tests. #:tests? #f)) ; No tests.
(inputs ; TODO package bundled wxvillalib (inputs ; TODO package bundled wxvillalib
`(("wxwidgets" ,wxwidgets-3.1) `(("wxwidgets" ,wxwidgets)
("wssvg" ,wxsvg) ("wssvg" ,wxsvg)
("dbus" ,dbus) ("dbus" ,dbus)
("cdrtools" ,cdrtools) ("cdrtools" ,cdrtools)

42
gnu/packages/chromium.scm
View file

@ -183,11 +183,11 @@
"third_party/libaddressinput" ;ASL2.0 "third_party/libaddressinput" ;ASL2.0
"third_party/libaom" ;BSD-2 or "Alliance for Open Media Patent License 1.0" "third_party/libaom" ;BSD-2 or "Alliance for Open Media Patent License 1.0"
"third_party/libaom/source/libaom/third_party/fastfeat" ;BSD-3 "third_party/libaom/source/libaom/third_party/fastfeat" ;BSD-3
"third_party/libaom/source/libaom/third_party/SVT-AV1" ;BSD-3
"third_party/libaom/source/libaom/third_party/vector" ;Expat "third_party/libaom/source/libaom/third_party/vector" ;Expat
"third_party/libaom/source/libaom/third_party/x86inc" ;ISC "third_party/libaom/source/libaom/third_party/x86inc" ;ISC
"third_party/libjxl" ;ASL2.0 "third_party/libjxl" ;ASL2.0
"third_party/libgav1" ;ASL2.0 "third_party/libgav1" ;ASL2.0
"third_party/libgifcodec" ;MPL1.1/GPL2+/LGPL2.1+, BSD-3, BSD-2
"third_party/libjingle_xmpp" ;BSD-3 "third_party/libjingle_xmpp" ;BSD-3
"third_party/libphonenumber" ;ASL2.0 "third_party/libphonenumber" ;ASL2.0
"third_party/libsecret" ;LGPL2.1+ "third_party/libsecret" ;LGPL2.1+
@ -273,7 +273,7 @@
"third_party/utf" ;Expat "third_party/utf" ;Expat
"third_party/vulkan-deps" ;ASL2.0, BSD-3, Expat "third_party/vulkan-deps" ;ASL2.0, BSD-3, Expat
"third_party/vulkan_memory_allocator" ;Expat "third_party/vulkan_memory_allocator" ;Expat
"third_party/wayland/protocol" ;Expat "third_party/wayland/src/protocol" ;Expat
"third_party/wayland/stubs" ;BSD-3, Expat "third_party/wayland/stubs" ;BSD-3, Expat
"third_party/wayland/wayland_scanner_wrapper.py" ;BSD-3 "third_party/wayland/wayland_scanner_wrapper.py" ;BSD-3
"third_party/wayland-protocols" ;Expat "third_party/wayland-protocols" ;Expat
@ -317,10 +317,10 @@
;; run the Blink performance tests, just remove everything to save ~70MiB. ;; run the Blink performance tests, just remove everything to save ~70MiB.
'("third_party/blink/perf_tests")) '("third_party/blink/perf_tests"))
(define %chromium-version "107.0.5304.121") (define %chromium-version "108.0.5359.71")
(define %ungoogled-revision (string-append %chromium-version "-1")) (define %ungoogled-revision (string-append %chromium-version "-1"))
(define %debian-revision "debian/102.0.5005.61-1") (define %debian-revision "debian/102.0.5005.61-1")
(define %arch-revision "6afedb08139b97089ce8ef720ece5cd14c83948c") (define %arch-revision "4de5019014aeb77187a517c5ca6db8723d622a40")
(define %ungoogled-origin (define %ungoogled-origin
(origin (origin
@ -330,7 +330,7 @@
(file-name (git-file-name "ungoogled-chromium" %ungoogled-revision)) (file-name (git-file-name "ungoogled-chromium" %ungoogled-revision))
(sha256 (sha256
(base32 (base32
"1ns664y7qx0ry8hg8r704z64jmx8j6rpxn2lkliv0xjfwlrbbfx3")))) "1309rz06s7fw9p7h5968nk23rbsyfhqm5znqrw6nh24qdbg6z3zx"))))
(define %debian-origin (define %debian-origin
(origin (origin
@ -360,9 +360,6 @@
"system/zlib.patch" "system/zlib.patch"
"system/openjpeg.patch"))) "system/openjpeg.patch")))
(define %gcc-patches
'())
(define (arch-patch revision name hash) (define (arch-patch revision name hash)
(origin (origin
(method url-fetch) (method url-fetch)
@ -376,10 +373,12 @@
(arch-patch %arch-revision "REVERT-roll-src-third_party-ffmpeg-m102.patch" (arch-patch %arch-revision "REVERT-roll-src-third_party-ffmpeg-m102.patch"
"0i7crn6fcwq09kd6a4smqnffaldyv61lmv2p0drcnpfrwalmkprh") "0i7crn6fcwq09kd6a4smqnffaldyv61lmv2p0drcnpfrwalmkprh")
(arch-patch %arch-revision "REVERT-roll-src-third_party-ffmpeg-m106.patch" (arch-patch %arch-revision "REVERT-roll-src-third_party-ffmpeg-m106.patch"
"0li10cvxnppmmmsc7w77b1s7z02s5bzd39zsal9x768708fx64jc") "0li10cvxnppmmmsc7w77b1s7z02s5bzd39zsal9x768708fx64jc")))
;; Fix crash when using Global Media Controls.
(arch-patch %arch-revision "REVERT-enable-GlobalMediaControlsCastStartStop.patch" (define %arch-patches
"1ilsw421lylkjnq3lvc607bdx7cvwlish8qzgwx9s84l4hzv37vp"))) (list
(arch-patch %arch-revision "disable-GlobalMediaControlsCastStartStop.patch"
"00m361ka38d60zpbss7qnfw80vcwnip2pjcz3wf46wd2sqi1nfvz")))
(define %guix-patches (define %guix-patches
(list (local-file (list (local-file
@ -398,6 +397,9 @@
(assume-valid-file-name (assume-valid-file-name
(search-patch "ungoogled-chromium-system-nspr.patch"))))) (search-patch "ungoogled-chromium-system-nspr.patch")))))
(define %patches
(append %debian-patches %arch-patches %guix-patches))
;; This is a source 'snippet' that does the following: ;; This is a source 'snippet' that does the following:
;; *) Applies various patches for unbundling purposes and libstdc++ compatibility. ;; *) Applies various patches for unbundling purposes and libstdc++ compatibility.
;; *) Runs the ungoogled patch-, domain substitution-, and scrubbing scripts. ;; *) Runs the ungoogled patch-, domain substitution-, and scrubbing scripts.
@ -419,8 +421,7 @@
(for-each (lambda (patch) (for-each (lambda (patch)
(invoke "patch" "-p1" "--force" "--input" (invoke "patch" "-p1" "--force" "--input"
patch "--no-backup-if-mismatch")) patch "--no-backup-if-mismatch"))
(append '#+%debian-patches '#+%guix-patches '#+%patches)
'#+%gcc-patches))
;; These patches are "reversed", i.e. their changes should be undone. ;; These patches are "reversed", i.e. their changes should be undone.
(for-each (lambda (patch) (for-each (lambda (patch)
@ -495,7 +496,7 @@
%chromium-version ".tar.xz")) %chromium-version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"12z0fhgxcsdkf6shnsg9maj3v901226cjcy8y2x8m88maw2apc0j")) "0pgzf6xrd71is1dld1arhq366vjp8p54x75zyx6y7vcjqj0a0v6b"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (force ungoogled-chromium-snippet)))) (snippet (force ungoogled-chromium-snippet))))
(build-system gnu-build-system) (build-system gnu-build-system)
@ -561,7 +562,7 @@
"use_system_libjpeg=true" "use_system_libjpeg=true"
"use_system_libopenjpeg2=true" "use_system_libopenjpeg2=true"
"use_system_libpng=true" "use_system_libpng=true"
"use_system_libwayland_server=true" "use_system_libwayland=true"
"use_system_wayland_scanner=true" "use_system_wayland_scanner=true"
(string-append "system_wayland_scanner_path=\"" (string-append "system_wayland_scanner_path=\""
(search-input-file %build-inputs (search-input-file %build-inputs
@ -613,11 +614,12 @@
#~(modify-phases %standard-phases #~(modify-phases %standard-phases
(add-after 'unpack 'patch-stuff (add-after 'unpack 'patch-stuff
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(let ((openjpeg (search-input-directory (let* ((libopenjp2 (search-input-file inputs "lib/libopenjp2.so"))
inputs "include/openjpeg-2.4"))) (openjpeg (dirname (dirname libopenjp2))))
(substitute* "third_party/pdfium/BUILD.gn" (substitute* "third_party/pdfium/BUILD.gn"
;; This include path is added by Debians openjpeg patch. ;; This include path is added by Debians openjpeg patch.
(("/usr/include/openjpeg-2.4") openjpeg)) (("/usr/include/openjpeg-")
(string-append openjpeg "/include/openjpeg-")))
;; Adjust minizip header inclusions. ;; Adjust minizip header inclusions.
(substitute* (find-files "third_party/tflite_support\ (substitute* (find-files "third_party/tflite_support\
@ -910,7 +912,7 @@
gdk-pixbuf gdk-pixbuf
glib glib
gtk+ gtk+
harfbuzz-3 harfbuzz-5
icu4c-71 icu4c-71
jsoncpp jsoncpp
lcms lcms

4
gnu/packages/code.scm
View file

@ -391,7 +391,7 @@ features that are not supported by the standard @code{stdio} implementation.")
(define-public universal-ctags (define-public universal-ctags
(package (package
(name "universal-ctags") (name "universal-ctags")
(version "5.9.20220807.0") (version "5.9.20221127.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -401,7 +401,7 @@ features that are not supported by the standard @code{stdio} implementation.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1wjj6hlda7xyjm8yrl2zz74ks7azymm9yyrpz36zxxpx2scf6lsk")) "0nvkx5j2vyzjf935a2s5w56gamlr6f12jy1x38bkqz78p5l0d3ja"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

8
gnu/packages/compression.scm
View file

@ -1127,7 +1127,7 @@ tarballs.")
(define-public libjcat (define-public libjcat
(package (package
(name "libjcat") (name "libjcat")
(version "0.1.11") (version "0.1.12")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -1137,7 +1137,7 @@ tarballs.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "08zywwhm9q8m8v17w2mp23w3w93p40ir1w4x18zrlbhs10xnhiys")))) (base32 "0fbcmnpc0y7s2ls3q829dv3ardhv0m5gxqqmbn0dnkzgkh42vv7p"))))
(build-system meson-build-system) (build-system meson-build-system)
(native-inputs (native-inputs
(list gobject-introspection help2man pkg-config)) (list gobject-introspection help2man pkg-config))
@ -2695,7 +2695,7 @@ to their original, binary CD format.")
(define-public libdeflate (define-public libdeflate
(package (package
(name "libdeflate") (name "libdeflate")
(version "1.12") (version "1.14")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -2704,7 +2704,7 @@ to their original, binary CD format.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"16n9232zjavcp5wp17cx0gh2v7gipxpncsha05j3ybajfs7g88jv")))) "09y69mnbv3mprgjp53zvin5zqznqajginrk5b25xmi9y0b83bns8"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list #:make-flags (list #:make-flags

4
gnu/packages/cook.scm
View file

@ -24,8 +24,8 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (gnu packages ed) #:use-module (gnu packages ed)
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages groff)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages groff)
#:use-module (guix build-system gnu)) #:use-module (guix build-system gnu))
(define-public cook (define-public cook
@ -70,7 +70,7 @@
(setenv "SH" (which "sh")) (setenv "SH" (which "sh"))
#t))))) #t)))))
(native-inputs (list bison (native-inputs (list bison-3.0
;; For building the documentation: ;; For building the documentation:
groff groff
;; For the tests: ;; For the tests:

672
gnu/packages/cran.scm
View file

File diff suppressed because it is too large Load diff

2919
gnu/packages/crates-io.scm
View file

File diff suppressed because it is too large Load diff

10
gnu/packages/cups.scm
View file

@ -871,7 +871,7 @@ HP@tie{}LaserJet, and possibly other printers. See @file{README} for details.")
(define-public epson-inkjet-printer-escpr (define-public epson-inkjet-printer-escpr
(package (package
(name "epson-inkjet-printer-escpr") (name "epson-inkjet-printer-escpr")
(version "1.7.21") (version "1.7.22")
;; XXX: This currently works. But it will break as soon as a newer ;; XXX: This currently works. But it will break as soon as a newer
;; version is available since the URLs for older versions are not ;; version is available since the URLs for older versions are not
;; preserved. An alternative source will be added as soon as ;; preserved. An alternative source will be added as soon as
@ -879,11 +879,11 @@ HP@tie{}LaserJet, and possibly other printers. See @file{README} for details.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download3.ebz.epson.net/dsc/f/03/00/13/77/" (uri (string-append "https://download3.ebz.epson.net/dsc/f/03/00/13/96/"
"93/e85dc2dc266e96fdc242bd95758bd88d1a51963e/" "55/c6fced63098ae1ba104f11f572794fd558ffca29/"
"epson-inkjet-printer-escpr-1.7.21-1lsb3.2.tar.gz")) "epson-inkjet-printer-escpr-1.7.22-1lsb3.2.tar.gz"))
(sha256 (sha256
(base32 "0z1x9p58321plf2swfxgl72wn7ls8bfbyjwd9l9c8jxfr1v2skkz")))) (base32 "0b359krhhjjw5hc4b0gqdqwrm6dzc263mdccfzgnyyq7znkyybqb"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list #:modules (list #:modules

5
gnu/packages/curl.scm
View file

@ -366,7 +366,7 @@ curl to obtain exactly that HTTP request.")
(define-public coeurl (define-public coeurl
(package (package
(name "coeurl") (name "coeurl")
(version "0.2.0") (version "0.2.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -375,8 +375,7 @@ curl to obtain exactly that HTTP request.")
(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 (base32 "0qbbrfs35zl0wl6x6jn4p9ncxgdm70a883cflvikkykx9n5k2lpq"))))
"0kbazvrb4hzc9jr7yywd36ack1yy7bh8sh1kc4jzv6jfzvxjb0i0"))))
(build-system meson-build-system) (build-system meson-build-system)
(native-inputs (native-inputs
(list doctest pkg-config)) (list doctest pkg-config))

12
gnu/packages/digest.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Ryan Prior <rprior@protonmail.com> ;;; Copyright © 2021 Ryan Prior <rprior@protonmail.com>
;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,9 +25,11 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system pyproject)
#:use-module (guix build-system python) #:use-module (guix build-system python)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages python-build)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
(define-public wyhash (define-public wyhash
@ -111,15 +113,17 @@ platforms (both big and little endian).")
(define-public python-xxhash (define-public python-xxhash
(package (package
(name "python-xxhash") (name "python-xxhash")
(version "2.0.2") (version "3.1.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "xxhash" version)) (uri (pypi-uri "xxhash" version))
(sha256 (sha256
(base32 (base32
"0jbvz19acznq00544gcsjg05fkvrmwbnwdfgrvwss3i1ys6avgmp")))) "1hdxcscry59gh0znlm71ya23mm9rfmvz8lvvlplzxzf63pib28dc"))))
(build-system python-build-system) (build-system pyproject-build-system)
;; Needed to embed the correct version string
(native-inputs (list python-setuptools-scm))
(home-page "https://github.com/ifduyue/python-xxhash") (home-page "https://github.com/ifduyue/python-xxhash")
(synopsis "Python binding for xxHash") (synopsis "Python binding for xxHash")
(description "This package provides Python bindings for the xxHash hash (description "This package provides Python bindings for the xxHash hash

7
gnu/packages/disk.scm
View file

@ -1021,7 +1021,7 @@ to create devices with respective mappings for the ATARAID sets discovered.")
(define-public libblockdev (define-public libblockdev
(package (package
(name "libblockdev") (name "libblockdev")
(version "2.27") (version "2.28")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/storaged-project/" (uri (string-append "https://github.com/storaged-project/"
@ -1029,7 +1029,7 @@ to create devices with respective mappings for the ATARAID sets discovered.")
version "-1/libblockdev-" version ".tar.gz")) version "-1/libblockdev-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"05rm9h8v30rahr245jcw6if6b5g16mb5hnz7wl1shzip0wky3k3d")))) "1x3xbgd2dyjhcqvyalpnrp727xidfxmaxgyyvv5gwx4aw90wijc2"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -1142,6 +1142,7 @@ on your file system and offers to remove it. @command{rmlint} can find:
(define-public lf (define-public lf
(package (package
(name "lf") (name "lf")
;; When updating, remove go-github-com-gdamore-tcell-v2-2.3 from golang.scm.
(version "27") (version "27")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -1155,7 +1156,7 @@ on your file system and offers to remove it. @command{rmlint} can find:
(build-system go-build-system) (build-system go-build-system)
(native-inputs (native-inputs
(list go-github.com-mattn-go-runewidth go-golang-org-x-term (list go-github.com-mattn-go-runewidth go-golang-org-x-term
go-gopkg-in-djherbis-times-v1 go-github-com-gdamore-tcell-v2)) go-gopkg-in-djherbis-times-v1 go-github-com-gdamore-tcell-v2-2.3))
(arguments (arguments
`(#:import-path "github.com/gokcehan/lf")) `(#:import-path "github.com/gokcehan/lf"))
(home-page "https://github.com/gokcehan/lf") (home-page "https://github.com/gokcehan/lf")

4
gnu/packages/dns.scm
View file

@ -871,7 +871,7 @@ Extensions} (DNSSEC).")
(define-public knot (define-public knot
(package (package
(name "knot") (name "knot")
(version "3.2.2") (version "3.2.3")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -880,7 +880,7 @@ Extensions} (DNSSEC).")
(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 "1x1waa2cb91zhsqkx4mkiqy00kq1f1pavjfhlz7wknlnll48iayd")) (base32 "117q8jllaakd6gv0mfkq45sigy5c8j8jbyxiwna3wan0mjx81fhv"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

1
gnu/packages/ebook.scm
View file

@ -197,6 +197,7 @@ with Microsoft Compiled HTML (CHM) files")
python-psutil python-psutil
python-py7zr python-py7zr
python-pychm python-pychm
python-pycryptodome
python-pygments python-pygments
python-pyqt-without-qtwebkit python-pyqt-without-qtwebkit
python-pyqtwebengine python-pyqtwebengine

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

@ -258,7 +258,7 @@
(define-public emacs-geiser (define-public emacs-geiser
(package (package
(name "emacs-geiser") (name "emacs-geiser")
(version "0.28") (version "0.28.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -267,7 +267,7 @@
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0dd20cq3nz4jjysaqx2aiqqaxvkfkbj2x4zm2mz3pd4rmydckj2y")))) (base32 "111as99278vbv6pwj8rpl308g327f8iznnrz71mngl6d5mr0xpa1"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (arguments
'(#:phases '(#:phases
@ -305,7 +305,7 @@ e.g. emacs-geiser-guile for Guile.")
(define-public emacs-geiser-guile (define-public emacs-geiser-guile
(package (package
(name "emacs-geiser-guile") (name "emacs-geiser-guile")
(version "0.28.0") (version "0.28.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -314,7 +314,7 @@ e.g. emacs-geiser-guile for Guile.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "13qxg1npm0pmnml5q268k5xk1clyqldp8v200ihrqwqlc3ga7f36")))) (base32 "0gp8xbfm7y2gabjyys8jylfy1pkkglqas32xxrbqxfh1hv0cfh2f"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (arguments
(list (list
@ -889,6 +889,29 @@ of the segments available in that package using icons from
information in the mode line.") information in the mode line.")
(license license:expat))) (license license:expat)))
(define-public emacs-spongebob
(let ((commit "ae8ae6ba0dc57b7357ba87ff0609d27c4a0a5f51")
(revision "0"))
(package
(name "emacs-spongebob")
(version (git-version "0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/dustyweb/spongebob.el")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "1agqpp078ij2irn0kb8bgqk0nd47fi20yfd9szn8kbqypfqalvgc"))))
(build-system emacs-build-system)
(home-page "https://gitlab.com/dustyweb/gauche")
(synopsis "Memetically mock a region of text")
(description "This package transforms text using @code{studlify-region}
and inserts a SpongeBob SquarePants ASCII art figure in the current
buffer.")
(license license:gpl3+))))
(define-public emacs-project (define-public emacs-project
(package (package
(name "emacs-project") (name "emacs-project")
@ -5089,6 +5112,28 @@ at the current line number or active region. @code{git-link-commit} returns
the URL for a commit. URLs are added to the kill ring.") the URL for a commit. URLs are added to the kill ring.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-frowny
(package
(name "emacs-frowny")
(version "0.3")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/duckwork/frowny.el")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "01ss3js71as1jpqcf0x9hfvapiyyhj9ni4y1n6wvqsghv5dcaiy0"))))
(build-system emacs-build-system)
(home-page "https://github.com/duckwork/frowny.el")
(synopsis "Insert frownies in Emacs :(")
(description "This package ships @code{frowny-mode}, which makes it so that
inserting a single @code{(} when after a @code{:} will not automatically close
the parenthesis, meaning that only @code{:(} is inserted. Works with
@code{electric-pair-mode}, @code{paredit-mode}, and others.")
(license license:public-domain)))
(define-public emacs-apache-mode (define-public emacs-apache-mode
(package (package
(name "emacs-apache-mode") (name "emacs-apache-mode")
@ -15971,7 +16016,7 @@ similar syntax; currently C++, Objective-C, Java, CORBA's IDL, Pike, and AWK.")
(define-public emacs-csharp-mode (define-public emacs-csharp-mode
(package (package
(name "emacs-csharp-mode") (name "emacs-csharp-mode")
(version "1.1.1") (version "2.0.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -15980,7 +16025,7 @@ similar syntax; currently C++, Objective-C, Java, CORBA's IDL, Pike, and AWK.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0wfd4jdjsq8qp6pavf25y87dxvlnsqapfi4c4m3xj24baalr2dpq")))) (base32 "1d0pf236xi4c7fazv67a53yrac24lilnkzp9pb55xm88gig7rfmz"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/josteink/csharp-mode") (home-page "https://github.com/josteink/csharp-mode")
(synopsis "Major mode for C# code") (synopsis "Major mode for C# code")
@ -30358,39 +30403,40 @@ service, and connect it with Emacs via inter-process communication.")
(name "emacs-telega") (name "emacs-telega")
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (arguments
`(#:emacs ,(if (target-64bit?) (list
emacs-minimal #:emacs (if (target-64bit?)
;; Require wide-int support for 32-bit platform. emacs-minimal
emacs-wide-int) ;; Require wide-int support for 32-bit platform.
#:include (cons "^etc\\/" %default-include) emacs-wide-int)
#:phases #:include #~(cons "^etc\\/" %default-include)
(modify-phases %standard-phases #:phases
(add-after 'unpack 'patch-sources #~(modify-phases %standard-phases
(lambda* (#:key inputs #:allow-other-keys) (add-after 'unpack 'patch-sources
;; Hard-code paths to `ffplay` and `ffmpeg`. (lambda* (#:key inputs #:allow-other-keys)
(let* ((ffplay-bin (search-input-file inputs "/bin/ffplay")) ;; Hard-code paths to `ffplay` and `ffmpeg`.
(ffmpeg-bin (search-input-file inputs "/bin/ffmpeg"))) (let* ((ffplay-bin (search-input-file inputs "/bin/ffplay"))
(substitute* '("telega-ffplay.el" "telega-vvnote.el") (ffmpeg-bin (search-input-file inputs "/bin/ffmpeg")))
(("(shell-command-to-string\|concat) \"(ffmpeg\|ffprobe)" (substitute* '("telega-ffplay.el" "telega-vvnote.el")
all func cmd) (("(shell-command-to-string\|concat) \"(ffmpeg\|ffprobe)"
(string-append func " \"" all func cmd)
(search-input-file (string-append func " \""
inputs (string-append "/bin/" cmd)))) (search-input-file
(("\\(executable-find \"ffplay\"\\)") inputs (string-append "/bin/" cmd))))
(string-append "(and (file-executable-p \"" ffplay-bin "\")" (("\\(executable-find \"ffplay\"\\)")
"\"" ffplay-bin "\")")) (string-append "(and (file-executable-p \"" ffplay-bin "\")"
(("\\(executable-find \"ffmpeg\"\\)") "\"" ffplay-bin "\")"))
(string-append "(and (file-executable-p \"" ffmpeg-bin "\")" (("\\(executable-find \"ffmpeg\"\\)")
"\"" ffmpeg-bin "\")")))))) (string-append "(and (file-executable-p \"" ffmpeg-bin "\")"
(add-after 'unpack 'configure "\"" ffmpeg-bin "\")"))))))
(lambda* (#:key inputs outputs #:allow-other-keys) (add-after 'unpack 'configure
(substitute* "telega-customize.el" (lambda* (#:key inputs outputs #:allow-other-keys)
(("@TELEGA_SERVER_BIN@") (substitute* "telega-customize.el"
(search-input-file inputs "/bin/telega-server"))) (("@TELEGA_SERVER_BIN@")
(substitute* "telega-util.el" (search-input-file inputs "/bin/telega-server")))
(("@TELEGA_SHARE@") (substitute* "telega-util.el"
(string-append (elpa-directory (assoc-ref outputs "out")) (("@TELEGA_SHARE@")
"/etc")))))))) (string-append (elpa-directory (assoc-ref outputs "out"))
"/etc"))))))))
(inputs (inputs
(list emacs-telega-server ffmpeg)) (list emacs-telega-server ffmpeg))
(native-inputs '()) (native-inputs '())
@ -30406,13 +30452,14 @@ for the Telegram messaging platform.")))
(inherit emacs-telega) (inherit emacs-telega)
(name "emacs-telega-contrib") (name "emacs-telega-contrib")
(arguments (arguments
`(#:exclude '("telega-live-location.el") (list
#:phases #:exclude #~(list "telega-live-location.el")
(modify-phases %standard-phases #:phases
(add-after 'unpack 'enter-subdirectory #~(modify-phases %standard-phases
(lambda _ (chdir "contrib") #t)) (add-after 'unpack 'enter-subdirectory
(add-before 'install-license-files 'leave-subdirectory (lambda _ (chdir "contrib")))
(lambda _ (chdir "..") #t))))) (add-before 'install-license-files 'leave-subdirectory
(lambda _ (chdir ".."))))))
(inputs '()) (inputs '())
(native-inputs '()) (native-inputs '())
(propagated-inputs (propagated-inputs

45
gnu/packages/engineering.scm
View file

@ -669,7 +669,7 @@ multipole-accelerated algorithm.")
(define-public fritzing (define-public fritzing
(package (package
(name "fritzing") (name "fritzing")
(version "0.9.3b") (version "0.9.6")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -678,7 +678,7 @@ multipole-accelerated algorithm.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0hpyc550xfhr6gmnc85nq60w00rm0ljm0y744dp0z88ikl04f4s3")))) "083nz7vj7a334575smjry6257535h68gglh8a381xxa36dw96aqs"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -687,24 +687,18 @@ multipole-accelerated algorithm.")
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(copy-recursively (assoc-ref inputs "fritzing-parts-db") (copy-recursively (assoc-ref inputs "fritzing-parts-db")
"parts") "parts")
;; Make compatible with libgit2 > 0.24
(substitute* "src/version/partschecker.cpp"
(("error = git_remote_connect\\(remote, GIT_DIRECTION_FETCH, &callbacks\\)")
"error = git_remote_connect(remote, GIT_DIRECTION_FETCH, &callbacks, NULL, NULL)"))
;; Use system libgit2 and boost. ;; Use system libgit2 and boost.
(substitute* "phoenix.pro" (substitute* "phoenix.pro"
(("^LIBGIT2INCLUDE =.*") (("^LIBGIT_STATIC.*")
(string-append "LIBGIT2INCLUDE=" (string-append "LIBGIT2INCLUDE=" (assoc-ref inputs "libgit2") "/include\n"
(assoc-ref inputs "libgit2") "/include\n")) "LIBGIT2LIB=" (assoc-ref inputs "libgit2") "/lib\n"
(("^ LIBGIT2LIB =.*") "INCLUDEPATH += $$LIBGIT2INCLUDE\n"
(string-append " LIBGIT2LIB=" "LIBS += -L$$LIBGIT2LIB -lgit2\n"))
(assoc-ref inputs "libgit2") "/lib\n"))) (("^.*pri/libgit2detect.pri.") ""))
;; This file checks for old versions of Boost, insisting on ;; Trick the internal mechanism to load the parts
;; having us download the boost sources and placing them in the (substitute* "src/version/partschecker.cpp"
;; build directory. ((".*git_libgit2_init.*")
(substitute* "pri/utils.pri" "return \"083nz7vj7a334575smjry6257535h68gglh8a381xxa36dw96aqs\";"))
(("error\\(") "message("))
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
(invoke "qmake" (invoke "qmake"
@ -723,11 +717,11 @@ multipole-accelerated algorithm.")
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/fritzing/fritzing-parts") (url "https://github.com/fritzing/fritzing-parts")
(commit version))) (commit (string-append "release_" version))))
(file-name (git-file-name "fritzing-parts" version)) (file-name (git-file-name "fritzing-parts" version))
(sha256 (sha256
(base32 (base32
"1d2v8k7p176j0lczx4vx9n9gbg3vw09n2c4b6w0wj5wqmifywhc1")))))) "0wsvn57v6n0ygnhk2my94rrfzb962z1cj4d1xmp1farwck3811h6"))))))
(home-page "https://fritzing.org") (home-page "https://fritzing.org")
(synopsis "Electronic circuit design") (synopsis "Electronic circuit design")
(description (description
@ -970,6 +964,7 @@ Emacs).")
#$(this-package-input "opencascade-occt") #$(this-package-input "opencascade-occt")
"/include/opencascade") "/include/opencascade")
"-DKICAD_SCRIPTING_WXPYTHON_PHOENIX=ON" "-DKICAD_SCRIPTING_WXPYTHON_PHOENIX=ON"
"-DKICAD_USE_EGL=ON" ;because wxWidgets uses EGL
"-DCMAKE_BUILD_WITH_INSTALL_RPATH=TRUE") "-DCMAKE_BUILD_WITH_INSTALL_RPATH=TRUE")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
@ -980,16 +975,6 @@ Emacs).")
(string-append "NGSPICE_DLL_FILE=\"" (string-append "NGSPICE_DLL_FILE=\""
(assoc-ref inputs "libngspice") (assoc-ref inputs "libngspice")
"/lib/libngspice.so\""))))) "/lib/libngspice.so\"")))))
(add-after 'unpack 'fix-python-detection
(lambda _
(substitute* "CMakeModules/FindPythonLibs.cmake"
(("_PYTHON3_VERSIONS 3\\.8 3\\.7")
"_PYTHON3_VERSIONS 3.9 3.8 3.7"))))
(add-after 'unpack 'add-missing-include
(lambda _
(substitute* "common/lib_tree_model.cpp"
(("#include <eda_pattern_match.h>" all)
(string-append "#include <algorithm>\n" all)))))
(add-after 'install 'wrap-program (add-after 'install 'wrap-program
;; Ensure correct Python at runtime. ;; Ensure correct Python at runtime.
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)

4
gnu/packages/finance.scm
View file

@ -2177,7 +2177,7 @@ mining.")
(define-public p2pool (define-public p2pool
(package (package
(name "p2pool") (name "p2pool")
(version "2.5") (version "2.6")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -2186,7 +2186,7 @@ mining.")
(commit (string-append "v" version)) (commit (string-append "v" version))
(recursive? #t))) (recursive? #t)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (base32 "1kdsxh6f24zp7h7bwkrin2mc81ysfny5wprzgy41h2bc6dpq067w")) (sha256 (base32 "0832mv3f4c61w8s25higjbmmajjkvjdriw1xfygjiw5qxdcs202z"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
#~(for-each delete-file-recursively #~(for-each delete-file-recursively

4
gnu/packages/freedesktop.scm
View file

@ -1882,7 +1882,7 @@ that wish to perform colour calibration.")
(define-public libfprint (define-public libfprint
(package (package
(name "libfprint") (name "libfprint")
(version "1.94.4") (version "1.94.5")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -1891,7 +1891,7 @@ that wish to perform colour calibration.")
(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 "1wfd2svsq26wizhsaifnr74havswbc1rlfm79b36yrhw9n7c3jqb")))) (base32 "1l1ak7y2kz0nrdkfj41n7h34dyykgzdg50y752ayk3ginp6szr7r"))))
(build-system meson-build-system) (build-system meson-build-system)
(arguments (arguments
(list #:configure-flags (list #:configure-flags

2
gnu/packages/ftp.scm
View file

@ -240,7 +240,7 @@ output.
nettle nettle
pugixml pugixml
sqlite sqlite
wxwidgets)) wxwidgets-3.0))
(home-page "https://filezilla-project.org") (home-page "https://filezilla-project.org")
(synopsis "Full-featured graphical FTP/FTPS/SFTP client") (synopsis "Full-featured graphical FTP/FTPS/SFTP client")
(description (description

24
gnu/packages/games.scm
View file

@ -1427,7 +1427,7 @@ real-time combat.")
(define-public golly (define-public golly
(package (package
(name "golly") (name "golly")
(version "3.3") (version "4.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/golly/golly/golly-" (uri (string-append "mirror://sourceforge/golly/golly/golly-"
@ -1435,7 +1435,7 @@ real-time combat.")
"-src.tar.gz")) "-src.tar.gz"))
(sha256 (sha256
(base32 (base32
"1j3ksnar4rdam4xiyspgyrs1pifbvxfxkrn65brkwxpx39mpgzc8")))) "0pg9cp83nxc354lizgza5bqdy7z5wh36863203zw6r6s4flji4an"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:make-flags (list "CC=gcc" '(#:make-flags (list "CC=gcc"
@ -1445,17 +1445,7 @@ real-time combat.")
#:tests? #f ; no check target #:tests? #f ; no check target
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(replace 'configure (delete 'configure)
(lambda* (#:key inputs #:allow-other-keys)
;; For some reason, setting the PYTHON_SHLIB make flag doesn't
;; properly set the path to the Python shared library. This
;; substitution acheives the same end by different means.
(substitute* "gui-wx/wxprefs.cpp"
(("pythonlib = wxT\\(STRINGIFY\\(PYTHON_SHLIB\\)\\)")
(string-append "pythonlib = \""
(assoc-ref inputs "python")
"/lib/libpython-2.7.so\"")))
#t))
(replace 'build (replace 'build
(lambda* (#:key make-flags outputs #:allow-other-keys) (lambda* (#:key make-flags outputs #:allow-other-keys)
(with-directory-excursion "gui-wx" (with-directory-excursion "gui-wx"
@ -1485,11 +1475,7 @@ real-time combat.")
(native-inputs (native-inputs
(list lua)) (list lua))
(inputs (inputs
`(("glu" ,glu) (list glu mesa python sdl2 wxwidgets zlib))
("mesa" ,mesa)
("python" ,python-2)
("wxwidgets" ,wxwidgets-gtk2)
("zlib" ,zlib)))
(home-page "http://golly.sourceforge.net/") (home-page "http://golly.sourceforge.net/")
(synopsis "Software for exploring cellular automata") (synopsis "Software for exploring cellular automata")
(description (description
@ -6151,7 +6137,7 @@ starting a decryption sequence to reveal the original plaintext characters.")
libvorbis libvorbis
lua lua
sdl2 sdl2
wxwidgets)) wxwidgets-3.0))
(native-inputs (native-inputs
(list cppunit pkg-config)) (list cppunit pkg-config))
(arguments (arguments

2
gnu/packages/geo.scm
View file

@ -2158,7 +2158,7 @@ exchanged form one Spatial DBMS and the other.")
sqlite sqlite
tinyxml tinyxml
wxsvg wxsvg
wxwidgets wxwidgets-3.0
xz xz
zlib)) zlib))
(arguments (arguments

2
gnu/packages/gnome.scm
View file

@ -7292,7 +7292,7 @@ almost all of them.")
("gtkspell3" ,gtkspell3) ("gtkspell3" ,gtkspell3)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas) ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("gnome-settings-daemon" ,gnome-settings-daemon) ; desktop-schemas are not enough ("gnome-settings-daemon" ,gnome-settings-daemon) ; desktop-schemas are not enough
("webkitgtk" ,webkitgtk))) ("webkitgtk" ,webkitgtk-with-libsoup2)))
(home-page "https://wiki.gnome.org/Apps/Eolie") (home-page "https://wiki.gnome.org/Apps/Eolie")
(synopsis "Web browser for GNOME") (synopsis "Web browser for GNOME")
(description (description

4
gnu/packages/gnupg.scm
View file

@ -485,7 +485,7 @@ gpgpme starting with version 1.7.")
(define-public guile-gcrypt (define-public guile-gcrypt
(package (package
(name "guile-gcrypt") (name "guile-gcrypt")
(version "0.3.0") (version "0.4.0")
(home-page "https://notabug.org/cwebber/guile-gcrypt") (home-page "https://notabug.org/cwebber/guile-gcrypt")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -494,7 +494,7 @@ gpgpme starting with version 1.7.")
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(sha256 (sha256
(base32 (base32
"0m29fg4pdfifnqqsa437zc5c1bhbfh62mc69ba25ak4x2cla41ll")) "0m75h9q10yb27kzjsvhhq0yk3jaxiy9bpbfd9qg269hf9gabgfdx"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

149
gnu/packages/gnuzilla.scm
View file

@ -19,7 +19,6 @@
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Baptiste Strazzul <bstrazzull@hotmail.fr> ;;; Copyright © 2021 Baptiste Strazzul <bstrazzull@hotmail.fr>
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -85,7 +84,6 @@
#:use-module (gnu packages assembly) #:use-module (gnu packages assembly)
#:use-module (gnu packages rust) #:use-module (gnu packages rust)
#:use-module (gnu packages rust-apps) #:use-module (gnu packages rust-apps)
#:use-module (gnu packages crates-io)
#:use-module (gnu packages llvm) #:use-module (gnu packages llvm)
#:use-module (gnu packages nss) #:use-module (gnu packages nss)
#:use-module (gnu packages icu4c) #:use-module (gnu packages icu4c)
@ -350,148 +348,6 @@ in C/C++.")
(inputs (inputs
(list icu4c readline zlib)))) (list icu4c readline zlib))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Temporary packaging of rust-cbindgen-0.23 and its dependencies
;; follow, pending their inclusion into (gnu packages rust-apps)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define rust-textwrap-0.15-promise
(delay
(package
(inherit rust-textwrap-0.12)
(name "rust-textwrap")
(version "0.15.0")
(source (origin
(method url-fetch)
(uri (crate-uri "textwrap" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1yw513k61lfiwgqrfvsjw1a5wpvm0azhpjr2kr0jhnq9c56is55i"))))
(arguments
`(#:skip-build? #t
#:cargo-inputs (("rust-hyphenation" ,rust-hyphenation-0.8)
("rust-smawk" ,rust-smawk-0.3)
("rust-terminal-size" ,rust-terminal-size-0.1)
("rust-unicode-linebreak" ,rust-unicode-linebreak-0.1)
("rust-unicode-width" ,rust-unicode-width-0.1)))))))
(define rust-clap-lex-0.2
(package
(name "rust-clap-lex")
(version "0.2.4")
(source (origin
(method url-fetch)
(uri (crate-uri "clap_lex" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1ib1a9v55ybnaws11l63az0jgz5xiy24jkdgsmyl7grcm3sz4l18"))))
(build-system cargo-build-system)
(arguments
`(#:skip-build? #t
#:cargo-inputs (("rust-os-str-bytes" ,rust-os-str-bytes-6))))
(home-page "https://github.com/clap-rs/clap/tree/master/clap_lex")
(synopsis "Minimal, flexible command line parser")
(description "Minimal, flexible command line parser")
(license (list license:expat license:asl2.0))))
(define rust-clap-derive-3.2.15-promise
(delay
(package
(inherit rust-clap-derive-3)
(name "rust-clap-derive")
(version "3.2.15")
(source (origin
(method url-fetch)
(uri (crate-uri "clap_derive" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1d2c4vs345fwihkd8cc7m6acbiydcwramkd5mnp36p0a7g6jm9cv"))))
(arguments
`(#:skip-build? #t
#:cargo-inputs (("rust-heck" ,rust-heck-0.4)
("rust-proc-macro-error" ,rust-proc-macro-error-1)
("rust-proc-macro2" ,rust-proc-macro2-1)
("rust-quote" ,rust-quote-1)
("rust-syn" ,rust-syn-1)))))))
(define rust-clap-3.2.16-promise
(delay
(package
(inherit rust-clap-3)
(name "rust-clap")
(version "3.2.16")
(source (origin
(method url-fetch)
(uri (crate-uri "clap" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1af06z8z7m3327yz1xvzxfjanclgpvvy3lssb745rig7adkbpnx3"))))
(arguments
`(#:skip-build? #t
#:cargo-inputs (("rust-atty" ,rust-atty-0.2)
("rust-backtrace" ,rust-backtrace-0.3)
("rust-bitflags" ,rust-bitflags-1)
("rust-clap-derive" ,(force rust-clap-derive-3.2.15-promise))
("rust-clap-lex" ,rust-clap-lex-0.2)
("rust-indexmap" ,rust-indexmap-1)
("rust-once-cell" ,rust-once-cell-1)
("rust-regex" ,rust-regex-1)
("rust-strsim" ,rust-strsim-0.10)
("rust-termcolor" ,rust-termcolor-1)
("rust-terminal-size" ,rust-terminal-size-0.1)
("rust-textwrap" ,(force rust-textwrap-0.15-promise))
("rust-unicase" ,rust-unicase-2)
("rust-yaml-rust" ,rust-yaml-rust-0.4)))))))
(define rust-cbindgen-0.24-promise
(delay
(package
(inherit rust-cbindgen-0.19)
(name "rust-cbindgen")
(version "0.24.3")
(source (origin
(method url-fetch)
(uri (crate-uri "cbindgen" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1yqxqsz2d0cppd8zwihk2139g5gy38wqgl9snj6rnk8gyvnqsdd6"))))
(arguments
`(#:cargo-inputs (("rust-clap" ,(force rust-clap-3.2.16-promise))
("rust-heck" ,rust-heck-0.4)
("rust-indexmap" ,rust-indexmap-1)
("rust-log" ,rust-log-0.4)
("rust-proc-macro2" ,rust-proc-macro2-1)
("rust-quote" ,rust-quote-1)
("rust-serde" ,rust-serde-1)
("rust-serde-json" ,rust-serde-json-1)
("rust-syn" ,rust-syn-1)
("rust-tempfile" ,rust-tempfile-3)
("rust-toml" ,rust-toml-0.5))
#:cargo-development-inputs (("rust-serial-test" ,rust-serial-test-0.5)))))))
;; Bug with IceCat 102 with cbindgen-0.24, see
;; https://bugzilla.mozilla.org/show_bug.cgi?id=1773259#c5 for
;; possible patch (untested)
(define rust-cbindgen-0.23-promise
(delay
(package
(inherit (force rust-cbindgen-0.24-promise))
(name "rust-cbindgen")
(version "0.23.0")
(source (origin
(method url-fetch)
(uri (crate-uri "cbindgen" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"006rn3fn4njayjxr2vd24g1awssr9i3894nbmfzkybx07j728vav")))))))
(define mozilla-compare-locales (define mozilla-compare-locales
(origin (origin
(method hg-fetch) (method hg-fetch)
@ -865,10 +721,9 @@ in C/C++.")
;; ,(search-patch "icecat-use-system-graphite2+harfbuzz.patch")) ;; ,(search-patch "icecat-use-system-graphite2+harfbuzz.patch"))
;; ("icecat-use-system-media-libs.patch" ;; ("icecat-use-system-media-libs.patch"
;; ,(search-patch "icecat-use-system-media-libs.patch")) ;; ,(search-patch "icecat-use-system-media-libs.patch"))
;; TODO: Change the following lines to use 'rust' when it's >= 1.59.
rust rust
`(,rust "cargo") `(,rust "cargo")
(force rust-cbindgen-0.23-promise) rust-cbindgen-0.23
llvm llvm
clang clang
perl perl
@ -1551,7 +1406,7 @@ ca495991b7852b855"))
pkg-config pkg-config
python-wrapper python-wrapper
rust rust
(force rust-cbindgen-0.23-promise) rust-cbindgen-0.23
which which
yasm)) yasm))
(home-page "https://www.thunderbird.net") (home-page "https://www.thunderbird.net")

15
gnu/packages/golang.scm
View file

@ -6259,6 +6259,21 @@ systems.")
(modify-inputs (package-inputs go-github-com-gdamore-tcell) (modify-inputs (package-inputs go-github-com-gdamore-tcell)
(prepend go-golang-org-x-term go-golang-org-x-sys))))) (prepend go-golang-org-x-term go-golang-org-x-sys)))))
(define-public go-github-com-gdamore-tcell-v2-2.3
(package
(inherit go-github-com-gdamore-tcell-v2)
(name "go-github-com-gdamore-tcell")
(version "2.3.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/gdamore/tcell")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "0ypbl5080q9sd3irad8mv7zlg4242i8pmg5xyhbyq95kymwibaid"))))))
(define-public go-git-sr-ht-rockorager-tcell-term (define-public go-git-sr-ht-rockorager-tcell-term
(package (package
(name "go-git-sr-ht-rockorager-tcell-term") (name "go-git-sr-ht-rockorager-tcell-term")

2
gnu/packages/gstreamer.scm
View file

@ -794,7 +794,7 @@ model to base your own plug-in on, here it is.")
;; This test is flaky on at least some architectures. ;; This test is flaky on at least some architectures.
;; https://gitlab.freedesktop.org/gstreamer/gstreamer/-/issues/1244 ;; https://gitlab.freedesktop.org/gstreamer/gstreamer/-/issues/1244
#$@(if (member (%current-system) #$@(if (member (%current-system)
'("i686-linux" "aarch64-linux")) '("i686-linux" "aarch64-linux" "riscv64-linux"))
`((("'elements/camerabin\\.c'\\]\\],") `((("'elements/camerabin\\.c'\\]\\],")
"'elements/camerabin.c'], true, ],")) "'elements/camerabin.c'], true, ],"))
'()) '())

14
gnu/packages/gtk.scm
View file

@ -344,6 +344,20 @@ output. Experimental backends include OpenGL, BeOS, OS/2, and DirectFB.")
(base32 (base32
"0c5mzwgz43d37h75p4b6cgjg4v24jdd96i7gjpgxirn8qks2i5m4")))))) "0c5mzwgz43d37h75p4b6cgjg4v24jdd96i7gjpgxirn8qks2i5m4"))))))
(define-public harfbuzz-5
(package
(inherit harfbuzz)
(version "5.3.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/harfbuzz/harfbuzz"
"/releases/download/" version "/harfbuzz-"
version ".tar.xz"))
(sha256
(base32
"0ka3nkk2lks2lgakq02vyibwdziv11dkpa2brkx230asnyby0v2a"))))))
(define-public libdatrie (define-public libdatrie
(package (package
(name "libdatrie") (name "libdatrie")

23
gnu/packages/hardware.scm
View file

@ -998,7 +998,7 @@ technology, such as head mounted displays with built in head tracking.")
(define-public openrgb (define-public openrgb
(package (package
(name "openrgb") (name "openrgb")
(version "0.7") (version "0.8")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -1007,15 +1007,25 @@ technology, such as head mounted displays with built in head tracking.")
(commit (string-append "release_" version)))) (commit (string-append "release_" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0xhfaz0b74nfnh7il2cz5c0338xlzay00g6hc2h3lsncarj8d5n7")) (base32 "1yz7sdrjcxajm1zpa5djinmych5dvck0r1fvk0x5qmk87va4p9z3"))
(patches (patches
(search-patches "openrgb-unbundle-hueplusplus.patch")) (search-patches "openrgb-unbundle-hueplusplus.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
;; Delete the bundled hueplusplus and json libraries. ;; Delete many of the bundled libraries.
(delete-file-recursively "dependencies/hueplusplus-1.0.0") (for-each delete-file-recursively
(delete-file-recursively "dependencies/json"))))) (list "dependencies/hidapi-win"
"dependencies/hueplusplus-1.0.0"
"dependencies/json"
"dependencies/libusb-1.0.22"
"dependencies/macUSPCIO"
"dependencies/mbedtls-2.24.0"
"dependencies/NVFC"
"dependencies/openrazer-win32"
"dependencies/winring0"
;; Some bundled appimages
"scripts/tools"))))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
(list (list
@ -1044,7 +1054,8 @@ technology, such as head mounted displays with built in head tracking.")
mbedtls-apache mbedtls-apache
qtbase-5)) qtbase-5))
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config
qttools-5))
(synopsis "RGB lighting control") (synopsis "RGB lighting control")
(description (description
"OpenRGB is lighting control that doesn't depend on manufacturer software. "OpenRGB is lighting control that doesn't depend on manufacturer software.

1
gnu/packages/jami.scm
View file

@ -99,6 +99,7 @@
"jami-fix-unit-tests-build.patch" "jami-fix-unit-tests-build.patch"
"jami-fix-qml-imports.patch" "jami-fix-qml-imports.patch"
"jami-no-webengine.patch" "jami-no-webengine.patch"
"jami-sip-contacts.patch"
"jami-sip-unregister.patch" "jami-sip-unregister.patch"
"jami-xcb-link.patch")))) "jami-xcb-link.patch"))))

22
gnu/packages/libreoffice.scm
View file

@ -483,14 +483,14 @@ Apple Keynote documents. It currently supports Keynote versions 2 to 5.")
(define-public liblangtag (define-public liblangtag
(package (package
(name "liblangtag") (name "liblangtag")
(version "0.6.3") (version "0.6.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://bitbucket.org/tagoh/liblangtag/downloads/" (uri (string-append "https://bitbucket.org/tagoh/liblangtag/downloads/"
"liblangtag-" version ".tar.bz2")) "liblangtag-" version ".tar.bz2"))
(sha256 (sha256
(base32 "1g9kwxx60q0hpwvs66ys1cb9qg54hfvbivadwli8sfpc085a44hz")))) (base32 "0r55r30ih8dgq1hwbpl834igilj7bpxcnmlrlkd3vryk2wn0c0ap"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
(list libtool pkg-config)) (list libtool pkg-config))
@ -745,14 +745,14 @@ from the old StarOffice (.sdc, .sdw, ...).")
(define-public libwps (define-public libwps
(package (package
(name "libwps") (name "libwps")
(version "0.4.12") (version "0.4.13")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/" name "/" name "/" (uri (string-append "mirror://sourceforge/" name "/" name "/"
name "-" version "/" name "-" version ".tar.xz")) name "-" version "/" name "-" version ".tar.xz"))
(sha256 (base32 (sha256 (base32
"1nsfacqp5sfkyayw7q0wp68lidksd1wjdix8qmsbf0vdl19gn6p2")))) "03y4aslp5lfqc14agn0hgkifwrknh8s4hfjll9wrfs1hq3kaz5ff"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
(list doxygen pkg-config)) (list doxygen pkg-config))
@ -992,7 +992,7 @@ spell-checking library.")
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
(list perl)) (list perl))
(home-page "http://hunspell.sourceforge.net/") (home-page "https://hunspell.github.io/")
(synopsis "Hyphenation library") (synopsis "Hyphenation library")
(description "Hyphen is a hyphenation library using TeX hyphenation (description "Hyphen is a hyphenation library using TeX hyphenation
patterns, which are pre-processed by a perl script.") patterns, which are pre-processed by a perl script.")
@ -1050,20 +1050,20 @@ spell-checking library.")
(define-public mythes (define-public mythes
(package (package
(name "mythes") (name "mythes")
(version "1.2.4") (version "1.2.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/hunspell/MyThes/" version "/" (uri (string-append "https://github.com/hunspell/mythes/releases/"
name "-" version ".tar.gz")) "download/v" version "/mythes-" version ".tar.xz"))
(sha256 (base32 (sha256
"0prh19wy1c74kmzkkavm9qslk99gz8h8wmjvwzjc6lf8v2az708y")))) (base32 "07ajdyyif19k445dqffkm32c1kl8z0cw6bczc7x5zgkvf1q9y9qr"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))
(inputs (inputs
(list hunspell perl)) (list hunspell perl))
(home-page "http://hunspell.sourceforge.net/") (home-page "https://hunspell.github.io/")
(synopsis "Thesaurus") (synopsis "Thesaurus")
(description "MyThes is a simple thesaurus that uses a structured text (description "MyThes is a simple thesaurus that uses a structured text
data file and an index file with binary search to look up words and phrases data file and an index file with binary search to look up words and phrases

171
gnu/packages/linux.scm
View file

@ -67,6 +67,7 @@
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Hunter Jozwiak <hunter.t.joz@gmail.com> ;;; Copyright © 2022 Hunter Jozwiak <hunter.t.joz@gmail.com>
;;; Copyright © 2022 Hilton Chain <hako@ultrarare.space> ;;; Copyright © 2022 Hilton Chain <hako@ultrarare.space>
;;; Copyright © 2022 Stefan <stefan-guix@vodafonemail.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -189,11 +190,31 @@
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex)) #:use-module (ice-9 regex)
#:export (customize-linux
make-defconfig))
(define (linux-srcarch)
"Return the linux SRCARCH name, which is set in the toplevel Makefile of
Linux and denotes the architecture-specific directory name below arch/ in its
source code. Some few architectures share a common folder. It resembles the
definition of SRCARCH based on ARCH in the Makefile and may be used to place a
defconfig file in the proper path."
(let ((linux-arch (platform-linux-architecture
(lookup-platform-by-target-or-system
(or (%current-target-system)
(%current-system))))))
(match linux-arch
("i386" "x86")
("x86_64" "x86")
("sparc32" "sparc")
("sparc64" "sparc")
("sh64" "sh")
(_ linux-arch))))
(define-public (system->defconfig system) (define-public (system->defconfig system)
"Some systems (notably powerpc-linux) require a special target for kernel "Some systems (notably powerpc-linux) require a special target for kernel
defconfig. Return the appropriate make target if applicable, otherwise return defconfig. Return the appropriate Make target if applicable, otherwise return
\"defconfig\"." \"defconfig\"."
(cond ((string-prefix? "powerpc-" system) "pmac32_defconfig") (cond ((string-prefix? "powerpc-" system) "pmac32_defconfig")
((string-prefix? "powerpc64-" system) "ppc64_defconfig") ((string-prefix? "powerpc64-" system) "ppc64_defconfig")
@ -846,8 +867,8 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(string-append "infodir=" #$output (string-append "infodir=" #$output
"/share/info")))))) "/share/info"))))))
#~()) #~())
(replace 'configure (add-before 'configure 'set-environment
(lambda* (#:key inputs target #:allow-other-keys) (lambda* (#:key target #:allow-other-keys)
;; Avoid introducing timestamps. ;; Avoid introducing timestamps.
(setenv "KCONFIG_NOTIMESTAMP" "1") (setenv "KCONFIG_NOTIMESTAMP" "1")
(setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH")) (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
@ -863,18 +884,21 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(%current-system)))))) (%current-system))))))
(setenv "ARCH" arch) (setenv "ARCH" arch)
(format #t "`ARCH' set to `~a'~%" (getenv "ARCH")) (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
(when target (when target
(setenv "CROSS_COMPILE" (string-append target "-")) (setenv "CROSS_COMPILE" (string-append target "-"))
(format #t "`CROSS_COMPILE' set to `~a'~%" (format #t "`CROSS_COMPILE' set to `~a'~%"
(getenv "CROSS_COMPILE")))) (getenv "CROSS_COMPILE"))))
;; Allow EXTRAVERSION to be set via the environment.
(substitute* "Makefile"
(("^ *EXTRAVERSION[[:blank:]]*=")
"EXTRAVERSION ?="))
(setenv "EXTRAVERSION" (setenv "EXTRAVERSION"
#$(and extra-version #$(and extra-version
(string-append "-" extra-version))) (string-append "-" extra-version)))))
(replace 'configure
(lambda* (#:key inputs #:allow-other-keys)
(let ((config (assoc-ref inputs "kconfig"))) (let ((config (assoc-ref inputs "kconfig")))
;; Use a custom kernel configuration file or a default ;; Use a custom kernel configuration file or a default
;; configuration file. ;; configuration file.
(if config (if config
@ -882,17 +906,15 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(copy-file config ".config") (copy-file config ".config")
(chmod ".config" #o666)) (chmod ".config" #o666))
(invoke "make" #$defconfig)) (invoke "make" #$defconfig))
;; Appending works even when the option wasn't in the ;; Appending works even when the option wasn't in the
;; file. The last one prevails if duplicated. ;; file. The last one prevails if duplicated.
(let ((port (open-file ".config" "a")) (let ((port (open-file ".config" "a"))
(extra-configuration #$(config->string extra-options))) (extra-configuration #$(config->string extra-options)))
(display extra-configuration port) (display extra-configuration port)
(close-port port)) (close-port port))
(invoke "make" "oldconfig")))) (invoke "make" "oldconfig"))))
(replace 'install (replace 'install
(lambda* (#:key inputs native-inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(let ((moddir (string-append #$output "/lib/modules")) (let ((moddir (string-append #$output "/lib/modules"))
(dtbdir (string-append #$output "/lib/dtbs"))) (dtbdir (string-append #$output "/lib/dtbs")))
;; Install kernel image, kernel configuration and link map. ;; Install kernel image, kernel configuration and link map.
@ -1238,6 +1260,110 @@ Linux kernel. It has been modified to remove all non-free binary blobs.")
(inputs (modify-inputs (package-inputs base-linux-libre) (inputs (modify-inputs (package-inputs base-linux-libre)
(prepend cpio)))))) (prepend cpio))))))
;;;
;;; Linux kernel customization functions.
;;;
(define* (customize-linux #:key name
(linux linux-libre)
source
defconfig
(configs "")
extra-version)
"Make a customized Linux package NAME derived from the LINUX package.
If NAME is not given, then it defaults to the same name as the LINUX package.
Unless SOURCE is given the source of LINUX is used.
A DEFCONFIG file to be used can be given as an origin, as a file-like object
(file-append, local-file etc.), or as a string with the name of a defconfig file
available in the Linux sources. If DEFCONFIG is not given, then a defconfig
file will be saved from the LINUX package configuration.
Additional CONFIGS will be used to modify the given or saved defconfig, which
will finally be used to build Linux.
CONFIGS can be a list of strings, with one configuration per line. The usual
defconfig syntax has to be used, but there is a special extension to ease the
removal of configurations. Comment lines are supported as well.
Here is an example:
'(;; This string defines the version tail in 'uname -r'.
\"CONFIG_LOCALVERSION=\\\"-handcrafted\\\"
;; This '# CONFIG_... is not set' syntax has to match exactly!
\"# CONFIG_BOOT_CONFIG is not set\"
\"CONFIG_NFS_SWAP=y\"
;; This is a multiline configuration:
\"CONFIG_E1000=y
# This is a comment, below follows an extension to unset a configuration:
CONFIG_CMDLINE_EXTEND\")
A string of configurations instead of a list of configuration strings is also
possible.
EXTRA-VERSION can be a string overwriting the EXTRAVERSION setting of the LINUX
package, after being prepended by a hyphen. It will be visible in the output
of 'uname -r' behind the Linux version numbers."
(package
(inherit linux)
(name (or name (package-name linux)))
(source (or source (package-source linux)))
(arguments
(substitute-keyword-arguments
(package-arguments linux)
((#:imported-modules imported-modules %gnu-build-system-modules)
`((guix build kconfig) ,@imported-modules))
((#:modules modules)
`((guix build kconfig) ,@modules))
((#:phases phases)
#~(modify-phases #$phases
(replace 'configure
(lambda* (#:key inputs #:allow-other-keys #:rest arguments)
(setenv "EXTRAVERSION"
#$(and extra-version
(not (string-null? extra-version))
(string-append "-" extra-version)))
(let* ((configs
(string-append "arch/" #$(linux-srcarch) "/configs/"))
(guix_defconfig
(string-append configs "guix_defconfig")))
#$(cond
((not defconfig)
#~(begin
;; Call the original 'configure phase.
(apply (assoc-ref #$phases 'configure) arguments)
;; Save a defconfig file.
(invoke "make" "savedefconfig")
;; Move the saved defconfig to the proper location.
(rename-file "defconfig"
guix_defconfig)))
((string? defconfig)
;; Use another existing defconfig from the Linux sources.
#~(rename-file (string-append configs #$defconfig)
guix_defconfig))
(else
;; Copy the defconfig input to the proper location.
#~(copy-file (assoc-ref inputs "guix_defconfig")
guix_defconfig)))
(chmod guix_defconfig #o644)
(modify-defconfig guix_defconfig '#$configs)
(invoke "make" "guix_defconfig")
(verify-config ".config" guix_defconfig))))))))
(native-inputs
(append (if (or (not defconfig)
(string? defconfig))
'()
;; The defconfig should be an origin or file-like object.
`(("guix_defconfig" ,defconfig)))
(package-native-inputs linux)))))
(define (make-defconfig uri sha256-as-base32)
(origin (method url-fetch)
(uri uri)
(sha256 (base32 sha256-as-base32))))
;;; ;;;
@ -3151,7 +3277,7 @@ devices. It replaces @code{iwconfig}, which is deprecated.")
(define-public powertop (define-public powertop
(package (package
(name "powertop") (name "powertop")
(version "2.14") (version "2.15")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -3160,7 +3286,7 @@ devices. It replaces @code{iwconfig}, which is deprecated.")
(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 "1zkr2y5nb1nr22nq8a3zli87iyfasfq6489p7h1k428pv8k45w4f")))) (base32 "10vbk4vplmzp3p1mhwnhj81g6i5xvam9pdvmiy6cmd0xvnmdyy77"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags
@ -3179,18 +3305,17 @@ devices. It replaces @code{iwconfig}, which is deprecated.")
;; These programs are only needed to calibrate, so using ;; These programs are only needed to calibrate, so using
;; relative file names avoids adding extra inputs. When they ;; relative file names avoids adding extra inputs. When they
;; are missing powertop gracefully handles it. ;; are missing powertop gracefully handles it.
(("/usr/bin/hcitool") "hcitool") (("/usr/s?bin/(hciconfig|hcitool|xset)" _ command)
(("/usr/bin/xset") "xset") command))))))))
(("/usr/sbin/hciconfig") "hciconfig")) (native-inputs
#t)))))) (list autoconf
autoconf-archive
automake
gettext-minimal
libtool
pkg-config))
(inputs (inputs
(list kmod libnl ncurses pciutils zlib)) (list kmod libnl ncurses pciutils zlib))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("gettext" ,gettext-minimal)
("libtool" ,libtool)
("pkg-config" ,pkg-config)))
(home-page "https://01.org/powertop/") (home-page "https://01.org/powertop/")
(synopsis "Analyze power consumption on Intel-based laptops") (synopsis "Analyze power consumption on Intel-based laptops")
(description (description

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

@ -454,6 +454,41 @@ It's intended as a simpler alternative to parser generators.")
(define-public ecl-meta (define-public ecl-meta
(sbcl-package->ecl-package sbcl-meta)) (sbcl-package->ecl-package sbcl-meta))
(define-public sbcl-clavier
(let ((commit "048bea40cac0a89480f8c41ae542be45945f3268")
(revision "0"))
(package
(name "sbcl-clavier")
(version (git-version "0.0.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/mmontone/clavier")
(commit commit)))
(file-name (git-file-name "cl-clavier" version))
(sha256
(base32 "0734xia2hf7lqkm59gjhyvpsp0vl50djyhy4llwwbzbwwdkdihw4"))))
(build-system asdf-build-system/sbcl)
(native-inputs (list sbcl-stefil))
(inputs
(list sbcl-alexandria
sbcl-chronicity
sbcl-cl-fad
sbcl-cl-ppcre
sbcl-closer-mop))
(home-page "https://github.com/mmontone/clavier/")
(synopsis "General purpose validation library")
(description "Clavier is a general purpose validation library for
Common Lisp.")
(license license:expat))))
(define-public cl-clavier
(sbcl-package->cl-source-package sbcl-clavier))
(define-public ecl-clavier
(sbcl-package->ecl-package sbcl-clavier))
(define-public sbcl-cl-inotify (define-public sbcl-cl-inotify
(let ((commit "66f29e01ec28355ebba8292411b4de90eebd76a3") (let ((commit "66f29e01ec28355ebba8292411b4de90eebd76a3")
(revision "0")) (revision "0"))
@ -2516,7 +2551,7 @@ clause if no operation becomes available within a set amount of time.
Calispel is a message-passing library, and as such leaves the role of Calispel is a message-passing library, and as such leaves the role of
threading abstractions and utilities left to be filled by complementary threading abstractions and utilities left to be filled by complementary
libraries such as Bordeaux-Threads and Eager Future.") libraries such as Bordeaux-Threads and Eager Future.")
(home-page "https://www.thoughtcrime.us/software/jpl-queues/") (home-page "https://www.thoughtcrime.us/software/calispel/")
(license license:isc)))) (license license:isc))))
(define-public cl-calispel (define-public cl-calispel
@ -18124,6 +18159,35 @@ long-running threads. In principle, it is like an in-Lisp process supervisor.")
(define-public ecl-moira (define-public ecl-moira
(sbcl-package->ecl-package sbcl-moira)) (sbcl-package->ecl-package sbcl-moira))
(define-public sbcl-with-user-abort
(let ((commit "60693b4a1354faf17107ad6003b0b870cca37081")
(revision "0"))
(package
(name "sbcl-with-user-abort")
(version (git-version "0.1" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/compufox/with-user-abort")
(commit commit)))
(file-name (git-file-name "cl-with-user-abort" version))
(sha256
(base32 "0k1xxfvncdw4fx8nncis1ma128bqq05zky1mrzak5rjbivzjm8j1"))))
(build-system asdf-build-system/sbcl)
(home-page "https://github.com/compufox/with-user-abort")
(synopsis "Portability library for catching SIGINT from Common Lisp")
(description
"@code{with-user-abort} is a Common Lisp portability library providing a
like-named macro that catches the SIGINT signal.")
(license license:bsd-3))))
(define-public cl-with-user-abort
(sbcl-package->cl-source-package sbcl-with-user-abort))
(define-public ecl-with-user-abort
(sbcl-package->ecl-package sbcl-with-user-abort))
(define-public sbcl-cl-package-locks (define-public sbcl-cl-package-locks
(let ((commit "96a358ede7cef416d61d2f699e724fe1d9de602c") (let ((commit "96a358ede7cef416d61d2f699e724fe1d9de602c")
(revision "1")) (revision "1"))

7
gnu/packages/lisp.scm
View file

@ -423,17 +423,14 @@ an interpreter, a compiler, a debugger, and much more.")
(define-public sbcl (define-public sbcl
(package (package
(name "sbcl") (name "sbcl")
(version "2.2.10") (version "2.2.11")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/sbcl/sbcl/" version "/sbcl-" (uri (string-append "mirror://sourceforge/sbcl/sbcl/" version "/sbcl-"
version "-source.tar.bz2")) version "-source.tar.bz2"))
(patches
;; TODO: remove this patch when updating to sbcl > 2.2.10.
(search-patches "sbcl-fix-build-on-arm64-with-clisp-as-host.patch"))
(sha256 (sha256
(base32 "0cq8x4svkawirxq5s5gs4qxkl23m4q5p722a2kpss8qjfslc7hwc")) (base32 "1pwnhjp0fmkcgq11a6hj36gw8k05qramspgdbj28063k2s0dc1rn"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

136
gnu/packages/mail.scm
View file

@ -50,6 +50,7 @@
;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2022 muradm <mail@muradm.net> ;;; Copyright © 2022 muradm <mail@muradm.net>
;;; Copyright © 2022 jgart <jgart@dismail.de> ;;; Copyright © 2022 jgart <jgart@dismail.de>
;;; Copyright © 2022 ( <paren@disroot.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -151,6 +152,7 @@
#:use-module (gnu packages rdf) #:use-module (gnu packages rdf)
#:use-module (gnu packages readline) #:use-module (gnu packages readline)
#:use-module (gnu packages ruby) #:use-module (gnu packages ruby)
#:use-module (gnu packages rust-apps)
#:use-module (gnu packages search) #:use-module (gnu packages search)
#:use-module (gnu packages serialization) #:use-module (gnu packages serialization)
#:use-module (gnu packages samba) #:use-module (gnu packages samba)
@ -3811,14 +3813,14 @@ tools and applications:
(define-public balsa (define-public balsa
(package (package
(name "balsa") (name "balsa")
(version "2.6.3") (version "2.6.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pawsa.fedorapeople.org/balsa/" (uri (string-append "https://pawsa.fedorapeople.org/balsa/"
"balsa-" version ".tar.xz")) "balsa-" version ".tar.xz"))
(sha256 (sha256
(base32 "1m0x3rk7cp7slr47rmg4y91rbxgs652v706lyxj600m5r5v4bl6l")))) (base32 "1hcgmjka2x2igdrmvzlfs12mv892kv4vzv5iy90kvcqxa625kymy"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags
@ -3831,7 +3833,13 @@ tools and applications:
"--with-gpgme" "--with-gpgme"
"--with-sqlite" "--with-sqlite"
"--with-compface" "--with-compface"
"--with-ldap"))) "--with-ldap")
#:phases (modify-phases %standard-phases
(add-after 'unpack 'adjust-for-new-webkitgtk
(lambda _
(substitute* "configure"
(("webkit2gtk-4.0")
"webkit2gtk-4.1")))))))
(inputs (inputs
(list cyrus-sasl (list cyrus-sasl
enchant enchant
@ -3840,7 +3848,7 @@ tools and applications:
gnutls gnutls
gpgme gpgme
gtk+ gtk+
gtksourceview gtksourceview-4
gtkspell3 gtkspell3
libassuan ; in gpgme.pc Requires libassuan ; in gpgme.pc Requires
libcanberra libcanberra
@ -3860,6 +3868,9 @@ tools and applications:
the GNOME desktop. It supports both POP3 and IMAP servers as well as the the GNOME desktop. It supports both POP3 and IMAP servers as well as the
mbox, maildir and mh local mailbox formats. Balsa also supports SMTP and/or mbox, maildir and mh local mailbox formats. Balsa also supports SMTP and/or
the use of a local MTA such as Sendmail.") the use of a local MTA such as Sendmail.")
(properties
'((release-monitoring-url
. "https://pawsa.fedorapeople.org/balsa/download.html")))
(license license:gpl3+))) (license license:gpl3+)))
(define-public afew (define-public afew
@ -4754,3 +4765,120 @@ addresses.")
mailserver on their machine. It enables these users to send their mail over a mailserver on their machine. It enables these users to send their mail over a
remote SMTP server.") remote SMTP server.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public aerc
(package
(name "aerc")
(version "0.13.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.sr.ht/~rjarry/aerc")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"18rykklc0ppl53sm9lzhrw6kv4rcc7x45nv7qii7m4qads2pyjm5"))))
(build-system go-build-system)
(arguments
(list #:import-path "git.sr.ht/~rjarry/aerc"
;; Installing the source is only necessary for Go libraries.
#:install-source? #f
#:build-flags
#~(list "-tags=notmuch" "-ldflags"
(string-append "-X main.Version=" #$version
" -X git.sr.ht/~rjarry/aerc/config.shareDir="
#$output "/share/aerc"))
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'patch-paths
(lambda* (#:key import-path inputs #:allow-other-keys)
(with-directory-excursion
(string-append "src/" import-path)
(substitute* (list "config/config.go"
"lib/templates/template.go"
"widgets/compose.go"
"widgets/msgviewer.go"
"worker/maildir/worker.go"
"worker/notmuch/worker.go")
(("\"sh\"")
(string-append
"\"" (search-input-file inputs "bin/sh")
"\"")))
(substitute* "commands/z.go"
(("\"zoxide\"")
(string-append
"\"" (search-input-file inputs "bin/zoxide")
"\"")))
(substitute* (list "lib/crypto/gpg/gpg.go"
"lib/crypto/gpg/gpg_test.go"
"lib/crypto/gpg/gpgbin/keys.go"
"lib/crypto/gpg/gpgbin/gpgbin.go")
(("\"gpg\"")
(string-append
"\"" (search-input-file inputs "bin/gpg")
"\""))
(("strings\\.Contains\\(stderr\\.String\\(\\), .*\\)")
"strings.Contains(stderr.String(), \"gpg\")")))))
(add-after 'build 'doc
(lambda* (#:key import-path build-flags #:allow-other-keys)
(invoke "make" "doc" "-C"
(string-append "src/" import-path))))
(replace 'install
(lambda* (#:key import-path build-flags #:allow-other-keys)
(invoke "make" "install" "-C"
(string-append "src/" import-path)
(string-append "PREFIX=" #$output)))))))
(inputs (list gnupg
go-github-com-zenhack-go-notmuch
go-golang-org-x-oauth2
go-github-com-xo-terminfo
go-github-com-stretchr-testify
go-github-com-riywo-loginshell
go-github-com-pkg-errors
go-github-com-mitchellh-go-homedir
go-github-com-miolini-datacounter
go-github-com-mattn-go-runewidth
go-github-com-mattn-go-isatty
go-github-com-lithammer-fuzzysearch
go-github-com-kyoh86-xdg
go-github-com-imdario-mergo
go-github-com-google-shlex
go-github-com-go-ini-ini
go-github-com-gdamore-tcell-v2
go-github-com-gatherstars-com-jwz
go-github-com-fsnotify-fsnotify
go-github-com-emersion-go-smtp
go-github-com-emersion-go-sasl
go-github-com-emersion-go-pgpmail
go-github-com-emersion-go-message
go-github-com-emersion-go-maildir
go-github-com-emersion-go-imap-sortthread
go-github-com-emersion-go-imap
go-github-com-emersion-go-msgauth
go-github-com-emersion-go-mbox
go-github-com-ddevault-go-libvterm
go-github-com-danwakefield-fnmatch
go-github-com-creack-pty
go-github-com-arran4-golang-ical
go-github-com-protonmail-go-crypto
go-github-com-syndtr-goleveldb-leveldb
go-git-sr-ht-sircmpwn-getopt
go-git-sr-ht-rockorager-tcell-term
zoxide))
(native-inputs (list scdoc))
(home-page "https://git.sr.ht/~rjarry/aerc")
(synopsis "Email client for the terminal")
(description "@code{aerc} is a textual email client for terminals. It
features:
@enumerate
@item First-class support for using patches and @code{git send-email}
@item Vi-like keybindings and command system
@item A built-in console
@item Support for multiple accounts
@end enumerate")
;; The license given is MIT/Expat; however, linking against notmuch
;; effectively makes it GPL-3.0-or-later. See this thread discussing it:
;; <https://lists.sr.ht/~rjarry/aerc-devel/%3Cb5cb213a7d0c699a886971658c2476
;; 1073eb2391%40disroot.org%3E>
(license license:gpl3+)))

4
gnu/packages/mpd.scm
View file

@ -581,7 +581,7 @@ mpdevil loads all tags and covers on demand.")
(define-public mympd (define-public mympd
(package (package
(name "mympd") (name "mympd")
(version "10.1.2") (version "10.1.3")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -590,7 +590,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
"1cqq09j7mi7dz5y6l7i0sa6vi2n5zrndnrxnqsi4vcg99fc2vwv8")))) "16cvjwbyb1m88kmgylp95p82a4xdjikmrw9arl6kvmgcbyw317yp"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
(list #:tests? #f)) ; no test target (list #:tests? #f)) ; no test target

62
gnu/packages/music.scm
View file

@ -2463,6 +2463,66 @@ which can modulate the oscillators, filter, and amplitude; distortion and
reverb effects.") reverb effects.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public paulxstretch
(package
(name "paulxstretch")
(version "1.6.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/essej/paulxstretch")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1pff51imfgmgqzc6mdgwd1v9fci0a8hj85fnkdsvkdzbnxdzvs9r"))))
(build-system cmake-build-system)
(arguments
(list #:tests? #f ;no test suite
#:phases
#~(modify-phases %standard-phases
(replace 'install
(lambda _
(let* ((bin (string-append #$output "/bin"))
(lib (string-append #$output "/lib"))
(share (string-append #$output "/share"))
(clap (string-append lib "/clap"))
(vst3 (string-append lib "/vst3")))
(with-directory-excursion
"PaulXStretch_artefacts/RelWithDebInfo"
(install-file "Standalone/paulxstretch" bin)
(install-file "CLAP/PaulXStretch.clap" clap)
(mkdir-p vst3)
(copy-recursively "VST3" vst3)
(install-file (string-append
#$source
"/linux/paulxstretch.desktop")
(string-append share "/applications"))
(install-file
(string-append
#$source
"/images/paulxstretch_icon_1024_rounded.png")
(string-append share "/pixmaps")))))))))
(home-page "https://sonosaurus.com/paulxstretch/")
(native-inputs (list pkg-config))
(inputs (list alsa-lib
curl
fftwf
freetype
jack-1
libx11
libxcursor
libxext
libxinerama
libxrandr))
(supported-systems '("x86_64-linux")) ;pffft.c uses SIMD code
(synopsis "Audio timestretching application and plugin")
(description
"PaulXStretch is an application/plugin is based on the PaulStretch
algorithm (Paul’s Extreme Time Stretch, originally developed by Nasca Octavian
Paul), and specifically the PaulXStretch version from Xenakios.")
(license license:gpl3+)))
(define-public setbfree (define-public setbfree
(package (package
(name "setbfree") (name "setbfree")
@ -3980,7 +4040,7 @@ with a number of bugfixes and changes to improve IT playback.")
(inputs (inputs
(list jack-1 (list jack-1
alsa-lib alsa-lib
wxwidgets-gtk2 wxwidgets-gtk2-3.0
libsndfile libsndfile
libsamplerate libsamplerate
liblo liblo

38
gnu/packages/patches/jami-sip-contacts.patch Normal file
View file

@ -0,0 +1,38 @@
From 3ba007d02bc19e499c8f3c2345302453028831a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Blin?=
<sebastien.blin@savoirfairelinux.com>
Date: Tue, 29 Nov 2022 09:26:20 -0500
Subject: [PATCH] misc: fix incoming message sip
We do not need to check contacts for SIP as it will be considered
automatically as a contact
Change-Id: If78113e9d79dcd695c39c2d12c0441e2cb282737
---
src/libclient/conversationmodel.cpp | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/client-qt/src/libclient/conversationmodel.cpp b/client-qt/src/libclient/conversationmodel.cpp
index dba206bd..5604a17c 100644
--- a/client-qt/src/libclient/conversationmodel.cpp
+++ b/client-qt/src/libclient/conversationmodel.cpp
@@ -3611,8 +3611,12 @@ ConversationModelPimpl::addIncomingMessage(const QString& peerId,
try {
auto contact = linked.owner.contactModel->getContact(peerId);
isRequest = contact.profileInfo.type == profile::Type::PENDING;
- if (isRequest && !contact.isBanned && peerId != linked.owner.profileInfo.uri) {
- addContactRequest(peerId);
+ // if isSip, it will be a contact!
+ auto isSip = linked.owner.profileInfo.type == profile::Type::SIP;
+ if (isSip
+ || (isRequest && !contact.isBanned && peerId != linked.owner.profileInfo.uri)) {
+ if (!isSip)
+ addContactRequest(peerId);
convIds.push_back(storage::beginConversationWithPeer(db, contact.profileInfo.uri));
auto& conv = getConversationForPeerUri(contact.profileInfo.uri).get();
conv.uid = convIds[0];
base-commit: 6f30acf0043d07dcbe63ee8636509885a9b6fd76
--
2.38.1

565
gnu/packages/patches/rust-1.64-fix-riscv64-bootstrap.patch Normal file
View file

@ -0,0 +1,565 @@
https://github.com/rust-lang/rust/commit/263edd43c5255084292329423c61a9d69715ebfa.patch
https://github.com/rust-lang/rust/issues/102155
Issue seen on native builds on riscv64 across multiple Linux
Distributions. An alternative workaround appears to be building stage 1
with debug enabled.
From 27412d1e3e128349bc515c16ce882860e20f037d Mon Sep 17 00:00:00 2001
From: 5225225 <5225225@mailbox.org>
Date: Thu, 14 Jul 2022 22:42:47 +0100
Subject: [PATCH] Use constant eval to do strict validity checks
---
Cargo.lock | 1 +
.../src/intrinsics/mod.rs | 15 +----
compiler/rustc_codegen_ssa/Cargo.toml | 1 +
compiler/rustc_codegen_ssa/src/mir/block.rs | 9 ++-
.../src/const_eval/machine.rs | 2 +-
.../src/interpret/intrinsics.rs | 56 ++++++++--------
compiler/rustc_const_eval/src/lib.rs | 6 ++
.../src/might_permit_raw_init.rs | 40 +++++++++++
compiler/rustc_middle/src/query/mod.rs | 8 +++
compiler/rustc_middle/src/ty/query.rs | 1 +
compiler/rustc_query_impl/src/keys.rs | 12 +++-
compiler/rustc_target/src/abi/mod.rs | 38 +++++------
.../intrinsics/panic-uninitialized-zeroed.rs | 66 ++++++++++++-------
13 files changed, 161 insertions(+), 94 deletions(-)
create mode 100644 compiler/rustc_const_eval/src/might_permit_raw_init.rs
diff --git a/Cargo.lock b/Cargo.lock
index 147d47044078a..dd6f0345affd0 100644
--- a/Cargo.lock
+++ b/Cargo.lock
@@ -3664,6 +3664,7 @@ dependencies = [
"rustc_arena",
"rustc_ast",
"rustc_attr",
+ "rustc_const_eval",
"rustc_data_structures",
"rustc_errors",
"rustc_fs_util",
diff --git a/compiler/rustc_codegen_cranelift/src/intrinsics/mod.rs b/compiler/rustc_codegen_cranelift/src/intrinsics/mod.rs
index eafae1cdc8af0..4b2207f375879 100644
--- a/compiler/rustc_codegen_cranelift/src/intrinsics/mod.rs
+++ b/compiler/rustc_codegen_cranelift/src/intrinsics/mod.rs
@@ -58,7 +58,6 @@ pub(crate) use llvm::codegen_llvm_intrinsic_call;
use rustc_middle::ty::print::with_no_trimmed_paths;
use rustc_middle::ty::subst::SubstsRef;
use rustc_span::symbol::{kw, sym, Symbol};
-use rustc_target::abi::InitKind;
use crate::prelude::*;
use cranelift_codegen::ir::AtomicRmwOp;
@@ -672,12 +671,7 @@ fn codegen_regular_intrinsic_call<'tcx>(
return;
}
- if intrinsic == sym::assert_zero_valid
- && !layout.might_permit_raw_init(
- fx,
- InitKind::Zero,
- fx.tcx.sess.opts.unstable_opts.strict_init_checks) {
-
+ if intrinsic == sym::assert_zero_valid && !fx.tcx.permits_zero_init(layout) {
with_no_trimmed_paths!({
crate::base::codegen_panic(
fx,
@@ -688,12 +682,7 @@ fn codegen_regular_intrinsic_call<'tcx>(
return;
}
- if intrinsic == sym::assert_uninit_valid
- && !layout.might_permit_raw_init(
- fx,
- InitKind::Uninit,
- fx.tcx.sess.opts.unstable_opts.strict_init_checks) {
-
+ if intrinsic == sym::assert_uninit_valid && !fx.tcx.permits_uninit_init(layout) {
with_no_trimmed_paths!({
crate::base::codegen_panic(
fx,
diff --git a/compiler/rustc_codegen_ssa/Cargo.toml b/compiler/rustc_codegen_ssa/Cargo.toml
index faabea92f5a6c..81c8b9ceb136e 100644
--- a/compiler/rustc_codegen_ssa/Cargo.toml
+++ b/compiler/rustc_codegen_ssa/Cargo.toml
@@ -40,6 +40,7 @@ rustc_metadata = { path = "../rustc_metadata" }
rustc_query_system = { path = "../rustc_query_system" }
rustc_target = { path = "../rustc_target" }
rustc_session = { path = "../rustc_session" }
+rustc_const_eval = { path = "../rustc_const_eval" }
[dependencies.object]
version = "0.29.0"
diff --git a/compiler/rustc_codegen_ssa/src/mir/block.rs b/compiler/rustc_codegen_ssa/src/mir/block.rs
index 745da821c9d76..773c55cf551d5 100644
--- a/compiler/rustc_codegen_ssa/src/mir/block.rs
+++ b/compiler/rustc_codegen_ssa/src/mir/block.rs
@@ -22,7 +22,7 @@ use rustc_span::source_map::Span;
use rustc_span::{sym, Symbol};
use rustc_symbol_mangling::typeid_for_fnabi;
use rustc_target::abi::call::{ArgAbi, FnAbi, PassMode};
-use rustc_target::abi::{self, HasDataLayout, InitKind, WrappingRange};
+use rustc_target::abi::{self, HasDataLayout, WrappingRange};
use rustc_target::spec::abi::Abi;
/// Used by `FunctionCx::codegen_terminator` for emitting common patterns
@@ -528,7 +528,6 @@ impl<'a, 'tcx, Bx: BuilderMethods<'a, 'tcx>> FunctionCx<'a, 'tcx, Bx> {
source_info: mir::SourceInfo,
target: Option<mir::BasicBlock>,
cleanup: Option<mir::BasicBlock>,
- strict_validity: bool,
) -> bool {
// Emit a panic or a no-op for `assert_*` intrinsics.
// These are intrinsics that compile to panics so that we can get a message
@@ -547,12 +546,13 @@ impl<'a, 'tcx, Bx: BuilderMethods<'a, 'tcx>> FunctionCx<'a, 'tcx, Bx> {
});
if let Some(intrinsic) = panic_intrinsic {
use AssertIntrinsic::*;
+
let ty = instance.unwrap().substs.type_at(0);
let layout = bx.layout_of(ty);
let do_panic = match intrinsic {
Inhabited => layout.abi.is_uninhabited(),
- ZeroValid => !layout.might_permit_raw_init(bx, InitKind::Zero, strict_validity),
- UninitValid => !layout.might_permit_raw_init(bx, InitKind::Uninit, strict_validity),
+ ZeroValid => !bx.tcx().permits_zero_init(layout),
+ UninitValid => !bx.tcx().permits_uninit_init(layout),
};
if do_panic {
let msg_str = with_no_visible_paths!({
@@ -687,7 +687,6 @@ impl<'a, 'tcx, Bx: BuilderMethods<'a, 'tcx>> FunctionCx<'a, 'tcx, Bx> {
source_info,
target,
cleanup,
- self.cx.tcx().sess.opts.unstable_opts.strict_init_checks,
) {
return;
}
diff --git a/compiler/rustc_const_eval/src/const_eval/machine.rs b/compiler/rustc_const_eval/src/const_eval/machine.rs
index 29ab1d187719c..e00e667fb71e2 100644
--- a/compiler/rustc_const_eval/src/const_eval/machine.rs
+++ b/compiler/rustc_const_eval/src/const_eval/machine.rs
@@ -104,7 +104,7 @@ pub struct CompileTimeInterpreter<'mir, 'tcx> {
}
impl<'mir, 'tcx> CompileTimeInterpreter<'mir, 'tcx> {
- pub(super) fn new(const_eval_limit: Limit, can_access_statics: bool) -> Self {
+ pub(crate) fn new(const_eval_limit: Limit, can_access_statics: bool) -> Self {
CompileTimeInterpreter {
steps_remaining: const_eval_limit.0,
stack: Vec::new(),
diff --git a/compiler/rustc_const_eval/src/interpret/intrinsics.rs b/compiler/rustc_const_eval/src/interpret/intrinsics.rs
index e2a8a9891f72f..7827fb8395b7f 100644
--- a/compiler/rustc_const_eval/src/interpret/intrinsics.rs
+++ b/compiler/rustc_const_eval/src/interpret/intrinsics.rs
@@ -15,7 +15,7 @@ use rustc_middle::ty::layout::LayoutOf as _;
use rustc_middle::ty::subst::SubstsRef;
use rustc_middle::ty::{Ty, TyCtxt};
use rustc_span::symbol::{sym, Symbol};
-use rustc_target::abi::{Abi, Align, InitKind, Primitive, Size};
+use rustc_target::abi::{Abi, Align, Primitive, Size};
use super::{
util::ensure_monomorphic_enough, CheckInAllocMsg, ImmTy, InterpCx, Machine, OpTy, PlaceTy,
@@ -413,35 +413,33 @@ impl<'mir, 'tcx: 'mir, M: Machine<'mir, 'tcx>> InterpCx<'mir, 'tcx, M> {
),
)?;
}
- if intrinsic_name == sym::assert_zero_valid
- && !layout.might_permit_raw_init(
- self,
- InitKind::Zero,
- self.tcx.sess.opts.unstable_opts.strict_init_checks,
- )
- {
- M::abort(
- self,
- format!(
- "aborted execution: attempted to zero-initialize type `{}`, which is invalid",
- ty
- ),
- )?;
+
+ if intrinsic_name == sym::assert_zero_valid {
+ let should_panic = !self.tcx.permits_zero_init(layout);
+
+ if should_panic {
+ M::abort(
+ self,
+ format!(
+ "aborted execution: attempted to zero-initialize type `{}`, which is invalid",
+ ty
+ ),
+ )?;
+ }
}
- if intrinsic_name == sym::assert_uninit_valid
- && !layout.might_permit_raw_init(
- self,
- InitKind::Uninit,
- self.tcx.sess.opts.unstable_opts.strict_init_checks,
- )
- {
- M::abort(
- self,
- format!(
- "aborted execution: attempted to leave type `{}` uninitialized, which is invalid",
- ty
- ),
- )?;
+
+ if intrinsic_name == sym::assert_uninit_valid {
+ let should_panic = !self.tcx.permits_uninit_init(layout);
+
+ if should_panic {
+ M::abort(
+ self,
+ format!(
+ "aborted execution: attempted to leave type `{}` uninitialized, which is invalid",
+ ty
+ ),
+ )?;
+ }
}
}
sym::simd_insert => {
diff --git a/compiler/rustc_const_eval/src/lib.rs b/compiler/rustc_const_eval/src/lib.rs
index d65d4f7eb720e..72ac6af685dc4 100644
--- a/compiler/rustc_const_eval/src/lib.rs
+++ b/compiler/rustc_const_eval/src/lib.rs
@@ -33,11 +33,13 @@ extern crate rustc_middle;
pub mod const_eval;
mod errors;
pub mod interpret;
+mod might_permit_raw_init;
pub mod transform;
pub mod util;
use rustc_middle::ty;
use rustc_middle::ty::query::Providers;
+use rustc_target::abi::InitKind;
pub fn provide(providers: &mut Providers) {
const_eval::provide(providers);
@@ -59,4 +61,8 @@ pub fn provide(providers: &mut Providers) {
let (param_env, value) = param_env_and_value.into_parts();
const_eval::deref_mir_constant(tcx, param_env, value)
};
+ providers.permits_uninit_init =
+ |tcx, ty| might_permit_raw_init::might_permit_raw_init(tcx, ty, InitKind::Uninit);
+ providers.permits_zero_init =
+ |tcx, ty| might_permit_raw_init::might_permit_raw_init(tcx, ty, InitKind::Zero);
}
diff --git a/compiler/rustc_const_eval/src/might_permit_raw_init.rs b/compiler/rustc_const_eval/src/might_permit_raw_init.rs
new file mode 100644
index 0000000000000..f971c2238c7bb
--- /dev/null
+++ b/compiler/rustc_const_eval/src/might_permit_raw_init.rs
@@ -0,0 +1,40 @@
+use crate::const_eval::CompileTimeInterpreter;
+use crate::interpret::{InterpCx, MemoryKind, OpTy};
+use rustc_middle::ty::layout::LayoutCx;
+use rustc_middle::ty::{layout::TyAndLayout, ParamEnv, TyCtxt};
+use rustc_session::Limit;
+use rustc_target::abi::InitKind;
+
+pub fn might_permit_raw_init<'tcx>(
+ tcx: TyCtxt<'tcx>,
+ ty: TyAndLayout<'tcx>,
+ kind: InitKind,
+) -> bool {
+ let strict = tcx.sess.opts.unstable_opts.strict_init_checks;
+
+ if strict {
+ let machine = CompileTimeInterpreter::new(Limit::new(0), false);
+
+ let mut cx = InterpCx::new(tcx, rustc_span::DUMMY_SP, ParamEnv::reveal_all(), machine);
+
+ let allocated = cx
+ .allocate(ty, MemoryKind::Machine(crate::const_eval::MemoryKind::Heap))
+ .expect("OOM: failed to allocate for uninit check");
+
+ if kind == InitKind::Zero {
+ cx.write_bytes_ptr(
+ allocated.ptr,
+ std::iter::repeat(0_u8).take(ty.layout.size().bytes_usize()),
+ )
+ .expect("failed to write bytes for zero valid check");
+ }
+
+ let ot: OpTy<'_, _> = allocated.into();
+
+ // Assume that if it failed, it's a validation failure.
+ cx.validate_operand(&ot).is_ok()
+ } else {
+ let layout_cx = LayoutCx { tcx, param_env: ParamEnv::reveal_all() };
+ ty.might_permit_raw_init(&layout_cx, kind)
+ }
+}
diff --git a/compiler/rustc_middle/src/query/mod.rs b/compiler/rustc_middle/src/query/mod.rs
index bdae7e5fcd6b1..0581ef41f66c2 100644
--- a/compiler/rustc_middle/src/query/mod.rs
+++ b/compiler/rustc_middle/src/query/mod.rs
@@ -2053,4 +2053,12 @@ rustc_queries! {
desc { |tcx| "looking up generator diagnostic data of `{}`", tcx.def_path_str(key) }
separate_provide_extern
}
+
+ query permits_uninit_init(key: TyAndLayout<'tcx>) -> bool {
+ desc { "checking to see if {:?} permits being left uninit", key.ty }
+ }
+
+ query permits_zero_init(key: TyAndLayout<'tcx>) -> bool {
+ desc { "checking to see if {:?} permits being left zeroed", key.ty }
+ }
}
diff --git a/compiler/rustc_middle/src/ty/query.rs b/compiler/rustc_middle/src/ty/query.rs
index 3d662ed5de4ba..2452bcf6a61b8 100644
--- a/compiler/rustc_middle/src/ty/query.rs
+++ b/compiler/rustc_middle/src/ty/query.rs
@@ -28,6 +28,7 @@ use crate::traits::query::{
use crate::traits::specialization_graph;
use crate::traits::{self, ImplSource};
use crate::ty::fast_reject::SimplifiedType;
+use crate::ty::layout::TyAndLayout;
use crate::ty::subst::{GenericArg, SubstsRef};
use crate::ty::util::AlwaysRequiresDrop;
use crate::ty::GeneratorDiagnosticData;
diff --git a/compiler/rustc_query_impl/src/keys.rs b/compiler/rustc_query_impl/src/keys.rs
index 6fbafeb1d32b3..5477431431374 100644
--- a/compiler/rustc_query_impl/src/keys.rs
+++ b/compiler/rustc_query_impl/src/keys.rs
@@ -6,7 +6,7 @@ use rustc_middle::mir;
use rustc_middle::traits;
use rustc_middle::ty::fast_reject::SimplifiedType;
use rustc_middle::ty::subst::{GenericArg, SubstsRef};
-use rustc_middle::ty::{self, Ty, TyCtxt};
+use rustc_middle::ty::{self, layout::TyAndLayout, Ty, TyCtxt};
use rustc_span::symbol::{Ident, Symbol};
use rustc_span::{Span, DUMMY_SP};
@@ -385,6 +385,16 @@ impl<'tcx> Key for Ty<'tcx> {
}
}
+impl<'tcx> Key for TyAndLayout<'tcx> {
+ #[inline(always)]
+ fn query_crate_is_local(&self) -> bool {
+ true
+ }
+ fn default_span(&self, _: TyCtxt<'_>) -> Span {
+ DUMMY_SP
+ }
+}
+
impl<'tcx> Key for (Ty<'tcx>, Ty<'tcx>) {
#[inline(always)]
fn query_crate_is_local(&self) -> bool {
diff --git a/compiler/rustc_target/src/abi/mod.rs b/compiler/rustc_target/src/abi/mod.rs
index d1eafd6ac5fb8..6f4d073d70486 100644
--- a/compiler/rustc_target/src/abi/mod.rs
+++ b/compiler/rustc_target/src/abi/mod.rs
@@ -1372,7 +1372,7 @@ pub struct PointeeInfo {
/// Used in `might_permit_raw_init` to indicate the kind of initialisation
/// that is checked to be valid
-#[derive(Copy, Clone, Debug)]
+#[derive(Copy, Clone, Debug, PartialEq, Eq)]
pub enum InitKind {
Zero,
Uninit,
@@ -1487,14 +1487,18 @@ impl<'a, Ty> TyAndLayout<'a, Ty> {
///
/// `init_kind` indicates if the memory is zero-initialized or left uninitialized.
///
- /// `strict` is an opt-in debugging flag added in #97323 that enables more checks.
+ /// This code is intentionally conservative, and will not detect
+ /// * zero init of an enum whose 0 variant does not allow zero initialization
+ /// * making uninitialized types who have a full valid range (ints, floats, raw pointers)
+ /// * Any form of invalid value being made inside an array (unless the value is uninhabited)
///
- /// This is conservative: in doubt, it will answer `true`.
+ /// A strict form of these checks that uses const evaluation exists in
+ /// `rustc_const_eval::might_permit_raw_init`, and a tracking issue for making these checks
+ /// stricter is <https://github.com/rust-lang/rust/issues/66151>.
///
- /// FIXME: Once we removed all the conservatism, we could alternatively
- /// create an all-0/all-undef constant and run the const value validator to see if
- /// this is a valid value for the given type.
- pub fn might_permit_raw_init<C>(self, cx: &C, init_kind: InitKind, strict: bool) -> bool
+ /// FIXME: Once all the conservatism is removed from here, and the checks are ran by default,
+ /// we can use the const evaluation checks always instead.
+ pub fn might_permit_raw_init<C>(self, cx: &C, init_kind: InitKind) -> bool
where
Self: Copy,
Ty: TyAbiInterface<'a, C>,
@@ -1507,13 +1511,8 @@ impl<'a, Ty> TyAndLayout<'a, Ty> {
s.valid_range(cx).contains(0)
}
InitKind::Uninit => {
- if strict {
- // The type must be allowed to be uninit (which means "is a union").
- s.is_uninit_valid()
- } else {
- // The range must include all values.
- s.is_always_valid(cx)
- }
+ // The range must include all values.
+ s.is_always_valid(cx)
}
}
};
@@ -1534,19 +1533,12 @@ impl<'a, Ty> TyAndLayout<'a, Ty> {
// If we have not found an error yet, we need to recursively descend into fields.
match &self.fields {
FieldsShape::Primitive | FieldsShape::Union { .. } => {}
- FieldsShape::Array { count, .. } => {
+ FieldsShape::Array { .. } => {
// FIXME(#66151): For now, we are conservative and do not check arrays by default.
- if strict
- && *count > 0
- && !self.field(cx, 0).might_permit_raw_init(cx, init_kind, strict)
- {
- // Found non empty array with a type that is unhappy about this kind of initialization
- return false;
- }
}
FieldsShape::Arbitrary { offsets, .. } => {
for idx in 0..offsets.len() {
- if !self.field(cx, idx).might_permit_raw_init(cx, init_kind, strict) {
+ if !self.field(cx, idx).might_permit_raw_init(cx, init_kind) {
// We found a field that is unhappy with this kind of initialization.
return false;
}
diff --git a/src/test/ui/intrinsics/panic-uninitialized-zeroed.rs b/src/test/ui/intrinsics/panic-uninitialized-zeroed.rs
index 3ffd35ecdb8da..255151a96032c 100644
--- a/src/test/ui/intrinsics/panic-uninitialized-zeroed.rs
+++ b/src/test/ui/intrinsics/panic-uninitialized-zeroed.rs
@@ -57,6 +57,13 @@ enum LR_NonZero {
struct ZeroSized;
+#[allow(dead_code)]
+#[repr(i32)]
+enum ZeroIsValid {
+ Zero(u8) = 0,
+ One(NonNull<()>) = 1,
+}
+
fn test_panic_msg<T>(op: impl (FnOnce() -> T) + panic::UnwindSafe, msg: &str) {
let err = panic::catch_unwind(op).err();
assert_eq!(
@@ -152,33 +159,12 @@ fn main() {
"attempted to zero-initialize type `*const dyn core::marker::Send`, which is invalid"
);
- /* FIXME(#66151) we conservatively do not error here yet.
- test_panic_msg(
- || mem::uninitialized::<LR_NonZero>(),
- "attempted to leave type `LR_NonZero` uninitialized, which is invalid"
- );
- test_panic_msg(
- || mem::zeroed::<LR_NonZero>(),
- "attempted to zero-initialize type `LR_NonZero`, which is invalid"
- );
-
- test_panic_msg(
- || mem::uninitialized::<ManuallyDrop<LR_NonZero>>(),
- "attempted to leave type `std::mem::ManuallyDrop<LR_NonZero>` uninitialized, \
- which is invalid"
- );
- test_panic_msg(
- || mem::zeroed::<ManuallyDrop<LR_NonZero>>(),
- "attempted to zero-initialize type `std::mem::ManuallyDrop<LR_NonZero>`, \
- which is invalid"
- );
- */
-
test_panic_msg(
|| mem::uninitialized::<(NonNull<u32>, u32, u32)>(),
"attempted to leave type `(core::ptr::non_null::NonNull<u32>, u32, u32)` uninitialized, \
which is invalid"
);
+
test_panic_msg(
|| mem::zeroed::<(NonNull<u32>, u32, u32)>(),
"attempted to zero-initialize type `(core::ptr::non_null::NonNull<u32>, u32, u32)`, \
@@ -196,11 +182,23 @@ fn main() {
which is invalid"
);
+ test_panic_msg(
+ || mem::uninitialized::<LR_NonZero>(),
+ "attempted to leave type `LR_NonZero` uninitialized, which is invalid"
+ );
+
+ test_panic_msg(
+ || mem::uninitialized::<ManuallyDrop<LR_NonZero>>(),
+ "attempted to leave type `core::mem::manually_drop::ManuallyDrop<LR_NonZero>` uninitialized, \
+ which is invalid"
+ );
+
test_panic_msg(
|| mem::uninitialized::<NoNullVariant>(),
"attempted to leave type `NoNullVariant` uninitialized, \
which is invalid"
);
+
test_panic_msg(
|| mem::zeroed::<NoNullVariant>(),
"attempted to zero-initialize type `NoNullVariant`, \
@@ -212,10 +210,12 @@ fn main() {
|| mem::uninitialized::<bool>(),
"attempted to leave type `bool` uninitialized, which is invalid"
);
+
test_panic_msg(
|| mem::uninitialized::<LR>(),
"attempted to leave type `LR` uninitialized, which is invalid"
);
+
test_panic_msg(
|| mem::uninitialized::<ManuallyDrop<LR>>(),
"attempted to leave type `core::mem::manually_drop::ManuallyDrop<LR>` uninitialized, which is invalid"
@@ -229,6 +229,7 @@ fn main() {
let _val = mem::zeroed::<Option<&'static i32>>();
let _val = mem::zeroed::<MaybeUninit<NonNull<u32>>>();
let _val = mem::zeroed::<[!; 0]>();
+ let _val = mem::zeroed::<ZeroIsValid>();
let _val = mem::uninitialized::<MaybeUninit<bool>>();
let _val = mem::uninitialized::<[!; 0]>();
let _val = mem::uninitialized::<()>();
@@ -259,12 +260,33 @@ fn main() {
|| mem::zeroed::<[NonNull<()>; 1]>(),
"attempted to zero-initialize type `[core::ptr::non_null::NonNull<()>; 1]`, which is invalid"
);
+
+ // FIXME(#66151) we conservatively do not error here yet (by default).
+ test_panic_msg(
+ || mem::zeroed::<LR_NonZero>(),
+ "attempted to zero-initialize type `LR_NonZero`, which is invalid"
+ );
+
+ test_panic_msg(
+ || mem::zeroed::<ManuallyDrop<LR_NonZero>>(),
+ "attempted to zero-initialize type `core::mem::manually_drop::ManuallyDrop<LR_NonZero>`, \
+ which is invalid"
+ );
} else {
// These are UB because they have not been officially blessed, but we await the resolution
// of <https://github.com/rust-lang/unsafe-code-guidelines/issues/71> before doing
// anything about that.
let _val = mem::uninitialized::<i32>();
let _val = mem::uninitialized::<*const ()>();
+
+ // These are UB, but best to test them to ensure we don't become unintentionally
+ // stricter.
+
+ // It's currently unchecked to create invalid enums and values inside arrays.
+ let _val = mem::zeroed::<LR_NonZero>();
+ let _val = mem::zeroed::<[LR_NonZero; 1]>();
+ let _val = mem::zeroed::<[NonNull<()>; 1]>();
+ let _val = mem::uninitialized::<[NonNull<()>; 1]>();
}
}
}

27
gnu/packages/patches/sbcl-fix-build-on-arm64-with-clisp-as-host.patch
View file

@ -1,27 +0,0 @@
From 944f53fb00794f4bc96700dd14df1e88b6cd5623 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Thu, 17 Nov 2022 22:29:26 +0000
Subject: [PATCH] Fix build on arm64 with clisp as host
Make sure the offset constants are defined while compiling vm.lisp.
---
src/compiler/arm64/vm.lisp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/src/compiler/arm64/vm.lisp b/src/compiler/arm64/vm.lisp
index ae6d7c7fa..2a151be58 100644
--- a/src/compiler/arm64/vm.lisp
+++ b/src/compiler/arm64/vm.lisp
@@ -23,7 +23,8 @@
(macrolet ((defreg (name offset)
(let ((offset-sym (symbolicate name "-OFFSET")))
`(progn
- (defconstant ,offset-sym ,offset)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant ,offset-sym ,offset))
(setf (svref *register-names* ,offset-sym) ,(symbol-name name)))))
(defregset (name &rest regs)
--
2.30.2

45
gnu/packages/patches/sssd-optional-systemd.patch
View file

@ -1,45 +0,0 @@
Allow running sss_analyze without Python modules for systemd.
Upstream PR: https://github.com/SSSD/sssd/pull/6125
diff --git a/src/tools/analyzer/modules/request.py b/src/tools/analyzer/modules/request.py
index b9fe3caf8..51ec3a151 100644
--- a/src/tools/analyzer/modules/request.py
+++ b/src/tools/analyzer/modules/request.py
@@ -1,8 +1,6 @@
import re
import logging
-from sssd.source_files import Files
-from sssd.source_journald import Journald
from sssd.parser import SubparsersAction
from sssd.parser import Option
@@ -76,8 +74,10 @@ class RequestAnalyzer:
Instantiated source object
"""
if args.source == "journald":
+ from sssd.source_journald import Journald
source = Journald()
else:
+ from sssd.source_files import Files
source = Files(args.logdir)
return source
@@ -142,7 +142,7 @@ class RequestAnalyzer:
self.consumed_logs.append(line.rstrip(line[-1]))
else:
# files source includes newline
- if isinstance(source, Files):
+ if type(source).__name__ == 'Files':
print(line, end='')
else:
print(line)
@@ -240,7 +240,7 @@ class RequestAnalyzer:
self.print_formatted_verbose(source, patterns)
else:
for line in self.matched_line(source, patterns):
- if isinstance(source, Journald):
+ if type(source).__name__ == 'Journald':
print(line)
else:
self.print_formatted(line)

29
gnu/packages/python-check.scm
View file

@ -16,6 +16,7 @@
;;; Copyright © 2022 Malte Frank Gerdes <malte.f.gerdes@gmail.com> ;;; Copyright © 2022 Malte Frank Gerdes <malte.f.gerdes@gmail.com>
;;; Copyright © 2022 Felix Gruber <felgru@posteo.net> ;;; Copyright © 2022 Felix Gruber <felgru@posteo.net>
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl> ;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
;;; Copyright © 2022 jgart <jgart@dismail.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -2439,6 +2440,34 @@ parsed examples as part of your normal test run. Integration is
provided for the main Python test runners.") provided for the main Python test runners.")
(license license:expat))) (license license:expat)))
(define-public python-pytest-parawtf
(package
(name "python-pytest-parawtf")
(version "1.0.2")
(source (origin
(method url-fetch)
(uri (pypi-uri "pytest-parawtf" version))
(sha256
(base32
"08s86hy58lvrd90cnayzydvac4slaflj0ph9yknakcc42anrm023"))))
(build-system python-build-system)
(arguments
(list
#:phases
#~(modify-phases %standard-phases
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
;; https://github.com/flub/pytest-parawtf/issues/1
(invoke "pytest" "-k" "not test_mark")))))))
(propagated-inputs (list python-pytest))
(home-page "https://github.com/flub/pytest-parawtf/")
(synopsis "Finally spell paramete?ri[sz]e correctly")
(description
"@code{python-pytest} uses one of four different spellings of
parametrize. This plugin allows you to use all four.")
(license license:expat)))
(define-public python-pytest-httpx (define-public python-pytest-httpx
(package (package
(name "python-pytest-httpx") (name "python-pytest-httpx")

4
gnu/packages/python-science.scm
View file

@ -693,14 +693,14 @@ and visualization with these data structures.")
(define-public python-msgpack-numpy (define-public python-msgpack-numpy
(package (package
(name "python-msgpack-numpy") (name "python-msgpack-numpy")
(version "0.4.6.post0") (version "0.4.8")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "msgpack-numpy" version)) (uri (pypi-uri "msgpack-numpy" version))
(sha256 (sha256
(base32 (base32
"0syzy645mwcy7lfjwz6pc8f9p2vv1qk4limc8iina3l5nnf0rjyz")))) "0sbfanbkfs6c77np4vz0ayrwnv99bpn5xgj5fnf2yhhk0lcd6ry6"))))
(build-system python-build-system) (build-system python-build-system)
(propagated-inputs (propagated-inputs
(list python-msgpack python-numpy)) (list python-msgpack python-numpy))

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

@ -131,6 +131,7 @@
;;; Copyright © 2022 Mathieu Laparie <mlaparie@disr.it> ;;; Copyright © 2022 Mathieu Laparie <mlaparie@disr.it>
;;; Copyright © 2022 Garek Dyszel <garekdyszel@disroot.org> ;;; Copyright © 2022 Garek Dyszel <garekdyszel@disroot.org>
;;; Copyright © 2022 Baptiste Strazzulla <bstrazzull@hotmail.fr> ;;; Copyright © 2022 Baptiste Strazzulla <bstrazzull@hotmail.fr>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -159,9 +160,11 @@
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages cmake) #:use-module (gnu packages cmake)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages cpp)
#:use-module (gnu packages crypto) #:use-module (gnu packages crypto)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (gnu packages dbm) #:use-module (gnu packages dbm)
#:use-module (gnu packages digest)
#:use-module (gnu packages django) #:use-module (gnu packages django)
#:use-module (gnu packages djvu) #:use-module (gnu packages djvu)
#:use-module (gnu packages docker) #:use-module (gnu packages docker)
@ -4634,6 +4637,73 @@ accessible for novices, as well as a scripting interface offering the full
flexibility and power of the Python language.") flexibility and power of the Python language.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public python-dm-tree
(package
(name "python-dm-tree")
(version "0.1.7")
(source (origin
(method url-fetch)
(uri (pypi-uri "dm-tree" version))
(sha256
(base32 "0apxfxgmqh22qpk92zmmf3acqkavhwxz78lnwz026a5rlnncizih"))))
(build-system python-build-system)
(inputs (list pybind11 abseil-cpp python))
(propagated-inputs (list python-wheel
python-absl-py
python-attrs
python-numpy
python-wrapt))
(arguments
(list #:tests? #f
#:phases
#~(modify-phases %standard-phases
(add-before 'build 'build-shared-lib
(lambda _
(let* ((pybind11 #$(this-package-input "pybind11"))
(python #$(this-package-input "python"))
(version (python-version python))
(abseil-cpp #$(this-package-input "abseil-cpp")))
;; Delete default cmake build.
(substitute* "setup.py"
(("ext_modules.*") "")
(("cmdclass.*") ""))
;; Actual build phase.
(mkdir-p "build/temp/tree/")
(invoke
"gcc" "-pthread" "-Wno-unused-result" "-Wsign-compare"
"-DNDEBUG" "-g" "-fwrapv" "-O3" "-Wall"
"-fno-semantic-interposition" "-fPIC"
"-I" (string-append pybind11
"/lib/python" version
"/site-packages/pybind11/include")
"-I" (string-append python "/include/python"
version)
"-I" (string-append abseil-cpp "/include")
"-c" "tree/tree.cc"
"-o" "build/temp/tree/tree.o"
"-fvisibility=hidden" "-g0")
(mkdir-p "build/lib/tree")
(invoke
"g++" "-pthread" "-shared"
(string-append "-Wl," "-rpath=" python "/lib")
"-fno-semantic-interposition"
"build/temp/tree/tree.o"
"-L" (string-append python "/lib")
"-L" (string-append abseil-cpp "/lib")
"-l" "absl_int128"
"-l" "absl_raw_hash_set"
"-l" "absl_raw_logging_internal"
"-l" "absl_strings"
"-l" "absl_throw_delegate"
"-o" "build/lib/tree/_tree.so")))))))
(home-page "https://github.com/deepmind/tree")
(synopsis "Work with nested data structures in Python")
(description "Tree is a python library for working with nested data
structures. In a way, @code{tree} generalizes the builtin @code{map} function
which only supports flat sequences, and allows you to apply a function to each
leaf preserving the overall structure.")
(license license:asl2.0)))
(define-public python-docutils (define-public python-docutils
(package (package
(name "python-docutils") (name "python-docutils")
@ -22364,6 +22434,25 @@ working with iterables.")
(description "Lexer and codec to work with LaTeX code in Python.") (description "Lexer and codec to work with LaTeX code in Python.")
(license license:expat))) (license license:expat)))
(define-public python-pybloom-live
(package
(name "python-pybloom-live")
(version "4.0.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "pybloom_live" version))
(sha256
(base32
"040i6bjqvl33j30v865shsk30s3h7f16pqwiaj5kig857dfmqm4r"))))
(build-system pyproject-build-system)
(propagated-inputs (list python-bitarray python-xxhash))
(native-inputs (list python-pytest))
(home-page "https://github.com/joseph-fox/python-bloomfilter")
(synopsis "Bloom filter")
(description "This package provides a scalable Bloom filter implemented in
Python.")
(license license:expat)))
(define-public python-pybtex (define-public python-pybtex
(package (package
(name "python-pybtex") (name "python-pybtex")
@ -23082,6 +23171,32 @@ environments.")
"PyNamecheap is a Namecheap API client in Python.") "PyNamecheap is a Namecheap API client in Python.")
(license license:expat))) (license license:expat)))
(define-public python-pynixutil
(package
(name "python-pynixutil")
(version "0.5.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/nix-community/pynixutil")
(commit version)))
(file-name (git-file-name name version))
;; Derivation test uses nix.
(modules '((guix build utils)))
(snippet '(delete-file "tests/test_drv.py"))
(sha256
(base32
"1lnspcai7mqpv73bbd8kgyw63fxwgkwvfkl09b2bl5y2g2v7np6m"))))
(build-system pyproject-build-system)
(native-inputs (list poetry python-pytest))
(home-page "https://github.com/nix-community/pynixutil")
(synopsis "Utility functions for working with data from Nix in Python")
(description
"@code{pynixutil} provides functions for base32 encoding/decoding and
derivation parsing, namingly @code{b32decode()}, @code{b32encode()} and
@code{drvparse()}.")
(license license:expat)))
(define-public python-dns-lexicon (define-public python-dns-lexicon
(package (package
(name "python-dns-lexicon") (name "python-dns-lexicon")

235
gnu/packages/qt.scm
View file

@ -11,7 +11,7 @@
;;; Copyright © 2018, 2020, 2022 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2018, 2020, 2022 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2018 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2018 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019, 2020 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2019, 2020, 2022 Marius Bakke <marius@gnu.org>
;;; Copyright © 2018 John Soo <jsoo1@asu.edu> ;;; Copyright © 2018 John Soo <jsoo1@asu.edu>
;;; Copyright © 2020 Mike Rosset <mike.rosset@gmail.com> ;;; Copyright © 2020 Mike Rosset <mike.rosset@gmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@ -2280,6 +2280,61 @@ using the Enchant spell-checking library.")
;; COPYING file specify GPL3, but source code files all refer to GPL2+. ;; COPYING file specify GPL3, but source code files all refer to GPL2+.
(license license:gpl2+))) (license license:gpl2+)))
(define remove-third-party-files
#~(begin
(define preserved-club
;; Prefix exceptions with ./ for comparison with ftw.
(map (cut string-append "./" <>)
preserved-third-party-files))
(define protected (make-regexp "\\.(gn|gyp)i?$"))
(define (empty? dir)
(equal? (scandir dir) '("." "..")))
(define (third-party? file)
(string-contains file "/third_party/"))
(define (useless? file)
(any (cute string-suffix? <> file)
'(".zip" ".so" ".dll" ".exe" ".jar")))
(define (parents child)
;; Return all parent directories of CHILD up to and including
;; the closest "third_party".
(let loop ((parent (dirname child))
(parents '()))
(if (string=? "third_party" (basename parent))
(cons parent parents)
(loop (dirname parent)
(cons parent parents)))))
(define (remove-loudly file)
(format #t "deleting ~a...~%" file)
(force-output)
(delete-file file))
(define (delete-unwanted-files child stat flag base level)
(match flag
((or 'regular 'symlink 'stale-symlink)
(when (third-party? child)
(unless (or (member child preserved-club)
(any (cute member <> preserved-club)
(parents child))
(regexp-exec protected child))
(remove-loudly child)))
(when (and (useless? child) (file-exists? child))
(remove-loudly child))
#t)
('directory-processed
(when (empty? child)
(rmdir child))
#t)
(_ #t)))
(nftw "." delete-unwanted-files 'depth 'physical)
;; Assert that each preserved item is present to catch
;; removals.
(for-each (lambda (third-party)
(unless (file-exists? third-party)
(error (format #f "~s does not exist!~%"
third-party))))
preserved-club)))
(define-public qtwebengine-5 (define-public qtwebengine-5
(package (package
(inherit qtsvg-5) (inherit qtsvg-5)
@ -2298,7 +2353,7 @@ using the Enchant spell-checking library.")
(srfi srfi-26) (srfi srfi-26)
(guix build utils))) (guix build utils)))
(snippet (snippet
'(begin #~(begin
(let ((preserved-third-party-files (let ((preserved-third-party-files
'("base/third_party/double_conversion" '("base/third_party/double_conversion"
"base/third_party/cityhash" "base/third_party/cityhash"
@ -2434,54 +2489,7 @@ using the Enchant spell-checking library.")
"v8/src/third_party/valgrind" "v8/src/third_party/valgrind"
"v8/src/third_party/siphash" "v8/src/third_party/siphash"
"v8/third_party/v8/builtins" "v8/third_party/v8/builtins"
"v8/third_party/inspector_protocol")) "v8/third_party/inspector_protocol")))
(protected (make-regexp "\\.(gn|gyp)i?$")))
(define preserved-club
(map (lambda (member)
(string-append "./" member))
preserved-third-party-files))
(define (empty? dir)
(equal? (scandir dir) '("." "..")))
(define (third-party? file)
(string-contains file "third_party/"))
(define (useless? file)
(any (cute string-suffix? <> file)
'(".zip" ".so" ".dll" ".exe" ".jar")))
(define (parents child)
;; Return all parent directories of CHILD up to and including
;; the closest "third_party".
(let* ((dirs (match (string-split child #\/)
((dirs ... last) dirs)))
(closest (list-index (lambda (dir)
(string=? "third_party" dir))
(reverse dirs)))
(delim (- (length dirs) closest)))
(fold (lambda (dir prev)
(cons (string-append (car prev) "/" dir)
prev))
(list (string-join (list-head dirs delim) "/"))
(list-tail dirs delim))))
(define (remove-loudly file)
(format #t "deleting ~a...~%" file)
(force-output)
(delete-file file))
(define (delete-unwanted-files child stat flag base level)
(match flag
((or 'regular 'symlink 'stale-symlink)
(when (third-party? child)
(unless (or (member child preserved-club)
(any (cute member <> preserved-club)
(parents child))
(regexp-exec protected child))
(remove-loudly child)))
(when (and (useless? child) (file-exists? child))
(remove-loudly child))
#t)
('directory-processed
(when (empty? child)
(rmdir child))
#t)
(_ #t)))
(with-directory-excursion "src/3rdparty" (with-directory-excursion "src/3rdparty"
;; TODO: Try removing "gn" too for future versions of qtwebengine-5. ;; TODO: Try removing "gn" too for future versions of qtwebengine-5.
@ -2490,13 +2498,7 @@ using the Enchant spell-checking library.")
(with-directory-excursion "chromium" (with-directory-excursion "chromium"
;; Delete bundled software and binaries that were not explicitly ;; Delete bundled software and binaries that were not explicitly
;; preserved above. ;; preserved above.
(nftw "." delete-unwanted-files 'depth 'physical) #$remove-third-party-files
;; Assert that each preserved item is present to catch removals.
(for-each (lambda (third-party)
(unless (file-exists? third-party)
(error (format #f "~s does not exist!~%" third-party))))
preserved-club)
;; Use relative header locations instead of hard coded ones. ;; Use relative header locations instead of hard coded ones.
(substitute* (substitute*
@ -2676,7 +2678,7 @@ and binaries removed, and adds modular support for using system libraries.")
(srfi srfi-26) (srfi srfi-26)
(guix build utils))) (guix build utils)))
(snippet (snippet
'(begin #~(begin
(let ((preserved-third-party-files (let ((preserved-third-party-files
'("base/third_party/double_conversion" '("base/third_party/double_conversion"
"base/third_party/cityhash" "base/third_party/cityhash"
@ -2698,12 +2700,25 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/angle/src/common/third_party/base" "third_party/angle/src/common/third_party/base"
"third_party/angle/src/common/third_party/smhasher" "third_party/angle/src/common/third_party/smhasher"
"third_party/angle/src/common/third_party/xxhash" "third_party/angle/src/common/third_party/xxhash"
"third_party/angle/src/third_party/trace_event"
"third_party/angle/src/third_party/volk"
"third_party/axe-core" "third_party/axe-core"
"third_party/blink" "third_party/blink"
"third_party/boringssl" "third_party/boringssl"
"third_party/boringssl/src/third_party/fiat" "third_party/boringssl/src/third_party/fiat"
"third_party/breakpad" "third_party/breakpad"
"third_party/brotli" "third_party/brotli"
"third_party/catapult"
"third_party/catapult/common/py_vulcanize/third_party/rcssmin"
"third_party/catapult/common/py_vulcanize/third_party/rjsmin"
"third_party/catapult/third_party/polymer"
"third_party/catapult/tracing/third_party/d3/d3.min.js"
"third_party/catapult/tracing/third_party/gl-matrix/dist/gl-matrix-min.js"
"third_party/catapult/tracing/third_party/jpeg-js/jpeg-js-decoder.js"
"third_party/catapult/tracing/third_party/jszip/jszip.min.js"
"third_party/catapult/tracing/third_party/mannwhitneyu/mannwhitneyu.js"
"third_party/catapult/tracing/third_party/oboe/dist"
"third_party/catapult/tracing/third_party/pako/pako.min.js"
"third_party/ced" "third_party/ced"
"third_party/cld_3" "third_party/cld_3"
"third_party/closure_compiler" "third_party/closure_compiler"
@ -2713,13 +2728,28 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/crc32c" "third_party/crc32c"
"third_party/dav1d" "third_party/dav1d"
"third_party/dawn" "third_party/dawn"
"third_party/dawn/third_party/tint"
"third_party/devtools-frontend" "third_party/devtools-frontend"
"third_party/devtools-frontend/src/front_end/third_party/i18n"
"third_party/devtools-frontend/src/front_end/third_party/acorn"
"third_party/devtools-frontend/src/front_end/third_party/acorn-loose"
"third_party/devtools-frontend/src/front_end/third_party/axe-core"
"third_party/devtools-frontend/src/front_end/third_party/chromium"
"third_party/devtools-frontend/src/front_end/third_party/codemirror"
"third_party/devtools-frontend/src/front_end/third_party/diff"
"third_party/devtools-frontend/src/front_end/third_party/intl-messageformat"
"third_party/devtools-frontend/src/front_end/third_party/lighthouse" "third_party/devtools-frontend/src/front_end/third_party/lighthouse"
"third_party/devtools-frontend/src/front_end/third_party/lit-html"
"third_party/devtools-frontend/src/front_end/third_party/marked"
"third_party/devtools-frontend/src/front_end/third_party/wasmparser" "third_party/devtools-frontend/src/front_end/third_party/wasmparser"
"third_party/devtools-frontend/src/third_party/typescript"
"third_party/emoji-segmenter" "third_party/emoji-segmenter"
"third_party/fdlibm"
"third_party/ffmpeg" "third_party/ffmpeg"
"third_party/freetype"
"third_party/googletest" "third_party/googletest"
"third_party/harfbuzz-ng/utils" "third_party/harfbuzz-ng"
"third_party/highway"
"third_party/hunspell" "third_party/hunspell"
"third_party/iccjpeg" "third_party/iccjpeg"
"third_party/icu" "third_party/icu"
@ -2730,19 +2760,30 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/khronos" "third_party/khronos"
"third_party/leveldatabase" "third_party/leveldatabase"
"third_party/libaddressinput" "third_party/libaddressinput"
"third_party/libaom"
"third_party/libaom/source/libaom/third_party/fastfeat"
"third_party/libaom/source/libaom/third_party/vector"
"third_party/libaom/source/libaom/third_party/x86inc"
"third_party/libavif"
"third_party/libgav1"
"third_party/libgifcodec" "third_party/libgifcodec"
"third_party/libjingle_xmpp" "third_party/libjingle_xmpp"
"third_party/libjpeg_turbo" "third_party/libjpeg_turbo"
"third_party/libjxl"
"third_party/libpng" "third_party/libpng"
"third_party/libsrtp" "third_party/libsrtp"
"third_party/libsync" "third_party/libsync"
"third_party/libudev" "third_party/libudev"
"third_party/liburlpattern"
"third_party/libvpx" "third_party/libvpx"
"third_party/libwebm" "third_party/libwebm"
"third_party/libwebp" "third_party/libwebp"
"third_party/libx11"
"third_party/libxcb-keysyms"
"third_party/libxml" "third_party/libxml"
"third_party/libxslt" "third_party/libxslt"
"third_party/libyuv" "third_party/libyuv"
"third_party/lottie"
"third_party/lss" "third_party/lss"
"third_party/mako" "third_party/mako"
"third_party/markupsafe" "third_party/markupsafe"
@ -2750,18 +2791,23 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/metrics_proto" "third_party/metrics_proto"
"third_party/modp_b64" "third_party/modp_b64"
"third_party/nasm" "third_party/nasm"
"third_party/node"
"third_party/one_euro_filter" "third_party/one_euro_filter"
"third_party/openh264/src/codec/api/svc" "third_party/openh264"
"third_party/opus" "third_party/opus"
"third_party/ots" "third_party/ots"
"third_party/pdfium" "third_party/pdfium"
"third_party/pdfium/third_party/agg23" "third_party/pdfium/third_party/agg23"
"third_party/pdfium/third_party/base" "third_party/pdfium/third_party/base"
"third_party/pdfium/third_party/bigint"
"third_party/pdfium/third_party/freetype" "third_party/pdfium/third_party/freetype"
"third_party/pdfium/third_party/lcms" "third_party/pdfium/third_party/lcms"
"third_party/pdfium/third_party/libopenjpeg20" "third_party/pdfium/third_party/libopenjpeg20"
"third_party/pdfium/third_party/libpng16"
"third_party/pdfium/third_party/libtiff"
"third_party/pdfium/third_party/skia_shared" "third_party/pdfium/third_party/skia_shared"
"third_party/perfetto" "third_party/perfetto"
"third_party/perfetto/protos/third_party/chromium"
"third_party/pffft" "third_party/pffft"
"third_party/ply" "third_party/ply"
"third_party/polymer" "third_party/polymer"
@ -2777,9 +2823,18 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/skia/third_party/vulkanmemoryallocator" "third_party/skia/third_party/vulkanmemoryallocator"
"third_party/smhasher" "third_party/smhasher"
"third_party/snappy" "third_party/snappy"
"third_party/speech-dispatcher"
"third_party/sqlite" "third_party/sqlite"
"third_party/usb_ids" "third_party/usb_ids"
"third_party/usrsctp" "third_party/usrsctp"
"third_party/vulkan-deps/glslang"
"third_party/vulkan-deps/spirv-headers"
"third_party/vulkan-deps/spirv-tools"
"third_party/vulkan-deps/vulkan-headers"
"third_party/vulkan-deps/vulkan-loader"
"third_party/vulkan-deps/vulkan-tools"
"third_party/vulkan-deps/vulkan-validation-layers"
"third_party/vulkan_memory_allocator"
"third_party/web-animations-js" "third_party/web-animations-js"
"third_party/webrtc" "third_party/webrtc"
"third_party/webrtc/common_audio/third_party/ooura" "third_party/webrtc/common_audio/third_party/ooura"
@ -2793,58 +2848,15 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/widevine/cdm/widevine_cdm_common.h" "third_party/widevine/cdm/widevine_cdm_common.h"
"third_party/widevine/cdm/widevine_cdm_version.h" "third_party/widevine/cdm/widevine_cdm_version.h"
"third_party/woff2" "third_party/woff2"
"third_party/wuffs"
"third_party/x11proto"
"third_party/zlib" "third_party/zlib"
"url/third_party/mozilla" "url/third_party/mozilla"
"v8/src/third_party/utf8-decoder" "v8/src/third_party/utf8-decoder"
"v8/src/third_party/valgrind" "v8/src/third_party/valgrind"
"v8/src/third_party/siphash" "v8/src/third_party/siphash"
"v8/third_party/v8/builtins" "v8/third_party/v8/builtins"
"v8/third_party/inspector_protocol")) "v8/third_party/inspector_protocol")))
(protected (make-regexp "\\.(gn|gyp)i?$")))
(define preserved-club
(map (lambda (member)
(string-append "./" member))
preserved-third-party-files))
(define (empty? dir)
(equal? (scandir dir) '("." "..")))
(define (third-party? file)
(string-contains file "third_party/"))
(define (useless? file)
(any (cute string-suffix? <> file)
'(".zip" ".so" ".dll" ".exe" ".jar")))
(define (parents child)
;; Return all parent directories of CHILD up to and including
;; the closest "third_party".
(let* ((dirs (match (string-split child #\/)
((dirs ... last) dirs)))
(closest (list-index (lambda (dir)
(string=? "third_party" dir))
(reverse dirs)))
(delim (- (length dirs) closest)))
(fold (lambda (dir prev)
(cons (string-append (car prev) "/" dir)
prev))
(list (string-join (list-head dirs delim) "/"))
(list-tail dirs delim))))
(define (remove-loudly file)
(format #t "deleting ~a...~%" file)
(force-output)
(delete-file file))
(define (delete-unwanted-files child stat flag base level)
(match flag
((or 'regular 'symlink 'stale-symlink)
(when (third-party? child)
(unless (or (member child preserved-club)
(any (cute member <> preserved-club)
(parents child))
(regexp-exec protected child))
(remove-loudly child)))
(when (and (useless? child) (file-exists? child))
(remove-loudly child)))
('directory-processed
(when (empty? child)
(rmdir child)))
(_ #t)))
(with-directory-excursion "src/3rdparty" (with-directory-excursion "src/3rdparty"
(delete-file-recursively "ninja") (delete-file-recursively "ninja")
@ -2852,15 +2864,7 @@ and binaries removed, and adds modular support for using system libraries.")
(with-directory-excursion "chromium" (with-directory-excursion "chromium"
;; Delete bundled software and binaries that were not ;; Delete bundled software and binaries that were not
;; explicitly preserved above. ;; explicitly preserved above.
(nftw "." delete-unwanted-files 'depth 'physical) #$remove-third-party-files
;; Assert that each preserved item is present to catch
;; removals.
(for-each (lambda (third-party)
(unless (file-exists? third-party)
(error (format #f "~s does not exist!~%"
third-party))))
preserved-club)
;; Use relative header locations instead of hard coded ones. ;; Use relative header locations instead of hard coded ones.
(substitute* (substitute*
@ -2980,6 +2984,7 @@ linux/libcurl_wrapper.h"
(append clang-14 (append clang-14
lld-as-ld-wrapper lld-as-ld-wrapper
python-wrapper python-wrapper
python-beautifulsoup4
python-html5lib))) python-html5lib)))
(inputs (inputs
(modify-inputs (package-inputs qtwebengine-5) (modify-inputs (package-inputs qtwebengine-5)

136
gnu/packages/raspberry-pi.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2021 Stefan <stefan-guix@vodafonemail.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -17,17 +18,22 @@
;;; 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 raspberry-pi) (define-module (gnu packages raspberry-pi)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages algebra) #:use-module (gnu packages algebra)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages commencement) #:use-module (gnu packages commencement)
#:use-module (gnu packages cross-base) #:use-module (gnu packages cross-base)
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages embedded)
#:use-module (gnu packages file) #:use-module (gnu packages file)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages embedded) #:use-module (gnu packages linux)
#:use-module (guix build-system copy)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
@ -40,7 +46,10 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match)) #:use-module (ice-9 match)
#:export (make-raspi-bcm28-dtbs
raspi-config-file
raspi-custom-txt))
(define-public bcm2835 (define-public bcm2835
(package (package
@ -235,3 +244,126 @@ Raspberry Pi. Note: It does not work on Raspberry Pi 1.")
(install-file "arm64.bin" libexec) (install-file "arm64.bin" libexec)
#t)))))))) #t))))))))
(supported-systems '("aarch64-linux")))) (supported-systems '("aarch64-linux"))))
(define (raspi-config-file name content)
"Make a configuration file like config.txt for the Raspberry Pi firmware.
CONTENT can be a list of strings, which are concatenated with a newline
character. Alternatively CONTENT can be a string with the full file content."
(plain-file
name
(if (list? content)
(string-join content "\n" 'suffix)
content)))
(define-public %raspi-config-txt
;; A config.txt file to start the ARM cores up in 64-bit mode if necessary
;; and to include a dtb.txt, bootloader.txt, and a custom.txt, each with
;; separated configurations for the Raspberry Pi firmware.
(raspi-config-file
"config.txt"
`("# See https://www.raspberrypi.org/documentation/configuration/config-txt/README.md for details."
""
,(string-append "arm_64bit=" (if (target-aarch64?) "1" "0"))
"include dtb.txt"
"include bootloader.txt"
"include custom.txt")))
(define-public %raspi-bcm27-dtb-txt
;; A dtb.txt file to be included by the config.txt to ensure that the
;; downstream device tree files bcm27*.dtb will be used.
(raspi-config-file
"dtb.txt"
"upstream_kernel=0"))
(define-public %raspi-bcm28-dtb-txt
;; A dtb.txt file to be included by the config.txt to ensure that the
;; upstream device tree files bcm28*.dtb will be used.
;; This also implies the use of the dtoverlay=upstream.
(raspi-config-file
"dtb.txt"
"upstream_kernel=1"))
(define-public %raspi-u-boot-bootloader-txt
;; A bootloader.txt file to be included by the config.txt to load the
;; U-Boot bootloader.
(raspi-config-file
"bootloader.txt"
'("dtoverlay=upstream"
"enable_uart=1"
"kernel=u-boot.bin")))
(define (raspi-custom-txt content)
"Make a custom.txt file for the Raspberry Pi firmware.
CONTENT can be a list of strings, which are concatenated with a newline
character. Alternatively CONTENT can be a string with the full file content."
(raspi-config-file "custom.txt" content))
(define (make-raspi-bcm28-dtbs linux)
"Make a package with the device-tree files for Raspberry Pi models from the
kernel LINUX."
(package
(inherit linux)
(name "raspi-bcm28-dtbs")
(source #f)
(build-system copy-build-system)
(arguments
#~(list
#:phases #~(modify-phases %standard-phases (delete 'unpack))
#:install-plan
(list (list (search-input-directory %build-inputs
"lib/dtbs/broadcom/")
"." #:include-regexp '("/bcm....-rpi.*\\.dtb")))))
(inputs (list linux))
(synopsis "Device-tree files for a Raspberry Pi")
(description
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
(define-public grub-efi-bootloader-chain-raspi-64
;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
;; a local storage like a micro SD card. It neither installs firmware nor
;; device-tree files for the Raspberry Pi. It just assumes them to be
;; existing in boot/efi in the same way that some UEFI firmware with ACPI
;; data is usually assumed to be existing on PCs. It creates firmware
;; configuration files and a bootloader-chain with U-Boot to provide an EFI
;; API for the final GRUB bootloader. It also serves as a blue-print to
;; create an a custom bootloader-chain with firmware and device-tree
;; packages or files.
(efi-bootloader-chain grub-efi-netboot-removable-bootloader
#:packages (list u-boot-rpi-arm64-efi-bin)
#:files (list %raspi-config-txt
%raspi-bcm27-dtb-txt
%raspi-u-boot-bootloader-txt)))
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
argument of the function (modify-linux)."
(make-defconfig
(string-append
;; This is from commit 7838840 on branch rpi-5.18.y,
;; see https://github.com/raspberrypi/linux/tree/rpi-5.18.y/
;; and https://github.com/raspberrypi/linux/commit/7838840b5606a2051b31da4c598466df7b1c3005
"https://raw.githubusercontent.com/raspberrypi/linux/7838840b5606a2051b31da4c598466df7b1c3005/arch/"
arch "/configs/" defconfig)
sha256-as-base32))
(define-public %bcm2709-defconfig
(make-raspi-defconfig
"arm" "bcm2709_defconfig"
"1hcxmsr131f92ay3bfglrggds8ajy904yj3vw7c42i4c66256a79"))
(define-public %bcm2711-defconfig
(make-raspi-defconfig
"arm" "bcm2711_defconfig"
"1n7g5yq0hdp8lh0x6bfxph2ff8yn8zisdj3qg0gbn83j4v8i1zbd"))
(define-public %bcm2711-defconfig-64
(make-raspi-defconfig
"arm64" "bcm2711_defconfig"
"0k9q7qvw826v2hrp49xnxnw93pnnkicwx869chvlf7i57461n4i7"))
(define-public %bcmrpi3-defconfig
(make-raspi-defconfig
"arm64" "bcmrpi3_defconfig"
"1bfnl4p0ddx3200dg91kmh2pln36w95y05x1asc312kixv0jgd81"))

305
gnu/packages/rust-apps.scm
View file

@ -20,6 +20,8 @@
;;; Copyright © 2022 Gabriel Arazas <foo.dogsquared@gmail.com> ;;; Copyright © 2022 Gabriel Arazas <foo.dogsquared@gmail.com>
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2022 Mathieu Laparie <mlaparie@disr.it> ;;; Copyright © 2022 Mathieu Laparie <mlaparie@disr.it>
;;; Copyright © 2022 ( <paren@disroot.org>
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -37,11 +39,12 @@
;;; 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 rust-apps) (define-module (gnu packages rust-apps)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cargo) #:use-module (guix build-system cargo)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix deprecation) #:use-module (guix deprecation)
#:use-module (guix download)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages) #:use-module (gnu packages)
@ -1028,6 +1031,49 @@ rebase.")
"This package provides a tool for generating C/C++ bindings to Rust code.") "This package provides a tool for generating C/C++ bindings to Rust code.")
(license license:mpl2.0))) (license license:mpl2.0)))
(define-public rust-cbindgen-0.24
(package
(inherit rust-cbindgen)
(name "rust-cbindgen")
(version "0.24.3")
(source (origin
(method url-fetch)
(uri (crate-uri "cbindgen" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1yqxqsz2d0cppd8zwihk2139g5gy38wqgl9snj6rnk8gyvnqsdd6"))))
(arguments
`(#:cargo-inputs
(("rust-clap" ,rust-clap-3)
("rust-heck" ,rust-heck-0.4)
("rust-indexmap" ,rust-indexmap-1)
("rust-log" ,rust-log-0.4)
("rust-proc-macro2" ,rust-proc-macro2-1)
("rust-quote" ,rust-quote-1)
("rust-serde" ,rust-serde-1)
("rust-serde-json" ,rust-serde-json-1)
("rust-syn" ,rust-syn-1)
("rust-tempfile" ,rust-tempfile-3)
("rust-toml" ,rust-toml-0.5))
#:cargo-development-inputs
(("rust-serial-test" ,rust-serial-test-0.5))))
(native-inputs
(list python-cython))))
(define-public rust-cbindgen-0.23
(package
(inherit rust-cbindgen-0.24)
(name "rust-cbindgen")
(version "0.23.0")
(source (origin
(method url-fetch)
(uri (crate-uri "cbindgen" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"006rn3fn4njayjxr2vd24g1awssr9i3894nbmfzkybx07j728vav"))))))
(define-public rust-cbindgen-0.19 (define-public rust-cbindgen-0.19
(package (package
(inherit rust-cbindgen) (inherit rust-cbindgen)
@ -1875,6 +1921,164 @@ C-compatible) software.")
consecutive lines and since program start.") consecutive lines and since program start.")
(license license:expat))) (license license:expat)))
(define-public skim
(package
(name "skim")
(version "0.9.4")
(source
(origin
(method url-fetch)
(uri (crate-uri "skim" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
(base32
"1d5v9vq8frkdjm7bnw3455h6xf3c277d51il2qasn7r20kwik7ab"))))
(build-system cargo-build-system)
(arguments
`(#:cargo-inputs
(("rust-atty-0.2" ,rust-atty-0.2)
("rust-beef" ,rust-beef-0.5)
("rust-bitflags" ,rust-bitflags-1)
("rust-chrono" ,rust-chrono-0.4)
("rust-clap" ,rust-clap-2)
("rust-crossbeam" ,rust-crossbeam-0.8)
("rust-defer-drop" ,rust-defer-drop-1)
("rust-derive-builder" ,rust-derive-builder-0.9)
("rust-env-logger" ,rust-env-logger-0.8)
("rust-fuzzy-matcher" ,rust-fuzzy-matcher-0.3)
("rust-lazy-static" ,rust-lazy-static-1)
("rust-log" ,rust-log-0.4)
("rust-nix" ,rust-nix-0.19)
("rust-rayon" ,rust-rayon-1)
("rust-regex" ,rust-regex-1)
("rust-shlex" ,rust-shlex-0.1)
("rust-time" ,rust-time-0.2)
("rust-timer" ,rust-timer-0.2)
("rust-tuikit" ,rust-tuikit-0.4)
("rust-unicode-width" ,rust-unicode-width-0.1)
("rust-vte" ,rust-vte-0.9))
#:phases
(modify-phases %standard-phases
(add-after 'install 'install-extras
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(share (string-append out "/share"))
(man (string-append out "/share/man"))
(vimfiles (string-append share "/vim/vimfiles/plugin"))
(bash-completion
(string-append share "/bash-completions/completions"))
(zsh-site (string-append share "/zsh/site-functions"))
(fish-vendor
(string-append share "/fish/vendor-completions.d")))
;; Binaries
(for-each
(lambda (binary) (install-file binary bin))
(find-files "bin"))
(mkdir-p share)
;; Manpages
(copy-recursively "man" man)
;; Vim plugins
(mkdir-p vimfiles)
(copy-recursively "plugin" vimfiles)
;; Completions
(mkdir-p bash-completion)
(copy-file
"shell/completion.bash"
(string-append bash-completion "/skim"))
(copy-file
"shell/key-bindings.bash"
(string-append bash-completion "/skim-bindings"))
(mkdir-p zsh-site)
(copy-file
"shell/completion.zsh"
(string-append zsh-site "/_skim"))
(copy-file
"shell/key-bindings.zsh"
(string-append zsh-site "/_skim-bindings"))
(mkdir-p fish-vendor)
(copy-file
"shell/key-bindings.fish"
(string-append fish-vendor "/skim-bindings.fish"))))))))
(home-page "https://github.com/lotabout/skim")
(synopsis "Fuzzy Finder in Rust")
(description "This package provides a fuzzy finder in Rust.")
(license license:expat)))
(define-public skim-0.7
(package
(inherit skim)
(name "skim")
(version "0.7.0")
(source
(origin
(method url-fetch)
(uri (crate-uri "skim" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
(base32
"1yiyd6fml5hd2l811sckkzmiiq9bd7018ajk4qk3ai4wyvqnw8mv"))))
(arguments
`(#:cargo-inputs
(("rust-bitflags" ,rust-bitflags-1)
("rust-chrono" ,rust-chrono-0.4)
("rust-clap" ,rust-clap-2)
("rust-derive-builder" ,rust-derive-builder-0.9)
("rust-env-logger" ,rust-env-logger-0.6)
("rust-fuzzy-matcher" ,rust-fuzzy-matcher-0.3)
("rust-lazy-static" ,rust-lazy-static-1)
("rust-log" ,rust-log-0.4)
("rust-nix" ,rust-nix-0.14)
("rust-rayon" ,rust-rayon-1)
("rust-regex" ,rust-regex-1)
("rust-shlex" ,rust-shlex-0.1)
("rust-time" ,rust-time-0.1)
("rust-timer" ,rust-timer-0.2)
("rust-tuikit" ,rust-tuikit-0.2)
("rust-unicode-width" ,rust-unicode-width-0.1)
("rust-vte" ,rust-vte-0.3))))))
(define-public rust-skim-0.7
(deprecated-package "rust-skim-0.7" skim-0.7))
(define-public svd2rust
(package
(name "svd2rust")
(version "0.19.0")
(source
(origin
(method url-fetch)
(uri (crate-uri "svd2rust" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
(base32
"0q8slfgjfhpljzlk2myb0i538mfq99q1ljn398jm17r1q2pjjxhv"))))
(build-system cargo-build-system)
(arguments
`(#:cargo-inputs
(("rust-anyhow" ,rust-anyhow-1)
("rust-cast" ,rust-cast-0.2)
("rust-clap" ,rust-clap-2)
("rust-clap-conf" ,rust-clap-conf-0.1)
("rust-env-logger" ,rust-env-logger-0.7)
("rust-inflections" ,rust-inflections-1)
("rust-log" ,rust-log-0.4)
("rust-proc-macro2" ,rust-proc-macro2-0.4)
("rust-quote" ,rust-quote-1)
("rust-svd-parser" ,rust-svd-parser-0.10)
("rust-syn" ,rust-syn-1)
("rust-thiserror" ,rust-thiserror-1))))
(home-page "https://github.com/rust-embedded/svd2rust/")
(synopsis
"Generate Rust register maps (`struct`s) from SVD files")
(description
"This program can be used to generate Rust register maps (`struct`s) from SVD
files.")
(license (list license:expat license:asl2.0))))
(define-public swayhide (define-public swayhide
(package (package
(name "swayhide") (name "swayhide")
@ -1900,6 +2104,43 @@ workflow includes opening graphical programs from the terminal, as the locked
terminal won't have to take up any space.") terminal won't have to take up any space.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public swayr
(package
(name "swayr")
(version "0.18.0")
(source
(origin
(method url-fetch)
(uri (crate-uri "swayr" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1m443lwbs3lm20kkviw60db56w9i59dm393z1sn6llpfi2xihh3h"))))
(build-system cargo-build-system)
(arguments
`(#:tests? #f
#:cargo-inputs
(("rust-clap" ,rust-clap-3)
("rust-directories" ,rust-directories-4)
("rust-env-logger" ,rust-env-logger-0.9)
("rust-log" ,rust-log-0.4)
("rust-once-cell" ,rust-once-cell-1)
("rust-rand" ,rust-rand-0.8)
("rust-regex" ,rust-regex-1)
("rust-rt-format" ,rust-rt-format-0.3)
("rust-serde" ,rust-serde-1)
("rust-serde-json" ,rust-serde-json-1)
("rust-swayipc" ,rust-swayipc-3)
("rust-toml" ,rust-toml-0.5))))
(home-page "https://sr.ht/~tsdh/swayr/")
(synopsis "Window-switcher for the sway window manager")
(description
"This package provides a last-recently-used window-switcher for the sway
window manager. Swayr consists of a daemon, and a client. The swayrd daemon
records window/workspace creations, deletions, and focus changes using sway's
JSON IPC interface. The swayr client offers subcommands, and sends them to the
daemon which executes them.")
(license license:gpl3+)))
(define-public tealdeer (define-public tealdeer
(package (package
(name "tealdeer") (name "tealdeer")
@ -2029,32 +2270,54 @@ It will then write @code{fixup!} commits for each of those changes.")
(define-public zoxide (define-public zoxide
(package (package
(name "zoxide") (name "zoxide")
(version "0.6.0") (version "0.8.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (crate-uri "zoxide" version)) (uri (crate-uri "zoxide" version))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 "1ih01l3xp8plicxhmyxjkq12ncpdb8954jcj3dh3lwvkhvw29nkk")))) (base32 "0y5v2vgl9f3n0n0w4b3iddbfyxv0hls0vw5406ry0hcvnnjyy2l3"))))
(build-system cargo-build-system) (build-system cargo-build-system)
(arguments (arguments
`(#:cargo-inputs (list #:cargo-inputs
(("rust-anyhow" ,rust-anyhow-1) `(("rust-anyhow" ,rust-anyhow-1)
("rust-askama" ,rust-askama-0.10) ("rust-askama" ,rust-askama-0.11)
("rust-bincode" ,rust-bincode-1) ("rust-bincode" ,rust-bincode-1)
("rust-clap" ,rust-clap-3) ("rust-clap" ,rust-clap-3)
("rust-dirs-next" ,rust-dirs-next-2) ("rust-clap-complete" ,rust-clap-complete-3)
("rust-dunce" ,rust-dunce-1) ("rust-clap-complete-fig" ,rust-clap-complete-fig-3)
("rust-glob" ,rust-glob-0.3) ("rust-dirs" ,rust-dirs-4)
("rust-once-cell" ,rust-once-cell-1) ("rust-dunce" ,rust-dunce-1)
("rust-ordered-float" ,rust-ordered-float-2) ("rust-fastrand" ,rust-fastrand-1)
("rust-rand" ,rust-rand-0.7) ("rust-glob" ,rust-glob-0.3)
("rust-serde" ,rust-serde-1) ("rust-nix" ,rust-nix-0.24)
("rust-tempfile" ,rust-tempfile-3)) ("rust-serde" ,rust-serde-1)
#:cargo-development-inputs ("rust-which" ,rust-which-4))
(("rust-assert-cmd" ,rust-assert-cmd-1) #:cargo-development-inputs
("rust-seq-macro" ,rust-seq-macro-0.2)))) `(("rust-assert-cmd" ,rust-assert-cmd-2)
("rust-rstest" ,rust-rstest-0.15)
("rust-rstest-reuse" ,rust-rstest-reuse-0.4)
("rust-tempfile" ,rust-tempfile-3))
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'use-older-rust
(lambda _
(setenv "RUSTC_BOOTSTRAP" "1")
(substitute* "Cargo.toml"
(("^rust-version = .*$")
(string-append
"rust-version = \""
#$(package-version rust)
"\"\n")))
(substitute* "src/main.rs"
(("#!\\[allow\\(clippy::single_component_path_imports)]")
"#![feature(total_cmp)]"))
(substitute* "src/cmd/query.rs"
(("let handle = &mut io::stdout\\()\\.lock\\();")
"\
let _stdout = io::stdout();
let handle = &mut _stdout.lock();")))))))
(home-page "https://github.com/ajeetdsouza/zoxide/") (home-page "https://github.com/ajeetdsouza/zoxide/")
(synopsis "Fast way to navigate your file system") (synopsis "Fast way to navigate your file system")
(description (description

17
gnu/packages/rust.scm
View file

@ -625,6 +625,11 @@ safety and thread safety guarantees.")
rust-1.63 "1.64.0" "018j720b2n12slp4xk64jc6shkncd46d621qdyzh2a8s3r49zkdk"))) rust-1.63 "1.64.0" "018j720b2n12slp4xk64jc6shkncd46d621qdyzh2a8s3r49zkdk")))
(package (package
(inherit base-rust) (inherit base-rust)
(source
(origin
(inherit (package-source base-rust))
(patches (search-patches "rust-1.64-fix-riscv64-bootstrap.patch"))
(patch-flags '("-p1" "--reverse"))))
(arguments (arguments
(substitute-keyword-arguments (package-arguments base-rust) (substitute-keyword-arguments (package-arguments base-rust)
((#:phases phases) ((#:phases phases)
@ -638,8 +643,16 @@ safety and thread safety guarantees.")
(generate-all-checksums "vendor")))))))))) (generate-all-checksums "vendor"))))))))))
(define rust-1.65 (define rust-1.65
(rust-bootstrapped-package (let ((base-rust
rust-1.64 "1.65.0" "0f005kc0vl7qyy298f443i78ibz71hmmh820726bzskpyrkvna2q")) (rust-bootstrapped-package
rust-1.64 "1.65.0" "0f005kc0vl7qyy298f443i78ibz71hmmh820726bzskpyrkvna2q")))
(package
(inherit base-rust)
(source
(origin
(inherit (package-source base-rust))
(patches '())
(patch-flags '("-p1")))))))
;;; Note: Only the latest versions of Rust are supported and tested. The ;;; Note: Only the latest versions of Rust are supported and tested. The
;;; intermediate rusts are built for bootstrapping purposes and should not ;;; intermediate rusts are built for bootstrapping purposes and should not

9
gnu/packages/sssd.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2018, 2022 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si> ;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
@ -154,7 +154,7 @@ fundamental object types for C.")
(define-public sssd (define-public sssd
(package (package
(name "sssd") (name "sssd")
(version "2.7.4") (version "2.8.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -163,9 +163,8 @@ fundamental object types for C.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1946pfwyv1ci0m4flrhwkksq42p14n7kcng6fbq6sy4lcn5g3yml")) (base32 "19vn2a1r33q6fnw7jmfv3s4kirnviz0rgq0w6wzx6h008iysidsd"))
(patches (search-patches "sssd-optional-systemd.patch" (patches (search-patches "sssd-system-directories.patch"))))
"sssd-system-directories.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list (list

813
gnu/packages/statistics.scm
View file

File diff suppressed because it is too large Load diff

12
gnu/packages/texinfo.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2019, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017, 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017, 2019, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Pierre-Moana Levesque <pierre.moana.levesque@gmail.com> ;;; Copyright © 2019 Pierre-Moana Levesque <pierre.moana.levesque@gmail.com>
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@ -40,6 +40,7 @@
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module ((gnu packages hurd) #:select (hurd-target?))
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages readline)) #:use-module (gnu packages readline))
@ -71,7 +72,10 @@
(("env -i") (("env -i")
"env ")) "env "))
#t))) #t)))
%standard-phases))) %standard-phases)
;; XXX: Work around <https://issues.guix.gnu.org/59616>.
#:tests? ,(not (hurd-target?))))
(inputs (list ncurses perl)) (inputs (list ncurses perl))
;; When cross-compiling, texinfo will build some of its own binaries with ;; When cross-compiling, texinfo will build some of its own binaries with
;; the native compiler. This means ncurses is needed both in both inputs ;; the native compiler. This means ncurses is needed both in both inputs
@ -98,14 +102,14 @@ is on expressing the content semantically, avoiding physical markup commands.")
(define-public texinfo-7 (define-public texinfo-7
(package (package
(inherit texinfo) (inherit texinfo)
(version "7.0") (version "7.0.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/texinfo/texinfo-" (uri (string-append "mirror://gnu/texinfo/texinfo-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1q73zd0bm7zjamc5ssf329v7fndd8dqv0d7fii6s1rqwaf14nx10")))))) "1cn6na6vgz6nhda0f5naiysx5sqhw3azi81qk6hah1yqnbyj3lmw"))))))
(define-public texinfo-5 (define-public texinfo-5
(package (inherit texinfo) (package (inherit texinfo)

6
gnu/packages/text-editors.scm
View file

@ -310,7 +310,7 @@ bindings and many of the powerful features of GNU Emacs.")
(define-public jucipp (define-public jucipp
(package (package
(name "jucipp") (name "jucipp")
(version "1.7.1") (version "1.7.2")
(home-page "https://gitlab.com/cppit/jucipp") (home-page "https://gitlab.com/cppit/jucipp")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -322,7 +322,7 @@ bindings and many of the powerful features of GNU Emacs.")
(recursive? #t))) (recursive? #t)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0xyf1fa7jvxzvg1dxh5vc50fbwjjsar4fmlvbfhicdd1f8bhz1ii")) (base32 "034il3z38a7qvp95f52n9rxbqmh8fxsy416rjak3zzagvfkvzyii"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
@ -346,7 +346,7 @@ bindings and many of the powerful features of GNU Emacs.")
;; Disable the CMake build test, as it does not test ;; Disable the CMake build test, as it does not test
;; functionality of the package, and requires doing ;; functionality of the package, and requires doing
;; an "in-source" build. ;; an "in-source" build.
(("add_test\\(cmake_build_test.*\\)") (("add_test\\(cmake_(build|file_api)_test.*\\)")
"") "")
;; Disable the git test, as it requires the full checkout. ;; Disable the git test, as it requires the full checkout.
(("add_test\\(git_test.*\\)") (("add_test\\(git_test.*\\)")

33
gnu/packages/video.scm
View file

@ -5083,7 +5083,7 @@ transcode or reformat the videos in any way, producing perfect backups.")
(define-public svt-av1 (define-public svt-av1
(package (package
(name "svt-av1") (name "svt-av1")
(version "0.9.1") (version "1.3.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -5092,10 +5092,8 @@ transcode or reformat the videos in any way, producing perfect backups.")
(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 "02fchq2vlxcxzbrss72xl9vrxzysdy39d5i159bmg3qa45ngd2iw")))) (base32 "0blnla32yz665bx0xyx8lrjs2wqd2xhpbqwwpz72mq7zf341j8vv"))))
(build-system cmake-build-system) (build-system cmake-build-system)
;; SVT-AV1 only supports 64-bit Intel-compatible CPUs.
(supported-systems '("x86_64-linux"))
(arguments (arguments
;; The test suite tries to download test data and git clone a 3rd-party ;; The test suite tries to download test data and git clone a 3rd-party
;; fork of libaom. Skip it. ;; fork of libaom. Skip it.
@ -5113,7 +5111,8 @@ transcode or reformat the videos in any way, producing perfect backups.")
(synopsis "AV1 video codec") (synopsis "AV1 video codec")
(description "SVT-AV1 is an AV1 codec implementation. The encoder is a (description "SVT-AV1 is an AV1 codec implementation. The encoder is a
work-in-progress, aiming to support video-on-demand and live streaming work-in-progress, aiming to support video-on-demand and live streaming
applications. It only supports Intel-compatible CPUs (x86).") applications with high performance requirements. It mainly targets
Intel-compatible CPUs (x86), but has limited support for other architectures.")
(home-page "https://gitlab.com/AOMediaCodec/SVT-AV1") (home-page "https://gitlab.com/AOMediaCodec/SVT-AV1")
(license license:bsd-2))) (license license:bsd-2)))
@ -5569,3 +5568,27 @@ VCS, by default, makes screenshots the same size as the video, see the manual
for details on how to change this.") for details on how to change this.")
(home-page "http://p.outlyer.net/vcs/") (home-page "http://p.outlyer.net/vcs/")
(license license:lgpl2.1+))) (license license:lgpl2.1+)))
(define-public svtplay-dl
(package
(name "svtplay-dl")
(version "4.14")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/spaam/svtplay-dl")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"1wdrdszalvhv80m5jizbvjz4jc08acmbpxcsslyfb5cwh842in8m"))))
(build-system python-build-system)
(inputs (list ffmpeg python-pyaml python-requests python-pysocks
python-cryptography))
(home-page "https://svtplay-dl.se/")
(synopsis "Download or stream SVT Play's (and others) TV programmes")
(description
"@code{svtplay-dl} allows downloading TV programmes from various Swedish
broadcasters including SVT Play, Sveriges Radio, TV4 Play, along with many
others.")
(license license:expat)))

63
gnu/packages/web.scm
View file

@ -4898,6 +4898,69 @@ little effort, and the program to do so is often shorter and simpler than
you'd expect.") you'd expect.")
(license (list license:expat license:cc-by3.0)))) (license (list license:expat license:cc-by3.0))))
(define-public go-github-com-itchyny-timefmt-go
(package
(name "go-github-com-itchyny-timefmt-go")
(version "0.1.4")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/itchyny/timefmt-go")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "0z5z8hy5lbjqdxp544mf238i77n7pf7bv3psgr5gffh0630dsyag"))))
(build-system go-build-system)
(arguments
(list #:import-path "github.com/itchyny/timefmt-go"))
(home-page "https://github.com/itchyny/timefmt-go")
(synopsis "Efficient time formatting library (strftime, strptime) for Golang")
(description
"@code{timefmt-go} is a Go language package for formatting and parsing date
time strings.")
(license license:expat)))
(define-public go-github-com-itchyny-gojq
(package
(name "go-github-com-itchyny-gojq")
(version "0.12.9")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/itchyny/gojq")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1m4zchhhi2428r1v0qz08drac4s63mag1pwcqzsf6n495yc3g0h0"))))
(build-system go-build-system)
(inputs
(list go-github-com-google-go-cmp-cmp
go-github-com-itchyny-timefmt-go
go-github-com-mattn-go-isatty
go-github-com-mattn-go-runewidth
go-gopkg-in-yaml-v3))
(arguments
(list
#:import-path "github.com/itchyny/gojq/cmd/gojq"
#:unpack-path "github.com/itchyny/gojq"))
(home-page "https://github.com/itchyny/gojq")
(synopsis "Pure Go implementation of jq")
(description
"@command{gojq} is an Go implementation and library of the jq JSON
processor.")
(license license:expat)))
(define-public gojq
(package
(inherit go-github-com-itchyny-gojq)
(name "gojq")
(arguments
(ensure-keyword-arguments
(package-arguments go-github-com-itchyny-gojq)
(list #:install-source? #f)))))
(define-public pup (define-public pup
(let ((revision "1") (let ((revision "1")
(commit "681d7bb639334bf485476f5872c5bdab10931f9a")) (commit "681d7bb639334bf485476f5872c5bdab10931f9a"))

50
gnu/packages/wm.scm
View file

@ -1725,7 +1725,7 @@ display a clock or apply image manipulation techniques to the background image."
(define-public waybar (define-public waybar
(package (package
(name "waybar") (name "waybar")
(version "0.9.15") (version "0.9.16")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -1734,7 +1734,7 @@ display a clock or apply image manipulation techniques to the background image."
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0mvwsd3krrlniga0fq13b0qvsf1fj22mk9nzsfgz49r55lqw8sdv")))) (base32 "06vwsax8z6vvvav4c1d40nfiljc7h1cla57r43nv8dw86n539ic5"))))
(build-system meson-build-system) (build-system meson-build-system)
(inputs (list date (inputs (list date
fmt fmt
@ -2987,3 +2987,49 @@ file.")))
(synopsis "Primitive drawing library for Wayland") (synopsis "Primitive drawing library for Wayland")
(description "wld is a drawing library that targets Wayland.") (description "wld is a drawing library that targets Wayland.")
(license license:expat)))) (license license:expat))))
(define-public swc
(let ((commit "a7b615567f83d9e48d585251015048c441ca0239")
(revision "1"))
(package
(name "swc")
(version (git-version "0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/michaelforney/swc")
(commit commit)))
(sha256
(base32
"19rpbwpi81pm92fkhsmbx7pzagpah5m9ih5h5k3m8dy6r8ihdh35"))
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ;no tests
#:make-flags (list (string-append "CC="
,(cc-for-target))
(string-append "PREFIX=" %output))
#:phases (modify-phases %standard-phases
(delete 'configure))))
(inputs (list libdrm
libinput
libxcb
libxkbcommon
wayland
wayland-protocols
wld
xcb-util-wm))
(native-inputs (list pkg-config))
(home-page "https://github.com/michaelforney/swc")
(synopsis "Library for making a simple Wayland compositor")
(description
"swc is a small Wayland compositor implemented as a library.
It has been designed primarily with tiling window managers in mind. Additionally,
notable features include:
@itemize
@item Easy to follow code base
@item XWayland support
@item Can place borders around windows
@end itemize")
(license license:expat))))

232
gnu/packages/wxwidgets.scm
View file

@ -8,6 +8,7 @@
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2018, 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,6 +36,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages curl)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (gnu packages freedesktop) #:use-module (gnu packages freedesktop)
@ -45,18 +47,19 @@
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages photo) #:use-module (gnu packages photo)
#:use-module (gnu packages video) #:use-module (gnu packages video)
#:use-module (gnu packages pcre)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages python-xyz) #:use-module (gnu packages python-xyz)
#:use-module (gnu packages sdl) #:use-module (gnu packages sdl)
#:use-module (gnu packages webkit) #:use-module (gnu packages webkit)
#:use-module (gnu packages xorg) #:use-module (gnu packages xml)
#:use-module ((srfi srfi-1) #:select (alist-delete))) #:use-module (gnu packages xorg))
(define-public wxwidgets (define-public wxwidgets
(package (package
(name "wxwidgets") (name "wxwidgets")
(version "3.0.5.1") (version "3.2.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -64,24 +67,128 @@
"releases/download/v" version "releases/download/v" version
"/wxWidgets-" version ".tar.bz2")) "/wxWidgets-" version ".tar.bz2"))
(sha256 (sha256
(base32 "01y89999jw5q7njrhxajincx7lydls6yq37ikazjryssrxrnw3s4")))) (base32 "0rpsyph7l7kmpld376y0940la3c94y5vdpxmbkj8isqknimrfaf2"))
(modules '((guix build utils)
(ice-9 ftw)
(srfi srfi-26)))
(snippet
'(begin
;; wxWidgets bundles third-party code in the "3rdparty" directory as
;; well as the "src" directory. Remove external components that are
;; not required.
(let ((preserved-3rdparty '("nanosvg"))
;; The src directory contains a mixture of third party libraries
;; and similarly-named integration code. Cautiously use a
;; blacklist approach here.
(bundled-src '("expat" "jpeg" "png" "tiff" "zlib")))
(with-directory-excursion "3rdparty"
(for-each delete-file-recursively
(scandir "." (negate (cut member <>
(append '("." "..")
preserved-3rdparty))))))
(with-directory-excursion "src"
(for-each delete-file-recursively bundled-src)))))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(inputs (inputs
`(("glu" ,glu) (list catch-framework
;; XXX gstreamer-0.10 builds fail curl
;; ("gstreamer" ,gstreamer-0.10) expat
("gtk" ,gtk+) glu
("libjpeg" ,libjpeg-turbo) gstreamer
("libmspack" ,libmspack) gst-plugins-base
("libsm" ,libsm) gtk+
("libtiff" ,libtiff) libjpeg-turbo
("mesa" ,mesa) libmspack
("webkitgtk" ,webkitgtk) libnotify
("sdl" ,sdl) libpng
("shared-mime-info" ,shared-mime-info) libsecret
("xdg-utils" ,xdg-utils))) libsm
libtiff
mesa
pcre2
sdl2
shared-mime-info
webkitgtk-with-libsoup2
xdg-utils
zlib))
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))
(arguments
(list
#:configure-flags #~'("--with-libmspack"
"--with-regex"
"--with-sdl"
"--enable-gui"
"--enable-mediactrl"
"--enable-webview"
"--enable-webviewwebkit")
#:make-flags
#~(list (string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib"))
#:tests? #f ;TODO
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'use-newer-webkit
(lambda _
;; XXX: The configure script tests only for an ancient
;; WebKitGTK version.
(substitute* "configure"
(("webkit2gtk-4\\.0")
"webkit2gtk-4.1"))))
(add-after 'unpack 'refer-to-inputs
(lambda* (#:key inputs #:allow-other-keys)
(let ((catch (search-input-file inputs "include/catch.hpp"))
(mime (search-input-directory inputs "share/mime"))
(xdg-open (search-input-file inputs "bin/xdg-open")))
(install-file catch "3rdparty/catch/include/")
(substitute* "src/unix/utilsx11.cpp"
(("wxExecute\\(xdg_open \\+")
(string-append "wxExecute(\"" xdg-open "\"")))
(substitute* "src/unix/mimetype.cpp"
(("/usr(/local)?/share/mime")
mime)))))
(replace 'configure
(lambda* (#:key native-inputs inputs configure-flags
#:allow-other-keys)
(let ((sh (search-input-file (or native-inputs inputs)
"bin/sh")))
;; The configure script does not understand some of the default
;; options of gnu-build-system, so run it "by hand".
(apply invoke "./configure"
(string-append "SHELL=" sh)
(string-append "CONFIG_SHELL=" sh)
(string-append "--prefix=" #$output)
configure-flags)))))))
(home-page "https://www.wxwidgets.org/")
(synopsis "Widget toolkit for creating graphical user interfaces")
(description
"wxWidgets is a C++ library that lets developers create applications with
a graphical user interface. It has language bindings for Python, Perl, Ruby
and many other languages.")
(license (list l:lgpl2.0+ (l:fsf-free "file://doc/license.txt")))))
(define-public wxwidgets-gtk2
(package/inherit wxwidgets
(name "wxwidgets-gtk2")
(inputs (modify-inputs (package-inputs wxwidgets)
(delete "gtk+")
(prepend gtk+-2)))
(arguments
(substitute-keyword-arguments (package-arguments wxwidgets)
((#:configure-flags flags #~'())
#~(append #$flags '("--with-gtk=2")))))))
(define-public wxwidgets-3.0
(package
(inherit wxwidgets)
(version "3.0.5.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/wxWidgets/wxWidgets/"
"releases/download/v" version
"/wxWidgets-" version ".tar.bz2"))
(sha256
(base32
"01y89999jw5q7njrhxajincx7lydls6yq37ikazjryssrxrnw3s4"))))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
'("--with-regex" "--with-libmspack" '("--with-regex" "--with-libmspack"
@ -102,20 +209,24 @@
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'refer-to-inputs (add-after 'unpack 'refer-to-inputs
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(let* ((mime (search-input-directory inputs "/share/mime"))) (let ((mime (search-input-directory inputs "share/mime"))
(xdg-open (search-input-file inputs "bin/xdg-open")))
(substitute* "src/unix/utilsx11.cpp" (substitute* "src/unix/utilsx11.cpp"
(("wxExecute\\(xdg_open \\+") (("wxExecute\\(xdg_open \\+")
(string-append "wxExecute(\"" (which "xdg-open") "\""))) (string-append "wxExecute(\"" xdg-open "\"")))
(substitute* "src/unix/mimetype.cpp" (substitute* "src/unix/mimetype.cpp"
(("/usr(/local)?/share/mime") mime)) (("/usr(/local)?/share/mime") mime))))))))))
#t))))))
(home-page "https://www.wxwidgets.org/") (define-public wxwidgets-gtk2-3.0
(synopsis "Widget toolkit for creating graphical user interfaces") (package/inherit wxwidgets-3.0
(description (name "wxwidgets-gtk2")
"wxWidgets is a C++ library that lets developers create applications with (inputs (modify-inputs (package-inputs wxwidgets-3.0)
a graphical user interface. It has language bindings for Python, Perl, Ruby (delete "gtk+")
and many other languages.") (prepend gtk+-2)))
(license (list l:lgpl2.0+ (l:fsf-free "file://doc/license.txt"))))) (arguments
(substitute-keyword-arguments (package-arguments wxwidgets-3.0)
((#:configure-flags flags #~'())
#~(append #$flags '("--with-gtk=2")))))))
(define-public wxwidgets-2 (define-public wxwidgets-2
(package (package
@ -152,74 +263,17 @@ and many other languages.")
(("-Wall") "-Wall -Wno-narrowing")) (("-Wall") "-Wall -Wno-narrowing"))
#t))))))) #t)))))))
(define-public wxwidgets-gtk2
(package/inherit wxwidgets
(inputs `(("gtk+" ,gtk+-2)
,@(alist-delete
"gtk+"
(package-inputs wxwidgets))))
(name "wxwidgets-gtk2")))
;; Development version of wxWidgets, required to build against gstreamer-1.x.
;; This can be removed when wxWidgets is updated to the next stable version.
(define-public wxwidgets-3.1
(package (inherit wxwidgets)
(version "3.1.5")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/wxWidgets/wxWidgets")
(commit (string-append "v" version))))
(file-name (git-file-name "wxwidgets" version))
(sha256
(base32
"0j998nzqmycafignclxmahgqm5kgs1fiqbsiyvzm7bnpnafi333y"))))
(inputs (modify-inputs (package-inputs wxwidgets)
(prepend catch-framework gstreamer gst-plugins-base)))
(arguments
(substitute-keyword-arguments (package-arguments wxwidgets)
((#:configure-flags flags)
'(list "--with-regex" "--with-libmspack" "--with-sdl"
"--enable-mediactrl" "--enable-webviewwebkit"))
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'add-catch
(lambda* (#:key inputs #:allow-other-keys)
(install-file
(search-input-file inputs "include/catch.hpp")
"3rdparty/catch/include/")))
(replace 'configure
(lambda* (#:key configure-flags inputs native-inputs outputs
#:allow-other-keys)
(let ((sh (search-input-file (or native-inputs inputs)
"bin/sh")))
(apply invoke "./configure"
(string-append "SHELL=" sh)
(string-append "CONFIG_SHELL=" sh)
(string-append "--prefix="
(assoc-ref outputs "out"))
configure-flags))))))))))
(define-public wxwidgets-gtk2-3.1
(package/inherit wxwidgets-3.1
(inputs `(("gtk+" ,gtk+-2)
,@(alist-delete
"gtk+"
(package-inputs wxwidgets-3.1))))
(name "wxwidgets-gtk2")))
(define-public python-wxpython (define-public python-wxpython
(package (package
(name "python-wxpython") (name "python-wxpython")
(version "4.0.7.post1") (version "4.2.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "wxPython" version)) (uri (pypi-uri "wxPython" version))
(sha256 (sha256
(base32 (base32
"1jppcr3n428m8pgwb9q3g0iiqydxd451ncri4njk8b53xsiflhys")) "1iw6xp76b3fmdqwbqmsx9i1razzpfki5z1hq6l8mszlxa32fng36"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
@ -255,7 +309,7 @@ and many other languages.")
(native-inputs (native-inputs
(list pkg-config python-waf)) (list pkg-config python-waf))
(propagated-inputs (propagated-inputs
(list python-numpy python-pillow python-six)) (list python-attrdict python-numpy python-pillow python-six))
(home-page "https://wxpython.org/") (home-page "https://wxpython.org/")
(synopsis "Cross platform GUI toolkit for Python") (synopsis "Cross platform GUI toolkit for Python")
(description "wxPython is a cross-platform GUI toolkit for the Python (description "wxPython is a cross-platform GUI toolkit for the Python
@ -278,7 +332,7 @@ provide a 100% native look and feel for the application.")
(base32 "1fdbvihw1w2vm29xj54cqgpdabhlg0ydf3clkb0qrlf7mhgkc1rz")))) (base32 "1fdbvihw1w2vm29xj54cqgpdabhlg0ydf3clkb0qrlf7mhgkc1rz"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(inputs (inputs
(list wxwidgets-3.1 cairo ffmpeg)) (list wxwidgets cairo ffmpeg))
(native-inputs (native-inputs
(list pkg-config)) (list pkg-config))
(propagated-inputs (propagated-inputs

882
gnu/services/base.scm
View file

@ -977,148 +977,148 @@ to use as the tty. This is primarily useful for headless systems."
((device-name _ ...) ((device-name _ ...)
device-name)))))))) device-name))))))))
(define agetty-shepherd-service (define (agetty-shepherd-service config)
(match-lambda (match-record config <agetty-configuration>
(($ <agetty-configuration> agetty tty term baud-rate auto-login (agetty tty term baud-rate auto-login
login-program login-pause? eight-bits? no-reset? remote? flow-control? login-program login-pause? eight-bits? no-reset? remote? flow-control?
host no-issue? init-string no-clear? local-line extract-baud? host no-issue? init-string no-clear? local-line extract-baud?
skip-login? no-newline? login-options chroot hangup? keep-baud? timeout skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
detect-case? wait-cr? no-hints? no-hostname? long-hostname? detect-case? wait-cr? no-hints? no-hostname? long-hostname?
erase-characters kill-characters chdir delay nice extra-options erase-characters kill-characters chdir delay nice extra-options
shepherd-requirement) shepherd-requirement)
(list (list
(shepherd-service (shepherd-service
(documentation "Run agetty on a tty.") (documentation "Run agetty on a tty.")
(provision (list (symbol-append 'term- (string->symbol (or tty "console"))))) (provision (list (symbol-append 'term- (string->symbol (or tty "console")))))
;; Since the login prompt shows the host name, wait for the 'host-name' ;; Since the login prompt shows the host name, wait for the 'host-name'
;; service to be done. Also wait for udev essentially so that the tty ;; service to be done. Also wait for udev essentially so that the tty
;; text is not lost in the middle of kernel messages (see also ;; text is not lost in the middle of kernel messages (see also
;; mingetty-shepherd-service). ;; mingetty-shepherd-service).
(requirement (cons* 'user-processes 'host-name 'udev (requirement (cons* 'user-processes 'host-name 'udev
shepherd-requirement)) shepherd-requirement))
(modules '((ice-9 match) (gnu build linux-boot))) (modules '((ice-9 match) (gnu build linux-boot)))
(start (start
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build linux-boot))) '((gnu build linux-boot)))
#~(lambda args #~(lambda args
(let ((defaulted-tty #$(or tty (default-serial-port)))) (let ((defaulted-tty #$(or tty (default-serial-port))))
(apply (apply
(if defaulted-tty (if defaulted-tty
(make-forkexec-constructor (make-forkexec-constructor
(list #$(file-append util-linux "/sbin/agetty") (list #$(file-append util-linux "/sbin/agetty")
#$@extra-options #$@extra-options
#$@(if eight-bits? #$@(if eight-bits?
#~("--8bits") #~("--8bits")
#~()) #~())
#$@(if no-reset? #$@(if no-reset?
#~("--noreset") #~("--noreset")
#~()) #~())
#$@(if remote? #$@(if remote?
#~("--remote") #~("--remote")
#~()) #~())
#$@(if flow-control? #$@(if flow-control?
#~("--flow-control") #~("--flow-control")
#~()) #~())
#$@(if host #$@(if host
#~("--host" #$host) #~("--host" #$host)
#~()) #~())
#$@(if no-issue? #$@(if no-issue?
#~("--noissue") #~("--noissue")
#~()) #~())
#$@(if init-string #$@(if init-string
#~("--init-string" #$init-string) #~("--init-string" #$init-string)
#~()) #~())
#$@(if no-clear? #$@(if no-clear?
#~("--noclear") #~("--noclear")
#~()) #~())
;;; FIXME This doesn't work as expected. According to agetty(8), if this option ;;; FIXME This doesn't work as expected. According to agetty(8), if this option
;;; is not passed, then the default is 'auto'. However, in my tests, when that ;;; is not passed, then the default is 'auto'. However, in my tests, when that
;;; option is selected, agetty never presents the login prompt, and the ;;; option is selected, agetty never presents the login prompt, and the
;;; term-ttyS0 service respawns every few seconds. ;;; term-ttyS0 service respawns every few seconds.
#$@(if local-line #$@(if local-line
#~(#$(match local-line #~(#$(match local-line
('auto "--local-line=auto") ('auto "--local-line=auto")
('always "--local-line=always") ('always "--local-line=always")
('never "-local-line=never"))) ('never "-local-line=never")))
#~()) #~())
#$@(if tty #$@(if tty
#~() #~()
#~("--keep-baud")) #~("--keep-baud"))
#$@(if extract-baud? #$@(if extract-baud?
#~("--extract-baud") #~("--extract-baud")
#~()) #~())
#$@(if skip-login? #$@(if skip-login?
#~("--skip-login") #~("--skip-login")
#~()) #~())
#$@(if no-newline? #$@(if no-newline?
#~("--nonewline") #~("--nonewline")
#~()) #~())
#$@(if login-options #$@(if login-options
#~("--login-options" #$login-options) #~("--login-options" #$login-options)
#~()) #~())
#$@(if chroot #$@(if chroot
#~("--chroot" #$chroot) #~("--chroot" #$chroot)
#~()) #~())
#$@(if hangup? #$@(if hangup?
#~("--hangup") #~("--hangup")
#~()) #~())
#$@(if keep-baud? #$@(if keep-baud?
#~("--keep-baud") #~("--keep-baud")
#~()) #~())
#$@(if timeout #$@(if timeout
#~("--timeout" #$(number->string timeout)) #~("--timeout" #$(number->string timeout))
#~()) #~())
#$@(if detect-case? #$@(if detect-case?
#~("--detect-case") #~("--detect-case")
#~()) #~())
#$@(if wait-cr? #$@(if wait-cr?
#~("--wait-cr") #~("--wait-cr")
#~()) #~())
#$@(if no-hints? #$@(if no-hints?
#~("--nohints?") #~("--nohints?")
#~()) #~())
#$@(if no-hostname? #$@(if no-hostname?
#~("--nohostname") #~("--nohostname")
#~()) #~())
#$@(if long-hostname? #$@(if long-hostname?
#~("--long-hostname") #~("--long-hostname")
#~()) #~())
#$@(if erase-characters #$@(if erase-characters
#~("--erase-chars" #$erase-characters) #~("--erase-chars" #$erase-characters)
#~()) #~())
#$@(if kill-characters #$@(if kill-characters
#~("--kill-chars" #$kill-characters) #~("--kill-chars" #$kill-characters)
#~()) #~())
#$@(if chdir #$@(if chdir
#~("--chdir" #$chdir) #~("--chdir" #$chdir)
#~()) #~())
#$@(if delay #$@(if delay
#~("--delay" #$(number->string delay)) #~("--delay" #$(number->string delay))
#~()) #~())
#$@(if nice #$@(if nice
#~("--nice" #$(number->string nice)) #~("--nice" #$(number->string nice))
#~()) #~())
#$@(if auto-login #$@(if auto-login
(list "--autologin" auto-login) (list "--autologin" auto-login)
'()) '())
#$@(if login-program #$@(if login-program
#~("--login-program" #$login-program) #~("--login-program" #$login-program)
#~()) #~())
#$@(if login-pause? #$@(if login-pause?
#~("--login-pause") #~("--login-pause")
#~()) #~())
defaulted-tty defaulted-tty
#$@(if baud-rate #$@(if baud-rate
#~(#$baud-rate) #~(#$baud-rate)
#~()) #~())
#$@(if term #$@(if term
#~(#$term) #~(#$term)
#~()))) #~())))
(const #f)) ; never start. (const #f)) ; never start.
args))))) args)))))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define agetty-service-type (define agetty-service-type
(service-type (name 'agetty) (service-type (name 'agetty)
@ -1148,42 +1148,42 @@ the tty to run, among other things."
(clear-on-logout? mingetty-clear-on-logout? ;Boolean (clear-on-logout? mingetty-clear-on-logout? ;Boolean
(default #t))) (default #t)))
(define mingetty-shepherd-service (define (mingetty-shepherd-service config)
(match-lambda (match-record config <mingetty-configuration>
(($ <mingetty-configuration> mingetty tty auto-login login-program (mingetty tty auto-login login-program
login-pause? clear-on-logout?) login-pause? clear-on-logout?)
(list (list
(shepherd-service (shepherd-service
(documentation "Run mingetty on an tty.") (documentation "Run mingetty on an tty.")
(provision (list (symbol-append 'term- (string->symbol tty)))) (provision (list (symbol-append 'term- (string->symbol tty))))
;; Since the login prompt shows the host name, wait for the 'host-name' ;; Since the login prompt shows the host name, wait for the 'host-name'
;; service to be done. Also wait for udev essentially so that the tty ;; service to be done. Also wait for udev essentially so that the tty
;; text is not lost in the middle of kernel messages (XXX). ;; text is not lost in the middle of kernel messages (XXX).
(requirement '(user-processes host-name udev virtual-terminal)) (requirement '(user-processes host-name udev virtual-terminal))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty") (list #$(file-append mingetty "/sbin/mingetty")
;; Avoiding 'vhangup' allows us to avoid 'setfont' ;; Avoiding 'vhangup' allows us to avoid 'setfont'
;; errors down the path where various ioctls get ;; errors down the path where various ioctls get
;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c ;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c
;; in Linux. ;; in Linux.
"--nohangup" #$tty "--nohangup" #$tty
#$@(if clear-on-logout? #$@(if clear-on-logout?
#~() #~()
#~("--noclear")) #~("--noclear"))
#$@(if auto-login #$@(if auto-login
#~("--autologin" #$auto-login) #~("--autologin" #$auto-login)
#~()) #~())
#$@(if login-program #$@(if login-program
#~("--loginprog" #$login-program) #~("--loginprog" #$login-program)
#~()) #~())
#$@(if login-pause? #$@(if login-pause?
#~("--loginpause") #~("--loginpause")
#~())))) #~()))))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define mingetty-service-type (define mingetty-service-type
(service-type (name 'mingetty) (service-type (name 'mingetty)
@ -1260,46 +1260,47 @@ the tty to run, among other things."
(define (nscd.conf-file config) (define (nscd.conf-file config)
"Return the @file{nscd.conf} configuration file for @var{config}, an "Return the @file{nscd.conf} configuration file for @var{config}, an
@code{<nscd-configuration>} object." @code{<nscd-configuration>} object."
(define cache->config (define (cache->config cache)
(match-lambda (match-record cache <nscd-cache>
(($ <nscd-cache> (= symbol->string database) (database positive-time-to-live negative-time-to-live
positive-ttl negative-ttl size check-files? suggested-size check-files?
persistent? shared? max-size propagate?) persistent? shared? max-database-size auto-propagate?)
(string-append "\nenable-cache\t" database "\tyes\n" (let ((database (symbol->string database)))
(string-append "\nenable-cache\t" database "\tyes\n"
"positive-time-to-live\t" database "\t" "positive-time-to-live\t" database "\t"
(number->string positive-ttl) "\n" (number->string positive-time-to-live) "\n"
"negative-time-to-live\t" database "\t" "negative-time-to-live\t" database "\t"
(number->string negative-ttl) "\n" (number->string negative-time-to-live) "\n"
"suggested-size\t" database "\t" "suggested-size\t" database "\t"
(number->string size) "\n" (number->string suggested-size) "\n"
"check-files\t" database "\t" "check-files\t" database "\t"
(if check-files? "yes\n" "no\n") (if check-files? "yes\n" "no\n")
"persistent\t" database "\t" "persistent\t" database "\t"
(if persistent? "yes\n" "no\n") (if persistent? "yes\n" "no\n")
"shared\t" database "\t" "shared\t" database "\t"
(if shared? "yes\n" "no\n") (if shared? "yes\n" "no\n")
"max-db-size\t" database "\t" "max-db-size\t" database "\t"
(number->string max-size) "\n" (number->string max-database-size) "\n"
"auto-propagate\t" database "\t" "auto-propagate\t" database "\t"
(if propagate? "yes\n" "no\n"))))) (if auto-propagate? "yes\n" "no\n")))))
(match config (match-record config <nscd-configuration>
(($ <nscd-configuration> log-file debug-level caches) (log-file debug-level caches)
(plain-file "nscd.conf" (plain-file "nscd.conf"
(string-append "\ (string-append "\
# Configuration of libc's name service cache daemon (nscd).\n\n" # Configuration of libc's name service cache daemon (nscd).\n\n"
(if log-file (if log-file
(string-append "logfile\t" log-file) (string-append "logfile\t" log-file)
"") "")
"\n" "\n"
(if debug-level (if debug-level
(string-append "debug-level\t" (string-append "debug-level\t"
(number->string debug-level)) (number->string debug-level))
"") "")
"\n" "\n"
(string-concatenate (string-concatenate
(map cache->config caches))))))) (map cache->config caches))))))
(define (nscd-action-procedure nscd config option) (define (nscd-action-procedure nscd config option)
;; XXX: This is duplicated from mcron; factorize. ;; XXX: This is duplicated from mcron; factorize.
@ -1797,17 +1798,15 @@ proxy of 'guix-daemon'...~%")
(define (guix-accounts config) (define (guix-accounts config)
"Return the user accounts and user groups for CONFIG." "Return the user accounts and user groups for CONFIG."
(match config (cons (user-group
(($ <guix-configuration> _ build-group build-accounts) (name (guix-configuration-build-group config))
(cons (user-group (system? #t)
(name build-group)
(system? #t)
;; Use a fixed GID so that we can create the store with the right ;; Use a fixed GID so that we can create the store with the right
;; owner. ;; owner.
(id 30000)) (id 30000))
(guix-build-accounts build-accounts (guix-build-accounts (guix-configuration-build-accounts config)
#:group build-group))))) #:group (guix-configuration-build-group config))))
(define (guix-activation config) (define (guix-activation config)
"Return the activation gexp for CONFIG." "Return the activation gexp for CONFIG."
@ -2130,95 +2129,94 @@ item of @var{packages}."
(udev-rule "90-kvm.rules" (udev-rule "90-kvm.rules"
"KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n")) "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
(define udev-shepherd-service (define (udev-shepherd-service config)
;; Return a <shepherd-service> for UDEV with RULES. ;; Return a <shepherd-service> for UDEV with RULES.
(match-lambda (let ((udev (udev-configuration-udev config)))
(($ <udev-configuration> udev) (list
(list (shepherd-service
(shepherd-service (provision '(udev))
(provision '(udev))
;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
;; be added: see ;; be added: see
;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>. ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
(requirement '(root-file-system)) (requirement '(root-file-system))
(documentation "Populate the /dev directory, dynamically.") (documentation "Populate the /dev directory, dynamically.")
(start (start
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build linux-boot))) '((gnu build linux-boot)))
#~(lambda () #~(lambda ()
(define udevd (define udevd
;; 'udevd' from eudev. ;; 'udevd' from eudev.
#$(file-append udev "/sbin/udevd")) #$(file-append udev "/sbin/udevd"))
(define (wait-for-udevd) (define (wait-for-udevd)
;; Wait until someone's listening on udevd's control ;; Wait until someone's listening on udevd's control
;; socket. ;; socket.
(let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
(let try () (let try ()
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock PF_UNIX "/run/udev/control") (connect sock PF_UNIX "/run/udev/control")
(close-port sock)) (close-port sock))
(lambda args (lambda args
(format #t "waiting for udevd...~%") (format #t "waiting for udevd...~%")
(usleep 500000) (usleep 500000)
(try)))))) (try))))))
;; Allow udev to find the modules. ;; Allow udev to find the modules.
(setenv "LINUX_MODULE_DIRECTORY" (setenv "LINUX_MODULE_DIRECTORY"
"/run/booted-system/kernel/lib/modules") "/run/booted-system/kernel/lib/modules")
(let* ((kernel-release (let* ((kernel-release
(utsname:release (uname))) (utsname:release (uname)))
(linux-module-directory (linux-module-directory
(getenv "LINUX_MODULE_DIRECTORY")) (getenv "LINUX_MODULE_DIRECTORY"))
(directory (directory
(string-append linux-module-directory "/" (string-append linux-module-directory "/"
kernel-release)) kernel-release))
(old-umask (umask #o022))) (old-umask (umask #o022)))
;; If we're in a container, DIRECTORY might not exist, ;; If we're in a container, DIRECTORY might not exist,
;; for instance because the host runs a different ;; for instance because the host runs a different
;; kernel. In that case, skip it; we'll just miss a few ;; kernel. In that case, skip it; we'll just miss a few
;; nodes like /dev/fuse. ;; nodes like /dev/fuse.
(when (file-exists? directory) (when (file-exists? directory)
(make-static-device-nodes directory)) (make-static-device-nodes directory))
(umask old-umask)) (umask old-umask))
(let ((pid (fork+exec-command (let ((pid (fork+exec-command
(list udevd) (list udevd)
#:environment-variables #:environment-variables
(cons* (cons*
;; The first one is for udev, the second one for ;; The first one is for udev, the second one for
;; eudev. ;; eudev.
"UDEV_CONFIG_FILE=/etc/udev/udev.conf" "UDEV_CONFIG_FILE=/etc/udev/udev.conf"
"EUDEV_RULES_DIRECTORY=/etc/udev/rules.d" "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d"
(string-append "LINUX_MODULE_DIRECTORY=" (string-append "LINUX_MODULE_DIRECTORY="
(getenv "LINUX_MODULE_DIRECTORY")) (getenv "LINUX_MODULE_DIRECTORY"))
(default-environment-variables))))) (default-environment-variables)))))
;; Wait until udevd is up and running. This appears to ;; Wait until udevd is up and running. This appears to
;; be needed so that the events triggered below are ;; be needed so that the events triggered below are
;; actually handled. ;; actually handled.
(wait-for-udevd) (wait-for-udevd)
;; Trigger device node creation. ;; Trigger device node creation.
(system* #$(file-append udev "/bin/udevadm") (system* #$(file-append udev "/bin/udevadm")
"trigger" "--action=add") "trigger" "--action=add")
;; Wait for things to settle down. ;; Wait for things to settle down.
(system* #$(file-append udev "/bin/udevadm") (system* #$(file-append udev "/bin/udevadm")
"settle") "settle")
pid)))) pid))))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
;; When halting the system, 'udev' is actually killed by ;; When halting the system, 'udev' is actually killed by
;; 'user-processes', i.e., before its own 'stop' method was called. ;; 'user-processes', i.e., before its own 'stop' method was called.
;; Thus, make sure it is not respawned. ;; Thus, make sure it is not respawned.
(respawn? #f) (respawn? #f)
;; We need additional modules. ;; We need additional modules.
(modules `((gnu build linux-boot) ;'make-static-device-nodes' (modules `((gnu build linux-boot) ;'make-static-device-nodes'
,@%default-modules))))))) ,@%default-modules))))))
(define udev.conf (define udev.conf
(computed-file "udev.conf" (computed-file "udev.conf"
@ -2226,14 +2224,15 @@ item of @var{packages}."
(lambda (port) (lambda (port)
(format port "udev_rules=\"/etc/udev/rules.d\"~%"))))) (format port "udev_rules=\"/etc/udev/rules.d\"~%")))))
(define udev-etc (define (udev-etc config)
(match-lambda (match-record config <udev-configuration>
(($ <udev-configuration> udev rules) (udev rules)
`(("udev" `(("udev"
,(file-union ,(file-union "udev"
"udev" `(("udev.conf" ,udev.conf) `(("udev.conf" ,udev.conf)
("rules.d" ,(udev-rules-union (cons* udev kvm-udev-rule ("rules.d"
rules)))))))))) ,(udev-rules-union (cons* udev kvm-udev-rule
rules)))))))))
(define udev-service-type (define udev-service-type
(service-type (name 'udev) (service-type (name 'udev)
@ -2243,11 +2242,11 @@ item of @var{packages}."
(service-extension etc-service-type udev-etc))) (service-extension etc-service-type udev-etc)))
(compose concatenate) ;concatenate the list of rules (compose concatenate) ;concatenate the list of rules
(extend (lambda (config rules) (extend (lambda (config rules)
(match config (let ((initial-rules
(($ <udev-configuration> udev initial-rules) (udev-configuration-rules config)))
(udev-configuration (udev-configuration
(udev udev) (inherit config)
(rules (append initial-rules rules))))))) (rules (append initial-rules rules))))))
(default-value (udev-configuration)) (default-value (udev-configuration))
(description (description
"Run @command{udev}, which populates the @file{/dev} "Run @command{udev}, which populates the @file{/dev}
@ -2385,23 +2384,23 @@ instance."
(options gpm-configuration-options ;list of strings (options gpm-configuration-options ;list of strings
(default %default-gpm-options))) (default %default-gpm-options)))
(define gpm-shepherd-service (define (gpm-shepherd-service config)
(match-lambda (match-record config <gpm-configuration>
(($ <gpm-configuration> gpm options) (gpm options)
(list (shepherd-service (list (shepherd-service
(requirement '(udev)) (requirement '(udev))
(provision '(gpm)) (provision '(gpm))
;; 'gpm' runs in the background and sets a PID file. ;; 'gpm' runs in the background and sets a PID file.
;; Note that it requires running as "root". ;; Note that it requires running as "root".
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$(file-append gpm "/sbin/gpm") (list #$(file-append gpm "/sbin/gpm")
#$@options) #$@options)
#:pid-file "/var/run/gpm.pid" #:pid-file "/var/run/gpm.pid"
#:pid-file-timeout 3)) #:pid-file-timeout 3))
(stop #~(lambda (_) (stop #~(lambda (_)
;; Return #f if successfully stopped. ;; Return #f if successfully stopped.
(not (zero? (system* #$(file-append gpm "/sbin/gpm") (not (zero? (system* #$(file-append gpm "/sbin/gpm")
"-k")))))))))) "-k")))))))))
(define gpm-service-type (define gpm-service-type
(service-type (name 'gpm) (service-type (name 'gpm)
@ -2654,32 +2653,64 @@ to CONFIG."
"/servers/socket/2") "/servers/socket/2")
#f)))) #f))))
(define network-set-up/linux (define (network-set-up/linux config)
(match-lambda (match-record config <static-networking>
(($ <static-networking> addresses links routes) (addresses links routes)
(scheme-file "set-up-network" (scheme-file "set-up-network"
(with-extensions (list guile-netlink) (with-extensions (list guile-netlink)
#~(begin #~(begin
(use-modules (ip addr) (ip link) (ip route)) (use-modules (ip addr) (ip link) (ip route))
#$@(map (lambda (address) #$@(map (lambda (address)
#~(begin #~(begin
(addr-add #$(network-address-device address) (addr-add #$(network-address-device address)
#$(network-address-value address) #$(network-address-value address)
#:ipv6? #:ipv6?
#$(network-address-ipv6? address)) #$(network-address-ipv6? address))
;; FIXME: loopback? ;; FIXME: loopback?
(link-set #$(network-address-device address) (link-set #$(network-address-device address)
#:multicast-on #t #:multicast-on #t
#:up #t))) #:up #t)))
addresses) addresses)
#$@(map (match-lambda #$@(map (match-lambda
(($ <network-link> name type arguments) (($ <network-link> name type arguments)
#~(link-add #$name #$type #~(link-add #$name #$type
#:type-args '#$arguments))) #:type-args '#$arguments)))
links) links)
#$@(map (lambda (route) #$@(map (lambda (route)
#~(route-add #$(network-route-destination route) #~(route-add #$(network-route-destination route)
#:device
#$(network-route-device route)
#:ipv6?
#$(network-route-ipv6? route)
#:via
#$(network-route-gateway route)
#:src
#$(network-route-source route)))
routes)
#t)))))
(define (network-tear-down/linux config)
(match-record config <static-networking>
(addresses links routes)
(scheme-file "tear-down-network"
(with-extensions (list guile-netlink)
#~(begin
(use-modules (ip addr) (ip link) (ip route)
(netlink error)
(srfi srfi-34))
(define-syntax-rule (false-if-netlink-error exp)
(guard (c ((netlink-error? c) #f))
exp))
;; Wrap calls in 'false-if-netlink-error' so this
;; script goes as far as possible undoing the effects
;; of "set-up-network".
#$@(map (lambda (route)
#~(false-if-netlink-error
(route-del #$(network-route-destination route)
#:device #:device
#$(network-route-device route) #$(network-route-device route)
#:ipv6? #:ipv6?
@ -2687,80 +2718,47 @@ to CONFIG."
#:via #:via
#$(network-route-gateway route) #$(network-route-gateway route)
#:src #:src
#$(network-route-source route))) #$(network-route-source route))))
routes) routes)
#t)))))) #$@(map (match-lambda
(($ <network-link> name type arguments)
(define network-tear-down/linux
(match-lambda
(($ <static-networking> addresses links routes)
(scheme-file "tear-down-network"
(with-extensions (list guile-netlink)
#~(begin
(use-modules (ip addr) (ip link) (ip route)
(netlink error)
(srfi srfi-34))
(define-syntax-rule (false-if-netlink-error exp)
(guard (c ((netlink-error? c) #f))
exp))
;; Wrap calls in 'false-if-netlink-error' so this
;; script goes as far as possible undoing the effects
;; of "set-up-network".
#$@(map (lambda (route)
#~(false-if-netlink-error #~(false-if-netlink-error
(route-del #$(network-route-destination route) (link-del #$name))))
#:device links)
#$(network-route-device route) #$@(map (lambda (address)
#:ipv6? #~(false-if-netlink-error
#$(network-route-ipv6? route) (addr-del #$(network-address-device
#:via address)
#$(network-route-gateway route) #$(network-address-value address)
#:src #:ipv6?
#$(network-route-source route)))) #$(network-address-ipv6? address))))
routes) addresses)
#$@(map (match-lambda #f)))))
(($ <network-link> name type arguments)
#~(false-if-netlink-error
(link-del #$name))))
links)
#$@(map (lambda (address)
#~(false-if-netlink-error
(addr-del #$(network-address-device
address)
#$(network-address-value address)
#:ipv6?
#$(network-address-ipv6? address))))
addresses)
#f))))))
(define (static-networking-shepherd-service config) (define (static-networking-shepherd-service config)
(match config (match-record config <static-networking>
(($ <static-networking> addresses links routes (addresses links routes provision requirement name-servers)
provision requirement name-servers) (let ((loopback? (and provision (memq 'loopback provision))))
(let ((loopback? (and provision (memq 'loopback provision)))) (shepherd-service
(shepherd-service
(documentation (documentation
"Bring up the networking interface using a static IP address.") "Bring up the networking interface using a static IP address.")
(requirement requirement) (requirement requirement)
(provision provision) (provision provision)
(start #~(lambda _ (start #~(lambda _
;; Return #t if successfully started. ;; Return #t if successfully started.
(load #$(let-system (system target)
(if (string-contains (or target system) "-linux")
(network-set-up/linux config)
(network-set-up/hurd config))))))
(stop #~(lambda _
;; Return #f is successfully stopped.
(load #$(let-system (system target) (load #$(let-system (system target)
(if (string-contains (or target system) "-linux") (if (string-contains (or target system) "-linux")
(network-tear-down/linux config) (network-set-up/linux config)
(network-tear-down/hurd config)))))) (network-set-up/hurd config))))))
(respawn? #f)))))) (stop #~(lambda _
;; Return #f is successfully stopped.
(load #$(let-system (system target)
(if (string-contains (or target system) "-linux")
(network-tear-down/linux config)
(network-tear-down/hurd config))))))
(respawn? #f)))))
(define (static-networking-shepherd-services networks) (define (static-networking-shepherd-services networks)
(map static-networking-shepherd-service networks)) (map static-networking-shepherd-service networks))
@ -2873,33 +2871,33 @@ to handle."
(extra-env greetd-agreety-extra-env (default '())) (extra-env greetd-agreety-extra-env (default '()))
(xdg-env? greetd-agreety-xdg-env? (default #t))) (xdg-env? greetd-agreety-xdg-env? (default #t)))
(define greetd-agreety-tty-session-command (define (greetd-agreety-tty-session-command config)
(match-lambda (match-record config <greetd-agreety-session>
(($ <greetd-agreety-session> _ command args extra-env) (command command-args extra-env)
(program-file (program-file
"agreety-tty-session-command" "agreety-tty-session-command"
#~(begin #~(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(for-each (match-lambda ((var . val) (setenv var val))) (for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env))) (quote (#$@extra-env)))
(apply execl #$command #$command (list #$@args))))))) (apply execl #$command #$command (list #$@command-args))))))
(define greetd-agreety-tty-xdg-session-command (define (greetd-agreety-tty-xdg-session-command config)
(match-lambda (match-record config <greetd-agreety-session>
(($ <greetd-agreety-session> _ command args extra-env) (command command-args extra-env)
(program-file (program-file
"agreety-tty-xdg-session-command" "agreety-tty-xdg-session-command"
#~(begin #~(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(let* (let*
((username (getenv "USER")) ((username (getenv "USER"))
(useruid (passwd:uid (getpwuid username))) (useruid (passwd:uid (getpwuid username)))
(useruid (number->string useruid))) (useruid (number->string useruid)))
(setenv "XDG_SESSION_TYPE" "tty") (setenv "XDG_SESSION_TYPE" "tty")
(setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))) (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
(for-each (match-lambda ((var . val) (setenv var val))) (for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env))) (quote (#$@extra-env)))
(apply execl #$command #$command (list #$@args))))))) (apply execl #$command #$command (list #$@command-args))))))
(define-gexp-compiler (greetd-agreety-session-compiler (define-gexp-compiler (greetd-agreety-session-compiler
(session <greetd-agreety-session>) (session <greetd-agreety-session>)

4
gnu/services/cuirass.scm
View file

@ -125,7 +125,7 @@
(let ((cuirass (cuirass-configuration-cuirass config)) (let ((cuirass (cuirass-configuration-cuirass config))
(cache-directory (cuirass-configuration-cache-directory config)) (cache-directory (cuirass-configuration-cache-directory config))
(web-log-file (cuirass-configuration-web-log-file config)) (web-log-file (cuirass-configuration-web-log-file config))
(log-file (cuirass-configuration-log-file config)) (main-log-file (cuirass-configuration-log-file config))
(user (cuirass-configuration-user config)) (user (cuirass-configuration-user config))
(group (cuirass-configuration-group config)) (group (cuirass-configuration-group config))
(interval (cuirass-configuration-interval config)) (interval (cuirass-configuration-interval config))
@ -169,7 +169,7 @@
#:user #$user #:user #$user
#:group #$group #:group #$group
#:log-file #$log-file)) #:log-file #$main-log-file))
(stop #~(make-kill-destructor))) (stop #~(make-kill-destructor)))
,(shepherd-service ,(shepherd-service
(documentation "Run Cuirass web interface.") (documentation "Run Cuirass web interface.")

22
gnu/services/getmail.scm
View file

@ -215,17 +215,6 @@ lines.")
(parameter-alist '()) (parameter-alist '())
"Extra options to include.")) "Extra options to include."))
(define (serialize-getmail-configuration-file field-name val)
(match-record val <getmail-configuration-file>
(retriever destination options)
#~(string-append
"[retriever]\n"
#$(serialize-getmail-retriever-configuration #f retriever)
"\n[destination]\n"
#$(serialize-getmail-destination-configuration #f destination)
"\n[options]\n"
#$(serialize-getmail-options-configuration #f options))))
(define-configuration getmail-configuration-file (define-configuration getmail-configuration-file
(retriever (retriever
(getmail-retriever-configuration (getmail-retriever-configuration)) (getmail-retriever-configuration (getmail-retriever-configuration))
@ -237,6 +226,17 @@ lines.")
(getmail-options-configuration (getmail-options-configuration)) (getmail-options-configuration (getmail-options-configuration))
"Configure getmail.")) "Configure getmail."))
(define (serialize-getmail-configuration-file field-name val)
(match-record val <getmail-configuration-file>
(retriever destination options)
#~(string-append
"[retriever]\n"
#$(serialize-getmail-retriever-configuration #f retriever)
"\n[destination]\n"
#$(serialize-getmail-destination-configuration #f destination)
"\n[options]\n"
#$(serialize-getmail-options-configuration #f options))))
(define (serialize-symbol field-name val) "") (define (serialize-symbol field-name val) "")
(define (serialize-getmail-configuration field-name val) "") (define (serialize-getmail-configuration field-name val) "")

668
gnu/services/networking.scm
View file

@ -18,6 +18,7 @@
;;; Copyright © 2021 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2021 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2022 Andrew Tropin <andrew@trop.in>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -277,8 +278,10 @@ fe80::1%lo0 apps.facebook.com\n")
(define dhcp-client-shepherd-service (define dhcp-client-shepherd-service
(match-lambda (match-lambda
(($ <dhcp-client-configuration> package interfaces) ((? dhcp-client-configuration? config)
(let ((pid-file "/var/run/dhclient.pid")) (let ((package (dhcp-client-configuration-package config))
(interfaces (dhcp-client-configuration-interfaces config))
(pid-file "/var/run/dhclient.pid"))
(list (shepherd-service (list (shepherd-service
(documentation "Set up networking via DHCP.") (documentation "Set up networking via DHCP.")
(requirement '(user-processes udev)) (requirement '(user-processes udev))
@ -359,46 +362,46 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
(interfaces dhcpd-configuration-interfaces (interfaces dhcpd-configuration-interfaces
(default '()))) (default '())))
(define dhcpd-shepherd-service (define (dhcpd-shepherd-service config)
(match-lambda (match-record config <dhcpd-configuration>
(($ <dhcpd-configuration> package config-file version run-directory (package config-file version run-directory
lease-file pid-file interfaces) lease-file pid-file interfaces)
(unless config-file (unless config-file
(error "Must supply a config-file")) (error "Must supply a config-file"))
(list (shepherd-service (list (shepherd-service
;; Allow users to easily run multiple versions simultaneously. ;; Allow users to easily run multiple versions simultaneously.
(provision (list (string->symbol (provision (list (string->symbol
(string-append "dhcpv" version "-daemon")))) (string-append "dhcpv" version "-daemon"))))
(documentation (string-append "Run the DHCPv" version " daemon")) (documentation (string-append "Run the DHCPv" version " daemon"))
(requirement '(networking)) (requirement '(networking))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
'(#$(file-append package "/sbin/dhcpd") '(#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version) #$(string-append "-" version)
"-lf" #$lease-file "-lf" #$lease-file
"-pf" #$pid-file "-pf" #$pid-file
"-cf" #$config-file "-cf" #$config-file
#$@interfaces) #$@interfaces)
#:pid-file #$pid-file)) #:pid-file #$pid-file))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define dhcpd-activation (define (dhcpd-activation config)
(match-lambda (match-record config <dhcpd-configuration>
(($ <dhcpd-configuration> package config-file version run-directory (package config-file version run-directory
lease-file pid-file interfaces) lease-file pid-file interfaces)
(with-imported-modules '((guix build utils)) (with-imported-modules '((guix build utils))
#~(begin #~(begin
(unless (file-exists? #$run-directory) (unless (file-exists? #$run-directory)
(mkdir #$run-directory)) (mkdir #$run-directory))
;; According to the DHCP manual (man dhcpd.leases), the lease ;; According to the DHCP manual (man dhcpd.leases), the lease
;; database must be present for dhcpd to start successfully. ;; database must be present for dhcpd to start successfully.
(unless (file-exists? #$lease-file) (unless (file-exists? #$lease-file)
(with-output-to-file #$lease-file (with-output-to-file #$lease-file
(lambda _ (display "")))) (lambda _ (display ""))))
;; Validate the config. ;; Validate the config.
(invoke/quiet (invoke/quiet
#$(file-append package "/sbin/dhcpd") #$(file-append package "/sbin/dhcpd")
#$(string-append "-" version) #$(string-append "-" version)
"-t" "-cf" #$config-file)))))) "-t" "-cf" #$config-file)))))
(define dhcpd-service-type (define dhcpd-service-type
(service-type (service-type
@ -449,16 +452,16 @@ daemon is responsible for allocating IP addresses to its client.")))
(fold loop res x) (fold loop res x)
(cons (format #f "~a" x) res))))) (cons (format #f "~a" x) res)))))
(match ntp-server (match-record ntp-server <ntp-server>
(($ <ntp-server> type address options) (type address options)
;; XXX: It'd be neater if fields were validated at the syntax level (for ;; XXX: It'd be neater if fields were validated at the syntax level (for
;; static ones at least). Perhaps the Guix record type could support a ;; static ones at least). Perhaps the Guix record type could support a
;; predicate property on a field? ;; predicate property on a field?
(unless (enum-set-member? type ntp-server-types) (unless (enum-set-member? type ntp-server-types)
(error "Invalid NTP server type" type)) (error "Invalid NTP server type" type))
(string-join (cons* (symbol->string type) (string-join (cons* (symbol->string type)
address address
(flatten options)))))) (flatten options)))))
(define %ntp-servers (define %ntp-servers
;; Default set of NTP servers. These URLs are managed by the NTP Pool project. ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
@ -497,17 +500,16 @@ deprecated. Please use <ntp-server> records instead.\n")
((($ <ntp-server>) ($ <ntp-server>) ...) ((($ <ntp-server>) ($ <ntp-server>) ...)
ntp-servers)))) ntp-servers))))
(define ntp-shepherd-service (define (ntp-shepherd-service config)
(lambda (config) (match-record config <ntp-configuration>
(match config (ntp servers allow-large-adjustment?)
(($ <ntp-configuration> ntp servers allow-large-adjustment?) (let ((servers (ntp-configuration-servers config)))
(let ((servers (ntp-configuration-servers config))) ;; TODO: Add authentication support.
;; TODO: Add authentication support. (define config
(define config (string-append "driftfile /var/run/ntpd/ntp.drift\n"
(string-append "driftfile /var/run/ntpd/ntp.drift\n" (string-join (map ntp-server->string servers)
(string-join (map ntp-server->string servers) "\n")
"\n") "
"
# Disable status queries as a workaround for CVE-2013-5211: # Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>. # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
restrict default kod nomodify notrap nopeer noquery limited restrict default kod nomodify notrap nopeer noquery limited
@ -521,21 +523,21 @@ restrict -6 ::1
# option by default, as documented in the 'ntp.conf' manual. # option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n")) restrict source notrap nomodify noquery\n"))
(define ntpd.conf (define ntpd.conf
(plain-file "ntpd.conf" config)) (plain-file "ntpd.conf" config))
(list (shepherd-service (list (shepherd-service
(provision '(ntpd)) (provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.") (documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking)) (requirement '(user-processes networking))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$ntp "/bin/ntpd") "-n" (list (string-append #$ntp "/bin/ntpd") "-n"
"-c" #$ntpd.conf "-u" "ntpd" "-c" #$ntpd.conf "-u" "ntpd"
#$@(if allow-large-adjustment? #$@(if allow-large-adjustment?
'("-g") '("-g")
'())) '()))
#:log-file "/var/log/ntpd.log")) #:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor))))))))) (stop #~(make-kill-destructor)))))))
(define %ntp-accounts (define %ntp-accounts
(list (user-account (list (user-account
@ -742,19 +744,19 @@ daemon will keep the system clock synchronized with that of the given servers.")
" ") "\n"))) " ") "\n")))
entries))) entries)))
(define inetd-shepherd-service (define (inetd-shepherd-service config)
(match-lambda (let ((entries (inetd-configuration-entries config)))
(($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing (if (null? entries)
(($ <inetd-configuration> program entries) '() ;do nothing
(list (let ((program (inetd-configuration-program config)))
(shepherd-service (list (shepherd-service
(documentation "Run inetd.") (documentation "Run inetd.")
(provision '(inetd)) (provision '(inetd))
(requirement '(user-processes networking syslogd)) (requirement '(user-processes networking syslogd))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$program #$(inetd-config-file entries)) (list #$program #$(inetd-config-file entries))
#:pid-file "/var/run/inetd.pid")) #:pid-file "/var/run/inetd.pid"))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))))
(define-public inetd-service-type (define-public inetd-service-type
(service-type (service-type
@ -938,97 +940,94 @@ applications in communication. It is used by Jami, for example.")))
(define (tor-configuration->torrc config) (define (tor-configuration->torrc config)
"Return a 'torrc' file for CONFIG." "Return a 'torrc' file for CONFIG."
(match config (match-record config <tor-configuration>
(($ <tor-configuration> tor config-file services (tor config-file hidden-services socks-socket-type control-socket?)
socks-socket-type control-socket?) (computed-file
(computed-file "torrc"
"torrc" (with-imported-modules '((guix build utils))
(with-imported-modules '((guix build utils)) #~(begin
#~(begin (use-modules (guix build utils)
(use-modules (guix build utils) (ice-9 match))
(ice-9 match))
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
(display "\ (display "\
### These lines were generated from your system configuration: ### These lines were generated from your system configuration:
DataDirectory /var/lib/tor DataDirectory /var/lib/tor
Log notice syslog\n" port) Log notice syslog\n" port)
(when (eq? 'unix '#$socks-socket-type) (when (eq? 'unix '#$socks-socket-type)
(display "\ (display "\
SocksPort unix:/var/run/tor/socks-sock SocksPort unix:/var/run/tor/socks-sock
UnixSocksGroupWritable 1\n" port)) UnixSocksGroupWritable 1\n" port))
(when #$control-socket? (when #$control-socket?
(display "\ (display "\
ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
ControlSocketsGroupWritable 1\n" ControlSocketsGroupWritable 1\n"
port)) port))
(for-each (match-lambda (for-each (match-lambda
((service (ports hosts) ...) ((service (ports hosts) ...)
(format port "\ (format port "\
HiddenServiceDir /var/lib/tor/hidden-services/~a~%" HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
service) service)
(for-each (lambda (tcp-port host) (for-each (lambda (tcp-port host)
(format port "\ (format port "\
HiddenServicePort ~a ~a~%" HiddenServicePort ~a ~a~%"
tcp-port host)) tcp-port host))
ports hosts))) ports hosts)))
'#$(map (match-lambda '#$(map (match-lambda
(($ <hidden-service> name mapping) (($ <hidden-service> name mapping)
(cons name mapping))) (cons name mapping)))
services)) hidden-services))
(display "\ (display "\
### End of automatically generated lines.\n\n" port) ### End of automatically generated lines.\n\n" port)
;; Append the user's config file. ;; Append the user's config file.
(call-with-input-file #$config-file (call-with-input-file #$config-file
(lambda (input) (lambda (input)
(dump-port input port))) (dump-port input port)))
#t)))))))) #t)))))))
(define (tor-shepherd-service config) (define (tor-shepherd-service config)
"Return a <shepherd-service> running Tor." "Return a <shepherd-service> running Tor."
(match config (let* ((torrc (tor-configuration->torrc config))
(($ <tor-configuration> tor) (tor (least-authority-wrapper
(let* ((torrc (tor-configuration->torrc config)) (file-append (tor-configuration-tor config) "/bin/tor")
(tor (least-authority-wrapper #:name "tor"
(file-append tor "/bin/tor") #:mappings (list (file-system-mapping
#:name "tor" (source "/var/lib/tor")
#:mappings (list (file-system-mapping (target source)
(source "/var/lib/tor") (writable? #t))
(target source) (file-system-mapping
(writable? #t)) (source "/dev/log") ;for syslog
(file-system-mapping (target source))
(source "/dev/log") ;for syslog (file-system-mapping
(target source)) (source "/var/run/tor")
(file-system-mapping (target source)
(source "/var/run/tor") (writable? #t))
(target source) (file-system-mapping
(writable? #t)) (source torrc)
(file-system-mapping (target source)))
(source torrc) #:namespaces (delq 'net %namespaces))))
(target source))) (list (shepherd-service
#:namespaces (delq 'net %namespaces)))) (provision '(tor))
(list (shepherd-service
(provision '(tor))
;; Tor needs at least one network interface to be up, hence the ;; Tor needs at least one network interface to be up, hence the
;; dependency on 'loopback'. ;; dependency on 'loopback'.
(requirement '(user-processes loopback syslogd)) (requirement '(user-processes loopback syslogd))
;; XXX: #:pid-file won't work because the wrapped 'tor' ;; XXX: #:pid-file won't work because the wrapped 'tor'
;; program would print its PID within the user namespace ;; program would print its PID within the user namespace
;; instead of its actual PID outside. There's no inetd or ;; instead of its actual PID outside. There's no inetd or
;; systemd socket activation support either (there's ;; systemd socket activation support either (there's
;; 'sd_notify' though), so we're stuck with that. ;; 'sd_notify' though), so we're stuck with that.
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$tor "-f" #$torrc) (list #$tor "-f" #$torrc)
#:user "tor" #:group "tor")) #:user "tor" #:group "tor"))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action torrc))) (actions (list (shepherd-configuration-action torrc)))
(documentation "Run the Tor anonymous network overlay."))))))) (documentation "Run the Tor anonymous network overlay.")))))
(define (tor-activation config) (define (tor-activation config)
"Set up directories for Tor and its hidden services, if any." "Set up directories for Tor and its hidden services, if any."
@ -1143,19 +1142,20 @@ project's documentation} for more information."
(dns network-manager-configuration-dns (dns network-manager-configuration-dns
(default "default")) (default "default"))
(vpn-plugins network-manager-configuration-vpn-plugins ;list of file-like (vpn-plugins network-manager-configuration-vpn-plugins ;list of file-like
(default '()))) (default '()))
(iwd? network-manager-configuration-iwd? (default #f)))
(define network-manager-activation (define (network-manager-activation config)
;; Activation gexp for NetworkManager ;; Activation gexp for NetworkManager
(match-lambda (match-record config <network-manager-configuration>
(($ <network-manager-configuration> network-manager dns vpn-plugins) (network-manager dns vpn-plugins)
#~(begin #~(begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(mkdir-p "/etc/NetworkManager/system-connections") (mkdir-p "/etc/NetworkManager/system-connections")
#$@(if (equal? dns "dnsmasq") #$@(if (equal? dns "dnsmasq")
;; create directory to store dnsmasq lease file ;; create directory to store dnsmasq lease file
'((mkdir-p "/var/lib/misc")) '((mkdir-p "/var/lib/misc"))
'()))))) '()))))
(define (vpn-plugin-directory plugins) (define (vpn-plugin-directory plugins)
"Return a directory containing PLUGINS, the NM VPN plugins." "Return a directory containing PLUGINS, the NM VPN plugins."
@ -1188,44 +1188,47 @@ project's documentation} for more information."
(cons (user-group (name "network-manager") (system? #t)) (cons (user-group (name "network-manager") (system? #t))
accounts)))) accounts))))
(define network-manager-environment (define (network-manager-environment config)
(match-lambda (match-record config <network-manager-configuration>
(($ <network-manager-configuration> network-manager dns vpn-plugins) (network-manager dns vpn-plugins)
;; Define this variable in the global environment such that ;; Define this variable in the global environment such that
;; "nmcli connection import type openvpn file foo.ovpn" works. ;; "nmcli connection import type openvpn file foo.ovpn" works.
`(("NM_VPN_PLUGIN_DIR" `(("NM_VPN_PLUGIN_DIR"
. ,(file-append (vpn-plugin-directory vpn-plugins) . ,(file-append (vpn-plugin-directory vpn-plugins)
"/lib/NetworkManager/VPN")))))) "/lib/NetworkManager/VPN")))))
(define network-manager-shepherd-service (define (network-manager-shepherd-service config)
(match-lambda (match-record config <network-manager-configuration>
(($ <network-manager-configuration> network-manager dns vpn-plugins) (network-manager dns vpn-plugins iwd?)
(let ((conf (plain-file "NetworkManager.conf" (let ((conf (plain-file "NetworkManager.conf"
(string-append "[main]\ndns=" dns "\n"))) (string-append
(vpn (vpn-plugin-directory vpn-plugins))) "[main]\ndns=" dns "\n"
(list (shepherd-service (if iwd? "[device]\nwifi.backend=iwd\n" ""))))
(documentation "Run the NetworkManager.") (vpn (vpn-plugin-directory vpn-plugins)))
(provision '(networking)) (list (shepherd-service
(requirement '(user-processes dbus-system wpa-supplicant loopback)) (documentation "Run the NetworkManager.")
(start #~(make-forkexec-constructor (provision '(networking))
(list (string-append #$network-manager (requirement (append '(user-processes dbus-system loopback)
"/sbin/NetworkManager") (if iwd? '(iwd) '(wpa-supplicant))))
(string-append "--config=" #$conf) (start #~(make-forkexec-constructor
"--no-daemon") (list (string-append #$network-manager
#:environment-variables "/sbin/NetworkManager")
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn (string-append "--config=" #$conf)
"/lib/NetworkManager/VPN") "--no-daemon")
;; Override non-existent default users #:environment-variables
"NM_OPENVPN_USER=" (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"NM_OPENVPN_GROUP="))) "/lib/NetworkManager/VPN")
(stop #~(make-kill-destructor)))))))) ;; Override non-existent default users
"NM_OPENVPN_USER="
"NM_OPENVPN_GROUP=")))
(stop #~(make-kill-destructor)))))))
(define network-manager-service-type (define network-manager-service-type
(let (let ((config->packages
((config->packages (lambda (config)
(match-lambda (match-record config <network-manager-configuration>
(($ <network-manager-configuration> network-manager _ vpn-plugins) (network-manager vpn-plugins)
`(,network-manager ,@vpn-plugins))))) `(,network-manager ,@vpn-plugins)))))
(service-type (service-type
(name 'network-manager) (name 'network-manager)
@ -1332,9 +1335,8 @@ a network connection manager."))))
(define modem-manager-service-type (define modem-manager-service-type
(let ((config->package (let ((config->package
(match-lambda (lambda (config)
(($ <modem-manager-configuration> modem-manager) (list (modem-manager-configuration-modem-manager config)))))
(list modem-manager)))))
(service-type (name 'modem-manager) (service-type (name 'modem-manager)
(extensions (extensions
(list (service-extension dbus-root-service-type (list (service-extension dbus-root-service-type
@ -1405,24 +1407,25 @@ device is detected."
usb-modeswitch package specified in CONFIG. The rules file will invoke usb-modeswitch package specified in CONFIG. The rules file will invoke
usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
config file." config file."
(match config (match-record config <usb-modeswitch-configuration>
(($ <usb-modeswitch-configuration> usb-modeswitch data config-file) (usb-modeswitch usb-modeswitch-data config-file)
(computed-file (computed-file
"usb_modeswitch.rules" "usb_modeswitch.rules"
(with-imported-modules '((guix build utils)) (with-imported-modules '((guix build utils))
#~(begin #~(begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(let ((in (string-append #$data "/udev/40-usb_modeswitch.rules")) (let ((in (string-append #$usb-modeswitch-data
(out (string-append #$output "/lib/udev/rules.d")) "/udev/40-usb_modeswitch.rules"))
(script #$(usb-modeswitch-sh usb-modeswitch config-file))) (out (string-append #$output "/lib/udev/rules.d"))
(mkdir-p out) (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
(chdir out) (mkdir-p out)
(install-file in out) (chdir out)
(substitute* "40-usb_modeswitch.rules" (install-file in out)
(("PROGRAM=\"usb_modeswitch") (substitute* "40-usb_modeswitch.rules"
(string-append "PROGRAM=\"" script "/usb_modeswitch")) (("PROGRAM=\"usb_modeswitch")
(("RUN\\+=\"usb_modeswitch") (string-append "PROGRAM=\"" script "/usb_modeswitch"))
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))) (("RUN\\+=\"usb_modeswitch")
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))
(define usb-modeswitch-service-type (define usb-modeswitch-service-type
(service-type (service-type
@ -1466,40 +1469,39 @@ whatever the thing is supposed to do).")))
(extra-options wpa-supplicant-configuration-extra-options ;list of strings (extra-options wpa-supplicant-configuration-extra-options ;list of strings
(default '()))) (default '())))
(define wpa-supplicant-shepherd-service (define (wpa-supplicant-shepherd-service config)
(match-lambda (match-record config <wpa-supplicant-configuration>
(($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus? (wpa-supplicant requirement pid-file dbus?
interface config-file extra-options) interface config-file extra-options)
(list (shepherd-service (list (shepherd-service
(documentation "Run the WPA supplicant daemon") (documentation "Run the WPA supplicant daemon")
(provision '(wpa-supplicant)) (provision '(wpa-supplicant))
(requirement (if dbus? (requirement (if dbus?
(cons 'dbus-system requirement) (cons 'dbus-system requirement)
requirement)) requirement))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant (list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant") "/sbin/wpa_supplicant")
(string-append "-P" #$pid-file) (string-append "-P" #$pid-file)
"-B" ;run in background "-B" ;run in background
"-s" ;log to syslogd "-s" ;log to syslogd
#$@(if dbus? #$@(if dbus?
#~("-u") #~("-u")
#~()) #~())
#$@(if interface #$@(if interface
#~((string-append "-i" #$interface)) #~((string-append "-i" #$interface))
#~()) #~())
#$@(if config-file #$@(if config-file
#~((string-append "-c" #$config-file)) #~((string-append "-c" #$config-file))
#~()) #~())
#$@extra-options) #$@extra-options)
#:pid-file #$pid-file)) #:pid-file #$pid-file))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define wpa-supplicant-service-type (define wpa-supplicant-service-type
(let ((config->package (let ((config->package
(match-lambda (lambda (config)
(($ <wpa-supplicant-configuration> wpa-supplicant) (list (wpa-supplicant-configuration-wpa-supplicant config)))))
(list wpa-supplicant)))))
(service-type (name 'wpa-supplicant) (service-type (name 'wpa-supplicant)
(extensions (extensions
(list (service-extension shepherd-root-service-type (list (service-extension shepherd-root-service-type
@ -1621,41 +1623,38 @@ simulation."
(package openvswitch-configuration-package (package openvswitch-configuration-package
(default openvswitch))) (default openvswitch)))
(define openvswitch-activation (define (openvswitch-activation config)
(match-lambda (let ((ovsdb-tool (file-append (openvswitch-configuration-package config)
(($ <openvswitch-configuration> package) "/bin/ovsdb-tool")))
(let ((ovsdb-tool (file-append package "/bin/ovsdb-tool"))) (with-imported-modules '((guix build utils))
(with-imported-modules '((guix build utils)) #~(begin
#~(begin (use-modules (guix build utils))
(use-modules (guix build utils)) (mkdir-p "/var/run/openvswitch")
(mkdir-p "/var/run/openvswitch") (mkdir-p "/var/lib/openvswitch")
(mkdir-p "/var/lib/openvswitch") (let ((conf.db "/var/lib/openvswitch/conf.db"))
(let ((conf.db "/var/lib/openvswitch/conf.db")) (unless (file-exists? conf.db)
(unless (file-exists? conf.db) (system* #$ovsdb-tool "create" conf.db)))))))
(system* #$ovsdb-tool "create" conf.db)))))))))
(define openvswitch-shepherd-service (define (openvswitch-shepherd-service config)
(match-lambda (let* ((package (openvswitch-configuration-package config))
(($ <openvswitch-configuration> package) (ovsdb-server (file-append package "/sbin/ovsdb-server"))
(let ((ovsdb-server (file-append package "/sbin/ovsdb-server")) (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd"))) (list (shepherd-service
(list (provision '(ovsdb))
(shepherd-service (documentation "Run the Open vSwitch database server.")
(provision '(ovsdb)) (start #~(make-forkexec-constructor
(documentation "Run the Open vSwitch database server.") (list #$ovsdb-server "--pidfile"
(start #~(make-forkexec-constructor "--remote=punix:/var/run/openvswitch/db.sock")
(list #$ovsdb-server "--pidfile" #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
"--remote=punix:/var/run/openvswitch/db.sock") (stop #~(make-kill-destructor)))
#:pid-file "/var/run/openvswitch/ovsdb-server.pid")) (shepherd-service
(stop #~(make-kill-destructor))) (provision '(vswitchd))
(shepherd-service (requirement '(ovsdb))
(provision '(vswitchd)) (documentation "Run the Open vSwitch daemon.")
(requirement '(ovsdb)) (start #~(make-forkexec-constructor
(documentation "Run the Open vSwitch daemon.") (list #$ovs-vswitchd "--pidfile")
(start #~(make-forkexec-constructor #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(list #$ovs-vswitchd "--pidfile") (stop #~(make-kill-destructor))))))
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(stop #~(make-kill-destructor))))))))
(define openvswitch-service-type (define openvswitch-service-type
(service-type (service-type
@ -1695,20 +1694,20 @@ COMMIT
(ipv6-rules iptables-configuration-ipv6-rules (ipv6-rules iptables-configuration-ipv6-rules
(default %iptables-accept-all-rules))) (default %iptables-accept-all-rules)))
(define iptables-shepherd-service (define (iptables-shepherd-service config)
(match-lambda (match-record config <iptables-configuration>
(($ <iptables-configuration> iptables ipv4-rules ipv6-rules) (iptables ipv4-rules ipv6-rules)
(let ((iptables-restore (file-append iptables "/sbin/iptables-restore")) (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
(ip6tables-restore (file-append iptables "/sbin/ip6tables-restore"))) (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
(shepherd-service (shepherd-service
(documentation "Packet filtering framework") (documentation "Packet filtering framework")
(provision '(iptables)) (provision '(iptables))
(start #~(lambda _ (start #~(lambda _
(invoke #$iptables-restore #$ipv4-rules) (invoke #$iptables-restore #$ipv4-rules)
(invoke #$ip6tables-restore #$ipv6-rules))) (invoke #$ip6tables-restore #$ipv6-rules)))
(stop #~(lambda _ (stop #~(lambda _
(invoke #$iptables-restore #$%iptables-accept-all-rules) (invoke #$iptables-restore #$%iptables-accept-all-rules)
(invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))) (invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))
(define iptables-service-type (define iptables-service-type
(service-type (service-type
@ -1767,17 +1766,17 @@ table inet filter {
(ruleset nftables-configuration-ruleset ; file-like object (ruleset nftables-configuration-ruleset ; file-like object
(default %default-nftables-ruleset))) (default %default-nftables-ruleset)))
(define nftables-shepherd-service (define (nftables-shepherd-service config)
(match-lambda (match-record config <nftables-configuration>
(($ <nftables-configuration> package ruleset) (package ruleset)
(let ((nft (file-append package "/sbin/nft"))) (let ((nft (file-append package "/sbin/nft")))
(shepherd-service (shepherd-service
(documentation "Packet filtering and classification") (documentation "Packet filtering and classification")
(provision '(nftables)) (provision '(nftables))
(start #~(lambda _ (start #~(lambda _
(invoke #$nft "--file" #$ruleset))) (invoke #$nft "--file" #$ruleset)))
(stop #~(lambda _ (stop #~(lambda _
(invoke #$nft "flush" "ruleset")))))))) (invoke #$nft "flush" "ruleset")))))))
(define nftables-service-type (define nftables-service-type
(service-type (service-type
@ -2150,23 +2149,22 @@ of the IPFS peer-to-peer storage network.")))
(config-file keepalived-configuration-config-file ;file-like (config-file keepalived-configuration-config-file ;file-like
(default #f))) (default #f)))
(define keepalived-shepherd-service (define (keepalived-shepherd-service config)
(match-lambda (match-record config <keepalived-configuration>
(($ <keepalived-configuration> keepalived config-file) (keepalived config-file)
(list (list (shepherd-service
(shepherd-service (provision '(keepalived))
(provision '(keepalived)) (documentation "Run keepalived.")
(documentation "Run keepalived.") (requirement '(loopback))
(requirement '(loopback)) (start #~(make-forkexec-constructor
(start #~(make-forkexec-constructor (list (string-append #$keepalived "/sbin/keepalived")
(list (string-append #$keepalived "/sbin/keepalived") "--dont-fork" "--log-console" "--log-detail"
"--dont-fork" "--log-console" "--log-detail" "--pid=/var/run/keepalived.pid"
"--pid=/var/run/keepalived.pid" (string-append "--use-file=" #$config-file))
(string-append "--use-file=" #$config-file)) #:pid-file "/var/run/keepalived.pid"
#:pid-file "/var/run/keepalived.pid" #:log-file "/var/log/keepalived.log"))
#:log-file "/var/log/keepalived.log")) (respawn? #f)
(respawn? #f) (stop #~(make-kill-destructor))))))
(stop #~(make-kill-destructor)))))))
(define %keepalived-log-rotation (define %keepalived-log-rotation
(list (log-rotation (list (log-rotation

75
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl Normal file
View file

@ -0,0 +1,75 @@
;; This is an operating-system configuration template of a
;; 64-bit minimal system for a Raspberry Pi with an NFS root file-system.
;; It neither installs firmware nor device-tree files for the Raspberry Pi.
;; It just assumes them to be existing in boot/efi in the same way that some
;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
;; It expects the boot/efi directory to be served via TFTP and the root
;; file-system to be served via NFS. See the grub-efi-netboot-bootloader
;; description in the manual for more details.
(use-modules (gnu)
(gnu artwork)
(gnu system nss))
(use-service-modules admin
avahi
networking
ssh)
(use-package-modules certs
linux
raspberry-pi
ssh)
(define %my-public-key
(local-file (string-append (getenv "HOME") "/.ssh/id_ecdsa.pub")))
(define-public raspberry-pi-64-nfs-root
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader-chain-raspi-64)
(targets (list "/boot/efi"))
(theme (grub-theme
(resolution '(1920 . 1080))
(image (file-append
%artwork-repository
"/grub/GuixSD-fully-black-16-9.svg"))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
#:configs '("CONFIG_NFS_SWAP=y"
"CONFIG_USB_USBNET=y"
"CONFIG_USB_LAN78XX=y"
"CONFIG_USB_NET_SMSC95XX=y")))
(initrd-modules '())
(file-systems (cons* (file-system
(mount-point "/")
(type "nfs")
(device ":/export/raspberrypi/guix")
(options "addr=10.20.30.40,vers=4.1"))
%base-file-systems))
(swap-devices (list (swap-space
(target "/run/swapfile"))))
(users (cons* (user-account
(name "pi")
(group "users")
(supplementary-groups '("wheel" "netdev" "audio" "video"))
(home-directory "/home/pi"))
%base-user-accounts))
(packages (cons* nss-certs
openssh
%base-packages))
(services (cons* (service avahi-service-type)
(service dhcp-client-service-type)
(service ntp-service-type)
(service openssh-service-type
(openssh-configuration
(x11-forwarding? #t)
(authorized-keys
`(("pi" ,%my-public-key)))))
%base-services))
(name-service-switch %mdns-host-lookup-nss)))
raspberry-pi-64-nfs-root

79
gnu/system/examples/raspberry-pi-64.tmpl Normal file
View file

@ -0,0 +1,79 @@
;; This is an operating-system configuration template of a
;; 64-bit minimal system for a Raspberry Pi with local storage.
;; It neither installs firmware nor device-tree files for the Raspberry Pi.
;; It just assumes them to be existing in boot/efi in the same way that some
;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
;; It expects the boot-partition to be mounted as boot/efi in the same way
;; as it is usually expeted on PCs with UEFI firmware.
(use-modules (gnu)
(gnu artwork)
(gnu system nss))
(use-service-modules admin
avahi
networking
ssh)
(use-package-modules certs
linux
raspberry-pi
ssh)
(define %my-public-key
(local-file (string-append (getenv "HOME") "/.ssh/id_ecdsa.pub")))
(define-public raspberry-pi-64
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader-chain-raspi-64)
(targets (list "/boot/efi"))
(theme (grub-theme
(resolution '(1920 . 1080))
(image (file-append
%artwork-repository
"/grub/GuixSD-fully-black-16-9.svg"))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
;; the variable shown below. Unfortunately the
;; kernel built from the linux-libre sources with
;; this defconfig file does not boot.
;;#:extra-version "gnu-bcmrpi3"
;;#:defconfig %bcmrpi3-defconfig
))
(initrd-modules '())
(file-systems (cons* (file-system
(mount-point "/")
(type "ext4")
(device (file-system-label "Guix")))
(file-system
(mount-point "/boot/efi")
(type "vfat")
(device (file-system-label "EFI")))
%base-file-systems))
(swap-devices (list (swap-space
(target "/run/swapfile"))))
(users (cons* (user-account
(name "pi")
(group "users")
(supplementary-groups '("wheel" "netdev" "audio" "video"))
(home-directory "/home/pi"))
%base-user-accounts))
(packages (cons* nss-certs
openssh
%base-packages))
(services (cons* (service avahi-service-type)
(service dhcp-client-service-type)
(service ntp-service-type)
(service openssh-service-type
(openssh-configuration
(x11-forwarding? #t)
(authorized-keys
`(("pi" ,%my-public-key)))))
%base-services))
(name-service-switch %mdns-host-lookup-nss)))
raspberry-pi-64

44
gnu/system/hurd.scm
View file

@ -75,28 +75,30 @@
info-reader)) info-reader))
(define %base-services/hurd (define %base-services/hurd
(list (service hurd-console-service-type (append (list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd))) (hurd-console-configuration (hurd hurd)))
(service hurd-getty-service-type (hurd-getty-configuration (service static-networking-service-type
(tty "tty1"))) (list %loopback-static-networking
(service hurd-getty-service-type (hurd-getty-configuration
(tty "tty2")))
(service static-networking-service-type
(list %loopback-static-networking
;; QEMU user-mode networking. To get "eth0", you need ;; QEMU user-mode networking. To get "eth0", you need
;; QEMU to emulate a device for which Mach has an ;; QEMU to emulate a device for which Mach has an
;; in-kernel driver, for instance with: ;; in-kernel driver, for instance with:
;; --device rtl8139,netdev=net0 --netdev user,id=net0 ;; --device rtl8139,netdev=net0 --netdev user,id=net0
%qemu-static-networking)) %qemu-static-networking))
(syslog-service) (service guix-service-type
(service guix-service-type (guix-configuration
(guix-configuration (extra-options '("--disable-chroot"
(extra-options '("--disable-chroot" "--disable-deduplication"))))
"--disable-deduplication")))) (service special-files-service-type
(service special-files-service-type `(("/bin/sh" ,(file-append bash "/bin/sh"))
`(("/bin/sh" ,(file-append bash "/bin/sh")) ("/usr/bin/env" ,(file-append coreutils
("/usr/bin/env" ,(file-append coreutils "/bin/env")))))) "/bin/env"))))
(syslog-service))
(map (lambda (n)
(service hurd-getty-service-type
(hurd-getty-configuration
(tty (string-append "tty" (number->string n))))))
(iota 6 1))))
(define %setuid-programs/hurd (define %setuid-programs/hurd
;; Default set of setuid-root programs. ;; Default set of setuid-root programs.

28
gnu/system/linux-container.scm
View file

@ -121,9 +121,7 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
;; different configs that are better suited to containers. ;; different configs that are better suited to containers.
(append (list console-font-service-type (append (list console-font-service-type
mingetty-service-type mingetty-service-type
agetty-service-type agetty-service-type)
;; Reinstantiated below with smaller caches.
nscd-service-type)
(if shared-network? (if shared-network?
;; Replace these with dummy-networking-service-type below. ;; Replace these with dummy-networking-service-type below.
(list (list
@ -134,17 +132,13 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(list)))) (list))))
(define services-to-add (define services-to-add
(append ;; Many Guix services depend on a 'networking' shepherd
;; Many Guix services depend on a 'networking' shepherd ;; service, so make sure to provide a dummy 'networking'
;; service, so make sure to provide a dummy 'networking' ;; service when we are sure that networking is already set up
;; service when we are sure that networking is already set up ;; in the host and can be used. That prevents double setup.
;; in the host and can be used. That prevents double setup. (if shared-network?
(if shared-network? (list (service dummy-networking-service-type))
(list (service dummy-networking-service-type)) '()))
'())
(list
(nscd-service (nscd-configuration
(caches %nscd-container-caches))))))
(operating-system (operating-system
(inherit os) (inherit os)
@ -155,7 +149,11 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(services (append (remove (lambda (service) (services (append (remove (lambda (service)
(memq (service-kind service) (memq (service-kind service)
services-to-drop)) services-to-drop))
(operating-system-user-services os)) (modify-services (operating-system-user-services os)
(nscd-service-type
config => (nscd-configuration
(inherit config)
(caches %nscd-container-caches)))))
services-to-add)) services-to-add))
(file-systems (append (map mapping->fs (file-systems (append (map mapping->fs
(if shared-network? (if shared-network?

4
guix/build-system/linux-module.scm
View file

@ -66,7 +66,9 @@
(replace 'build (replace 'build
(lambda _ (lambda _
(invoke "make" "modules_prepare"))) (invoke "make" "modules_prepare")))
(delete 'strip) ; faster (delete 'strip) ;faster
(delete 'build-doc) ;costly and not useful here
(delete 'install-doc)
(replace 'install (replace 'install
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(let ((out-lib-build (string-append #$output "/lib/modules/build"))) (let ((out-lib-build (string-append #$output "/lib/modules/build")))

183
guix/build/kconfig.scm Normal file
View file

@ -0,0 +1,183 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; 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 (guix build kconfig)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (modify-defconfig
verify-config))
;; Commentary:
;;
;; Builder-side code to modify configurations for the Kconfig build system as
;; used by Linux and U-Boot.
;;
;; Code:
(define (config-string->pair config-string)
"Parse a configuration string like \"CONFIG_EXAMPLE=m\" into a key-value pair.
An error is thrown for invalid configurations.
\"CONFIG_A=y\" -> '(\"CONFIG_A\" . \"y\")
\"CONFIG_B=\\\"\\\"\" -> '(\"CONFIG_B\" . \"\\\"\\\"\")
\"CONFIG_C=\" -> '(\"CONFIG_C\" . \"\")
\"# CONFIG_E is not set\" -> '(\"CONFIG_E\" . #f)
\"CONFIG_D\" -> '(\"CONFIG_D\" . #f)
\"# Any comment\" -> '(#f . \"# Any comment\")
\"\" -> '(#f . \"\")
\"# CONFIG_E=y\" -> (error \"Invalid configuration\")
\"CONFIG_E is not set\" -> (error \"Invalid configuration\")
\"Anything else\" -> (error \"Invalid configuration\")"
(define config-regexp
(make-regexp
;; (match:substring (string-match "=(.*)" "=") 1) returns "", but the
;; pattern "=(.+)?" makes it return #f instead. From a "CONFIG_A=" we like
;; to get "", which later emits "CONFIG_A=" again.
(string-append "^ *(#[\\t ]*)?(CONFIG_[a-zA-Z0-9_]+)([\\t ]*="
"[\\t ]*(.*)|([\\t ]+is[\\t ]+not[\\t ]+set))?$")))
(define config-comment-regexp
(make-regexp "^([\\t ]*(#.*)?)$"))
(let ((match (regexp-exec config-regexp (string-trim-right config-string))))
(if match
(let* ((comment (match:substring match 1))
(key (match:substring match 2))
(unset (match:substring match 5))
(value (and (not comment)
(not unset)
(match:substring match 4))))
(if (eq? (not comment) (not unset))
;; The key is uncommented and set or commented and unset.
(cons key value)
;; The key is set or unset ambigiously.
(error (format #f "invalid configuration, did you mean \"~a\"?"
(pair->config-string (cons key #f)))
config-string)))
;; This is not a valid or ambigious config-string, but maybe a
;; comment.
(if (regexp-exec config-comment-regexp config-string)
(cons #f config-string) ;keep valid comments
(error "Invalid configuration" config-string)))))
(define (pair->config-string pair)
"Convert a PAIR back to a config-string."
(let* ((key (first pair))
(value (cdr pair)))
(if (string? key)
(if (string? value)
(string-append key "=" value)
(string-append "# " key " is not set"))
value)))
(define (defconfig->alist defconfig)
"Convert the content of a DEFCONFIG (or .config) file into an alist."
(with-input-from-file defconfig
(lambda ()
(let loop ((alist '())
(line (read-line)))
(if (eof-object? line)
;; Building the alist is done, now check for duplicates.
;; Note: the filter invocation is used to remove comments.
(let loop ((keys (map first (filter first alist)))
(duplicates '()))
(if (null? keys)
;; The search for duplicates is done.
;; Return the alist or throw an error on duplicates.
(if (null? duplicates)
alist
(error
(format #f "duplicate configurations in ~a" defconfig)
duplicates))
;; Continue the search for duplicates.
(loop (cdr keys)
(if (member (first keys) (cdr keys))
(cons (first keys) duplicates)
duplicates))))
;; Build the alist.
(loop (cons (config-string->pair line) alist)
(read-line)))))))
(define (modify-defconfig defconfig configs)
"This function can modify a given DEFCONFIG (or .config) file by adding,
changing or removing the list of strings in CONFIGS. This allows customization
of Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'.
These are examples for CONFIGS to add, change or remove configurations to/from
DEFCONFIG:
'(\"CONFIG_A=\\\"a\\\"\"
\"CONFIG_B=0\"
\"CONFIG_C=y\"
\"CONFIG_D=m\"
\"CONFIG_E=\"
\"# CONFIG_G is not set\"
;; For convenience this abbrevation can be used for not set configurations.
\"CONFIG_F\")
Instead of a list, CONFIGS can be a string with one configuration per line."
(let* (;; Split the configs into a list of single configurations. Both a
;; string and or a list of strings is supported, each with newlines
;; to separate configurations.
(config-pairs (map config-string->pair
(append-map (cut string-split <> #\newline)
(if (string? configs)
(list configs)
configs))))
;; Generate a blocklist from all valid keys in config-pairs.
(blocklist (delete #f (map first config-pairs)))
;; Generate an alist from the defconfig without the keys in blocklist.
(filtered-defconfig-pairs (remove (lambda (pair)
(member (first pair) blocklist))
(defconfig->alist defconfig))))
(with-output-to-file defconfig
(lambda ()
(for-each (lambda (pair)
(display (pair->config-string pair))
(newline))
(append filtered-defconfig-pairs config-pairs))))))
(define (verify-config config defconfig)
"Verify that the CONFIG file contains all configurations from the DEFCONFIG
file. When the verification fails, raise an error with the mismatching keys
and their values."
(let* ((config-pairs (defconfig->alist config))
(defconfig-pairs (defconfig->alist defconfig))
(mismatching-pairs
(remove (lambda (pair)
;; Remove all configurations, whose values are #f and
;; whose keys are not in config-pairs, as not in
;; config-pairs means unset, ...
(and (not (cdr pair))
(not (assoc-ref config-pairs (first pair)))))
;; ... from the defconfig-pairs different to config-pairs.
(lset-difference equal?
;; Remove comments by filtering with first.
(filter first defconfig-pairs)
config-pairs))))
(unless (null? mismatching-pairs)
(error (format #f "Mismatching configurations in ~a and ~a"
config defconfig)
(map (lambda (mismatching-pair)
(let* ((key (first mismatching-pair))
(defconfig-value (cdr mismatching-pair))
(config-value (assoc-ref config-pairs key)))
(cons key (list (list config-value defconfig-value)))))
mismatching-pairs)))))

1
guix/import/cran.scm
View file

@ -410,6 +410,7 @@ empty list when the FIELD cannot be found."
("tcl/tk" "tcl") ("tcl/tk" "tcl")
("booktabs" "texlive-booktabs") ("booktabs" "texlive-booktabs")
("freetype2" "freetype") ("freetype2" "freetype")
("sqlite3" "sqlite")
(_ sysname))) (_ sysname)))
(define cran-guix-name (cut guix-name "r-" <>)) (define cran-guix-name (cut guix-name "r-" <>))

87
guix/records.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -104,6 +104,10 @@ error-reporting purposes."
(() (()
#t))))))) #t)))))))
(define-syntax map-fields
(lambda (x)
(syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
(define-syntax-parameter this-record (define-syntax-parameter this-record
(lambda (s) (lambda (s)
"Return the record being defined. This macro may only be used in the "Return the record being defined. This macro may only be used in the
@ -325,6 +329,15 @@ This expression returns a new object equal to 'x' except for its 'name'
field and its 'loc' field---the latter is marked as \"innate\", so it is not field and its 'loc' field---the latter is marked as \"innate\", so it is not
inherited." inherited."
(define (rtd-identifier type)
;; Return an identifier derived from TYPE to name its record type
;; descriptor (RTD).
(let ((type-name (syntax->datum type)))
(datum->syntax
type
(string->symbol
(string-append "% " (symbol->string type-name) " rtd")))))
(define (field-default-value s) (define (field-default-value s)
(syntax-case s (default) (syntax-case s (default)
((field (default val) _ ...) ((field (default val) _ ...)
@ -428,10 +441,31 @@ inherited."
field))) field)))
field-spec))) field-spec)))
#`(begin #`(begin
(define-record-type type (define-record-type #,(rtd-identifier #'type)
(ctor field ...) (ctor field ...)
pred pred
field-spec* ...) field-spec* ...)
;; Rectify the vtable type name...
(set-struct-vtable-name! #,(rtd-identifier #'type) 'type)
(cond-expand
(guile-3
;; ... and the record type name.
(struct-set! #,(rtd-identifier #'type) vtable-offset-user
'type))
(else #f))
(define-syntax type
(lambda (s)
"This macro lets us query record type info at
macro-expansion time."
(syntax-case s (map-fields)
((_ map-fields macro)
#'(macro (field ...)))
(id
(identifier? #'id)
#'#,(rtd-identifier #'type)))))
(define #,(current-abi-identifier #'type) (define #,(current-abi-identifier #'type)
#,cookie) #,cookie)
@ -535,19 +569,50 @@ pairs. Stop upon an empty line (after consuming it) or EOF."
(else (else
(error "unmatched line" line)))))))) (error "unmatched line" line))))))))
;;;
;;; Pattern matching.
;;;
(define-syntax lookup-field
(lambda (s)
"Look up FIELD in the given list and return an expression that represents
its offset in the record. Raise a syntax violation when the field is not
found."
(syntax-case s ()
((_ field offset ())
(syntax-violation 'lookup-field "unknown record type field"
s #'field))
((_ field offset (head tail ...))
(free-identifier=? #'field #'head)
#'offset)
((_ field offset (_ tail ...))
#'(lookup-field field (+ 1 offset) (tail ...))))))
(define-syntax match-record-inner
(lambda (s)
(syntax-case s ()
((_ record type (field rest ...) body ...)
#`(let-syntax ((field-offset (syntax-rules ()
((_ f)
(lookup-field field 0 f)))))
(let* ((offset (type map-fields field-offset))
(field (struct-ref record offset)))
(match-record-inner record type (rest ...) body ...))))
((_ record type () body ...)
#'(begin body ...)))))
(define-syntax match-record (define-syntax match-record
(syntax-rules () (syntax-rules ()
"Bind each FIELD of a RECORD of the given TYPE to it's FIELD name. "Bind each FIELD of a RECORD of the given TYPE to it's FIELD name.
The order in which fields appear does not matter. A syntax error is raised if
an unknown field is queried.
The current implementation does not support thunked and delayed fields." The current implementation does not support thunked and delayed fields."
((_ record type (field fields ...) body ...) ;; TODO support thunked and delayed fields
((_ record type (fields ...) body ...)
(if (eq? (struct-vtable record) type) (if (eq? (struct-vtable record) type)
;; TODO compute indices and report wrong-field-name errors at (match-record-inner record type (fields ...) body ...)
;; expansion time (throw 'wrong-type-arg record)))))
;; TODO support thunked and delayed fields
(let ((field ((record-accessor type 'field) record)))
(match-record record type (fields ...) body ...))
(throw 'wrong-type-arg record)))
((_ record type () body ...)
(begin body ...))))
;;; records.scm ends here ;;; records.scm ends here

33
tests/records.scm
View file

@ -528,4 +528,37 @@ Description: 1st line,
'("a" "b" "c") '("a" "b" "c")
'("a"))) '("a")))
(test-equal "match-record, simple"
'((1 2) (a b))
(let ()
(define-record-type* <foo> foo make-foo
foo?
(first foo-first (default 1))
(second foo-second))
(list (match-record (foo (second 2)) <foo>
(first second)
(list first second))
(match-record (foo (first 'a) (second 'b)) <foo>
(second first)
(list first second)))))
(test-equal "match-record, unknown field"
'syntax-error
(catch 'syntax-error
(lambda ()
(eval '(begin
(use-modules (guix records))
(define-record-type* <foo> foo make-foo
foo?
(first foo-first (default 1))
(second foo-second))
(match-record (foo (second 2)) <foo>
(one two)
#f))
(make-fresh-user-module)))
(lambda (key . args) key)))
(test-end) (test-end)