futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki 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/haskell-build-system.scm \
guix/build/julia-build-system.scm \
guix/build/kconfig.scm \
guix/build/linux-module-build-system.scm \
guix/build/store-copy.scm \
guix/build/json.scm \
@ -439,6 +440,8 @@ EXAMPLES = \
gnu/system/examples/desktop.tmpl \
gnu/system/examples/lightweight-desktop.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
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
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
@code{define-record-type*}) rather than abuse lists. In addition, it
should use pattern matching, via Guile’s @code{(ice-9 match)} module,
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
@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}
and @code{file->udev-rule} from @code{(gnu services base)} simplify the
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
@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 '(next-hour '(3))
(lambda ()
(execl (string-append #$findutils "/bin/updatedb")
"updatedb"
"--prunepaths=/tmp /var/tmp /gnu/store"))
(system* (string-append #$findutils "/bin/updatedb")
"--prunepaths=/tmp /var/tmp /gnu/store"))
"updatedb"))
(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!
@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
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
@ -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}
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 deftp
@ -37991,8 +37997,9 @@ The type of a bootloader configuration declaration.
@cindex BIOS, bootloader
The bootloader to use, as a @code{bootloader} object. For now
@code{grub-bootloader}, @code{grub-efi-bootloader},
@code{grub-efi-netboot-bootloader}, @code{grub-efi-removable-bootloader},
@code{extlinux-bootloader} and @code{u-boot-bootloader} are supported.
@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
and @code{u-boot-bootloader} are supported.
@cindex ARM, 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
@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
@code{grub-efi-bootloader} allows to boot on modern systems using the
@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
use if the installation image contains a @file{/sys/firmware/efi} directory
when you boot it on your system.
@vindex grub-bootloader
@code{grub-bootloader} allows you to boot in particular Intel-based machines
in ``legacy'' BIOS mode.
@vindex grub-efi-removable-bootloader
@code{grub-efi-removable-bootloader} allows you to boot your system from
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
@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
content of the TFTP root directory at @code{targets} (@pxref{Bootloader
Configuration, @code{targets}}), to be served by a TFTP server. You may
want to mount your TFTP server directories onto the @code{targets} to
move the required files to the TFTP server automatically.
Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
served by a TFTP server. You may want to mount your TFTP server directories
onto the @code{targets} to move the required files to the TFTP server
automatically during installation.
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
@ -38049,25 +38071,34 @@ this constellation the symlinks will work.
For other constellations you will have to program your own bootloader
installer, which then takes care to make necessary files from the store
accessible through TFTP, for example by copying them into the TFTP root
directory to your @code{targets}.
directory for your @code{targets}.
It is important to note that symlinks pointing outside the TFTP root directory
may need to be allowed in the configuration of your TFTP server. Further the
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
NFS servers, you also need a properly configured DHCP server to make the booting
over netboot possible. For all this we can currently only recommend you to look
for instructions about @acronym{PXE, Preboot eXecution Environment}.
@vindex grub-efi-removable-bootloader
@code{grub-efi-removable-bootloader} allows you to boot your system from
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.
If a local EFI System Partition (ESP) or a similar partition with a FAT
file system is mounted in @code{targets}, then symlinks cannot be
created. In this case everything will be prepared for booting from
local storage, matching the behavior of @code{grub-efi-bootloader}, with
the difference that all GRUB binaries are copied to @code{targets},
necessary for booting over the network.
@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
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,
Racket's variant of Chez Scheme, and development of a Racket build system and
importer."
#:scope (list "gnu/packages/racket.scm")))
#:scope (list "gnu/packages/chez.scm"
"gnu/packages/racket.scm")))
(define-member (person "Thiago Jung Bauermann"

105
gnu/bootloader.scm
View File

@ -322,26 +322,22 @@ instead~%")))
(force %bootloaders))
(leave (G_ "~a: no such bootloader~%") name)))
(define (efi-bootloader-profile files bootloader-package hooks)
"Creates a profile with BOOTLOADER-PACKAGE and a directory collection/ with
links to additional FILES from the store. This collection is meant to be used
by the bootloader installer.
(define (efi-bootloader-profile packages files hooks)
"Creates a profile from the lists of PACKAGES and FILES from the store.
This profile is meant to be used by the bootloader-installer.
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 '/',
then the directory content instead of the directory itself will be symlinked
into the collection/ directory.
symlinked into the profile. If a directory name ends with '/', then the
directory content instead of the directory itself will be symlinked into the
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.
HOOKS lists additional hook functions to modify the profile."
(define (bootloader-collection manifest)
(define (efi-bootloader-profile-hook manifest)
(define build
(with-imported-modules '((guix build utils)
(ice-9 ftw)
(srfi srfi-1)
(srfi srfi-26))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules ((guix build utils)
#: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)
"Return #t if NAME is a direct store entry and nothing inside."
(not (string-index (strip-store-file-name name) #\/)))
(let* ((collection (string-append #$output "/collection"))
(files '#$files)
(let* ((files '#$files)
(directories (filter name-ends-with-/? files))
(names-from-directories
(append-map (lambda (directory)
@ -374,11 +369,11 @@ HOOKS lists additional hook functions to modify the profile."
directories))
(names (append names-from-directories
(remove name-ends-with-/? files))))
(mkdir-p collection)
(mkdir-p #$output)
(if (every file-exists? names)
(begin
(for-each (lambda (name)
(symlink-to name collection
(symlink-to name #$output
(if (name-is-store-entry? name)
strip-store-file-name
basename)))
@ -386,57 +381,63 @@ HOOKS lists additional hook functions to modify the profile."
#t)
#f)))))
(gexp->derivation "bootloader-collection"
(gexp->derivation "efi-bootloader-profile"
build
#:local-build? #t
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . bootloader-collection))))
(hook . efi-bootloader-profile-hook))))
(profile (content (packages->manifest (list bootloader-package)))
(name "bootloader-profile")
(hooks (append (list bootloader-collection) hooks))
(profile (content (packages->manifest packages))
(name "efi-bootloader-profile")
(hooks (cons efi-bootloader-profile-hook hooks))
(locales? #f)
(allow-collisions? #f)
(relative-symlinks? #f)))
(define* (efi-bootloader-chain files
final-bootloader
(define* (efi-bootloader-chain final-bootloader
#:key
(packages '())
(files '())
(hooks '())
installer)
"Define a bootloader chain with FINAL-BOOTLOADER as the final bootloader and
certain directories and files from the store given in the list of FILES.
installer
disk-image-installer)
"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,
local-file, etc., or package contents produced with file-append. They will be
collected inside a directory collection/ inside a generated bootloader profile,
which will be passed to the INSTALLER.
The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
in an efi-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
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
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
the bootloader. Otherwise the installer of the FINAL-BOOTLOADER will be called."
(let* ((final-installer (or installer
(bootloader-installer final-bootloader)))
(profile (efi-bootloader-profile files
(bootloader-package final-bootloader)
(if (list? hooks)
hooks
(list hooks)))))
(bootloader
(inherit final-bootloader)
(package profile)
(installer
#~(lambda (bootloader target mount-point)
(#$final-installer bootloader target mount-point)
(copy-recursively
(string-append bootloader "/collection")
(string-append mount-point target)
#:follow-symlinks? #t
#:log (%make-void-port "w")))))))
If the INSTALLER argument is used, then this gexp procedure will be called to
install the efi-bootloader-profile. Otherwise the installer of the
FINAL-BOOTLOADER will be called.
If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
to install the efi-bootloader-profile into a disk image. Otherwise the
disk-image-installer of the FINAL-BOOTLOADER will be called."
(bootloader
(inherit final-bootloader)
(name "efi-bootloader-chain")
(package
(efi-bootloader-profile (cons (bootloader-package final-bootloader)
packages)
files
(if (list? hooks)
hooks
(list hooks))))
(installer
(or installer
(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
install-grub-efi-removable
install-grub-efi-netboot
make-grub-efi-netboot-installer
grub-bootloader
grub-efi-bootloader
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
grub-efi-netboot-removable-bootloader
grub-mkrescue-bootloader
grub-minimal-bootloader
@ -353,7 +354,7 @@ code."
((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
(define* (grub-configuration-file config entries
(define* (make-grub-configuration grub config entries
#:key
(locale #f)
(system (%current-system))
@ -453,9 +454,7 @@ menuentry ~s {
(define locale-config
(let* ((entry (first all-entries))
(device (menu-entry-device entry))
(mount-point (menu-entry-device-mount-point entry))
(bootloader (bootloader-configuration-bootloader config))
(grub (bootloader-package bootloader)))
(mount-point (menu-entry-device-mount-point entry)))
#~(let ((locale #$(and locale
(locale-definition-source
(locale-name->definition locale))))
@ -481,8 +480,6 @@ set lang=~a~%"
(define keyboard-layout-config
(let* ((layout (bootloader-configuration-keyboard-layout config))
(grub (bootloader-package
(bootloader-configuration-bootloader config)))
(keymap* (and layout
(keyboard-layout-file layout #:grub grub)))
(entry (first all-entries))
@ -533,6 +530,16 @@ fi~%"))))
#:options '(#:local-build? #t
#: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"))
"--efi-directory" target-esp)))))
(define (install-grub-efi-netboot subdir)
"Define a grub-efi-netboot bootloader installer for installation in SUBDIR,
which is usually efi/Guix or efi/boot."
(let* ((system (string-split (nix-system->gnu-triplet
(or (%current-target-system)
(%current-system)))
#\-))
(arch (first system))
(boot-efi-link (match system
;; These are the supportend systems and the names
;; defined by the UEFI standard for removable media.
(("i686" _ ...) "/bootia32.efi")
(("x86_64" _ ...) "/bootx64.efi")
(("arm" _ ...) "/bootarm.efi")
(("aarch64" _ ...) "/bootaa64.efi")
(("riscv" _ ...) "/bootriscv32.efi")
(("riscv64" _ ...) "/bootriscv64.efi")
;; Other systems are not supported, although defined.
;; (("riscv128" _ ...) "/bootriscv128.efi")
;; (("ia64" _ ...) "/bootia64.efi")
((_ ...) #f)))
(core-efi (string-append
;; This is the arch dependent file name of GRUB, e.g.
;; i368-efi/core.efi or arm64-efi/core.efi.
(match arch
("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.
(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
"Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
its files in SUBDIR and its configuration file in GRUB-CFG.
As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
installer basically copies all files from the bootloader-package (or profile)
into the bootloader-target directory.
Additionally for network booting over TFTP, two relative symlinks to the store
and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
not be located on a FAT file-system.
If the bootloader-target does not support symlinks, then it is assumed to be a
kind of EFI System Partition (ESP). In this case an intermediate configuration
file is created with the help of GRUB-EFI to load the GRUB-CFG.
The installer is usable for any efi-bootloader-chain, which prepares the
bootloader-profile in a way ready for copying.
The installer does not manipulate the system's 'UEFI Boot Manager'.
The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
directory TARGET for the system whose root is mounted at MOUNT-POINT.
MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
or '/' for other 'guix system' commands.
@ -719,17 +715,19 @@ bootloader-configuration in:
(operating-system
(bootloader (bootloader-configuration
(targets '(\"/boot\"))
(targets '(\"/boot/efi\"))
…))
…)
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
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
MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
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
directory and that the TARGET/%store-prefix symlink makes the whole store
accessible via TFTP. Possibly the TFTP server must be configured
to allow accesses outside its TFTP root directory. This may need to be
considered for security aspects."
(use-modules ((guix build union) #:select (symlink-relative)))
(let* ((net-dir (string-append mount-point target "/"))
(sub-dir (string-append net-dir #$subdir "/"))
(store (string-append mount-point (%store-prefix)))
(store-link (string-append net-dir (%store-prefix)))
(grub-cfg (string-append mount-point "/boot/grub/grub.cfg"))
(grub-cfg-link (string-append sub-dir (basename grub-cfg)))
(boot-efi-link (string-append sub-dir #$boot-efi-link)))
;; Prepare the symlink to the store.
(mkdir-p (dirname store-link))
(false-if-exception (delete-file store-link))
(symlink-relative store store-link)
;; Prepare the symlink to the grub.cfg, which points into the store.
(mkdir-p (dirname grub-cfg-link))
(false-if-exception (delete-file grub-cfg-link))
(symlink-relative grub-cfg grub-cfg-link)
;; Install GRUB, which refers to the grub.cfg, with support for
;; encrypted partitions,
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
(string-append "--net-directory=" net-dir)
(string-append "--subdir=" #$subdir))
;; Prepare the bootloader symlink, which points to core.efi of GRUB.
(false-if-exception (delete-file boot-efi-link))
(symlink #$core-efi boot-efi-link))))))
accessible via TFTP. Possibly the TFTP server must be configured to allow
accesses outside its TFTP root directory. This all may need to be considered
for security aspects. It is advised to disable any TFTP write access!
The installer can also be used to prepare booting from local storage, if the
underlying file-system, like FAT on an EFI System Partition (ESP), does not
support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
symlink to the store is not needed in this case."
(with-imported-modules '((guix build union))
#~(lambda (bootloader target mount-point)
;; In context of a disk image creation TARGET will be #f and an
;; installer is expected to do necessary installations on MOUNT-POINT,
;; which will become the root file system. If TARGET is #f, this
;; installer has nothing to do, as it only cares about the EFI System
;; Partition (ESP).
(when target
(use-modules ((guix build union) #:select (symlink-relative))
(ice-9 popen)
(ice-9 rdelim))
(let* ((mount-point/target (string-append mount-point target "/"))
;; When installing Guix, it is common to mount TARGET below
;; MOUNT-POINT rather than the root directory.
(bootloader-target (if (file-exists? mount-point/target)
mount-point/target
target))
(store (string-append mount-point (%store-prefix)))
(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)
(installer install-grub)
(disk-image-installer install-grub-disk-image)
(configuration-file "/boot/grub/grub.cfg")
(configuration-file grub-cfg)
(configuration-file-generator grub-configuration-file)))
(define grub-minimal-bootloader
@ -794,11 +838,12 @@ considered for security aspects."
(define grub-efi-bootloader
(bootloader
(inherit grub-bootloader)
(name 'grub-efi)
(package grub-efi)
(installer install-grub-efi)
(disk-image-installer #f)
(name 'grub-efi)
(package grub-efi)))
(configuration-file grub-cfg)
(configuration-file-generator grub-configuration-file)))
(define grub-efi-removable-bootloader
(bootloader
@ -813,11 +858,22 @@ considered for security aspects."
(name 'grub-efi32)
(package grub-efi32)))
(define grub-efi-netboot-bootloader
(define (make-grub-efi-netboot-bootloader name subdir)
(bootloader
(inherit grub-efi-bootloader)
(name 'grub-efi-netboot-bootloader)
(installer (install-grub-efi-netboot "efi/Guix"))))
(name name)
(package (make-grub-efi-netboot (symbol->string name) subdir))
(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
(bootloader

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

@ -1,5 +1,5 @@
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -127,6 +127,9 @@ set."
(define (translated? 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")
(passive-translator-xattr? file-name)
(passive-translator-installed? file-name)))
@ -210,31 +213,34 @@ set."
;; 'fd_to_filename' in libc expects it.
("dev/fd" ("/hurd/magic" "--directory" "fd") #o555)
("dev/tty1" ("/hurd/term" "/dev/tty1" "hurdio" "/dev/vcs/1/console")
#o666)
("dev/tty2" ("/hurd/term" "/dev/tty2" "hurdio" "/dev/vcs/2/console")
#o666)
("dev/tty3" ("/hurd/term" "/dev/tty3" "hurdio" "/dev/vcs/3/console")
#o666)
;; Create a number of ttys; syslogd writes to tty12 by default.
;; FIXME: Creating /dev/tty12 leads the console client to switch to
;; tty12 when syslogd starts, which is confusing for users. Thus, do
;; not create tty12.
,@(map (lambda (n)
(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")
#o666)
("dev/ptyp1" ("/hurd/term" "/dev/ptyp1" "pty-master" "/dev/ttyp1")
#o666)
("dev/ptyp2" ("/hurd/term" "/dev/ptyp2" "pty-master" "/dev/ttyp2")
#o666)
,@(append-map (lambda (n)
(let ((n (number->string n)))
`((,(string-append "dev/ptyp" n)
("/hurd/term" ,(string-append "/dev/ptyp" n)
"pty-master" ,(string-append "/dev/ttyp" n))
#o666)
("dev/ttyp0" ("/hurd/term" "/dev/ttyp0" "pty-slave" "/dev/ptyp0")
#o666)
("dev/ttyp1" ("/hurd/term" "/dev/ttyp1" "pty-slave" "/dev/ptyp1")
#o666)
("dev/ttyp2" ("/hurd/term" "/dev/ttyp2" "pty-slave" "/dev/ptyp2")
#o666)))
(,(string-append "dev/ttyp" n)
("/hurd/term" ,(string-append "/dev/ttyp" n)
"pty-slave" ,(string-append "/dev/ptyp" n))
#o666))))
(iota 10 0))))
(for-each scope-set-translator servers)
(mkdir* "dev/vcs/1")
(mkdir* "dev/vcs/2")
(mkdir* "dev/vcs/2")
(rename-file (scope "dev/console") (scope "dev/console-"))
(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
(@@ (gnu services mcron) shepherd-schedule-action))
(define home-mcron-shepherd-services
(match-lambda
(($ <home-mcron-configuration> mcron '()) ; no jobs to run
'())
(($ <home-mcron-configuration> mcron jobs log? log-format)
(let ((files (job-files mcron jobs)))
(list (shepherd-service
(documentation "User cron jobs.")
(provision '(mcron))
(modules `((srfi srfi-1)
(srfi srfi-26)
(ice-9 popen) ; for the 'schedule' action
(ice-9 rdelim)
(ice-9 match)
,@%default-modules))
(start #~(make-forkexec-constructor
(list (string-append #$mcron "/bin/mcron")
#$@(if log?
#~("--log" "--log-format" #$log-format)
#~())
#$@files)
#:log-file (string-append
(or (getenv "XDG_LOG_HOME")
(format #f "~a/.local/var/log"
(getenv "HOME")))
"/mcron.log")))
(stop #~(make-kill-destructor))
(actions
(list (shepherd-schedule-action mcron files)))))))))
(define (home-mcron-shepherd-services config)
(match-record config <home-mcron-configuration>
(mcron jobs log? log-format)
(if (null? jobs)
'() ;no jobs to run
(let ((files (job-files mcron jobs)))
(list (shepherd-service
(documentation "User cron jobs.")
(provision '(mcron))
(modules `((srfi srfi-1)
(srfi srfi-26)
(ice-9 popen) ;for the 'schedule' action
(ice-9 rdelim)
(ice-9 match)
,@%default-modules))
(start #~(make-forkexec-constructor
(list (string-append #$mcron "/bin/mcron")
#$@(if log?
#~("--log" "--log-format" #$log-format)
#~())
#$@files)
#:log-file (string-append
(or (getenv "XDG_LOG_HOME")
(format #f "~a/.local/var/log"
(getenv "HOME")))
"/mcron.log")))
(stop #~(make-kill-destructor))
(actions
(list (shepherd-schedule-action mcron files)))))))))
(define home-mcron-profile (compose list home-mcron-configuration-mcron))

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

@ -25,6 +25,7 @@
#:use-module (gnu packages bash)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#: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."))
(define (home-bash-extensions original-config extension-configs)
(match original-config
(($ <home-bash-configuration> _ _ environment-variables aliases
bash-profile bashrc bash-logout)
(home-bash-configuration
(inherit original-config)
(environment-variables
(append environment-variables
(append-map
home-bash-extension-environment-variables extension-configs)))
(aliases
(append aliases
(append-map
home-bash-extension-aliases extension-configs)))
(bash-profile
(append bash-profile
(append-map
home-bash-extension-bash-profile extension-configs)))
(bashrc
(append bashrc
(append-map
home-bash-extension-bashrc extension-configs)))
(bash-logout
(append bash-logout
(append-map
home-bash-extension-bash-logout extension-configs)))))))
(match-record original-config <home-bash-configuration>
(environment-variables aliases bash-profile bashrc bash-logout)
(home-bash-configuration
(inherit original-config)
(environment-variables
(append environment-variables
(append-map
home-bash-extension-environment-variables extension-configs)))
(aliases
(append aliases
(append-map
home-bash-extension-aliases extension-configs)))
(bash-profile
(append bash-profile
(append-map
home-bash-extension-bash-profile extension-configs)))
(bashrc
(append bashrc
(append-map
home-bash-extension-bashrc extension-configs)))
(bash-logout
(append bash-logout
(append-map
home-bash-extension-bash-logout extension-configs))))))
(define home-bash-service-type
(service-type (name 'home-bash)

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

@ -1,5 +1,5 @@
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -35,10 +35,24 @@
#:export (home-xdg-base-directories-service-type
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-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-entry
@ -383,25 +397,25 @@ configuration."
(define (serialize-alist config)
(generic-serialize-alist append format-config config))
(define (serialize-xdg-desktop-action action)
(match action
(($ <xdg-desktop-action> action name config)
`(,(format #f "[Desktop Action ~a]\n"
(string-capitalize (maybe-object->string action)))
,(format #f "Name=~a\n" name)
,@(serialize-alist config)))))
(define (serialize-xdg-desktop-action desktop-action)
(match-record desktop-action <xdg-desktop-action>
(action name config)
`(,(format #f "[Desktop Action ~a]\n"
(string-capitalize (maybe-object->string action)))
,(format #f "Name=~a\n" name)
,@(serialize-alist config))))
(match entry
(($ <xdg-desktop-entry> file name type config actions)
(list (if (string-suffix? file ".desktop")
file
(string-append file ".desktop"))
`("[Desktop Entry]\n"
,(format #f "Name=~a\n" name)
,(format #f "Type=~a\n"
(string-capitalize (symbol->string type)))
,@(serialize-alist config)
,@(append-map serialize-xdg-desktop-action actions))))))
(match-record entry <xdg-desktop-entry>
(file name type config actions)
(list (if (string-suffix? file ".desktop")
file
(string-append file ".desktop"))
`("[Desktop Entry]\n"
,(format #f "Name=~a\n" name)
,(format #f "Type=~a\n"
(string-capitalize (symbol->string type)))
,@(serialize-alist config)
,@(append-map serialize-xdg-desktop-action actions)))))
(define-configuration home-xdg-mime-applications-configuration
(added

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-libjami-headers-search.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-xcb-link.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-sanitize-system-libxml.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/i3status-rust-enable-unstable-features.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-burgled-batteries3-fix-signals.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/scalapack-gcc-10-compilation.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/sphinxbase-fix-doxygen.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/steghide-fixes.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
(package
(name "netcat-openbsd")
(version "1.218-5")
(version "1.219-1")
(source (origin
(method git-fetch)
(uri (git-reference
@ -1184,7 +1184,7 @@ would need and has several interesting built-in capabilities.")
(file-name (git-file-name name version))
(sha256
(base32
"0hpbmz9m2q22a6qgbn9590z2x96xgffim8g0m1v47mariz3pqhlc"))))
"1fhrmnbdl6bgsjk02vi78zy9i486mmniymbbbhdkzl8zfjbjkpxc"))))
(build-system gnu-build-system)
(arguments
`(#: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)
(native-inputs (list zlib))
(arguments
;; Some tests fail when run in parallel.
`(#:parallel-tests? #f))
`(#:configure-flags
(list "--disable-static")
;; Some tests fail when run in parallel.
#:parallel-tests? #f))
(synopsis "Library for generating assembly code at runtime")
(description
"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 (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
(let ((commit "7329a075271edab8f6264db649e81e62b2b6ae5e")
(revision "1"))
@ -1873,7 +1925,7 @@ It can be used to calculate the trajectory of satellites.")
(native-inputs
(list boost pkg-config))
(inputs
(list cfitsio freeimage glew wxwidgets))
(list cfitsio freeimage glew wxwidgets-3.0))
(home-page "https://github.com/GreatAttractor/imppg")
(synopsis "Astronomical Image Post-Proccessor (ImPPG)")
(description

2
gnu/packages/audio.scm
View File

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

4
gnu/packages/backup.scm
View File

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

89
gnu/packages/bioconductor.scm
View File

@ -2454,13 +2454,13 @@ plants. The method has been specifically designed to:
(define-public r-alpine
(package
(name "r-alpine")
(version "1.22.0")
(version "1.24.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "alpine" version))
(sha256
(base32
"1nl1hxwakh5m9rqm3ksn2jzknsj9xnwl51bmc30knknm4q35wdv9"))))
"0rjnwljh4c2f7ml0m14pllns4pvyjwwf23qsn6zjygm5x04bapf0"))))
(properties `((upstream-name . "alpine")))
(build-system r-build-system)
(propagated-inputs
@ -4216,18 +4216,19 @@ mapping.")
(define-public r-nmf
(package
(name "r-nmf")
(version "0.24.0")
(version "0.25")
(source
(origin
(method url-fetch)
(uri (cran-uri "NMF" version))
(sha256
(base32
"14yxra6in5c1md5nr75y8cdmh9pg0lxqabqflvlhgg1vbg9i2628"))))
"0kdl7yz4v7pms6y2lff4x5w7pwkx54488qx0v539qmvcbxv1if98"))))
(properties `((upstream-name . "NMF")))
(build-system r-build-system)
(propagated-inputs
(list r-cluster
r-codetools
r-biobase
r-biocmanager
r-bigmemory ; suggested
@ -4238,7 +4239,6 @@ mapping.")
r-foreach
r-ggplot2
r-gridbase
r-pkgmaker
r-rcolorbrewer
r-registry
r-reshape2
@ -4787,13 +4787,13 @@ only one command.")
(define-public r-biocparallel
(package
(name "r-biocparallel")
(version "1.32.1")
(version "1.32.3")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "BiocParallel" version))
(sha256
(base32
"1fkfbs0n0sdssli7ibrswkfag080kgv8n1zf6ssxx729g1fz3m3h"))))
"0z2g3p6ip4g865na9bmqaa7w2s52769pmjr3hpiv6x8bhifh3nm5"))))
(properties
`((upstream-name . "BiocParallel")))
(build-system r-build-system)
@ -6010,6 +6010,42 @@ reduction (between group analysis) and joint dimension reduction of two
datasets (coinertia analysis).")
(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
(package
(name "r-methylkit")
@ -8765,6 +8801,41 @@ representations of analysis results in order to provide additional
information.")
(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
(package
(name "r-rots")
@ -17820,14 +17891,14 @@ the Bioconductor project.")
(define-public r-biodb
(package
(name "r-biodb")
(version "1.6.0")
(version "1.6.1")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "biodb" version))
(sha256
(base32
"08ahz3v2xbhwfh89dbnhhcdm0x5qv4hibi8wknlqf5x8gqm5j5w6"))))
"0mbqsias2ajw29d1wgl10y2cjqv3slrsgifccz0kh9l5r6bk28vz"))))
(properties `((upstream-name . "biodb")))
(build-system r-build-system)
(propagated-inputs

97
gnu/packages/bioinformatics.scm
View File

@ -57,6 +57,7 @@
#:use-module (guix build-system meson)
#:use-module (guix build-system ocaml)
#:use-module (guix build-system perl)
#:use-module (guix build-system pyproject)
#:use-module (guix build-system python)
#:use-module (guix build-system qt)
#:use-module (guix build-system r)
@ -10601,6 +10602,102 @@ traditional read alignments) and massively-parallel stochastic collapsed
variational inference.")
(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
(package
(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)))
(define-public gn
(let ((commit "e327ffdc503815916db2543ec000226a8df45163")
(revision "1819")) ;as returned by `git describe`, used below
(let ((commit "1c4151ff5c1d6fbf7fa800b8d4bb34d3abc03a41")
(revision "2072")) ;as returned by `git describe`, used below
(package
(name "gn")
(version (git-version "0.0" revision commit))
@ -215,49 +215,56 @@ programs and other files depend.")
(uri (git-reference (url home-page) (commit commit)))
(sha256
(base32
"0kvlfj3www84zp1vmxh76x8fdjm9hyk8lkh2vdsidafpmm75fphr"))
"02621c9nqpr4pwcapy31x36l5kbyd0vdgd0wdaxj5p8hrxk67d6b"))
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(add-before 'configure 'set-build-environment
(lambda _
(setenv "CC" "gcc") (setenv "CXX" "g++")
(setenv "AR" "ar")))
(replace 'configure
(lambda _
(invoke "python" "build/gen.py"
"--no-last-commit-position")))
(add-after 'configure 'create-last-commit-position
(lambda _
;; Create "last_commit_position.h" to avoid a dependency
;; on 'git' (and the checkout..).
(call-with-output-file "out/last_commit_position.h"
(lambda (port)
(format port
(string-append
"#define LAST_COMMIT_POSITION_NUM ~a\n"
"#define LAST_COMMIT_POSITION \"~a (~a)\"\n")
,revision ,revision ,(string-take commit 8))))))
(replace 'build
(lambda _
(invoke "ninja" "-C" "out" "gn"
"-j" (number->string (parallel-job-count)))))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(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* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(install-file "out/gn" (string-append out "/bin"))))))))
(list #:phases
#~(modify-phases %standard-phases
(add-before 'configure 'set-build-environment
(lambda _
(setenv "CC" "gcc")
(setenv "CXX" "g++")
(setenv "AR" "ar")))
(replace 'configure
(lambda _
(invoke "python" "build/gen.py"
"--no-last-commit-position")))
(add-after 'configure 'create-last-commit-position
(lambda _
;; Mimic GenerateLastCommitPosition from gen.py.
(call-with-output-file "out/last_commit_position.h"
(lambda (port)
(format port
"// Generated by Guix.
#ifndef OUT_LAST_COMMIT_POSITION_H_
#define OUT_LAST_COMMIT_POSITION_H_
#define LAST_COMMIT_POSITION_NUM ~a
#define LAST_COMMIT_POSITION \"~a (~a)\"
#endif // OUT_LAST_COMMIT_POSITION_H_
"
#$revision #$revision
#$(string-take commit 12))))))
(replace 'build
(lambda _
(invoke "ninja" "-C" "out" "gn"
"-j" (number->string (parallel-job-count)))))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(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
`(("ninja" ,ninja)
("python" ,python-wrapper)))
(list ninja python-wrapper))
(synopsis "Generate Ninja build files")
(description
"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)))
#:tests? #f)) ; No tests.
(inputs ; TODO package bundled wxvillalib
`(("wxwidgets" ,wxwidgets-3.1)
`(("wxwidgets" ,wxwidgets)
("wssvg" ,wxsvg)
("dbus" ,dbus)
("cdrtools" ,cdrtools)

42
gnu/packages/chromium.scm
View File

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

8
gnu/packages/compression.scm
View File

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

4
gnu/packages/cook.scm
View File

@ -24,8 +24,8 @@
#:use-module (guix download)
#:use-module (gnu packages ed)
#:use-module (gnu packages bison)
#:use-module (gnu packages groff)
#:use-module (gnu packages compression)
#:use-module (gnu packages groff)
#:use-module (guix build-system gnu))
(define-public cook
@ -70,7 +70,7 @@
(setenv "SH" (which "sh"))
#t)))))
(native-inputs (list bison
(native-inputs (list bison-3.0
;; For building the documentation:
groff
;; 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
(package
(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
;; version is available since the URLs for older versions are not
;; 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
(origin
(method url-fetch)
(uri (string-append "https://download3.ebz.epson.net/dsc/f/03/00/13/77/"
"93/e85dc2dc266e96fdc242bd95758bd88d1a51963e/"
"epson-inkjet-printer-escpr-1.7.21-1lsb3.2.tar.gz"))
(uri (string-append "https://download3.ebz.epson.net/dsc/f/03/00/13/96/"
"55/c6fced63098ae1ba104f11f572794fd558ffca29/"
"epson-inkjet-printer-escpr-1.7.22-1lsb3.2.tar.gz"))
(sha256
(base32 "0z1x9p58321plf2swfxgl72wn7ls8bfbyjwd9l9c8jxfr1v2skkz"))))
(base32 "0b359krhhjjw5hc4b0gqdqwrm6dzc263mdccfzgnyyq7znkyybqb"))))
(build-system gnu-build-system)
(arguments
(list #:modules

5
gnu/packages/curl.scm
View File

@ -366,7 +366,7 @@ curl to obtain exactly that HTTP request.")
(define-public coeurl
(package
(name "coeurl")
(version "0.2.0")
(version "0.2.1")
(source
(origin
(method git-fetch)
@ -375,8 +375,7 @@ curl to obtain exactly that HTTP request.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0kbazvrb4hzc9jr7yywd36ack1yy7bh8sh1kc4jzv6jfzvxjb0i0"))))
(base32 "0qbbrfs35zl0wl6x6jn4p9ncxgdm70a883cflvikkykx9n5k2lpq"))))
(build-system meson-build-system)
(native-inputs
(list doctest pkg-config))

12
gnu/packages/digest.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; 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.
;;;
@ -25,9 +25,11 @@
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system pyproject)
#:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix utils)
#:use-module (gnu packages python-build)
#:use-module (ice-9 match))
(define-public wyhash
@ -111,15 +113,17 @@ platforms (both big and little endian).")
(define-public python-xxhash
(package
(name "python-xxhash")
(version "2.0.2")
(version "3.1.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "xxhash" version))
(sha256
(base32
"0jbvz19acznq00544gcsjg05fkvrmwbnwdfgrvwss3i1ys6avgmp"))))
(build-system python-build-system)
"1hdxcscry59gh0znlm71ya23mm9rfmvz8lvvlplzxzf63pib28dc"))))
(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")
(synopsis "Python binding for xxHash")
(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
(package
(name "libblockdev")
(version "2.27")
(version "2.28")
(source (origin
(method url-fetch)
(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"))
(sha256
(base32
"05rm9h8v30rahr245jcw6if6b5g16mb5hnz7wl1shzip0wky3k3d"))))
"1x3xbgd2dyjhcqvyalpnrp727xidfxmaxgyyvv5gwx4aw90wijc2"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@ -1142,6 +1142,7 @@ on your file system and offers to remove it. @command{rmlint} can find:
(define-public lf
(package
(name "lf")
;; When updating, remove go-github-com-gdamore-tcell-v2-2.3 from golang.scm.
(version "27")
(source (origin
(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)
(native-inputs
(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
`(#:import-path "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
(package
(name "knot")
(version "3.2.2")
(version "3.2.3")
(source
(origin
(method git-fetch)
@ -880,7 +880,7 @@ Extensions} (DNSSEC).")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1x1waa2cb91zhsqkx4mkiqy00kq1f1pavjfhlz7wknlnll48iayd"))
(base32 "117q8jllaakd6gv0mfkq45sigy5c8j8jbyxiwna3wan0mjx81fhv"))
(modules '((guix build utils)))
(snippet
'(begin

1
gnu/packages/ebook.scm
View File

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

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

@ -258,7 +258,7 @@
(define-public emacs-geiser
(package
(name "emacs-geiser")
(version "0.28")
(version "0.28.1")
(source
(origin
(method git-fetch)
@ -267,7 +267,7 @@
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "0dd20cq3nz4jjysaqx2aiqqaxvkfkbj2x4zm2mz3pd4rmydckj2y"))))
(base32 "111as99278vbv6pwj8rpl308g327f8iznnrz71mngl6d5mr0xpa1"))))
(build-system emacs-build-system)
(arguments
'(#:phases
@ -305,7 +305,7 @@ e.g. emacs-geiser-guile for Guile.")
(define-public emacs-geiser-guile
(package
(name "emacs-geiser-guile")
(version "0.28.0")
(version "0.28.1")
(source
(origin
(method git-fetch)
@ -314,7 +314,7 @@ e.g. emacs-geiser-guile for Guile.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "13qxg1npm0pmnml5q268k5xk1clyqldp8v200ihrqwqlc3ga7f36"))))
(base32 "0gp8xbfm7y2gabjyys8jylfy1pkkglqas32xxrbqxfh1hv0cfh2f"))))
(build-system emacs-build-system)
(arguments
(list
@ -889,6 +889,29 @@ of the segments available in that package using icons from
information in the mode line.")
(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
(package
(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.")
(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
(package
(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
(package
(name "emacs-csharp-mode")
(version "1.1.1")
(version "2.0.0")
(source
(origin
(method git-fetch)
@ -15980,7 +16025,7 @@ similar syntax; currently C++, Objective-C, Java, CORBA's IDL, Pike, and AWK.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "0wfd4jdjsq8qp6pavf25y87dxvlnsqapfi4c4m3xj24baalr2dpq"))))
(base32 "1d0pf236xi4c7fazv67a53yrac24lilnkzp9pb55xm88gig7rfmz"))))
(build-system emacs-build-system)
(home-page "https://github.com/josteink/csharp-mode")
(synopsis "Major mode for C# code")
@ -30358,39 +30403,40 @@ service, and connect it with Emacs via inter-process communication.")
(name "emacs-telega")
(build-system emacs-build-system)
(arguments
`(#:emacs ,(if (target-64bit?)
emacs-minimal
;; Require wide-int support for 32-bit platform.
emacs-wide-int)
#:include (cons "^etc\\/" %default-include)
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-sources
(lambda* (#:key inputs #:allow-other-keys)
;; Hard-code paths to `ffplay` and `ffmpeg`.
(let* ((ffplay-bin (search-input-file inputs "/bin/ffplay"))
(ffmpeg-bin (search-input-file inputs "/bin/ffmpeg")))
(substitute* '("telega-ffplay.el" "telega-vvnote.el")
(("(shell-command-to-string\|concat) \"(ffmpeg\|ffprobe)"
all func cmd)
(string-append func " \""
(search-input-file
inputs (string-append "/bin/" cmd))))
(("\\(executable-find \"ffplay\"\\)")
(string-append "(and (file-executable-p \"" ffplay-bin "\")"
"\"" ffplay-bin "\")"))
(("\\(executable-find \"ffmpeg\"\\)")
(string-append "(and (file-executable-p \"" ffmpeg-bin "\")"
"\"" ffmpeg-bin "\")"))))))
(add-after 'unpack 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "telega-customize.el"
(("@TELEGA_SERVER_BIN@")
(search-input-file inputs "/bin/telega-server")))
(substitute* "telega-util.el"
(("@TELEGA_SHARE@")
(string-append (elpa-directory (assoc-ref outputs "out"))
"/etc"))))))))
(list
#:emacs (if (target-64bit?)
emacs-minimal
;; Require wide-int support for 32-bit platform.
emacs-wide-int)
#:include #~(cons "^etc\\/" %default-include)
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'patch-sources
(lambda* (#:key inputs #:allow-other-keys)
;; Hard-code paths to `ffplay` and `ffmpeg`.
(let* ((ffplay-bin (search-input-file inputs "/bin/ffplay"))
(ffmpeg-bin (search-input-file inputs "/bin/ffmpeg")))
(substitute* '("telega-ffplay.el" "telega-vvnote.el")
(("(shell-command-to-string\|concat) \"(ffmpeg\|ffprobe)"
all func cmd)
(string-append func " \""
(search-input-file
inputs (string-append "/bin/" cmd))))
(("\\(executable-find \"ffplay\"\\)")
(string-append "(and (file-executable-p \"" ffplay-bin "\")"
"\"" ffplay-bin "\")"))
(("\\(executable-find \"ffmpeg\"\\)")
(string-append "(and (file-executable-p \"" ffmpeg-bin "\")"
"\"" ffmpeg-bin "\")"))))))
(add-after 'unpack 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "telega-customize.el"
(("@TELEGA_SERVER_BIN@")
(search-input-file inputs "/bin/telega-server")))
(substitute* "telega-util.el"
(("@TELEGA_SHARE@")
(string-append (elpa-directory (assoc-ref outputs "out"))
"/etc"))))))))
(inputs
(list emacs-telega-server ffmpeg))
(native-inputs '())
@ -30406,13 +30452,14 @@ for the Telegram messaging platform.")))
(inherit emacs-telega)
(name "emacs-telega-contrib")
(arguments
`(#:exclude '("telega-live-location.el")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-subdirectory
(lambda _ (chdir "contrib") #t))
(add-before 'install-license-files 'leave-subdirectory
(lambda _ (chdir "..") #t)))))
(list
#:exclude #~(list "telega-live-location.el")
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'enter-subdirectory
(lambda _ (chdir "contrib")))
(add-before 'install-license-files 'leave-subdirectory
(lambda _ (chdir ".."))))))
(inputs '())
(native-inputs '())
(propagated-inputs

45
gnu/packages/engineering.scm
View File

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

4
gnu/packages/finance.scm
View File

@ -2177,7 +2177,7 @@ mining.")
(define-public p2pool
(package
(name "p2pool")
(version "2.5")
(version "2.6")
(source
(origin
(method git-fetch)
@ -2186,7 +2186,7 @@ mining.")
(commit (string-append "v" version))
(recursive? #t)))
(file-name (git-file-name name version))
(sha256 (base32 "1kdsxh6f24zp7h7bwkrin2mc81ysfny5wprzgy41h2bc6dpq067w"))
(sha256 (base32 "0832mv3f4c61w8s25higjbmmajjkvjdriw1xfygjiw5qxdcs202z"))
(modules '((guix build utils)))
(snippet
#~(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
(package
(name "libfprint")
(version "1.94.4")
(version "1.94.5")
(source
(origin
(method git-fetch)
@ -1891,7 +1891,7 @@ that wish to perform colour calibration.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1wfd2svsq26wizhsaifnr74havswbc1rlfm79b36yrhw9n7c3jqb"))))
(base32 "1l1ak7y2kz0nrdkfj41n7h34dyykgzdg50y752ayk3ginp6szr7r"))))
(build-system meson-build-system)
(arguments
(list #:configure-flags

2
gnu/packages/ftp.scm
View File

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

24
gnu/packages/games.scm
View File

@ -1427,7 +1427,7 @@ real-time combat.")
(define-public golly
(package
(name "golly")
(version "3.3")
(version "4.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/golly/golly/golly-"
@ -1435,7 +1435,7 @@ real-time combat.")
"-src.tar.gz"))
(sha256
(base32
"1j3ksnar4rdam4xiyspgyrs1pifbvxfxkrn65brkwxpx39mpgzc8"))))
"0pg9cp83nxc354lizgza5bqdy7z5wh36863203zw6r6s4flji4an"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags (list "CC=gcc"
@ -1445,17 +1445,7 @@ real-time combat.")
#:tests? #f ; no check target
#:phases
(modify-phases %standard-phases
(replace '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))
(delete 'configure)
(replace 'build
(lambda* (#:key make-flags outputs #:allow-other-keys)
(with-directory-excursion "gui-wx"
@ -1485,11 +1475,7 @@ real-time combat.")
(native-inputs
(list lua))
(inputs
`(("glu" ,glu)
("mesa" ,mesa)
("python" ,python-2)
("wxwidgets" ,wxwidgets-gtk2)
("zlib" ,zlib)))
(list glu mesa python sdl2 wxwidgets zlib))
(home-page "http://golly.sourceforge.net/")
(synopsis "Software for exploring cellular automata")
(description
@ -6151,7 +6137,7 @@ starting a decryption sequence to reveal the original plaintext characters.")
libvorbis
lua
sdl2
wxwidgets))
wxwidgets-3.0))
(native-inputs
(list cppunit pkg-config))
(arguments

2
gnu/packages/geo.scm
View File

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

2
gnu/packages/gnome.scm
View File

@ -7292,7 +7292,7 @@ almost all of them.")
("gtkspell3" ,gtkspell3)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("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")
(synopsis "Web browser for GNOME")
(description

4
gnu/packages/gnupg.scm
View File

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

149
gnu/packages/gnuzilla.scm
View File

@ -19,7 +19,6 @@
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Baptiste Strazzul <bstrazzull@hotmail.fr>
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -85,7 +84,6 @@
#:use-module (gnu packages assembly)
#:use-module (gnu packages rust)
#:use-module (gnu packages rust-apps)
#:use-module (gnu packages crates-io)
#:use-module (gnu packages llvm)
#:use-module (gnu packages nss)
#:use-module (gnu packages icu4c)
@ -350,148 +348,6 @@ in C/C++.")
(inputs
(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
(origin
(method hg-fetch)
@ -865,10 +721,9 @@ in C/C++.")
;; ,(search-patch "icecat-use-system-graphite2+harfbuzz.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 "cargo")
(force rust-cbindgen-0.23-promise)
rust-cbindgen-0.23
llvm
clang
perl
@ -1551,7 +1406,7 @@ ca495991b7852b855"))
pkg-config
python-wrapper
rust
(force rust-cbindgen-0.23-promise)
rust-cbindgen-0.23
which
yasm))
(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)
(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
(package
(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.
;; https://gitlab.freedesktop.org/gstreamer/gstreamer/-/issues/1244
#$@(if (member (%current-system)
'("i686-linux" "aarch64-linux"))
'("i686-linux" "aarch64-linux" "riscv64-linux"))
`((("'elements/camerabin\\.c'\\]\\],")
"'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
"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
(package
(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
(package
(name "openrgb")
(version "0.7")
(version "0.8")
(source
(origin
(method git-fetch)
@ -1007,15 +1007,25 @@ technology, such as head mounted displays with built in head tracking.")
(commit (string-append "release_" version))))
(file-name (git-file-name name version))
(sha256
(base32 "0xhfaz0b74nfnh7il2cz5c0338xlzay00g6hc2h3lsncarj8d5n7"))
(base32 "1yz7sdrjcxajm1zpa5djinmych5dvck0r1fvk0x5qmk87va4p9z3"))
(patches
(search-patches "openrgb-unbundle-hueplusplus.patch"))
(modules '((guix build utils)))
(snippet
'(begin
;; Delete the bundled hueplusplus and json libraries.
(delete-file-recursively "dependencies/hueplusplus-1.0.0")
(delete-file-recursively "dependencies/json")))))
;; Delete many of the bundled libraries.
(for-each delete-file-recursively
(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)
(arguments
(list
@ -1044,7 +1054,8 @@ technology, such as head mounted displays with built in head tracking.")
mbedtls-apache
qtbase-5))
(native-inputs
(list pkg-config))
(list pkg-config
qttools-5))
(synopsis "RGB lighting control")
(description
"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-qml-imports.patch"
"jami-no-webengine.patch"
"jami-sip-contacts.patch"
"jami-sip-unregister.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
(package
(name "liblangtag")
(version "0.6.3")
(version "0.6.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://bitbucket.org/tagoh/liblangtag/downloads/"
"liblangtag-" version ".tar.bz2"))
(sha256
(base32 "1g9kwxx60q0hpwvs66ys1cb9qg54hfvbivadwli8sfpc085a44hz"))))
(base32 "0r55r30ih8dgq1hwbpl834igilj7bpxcnmlrlkd3vryk2wn0c0ap"))))
(build-system gnu-build-system)
(native-inputs
(list libtool pkg-config))
@ -745,14 +745,14 @@ from the old StarOffice (.sdc, .sdw, ...).")
(define-public libwps
(package
(name "libwps")
(version "0.4.12")
(version "0.4.13")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/" name "/" name "/"
name "-" version "/" name "-" version ".tar.xz"))
(sha256 (base32
"1nsfacqp5sfkyayw7q0wp68lidksd1wjdix8qmsbf0vdl19gn6p2"))))
"03y4aslp5lfqc14agn0hgkifwrknh8s4hfjll9wrfs1hq3kaz5ff"))))
(build-system gnu-build-system)
(native-inputs
(list doxygen pkg-config))
@ -992,7 +992,7 @@ spell-checking library.")
(build-system gnu-build-system)
(inputs
(list perl))
(home-page "http://hunspell.sourceforge.net/")
(home-page "https://hunspell.github.io/")
(synopsis "Hyphenation library")
(description "Hyphen is a hyphenation library using TeX hyphenation
patterns, which are pre-processed by a perl script.")
@ -1050,20 +1050,20 @@ spell-checking library.")
(define-public mythes
(package
(name "mythes")
(version "1.2.4")
(version "1.2.5")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/hunspell/MyThes/" version "/"
name "-" version ".tar.gz"))
(sha256 (base32
"0prh19wy1c74kmzkkavm9qslk99gz8h8wmjvwzjc6lf8v2az708y"))))
(uri (string-append "https://github.com/hunspell/mythes/releases/"
"download/v" version "/mythes-" version ".tar.xz"))
(sha256
(base32 "07ajdyyif19k445dqffkm32c1kl8z0cw6bczc7x5zgkvf1q9y9qr"))))
(build-system gnu-build-system)
(native-inputs
(list pkg-config))
(inputs
(list hunspell perl))
(home-page "http://hunspell.sourceforge.net/")
(home-page "https://hunspell.github.io/")
(synopsis "Thesaurus")
(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

171
gnu/packages/linux.scm
View File

@ -67,6 +67,7 @@
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Hunter Jozwiak <hunter.t.joz@gmail.com>
;;; Copyright © 2022 Hilton Chain <hako@ultrarare.space>
;;; Copyright © 2022 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -189,11 +190,31 @@
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#: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)
"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\"."
(cond ((string-prefix? "powerpc-" system) "pmac32_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
"/share/info"))))))
#~())
(replace 'configure
(lambda* (#:key inputs target #:allow-other-keys)
(add-before 'configure 'set-environment
(lambda* (#:key target #:allow-other-keys)
;; Avoid introducing timestamps.
(setenv "KCONFIG_NOTIMESTAMP" "1")
(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))))))
(setenv "ARCH" arch)
(format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
(when target
(setenv "CROSS_COMPILE" (string-append target "-"))
(format #t "`CROSS_COMPILE' set to `~a'~%"
(getenv "CROSS_COMPILE"))))
;; Allow EXTRAVERSION to be set via the environment.
(substitute* "Makefile"
(("^ *EXTRAVERSION[[:blank:]]*=")
"EXTRAVERSION ?="))
(setenv "EXTRAVERSION"
#$(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")))
;; Use a custom kernel configuration file or a default
;; configuration file.
(if config
@ -882,17 +906,15 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(copy-file config ".config")
(chmod ".config" #o666))
(invoke "make" #$defconfig))
;; Appending works even when the option wasn't in the
;; file. The last one prevails if duplicated.
(let ((port (open-file ".config" "a"))
(extra-configuration #$(config->string extra-options)))
(display extra-configuration port)
(close-port port))
(invoke "make" "oldconfig"))))
(replace 'install
(lambda* (#:key inputs native-inputs #:allow-other-keys)
(lambda* (#:key inputs #:allow-other-keys)
(let ((moddir (string-append #$output "/lib/modules"))
(dtbdir (string-append #$output "/lib/dtbs")))
;; 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)
(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
(package
(name "powertop")
(version "2.14")
(version "2.15")
(source
(origin
(method git-fetch)
@ -3160,7 +3286,7 @@ devices. It replaces @code{iwconfig}, which is deprecated.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1zkr2y5nb1nr22nq8a3zli87iyfasfq6489p7h1k428pv8k45w4f"))))
(base32 "10vbk4vplmzp3p1mhwnhj81g6i5xvam9pdvmiy6cmd0xvnmdyy77"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
@ -3179,18 +3305,17 @@ devices. It replaces @code{iwconfig}, which is deprecated.")
;; These programs are only needed to calibrate, so using
;; relative file names avoids adding extra inputs. When they
;; are missing powertop gracefully handles it.
(("/usr/bin/hcitool") "hcitool")
(("/usr/bin/xset") "xset")
(("/usr/sbin/hciconfig") "hciconfig"))
#t))))))
(("/usr/s?bin/(hciconfig|hcitool|xset)" _ command)
command))))))))
(native-inputs
(list autoconf
autoconf-archive
automake
gettext-minimal
libtool
pkg-config))
(inputs
(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/")
(synopsis "Analyze power consumption on Intel-based laptops")
(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
(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
(let ((commit "66f29e01ec28355ebba8292411b4de90eebd76a3")
(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
threading abstractions and utilities left to be filled by complementary
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))))
(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
(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
(let ((commit "96a358ede7cef416d61d2f699e724fe1d9de602c")
(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
(package
(name "sbcl")
(version "2.2.10")
(version "2.2.11")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/sbcl/sbcl/" version "/sbcl-"
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
(base32 "0cq8x4svkawirxq5s5gs4qxkl23m4q5p722a2kpss8qjfslc7hwc"))
(base32 "1pwnhjp0fmkcgq11a6hj36gw8k05qramspgdbj28063k2s0dc1rn"))
(modules '((guix build utils)))
(snippet
'(begin

136
gnu/packages/mail.scm
View File

@ -50,6 +50,7 @@
;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2022 muradm <mail@muradm.net>
;;; Copyright © 2022 jgart <jgart@dismail.de>
;;; Copyright © 2022 ( <paren@disroot.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -151,6 +152,7 @@
#:use-module (gnu packages rdf)
#:use-module (gnu packages readline)
#:use-module (gnu packages ruby)
#:use-module (gnu packages rust-apps)
#:use-module (gnu packages search)
#:use-module (gnu packages serialization)
#:use-module (gnu packages samba)
@ -3811,14 +3813,14 @@ tools and applications:
(define-public balsa
(package
(name "balsa")
(version "2.6.3")
(version "2.6.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://pawsa.fedorapeople.org/balsa/"
"balsa-" version ".tar.xz"))
(sha256
(base32 "1m0x3rk7cp7slr47rmg4y91rbxgs652v706lyxj600m5r5v4bl6l"))))
(base32 "1hcgmjka2x2igdrmvzlfs12mv892kv4vzv5iy90kvcqxa625kymy"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@ -3831,7 +3833,13 @@ tools and applications:
"--with-gpgme"
"--with-sqlite"
"--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
(list cyrus-sasl
enchant
@ -3840,7 +3848,7 @@ tools and applications:
gnutls
gpgme
gtk+
gtksourceview
gtksourceview-4
gtkspell3
libassuan ; in gpgme.pc Requires
libcanberra
@ -3860,6 +3868,9 @@ tools and applications:
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
the use of a local MTA such as Sendmail.")
(properties
'((release-monitoring-url
. "https://pawsa.fedorapeople.org/balsa/download.html")))
(license license:gpl3+)))
(define-public afew
@ -4754,3 +4765,120 @@ addresses.")
mailserver on their machine. It enables these users to send their mail over a
remote SMTP server.")
(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
(package
(name "mympd")
(version "10.1.2")
(version "10.1.3")
(source (origin
(method git-fetch)
(uri (git-reference
@ -590,7 +590,7 @@ mpdevil loads all tags and covers on demand.")
(file-name (git-file-name name version))
(sha256
(base32
"1cqq09j7mi7dz5y6l7i0sa6vi2n5zrndnrxnqsi4vcg99fc2vwv8"))))
"16cvjwbyb1m88kmgylp95p82a4xdjikmrw9arl6kvmgcbyw317yp"))))
(build-system cmake-build-system)
(arguments
(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.")
(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
(package
(name "setbfree")
@ -3980,7 +4040,7 @@ with a number of bugfixes and changes to improve IT playback.")
(inputs
(list jack-1
alsa-lib
wxwidgets-gtk2
wxwidgets-gtk2-3.0
libsndfile
libsamplerate
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 Felix Gruber <felgru@posteo.net>
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
;;; Copyright © 2022 jgart <jgart@dismail.de>
;;;
;;; 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.")
(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
(package
(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
(package
(name "python-msgpack-numpy")
(version "0.4.6.post0")
(version "0.4.8")
(source
(origin
(method url-fetch)
(uri (pypi-uri "msgpack-numpy" version))
(sha256
(base32
"0syzy645mwcy7lfjwz6pc8f9p2vv1qk4limc8iina3l5nnf0rjyz"))))
"0sbfanbkfs6c77np4vz0ayrwnv99bpn5xgj5fnf2yhhk0lcd6ry6"))))
(build-system python-build-system)
(propagated-inputs
(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 Garek Dyszel <garekdyszel@disroot.org>
;;; Copyright © 2022 Baptiste Strazzulla <bstrazzull@hotmail.fr>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -159,9 +160,11 @@
#:use-module (gnu packages check)
#:use-module (gnu packages cmake)
#:use-module (gnu packages compression)
#:use-module (gnu packages cpp)
#:use-module (gnu packages crypto)
#:use-module (gnu packages databases)
#:use-module (gnu packages dbm)
#:use-module (gnu packages digest)
#:use-module (gnu packages django)
#:use-module (gnu packages djvu)
#: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.")
(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
(package
(name "python-docutils")
@ -22364,6 +22434,25 @@ working with iterables.")
(description "Lexer and codec to work with LaTeX code in Python.")
(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
(package
(name "python-pybtex")
@ -23082,6 +23171,32 @@ environments.")
"PyNamecheap is a Namecheap API client in Python.")
(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
(package
(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 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; 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 © 2020 Mike Rosset <mike.rosset@gmail.com>
;;; 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+.
(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
(package
(inherit qtsvg-5)
@ -2298,7 +2353,7 @@ using the Enchant spell-checking library.")
(srfi srfi-26)
(guix build utils)))
(snippet
'(begin
#~(begin
(let ((preserved-third-party-files
'("base/third_party/double_conversion"
"base/third_party/cityhash"
@ -2434,54 +2489,7 @@ using the Enchant spell-checking library.")
"v8/src/third_party/valgrind"
"v8/src/third_party/siphash"
"v8/third_party/v8/builtins"
"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)))
"v8/third_party/inspector_protocol")))
(with-directory-excursion "src/3rdparty"
;; 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"
;; Delete bundled software and binaries that were not explicitly
;; preserved above.
(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)
#$remove-third-party-files
;; Use relative header locations instead of hard coded ones.
(substitute*
@ -2676,7 +2678,7 @@ and binaries removed, and adds modular support for using system libraries.")
(srfi srfi-26)
(guix build utils)))
(snippet
'(begin
#~(begin
(let ((preserved-third-party-files
'("base/third_party/double_conversion"
"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/smhasher"
"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/blink"
"third_party/boringssl"
"third_party/boringssl/src/third_party/fiat"
"third_party/breakpad"
"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/cld_3"
"third_party/closure_compiler"
@ -2713,13 +2728,28 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/crc32c"
"third_party/dav1d"
"third_party/dawn"
"third_party/dawn/third_party/tint"
"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/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/third_party/typescript"
"third_party/emoji-segmenter"
"third_party/fdlibm"
"third_party/ffmpeg"
"third_party/freetype"
"third_party/googletest"
"third_party/harfbuzz-ng/utils"
"third_party/harfbuzz-ng"
"third_party/highway"
"third_party/hunspell"
"third_party/iccjpeg"
"third_party/icu"
@ -2730,19 +2760,30 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/khronos"
"third_party/leveldatabase"
"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/libjingle_xmpp"
"third_party/libjpeg_turbo"
"third_party/libjxl"
"third_party/libpng"
"third_party/libsrtp"
"third_party/libsync"
"third_party/libudev"
"third_party/liburlpattern"
"third_party/libvpx"
"third_party/libwebm"
"third_party/libwebp"
"third_party/libx11"
"third_party/libxcb-keysyms"
"third_party/libxml"
"third_party/libxslt"
"third_party/libyuv"
"third_party/lottie"
"third_party/lss"
"third_party/mako"
"third_party/markupsafe"
@ -2750,18 +2791,23 @@ and binaries removed, and adds modular support for using system libraries.")
"third_party/metrics_proto"
"third_party/modp_b64"
"third_party/nasm"
"third_party/node"
"third_party/one_euro_filter"
"third_party/openh264/src/codec/api/svc"
"third_party/openh264"
"third_party/opus"
"third_party/ots"
"third_party/pdfium"
"third_party/pdfium/third_party/agg23"
"third_party/pdfium/third_party/base"
"third_party/pdfium/third_party/bigint"
"third_party/pdfium/third_party/freetype"
"third_party/pdfium/third_party/lcms"
"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/perfetto"
"third_party/perfetto/protos/third_party/chromium"
"third_party/pffft"
"third_party/ply"
"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/smhasher"
"third_party/snappy"
"third_party/speech-dispatcher"
"third_party/sqlite"
"third_party/usb_ids"
"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/webrtc"
"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_version.h"
"third_party/woff2"
"third_party/wuffs"
"third_party/x11proto"
"third_party/zlib"
"url/third_party/mozilla"
"v8/src/third_party/utf8-decoder"
"v8/src/third_party/valgrind"
"v8/src/third_party/siphash"
"v8/third_party/v8/builtins"
"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)))
"v8/third_party/inspector_protocol")))
(with-directory-excursion "src/3rdparty"
(delete-file-recursively "ninja")
@ -2852,15 +2864,7 @@ and binaries removed, and adds modular support for using system libraries.")
(with-directory-excursion "chromium"
;; Delete bundled software and binaries that were not
;; explicitly preserved above.
(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)
#$remove-third-party-files
;; Use relative header locations instead of hard coded ones.
(substitute*
@ -2980,6 +2984,7 @@ linux/libcurl_wrapper.h"
(append clang-14
lld-as-ld-wrapper
python-wrapper
python-beautifulsoup4
python-html5lib)))
(inputs
(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
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2021 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -17,17 +18,22 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages commencement)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages documentation)
#:use-module (gnu packages embedded)
#:use-module (gnu packages file)
#: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 download)
#:use-module (guix git-download)
@ -40,7 +46,10 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#: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
(package
@ -235,3 +244,126 @@ Raspberry Pi. Note: It does not work on Raspberry Pi 1.")
(install-file "arm64.bin" libexec)
#t))))))))
(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 Ricardo Wurmus <rekado@elephly.net>
;;; 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.
;;;
@ -37,11 +39,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages rust-apps)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cargo)
#:use-module (guix download)
#:use-module (guix git-download)
#: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 utils)
#:use-module (gnu packages)
@ -1028,6 +1031,49 @@ rebase.")
"This package provides a tool for generating C/C++ bindings to Rust code.")
(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
(package
(inherit rust-cbindgen)
@ -1875,6 +1921,164 @@ C-compatible) software.")
consecutive lines and since program start.")
(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
(package
(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.")
(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
(package
(name "tealdeer")
@ -2029,32 +2270,54 @@ It will then write @code{fixup!} commits for each of those changes.")
(define-public zoxide
(package
(name "zoxide")
(version "0.6.0")
(version "0.8.3")
(source
(origin
(method url-fetch)
(uri (crate-uri "zoxide" version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1ih01l3xp8plicxhmyxjkq12ncpdb8954jcj3dh3lwvkhvw29nkk"))))
(base32 "0y5v2vgl9f3n0n0w4b3iddbfyxv0hls0vw5406ry0hcvnnjyy2l3"))))
(build-system cargo-build-system)
(arguments
`(#:cargo-inputs
(("rust-anyhow" ,rust-anyhow-1)
("rust-askama" ,rust-askama-0.10)
("rust-bincode" ,rust-bincode-1)
("rust-clap" ,rust-clap-3)
("rust-dirs-next" ,rust-dirs-next-2)
("rust-dunce" ,rust-dunce-1)
("rust-glob" ,rust-glob-0.3)
("rust-once-cell" ,rust-once-cell-1)
("rust-ordered-float" ,rust-ordered-float-2)
("rust-rand" ,rust-rand-0.7)
("rust-serde" ,rust-serde-1)
("rust-tempfile" ,rust-tempfile-3))
#:cargo-development-inputs
(("rust-assert-cmd" ,rust-assert-cmd-1)
("rust-seq-macro" ,rust-seq-macro-0.2))))
(list #:cargo-inputs
`(("rust-anyhow" ,rust-anyhow-1)
("rust-askama" ,rust-askama-0.11)
("rust-bincode" ,rust-bincode-1)
("rust-clap" ,rust-clap-3)
("rust-clap-complete" ,rust-clap-complete-3)
("rust-clap-complete-fig" ,rust-clap-complete-fig-3)
("rust-dirs" ,rust-dirs-4)
("rust-dunce" ,rust-dunce-1)
("rust-fastrand" ,rust-fastrand-1)
("rust-glob" ,rust-glob-0.3)
("rust-nix" ,rust-nix-0.24)
("rust-serde" ,rust-serde-1)
("rust-which" ,rust-which-4))
#:cargo-development-inputs
`(("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/")
(synopsis "Fast way to navigate your file system")
(description

17
gnu/packages/rust.scm
View File

@ -625,6 +625,11 @@ safety and thread safety guarantees.")
rust-1.63 "1.64.0" "018j720b2n12slp4xk64jc6shkncd46d621qdyzh2a8s3r49zkdk")))
(package
(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
(substitute-keyword-arguments (package-arguments base-rust)
((#:phases phases)
@ -638,8 +643,16 @@ safety and thread safety guarantees.")
(generate-all-checksums "vendor"))))))))))
(define rust-1.65
(rust-bootstrapped-package
rust-1.64 "1.65.0" "0f005kc0vl7qyy298f443i78ibz71hmmh820726bzskpyrkvna2q"))
(let ((base-rust
(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
;;; 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
;;; 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 © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
@ -154,7 +154,7 @@ fundamental object types for C.")
(define-public sssd
(package
(name "sssd")
(version "2.7.4")
(version "2.8.1")
(source
(origin
(method git-fetch)
@ -163,9 +163,8 @@ fundamental object types for C.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "1946pfwyv1ci0m4flrhwkksq42p14n7kcng6fbq6sy4lcn5g3yml"))
(patches (search-patches "sssd-optional-systemd.patch"
"sssd-system-directories.patch"))))
(base32 "19vn2a1r33q6fnw7jmfv3s4kirnviz0rgq0w6wzx6h008iysidsd"))
(patches (search-patches "sssd-system-directories.patch"))))
(build-system gnu-build-system)
(arguments
(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 © 2014, 2016 Eric Bavier <bavier@member.fsf.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 Pierre-Moana Levesque <pierre.moana.levesque@gmail.com>
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@ -40,6 +40,7 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages gettext)
#:use-module ((gnu packages hurd) #:select (hurd-target?))
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl)
#:use-module (gnu packages readline))
@ -71,7 +72,10 @@
(("env -i")
"env "))
#t)))
%standard-phases)))
%standard-phases)
;; XXX: Work around <https://issues.guix.gnu.org/59616>.
#:tests? ,(not (hurd-target?))))
(inputs (list ncurses perl))
;; When cross-compiling, texinfo will build some of its own binaries with
;; 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
(package
(inherit texinfo)
(version "7.0")
(version "7.0.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/texinfo/texinfo-"
version ".tar.xz"))
(sha256
(base32
"1q73zd0bm7zjamc5ssf329v7fndd8dqv0d7fii6s1rqwaf14nx10"))))))
"1cn6na6vgz6nhda0f5naiysx5sqhw3azi81qk6hah1yqnbyj3lmw"))))))
(define-public texinfo-5
(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
(package
(name "jucipp")
(version "1.7.1")
(version "1.7.2")
(home-page "https://gitlab.com/cppit/jucipp")
(source (origin
(method git-fetch)
@ -322,7 +322,7 @@ bindings and many of the powerful features of GNU Emacs.")
(recursive? #t)))
(file-name (git-file-name name version))
(sha256
(base32 "0xyf1fa7jvxzvg1dxh5vc50fbwjjsar4fmlvbfhicdd1f8bhz1ii"))
(base32 "034il3z38a7qvp95f52n9rxbqmh8fxsy416rjak3zzagvfkvzyii"))
(modules '((guix build utils)))
(snippet
'(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
;; functionality of the package, and requires doing
;; 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.
(("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
(package
(name "svt-av1")
(version "0.9.1")
(version "1.3.0")
(source
(origin
(method git-fetch)
@ -5092,10 +5092,8 @@ transcode or reformat the videos in any way, producing perfect backups.")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "02fchq2vlxcxzbrss72xl9vrxzysdy39d5i159bmg3qa45ngd2iw"))))
(base32 "0blnla32yz665bx0xyx8lrjs2wqd2xhpbqwwpz72mq7zf341j8vv"))))
(build-system cmake-build-system)
;; SVT-AV1 only supports 64-bit Intel-compatible CPUs.
(supported-systems '("x86_64-linux"))
(arguments
;; The test suite tries to download test data and git clone a 3rd-party
;; fork of libaom. Skip it.
@ -5113,7 +5111,8 @@ transcode or reformat the videos in any way, producing perfect backups.")
(synopsis "AV1 video codec")
(description "SVT-AV1 is an AV1 codec implementation. The encoder is a
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")
(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.")
(home-page "http://p.outlyer.net/vcs/")
(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.")
(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
(let ((revision "1")
(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
(package
(name "waybar")
(version "0.9.15")
(version "0.9.16")
(source
(origin
(method git-fetch)
@ -1734,7 +1734,7 @@ display a clock or apply image manipulation techniques to the background image."
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "0mvwsd3krrlniga0fq13b0qvsf1fj22mk9nzsfgz49r55lqw8sdv"))))
(base32 "06vwsax8z6vvvav4c1d40nfiljc7h1cla57r43nv8dw86n539ic5"))))
(build-system meson-build-system)
(inputs (list date
fmt
@ -2987,3 +2987,49 @@ file.")))
(synopsis "Primitive drawing library for Wayland")
(description "wld is a drawing library that targets Wayland.")
(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 © 2018, 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -35,6 +36,7 @@
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (gnu packages check)
#:use-module (gnu packages curl)
#:use-module (gnu packages compression)
#:use-module (gnu packages databases)
#:use-module (gnu packages freedesktop)
@ -45,18 +47,19 @@
#:use-module (gnu packages image)
#:use-module (gnu packages photo)
#:use-module (gnu packages video)
#:use-module (gnu packages pcre)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages sdl)
#:use-module (gnu packages webkit)
#:use-module (gnu packages xorg)
#:use-module ((srfi srfi-1) #:select (alist-delete)))
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg))
(define-public wxwidgets
(package
(name "wxwidgets")
(version "3.0.5.1")
(version "3.2.1")
(source
(origin
(method url-fetch)
@ -64,24 +67,128 @@
"releases/download/v" version
"/wxWidgets-" version ".tar.bz2"))
(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)
(inputs
`(("glu" ,glu)
;; XXX gstreamer-0.10 builds fail
;; ("gstreamer" ,gstreamer-0.10)
("gtk" ,gtk+)
("libjpeg" ,libjpeg-turbo)
("libmspack" ,libmspack)
("libsm" ,libsm)
("libtiff" ,libtiff)
("mesa" ,mesa)
("webkitgtk" ,webkitgtk)
("sdl" ,sdl)
("shared-mime-info" ,shared-mime-info)
("xdg-utils" ,xdg-utils)))
(list catch-framework
curl
expat
glu
gstreamer
gst-plugins-base
gtk+
libjpeg-turbo
libmspack
libnotify
libpng
libsecret
libsm
libtiff
mesa
pcre2
sdl2
shared-mime-info
webkitgtk-with-libsoup2
xdg-utils
zlib))
(native-inputs
(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
`(#:configure-flags
'("--with-regex" "--with-libmspack"
@ -102,20 +209,24 @@
(modify-phases %standard-phases
(add-after 'unpack 'refer-to-inputs
(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"
(("wxExecute\\(xdg_open \\+")
(string-append "wxExecute(\"" (which "xdg-open") "\"")))
(string-append "wxExecute(\"" xdg-open "\"")))
(substitute* "src/unix/mimetype.cpp"
(("/usr(/local)?/share/mime") mime))
#t))))))
(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")))))
(("/usr(/local)?/share/mime") mime))))))))))
(define-public wxwidgets-gtk2-3.0
(package/inherit wxwidgets-3.0
(name "wxwidgets-gtk2")
(inputs (modify-inputs (package-inputs wxwidgets-3.0)
(delete "gtk+")
(prepend gtk+-2)))
(arguments
(substitute-keyword-arguments (package-arguments wxwidgets-3.0)
((#:configure-flags flags #~'())
#~(append #$flags '("--with-gtk=2")))))))
(define-public wxwidgets-2
(package
@ -152,74 +263,17 @@ and many other languages.")
(("-Wall") "-Wall -Wno-narrowing"))
#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
(package
(name "python-wxpython")
(version "4.0.7.post1")
(version "4.2.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "wxPython" version))
(sha256
(base32
"1jppcr3n428m8pgwb9q3g0iiqydxd451ncri4njk8b53xsiflhys"))
"1iw6xp76b3fmdqwbqmsx9i1razzpfki5z1hq6l8mszlxa32fng36"))
(modules '((guix build utils)))
(snippet
'(begin
@ -255,7 +309,7 @@ and many other languages.")
(native-inputs
(list pkg-config python-waf))
(propagated-inputs
(list python-numpy python-pillow python-six))
(list python-attrdict python-numpy python-pillow python-six))
(home-page "https://wxpython.org/")
(synopsis "Cross platform GUI toolkit for 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"))))
(build-system glib-or-gtk-build-system)
(inputs
(list wxwidgets-3.1 cairo ffmpeg))
(list wxwidgets cairo ffmpeg))
(native-inputs
(list pkg-config))
(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))))))))
(define agetty-shepherd-service
(match-lambda
(($ <agetty-configuration> agetty tty term baud-rate auto-login
login-program login-pause? eight-bits? no-reset? remote? flow-control?
host no-issue? init-string no-clear? local-line extract-baud?
skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
detect-case? wait-cr? no-hints? no-hostname? long-hostname?
erase-characters kill-characters chdir delay nice extra-options
shepherd-requirement)
(list
(shepherd-service
(documentation "Run agetty on a tty.")
(provision (list (symbol-append 'term- (string->symbol (or tty "console")))))
(define (agetty-shepherd-service config)
(match-record config <agetty-configuration>
(agetty tty term baud-rate auto-login
login-program login-pause? eight-bits? no-reset? remote? flow-control?
host no-issue? init-string no-clear? local-line extract-baud?
skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
detect-case? wait-cr? no-hints? no-hostname? long-hostname?
erase-characters kill-characters chdir delay nice extra-options
shepherd-requirement)
(list
(shepherd-service
(documentation "Run agetty on a tty.")
(provision (list (symbol-append 'term- (string->symbol (or tty "console")))))
;; 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
;; text is not lost in the middle of kernel messages (see also
;; mingetty-shepherd-service).
(requirement (cons* 'user-processes 'host-name 'udev
shepherd-requirement))
;; 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
;; text is not lost in the middle of kernel messages (see also
;; mingetty-shepherd-service).
(requirement (cons* 'user-processes 'host-name 'udev
shepherd-requirement))
(modules '((ice-9 match) (gnu build linux-boot)))
(start
(with-imported-modules (source-module-closure
'((gnu build linux-boot)))
#~(lambda args
(let ((defaulted-tty #$(or tty (default-serial-port))))
(apply
(if defaulted-tty
(make-forkexec-constructor
(list #$(file-append util-linux "/sbin/agetty")
#$@extra-options
#$@(if eight-bits?
#~("--8bits")
#~())
#$@(if no-reset?
#~("--noreset")
#~())
#$@(if remote?
#~("--remote")
#~())
#$@(if flow-control?
#~("--flow-control")
#~())
#$@(if host
#~("--host" #$host)
#~())
#$@(if no-issue?
#~("--noissue")
#~())
#$@(if init-string
#~("--init-string" #$init-string)
#~())
#$@(if no-clear?
#~("--noclear")
#~())
(modules '((ice-9 match) (gnu build linux-boot)))
(start
(with-imported-modules (source-module-closure
'((gnu build linux-boot)))
#~(lambda args
(let ((defaulted-tty #$(or tty (default-serial-port))))
(apply
(if defaulted-tty
(make-forkexec-constructor
(list #$(file-append util-linux "/sbin/agetty")
#$@extra-options
#$@(if eight-bits?
#~("--8bits")
#~())
#$@(if no-reset?
#~("--noreset")
#~())
#$@(if remote?
#~("--remote")
#~())
#$@(if flow-control?
#~("--flow-control")
#~())
#$@(if host
#~("--host" #$host)
#~())
#$@(if no-issue?
#~("--noissue")
#~())
#$@(if init-string
#~("--init-string" #$init-string)
#~())
#$@(if no-clear?
#~("--noclear")
#~())
;;; 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
;;; option is selected, agetty never presents the login prompt, and the
;;; term-ttyS0 service respawns every few seconds.
#$@(if local-line
#~(#$(match local-line
('auto "--local-line=auto")
('always "--local-line=always")
('never "-local-line=never")))
#~())
#$@(if tty
#~()
#~("--keep-baud"))
#$@(if extract-baud?
#~("--extract-baud")
#~())
#$@(if skip-login?
#~("--skip-login")
#~())
#$@(if no-newline?
#~("--nonewline")
#~())
#$@(if login-options
#~("--login-options" #$login-options)
#~())
#$@(if chroot
#~("--chroot" #$chroot)
#~())
#$@(if hangup?
#~("--hangup")
#~())
#$@(if keep-baud?
#~("--keep-baud")
#~())
#$@(if timeout
#~("--timeout" #$(number->string timeout))
#~())
#$@(if detect-case?
#~("--detect-case")
#~())
#$@(if wait-cr?
#~("--wait-cr")
#~())
#$@(if no-hints?
#~("--nohints?")
#~())
#$@(if no-hostname?
#~("--nohostname")
#~())
#$@(if long-hostname?
#~("--long-hostname")
#~())
#$@(if erase-characters
#~("--erase-chars" #$erase-characters)
#~())
#$@(if kill-characters
#~("--kill-chars" #$kill-characters)
#~())
#$@(if chdir
#~("--chdir" #$chdir)
#~())
#$@(if delay
#~("--delay" #$(number->string delay))
#~())
#$@(if nice
#~("--nice" #$(number->string nice))
#~())
#$@(if auto-login
(list "--autologin" auto-login)
'())
#$@(if login-program
#~("--login-program" #$login-program)
#~())
#$@(if login-pause?
#~("--login-pause")
#~())
defaulted-tty
#$@(if baud-rate
#~(#$baud-rate)
#~())
#$@(if term
#~(#$term)
#~())))
(const #f)) ; never start.
args)))))
(stop #~(make-kill-destructor)))))))
#$@(if local-line
#~(#$(match local-line
('auto "--local-line=auto")
('always "--local-line=always")
('never "-local-line=never")))
#~())
#$@(if tty
#~()
#~("--keep-baud"))
#$@(if extract-baud?
#~("--extract-baud")
#~())
#$@(if skip-login?
#~("--skip-login")
#~())
#$@(if no-newline?
#~("--nonewline")
#~())
#$@(if login-options
#~("--login-options" #$login-options)
#~())
#$@(if chroot
#~("--chroot" #$chroot)
#~())
#$@(if hangup?
#~("--hangup")
#~())
#$@(if keep-baud?
#~("--keep-baud")
#~())
#$@(if timeout
#~("--timeout" #$(number->string timeout))
#~())
#$@(if detect-case?
#~("--detect-case")
#~())
#$@(if wait-cr?
#~("--wait-cr")
#~())
#$@(if no-hints?
#~("--nohints?")
#~())
#$@(if no-hostname?
#~("--nohostname")
#~())
#$@(if long-hostname?
#~("--long-hostname")
#~())
#$@(if erase-characters
#~("--erase-chars" #$erase-characters)
#~())
#$@(if kill-characters
#~("--kill-chars" #$kill-characters)
#~())
#$@(if chdir
#~("--chdir" #$chdir)
#~())
#$@(if delay
#~("--delay" #$(number->string delay))
#~())
#$@(if nice
#~("--nice" #$(number->string nice))
#~())
#$@(if auto-login
(list "--autologin" auto-login)
'())
#$@(if login-program
#~("--login-program" #$login-program)
#~())
#$@(if login-pause?
#~("--login-pause")
#~())
defaulted-tty
#$@(if baud-rate
#~(#$baud-rate)
#~())
#$@(if term
#~(#$term)
#~())))
(const #f)) ; never start.
args)))))
(stop #~(make-kill-destructor))))))
(define agetty-service-type
(service-type (name 'agetty)
@ -1148,42 +1148,42 @@ the tty to run, among other things."
(clear-on-logout? mingetty-clear-on-logout? ;Boolean
(default #t)))
(define mingetty-shepherd-service
(match-lambda
(($ <mingetty-configuration> mingetty tty auto-login login-program
login-pause? clear-on-logout?)
(list
(shepherd-service
(documentation "Run mingetty on an tty.")
(provision (list (symbol-append 'term- (string->symbol tty))))
(define (mingetty-shepherd-service config)
(match-record config <mingetty-configuration>
(mingetty tty auto-login login-program
login-pause? clear-on-logout?)
(list
(shepherd-service
(documentation "Run mingetty on an tty.")
(provision (list (symbol-append 'term- (string->symbol tty))))
;; 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
;; text is not lost in the middle of kernel messages (XXX).
(requirement '(user-processes host-name udev virtual-terminal))
;; 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
;; text is not lost in the middle of kernel messages (XXX).
(requirement '(user-processes host-name udev virtual-terminal))
(start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty")
(start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty")
;; Avoiding 'vhangup' allows us to avoid 'setfont'
;; errors down the path where various ioctls get
;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c
;; in Linux.
"--nohangup" #$tty
;; Avoiding 'vhangup' allows us to avoid 'setfont'
;; errors down the path where various ioctls get
;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c
;; in Linux.
"--nohangup" #$tty
#$@(if clear-on-logout?
#~()
#~("--noclear"))
#$@(if auto-login
#~("--autologin" #$auto-login)
#~())
#$@(if login-program
#~("--loginprog" #$login-program)
#~())
#$@(if login-pause?
#~("--loginpause")
#~()))))
(stop #~(make-kill-destructor)))))))
#$@(if clear-on-logout?
#~()
#~("--noclear"))
#$@(if auto-login
#~("--autologin" #$auto-login)
#~())
#$@(if login-program
#~("--loginprog" #$login-program)
#~())
#$@(if login-pause?
#~("--loginpause")
#~()))))
(stop #~(make-kill-destructor))))))
(define mingetty-service-type
(service-type (name 'mingetty)
@ -1260,46 +1260,47 @@ the tty to run, among other things."
(define (nscd.conf-file config)
"Return the @file{nscd.conf} configuration file for @var{config}, an
@code{<nscd-configuration>} object."
(define cache->config
(match-lambda
(($ <nscd-cache> (= symbol->string database)
positive-ttl negative-ttl size check-files?
persistent? shared? max-size propagate?)
(string-append "\nenable-cache\t" database "\tyes\n"
(define (cache->config cache)
(match-record cache <nscd-cache>
(database positive-time-to-live negative-time-to-live
suggested-size check-files?
persistent? shared? max-database-size auto-propagate?)
(let ((database (symbol->string database)))
(string-append "\nenable-cache\t" database "\tyes\n"
"positive-time-to-live\t" database "\t"
(number->string positive-ttl) "\n"
"negative-time-to-live\t" database "\t"
(number->string negative-ttl) "\n"
"suggested-size\t" database "\t"
(number->string size) "\n"
"check-files\t" database "\t"
(if check-files? "yes\n" "no\n")
"persistent\t" database "\t"
(if persistent? "yes\n" "no\n")
"shared\t" database "\t"
(if shared? "yes\n" "no\n")
"max-db-size\t" database "\t"
(number->string max-size) "\n"
"auto-propagate\t" database "\t"
(if propagate? "yes\n" "no\n")))))
"positive-time-to-live\t" database "\t"
(number->string positive-time-to-live) "\n"
"negative-time-to-live\t" database "\t"
(number->string negative-time-to-live) "\n"
"suggested-size\t" database "\t"
(number->string suggested-size) "\n"
"check-files\t" database "\t"
(if check-files? "yes\n" "no\n")
"persistent\t" database "\t"
(if persistent? "yes\n" "no\n")
"shared\t" database "\t"
(if shared? "yes\n" "no\n")
"max-db-size\t" database "\t"
(number->string max-database-size) "\n"
"auto-propagate\t" database "\t"
(if auto-propagate? "yes\n" "no\n")))))
(match config
(($ <nscd-configuration> log-file debug-level caches)
(plain-file "nscd.conf"
(string-append "\
(match-record config <nscd-configuration>
(log-file debug-level caches)
(plain-file "nscd.conf"
(string-append "\
# Configuration of libc's name service cache daemon (nscd).\n\n"
(if log-file
(string-append "logfile\t" log-file)
"")
"\n"
(if debug-level
(string-append "debug-level\t"
(number->string debug-level))
"")
"\n"
(string-concatenate
(map cache->config caches)))))))
(if log-file
(string-append "logfile\t" log-file)
"")
"\n"
(if debug-level
(string-append "debug-level\t"
(number->string debug-level))
"")
"\n"
(string-concatenate
(map cache->config caches))))))
(define (nscd-action-procedure nscd config option)
;; XXX: This is duplicated from mcron; factorize.
@ -1797,17 +1798,15 @@ proxy of 'guix-daemon'...~%")
(define (guix-accounts config)
"Return the user accounts and user groups for CONFIG."
(match config
(($ <guix-configuration> _ build-group build-accounts)
(cons (user-group
(name build-group)
(system? #t)
(cons (user-group
(name (guix-configuration-build-group config))
(system? #t)
;; Use a fixed GID so that we can create the store with the right
;; owner.
(id 30000))
(guix-build-accounts build-accounts
#:group build-group)))))
;; Use a fixed GID so that we can create the store with the right
;; owner.
(id 30000))
(guix-build-accounts (guix-configuration-build-accounts config)
#:group (guix-configuration-build-group config))))
(define (guix-activation config)
"Return the activation gexp for CONFIG."
@ -2130,95 +2129,94 @@ item of @var{packages}."
(udev-rule "90-kvm.rules"
"KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
(define udev-shepherd-service
(define (udev-shepherd-service config)
;; Return a <shepherd-service> for UDEV with RULES.
(match-lambda
(($ <udev-configuration> udev)
(list
(shepherd-service
(provision '(udev))
(let ((udev (udev-configuration-udev config)))
(list
(shepherd-service
(provision '(udev))
;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
;; be added: see
;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
(requirement '(root-file-system))
;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
;; be added: see
;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
(requirement '(root-file-system))
(documentation "Populate the /dev directory, dynamically.")
(start
(with-imported-modules (source-module-closure
'((gnu build linux-boot)))
#~(lambda ()
(define udevd
;; 'udevd' from eudev.
#$(file-append udev "/sbin/udevd"))
(documentation "Populate the /dev directory, dynamically.")
(start
(with-imported-modules (source-module-closure
'((gnu build linux-boot)))
#~(lambda ()
(define udevd
;; 'udevd' from eudev.
#$(file-append udev "/sbin/udevd"))
(define (wait-for-udevd)
;; Wait until someone's listening on udevd's control
;; socket.
(let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
(let try ()
(catch 'system-error
(lambda ()
(connect sock PF_UNIX "/run/udev/control")
(close-port sock))
(lambda args
(format #t "waiting for udevd...~%")
(usleep 500000)
(try))))))
(define (wait-for-udevd)
;; Wait until someone's listening on udevd's control
;; socket.
(let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
(let try ()
(catch 'system-error
(lambda ()
(connect sock PF_UNIX "/run/udev/control")
(close-port sock))
(lambda args
(format #t "waiting for udevd...~%")
(usleep 500000)
(try))))))
;; Allow udev to find the modules.
(setenv "LINUX_MODULE_DIRECTORY"
"/run/booted-system/kernel/lib/modules")
;; Allow udev to find the modules.
(setenv "LINUX_MODULE_DIRECTORY"
"/run/booted-system/kernel/lib/modules")
(let* ((kernel-release
(utsname:release (uname)))
(linux-module-directory
(getenv "LINUX_MODULE_DIRECTORY"))
(directory
(string-append linux-module-directory "/"
kernel-release))
(old-umask (umask #o022)))
;; If we're in a container, DIRECTORY might not exist,
;; for instance because the host runs a different
;; kernel. In that case, skip it; we'll just miss a few
;; nodes like /dev/fuse.
(when (file-exists? directory)
(make-static-device-nodes directory))
(umask old-umask))
(let* ((kernel-release
(utsname:release (uname)))
(linux-module-directory
(getenv "LINUX_MODULE_DIRECTORY"))
(directory
(string-append linux-module-directory "/"
kernel-release))
(old-umask (umask #o022)))
;; If we're in a container, DIRECTORY might not exist,
;; for instance because the host runs a different
;; kernel. In that case, skip it; we'll just miss a few
;; nodes like /dev/fuse.
(when (file-exists? directory)
(make-static-device-nodes directory))
(umask old-umask))
(let ((pid (fork+exec-command
(list udevd)
#:environment-variables
(cons*
;; The first one is for udev, the second one for
;; eudev.
"UDEV_CONFIG_FILE=/etc/udev/udev.conf"
"EUDEV_RULES_DIRECTORY=/etc/udev/rules.d"
(string-append "LINUX_MODULE_DIRECTORY="
(getenv "LINUX_MODULE_DIRECTORY"))
(default-environment-variables)))))
;; Wait until udevd is up and running. This appears to
;; be needed so that the events triggered below are
;; actually handled.
(wait-for-udevd)
(let ((pid (fork+exec-command
(list udevd)
#:environment-variables
(cons*
;; The first one is for udev, the second one for
;; eudev.
"UDEV_CONFIG_FILE=/etc/udev/udev.conf"
"EUDEV_RULES_DIRECTORY=/etc/udev/rules.d"
(string-append "LINUX_MODULE_DIRECTORY="
(getenv "LINUX_MODULE_DIRECTORY"))
(default-environment-variables)))))
;; Wait until udevd is up and running. This appears to
;; be needed so that the events triggered below are
;; actually handled.
(wait-for-udevd)
;; Trigger device node creation.
(system* #$(file-append udev "/bin/udevadm")
"trigger" "--action=add")
;; Trigger device node creation.
(system* #$(file-append udev "/bin/udevadm")
"trigger" "--action=add")
;; Wait for things to settle down.
(system* #$(file-append udev "/bin/udevadm")
"settle")
pid))))
(stop #~(make-kill-destructor))
;; Wait for things to settle down.
(system* #$(file-append udev "/bin/udevadm")
"settle")
pid))))
(stop #~(make-kill-destructor))
;; When halting the system, 'udev' is actually killed by
;; 'user-processes', i.e., before its own 'stop' method was called.
;; Thus, make sure it is not respawned.
(respawn? #f)
;; We need additional modules.
(modules `((gnu build linux-boot) ;'make-static-device-nodes'
,@%default-modules)))))))
;; When halting the system, 'udev' is actually killed by
;; 'user-processes', i.e., before its own 'stop' method was called.
;; Thus, make sure it is not respawned.
(respawn? #f)
;; We need additional modules.
(modules `((gnu build linux-boot) ;'make-static-device-nodes'
,@%default-modules))))))
(define udev.conf
(computed-file "udev.conf"
@ -2226,14 +2224,15 @@ item of @var{packages}."
(lambda (port)
(format port "udev_rules=\"/etc/udev/rules.d\"~%")))))
(define udev-etc
(match-lambda
(($ <udev-configuration> udev rules)
`(("udev"
,(file-union
"udev" `(("udev.conf" ,udev.conf)
("rules.d" ,(udev-rules-union (cons* udev kvm-udev-rule
rules))))))))))
(define (udev-etc config)
(match-record config <udev-configuration>
(udev rules)
`(("udev"
,(file-union "udev"
`(("udev.conf" ,udev.conf)
("rules.d"
,(udev-rules-union (cons* udev kvm-udev-rule
rules)))))))))
(define udev-service-type
(service-type (name 'udev)
@ -2243,11 +2242,11 @@ item of @var{packages}."
(service-extension etc-service-type udev-etc)))
(compose concatenate) ;concatenate the list of rules
(extend (lambda (config rules)
(match config
(($ <udev-configuration> udev initial-rules)
(udev-configuration
(udev udev)
(rules (append initial-rules rules)))))))
(let ((initial-rules
(udev-configuration-rules config)))
(udev-configuration
(inherit config)
(rules (append initial-rules rules))))))
(default-value (udev-configuration))
(description
"Run @command{udev}, which populates the @file{/dev}
@ -2385,23 +2384,23 @@ instance."
(options gpm-configuration-options ;list of strings
(default %default-gpm-options)))
(define gpm-shepherd-service
(match-lambda
(($ <gpm-configuration> gpm options)
(list (shepherd-service
(requirement '(udev))
(provision '(gpm))
;; 'gpm' runs in the background and sets a PID file.
;; Note that it requires running as "root".
(start #~(make-forkexec-constructor
(list #$(file-append gpm "/sbin/gpm")
#$@options)
#:pid-file "/var/run/gpm.pid"
#:pid-file-timeout 3))
(stop #~(lambda (_)
;; Return #f if successfully stopped.
(not (zero? (system* #$(file-append gpm "/sbin/gpm")
"-k"))))))))))
(define (gpm-shepherd-service config)
(match-record config <gpm-configuration>
(gpm options)
(list (shepherd-service
(requirement '(udev))
(provision '(gpm))
;; 'gpm' runs in the background and sets a PID file.
;; Note that it requires running as "root".
(start #~(make-forkexec-constructor
(list #$(file-append gpm "/sbin/gpm")
#$@options)
#:pid-file "/var/run/gpm.pid"
#:pid-file-timeout 3))
(stop #~(lambda (_)
;; Return #f if successfully stopped.
(not (zero? (system* #$(file-append gpm "/sbin/gpm")
"-k")))))))))
(define gpm-service-type
(service-type (name 'gpm)
@ -2654,32 +2653,64 @@ to CONFIG."
"/servers/socket/2")
#f))))
(define network-set-up/linux
(match-lambda
(($ <static-networking> addresses links routes)
(scheme-file "set-up-network"
(with-extensions (list guile-netlink)
#~(begin
(use-modules (ip addr) (ip link) (ip route))
(define (network-set-up/linux config)
(match-record config <static-networking>
(addresses links routes)
(scheme-file "set-up-network"
(with-extensions (list guile-netlink)
#~(begin
(use-modules (ip addr) (ip link) (ip route))
#$@(map (lambda (address)
#~(begin
(addr-add #$(network-address-device address)
#$(network-address-value address)
#:ipv6?
#$(network-address-ipv6? address))
;; FIXME: loopback?
(link-set #$(network-address-device address)
#:multicast-on #t
#:up #t)))
addresses)
#$@(map (match-lambda
(($ <network-link> name type arguments)
#~(link-add #$name #$type
#:type-args '#$arguments)))
links)
#$@(map (lambda (route)
#~(route-add #$(network-route-destination route)
#$@(map (lambda (address)
#~(begin
(addr-add #$(network-address-device address)
#$(network-address-value address)
#:ipv6?
#$(network-address-ipv6? address))
;; FIXME: loopback?
(link-set #$(network-address-device address)
#:multicast-on #t
#:up #t)))
addresses)
#$@(map (match-lambda
(($ <network-link> name type arguments)
#~(link-add #$name #$type
#:type-args '#$arguments)))
links)
#$@(map (lambda (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
#$(network-route-device route)
#:ipv6?
@ -2687,80 +2718,47 @@ to CONFIG."
#:via
#$(network-route-gateway route)
#:src
#$(network-route-source route)))
routes)
#t))))))
(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)
#$(network-route-source route))))
routes)
#$@(map (match-lambda
(($ <network-link> name type arguments)
#~(false-if-netlink-error
(route-del #$(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)
#$@(map (match-lambda
(($ <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))))))
(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)
(match config
(($ <static-networking> addresses links routes
provision requirement name-servers)
(let ((loopback? (and provision (memq 'loopback provision))))
(shepherd-service
(match-record config <static-networking>
(addresses links routes provision requirement name-servers)
(let ((loopback? (and provision (memq 'loopback provision))))
(shepherd-service
(documentation
"Bring up the networking interface using a static IP address.")
(requirement requirement)
(provision provision)
(documentation
"Bring up the networking interface using a static IP address.")
(requirement requirement)
(provision provision)
(start #~(lambda _
;; 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.
(start #~(lambda _
;; Return #t if successfully started.
(load #$(let-system (system target)
(if (string-contains (or target system) "-linux")
(network-tear-down/linux config)
(network-tear-down/hurd config))))))
(respawn? #f))))))
(network-set-up/linux config)
(network-set-up/hurd config))))))
(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)
(map static-networking-shepherd-service networks))
@ -2873,33 +2871,33 @@ to handle."
(extra-env greetd-agreety-extra-env (default '()))
(xdg-env? greetd-agreety-xdg-env? (default #t)))
(define greetd-agreety-tty-session-command
(match-lambda
(($ <greetd-agreety-session> _ command args extra-env)
(program-file
"agreety-tty-session-command"
#~(begin
(use-modules (ice-9 match))
(for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env)))
(apply execl #$command #$command (list #$@args)))))))
(define (greetd-agreety-tty-session-command config)
(match-record config <greetd-agreety-session>
(command command-args extra-env)
(program-file
"agreety-tty-session-command"
#~(begin
(use-modules (ice-9 match))
(for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env)))
(apply execl #$command #$command (list #$@command-args))))))
(define greetd-agreety-tty-xdg-session-command
(match-lambda
(($ <greetd-agreety-session> _ command args extra-env)
(program-file
"agreety-tty-xdg-session-command"
#~(begin
(use-modules (ice-9 match))
(let*
((username (getenv "USER"))
(useruid (passwd:uid (getpwuid username)))
(useruid (number->string useruid)))
(setenv "XDG_SESSION_TYPE" "tty")
(setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
(for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env)))
(apply execl #$command #$command (list #$@args)))))))
(define (greetd-agreety-tty-xdg-session-command config)
(match-record config <greetd-agreety-session>
(command command-args extra-env)
(program-file
"agreety-tty-xdg-session-command"
#~(begin
(use-modules (ice-9 match))
(let*
((username (getenv "USER"))
(useruid (passwd:uid (getpwuid username)))
(useruid (number->string useruid)))
(setenv "XDG_SESSION_TYPE" "tty")
(setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
(for-each (match-lambda ((var . val) (setenv var val)))
(quote (#$@extra-env)))
(apply execl #$command #$command (list #$@command-args))))))
(define-gexp-compiler (greetd-agreety-session-compiler
(session <greetd-agreety-session>)

4
gnu/services/cuirass.scm
View File

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

22
gnu/services/getmail.scm
View File

@ -215,17 +215,6 @@ lines.")
(parameter-alist '())
"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
(retriever
(getmail-retriever-configuration (getmail-retriever-configuration))
@ -237,6 +226,17 @@ lines.")
(getmail-options-configuration (getmail-options-configuration))
"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-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 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2022 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of GNU Guix.
;;;
@ -277,8 +278,10 @@ fe80::1%lo0 apps.facebook.com\n")
(define dhcp-client-shepherd-service
(match-lambda
(($ <dhcp-client-configuration> package interfaces)
(let ((pid-file "/var/run/dhclient.pid"))
((? dhcp-client-configuration? config)
(let ((package (dhcp-client-configuration-package config))
(interfaces (dhcp-client-configuration-interfaces config))
(pid-file "/var/run/dhclient.pid"))
(list (shepherd-service
(documentation "Set up networking via DHCP.")
(requirement '(user-processes udev))
@ -359,46 +362,46 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
(interfaces dhcpd-configuration-interfaces
(default '())))
(define dhcpd-shepherd-service
(match-lambda
(($ <dhcpd-configuration> package config-file version run-directory
lease-file pid-file interfaces)
(unless config-file
(error "Must supply a config-file"))
(list (shepherd-service
;; Allow users to easily run multiple versions simultaneously.
(provision (list (string->symbol
(string-append "dhcpv" version "-daemon"))))
(documentation (string-append "Run the DHCPv" version " daemon"))
(requirement '(networking))
(start #~(make-forkexec-constructor
'(#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version)
"-lf" #$lease-file
"-pf" #$pid-file
"-cf" #$config-file
#$@interfaces)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))))
(define (dhcpd-shepherd-service config)
(match-record config <dhcpd-configuration>
(package config-file version run-directory
lease-file pid-file interfaces)
(unless config-file
(error "Must supply a config-file"))
(list (shepherd-service
;; Allow users to easily run multiple versions simultaneously.
(provision (list (string->symbol
(string-append "dhcpv" version "-daemon"))))
(documentation (string-append "Run the DHCPv" version " daemon"))
(requirement '(networking))
(start #~(make-forkexec-constructor
'(#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version)
"-lf" #$lease-file
"-pf" #$pid-file
"-cf" #$config-file
#$@interfaces)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor))))))
(define dhcpd-activation
(match-lambda
(($ <dhcpd-configuration> package config-file version run-directory
lease-file pid-file interfaces)
(with-imported-modules '((guix build utils))
#~(begin
(unless (file-exists? #$run-directory)
(mkdir #$run-directory))
;; According to the DHCP manual (man dhcpd.leases), the lease
;; database must be present for dhcpd to start successfully.
(unless (file-exists? #$lease-file)
(with-output-to-file #$lease-file
(lambda _ (display ""))))
;; Validate the config.
(invoke/quiet
#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version)
"-t" "-cf" #$config-file))))))
(define (dhcpd-activation config)
(match-record config <dhcpd-configuration>
(package config-file version run-directory
lease-file pid-file interfaces)
(with-imported-modules '((guix build utils))
#~(begin
(unless (file-exists? #$run-directory)
(mkdir #$run-directory))
;; According to the DHCP manual (man dhcpd.leases), the lease
;; database must be present for dhcpd to start successfully.
(unless (file-exists? #$lease-file)
(with-output-to-file #$lease-file
(lambda _ (display ""))))
;; Validate the config.
(invoke/quiet
#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version)
"-t" "-cf" #$config-file)))))
(define dhcpd-service-type
(service-type
@ -449,16 +452,16 @@ daemon is responsible for allocating IP addresses to its client.")))
(fold loop res x)
(cons (format #f "~a" x) res)))))
(match ntp-server
(($ <ntp-server> type address options)
;; 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
;; predicate property on a field?
(unless (enum-set-member? type ntp-server-types)
(error "Invalid NTP server type" type))
(string-join (cons* (symbol->string type)
address
(flatten options))))))
(match-record ntp-server <ntp-server>
(type address options)
;; 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
;; predicate property on a field?
(unless (enum-set-member? type ntp-server-types)
(error "Invalid NTP server type" type))
(string-join (cons* (symbol->string type)
address
(flatten options)))))
(define %ntp-servers
;; 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-servers))))
(define ntp-shepherd-service
(lambda (config)
(match config
(($ <ntp-configuration> ntp servers allow-large-adjustment?)
(let ((servers (ntp-configuration-servers config)))
;; TODO: Add authentication support.
(define config
(string-append "driftfile /var/run/ntpd/ntp.drift\n"
(string-join (map ntp-server->string servers)
"\n")
"
(define (ntp-shepherd-service config)
(match-record config <ntp-configuration>
(ntp servers allow-large-adjustment?)
(let ((servers (ntp-configuration-servers config)))
;; TODO: Add authentication support.
(define config
(string-append "driftfile /var/run/ntpd/ntp.drift\n"
(string-join (map ntp-server->string servers)
"\n")
"
# Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
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.
restrict source notrap nomodify noquery\n"))
(define ntpd.conf
(plain-file "ntpd.conf" config))
(define ntpd.conf
(plain-file "ntpd.conf" config))
(list (shepherd-service
(provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking))
(start #~(make-forkexec-constructor
(list (string-append #$ntp "/bin/ntpd") "-n"
"-c" #$ntpd.conf "-u" "ntpd"
#$@(if allow-large-adjustment?
'("-g")
'()))
#:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor)))))))))
(list (shepherd-service
(provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking))
(start #~(make-forkexec-constructor
(list (string-append #$ntp "/bin/ntpd") "-n"
"-c" #$ntpd.conf "-u" "ntpd"
#$@(if allow-large-adjustment?
'("-g")
'()))
#:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor)))))))
(define %ntp-accounts
(list (user-account
@ -742,19 +744,19 @@ daemon will keep the system clock synchronized with that of the given servers.")
" ") "\n")))
entries)))
(define inetd-shepherd-service
(match-lambda
(($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
(($ <inetd-configuration> program entries)
(list
(shepherd-service
(documentation "Run inetd.")
(provision '(inetd))
(requirement '(user-processes networking syslogd))
(start #~(make-forkexec-constructor
(list #$program #$(inetd-config-file entries))
#:pid-file "/var/run/inetd.pid"))
(stop #~(make-kill-destructor)))))))
(define (inetd-shepherd-service config)
(let ((entries (inetd-configuration-entries config)))
(if (null? entries)
'() ;do nothing
(let ((program (inetd-configuration-program config)))
(list (shepherd-service
(documentation "Run inetd.")
(provision '(inetd))
(requirement '(user-processes networking syslogd))
(start #~(make-forkexec-constructor
(list #$program #$(inetd-config-file entries))
#:pid-file "/var/run/inetd.pid"))
(stop #~(make-kill-destructor))))))))
(define-public inetd-service-type
(service-type
@ -938,97 +940,94 @@ applications in communication. It is used by Jami, for example.")))
(define (tor-configuration->torrc config)
"Return a 'torrc' file for CONFIG."
(match config
(($ <tor-configuration> tor config-file services
socks-socket-type control-socket?)
(computed-file
"torrc"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(match-record config <tor-configuration>
(tor config-file hidden-services socks-socket-type control-socket?)
(computed-file
"torrc"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(call-with-output-file #$output
(lambda (port)
(display "\
(call-with-output-file #$output
(lambda (port)
(display "\
### These lines were generated from your system configuration:
DataDirectory /var/lib/tor
Log notice syslog\n" port)
(when (eq? 'unix '#$socks-socket-type)
(display "\
(when (eq? 'unix '#$socks-socket-type)
(display "\
SocksPort unix:/var/run/tor/socks-sock
UnixSocksGroupWritable 1\n" port))
(when #$control-socket?
(display "\
(when #$control-socket?
(display "\
ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
ControlSocketsGroupWritable 1\n"
port))
port))
(for-each (match-lambda
((service (ports hosts) ...)
(format port "\
(for-each (match-lambda
((service (ports hosts) ...)
(format port "\
HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
service)
(for-each (lambda (tcp-port host)
(format port "\
service)
(for-each (lambda (tcp-port host)
(format port "\
HiddenServicePort ~a ~a~%"
tcp-port host))
ports hosts)))
'#$(map (match-lambda
(($ <hidden-service> name mapping)
(cons name mapping)))
services))
tcp-port host))
ports hosts)))
'#$(map (match-lambda
(($ <hidden-service> name mapping)
(cons name mapping)))
hidden-services))
(display "\
(display "\
### End of automatically generated lines.\n\n" port)
;; Append the user's config file.
(call-with-input-file #$config-file
(lambda (input)
(dump-port input port)))
#t))))))))
;; Append the user's config file.
(call-with-input-file #$config-file
(lambda (input)
(dump-port input port)))
#t)))))))
(define (tor-shepherd-service config)
"Return a <shepherd-service> running Tor."
(match config
(($ <tor-configuration> tor)
(let* ((torrc (tor-configuration->torrc config))
(tor (least-authority-wrapper
(file-append tor "/bin/tor")
#:name "tor"
#:mappings (list (file-system-mapping
(source "/var/lib/tor")
(target source)
(writable? #t))
(file-system-mapping
(source "/dev/log") ;for syslog
(target source))
(file-system-mapping
(source "/var/run/tor")
(target source)
(writable? #t))
(file-system-mapping
(source torrc)
(target source)))
#:namespaces (delq 'net %namespaces))))
(list (shepherd-service
(provision '(tor))
(let* ((torrc (tor-configuration->torrc config))
(tor (least-authority-wrapper
(file-append (tor-configuration-tor config) "/bin/tor")
#:name "tor"
#:mappings (list (file-system-mapping
(source "/var/lib/tor")
(target source)
(writable? #t))
(file-system-mapping
(source "/dev/log") ;for syslog
(target source))
(file-system-mapping
(source "/var/run/tor")
(target source)
(writable? #t))
(file-system-mapping
(source torrc)
(target source)))
#:namespaces (delq 'net %namespaces))))
(list (shepherd-service
(provision '(tor))
;; Tor needs at least one network interface to be up, hence the
;; dependency on 'loopback'.
(requirement '(user-processes loopback syslogd))
;; Tor needs at least one network interface to be up, hence the
;; dependency on 'loopback'.
(requirement '(user-processes loopback syslogd))
;; XXX: #:pid-file won't work because the wrapped 'tor'
;; program would print its PID within the user namespace
;; instead of its actual PID outside. There's no inetd or
;; systemd socket activation support either (there's
;; 'sd_notify' though), so we're stuck with that.
(start #~(make-forkexec-constructor
(list #$tor "-f" #$torrc)
#:user "tor" #:group "tor"))
(stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action torrc)))
(documentation "Run the Tor anonymous network overlay.")))))))
;; XXX: #:pid-file won't work because the wrapped 'tor'
;; program would print its PID within the user namespace
;; instead of its actual PID outside. There's no inetd or
;; systemd socket activation support either (there's
;; 'sd_notify' though), so we're stuck with that.
(start #~(make-forkexec-constructor
(list #$tor "-f" #$torrc)
#:user "tor" #:group "tor"))
(stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action torrc)))
(documentation "Run the Tor anonymous network overlay.")))))
(define (tor-activation config)
"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
(default "default"))
(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
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
#~(begin
(use-modules (guix build utils))
(mkdir-p "/etc/NetworkManager/system-connections")
#$@(if (equal? dns "dnsmasq")
;; create directory to store dnsmasq lease file
'((mkdir-p "/var/lib/misc"))
'())))))
(match-record config <network-manager-configuration>
(network-manager dns vpn-plugins)
#~(begin
(use-modules (guix build utils))
(mkdir-p "/etc/NetworkManager/system-connections")
#$@(if (equal? dns "dnsmasq")
;; create directory to store dnsmasq lease file
'((mkdir-p "/var/lib/misc"))
'()))))
(define (vpn-plugin-directory 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))
accounts))))
(define network-manager-environment
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
;; Define this variable in the global environment such that
;; "nmcli connection import type openvpn file foo.ovpn" works.
`(("NM_VPN_PLUGIN_DIR"
. ,(file-append (vpn-plugin-directory vpn-plugins)
"/lib/NetworkManager/VPN"))))))
(define (network-manager-environment config)
(match-record config <network-manager-configuration>
(network-manager dns vpn-plugins)
;; Define this variable in the global environment such that
;; "nmcli connection import type openvpn file foo.ovpn" works.
`(("NM_VPN_PLUGIN_DIR"
. ,(file-append (vpn-plugin-directory vpn-plugins)
"/lib/NetworkManager/VPN")))))
(define network-manager-shepherd-service
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
(let ((conf (plain-file "NetworkManager.conf"
(string-append "[main]\ndns=" dns "\n")))
(vpn (vpn-plugin-directory vpn-plugins)))
(list (shepherd-service
(documentation "Run the NetworkManager.")
(provision '(networking))
(requirement '(user-processes dbus-system wpa-supplicant loopback))
(start #~(make-forkexec-constructor
(list (string-append #$network-manager
"/sbin/NetworkManager")
(string-append "--config=" #$conf)
"--no-daemon")
#:environment-variables
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"/lib/NetworkManager/VPN")
;; Override non-existent default users
"NM_OPENVPN_USER="
"NM_OPENVPN_GROUP=")))
(stop #~(make-kill-destructor))))))))
(define (network-manager-shepherd-service config)
(match-record config <network-manager-configuration>
(network-manager dns vpn-plugins iwd?)
(let ((conf (plain-file "NetworkManager.conf"
(string-append
"[main]\ndns=" dns "\n"
(if iwd? "[device]\nwifi.backend=iwd\n" ""))))
(vpn (vpn-plugin-directory vpn-plugins)))
(list (shepherd-service
(documentation "Run the NetworkManager.")
(provision '(networking))
(requirement (append '(user-processes dbus-system loopback)
(if iwd? '(iwd) '(wpa-supplicant))))
(start #~(make-forkexec-constructor
(list (string-append #$network-manager
"/sbin/NetworkManager")
(string-append "--config=" #$conf)
"--no-daemon")
#:environment-variables
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"/lib/NetworkManager/VPN")
;; Override non-existent default users
"NM_OPENVPN_USER="
"NM_OPENVPN_GROUP=")))
(stop #~(make-kill-destructor)))))))
(define network-manager-service-type
(let
((config->packages
(match-lambda
(($ <network-manager-configuration> network-manager _ vpn-plugins)
`(,network-manager ,@vpn-plugins)))))
(let ((config->packages
(lambda (config)
(match-record config <network-manager-configuration>
(network-manager vpn-plugins)
`(,network-manager ,@vpn-plugins)))))
(service-type
(name 'network-manager)
@ -1332,9 +1335,8 @@ a network connection manager."))))
(define modem-manager-service-type
(let ((config->package
(match-lambda
(($ <modem-manager-configuration> modem-manager)
(list modem-manager)))))
(lambda (config)
(list (modem-manager-configuration-modem-manager config)))))
(service-type (name 'modem-manager)
(extensions
(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.sh from the usb-modeswitch package, modified to pass the right
config file."
(match config
(($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
(computed-file
"usb_modeswitch.rules"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
(out (string-append #$output "/lib/udev/rules.d"))
(script #$(usb-modeswitch-sh usb-modeswitch config-file)))
(mkdir-p out)
(chdir out)
(install-file in out)
(substitute* "40-usb_modeswitch.rules"
(("PROGRAM=\"usb_modeswitch")
(string-append "PROGRAM=\"" script "/usb_modeswitch"))
(("RUN\\+=\"usb_modeswitch")
(string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
(match-record config <usb-modeswitch-configuration>
(usb-modeswitch usb-modeswitch-data config-file)
(computed-file
"usb_modeswitch.rules"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(let ((in (string-append #$usb-modeswitch-data
"/udev/40-usb_modeswitch.rules"))
(out (string-append #$output "/lib/udev/rules.d"))
(script #$(usb-modeswitch-sh usb-modeswitch config-file)))
(mkdir-p out)
(chdir out)
(install-file in out)
(substitute* "40-usb_modeswitch.rules"
(("PROGRAM=\"usb_modeswitch")
(string-append "PROGRAM=\"" script "/usb_modeswitch"))
(("RUN\\+=\"usb_modeswitch")
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))
(define usb-modeswitch-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
(default '())))
(define wpa-supplicant-shepherd-service
(match-lambda
(($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
interface config-file extra-options)
(list (shepherd-service
(documentation "Run the WPA supplicant daemon")
(provision '(wpa-supplicant))
(requirement (if dbus?
(cons 'dbus-system requirement)
requirement))
(start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant")
(string-append "-P" #$pid-file)
"-B" ;run in background
"-s" ;log to syslogd
#$@(if dbus?
#~("-u")
#~())
#$@(if interface
#~((string-append "-i" #$interface))
#~())
#$@(if config-file
#~((string-append "-c" #$config-file))
#~())
#$@extra-options)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))))
(define (wpa-supplicant-shepherd-service config)
(match-record config <wpa-supplicant-configuration>
(wpa-supplicant requirement pid-file dbus?
interface config-file extra-options)
(list (shepherd-service
(documentation "Run the WPA supplicant daemon")
(provision '(wpa-supplicant))
(requirement (if dbus?
(cons 'dbus-system requirement)
requirement))
(start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant")
(string-append "-P" #$pid-file)
"-B" ;run in background
"-s" ;log to syslogd
#$@(if dbus?
#~("-u")
#~())
#$@(if interface
#~((string-append "-i" #$interface))
#~())
#$@(if config-file
#~((string-append "-c" #$config-file))
#~())
#$@extra-options)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor))))))
(define wpa-supplicant-service-type
(let ((config->package
(match-lambda
(($ <wpa-supplicant-configuration> wpa-supplicant)
(list wpa-supplicant)))))
(lambda (config)
(list (wpa-supplicant-configuration-wpa-supplicant config)))))
(service-type (name 'wpa-supplicant)
(extensions
(list (service-extension shepherd-root-service-type
@ -1621,41 +1623,38 @@ simulation."
(package openvswitch-configuration-package
(default openvswitch)))
(define openvswitch-activation
(match-lambda
(($ <openvswitch-configuration> package)
(let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/openvswitch")
(mkdir-p "/var/lib/openvswitch")
(let ((conf.db "/var/lib/openvswitch/conf.db"))
(unless (file-exists? conf.db)
(system* #$ovsdb-tool "create" conf.db)))))))))
(define (openvswitch-activation config)
(let ((ovsdb-tool (file-append (openvswitch-configuration-package config)
"/bin/ovsdb-tool")))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/openvswitch")
(mkdir-p "/var/lib/openvswitch")
(let ((conf.db "/var/lib/openvswitch/conf.db"))
(unless (file-exists? conf.db)
(system* #$ovsdb-tool "create" conf.db)))))))
(define openvswitch-shepherd-service
(match-lambda
(($ <openvswitch-configuration> package)
(let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
(list
(shepherd-service
(provision '(ovsdb))
(documentation "Run the Open vSwitch database server.")
(start #~(make-forkexec-constructor
(list #$ovsdb-server "--pidfile"
"--remote=punix:/var/run/openvswitch/db.sock")
#:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
(stop #~(make-kill-destructor)))
(shepherd-service
(provision '(vswitchd))
(requirement '(ovsdb))
(documentation "Run the Open vSwitch daemon.")
(start #~(make-forkexec-constructor
(list #$ovs-vswitchd "--pidfile")
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(stop #~(make-kill-destructor))))))))
(define (openvswitch-shepherd-service config)
(let* ((package (openvswitch-configuration-package config))
(ovsdb-server (file-append package "/sbin/ovsdb-server"))
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
(list (shepherd-service
(provision '(ovsdb))
(documentation "Run the Open vSwitch database server.")
(start #~(make-forkexec-constructor
(list #$ovsdb-server "--pidfile"
"--remote=punix:/var/run/openvswitch/db.sock")
#:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
(stop #~(make-kill-destructor)))
(shepherd-service
(provision '(vswitchd))
(requirement '(ovsdb))
(documentation "Run the Open vSwitch daemon.")
(start #~(make-forkexec-constructor
(list #$ovs-vswitchd "--pidfile")
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(stop #~(make-kill-destructor))))))
(define openvswitch-service-type
(service-type
@ -1695,20 +1694,20 @@ COMMIT
(ipv6-rules iptables-configuration-ipv6-rules
(default %iptables-accept-all-rules)))
(define iptables-shepherd-service
(match-lambda
(($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
(let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
(ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
(shepherd-service
(documentation "Packet filtering framework")
(provision '(iptables))
(start #~(lambda _
(invoke #$iptables-restore #$ipv4-rules)
(invoke #$ip6tables-restore #$ipv6-rules)))
(stop #~(lambda _
(invoke #$iptables-restore #$%iptables-accept-all-rules)
(invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
(define (iptables-shepherd-service config)
(match-record config <iptables-configuration>
(iptables ipv4-rules ipv6-rules)
(let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
(ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
(shepherd-service
(documentation "Packet filtering framework")
(provision '(iptables))
(start #~(lambda _
(invoke #$iptables-restore #$ipv4-rules)
(invoke #$ip6tables-restore #$ipv6-rules)))
(stop #~(lambda _
(invoke #$iptables-restore #$%iptables-accept-all-rules)
(invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))
(define iptables-service-type
(service-type
@ -1767,17 +1766,17 @@ table inet filter {
(ruleset nftables-configuration-ruleset ; file-like object
(default %default-nftables-ruleset)))
(define nftables-shepherd-service
(match-lambda
(($ <nftables-configuration> package ruleset)
(let ((nft (file-append package "/sbin/nft")))
(shepherd-service
(documentation "Packet filtering and classification")
(provision '(nftables))
(start #~(lambda _
(invoke #$nft "--file" #$ruleset)))
(stop #~(lambda _
(invoke #$nft "flush" "ruleset"))))))))
(define (nftables-shepherd-service config)
(match-record config <nftables-configuration>
(package ruleset)
(let ((nft (file-append package "/sbin/nft")))
(shepherd-service
(documentation "Packet filtering and classification")
(provision '(nftables))
(start #~(lambda _
(invoke #$nft "--file" #$ruleset)))
(stop #~(lambda _
(invoke #$nft "flush" "ruleset")))))))
(define nftables-service-type
(service-type
@ -2150,23 +2149,22 @@ of the IPFS peer-to-peer storage network.")))
(config-file keepalived-configuration-config-file ;file-like
(default #f)))
(define keepalived-shepherd-service
(match-lambda
(($ <keepalived-configuration> keepalived config-file)
(list
(shepherd-service
(provision '(keepalived))
(documentation "Run keepalived.")
(requirement '(loopback))
(start #~(make-forkexec-constructor
(list (string-append #$keepalived "/sbin/keepalived")
"--dont-fork" "--log-console" "--log-detail"
"--pid=/var/run/keepalived.pid"
(string-append "--use-file=" #$config-file))
#:pid-file "/var/run/keepalived.pid"
#:log-file "/var/log/keepalived.log"))
(respawn? #f)
(stop #~(make-kill-destructor)))))))
(define (keepalived-shepherd-service config)
(match-record config <keepalived-configuration>
(keepalived config-file)
(list (shepherd-service
(provision '(keepalived))
(documentation "Run keepalived.")
(requirement '(loopback))
(start #~(make-forkexec-constructor
(list (string-append #$keepalived "/sbin/keepalived")
"--dont-fork" "--log-console" "--log-detail"
"--pid=/var/run/keepalived.pid"
(string-append "--use-file=" #$config-file))
#:pid-file "/var/run/keepalived.pid"
#:log-file "/var/log/keepalived.log"))
(respawn? #f)
(stop #~(make-kill-destructor))))))
(define %keepalived-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))
(define %base-services/hurd
(list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd)))
(service hurd-getty-service-type (hurd-getty-configuration
(tty "tty1")))
(service hurd-getty-service-type (hurd-getty-configuration
(tty "tty2")))
(service static-networking-service-type
(list %loopback-static-networking
(append (list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd)))
(service static-networking-service-type
(list %loopback-static-networking
;; QEMU user-mode networking. To get "eth0", you need
;; QEMU to emulate a device for which Mach has an
;; in-kernel driver, for instance with:
;; --device rtl8139,netdev=net0 --netdev user,id=net0
%qemu-static-networking))
(syslog-service)
(service guix-service-type
(guix-configuration
(extra-options '("--disable-chroot"
"--disable-deduplication"))))
(service special-files-service-type
`(("/bin/sh" ,(file-append bash "/bin/sh"))
("/usr/bin/env" ,(file-append coreutils "/bin/env"))))))
;; QEMU user-mode networking. To get "eth0", you need
;; QEMU to emulate a device for which Mach has an
;; in-kernel driver, for instance with:
;; --device rtl8139,netdev=net0 --netdev user,id=net0
%qemu-static-networking))
(service guix-service-type
(guix-configuration
(extra-options '("--disable-chroot"
"--disable-deduplication"))))
(service special-files-service-type
`(("/bin/sh" ,(file-append bash "/bin/sh"))
("/usr/bin/env" ,(file-append coreutils
"/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
;; 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.
(append (list console-font-service-type
mingetty-service-type
agetty-service-type
;; Reinstantiated below with smaller caches.
nscd-service-type)
agetty-service-type)
(if shared-network?
;; Replace these with dummy-networking-service-type below.
(list
@ -134,17 +132,13 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(list))))
(define services-to-add
(append
;; Many Guix services depend on a 'networking' shepherd
;; service, so make sure to provide a dummy 'networking'
;; service when we are sure that networking is already set up
;; in the host and can be used. That prevents double setup.
(if shared-network?
(list (service dummy-networking-service-type))
'())
(list
(nscd-service (nscd-configuration
(caches %nscd-container-caches))))))
;; Many Guix services depend on a 'networking' shepherd
;; service, so make sure to provide a dummy 'networking'
;; service when we are sure that networking is already set up
;; in the host and can be used. That prevents double setup.
(if shared-network?
(list (service dummy-networking-service-type))
'()))
(operating-system
(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)
(memq (service-kind service)
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))
(file-systems (append (map mapping->fs
(if shared-network?

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

@ -66,7 +66,9 @@
(replace 'build
(lambda _
(invoke "make" "modules_prepare")))
(delete 'strip) ; faster
(delete 'strip) ;faster
(delete 'build-doc) ;costly and not useful here
(delete 'install-doc)
(replace 'install
(lambda* (#:key inputs #:allow-other-keys)
(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")
("booktabs" "texlive-booktabs")
("freetype2" "freetype")
("sqlite3" "sqlite")
(_ sysname)))
(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
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -104,6 +104,10 @@ error-reporting purposes."
(()
#t)))))))
(define-syntax map-fields
(lambda (x)
(syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
(define-syntax-parameter this-record
(lambda (s)
"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
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)
(syntax-case s (default)
((field (default val) _ ...)
@ -428,10 +441,31 @@ inherited."
field)))
field-spec)))
#`(begin
(define-record-type type
(define-record-type #,(rtd-identifier #'type)
(ctor field ...)
pred
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)
#,cookie)
@ -535,19 +569,50 @@ pairs. Stop upon an empty line (after consuming it) or EOF."
(else
(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
(syntax-rules ()
"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."
((_ record type (field fields ...) body ...)
;; TODO support thunked and delayed fields
((_ record type (fields ...) body ...)
(if (eq? (struct-vtable record) type)
;; TODO compute indices and report wrong-field-name errors at
;; expansion time
;; 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 ...))))
(match-record-inner record type (fields ...) body ...)
(throw 'wrong-type-arg record)))))
;;; records.scm ends here

33
tests/records.scm
View File

@ -528,4 +528,37 @@ Description: 1st line,
'("a" "b" "c")
'("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)