mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
Merge branch 'master' into staging
This commit is contained in:
commit
827b4117da
79 changed files with 3692 additions and 498 deletions
|
@ -533,6 +533,7 @@ SCM_TESTS = \
|
|||
tests/services.scm \
|
||||
tests/services/file-sharing.scm \
|
||||
tests/services/configuration.scm \
|
||||
tests/services/lightdm.scm \
|
||||
tests/services/linux.scm \
|
||||
tests/services/telephony.scm \
|
||||
tests/sets.scm \
|
||||
|
|
|
@ -320,15 +320,25 @@ s-expression, etc.
|
|||
@cindex reducing boilerplate
|
||||
We also provide templates for common git commit messages and package
|
||||
definitions in the @file{etc/snippets} directory. These templates can
|
||||
be used with @url{https://joaotavora.github.io/yasnippet/, YASnippet} to
|
||||
expand short trigger strings to interactive text snippets. You may want
|
||||
to add the snippets directory to the @var{yas-snippet-dirs} variable in
|
||||
be used to expand short trigger strings to interactive text snippets. If
|
||||
you use @url{https://joaotavora.github.io/yasnippet/, YASnippet}, you
|
||||
may want to add the @file{etc/snippets/yas} snippets directory to the
|
||||
@var{yas-snippet-dirs} variable. If you use
|
||||
@url{https://github.com/minad/tempel/, Tempel}, you may want to add the
|
||||
@file{etc/snippets/tempel/*} path to the @var{tempel-path} variable in
|
||||
Emacs.
|
||||
|
||||
@lisp
|
||||
;; @r{Assuming the Guix checkout is in ~/src/guix.}
|
||||
;; @r{Yasnippet configuration}
|
||||
(with-eval-after-load 'yasnippet
|
||||
(add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets"))
|
||||
(add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets/yas"))
|
||||
;; @r{Tempel configuration}
|
||||
(with-eval-after-load 'tempel
|
||||
;; Ensure tempel-path is a list -- it may also be a string.
|
||||
(unless (listp 'tempel-path)
|
||||
(setq tempel-path (list tempel-path)))
|
||||
(add-to-list 'tempel-path "~/src/guix/etc/snippets/tempel/*"))
|
||||
@end lisp
|
||||
|
||||
The commit message snippets depend on @url{https://magit.vc/, Magit} to
|
||||
|
|
465
doc/guix.texi
465
doc/guix.texi
|
@ -21278,6 +21278,208 @@ Relogin after logout.
|
|||
@end table
|
||||
@end deftp
|
||||
|
||||
@cindex lightdm, graphical login manager
|
||||
@cindex display manager, lightdm
|
||||
@defvr {Scheme Variable} lightdm-service-type
|
||||
This is the type of the service to run the
|
||||
@url{https://github.com/canonical/lightdm,LightDM display manager}. Its
|
||||
value must be a @code{lightdm-configuration} record, which is documented
|
||||
below. Among its distinguishing features are TigerVNC integration for
|
||||
easily remoting your desktop as well as support for the XDMCP protocol,
|
||||
which can be used by remote clients to start a session from the login
|
||||
manager.
|
||||
|
||||
In its most basic form, it can be used simply as:
|
||||
|
||||
@lisp
|
||||
(service lightdm-service-type)
|
||||
@end lisp
|
||||
|
||||
A more elaborate example making use of the VNC capabilities and enabling
|
||||
more features and verbose logs could look like:
|
||||
|
||||
@lisp
|
||||
(service lightdm-service-type
|
||||
(lightdm-configuration
|
||||
(allow-empty-passwords? #t)
|
||||
(xdmcp? #t)
|
||||
(vnc-server? #t)
|
||||
(vnc-server-command
|
||||
(file-append tigervnc-server "/bin/Xvnc"
|
||||
" -SecurityTypes None"))
|
||||
(seats
|
||||
(list (lightdm-seat-configuration
|
||||
(name "*")
|
||||
(user-session "ratpoison"))))))
|
||||
@end lisp
|
||||
@end defvr
|
||||
|
||||
@c The LightDM service documentation can be auto-generated via the
|
||||
@c 'generate-doc' procedure at the bottom of the (gnu services lightdm)
|
||||
@c module.
|
||||
@c %start of fragment
|
||||
@deftp {Data Type} lightdm-configuration
|
||||
Available @code{lightdm-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{lightdm} (default: @code{lightdm}) (type: file-like)
|
||||
The lightdm package to use.
|
||||
|
||||
@item @code{allow-empty-passwords?} (default: @code{#f}) (type: boolean)
|
||||
Whether users not having a password set can login.
|
||||
|
||||
@item @code{debug?} (default: @code{#f}) (type: boolean)
|
||||
Enable verbose output.
|
||||
|
||||
@item @code{xorg-configuration} (type: xorg-configuration)
|
||||
The default Xorg server configuration to use to generate the Xorg server
|
||||
start script. It can be refined per seat via the @code{xserver-command}
|
||||
of the @code{<lightdm-seat-configuration>} record, if desired.
|
||||
|
||||
@item @code{greeters} (type: list-of-greeter-configurations)
|
||||
The LightDM greeter configurations specifying the greeters to use.
|
||||
|
||||
@item @code{seats} (type: list-of-seat-configurations)
|
||||
The seat configurations to use. A LightDM seat is akin to a user.
|
||||
|
||||
@item @code{xdmcp?} (default: @code{#f}) (type: boolean)
|
||||
Whether a XDMCP server should listen on port UDP 177.
|
||||
|
||||
@item @code{xdmcp-listen-address} (type: maybe-string)
|
||||
The host or IP address the XDMCP server listens for incoming
|
||||
connections. When unspecified, listen on for any hosts/IP addresses.
|
||||
|
||||
@item @code{vnc-server?} (default: @code{#f}) (type: boolean)
|
||||
Whether a VNC server is started.
|
||||
|
||||
@item @code{vnc-server-command} (type: file-like)
|
||||
The Xvnc command to use for the VNC server, it's possible to provide
|
||||
extra options not otherwise exposed along the command, for example to
|
||||
disable security:
|
||||
|
||||
@lisp
|
||||
(vnc-server-command (file-append tigervnc-server "/bin/Xvnc"
|
||||
" -SecurityTypes None" ))
|
||||
@end lisp
|
||||
|
||||
Or to set a PasswordFile for the classic (unsecure) VncAuth
|
||||
mecanism:
|
||||
|
||||
@lisp
|
||||
(vnc-server-command (file-append tigervnc-server "/bin/Xvnc"
|
||||
" -PasswordFile /var/lib/lightdm/.vnc/passwd"))
|
||||
@end lisp
|
||||
|
||||
The password file should be manually created using the
|
||||
@command{vncpasswd} command. Note that LightDM will create new sessions
|
||||
for VNC users, which means they need to authenticate in the same way as
|
||||
local users would.
|
||||
|
||||
@item @code{vnc-server-listen-address} (type: maybe-string)
|
||||
The host or IP address the VNC server listens for incoming connections.
|
||||
When unspecified, listen for any hosts/IP addresses.
|
||||
|
||||
@item @code{vnc-server-port} (default: @code{5900}) (type: number)
|
||||
The TCP port the VNC server should listen to.
|
||||
|
||||
@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
|
||||
Extra configuration values to append to the LightDM configuration file.
|
||||
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
|
||||
@c %end of fragment
|
||||
@c %start of fragment
|
||||
|
||||
@deftp {Data Type} lightdm-gtk-greeter-configuration
|
||||
Available @code{lightdm-gtk-greeter-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
|
||||
The lightdm-gtk-greeter package to use.
|
||||
|
||||
@item @code{assets} @
|
||||
(default: @code{(adwaita-icon-theme gnome-themes-extrahicolor-icon-theme)}) @
|
||||
(type: list-of-file-likes)
|
||||
The list of packages complementing the greeter, such as package
|
||||
providing icon themes.
|
||||
|
||||
@item @code{theme-name} (default: @code{"Adwaita"}) (type: string)
|
||||
The name of the theme to use.
|
||||
|
||||
@item @code{icon-theme-name} (default: @code{"Adwaita"}) (type: string)
|
||||
The name of the icon theme to use.
|
||||
|
||||
@item @code{cursor-theme-name} (default: @code{"Adwaita"}) (type: string)
|
||||
The name of the cursor theme to use.
|
||||
|
||||
@item @code{cursor-theme-size} (default: @code{16}) (type: number)
|
||||
The size to use for the the cursor theme.
|
||||
|
||||
@item @code{allow-debugging?} (type: maybe-boolean)
|
||||
Set to #t to enable debug log level.
|
||||
|
||||
@item @code{background} (type: file-like)
|
||||
The background image to use.
|
||||
|
||||
@item @code{at-spi-enabled?} (default: @code{#f}) (type: boolean)
|
||||
Enable accessibility support through the Assistive Technology Service
|
||||
Provider Interface (AT-SPI).
|
||||
|
||||
@item @code{a11y-states} @
|
||||
(default: @code{(contrast font keyboard reader)}) (type: list-of-a11y-states)
|
||||
The accessibility features to enable, given as list of symbols.
|
||||
|
||||
@item @code{reader} (type: maybe-file-like)
|
||||
The command to use to launch a screen reader.
|
||||
|
||||
@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
|
||||
Extra configuration values to append to the LightDM GTK Greeter
|
||||
configuration file.
|
||||
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
@c %end of fragment
|
||||
@c %start of fragment
|
||||
|
||||
@deftp {Data Type} lightdm-seat-configuration
|
||||
Available @code{lightdm-seat-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{name} (type: seat-name)
|
||||
The name of the seat. An asterisk (*) can be used in the name to apply
|
||||
the seat configuration to all the seat names it matches.
|
||||
|
||||
@item @code{user-session} (type: maybe-string)
|
||||
The session to use by default. The session name must be provided as a
|
||||
lowercase string, such as @code{"gnome"}, @code{"ratpoison"}, etc.
|
||||
|
||||
@item @code{type} (default: @code{local}) (type: seat-type)
|
||||
The type of the seat, either the @code{local} or @code{xremote} symbol.
|
||||
|
||||
@item @code{autologin-user} (type: maybe-string)
|
||||
The username to automatically log in with by default.
|
||||
|
||||
@item @code{greeter-session} @
|
||||
(default: @code{lightdm-gtk-greeter}) (type: greeter-session)
|
||||
The greeter session to use, specified as a symbol. Currently, only
|
||||
@code{lightdm-gtk-greeter} is supported.
|
||||
|
||||
@item @code{xserver-command} (type: maybe-file-like)
|
||||
The Xorg server command to run.
|
||||
|
||||
@item @code{session-wrapper} (type: file-like)
|
||||
The xinitrc session wrapper to use.
|
||||
|
||||
@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
|
||||
Extra configuration values to append to the seat configuration section.
|
||||
|
||||
@end table
|
||||
@end deftp
|
||||
@c %end of fragment
|
||||
|
||||
|
||||
@cindex Xorg, configuration
|
||||
@deftp {Data Type} xorg-configuration
|
||||
|
@ -36311,6 +36513,255 @@ Extra command line options for @code{nix-service-type}.
|
|||
@end table
|
||||
@end deftp
|
||||
|
||||
@cindex Fail2Ban
|
||||
@subsubheading Fail2Ban service
|
||||
|
||||
@uref{http://www.fail2ban.org/, @code{fail2ban}} scans log files
|
||||
(e.g. @code{/var/log/apache/error_log}) and bans IP addresses that show
|
||||
malicious signs -- repeated password failures, attempts to make use of
|
||||
exploits, etc.
|
||||
|
||||
@code{fail2ban-service-type} service type is provided by the @code{(gnu
|
||||
services security)} module.
|
||||
|
||||
This service type runs the @code{fail2ban} daemon. It can be configured
|
||||
in various ways, which are:
|
||||
|
||||
@table @asis
|
||||
@item Basic configuration
|
||||
The basic parameters of the Fail2Ban service can be configured via its
|
||||
@code{fail2ban} configuration, which is documented below.
|
||||
|
||||
@item User-specified jail extensions
|
||||
The @code{fail2ban-jail-service} function can be used to add new
|
||||
Fail2Ban jails.
|
||||
|
||||
@item Shepherd extension mechanism
|
||||
Service developers can extend the @code{fail2ban-service-type} service
|
||||
type itself via the usual service extension mechanism.
|
||||
@end table
|
||||
|
||||
@defvr {Scheme Variable} fail2ban-service-type
|
||||
|
||||
This is the type of the service that runs @code{fail2ban} daemon. Below
|
||||
is an example of a basic, explicit configuration:
|
||||
|
||||
@lisp
|
||||
(append
|
||||
(list
|
||||
(service fail2ban-service-type
|
||||
(fail2ban-configuration
|
||||
(extra-jails
|
||||
(list
|
||||
(fail2ban-jail-configuration
|
||||
(name "sshd")
|
||||
(enabled #t))))))
|
||||
;; There is no implicit dependency on an actual SSH
|
||||
;; service, so you need to provide one.
|
||||
(service openssh-service-type))
|
||||
%base-services)
|
||||
@end lisp
|
||||
@end defvr
|
||||
|
||||
@deffn {Scheme Procedure} fail2ban-jail-service @var{svc-type} @var{jail}
|
||||
Extend @var{svc-type}, a @code{<service-type>} object with @var{jail}, a
|
||||
@code{fail2ban-jail-configuration} object.
|
||||
|
||||
For example:
|
||||
|
||||
@lisp
|
||||
(append
|
||||
(list
|
||||
(service
|
||||
;; The 'fail2ban-jail-service' procedure can extend any service type
|
||||
;; with a fail2ban jail. This removes the requirement to explicitly
|
||||
;; extend services with fail2ban-service-type.
|
||||
(fail2ban-jail-service
|
||||
openssh-service-type
|
||||
(fail2ban-jail-configuration
|
||||
(name "sshd")
|
||||
(enabled #t)))
|
||||
(openssh-configuration ...))))
|
||||
@end lisp
|
||||
@end deffn
|
||||
|
||||
Below is the reference for the different @code{jail-service-type}
|
||||
configuration records.
|
||||
|
||||
@c The documentation is to be auto-generated via
|
||||
@c 'generate-documentation'. See at the bottom of (gnu services
|
||||
@c security).
|
||||
|
||||
@deftp {Data Type} fail2ban-configuration
|
||||
Available @code{fail2ban-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{fail2ban} (default: @code{fail2ban}) (type: package)
|
||||
The @code{fail2ban} package to use. It is used for both binaries and as
|
||||
base default configuration that is to be extended with
|
||||
@code{<fail2ban-jail-configuration>} objects.
|
||||
|
||||
@item @code{run-directory} (default: @code{"/var/run/fail2ban"}) (type: string)
|
||||
The state directory for the @code{fail2ban} daemon.
|
||||
|
||||
@item @code{jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations)
|
||||
Instances of @code{<fail2ban-jail-configuration>} collected from
|
||||
extensions.
|
||||
|
||||
@item @code{extra-jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations)
|
||||
Instances of @code{<fail2ban-jail-configuration>} explicitly provided.
|
||||
|
||||
@item @code{extra-content} (type: maybe-string)
|
||||
Extra raw content to add to the end of the @file{jail.local} file.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@deftp {Data Type} fail2ban-ignore-cache-configuration
|
||||
Available @code{fail2ban-ignore-cache-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{key} (type: string)
|
||||
Cache key.
|
||||
|
||||
@item @code{max-count} (type: integer)
|
||||
Cache size.
|
||||
|
||||
@item @code{max-time} (type: integer)
|
||||
Cache time.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@deftp {Data Type} fail2ban-jail-action-configuration
|
||||
Available @code{fail2ban-jail-action-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{name} (type: string)
|
||||
Action name.
|
||||
|
||||
@item @code{arguments} (default: @code{()}) (type: list-of-arguments)
|
||||
Action arguments.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@deftp {Data Type} fail2ban-jail-configuration
|
||||
Available @code{fail2ban-jail-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{name} (type: string)
|
||||
Required name of this jail configuration.
|
||||
|
||||
@item @code{enabled?} (default: @code{#t}) (type: boolean)
|
||||
Whether this jail is enabled.
|
||||
|
||||
@item @code{backend} (type: maybe-symbol)
|
||||
Backend to use to detect changes in the @code{ogpath}. The default is
|
||||
'auto. To consult the defaults of the jail configuration, refer to the
|
||||
@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package.
|
||||
|
||||
@item @code{max-retry} (type: maybe-integer)
|
||||
The number of failures before a host get banned (e.g. @code{(max-retry
|
||||
5)}).
|
||||
|
||||
@item @code{max-matches} (type: maybe-integer)
|
||||
The number of matches stored in ticket (resolvable via tag
|
||||
@code{<matches>}) in action.
|
||||
|
||||
@item @code{find-time} (type: maybe-string)
|
||||
The time window during which the maximum retry count must be reached for
|
||||
an IP address to be banned. A host is banned if it has generated
|
||||
@code{max-retry} during the last @code{find-time} seconds (e.g.
|
||||
@code{(find-time "10m")}). It can be provided in seconds or using
|
||||
Fail2Ban's "time abbreviation format", as described in @command{man 5
|
||||
jail.conf}.
|
||||
|
||||
@item @code{ban-time} (type: maybe-string)
|
||||
The duration, in seconds or time abbreviated format, that a ban should
|
||||
last. (e.g. @code{(ban-time "10m")}).
|
||||
|
||||
@item @code{ban-time-increment?} (type: maybe-boolean)
|
||||
Whether to consider past bans to compute increases to the default ban
|
||||
time of a specific IP address.
|
||||
|
||||
@item @code{ban-time-factor} (type: maybe-string)
|
||||
The coefficient to use to compute an exponentially growing ban time.
|
||||
|
||||
@item @code{ban-time-formula} (type: maybe-string)
|
||||
This is the formula used to calculate the next value of a ban time.
|
||||
|
||||
@item @code{ban-time-multipliers} (type: maybe-string)
|
||||
Used to calculate next value of ban time instead of formula.
|
||||
|
||||
@item @code{ban-time-max-time} (type: maybe-string)
|
||||
The maximum number of seconds a ban should last.
|
||||
|
||||
@item @code{ban-time-rnd-time} (type: maybe-string)
|
||||
The maximum number of seconds a randomized ban time should last. This
|
||||
can be useful to stop ``clever'' botnets calculating the exact time an
|
||||
IP address can be unbanned again.
|
||||
|
||||
@item @code{ban-time-overall-jails?} (type: maybe-boolean)
|
||||
When true, it specifies the search of an IP address in the database
|
||||
should be made across all jails. Otherwise, only the current jail of
|
||||
the ban IP address is considered.
|
||||
|
||||
@item @code{ignore-self?} (type: maybe-boolean)
|
||||
Never ban the local machine's own IP address.
|
||||
|
||||
@item @code{ignore-ip} (default: @code{()}) (type: list-of-strings)
|
||||
A list of IP addresses, CIDR masks or DNS hosts to ignore.
|
||||
@code{fail2ban} will not ban a host which matches an address in this
|
||||
list.
|
||||
|
||||
@item @code{ignore-cache} (type: maybe-fail2ban-ignore-cache-configuration)
|
||||
Provide cache parameters for the ignore failure check.
|
||||
|
||||
@item @code{filter} (type: maybe-fail2ban-jail-filter-configuration)
|
||||
The filter to use by the jail, specified via a
|
||||
@code{<fail2ban-jail-filter-configuration>} object. By default, jails
|
||||
have names matching their filter name.
|
||||
|
||||
@item @code{log-time-zone} (type: maybe-string)
|
||||
The default time zone for log lines that do not have one.
|
||||
|
||||
@item @code{log-encoding} (type: maybe-symbol)
|
||||
The encoding of the log files handled by the jail. Possible values are:
|
||||
@code{'ascii}, @code{'utf-8} and @code{'auto}.
|
||||
|
||||
@item @code{log-path} (default: @code{()}) (type: list-of-strings)
|
||||
The file names of the log files to be monitored.
|
||||
|
||||
@item @code{action} (default: @code{()}) (type: list-of-fail2ban-jail-actions)
|
||||
A list of @code{<fail2ban-jail-action-configuration>}.
|
||||
|
||||
@item @code{extra-content} (type: maybe-string)
|
||||
Extra content for the jail configuration.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@deftp {Data Type} fail2ban-jail-filter-configuration
|
||||
Available @code{fail2ban-jail-filter-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{name} (type: string)
|
||||
Filter to use.
|
||||
|
||||
@item @code{mode} (type: maybe-string)
|
||||
Mode for filter.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
@c End of auto-generated fail2ban documentation.
|
||||
|
||||
@node Setuid Programs
|
||||
@section Setuid Programs
|
||||
|
||||
|
@ -36988,6 +37439,15 @@ corresponds to COM1 (@pxref{Serial terminal,,, grub,GNU GRUB manual}).
|
|||
The speed of the serial interface, as an integer. For GRUB, the
|
||||
default value is chosen at run-time; currently GRUB chooses
|
||||
9600@tie{}bps (@pxref{Serial terminal,,, grub,GNU GRUB manual}).
|
||||
|
||||
@item @code{device-tree-support?} (default: @code{#t})
|
||||
Whether to support Linux @uref{https://en.wikipedia.org/wiki/Devicetree,
|
||||
device tree} files loading.
|
||||
|
||||
This option in enabled by default. In some cases involving the
|
||||
@code{u-boot} bootloader, where the device tree has already been loaded
|
||||
in RAM, it can be handy to disable the option by setting it to
|
||||
@code{#f}.
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
@ -37561,6 +38021,11 @@ Installation Image}).
|
|||
Attempt to build for @var{system} instead of the host system type.
|
||||
This works as per @command{guix build} (@pxref{Invoking guix build}).
|
||||
|
||||
@item --target=@var{triplet}
|
||||
Cross-build for @var{triplet}, which must be a valid GNU triplet, such
|
||||
as @code{"aarch64-linux-gnu"} (@pxref{Specifying target triplets, GNU
|
||||
configuration triplets,, autoconf, Autoconf}).
|
||||
|
||||
@item --derivation
|
||||
@itemx -d
|
||||
Return the derivation file name of the given operating system without
|
||||
|
|
89
etc/snippets/tempel/scheme-mode
Normal file
89
etc/snippets/tempel/scheme-mode
Normal file
|
@ -0,0 +1,89 @@
|
|||
-*- mode: lisp-data -*-
|
||||
|
||||
scheme-mode
|
||||
|
||||
(package...
|
||||
"(define-public " (s name)
|
||||
n> "(package"
|
||||
n > "(name \"" (s name) "\")"
|
||||
n > "(version \"" p "\")"
|
||||
n > "(source origin...)"
|
||||
n > "(build-system " (p "gnu") "-build-system)"
|
||||
n > "(home-page \"" p "\")"
|
||||
n > "(synopsis \"" p "\")"
|
||||
n > "(description \"" p "\")"
|
||||
n > "(license license:" (p "unknown") ")))" n)
|
||||
|
||||
(origin...
|
||||
"(origin"
|
||||
n> "(method " (p "url-fetch" method) ")"
|
||||
n> "(uri " (cl-case (and method (intern method))
|
||||
('git-fetch "git-reference...")
|
||||
('svn-fetch "svn-reference...")
|
||||
('hg-fetch "hg-reference...")
|
||||
('cvs-fetch "cvs-reference...")
|
||||
('bzr-fetch "bzr-reference...")
|
||||
(t "\"https://...\""))
|
||||
")"
|
||||
n>
|
||||
(cl-case (and method (intern method))
|
||||
('git-fetch
|
||||
(insert "(file-name (git-file-name name version))")
|
||||
(newline)
|
||||
(indent-according-to-mode))
|
||||
('hg-fetch
|
||||
(insert "(file-name (hg-file-name name version))")
|
||||
(newline)
|
||||
(indent-according-to-mode))
|
||||
('svn-fetch
|
||||
(insert "(file-name (string-append name \"-\" version \"-checkout\"))")
|
||||
(newline)
|
||||
(indent-according-to-mode))
|
||||
('cvs-fetch
|
||||
(insert "(file-name (string-append name \"-\" version \"-checkout\"))")
|
||||
(newline)
|
||||
(indent-according-to-mode))
|
||||
('bzr-fetch
|
||||
(insert "(file-name (string-append name \"-\" version \"-checkout\"))")
|
||||
(newline)
|
||||
(indent-according-to-mode))
|
||||
(t ""))
|
||||
> "(sha256"
|
||||
n > "(base32 \""
|
||||
;; hash of an empty directory
|
||||
(p "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5") "\")))")
|
||||
|
||||
(git-reference...
|
||||
"(git-reference"
|
||||
n> "(url \"" p "\")"
|
||||
n> "(commit \"" p "\"))")
|
||||
|
||||
(svn-reference...
|
||||
"(svn-reference"
|
||||
n> "(url \"" p "\")"
|
||||
n> "(revision \"" p "\"))")
|
||||
|
||||
(cvs-reference...
|
||||
"(cvs-reference"
|
||||
n> "(root-directory \"" p "\")"
|
||||
n> "(module \"" p "\")"
|
||||
n> "(revision \"" p "\"))")
|
||||
|
||||
(hg-reference...
|
||||
"(hg-reference"
|
||||
n> "(url \"" p "\")"
|
||||
n> "(changeset \"" p "\"))")
|
||||
|
||||
(bzr-reference...
|
||||
"(bzr-reference"
|
||||
n> "(url \"" p "\")"
|
||||
n> "(revision \"" p "\"))")
|
||||
|
||||
(:phases\ "#:phases (modify-phases %standard-phases"
|
||||
n> p ")")
|
||||
|
||||
(add-before\ "(add-before '" p " '" p
|
||||
n > p ")")
|
||||
(add-after\ "(add-after '" p " '" p
|
||||
n > p ")")
|
||||
(replace\ "(replace '" p " " p")")
|
101
etc/snippets/tempel/text-mode
Normal file
101
etc/snippets/tempel/text-mode
Normal file
|
@ -0,0 +1,101 @@
|
|||
-*- mode: lisp-data -*-
|
||||
|
||||
text-mode :when (and (fboundp 'git-commit-mode) (git-commit-mode))
|
||||
|
||||
(add\
|
||||
"gnu: Add "
|
||||
(p
|
||||
(with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "\\+(define-public \\(\\S-+\\)" nil 'noerror)
|
||||
(match-string-no-properties 1)))
|
||||
var ) "." n n
|
||||
"* " (car (magit-staged-files)) " (" (s var ) "): New variable.")
|
||||
|
||||
(remove\
|
||||
"gnu: Remove "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "\\-(define-public \\(\\S-+\\)" nil 'noerror)
|
||||
(match-string-no-properties 1)))
|
||||
var) "." n n
|
||||
"* " (car (magit-staged-files)) " (" (s var) "): Delete variable.")
|
||||
|
||||
(rename\
|
||||
"gnu: "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(beginning-of-buffer)
|
||||
(when (search-forward "-(define-public " nil 'noerror)
|
||||
(thing-at-point 'sexp 'no-properties)))
|
||||
prev-var)
|
||||
": Rename package to "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(beginning-of-buffer)
|
||||
(when (search-forward "+(define-public " nil 'noerror)
|
||||
(thing-at-point 'sexp 'no-properties)))
|
||||
new-var) "." n n
|
||||
"* " (car (magit-staged-files)) " (" (s prev-var) "): Define in terms of" n
|
||||
"'deprecated-package'." n
|
||||
"(" (s new-var) "): New variable, formerly known as \"" (s prev-var) "\".")
|
||||
|
||||
(update\
|
||||
"gnu: "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)" nil 'noerror)
|
||||
(match-string-no-properties 1)))
|
||||
var)
|
||||
": Update to "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(goto-char (point-min))
|
||||
(search-forward "name" nil 'noerror)
|
||||
(search-forward "+" nil 'noerror) ; first change
|
||||
(when (and (search-forward "version " nil 'noerror)
|
||||
(looking-at-p "\""))
|
||||
(let ((end (save-excursion (search-forward "\")" nil 'noerror))))
|
||||
(when end
|
||||
(forward-char)
|
||||
(buffer-substring-no-properties (point) (- end 2))))))
|
||||
version) "." n n
|
||||
"* " (car (magit-staged-files)) " (" (s var) "): Update to " (s version) "."
|
||||
(mapconcat (lambda (file) (concat "* " file)) (cdr (magit-staged-files))) n)
|
||||
|
||||
(addcl\
|
||||
"gnu: Add cl-"
|
||||
(p (replace-regexp-in-string
|
||||
"^cl-" "" (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(beginning-of-buffer)
|
||||
(when (search-forward "+(define-public " nil 'noerror)
|
||||
(replace-regexp-in-string
|
||||
"^sbcl-" ""
|
||||
(thing-at-point 'sexp 'no-properties)))))
|
||||
var) "." n n
|
||||
"* " (car (magit-staged-files))
|
||||
" (cl-" (s var) ", ecl-" (s var) ", sbcl-" (s var) "): New variables.")
|
||||
|
||||
(https\
|
||||
"gnu: "
|
||||
(p (with-temp-buffer
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"diff" "--staged")
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)" nil 'noerror)
|
||||
(match-string-no-properties 1)))
|
||||
var)
|
||||
": Use HTTPS home page." n n
|
||||
"* " (car (magit-staged-files)) " (" (s var) ")[home-page]: Use HTTPS." n
|
||||
(mapconcat (lambda (file) (concat "* " file)) (cdr (magit-staged-files))) n)
|
|
@ -11,6 +11,7 @@
|
|||
"ant-build-system"
|
||||
"asdf-build-system"
|
||||
"cargo-build-system"
|
||||
"chicken-build-system"
|
||||
"clojure-build-system"
|
||||
"cmake-build-system"
|
||||
"copy-build-system"
|
||||
|
@ -27,6 +28,7 @@
|
|||
"linux-module-build-system"
|
||||
"maven-build-system"
|
||||
"meson-build-system"
|
||||
"minetest-build-system"
|
||||
"minify-build-system"
|
||||
"node-build-system"
|
||||
"ocaml-build-system"
|
||||
|
@ -35,6 +37,8 @@
|
|||
"qt-build-system"
|
||||
"r-build-system"
|
||||
"rakudo-build-system"
|
||||
"rebar-build-system"
|
||||
"renpy-build-system"
|
||||
"ruby-build-system"
|
||||
"scons-build-system"
|
||||
"texlive-build-system"
|
|
@ -1,9 +1,11 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2017 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe <othacehe@gnu.org>
|
||||
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
|
||||
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -21,6 +23,8 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu bootloader)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system uuid)
|
||||
#:use-module (guix discovery)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix profiles)
|
||||
|
@ -69,6 +73,7 @@ (define-module (gnu bootloader)
|
|||
bootloader-configuration-terminal-inputs
|
||||
bootloader-configuration-serial-unit
|
||||
bootloader-configuration-serial-speed
|
||||
bootloader-configuration-device-tree-support?
|
||||
|
||||
%bootloaders
|
||||
lookup-bootloader-by-name
|
||||
|
@ -104,12 +109,19 @@ (define-record-type* <menu-entry>
|
|||
|
||||
(define (menu-entry->sexp entry)
|
||||
"Return ENTRY serialized as an sexp."
|
||||
(define (device->sexp device)
|
||||
(match device
|
||||
((? uuid? uuid)
|
||||
`(uuid ,(uuid-type uuid) ,(uuid->string uuid)))
|
||||
((? file-system-label? label)
|
||||
`(label ,(file-system-label->string label)))
|
||||
(_ device)))
|
||||
(match entry
|
||||
(($ <menu-entry> label device mount-point linux linux-arguments initrd #f
|
||||
())
|
||||
`(menu-entry (version 0)
|
||||
(label ,label)
|
||||
(device ,device)
|
||||
(device ,(device->sexp device))
|
||||
(device-mount-point ,mount-point)
|
||||
(linux ,linux)
|
||||
(linux-arguments ,linux-arguments)
|
||||
|
@ -118,7 +130,7 @@ (define (menu-entry->sexp entry)
|
|||
multiboot-kernel multiboot-arguments multiboot-modules)
|
||||
`(menu-entry (version 0)
|
||||
(label ,label)
|
||||
(device ,device)
|
||||
(device ,(device->sexp device))
|
||||
(device-mount-point ,mount-point)
|
||||
(multiboot-kernel ,multiboot-kernel)
|
||||
(multiboot-arguments ,multiboot-arguments)
|
||||
|
@ -127,6 +139,13 @@ (define (menu-entry->sexp entry)
|
|||
(define (sexp->menu-entry sexp)
|
||||
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
|
||||
record."
|
||||
(define (sexp->device device-sexp)
|
||||
(match device-sexp
|
||||
(('uuid type uuid-string)
|
||||
(uuid uuid-string type))
|
||||
(('label label)
|
||||
(file-system-label label))
|
||||
(_ device-sexp)))
|
||||
(match sexp
|
||||
(('menu-entry ('version 0)
|
||||
('label label) ('device device)
|
||||
|
@ -135,7 +154,7 @@ (define (sexp->menu-entry sexp)
|
|||
('initrd initrd) _ ...)
|
||||
(menu-entry
|
||||
(label label)
|
||||
(device device)
|
||||
(device (sexp->device device))
|
||||
(device-mount-point mount-point)
|
||||
(linux linux)
|
||||
(linux-arguments linux-arguments)
|
||||
|
@ -148,7 +167,7 @@ (define (sexp->menu-entry sexp)
|
|||
('multiboot-modules multiboot-modules) _ ...)
|
||||
(menu-entry
|
||||
(label label)
|
||||
(device device)
|
||||
(device (sexp->device device))
|
||||
(device-mount-point mount-point)
|
||||
(multiboot-kernel multiboot-kernel)
|
||||
(multiboot-arguments multiboot-arguments)
|
||||
|
@ -193,29 +212,33 @@ (define-with-syntax-properties (warn-target-field-deprecation
|
|||
(define-record-type* <bootloader-configuration>
|
||||
bootloader-configuration make-bootloader-configuration
|
||||
bootloader-configuration?
|
||||
(bootloader bootloader-configuration-bootloader) ;<bootloader>
|
||||
(targets %bootloader-configuration-targets ;list of strings
|
||||
(default #f))
|
||||
(target %bootloader-configuration-target ;deprecated
|
||||
(default #f) (sanitize warn-target-field-deprecation))
|
||||
(menu-entries bootloader-configuration-menu-entries ;list of <menu-entry>
|
||||
(default '()))
|
||||
(default-entry bootloader-configuration-default-entry ;integer
|
||||
(default 0))
|
||||
(timeout bootloader-configuration-timeout ;seconds as integer
|
||||
(default 5))
|
||||
(keyboard-layout bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
|
||||
(default #f))
|
||||
(theme bootloader-configuration-theme ;bootloader-specific theme
|
||||
(default #f))
|
||||
(terminal-outputs bootloader-configuration-terminal-outputs ;list of symbols
|
||||
(default '(gfxterm)))
|
||||
(terminal-inputs bootloader-configuration-terminal-inputs ;list of symbols
|
||||
(default '()))
|
||||
(serial-unit bootloader-configuration-serial-unit ;integer | #f
|
||||
(default #f))
|
||||
(serial-speed bootloader-configuration-serial-speed ;integer | #f
|
||||
(default #f)))
|
||||
(bootloader
|
||||
bootloader-configuration-bootloader) ;<bootloader>
|
||||
(targets %bootloader-configuration-targets
|
||||
(default #f)) ;list of strings
|
||||
(target %bootloader-configuration-target ;deprecated
|
||||
(default #f)
|
||||
(sanitize warn-target-field-deprecation))
|
||||
(menu-entries bootloader-configuration-menu-entries
|
||||
(default '())) ;list of <menu-entry>
|
||||
(default-entry bootloader-configuration-default-entry
|
||||
(default 0)) ;integer
|
||||
(timeout bootloader-configuration-timeout
|
||||
(default 5)) ;seconds as integer
|
||||
(keyboard-layout bootloader-configuration-keyboard-layout
|
||||
(default #f)) ;<keyboard-layout> | #f
|
||||
(theme bootloader-configuration-theme
|
||||
(default #f)) ;bootloader-specific theme
|
||||
(terminal-outputs bootloader-configuration-terminal-outputs
|
||||
(default '(gfxterm))) ;list of symbols
|
||||
(terminal-inputs bootloader-configuration-terminal-inputs
|
||||
(default '())) ;list of symbols
|
||||
(serial-unit bootloader-configuration-serial-unit
|
||||
(default #f)) ;integer | #f
|
||||
(serial-speed bootloader-configuration-serial-speed
|
||||
(default #f)) ;integer | #f
|
||||
(device-tree-support? bootloader-configuration-device-tree-support?
|
||||
(default #t))) ;boolean
|
||||
|
||||
(define-deprecated (bootloader-configuration-target config)
|
||||
bootloader-configuration-targets
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2017 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -38,6 +39,9 @@ (define* (extlinux-configuration-file config entries
|
|||
(define all-entries
|
||||
(append entries (bootloader-configuration-menu-entries config)))
|
||||
|
||||
(define with-fdtdir?
|
||||
(bootloader-configuration-device-tree-support? config))
|
||||
|
||||
(define (menu-entry->gexp entry)
|
||||
(let ((label (menu-entry-label entry))
|
||||
(kernel (menu-entry-linux entry))
|
||||
|
@ -46,12 +50,16 @@ (define (menu-entry->gexp entry)
|
|||
#~(format port "LABEL ~a
|
||||
MENU LABEL ~a
|
||||
KERNEL ~a
|
||||
FDTDIR ~a/lib/dtbs
|
||||
~a
|
||||
INITRD ~a
|
||||
APPEND ~a
|
||||
~%"
|
||||
#$label #$label
|
||||
#$kernel (dirname #$kernel) #$initrd
|
||||
#$kernel
|
||||
(if #$with-fdtdir?
|
||||
(string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
|
||||
"")
|
||||
#$initrd
|
||||
(string-join (list #$@kernel-arguments)))))
|
||||
|
||||
(define builder
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -267,39 +268,50 @@ (define (marionette-control command marionette)
|
|||
;; The "quit" command terminates QEMU immediately, with no output.
|
||||
(unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))
|
||||
|
||||
(define* (marionette-screen-text marionette
|
||||
#:key
|
||||
(ocrad "ocrad"))
|
||||
"Take a screenshot of MARIONETTE, perform optical character
|
||||
recognition (OCR), and return the text read from the screen as a string. Do
|
||||
this by invoking OCRAD (file name for GNU Ocrad's command)"
|
||||
(define (random-file-name)
|
||||
(string-append "/tmp/marionette-screenshot-"
|
||||
(number->string (random (expt 2 32)) 16)
|
||||
".ppm"))
|
||||
(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad"))
|
||||
"Invoke the OCRAD command on image, and return the recognized text."
|
||||
(let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image))
|
||||
(text (get-string-all pipe)))
|
||||
(unless (zero? (close-pipe pipe))
|
||||
(error "'ocrad' failed" ocrad))
|
||||
text))
|
||||
|
||||
(let ((image (random-file-name)))
|
||||
(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract"))
|
||||
"Invoke the TESSERACT command on IMAGE, and return the recognized text."
|
||||
(let* ((output-basename (tmpnam))
|
||||
(output-basename* (string-append output-basename ".txt")))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(lambda ()
|
||||
(marionette-control (string-append "screendump " image)
|
||||
marionette)
|
||||
|
||||
;; Tell Ocrad to invert the image colors (make it black on white) and
|
||||
;; to scale the image up, which significantly improves the quality of
|
||||
;; the result. In spite of this, be aware that OCR confuses "y" and
|
||||
;; "V" and sometimes erroneously introduces white space.
|
||||
(let* ((pipe (open-pipe* OPEN_READ ocrad
|
||||
"-i" "-s" "10" image))
|
||||
(text (get-string-all pipe)))
|
||||
(unless (zero? (close-pipe pipe))
|
||||
(error "'ocrad' failed" ocrad))
|
||||
text))
|
||||
(let ((exit-val (status:exit-val
|
||||
(system* tesseract image output-basename))))
|
||||
(unless (zero? exit-val)
|
||||
(error "'tesseract' failed" tesseract))
|
||||
(call-with-input-file output-basename* get-string-all)))
|
||||
(lambda ()
|
||||
(false-if-exception (delete-file image))))))
|
||||
(false-if-exception (delete-file output-basename))
|
||||
(false-if-exception (delete-file output-basename*))))))
|
||||
|
||||
(define* (marionette-screen-text marionette #:key (ocr "ocrad"))
|
||||
"Take a screenshot of MARIONETTE, perform optical character
|
||||
recognition (OCR), and return the text read from the screen as a string. Do
|
||||
this by invoking OCR, which should be the file name of GNU Ocrad's
|
||||
@command{ocrad} or Tesseract OCR's @command{tesseract} command."
|
||||
(define image (string-append (tmpnam) ".ppm"))
|
||||
;; Use the QEMU Monitor to save an image of the screen to the host.
|
||||
(marionette-control (string-append "screendump " image) marionette)
|
||||
;; Process it via the OCR.
|
||||
(cond
|
||||
((string-contains ocr "ocrad")
|
||||
(invoke-ocrad-ocr image #:ocrad ocr))
|
||||
((string-contains ocr "tesseract")
|
||||
(invoke-tesseract-ocr image #:tesseract ocr))
|
||||
(else (error "unsupported ocr command"))))
|
||||
|
||||
(define* (wait-for-screen-text marionette predicate
|
||||
#:key (timeout 30) (ocrad "ocrad"))
|
||||
#:key
|
||||
(ocr "ocrad")
|
||||
(timeout 30))
|
||||
"Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
|
||||
PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded."
|
||||
(define start
|
||||
|
@ -308,13 +320,14 @@ (define start
|
|||
(define end
|
||||
(+ start timeout))
|
||||
|
||||
(let loop ()
|
||||
(let loop ((last-text #f))
|
||||
(if (> (car (gettimeofday)) end)
|
||||
(error "'wait-for-screen-text' timeout" predicate)
|
||||
(or (predicate (marionette-screen-text marionette #:ocrad ocrad))
|
||||
(begin
|
||||
(sleep 1)
|
||||
(loop))))))
|
||||
(error "'wait-for-screen-text' timeout" 'ocr-text: last-text)
|
||||
(let ((text (marionette-screen-text marionette #:ocr ocr)))
|
||||
(or (predicate text)
|
||||
(begin
|
||||
(sleep 1)
|
||||
(loop text)))))))
|
||||
|
||||
(define %qwerty-us-keystrokes
|
||||
;; Maps "special" characters to their keystrokes.
|
||||
|
|
11
gnu/local.mk
11
gnu/local.mk
|
@ -51,6 +51,7 @@
|
|||
# Copyright © 2022 Remco van 't Veer <remco@remworks.net>
|
||||
# Copyright © 2022 Artyom V. Poptsov <poptsov.artyom@gmail.com>
|
||||
# Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
|
||||
# Copyright © 2022 muradm <mail@muradm.net>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
|
@ -660,6 +661,7 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/services/guix.scm \
|
||||
%D%/services/hurd.scm \
|
||||
%D%/services/kerberos.scm \
|
||||
%D%/services/lightdm.scm \
|
||||
%D%/services/linux.scm \
|
||||
%D%/services/lirc.scm \
|
||||
%D%/services/virtualization.scm \
|
||||
|
@ -672,6 +674,7 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/services/nfs.scm \
|
||||
%D%/services/pam-mount.scm \
|
||||
%D%/services/science.scm \
|
||||
%D%/services/security.scm \
|
||||
%D%/services/security-token.scm \
|
||||
%D%/services/shepherd.scm \
|
||||
%D%/services/sound.scm \
|
||||
|
@ -756,6 +759,7 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/tests/package-management.scm \
|
||||
%D%/tests/reconfigure.scm \
|
||||
%D%/tests/rsync.scm \
|
||||
%D%/tests/security.scm \
|
||||
%D%/tests/security-token.scm \
|
||||
%D%/tests/singularity.scm \
|
||||
%D%/tests/ssh.scm \
|
||||
|
@ -840,6 +844,7 @@ dist_patch_DATA = \
|
|||
%D%/packages/patches/abseil-cpp-fix-strerror_test.patch \
|
||||
%D%/packages/patches/adb-add-libraries.patch \
|
||||
%D%/packages/patches/adb-libssl_11-compatibility.patch \
|
||||
%D%/packages/patches/accountsservice-extensions.patch \
|
||||
%D%/packages/patches/aegis-constness-error.patch \
|
||||
%D%/packages/patches/aegis-perl-tempdir1.patch \
|
||||
%D%/packages/patches/aegis-perl-tempdir2.patch \
|
||||
|
@ -1354,6 +1359,9 @@ dist_patch_DATA = \
|
|||
%D%/packages/patches/librime-fix-build-with-gcc10.patch \
|
||||
%D%/packages/patches/libvirt-add-install-prefix.patch \
|
||||
%D%/packages/patches/libziparchive-add-includes.patch \
|
||||
%D%/packages/patches/lightdm-arguments-ordering.patch \
|
||||
%D%/packages/patches/lightdm-vncserver-check.patch \
|
||||
%D%/packages/patches/lightdm-vnc-color-depth.patch \
|
||||
%D%/packages/patches/localed-xorg-keyboard.patch \
|
||||
%D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
|
||||
%D%/packages/patches/kiki-level-selection-crash.patch \
|
||||
|
@ -1500,7 +1508,8 @@ dist_patch_DATA = \
|
|||
%D%/packages/patches/libmemcached-build-with-gcc7.patch \
|
||||
%D%/packages/patches/libmhash-hmac-fix-uaf.patch \
|
||||
%D%/packages/patches/libsigrokdecode-python3.9-fix.patch \
|
||||
%D%/packages/patches/mercurial-hg-extension-path.patch \
|
||||
%D%/packages/patches/mercurial-hg-extension-path.patch \
|
||||
%D%/packages/patches/mercurial-openssl-compat.patch \
|
||||
%D%/packages/patches/mesa-opencl-all-targets.patch \
|
||||
%D%/packages/patches/mesa-skip-tests.patch \
|
||||
%D%/packages/patches/meson-allow-dirs-outside-of-prefix.patch \
|
||||
|
|
|
@ -3,6 +3,7 @@
|
|||
;;; Copyright © 2018–2021 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
|
||||
;;; Copyright © 2020, 2021, 2022 Vinicius Monego <monego@posteo.net>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -47,6 +48,7 @@ (define-module (gnu packages animation)
|
|||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages imagemagick)
|
||||
#:use-module (gnu packages jemalloc)
|
||||
#:use-module (gnu packages mp3)
|
||||
#:use-module (gnu packages networking)
|
||||
#:use-module (gnu packages pcre)
|
||||
#:use-module (gnu packages perl)
|
||||
|
@ -495,3 +497,100 @@ (define-public pencil2d
|
|||
lets you create traditional hand-drawn animations (cartoons) using both bitmap
|
||||
and vector graphics.")
|
||||
(license license:gpl2)))
|
||||
|
||||
(define-public swftools
|
||||
;; Last release of swftools was 0.9.2 on 2012-04-21 - it is really old and
|
||||
;; does not compile with what's available in guix, master on the other hand works.
|
||||
(let ((commit "772e55a271f66818b06c6e8c9b839befa51248f4")
|
||||
(revision "1"))
|
||||
(package
|
||||
(name "swftools")
|
||||
(version (git-version "0.9.2" revision commit))
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/matthiaskramm/swftools")
|
||||
(commit commit)))
|
||||
(sha256
|
||||
(base32 "0a8a29rn7gpxnba3spnvkpdgr7mdlssvr273mzw5b2wjvbzard3w"))
|
||||
(file-name (git-file-name name version))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
'(begin
|
||||
;; XXX: Swftools includes the source tarball of an old version of
|
||||
;; xpdf.
|
||||
|
||||
;; To fix a linking error I followed the workaround in:
|
||||
;; https://github.com/matthiaskramm/swftools/issues/178
|
||||
;; and implented it as a two-step snippet because substitute*
|
||||
;; does not match multiline regexes.
|
||||
(substitute* "lib/lame/quantize.c"
|
||||
;; move inline keywords to the same line as their function headers
|
||||
(("^inline.*\n") "inline "))
|
||||
(substitute* "lib/lame/quantize.c"
|
||||
;; make this particular function not inline
|
||||
(("inline (void bitpressure_strategy1)" _ f) f))))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
(list #:tests? #f)) ; no rule for check
|
||||
(inputs (list zlib freetype giflib libjpeg-turbo lame))
|
||||
(home-page "http://www.swftools.org")
|
||||
(synopsis "Collection of utilities for working with Adobe Flash files")
|
||||
|
||||
;; XXX: This package will built all of swftools' tools but one: PDF2SWF,
|
||||
;; purposefuly commented out of the description below.
|
||||
(description "SWFTools is a collection of utilities for working with
|
||||
Adobe Flash files (SWF files). The tool collection includes programs for
|
||||
reading SWF files, combining them, and creating them from other content (like
|
||||
images, sound files, videos or sourcecode). The current collection is
|
||||
comprised of the programs detailed below:
|
||||
|
||||
@itemize
|
||||
@comment PDF2SWF is not currentlybeing build alongside other tools. The next
|
||||
@comment two lines should be uncommented if this will ever get fixed.
|
||||
@comment @item
|
||||
@comment @command{pdf2swf} A PDF to SWF Converter.
|
||||
|
||||
@item
|
||||
@command{swfcombine} A multi-function tool for inserting, contatenating,
|
||||
stacking and changing parameters in SWFs.
|
||||
|
||||
@item
|
||||
@command{swfstrings} Scans SWFs for text data.
|
||||
@item
|
||||
@command{swfdump} Prints out various informations about SWFs.
|
||||
|
||||
@item
|
||||
@command{jpeg2swf} Takes one or more JPEG pictures and generates a SWF
|
||||
slideshow from them.
|
||||
|
||||
@item
|
||||
@command{png2swf} Like JPEG2SWF, only for PNGs.
|
||||
|
||||
@item
|
||||
@command{gif2swf} Converts GIFs to SWF. Also able to handle animated GIFs.
|
||||
|
||||
@item
|
||||
@command{wav2swf} Converts WAV audio files to SWFs, using the LAME MP3
|
||||
encoder library.
|
||||
|
||||
@item
|
||||
@command{font2swf} Converts font files (TTF, Type1) to SWF.
|
||||
|
||||
@item
|
||||
@command{swfbbox} Allows to read out, optimize and readjust SWF bounding boxes.
|
||||
|
||||
@item
|
||||
@command{swfc} A tool for creating SWF files from simple script files. Supports
|
||||
both ActionScript 2.0 aand 3.0.
|
||||
|
||||
@item
|
||||
@command{swfextract} Allows to extract Movieclips, Sounds, Images etc. from SWF
|
||||
files.
|
||||
|
||||
@item
|
||||
@command{as3compile} A standalone ActionScript 3.0 compiler. Mostly compatible
|
||||
with Flex.
|
||||
@end itemize")
|
||||
(license license:gpl2+))))
|
||||
|
|
|
@ -4647,14 +4647,14 @@ (define-public r-interactivedisplaybase
|
|||
(define-public r-keggrest
|
||||
(package
|
||||
(name "r-keggrest")
|
||||
(version "1.36.2")
|
||||
(version "1.36.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "KEGGREST" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1rn03w8y80prbvzahkvf8275haiymnjj1ijcgn55p3d0sb54yzgw"))))
|
||||
"0lzb3z6pzm323q70931b7220ygml7jb4g81dybwa79wqiqz15pni"))))
|
||||
(properties `((upstream-name . "KEGGREST")))
|
||||
(build-system r-build-system)
|
||||
(propagated-inputs
|
||||
|
|
|
@ -16,6 +16,7 @@
|
|||
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
|
||||
;;; Copyright © 2021 lu hui <luhuins@163.com>
|
||||
;;; Copyright © 2021, 2022 Foo Chuan Wei <chuanwei.foo@hotmail.com>
|
||||
;;; Copyright © 2022 Michael Rohleder <mike@rohleder.de>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -744,7 +745,7 @@ (define-public makefile2graph
|
|||
(define-public uncrustify
|
||||
(package
|
||||
(name "uncrustify")
|
||||
(version "0.74.0")
|
||||
(version "0.75.1")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
|
@ -753,7 +754,7 @@ (define-public uncrustify
|
|||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0v48vhmzxjzysbf0vhxzayl2pkassvbabvwg84xd6b8n5i74ijxd"))))
|
||||
"1mzzzd4alajjdshbjd2a5mddqcpag8yyss72n09mfpialzyf7g60"))))
|
||||
(build-system cmake-build-system)
|
||||
(native-inputs
|
||||
`(("python" ,python-wrapper)))
|
||||
|
|
|
@ -1153,7 +1153,7 @@ (define-public mariadb
|
|||
("libaio" ,libaio)
|
||||
("libxml2" ,libxml2)
|
||||
("ncurses" ,ncurses)
|
||||
("openssl" ,openssl)
|
||||
("openssl" ,openssl-1.1)
|
||||
("pam" ,linux-pam)
|
||||
("pcre2" ,pcre2)
|
||||
("xz" ,xz)
|
||||
|
|
|
@ -621,7 +621,7 @@ (define-public remake
|
|||
(define-public rr
|
||||
(package
|
||||
(name "rr")
|
||||
(version "5.5.0")
|
||||
(version "5.6.0")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
|
@ -629,7 +629,7 @@ (define-public rr
|
|||
(commit version)))
|
||||
(sha256
|
||||
(base32
|
||||
"079x891axkiy8qbvjar9vbaldlx7pm9p0i3nq6infdc66nc69635"))
|
||||
"0sdpsd7bcbmx9gmp7lv71znzxz708wm8qxq5apbyc6hh80z4fzqz"))
|
||||
(file-name (git-file-name name version))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
|
@ -641,7 +641,9 @@ (define-public rr
|
|||
;; Satisfy the ‘validate-runpath’ phase. This isn't a direct
|
||||
;; consequence of clearing CMAKE_INSTALL_RPATH.
|
||||
(string-append "-DCMAKE_EXE_LINKER_FLAGS=-Wl,-rpath="
|
||||
(assoc-ref %build-inputs "capnproto") "/lib")
|
||||
(assoc-ref %build-inputs "capnproto")
|
||||
"/lib,-rpath=" (assoc-ref %build-inputs "zlib")
|
||||
"/lib")
|
||||
,@(if (and (not (%current-target-system))
|
||||
(member (%current-system)
|
||||
'("x86_64-linux" "aarch64-linux")))
|
||||
|
@ -666,7 +668,7 @@ (define-public rr
|
|||
(native-inputs
|
||||
(list pkg-config ninja which))
|
||||
(inputs
|
||||
(list gdb capnproto python python-pexpect))
|
||||
(list gdb capnproto python python-pexpect zlib))
|
||||
(home-page "https://rr-project.org/")
|
||||
(synopsis "Record and reply debugging framework")
|
||||
(description
|
||||
|
|
|
@ -37,6 +37,7 @@ (define-module (gnu packages display-managers)
|
|||
#:use-module (guix build-system cmake)
|
||||
#:use-module (guix build-system qt)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system glib-or-gtk)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix utils)
|
||||
|
@ -53,6 +54,7 @@ (define-module (gnu packages display-managers)
|
|||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages gnupg)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages kde-frameworks)
|
||||
#:use-module (gnu packages linux)
|
||||
|
@ -275,7 +277,10 @@ (define-public lightdm
|
|||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))))
|
||||
"1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))
|
||||
(patches (search-patches "lightdm-arguments-ordering.patch"
|
||||
"lightdm-vncserver-check.patch"
|
||||
"lightdm-vnc-color-depth.patch"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:parallel-tests? #f ; fails when run in parallel
|
||||
|
@ -310,8 +315,8 @@ (define-public lightdm
|
|||
(unsetenv "LC_ALL"))))))
|
||||
(inputs
|
||||
(list audit
|
||||
bash-minimal ;for cross-compilation
|
||||
coreutils-minimal ;ditto
|
||||
bash-minimal ;for cross-compilation
|
||||
coreutils-minimal ;ditto
|
||||
linux-pam
|
||||
shadow ;for sbin/nologin
|
||||
libgcrypt
|
||||
|
@ -356,17 +361,29 @@ (define-public lightdm-gtk-greeter
|
|||
(sha256
|
||||
(base32
|
||||
"04q62mvr97l9gv8h37hfarygqc7p0498ig7xclcg4kxkqw0b7yxy"))))
|
||||
(build-system gnu-build-system)
|
||||
(build-system glib-or-gtk-build-system)
|
||||
(arguments
|
||||
(list
|
||||
#:configure-flags
|
||||
#~(list "--disable-indicator-services-command" ;requires upstart
|
||||
;; Put the binary under /bin rather than /sbin, so that it gets
|
||||
;; wrapped by the glib-or-gtk-wrap phase.
|
||||
(string-append "--sbindir=" #$output "/bin")
|
||||
(string-append "--with-libxklavier")
|
||||
(string-append "--enable-at-spi-command="
|
||||
(search-input-file
|
||||
%build-inputs "libexec/at-spi-bus-launcher")))
|
||||
|
||||
%build-inputs "libexec/at-spi-bus-launcher")
|
||||
" --launch-immediately"))
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'unpack 'customize-default-config-path
|
||||
(lambda _
|
||||
(substitute* "src/Makefile.in"
|
||||
;; Have the default config directory sourced from
|
||||
;; /etc/lightdm/lightdm-gtk-greeter.conf, which is where the
|
||||
;; lightdm service writes it.
|
||||
(("\\$\\(sysconfdir)/lightdm/lightdm-gtk-greeter.conf")
|
||||
"/etc/lightdm/lightdm-gtk-greeter.conf"))))
|
||||
(add-after 'install 'fix-.desktop-file
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(substitute* (search-input-file
|
||||
|
@ -375,34 +392,38 @@ (define-public lightdm-gtk-greeter
|
|||
(("Exec=lightdm-gtk-greeter")
|
||||
(string-append "Exec="
|
||||
(search-input-file
|
||||
outputs "sbin/lightdm-gtk-greeter"))))))
|
||||
(add-after 'fix-.desktop-file 'wrap-program
|
||||
;; Mimic glib-or-gtk build system which doesn't wrap files in
|
||||
;; /sbin.
|
||||
(lambda* (#:key outputs inputs #:allow-other-keys)
|
||||
(let ((gtk #$(this-package-input "gtk+"))
|
||||
(shared-mime-info #$(this-package-input "shared-mime-info"))
|
||||
(glib #$(this-package-input "glib")))
|
||||
(wrap-program (search-input-file
|
||||
outputs "sbin/lightdm-gtk-greeter")
|
||||
`("XDG_DATA_DIRS" ":" prefix
|
||||
,(cons "/run/current-system/profile/share"
|
||||
(map (lambda (pkg)
|
||||
(string-append pkg "/share"))
|
||||
(list gtk shared-mime-info glib))))
|
||||
`("GTK_PATH" ":" prefix (,gtk))
|
||||
`("GIO_EXTRA_MODULES" ":" prefix (,gtk))
|
||||
'("XCURSOR_PATH" ":" prefix
|
||||
("/run/current-system/profile/share/icons")))))))))
|
||||
outputs "bin/lightdm-gtk-greeter"))))))
|
||||
(add-after 'glib-or-gtk-wrap 'custom-wrap
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(wrap-script (search-input-file
|
||||
outputs "bin/lightdm-gtk-greeter")
|
||||
;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is
|
||||
;; available at all times even outside of profiles, such as
|
||||
;; when used in the lightdm-service-type. Otherwise, it
|
||||
;; wouldn't be able to display its own icons.
|
||||
`("GDK_PIXBUF_MODULE_FILE" =
|
||||
(,(search-input-file
|
||||
outputs
|
||||
"lib/gdk-pixbuf-2.0/2.10.0/loaders.cache")))
|
||||
`("XDG_DATA_DIRS" ":" prefix
|
||||
(,(string-append "/run/current-system/profile/share:"
|
||||
(getenv "XDG_DATA_DIRS"))))
|
||||
'("XCURSOR_PATH" ":" prefix
|
||||
("/run/current-system/profile/share/icons"))))))))
|
||||
(native-inputs
|
||||
(list exo intltool pkg-config xfce4-dev-tools))
|
||||
(list exo
|
||||
intltool
|
||||
pkg-config
|
||||
xfce4-dev-tools))
|
||||
(inputs
|
||||
(list bash-minimal ;for wrap-program
|
||||
(list at-spi2-core
|
||||
bash-minimal ;for wrap-program
|
||||
gtk+
|
||||
guile-3.0
|
||||
librsvg
|
||||
libxklavier
|
||||
lightdm
|
||||
shared-mime-info
|
||||
at-spi2-core
|
||||
glib
|
||||
gtk+))
|
||||
shared-mime-info))
|
||||
(synopsis "GTK+ greeter for LightDM")
|
||||
(home-page "https://github.com/xubuntu/lightdm-gtk-greeter")
|
||||
(description "This package provides a LightDM greeter implementation using
|
||||
|
|
|
@ -1361,3 +1361,54 @@ (define-public python-django-svg-image-form-field
|
|||
models that use Django's standard @code{ImageField}, in addition to the
|
||||
image files already supported by it.")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public python-django-cleanup
|
||||
(package
|
||||
(name "python-django-cleanup")
|
||||
(version "6.0.0")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/un1t/django-cleanup")
|
||||
(commit (string-append version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32 "0c1nghn1bnlq0a4d3sy3s363ksqsnxksixbimdy3cc6a0vk4sjps"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-tests-settings
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; django-cleanup optionally integrates with
|
||||
;; sorl-thumbnail, which is not available in Guix yet, so
|
||||
;; this patch comments it out to avoid import failures in
|
||||
;; test settings.
|
||||
(substitute* "django_cleanup/testapp/settings.py"
|
||||
(("'sorl\\.thumbnail',") "# 'sorl.thumbnail',"))))
|
||||
(replace 'check
|
||||
(lambda* (#:key tests? inputs outputs #:allow-other-keys)
|
||||
(when tests?
|
||||
(add-installed-pythonpath inputs outputs)
|
||||
;; Add CWD to PYTHONPATH so that the tests can find the
|
||||
;; testapp package in the source.
|
||||
(setenv "PYTHONPATH" (getcwd))
|
||||
(invoke "pytest")))))))
|
||||
(native-inputs
|
||||
(list ;; python-django-sorl-thumbnail ; TODO: Add to Guix.
|
||||
python-easy-thumbnails
|
||||
python-pillow
|
||||
python-pytest
|
||||
python-pytest-cov
|
||||
python-pytest-django
|
||||
python-pytest-xdist))
|
||||
(propagated-inputs
|
||||
(list python-django))
|
||||
(home-page "https://github.com/un1t/django-cleanup")
|
||||
(synopsis "Automatically deletes unused media files")
|
||||
(description "This application automatically deletes user-uploaded
|
||||
files when a model is modified or deleted. It works for FileField,
|
||||
ImageField and their subclasses. Files set as default values for any
|
||||
FileField are not deleted.")
|
||||
(license license:expat)))
|
||||
|
|
|
@ -19836,8 +19836,8 @@ (define-public emacs-elisp-refs
|
|||
(define-public emacs-crdt
|
||||
;; XXX: Upstream does not always tag new releases. The commit below
|
||||
;; corresponds exactly to latest version bump.
|
||||
(let ((commit "2feb88ea9a2589946014878790af585cad9f28fc")
|
||||
(version "0.3.2"))
|
||||
(let ((commit "480f60fdda9e40848920fa460b59dfba23fa06e5")
|
||||
(version "0.3.3"))
|
||||
(package
|
||||
(name "emacs-crdt")
|
||||
(version version)
|
||||
|
@ -19849,7 +19849,7 @@ (define-public emacs-crdt
|
|||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32 "1fc98kl5qm7h5hrd70g61zzbdinnbf0zvk9rghf6w78ndp6lv7fz"))))
|
||||
(base32 "10hb2xwv8ylkm4cla2q5l11r1m1s1j4ywiwvy9x5884gxvbpbbph"))))
|
||||
(build-system emacs-build-system)
|
||||
(home-page "https://code.librehq.com/qhong/crdt.el")
|
||||
(synopsis "Real-time collaborative editing environment")
|
||||
|
|
|
@ -27,7 +27,7 @@
|
|||
;;; Copyright © 2021 Robby Zambito <contact@robbyzambito.me>
|
||||
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
|
||||
;;; Copyright © 2021 John Kehayias <john.kehayias@protonmail.com>
|
||||
;;; Copyright © 2021, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2021, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
|
||||
;;; Copyright © 2022 muradm <mail@muradm.net>
|
||||
;;;
|
||||
|
@ -1074,8 +1074,11 @@ (define-public wayland-protocols
|
|||
(build-system meson-build-system)
|
||||
(inputs
|
||||
(list wayland))
|
||||
(native-inputs
|
||||
(list pkg-config python))
|
||||
(native-inputs (cons* pkg-config python
|
||||
(if (%current-target-system)
|
||||
(list pkg-config-for-build
|
||||
wayland) ; for wayland-scanner
|
||||
'())))
|
||||
(synopsis "Wayland protocols")
|
||||
(description "Wayland-Protocols contains Wayland protocols that add
|
||||
functionality not available in the Wayland core protocol. Such protocols either
|
||||
|
@ -1435,7 +1438,7 @@ (define-public udisks
|
|||
(define-public accountsservice
|
||||
(package
|
||||
(name "accountsservice")
|
||||
(version "0.6.55")
|
||||
(version "22.08.8")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
@ -1443,45 +1446,75 @@ (define-public accountsservice
|
|||
"accountsservice/accountsservice-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32 "16wwd633jak9ajyr1f1h047rmd09fhf3kzjz6g5xjsz0lwcj8azz"))))
|
||||
(base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch"))
|
||||
(patches (search-patches "accountsservice-extensions.patch"))))
|
||||
(build-system meson-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; XXX: tests require DocBook 4.1.2
|
||||
#:configure-flags
|
||||
`(#:configure-flags
|
||||
'("--localstatedir=/var"
|
||||
"-Dsystemdsystemunitdir=/tmp/empty"
|
||||
"-Dsystemd=false"
|
||||
"-Delogind=true")
|
||||
"-Delogind=true"
|
||||
"-Ddocbook=true"
|
||||
"-Dgtk_doc=true"
|
||||
"-Dsystemdsystemunitdir=/tmp/empty")
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-/bin/cat
|
||||
(lambda _
|
||||
(substitute* "src/user.c"
|
||||
(("/bin/cat") (which "cat")))))
|
||||
(add-before
|
||||
'configure 'pre-configure
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "meson_post_install.py"
|
||||
(("in dst_dirs") "in []"))
|
||||
(let ((shadow (assoc-ref inputs "shadow")))
|
||||
(substitute* '("src/user.c" "src/daemon.c")
|
||||
(("/usr/sbin/usermod")
|
||||
(string-append shadow "/sbin/usermod"))
|
||||
(("/usr/sbin/useradd")
|
||||
(string-append shadow "/sbin/useradd"))
|
||||
(("/usr/sbin/userdel")
|
||||
(string-append shadow "/sbin/userdel"))
|
||||
(("/usr/bin/passwd")
|
||||
(string-append shadow "/bin/passwd"))
|
||||
(("/usr/bin/chage")
|
||||
(string-append shadow "/bin/chage")))))))))
|
||||
(add-after 'unpack 'patch-docbook-references
|
||||
;; Having XML_CATALOG_FILES set is not enough; xmlto does not seem
|
||||
;; to honor it.
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* (find-files "." "\\.xml(\\.in)?$")
|
||||
(("http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
|
||||
(search-input-file inputs "share/xml/dbus-1/introspect.dtd"))
|
||||
(("http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd")
|
||||
(search-input-file inputs "xml/dtd/docbook/docbookx.dtd")))))
|
||||
(add-after 'unpack 'patch-paths
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "meson_post_install.py"
|
||||
(("in dst_dirs") "in []"))
|
||||
(substitute* '("src/user.c" "src/daemon.c")
|
||||
(("/bin/cat")
|
||||
(search-input-file inputs "bin/cat"))
|
||||
(("/usr/sbin/usermod")
|
||||
(search-input-file inputs "sbin/usermod"))
|
||||
(("/usr/sbin/useradd")
|
||||
(search-input-file inputs "sbin/useradd"))
|
||||
(("/usr/sbin/userdel")
|
||||
(search-input-file inputs "sbin/userdel"))
|
||||
(("/usr/bin/passwd")
|
||||
(search-input-file inputs "bin/passwd"))
|
||||
(("/usr/bin/chage")
|
||||
(search-input-file inputs "bin/chage")))))
|
||||
(add-after 'install 'wrap-with-xdg-data-dirs
|
||||
;; This is to allow accountsservice finding extensions, which
|
||||
;; should be installed to the system profile.
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(wrap-program (search-input-file outputs "libexec/accounts-daemon")
|
||||
'("XDG_DATA_DIRS" prefix
|
||||
("/run/current-system/profile/share"))))))))
|
||||
(native-inputs
|
||||
`(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc.
|
||||
("gobject-introspection" ,gobject-introspection)
|
||||
("intltool" ,intltool)
|
||||
("pkg-config" ,pkg-config)))
|
||||
(list docbook-xml-4.1.2
|
||||
docbook-xsl
|
||||
gettext-minimal
|
||||
`(,glib "bin") ; for gdbus-codegen, etc.
|
||||
gobject-introspection
|
||||
gtk-doc
|
||||
libxml2 ;for XML_CATALOG_FILES
|
||||
libxslt
|
||||
pkg-config
|
||||
vala
|
||||
xmlto
|
||||
|
||||
;; For the tests.
|
||||
python
|
||||
python-dbusmock
|
||||
python-pygobject))
|
||||
(inputs
|
||||
(list dbus elogind polkit shadow))
|
||||
(list coreutils-minimal
|
||||
dbus
|
||||
elogind
|
||||
shadow))
|
||||
(propagated-inputs
|
||||
(list polkit)) ; listed in Requires.private
|
||||
(home-page "https://www.freedesktop.org/wiki/Software/AccountsService/")
|
||||
(synopsis "D-Bus interface for user account query and manipulation")
|
||||
(description
|
||||
|
|
|
@ -7622,148 +7622,6 @@ (define-public crispy-doom
|
|||
original.")
|
||||
(home-page "https://www.chocolate-doom.org/wiki/index.php/Crispy_Doom")))
|
||||
|
||||
(define shlomif-cmake-modules
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://raw.githubusercontent.com/shlomif/shlomif-cmake-modules/"
|
||||
"89f05caf86078f783873975525230cf4fecede8a"
|
||||
"/shlomif-cmake-modules/Shlomif_Common.cmake"))
|
||||
(sha256
|
||||
(base32 "05xdikw5ln0yh8p5chsmd8qnndmxg5b5vjlfpdqrjcb1ncqzywkc"))))
|
||||
|
||||
(define-public rinutils
|
||||
(package
|
||||
(name "rinutils")
|
||||
(version "0.10.1")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/shlomif/rinutils")
|
||||
(commit version)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0r90kncf6mvyklifpdsnm50iya7w2951nz35nlgndmqnr82gvdwf"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
(list #:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'unpack 'copy-cmake-modules
|
||||
(lambda _
|
||||
(copy-file #$shlomif-cmake-modules
|
||||
(string-append "cmake/"
|
||||
(strip-store-file-name
|
||||
#$shlomif-cmake-modules)))))
|
||||
(replace 'check
|
||||
(lambda* (#:key tests? #:allow-other-keys)
|
||||
(when tests?
|
||||
(with-directory-excursion "../source"
|
||||
(setenv "FCS_TEST_BUILD" "1")
|
||||
(setenv "RINUTILS_TEST_BUILD" "1")
|
||||
;; TODO: Run tests after setting RINUTILS_TEST_TIDY to `1',
|
||||
;; which requires tidy-all.
|
||||
;; (setenv "RINUTILS_TEST_TIDY" "1")
|
||||
(invoke "perl"
|
||||
"CI-testing/continuous-integration-testing.pl"))))))))
|
||||
(native-inputs
|
||||
(list perl
|
||||
;; The following are needed only for tests.
|
||||
perl-class-xsaccessor
|
||||
perl-file-find-object
|
||||
perl-io-all
|
||||
perl-test-differences
|
||||
perl-test-runvalgrind
|
||||
pkg-config))
|
||||
(inputs
|
||||
(list cmocka
|
||||
perl-env-path
|
||||
perl-inline
|
||||
perl-inline-c
|
||||
perl-string-shellquote
|
||||
perl-test-trailingspace
|
||||
perl-file-find-object-rule
|
||||
perl-text-glob
|
||||
perl-number-compare
|
||||
perl-moo))
|
||||
(home-page "https://www.shlomifish.org/open-source/projects/")
|
||||
(synopsis "C11 / gnu11 utilities C library")
|
||||
(description "This package provides C11 / gnu11 utilities C library")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public fortune-mod
|
||||
(package
|
||||
(name "fortune-mod")
|
||||
(version "3.14.0")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/shlomif/fortune-mod")
|
||||
(commit (string-append "fortune-mod-" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32 "1f2zif3s6vddbhph4jr1cymdsn7gagg59grrxs0yap6myqmy8shg"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
(list #:configure-flags
|
||||
#~(let ((fortunes (string-append #$output "/share/fortunes")))
|
||||
(list (string-append "-DLOCALDIR=" fortunes)
|
||||
(string-append "-DLOCALODIR=" fortunes "/off")
|
||||
(string-append "-DCOOKIEDIR=" fortunes)
|
||||
(string-append "-DOCOOKIEDIR=" fortunes "/off")))
|
||||
#:test-target "check"
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'unpack 'enter-build-directory
|
||||
(lambda _
|
||||
(chdir "fortune-mod")))
|
||||
(add-after 'enter-build-directory 'symlink-rinutils
|
||||
(lambda _
|
||||
(mkdir-p "rinutils")
|
||||
(symlink #$(this-package-native-input "rinutils")
|
||||
"rinutils/rinutils")))
|
||||
(add-after 'enter-build-directory 'copy-cmake-modules
|
||||
(lambda _
|
||||
(copy-file #$shlomif-cmake-modules
|
||||
(string-append "cmake/"
|
||||
(strip-store-file-name
|
||||
#$shlomif-cmake-modules)))))
|
||||
(add-after 'enter-build-directory 'delete-failing-test
|
||||
(lambda _
|
||||
;; TODO: Valgrind tests fail for some reason. Similar issue?
|
||||
;; https://github.com/shlomif/fortune-mod/issues/21
|
||||
(delete-file "tests/data/valgrind.t")
|
||||
(with-output-to-file "tests/scripts/split-valgrind.pl"
|
||||
(const #t))))
|
||||
(add-after 'install 'fix-install-directory
|
||||
;; Move fortune from "games/" to "bin/" and remove the
|
||||
;; former. This is easier than patching CMakeLists.txt
|
||||
;; since the tests hard-code the location as well.
|
||||
(lambda _
|
||||
(with-directory-excursion #$output
|
||||
(rename-file "games/fortune" "bin/fortune")
|
||||
(rmdir "games")))))))
|
||||
(inputs (list recode))
|
||||
(native-inputs
|
||||
(list perl
|
||||
;; For generating the documentation.
|
||||
docbook-xml-5
|
||||
docbook-xsl
|
||||
perl-app-xml-docbook-builder
|
||||
;; The following are only needed for tests.
|
||||
perl-file-find-object
|
||||
perl-test-differences
|
||||
perl-class-xsaccessor
|
||||
perl-io-all
|
||||
perl-test-runvalgrind
|
||||
rinutils))
|
||||
(home-page "https://www.shlomifish.org/open-source/projects/fortune-mod/")
|
||||
(synopsis "The Fortune Cookie program from BSD games")
|
||||
(description "Fortune is a command-line utility which displays a random
|
||||
quotation from a collection of quotes.")
|
||||
(license license:bsd-4)))
|
||||
|
||||
(define xonotic-data
|
||||
(package
|
||||
(name "xonotic-data")
|
||||
|
|
|
@ -175,7 +175,7 @@ (define-public mrg
|
|||
(define-public babl
|
||||
(package
|
||||
(name "babl")
|
||||
(version "0.1.92")
|
||||
(version "0.1.96")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (list (string-append "https://download.gimp.org/pub/babl/"
|
||||
|
@ -189,7 +189,7 @@ (define-public babl
|
|||
"/babl-" version ".tar.xz")))
|
||||
(sha256
|
||||
(base32
|
||||
"1hd2i1s7fng33msxiafavk3zb4zb9jk61w8qmmsn6jwl51876rzn"))))
|
||||
"1xj5hlmm834lb84rpjlfxbqnm5piswgzhjas4h8z90x9b7j3yrrk"))))
|
||||
(build-system meson-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
|
|
|
@ -288,7 +288,7 @@ (define-public gnupg
|
|||
(replacement gnupg/fixed)
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "ftp://ftp.gnupg.org/gcrypt/gnupg/gnupg-" version
|
||||
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
|
||||
".tar.bz2"))
|
||||
(patches (search-patches "gnupg-default-pinentry.patch"))
|
||||
(sha256
|
||||
|
|
|
@ -2182,6 +2182,109 @@ (define-public azpainter
|
|||
")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public mmg
|
||||
(package
|
||||
(name "mmg")
|
||||
(version "5.6.0")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/MmgTools/mmg")
|
||||
(commit (string-append "v" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32 "173biz5skbwg27i5w6layg7mydjzv3rmi1ywhra4rx9rjf5c0cc5"))))
|
||||
(build-system cmake-build-system)
|
||||
(outputs '("out" "lib" "doc"))
|
||||
(arguments
|
||||
(list #:configure-flags
|
||||
#~(list (string-append "-DCMAKE_INSTALL_PREFIX=" #$output:lib)
|
||||
(string-append "-DCMAKE_INSTALL_RPATH=" #$output:lib "/lib")
|
||||
;; The build doesn't honor -DCMAKE_INSTALL_BINDIR, hence
|
||||
;; the adjust-bindir phase.
|
||||
;;(string-append "-DCMAKE_INSTALL_BINDIR=" #$output "/bin")
|
||||
"-DBUILD_SHARED_LIBS=ON"
|
||||
"-DBUILD_TESTING=ON"
|
||||
;; The longer tests are for continuous integration and
|
||||
;; depend on input data which must be downloaded.
|
||||
"-DONLY_VERY_SHORT_TESTS=ON"
|
||||
;; TODO: Add Elas (from
|
||||
;; https://github.com/ISCDtoolbox/LinearElasticity).
|
||||
"-DUSE_ELAS=OFF"
|
||||
;; TODO: Figure out how to add VTK to inputs without
|
||||
;; causing linking errors in ASLI of the form:
|
||||
;;
|
||||
;; ld: /gnu/store/…-vtk-9.0.1/lib/libvtkWrappingPythonCore-9.0.so.1:
|
||||
;; undefined reference to `PyUnicode_InternFromString'
|
||||
;;
|
||||
;; Also, adding VTK to inputs requires adding these as well:
|
||||
;;
|
||||
;; double-conversion eigen expat freetype gl2ps glew hdf5
|
||||
;; jsoncpp libjpeg-turbo libpng libtheora libtiff libx11
|
||||
;; libxml2 lz4 netcdf proj python sqlite zlib
|
||||
"-DUSE_VTK=OFF")
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'build 'build-doc
|
||||
(lambda _
|
||||
;; Fontconfig wants to write to a cache directory.
|
||||
(setenv "HOME" "/tmp")
|
||||
(invoke "make" "doc")))
|
||||
(add-after 'install 'install-doc
|
||||
(lambda _
|
||||
(copy-recursively
|
||||
"../source/doc/man" (string-append #$output
|
||||
"/share/man/man1"))
|
||||
(copy-recursively
|
||||
"doc" (string-append #$output:doc "/share/doc/"
|
||||
#$name "-" #$version))))
|
||||
(add-after 'install 'adjust-bindir
|
||||
(lambda _
|
||||
(let ((src (string-append #$output:lib "/bin"))
|
||||
(dst (string-append #$output "/bin")))
|
||||
(copy-recursively src dst)
|
||||
(delete-file-recursively src))))
|
||||
;; Suffixing program names with build information, i.e.,
|
||||
;; optimization flags and whether debug symbols were generated,
|
||||
;; is unusual and fragilizes scripts calling these programs.
|
||||
(add-after 'adjust-bindir 'fix-program-names
|
||||
(lambda _
|
||||
(with-directory-excursion (string-append #$output "/bin")
|
||||
(rename-file "mmg2d_O3d" "mmg2d")
|
||||
(rename-file "mmg3d_O3d" "mmg3d")
|
||||
(rename-file "mmgs_O3d" "mmgs")))))))
|
||||
(native-inputs
|
||||
;; For the documentation
|
||||
(list doxygen graphviz
|
||||
;; TODO: Fix failing LaTeX invocation (which results in equations
|
||||
;; being inserted literally into PNGs rather than being typeset).
|
||||
;;texlive-tiny
|
||||
))
|
||||
(inputs
|
||||
(list scotch))
|
||||
(home-page "http://www.mmgtools.org/")
|
||||
(synopsis "Surface and volume remeshers")
|
||||
(description "Mmg is a collection of applications and libraries for
|
||||
bidimensional and tridimensional surface and volume remeshing. It consists
|
||||
of:
|
||||
|
||||
@itemize
|
||||
@item the @code{mmg2d} application and library: mesh generation from a set of
|
||||
edges, adaptation and optimization of a bidimensional triangulation and
|
||||
isovalue discretization;
|
||||
|
||||
@item the @code{mmgs} application and library: adaptation and optimization of
|
||||
a surface triangulation and isovalue discretization;
|
||||
|
||||
@item the @code{mmg3d} application and library: adaptation and optimization of
|
||||
a tetrahedral mesh, isovalue discretization and Lagrangian movement;
|
||||
|
||||
@item the @code{mmg} library gathering the @code{mmg2d}, @code{mmgs} and
|
||||
@code{mmg3d} libraries.
|
||||
@end itemize")
|
||||
(license license:lgpl3+)))
|
||||
|
||||
(define-public f3d
|
||||
;; There have been many improvements since the last tagged version (1.2.1,
|
||||
;; released in December 2021), including support for the Alembic file
|
||||
|
|
|
@ -12000,9 +12000,6 @@ (define-public ghc-statistics
|
|||
(base32
|
||||
"0j9awbg47fzb58k5z2wgkp6a0042j7hqrl1g6lyflrbsfswdp5n4"))))
|
||||
(build-system haskell-build-system)
|
||||
(arguments
|
||||
'(;; Two tests fail: "Discrete CDF is OK" and "Quantile is CDF inverse".
|
||||
#:tests? #t))
|
||||
(inputs
|
||||
(list ghc-aeson
|
||||
ghc-async
|
||||
|
|
|
@ -20,6 +20,7 @@
|
|||
;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;; Copyright © 2021 Ivan Gankevich <i.gankevich@spbu.ru>
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -511,6 +512,9 @@ (define-public opencv
|
|||
;; DISPATCH is the list of optional dispatches.
|
||||
"-DCPU_BASELINE=SSE2"
|
||||
|
||||
;; Build Python bindings.
|
||||
"-DBUILD_opencv_python3=ON"
|
||||
|
||||
,@(match (%current-system)
|
||||
("x86_64-linux"
|
||||
'("-DCPU_DISPATCH=NEON;VFPV3;FP16;SSE;SSE2;SSE3;SSSE3;SSE4_1;SSE4_2;POPCNT;AVX;FP16;AVX2;FMA3;AVX_512F;AVX512_SKX"
|
||||
|
|
|
@ -25,6 +25,7 @@
|
|||
;;; Copyright © 2021 dissent <disseminatedissent@protonmail.com>
|
||||
;;; Copyright © 2022 Michael Rohleder <mike@rohleder.de>
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -55,6 +56,7 @@ (define-module (gnu packages image-viewers)
|
|||
#:use-module (guix build-system qt)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module (gnu packages algebra)
|
||||
#:use-module (gnu packages animation)
|
||||
#:use-module (gnu packages backup)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bash)
|
||||
|
@ -85,14 +87,20 @@ (define-module (gnu packages image-viewers)
|
|||
#:use-module (gnu packages photo)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages python-check)
|
||||
#:use-module (gnu packages python-compression)
|
||||
#:use-module (gnu packages python-crypto)
|
||||
#:use-module (gnu packages python-web)
|
||||
#:use-module (gnu packages python-xyz)
|
||||
#:use-module (gnu packages qt)
|
||||
#:use-module (gnu packages suckless)
|
||||
#:use-module (gnu packages terminals)
|
||||
#:use-module (gnu packages upnp)
|
||||
#:use-module (gnu packages version-control)
|
||||
#:use-module (gnu packages video)
|
||||
#:use-module (gnu packages web)
|
||||
#:use-module (gnu packages xdisorg)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages))
|
||||
|
||||
|
@ -973,3 +981,131 @@ (define-public xzgv
|
|||
(description
|
||||
"xzgv is a fast image viewer that provides extensive keyboard support.")
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public hydrus-network
|
||||
(package
|
||||
(name "hydrus-network")
|
||||
(version "495") ;upstream has a weekly release cycle
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/hydrusnetwork/hydrus")
|
||||
(commit (string-append "v" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"03zhrcmjzbk37sl9nwjahfmr8aflss84c4xhg5ci5b8jvbbqmr1j"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
;; Remove pre-built binaries from bin/.
|
||||
#~(for-each delete-file (find-files "bin" "^swfrender")))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
(list
|
||||
#:phases
|
||||
#~(let ((static-dir "/share/hydrus/static"))
|
||||
(modify-phases %standard-phases
|
||||
;; Hydrus is a python program but does not uses setup.py or any
|
||||
;; other build system to build itself - it's delivered ready to
|
||||
;; run from the source.
|
||||
(replace 'check
|
||||
(lambda _
|
||||
(setenv "DISPLAY" ":0")
|
||||
(setenv "XDG_CACHE_HOME" (getcwd))
|
||||
(setenv "HOME" (getcwd))
|
||||
(invoke "xvfb-run" "python" "test.py")))
|
||||
;; XXX: program help files are not built. Updating
|
||||
;; python-pymdown-extensions to its latest version might be the
|
||||
;; solution, but this would require also packaging its new build
|
||||
;; system that is not present in guix yet.
|
||||
(delete 'build)
|
||||
(add-before 'install 'patch-variables
|
||||
(lambda* (#:key outputs inputs #:allow-other-keys)
|
||||
(let ((ffmpeg (search-input-file inputs "/bin/ffmpeg"))
|
||||
(swfrender (search-input-file inputs "/bin/swfrender"))
|
||||
(upnpc (search-input-file inputs "/bin/upnpc"))
|
||||
(out (assoc-ref outputs "out")))
|
||||
(with-directory-excursion "hydrus"
|
||||
;; Without this the program would incorrectly assume
|
||||
;; that it uses user's ffmpeg binary when it isn't.
|
||||
(substitute* "client/ClientController.py"
|
||||
(("if (HydrusVideoHandling\\.FFMPEG_PATH).*" _ var)
|
||||
(string-append "if " var " == \"" ffmpeg "\":\n")))
|
||||
(with-directory-excursion "core"
|
||||
(substitute* "HydrusConstants.py"
|
||||
(("STATIC_DIR = .*")
|
||||
(string-append "STATIC_DIR = \"" out static-dir "\"\n")))
|
||||
(substitute* "HydrusFlashHandling.py"
|
||||
(("SWFRENDER_PATH = .*\n")
|
||||
(string-append "SWFRENDER_PATH = \"" swfrender "\"\n")))
|
||||
(substitute* "HydrusVideoHandling.py"
|
||||
(("FFMPEG_PATH = .*\n")
|
||||
(string-append "FFMPEG_PATH = \"" ffmpeg "\"\n")))
|
||||
(substitute* "networking/HydrusNATPunch.py"
|
||||
(("UPNPC_PATH = .*\n")
|
||||
(string-append "UPNPC_PATH = \"" upnpc "\"\n"))))))))
|
||||
;; Since everything lives in hydrus's root directory, it needs to
|
||||
;; be spread out to comply with guix's expectations.
|
||||
(replace 'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(client (string-append out "/bin/hydrus"))
|
||||
(server (string-append out "/bin/hydrus-server")))
|
||||
(copy-recursively "static"
|
||||
(string-append out static-dir))
|
||||
(copy-recursively "hydrus"
|
||||
(string-append out
|
||||
"/lib/python"
|
||||
(python-version
|
||||
#$(this-package-input "python"))
|
||||
"/site-packages/hydrus"))
|
||||
(mkdir (string-append out "/bin"))
|
||||
(copy-file "client.py" client)
|
||||
(chmod client #o0555)
|
||||
(copy-file "server.py" server)
|
||||
(chmod server #o0555))))))))
|
||||
;; All native-inputs are only needed for the the check phase
|
||||
(native-inputs
|
||||
(list xvfb-run
|
||||
python-nose
|
||||
python-mock
|
||||
python-httmock))
|
||||
;; All python packages were taken from static/build_files/linux/requirements.txt
|
||||
(propagated-inputs
|
||||
(list python-beautifulsoup4
|
||||
python-cbor2
|
||||
python-chardet
|
||||
python-cloudscraper
|
||||
python-html5lib
|
||||
python-lxml
|
||||
python-lz4
|
||||
python-numpy
|
||||
opencv ; its python bindings are a drop-in replacement for opencv-python-headless
|
||||
python-pillow
|
||||
python-psutil
|
||||
python-pylzma
|
||||
python-pyopenssl
|
||||
;; Since hydrus' version 494 it supports python-pyside-6 but it's not yet
|
||||
;; in guix. pyside-2 is still supported as a fallback.
|
||||
python-pyside-2
|
||||
python-pysocks
|
||||
python-mpv
|
||||
python-pyyaml
|
||||
python-qtpy
|
||||
python-requests
|
||||
python-send2trash
|
||||
python-service-identity
|
||||
python-six
|
||||
python-twisted))
|
||||
(inputs
|
||||
(list swftools ffmpeg miniupnpc python))
|
||||
(synopsis "Organize your media with tags like a dektop booru")
|
||||
(description
|
||||
"The hydrus network client is an application written for
|
||||
internet-fluent media nerds who have large image/swf/webm collections.
|
||||
It browses with tags instead of folders, a little like a booru on your desktop.
|
||||
Advanced users can share tags and files anonymously through custom servers that
|
||||
any user may run. Everything is free and privacy is the first concern.")
|
||||
(home-page "https://hydrusnetwork.github.io/hydrus/")
|
||||
(license license:wtfpl2)))
|
||||
|
|
|
@ -165,7 +165,8 @@ (define-public julia-arrayinterface
|
|||
;; Expression: @inferred(ArrayInterface.size(Rnr)) === (StaticInt(4),)
|
||||
;; Evaluated: (static(2),) === (static(4),)
|
||||
;; Disable as stopgap.
|
||||
(list #:tests? (not (target-x86-32?))))
|
||||
(list #:tests? (not (or (%current-target-system)
|
||||
(target-x86-32?)))))
|
||||
(propagated-inputs
|
||||
(list julia-ifelse
|
||||
julia-requires
|
||||
|
@ -2048,7 +2049,8 @@ (define-public julia-forwarddiff
|
|||
;; Expression: dual_isapprox(FDNUM ^ PRIMAL, exp(PRIMAL * log(FDNUM)))
|
||||
;; ERROR: LoadError: LoadError: There was an error during testing
|
||||
;; Disable as stopgap.
|
||||
(list #:tests? (not (target-x86-32?))))
|
||||
(list #:tests? (not (or (%current-target-system)
|
||||
(target-x86-32?)))))
|
||||
(inputs ;required for tests
|
||||
(list julia-calculus
|
||||
julia-difftests))
|
||||
|
@ -2937,7 +2939,8 @@ (define-public julia-interpolations
|
|||
;; Got exception outside of a @test
|
||||
;; OverflowError: 96908232 * 106943408 overflowed for type Int32
|
||||
;; Disable as stopgap.
|
||||
#:tests? (not (target-x86-32?))))
|
||||
#:tests? (not (or (%current-target-system)
|
||||
(target-x86-32?)))))
|
||||
(propagated-inputs
|
||||
(list julia-axisalgorithms
|
||||
julia-offsetarrays
|
||||
|
@ -4658,7 +4661,8 @@ (define-public julia-reversediff
|
|||
;; Expression: hash(tr_float, hash(1)) === hash(v_float, hash(1))
|
||||
;; MethodError: no method matching decompose(::ReverseDiff.TrackedReal{Float64, Float64, Nothing})
|
||||
;; Disable as stopgap.
|
||||
(list #:tests? (not (target-x86-32?))))
|
||||
(list #:tests? (not (or (%current-target-system)
|
||||
(target-x86-32?)))))
|
||||
(propagated-inputs
|
||||
(list julia-diffresults
|
||||
julia-diffrules
|
||||
|
|
|
@ -7683,9 +7683,9 @@ (define-public proot
|
|||
;; Disable the test suite on armhf-linux, as there are too many
|
||||
;; failures to keep track of (see for example:
|
||||
;; https://github.com/proot-me/proot/issues/286).
|
||||
`(#:tests? ,(not (string-prefix? "armhf"
|
||||
(or (%current-target-system)
|
||||
(%current-system))))
|
||||
`(#:tests? ,(not (or (%current-target-system)
|
||||
(string-prefix? "armhf"
|
||||
(or (%current-system)))))
|
||||
#:make-flags '("-C" "src")
|
||||
#:phases (modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-sources
|
||||
|
|
|
@ -22762,6 +22762,37 @@ (define-public ecl-trivial-custom-debugger
|
|||
;; Tests fail on ECL: https://github.com/phoe/trivial-custom-debugger/issues/3
|
||||
'(#:tests? #f))))
|
||||
|
||||
(define-public sbcl-safe-read
|
||||
(let ((commit "d25f08597b34d7aaeb86b045d57f7b020a5bb5f0")
|
||||
(revision "0"))
|
||||
(package
|
||||
(name "sbcl-safe-read")
|
||||
(version (git-version "0.1" revision commit))
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/phoe/safe-read")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name "cl-safe-read" version))
|
||||
(sha256
|
||||
(base32 "1r9k8danfnqgpbn2vb90n6wdc6jd92h1ig565yplrbh6232lhi26"))))
|
||||
(build-system asdf-build-system/sbcl)
|
||||
(inputs
|
||||
(list sbcl-local-time sbcl-trivial-garbage))
|
||||
(home-page "https://github.com/phoe/safe-read/")
|
||||
(synopsis "Safer variant of READ")
|
||||
(description
|
||||
"This package provides a safer variant of @code{READ} secure against
|
||||
internbombing, excessive input and macro characters.")
|
||||
(license license:bsd-2))))
|
||||
|
||||
(define-public cl-safe-read
|
||||
(sbcl-package->cl-source-package sbcl-safe-read))
|
||||
|
||||
(define-public ecl-safe-read
|
||||
(sbcl-package->ecl-package sbcl-safe-read))
|
||||
|
||||
(define-public sbcl-ospm
|
||||
(package
|
||||
(name "sbcl-ospm")
|
||||
|
|
|
@ -24,6 +24,7 @@
|
|||
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2022 Greg Hogan <code@greghogan.com>
|
||||
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
|
||||
;;; Copyright © 2022 Clément Lassieur <clement@lassieur.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -1842,6 +1843,7 @@ (define-public emacs-clang-format
|
|||
(build-system emacs-build-system)
|
||||
(inputs
|
||||
(list clang))
|
||||
(propagated-inputs '())
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
|
|
|
@ -1179,48 +1179,43 @@ (define-public emilua
|
|||
(license license:boost1.0)))
|
||||
|
||||
(define-public fennel
|
||||
;; The 1.0.0 release had a bug where fennel installed under 5.4 no matter
|
||||
;; what lua was used to compile it. There has since been an update that
|
||||
;; corrects this issue, so we can rely on the version of the lua input to
|
||||
;; determine where the fennel.lua file got installed to.
|
||||
(let ((commit "03c1c95f2a79e45a9baf607f96a74c693b8b70f4")
|
||||
(revision "0"))
|
||||
(package
|
||||
(name "fennel")
|
||||
(version (git-version "1.0.0" revision commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://git.sr.ht/~technomancy/fennel")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1znp38h5q819gvcyl248zwvjsljfxdxdk8n82fnj6lyibiiqzgvx"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
|
||||
#:tests? #t ; even on cross-build
|
||||
#:test-target "test"
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-after 'build 'patch-fennel
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "fennel"
|
||||
(("/usr/bin/env .*lua")
|
||||
(search-input-file inputs "/bin/lua")))))
|
||||
(delete 'check)
|
||||
(add-after 'install 'check
|
||||
(assoc-ref %standard-phases 'check)))))
|
||||
(inputs (list lua))
|
||||
(home-page "https://fennel-lang.org/")
|
||||
(synopsis "Lisp that compiles to Lua")
|
||||
(description
|
||||
"Fennel is a programming language that brings together the speed,
|
||||
(package
|
||||
(name "fennel")
|
||||
(version "1.2.0")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://git.sr.ht/~technomancy/fennel")
|
||||
(commit version)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0klqxhgc9s6rm2xbn2fyzw9nzdas65g84js7s69by0gv2jzalyad"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
(list #:make-flags #~(list (string-append "PREFIX="
|
||||
(assoc-ref %outputs "out")))
|
||||
#:tests? #t ;even on cross-build
|
||||
#:test-target "test"
|
||||
#:phases #~(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-after 'build 'patch-fennel
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "fennel"
|
||||
(("/usr/bin/env .*lua")
|
||||
(search-input-file inputs "/bin/lua")))))
|
||||
(delete 'check)
|
||||
(add-after 'install 'check
|
||||
(assoc-ref %standard-phases
|
||||
'check)))))
|
||||
(inputs (list lua))
|
||||
(home-page "https://fennel-lang.org/")
|
||||
(synopsis "Lisp that compiles to Lua")
|
||||
(description
|
||||
"Fennel is a programming language that brings together the speed,
|
||||
simplicity, and reach of Lua with the flexibility of a Lisp syntax and macro
|
||||
system.")
|
||||
(license license:expat))))
|
||||
(license license:expat)))
|
||||
|
||||
(define-public fnlfmt
|
||||
(package
|
||||
|
|
|
@ -565,7 +565,7 @@ (define-public strawberry
|
|||
(define-public cmus
|
||||
(package
|
||||
(name "cmus")
|
||||
(version "2.9.1")
|
||||
(version "2.10.0")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
|
@ -574,7 +574,7 @@ (define-public cmus
|
|||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0zjkimni2fhv4yskrjrgj6b74f33rfj58zgd7khwrz4z8nf88j0w"))))
|
||||
"0csj59q2n7hz9zihq92kb4kzvb51rgzl65y6vd0chq6j3li1pb8x"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; cmus does not include tests
|
||||
|
|
|
@ -1727,14 +1727,14 @@ (define-public whois
|
|||
(define-public wireshark
|
||||
(package
|
||||
(name "wireshark")
|
||||
(version "3.6.2")
|
||||
(version "3.6.7")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://www.wireshark.org/download/src/wireshark-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32 "03n34jh4318y3q14jclxfxi4r7b9l393w9fw9bq57ydff9aim42x"))))
|
||||
(base32 "1idpxnh8vrvan3g0ymaa24bd4iyxi19xrr76sdrrpxx2r8shmqfc"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
|
|
|
@ -290,7 +290,7 @@ (define-public node
|
|||
icu4c
|
||||
libuv
|
||||
`(,nghttp2 "lib")
|
||||
openssl
|
||||
openssl-1.1
|
||||
zlib
|
||||
;; Regular build-time dependencies.
|
||||
perl
|
||||
|
@ -867,7 +867,7 @@ (define-public node-lts
|
|||
icu4c-71
|
||||
libuv-for-node
|
||||
`(,nghttp2 "lib")
|
||||
openssl
|
||||
openssl-1.1
|
||||
zlib
|
||||
;; Regular build-time dependencies.
|
||||
perl
|
||||
|
@ -884,7 +884,7 @@ (define-public node-lts
|
|||
llhttp-bootstrap
|
||||
brotli
|
||||
`(,nghttp2 "lib")
|
||||
openssl
|
||||
openssl-1.1
|
||||
python-wrapper ;; for node-gyp (supports python3)
|
||||
zlib))))
|
||||
|
||||
|
|
|
@ -177,9 +177,11 @@ (define eng.traineddata
|
|||
(inputs
|
||||
(list cairo
|
||||
icu4c
|
||||
leptonica
|
||||
pango
|
||||
python-wrapper))
|
||||
(propagated-inputs
|
||||
;; Required by tesseract.pc.
|
||||
(list leptonica))
|
||||
(native-search-paths (list (search-path-specification
|
||||
(variable "TESSDATA_PREFIX")
|
||||
(files (list "share/tesseract-ocr/tessdata"))
|
||||
|
|
25
gnu/packages/patches/accountsservice-extensions.patch
Normal file
25
gnu/packages/patches/accountsservice-extensions.patch
Normal file
|
@ -0,0 +1,25 @@
|
|||
Patch from NixOS retrieved from
|
||||
https://raw.githubusercontent.com/NixOS/nixpkgs/master/pkgs/development/libraries/accountsservice/drop-prefix-check-extensions.patch.
|
||||
|
||||
diff --git a/src/extensions.c b/src/extensions.c
|
||||
index 038dcb2..830465d 100644
|
||||
--- a/src/extensions.c
|
||||
+++ b/src/extensions.c
|
||||
@@ -121,16 +121,7 @@ daemon_read_extension_directory (GHashTable *ifaces,
|
||||
continue;
|
||||
}
|
||||
|
||||
- /* Ensure it looks like "../../dbus-1/interfaces/${name}" */
|
||||
- const gchar * const prefix = "../../dbus-1/interfaces/";
|
||||
- if (g_str_has_prefix (symlink, prefix) && g_str_equal (symlink + strlen (prefix), name)) {
|
||||
- daemon_read_extension_file (ifaces, filename);
|
||||
- }
|
||||
- else {
|
||||
- g_warning ("Found accounts service vendor extension symlink %s, but it must be exactly "
|
||||
- "equal to '../../dbus-1/interfaces/%s' for forwards-compatibility reasons.",
|
||||
- filename, name);
|
||||
- }
|
||||
+ daemon_read_extension_file (ifaces, filename);
|
||||
}
|
||||
|
||||
g_dir_close (dir);
|
54
gnu/packages/patches/lightdm-arguments-ordering.patch
Normal file
54
gnu/packages/patches/lightdm-arguments-ordering.patch
Normal file
|
@ -0,0 +1,54 @@
|
|||
When providing the VNCServer command as 'Xvnc -SecurityTypes None',
|
||||
the formatted command line used would look like:
|
||||
|
||||
Xvnc -SecurityTypes None :1 -auth /var/run/lightdm/root/:1
|
||||
|
||||
which is invalid (the display number must appear first).
|
||||
|
||||
Submitted upstream at: https://github.com/canonical/lightdm/pull/265
|
||||
|
||||
src/x-server-local.c | 14 +++++++++++++-
|
||||
1 file changed, 13 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/src/x-server-local.c b/src/x-server-local.c
|
||||
index 7c4ab870..6c540d18 100644
|
||||
--- a/src/x-server-local.c
|
||||
+++ b/src/x-server-local.c
|
||||
@@ -463,14 +463,20 @@ x_server_local_start (DisplayServer *display_server)
|
||||
l_debug (display_server, "Logging to %s", log_file);
|
||||
|
||||
g_autofree gchar *absolute_command = get_absolute_command (priv->command);
|
||||
+ g_auto(GStrv) tokens = g_strsplit (absolute_command, " ", 2);
|
||||
+ const gchar* binary = tokens[0];
|
||||
+ const gchar *extra_options = tokens[1];
|
||||
+
|
||||
if (!absolute_command)
|
||||
{
|
||||
l_debug (display_server, "Can't launch X server %s, not found in path", priv->command);
|
||||
stopped_cb (priv->x_server_process, X_SERVER_LOCAL (server));
|
||||
return FALSE;
|
||||
}
|
||||
- g_autoptr(GString) command = g_string_new (absolute_command);
|
||||
+ g_autoptr(GString) command = g_string_new (binary);
|
||||
|
||||
+ /* The display argument must be given first when the X server used
|
||||
+ * is Xvnc. */
|
||||
g_string_append_printf (command, " :%d", priv->display_number);
|
||||
|
||||
if (priv->config_file)
|
||||
@@ -513,6 +519,12 @@ x_server_local_start (DisplayServer *display_server)
|
||||
if (X_SERVER_LOCAL_GET_CLASS (server)->add_args)
|
||||
X_SERVER_LOCAL_GET_CLASS (server)->add_args (server, command);
|
||||
|
||||
+ /* Any extra user options provided via the VNCServer 'command'
|
||||
+ * config option are appended last, so the user can override any
|
||||
+ * of the above. */
|
||||
+ if (extra_options)
|
||||
+ g_string_append_printf (command, " %s", extra_options);
|
||||
+
|
||||
process_set_command (priv->x_server_process, command->str);
|
||||
|
||||
l_debug (display_server, "Launching X Server");
|
||||
--
|
||||
2.36.1
|
||||
|
81
gnu/packages/patches/lightdm-vnc-color-depth.patch
Normal file
81
gnu/packages/patches/lightdm-vnc-color-depth.patch
Normal file
|
@ -0,0 +1,81 @@
|
|||
There is no longer support for 8 bit color depth in TigerVNC (see:
|
||||
https://github.com/TigerVNC/tigervnc/commit/e86d8720ba1e79b486ca29a5c2b27fa25811e6a2);
|
||||
using it causes a fatal error.
|
||||
|
||||
Submitted upstream at: https://github.com/canonical/lightdm/pull/265.
|
||||
|
||||
diff --git a/data/lightdm.conf b/data/lightdm.conf
|
||||
index 0df38429..60e3e8b4 100644
|
||||
--- a/data/lightdm.conf
|
||||
+++ b/data/lightdm.conf
|
||||
@@ -160,4 +160,4 @@
|
||||
#listen-address=
|
||||
#width=1024
|
||||
#height=768
|
||||
-#depth=8
|
||||
+#depth=24
|
||||
diff --git a/src/x-server-xvnc.c b/src/x-server-xvnc.c
|
||||
index 68340d53..27ca4454 100644
|
||||
--- a/src/x-server-xvnc.c
|
||||
+++ b/src/x-server-xvnc.c
|
||||
@@ -127,7 +127,7 @@ x_server_xvnc_init (XServerXVNC *server)
|
||||
XServerXVNCPrivate *priv = x_server_xvnc_get_instance_private (server);
|
||||
priv->width = 1024;
|
||||
priv->height = 768;
|
||||
- priv->depth = 8;
|
||||
+ priv->depth = 24;
|
||||
}
|
||||
|
||||
static void
|
||||
diff --git a/tests/scripts/vnc-command.conf b/tests/scripts/vnc-command.conf
|
||||
index 0f1e25fd..335956d9 100644
|
||||
--- a/tests/scripts/vnc-command.conf
|
||||
+++ b/tests/scripts/vnc-command.conf
|
||||
@@ -19,7 +19,7 @@ command=Xvnc -option
|
||||
#?VNC-CLIENT CONNECT
|
||||
|
||||
# Xvnc server starts
|
||||
-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=TRUE
|
||||
+#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=TRUE
|
||||
|
||||
# Daemon connects when X server is ready
|
||||
#?*XVNC-0 INDICATE-READY
|
||||
diff --git a/tests/scripts/vnc-guest.conf b/tests/scripts/vnc-guest.conf
|
||||
index 431bb244..ce2b97db 100644
|
||||
--- a/tests/scripts/vnc-guest.conf
|
||||
+++ b/tests/scripts/vnc-guest.conf
|
||||
@@ -21,7 +21,7 @@ user-session=default
|
||||
#?VNC-CLIENT CONNECT
|
||||
|
||||
# Xvnc server starts
|
||||
-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
|
||||
+#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
|
||||
|
||||
# Daemon connects when X server is ready
|
||||
#?*XVNC-0 INDICATE-READY
|
||||
diff --git a/tests/scripts/vnc-login.conf b/tests/scripts/vnc-login.conf
|
||||
index cdfe17b8..f0d65b7f 100644
|
||||
--- a/tests/scripts/vnc-login.conf
|
||||
+++ b/tests/scripts/vnc-login.conf
|
||||
@@ -21,7 +21,7 @@ user-session=default
|
||||
#?VNC-CLIENT CONNECT
|
||||
|
||||
# Xvnc server starts
|
||||
-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
|
||||
+#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
|
||||
|
||||
# Daemon connects when X server is ready
|
||||
#?*XVNC-0 INDICATE-READY
|
||||
diff --git a/tests/scripts/vnc-open-file-descriptors.conf b/tests/scripts/vnc-open-file-descriptors.conf
|
||||
index 753c84dd..e5d35730 100644
|
||||
--- a/tests/scripts/vnc-open-file-descriptors.conf
|
||||
+++ b/tests/scripts/vnc-open-file-descriptors.conf
|
||||
@@ -21,7 +21,7 @@ user-session=default
|
||||
#?VNC-CLIENT CONNECT
|
||||
|
||||
# Xvnc server starts
|
||||
-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
|
||||
+#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
|
||||
|
||||
# Daemon connects when X server is ready
|
||||
#?*XVNC-0 INDICATE-READY
|
66
gnu/packages/patches/lightdm-vncserver-check.patch
Normal file
66
gnu/packages/patches/lightdm-vncserver-check.patch
Normal file
|
@ -0,0 +1,66 @@
|
|||
Honor the Xvnc command specified in the config instead of using a hard-coded
|
||||
default.
|
||||
|
||||
Submitted upstream at: https://github.com/canonical/lightdm/pull/265
|
||||
|
||||
diff --git a/src/lightdm.c b/src/lightdm.c
|
||||
index 74f9ff2d..0ccfcd78 100644
|
||||
--- a/src/lightdm.c
|
||||
+++ b/src/lightdm.c
|
||||
@@ -349,27 +349,42 @@ start_display_manager (void)
|
||||
/* Start the VNC server */
|
||||
if (config_get_boolean (config_get_instance (), "VNCServer", "enabled"))
|
||||
{
|
||||
- g_autofree gchar *path = g_find_program_in_path ("Xvnc");
|
||||
- if (path)
|
||||
+ /* Validate that a the VNC command is available. */
|
||||
+ g_autofree gchar *command = config_get_string (config_get_instance (), "VNCServer", "command");
|
||||
+ if (command)
|
||||
{
|
||||
- vnc_server = vnc_server_new ();
|
||||
- if (config_has_key (config_get_instance (), "VNCServer", "port"))
|
||||
+ g_auto(GStrv) tokens = g_strsplit (command, " ", 2);
|
||||
+ if (!g_find_program_in_path (tokens[0]))
|
||||
{
|
||||
- gint port = config_get_integer (config_get_instance (), "VNCServer", "port");
|
||||
- if (port > 0)
|
||||
- vnc_server_set_port (vnc_server, port);
|
||||
+ g_warning ("Can't start VNC server; command '%s' not found", tokens[0]);
|
||||
+ return;
|
||||
}
|
||||
- g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address");
|
||||
- vnc_server_set_listen_address (vnc_server, listen_address);
|
||||
- g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL);
|
||||
-
|
||||
- g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server));
|
||||
- vnc_server_start (vnc_server);
|
||||
}
|
||||
else
|
||||
- g_warning ("Can't start VNC server, Xvnc is not in the path");
|
||||
+ {
|
||||
+ /* Fallback to 'Xvnc'. */
|
||||
+ if (!g_find_program_in_path ("Xvnc")) {
|
||||
+ g_warning ("Can't start VNC server; 'Xvnc' command not found");
|
||||
+ return;
|
||||
+ }
|
||||
+ }
|
||||
+
|
||||
+ vnc_server = vnc_server_new ();
|
||||
+ if (config_has_key (config_get_instance (), "VNCServer", "port"))
|
||||
+ {
|
||||
+ gint port = config_get_integer (config_get_instance (), "VNCServer", "port");
|
||||
+ if (port > 0)
|
||||
+ vnc_server_set_port (vnc_server, port);
|
||||
+ }
|
||||
+ g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address");
|
||||
+ vnc_server_set_listen_address (vnc_server, listen_address);
|
||||
+ g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL);
|
||||
+
|
||||
+ g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server));
|
||||
+ vnc_server_start (vnc_server);
|
||||
}
|
||||
}
|
||||
+
|
||||
static void
|
||||
service_ready_cb (DisplayManagerService *service)
|
||||
{
|
89
gnu/packages/patches/mercurial-openssl-compat.patch
Normal file
89
gnu/packages/patches/mercurial-openssl-compat.patch
Normal file
|
@ -0,0 +1,89 @@
|
|||
Tweak cipher selection to make TLS < 1.2 work with OpenSSL 3.
|
||||
|
||||
Taken from Debian:
|
||||
|
||||
https://salsa.debian.org/python-team/packages/mercurial/-/blob/debian/master/debian/patches/openssl_3_cipher_tlsv1.patch
|
||||
|
||||
--- a/mercurial/sslutil.py
|
||||
+++ b/mercurial/sslutil.py
|
||||
@@ -117,17 +117,17 @@ def _hostsettings(ui, hostname):
|
||||
ciphers = ui.config(b'hostsecurity', b'%s:ciphers' % bhostname, ciphers)
|
||||
|
||||
# If --insecure is used, we allow the use of TLS 1.0 despite config options.
|
||||
# We always print a "connection security to %s is disabled..." message when
|
||||
# --insecure is used. So no need to print anything more here.
|
||||
if ui.insecureconnections:
|
||||
minimumprotocol = b'tls1.0'
|
||||
if not ciphers:
|
||||
- ciphers = b'DEFAULT'
|
||||
+ ciphers = b'DEFAULT:@SECLEVEL=0'
|
||||
|
||||
s[b'minimumprotocol'] = minimumprotocol
|
||||
s[b'ciphers'] = ciphers
|
||||
|
||||
# Look for fingerprints in [hostsecurity] section. Value is a list
|
||||
# of <alg>:<fingerprint> strings.
|
||||
fingerprints = ui.configlist(
|
||||
b'hostsecurity', b'%s:fingerprints' % bhostname
|
||||
@@ -621,17 +621,17 @@ def wrapserversocket(
|
||||
|
||||
# Improve forward secrecy.
|
||||
sslcontext.options |= getattr(ssl, 'OP_SINGLE_DH_USE', 0)
|
||||
sslcontext.options |= getattr(ssl, 'OP_SINGLE_ECDH_USE', 0)
|
||||
|
||||
# In tests, allow insecure ciphers
|
||||
# Otherwise, use the list of more secure ciphers if found in the ssl module.
|
||||
if exactprotocol:
|
||||
- sslcontext.set_ciphers('DEFAULT')
|
||||
+ sslcontext.set_ciphers('DEFAULT:@SECLEVEL=0')
|
||||
elif util.safehasattr(ssl, b'_RESTRICTED_SERVER_CIPHERS'):
|
||||
sslcontext.options |= getattr(ssl, 'OP_CIPHER_SERVER_PREFERENCE', 0)
|
||||
# pytype: disable=module-attr
|
||||
sslcontext.set_ciphers(ssl._RESTRICTED_SERVER_CIPHERS)
|
||||
# pytype: enable=module-attr
|
||||
|
||||
if requireclientcert:
|
||||
sslcontext.verify_mode = ssl.CERT_REQUIRED
|
||||
--- a/tests/test-https.t
|
||||
+++ b/tests/test-https.t
|
||||
@@ -356,19 +356,19 @@ Start servers running supported TLS vers
|
||||
$ cat ../hg1.pid >> $DAEMON_PIDS
|
||||
$ hg serve -p $HGPORT2 -d --pid-file=../hg2.pid --certificate=$PRIV \
|
||||
> --config devel.serverexactprotocol=tls1.2
|
||||
$ cat ../hg2.pid >> $DAEMON_PIDS
|
||||
$ cd ..
|
||||
|
||||
Clients talking same TLS versions work
|
||||
|
||||
- $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.0 --config hostsecurity.ciphers=DEFAULT id https://localhost:$HGPORT/
|
||||
+ $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.0 --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 id https://localhost:$HGPORT/
|
||||
5fed3813f7f5
|
||||
- $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.1 --config hostsecurity.ciphers=DEFAULT id https://localhost:$HGPORT1/
|
||||
+ $ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.1 --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 id https://localhost:$HGPORT1/
|
||||
5fed3813f7f5
|
||||
$ P="$CERTSDIR" hg --config hostsecurity.minimumprotocol=tls1.2 id https://localhost:$HGPORT2/
|
||||
5fed3813f7f5
|
||||
|
||||
Clients requiring newer TLS version than what server supports fail
|
||||
|
||||
$ P="$CERTSDIR" hg id https://localhost:$HGPORT/
|
||||
(could not negotiate a common security protocol (tls1.1+) with localhost; the likely cause is Mercurial is configured to be more secure than the server can support)
|
||||
@@ -400,17 +400,17 @@ Clients requiring newer TLS version than
|
||||
|
||||
$ hg --config hostsecurity.minimumprotocol=tls1.2 id --insecure https://localhost:$HGPORT1/
|
||||
warning: connection security to localhost is disabled per current settings; communication is susceptible to eavesdropping and tampering
|
||||
5fed3813f7f5
|
||||
|
||||
The per-host config option overrides the default
|
||||
|
||||
$ P="$CERTSDIR" hg id https://localhost:$HGPORT/ \
|
||||
- > --config hostsecurity.ciphers=DEFAULT \
|
||||
+ > --config hostsecurity.ciphers=DEFAULT:@SECLEVEL=0 \
|
||||
> --config hostsecurity.minimumprotocol=tls1.2 \
|
||||
> --config hostsecurity.localhost:minimumprotocol=tls1.0
|
||||
5fed3813f7f5
|
||||
|
||||
The per-host config option by itself works
|
||||
|
||||
$ P="$CERTSDIR" hg id https://localhost:$HGPORT/ \
|
||||
> --config hostsecurity.localhost:minimumprotocol=tls1.2
|
|
@ -6,7 +6,7 @@
|
|||
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
|
||||
;;; Copyright © 2016 Nikita <nikita@n0.is>
|
||||
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
|
||||
;;; Copyright © 2016, 2017, 2022 Marius Bakke <marius@gnu.org>
|
||||
;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
|
||||
;;; Copyright © 2016, 2019 Arun Isaac <arunisaac@systemreboot.net>
|
||||
|
@ -82,6 +82,7 @@ (define-module (gnu packages pdf)
|
|||
#:use-module (gnu packages lua)
|
||||
#:use-module (gnu packages man)
|
||||
#:use-module (gnu packages markup)
|
||||
#:use-module (gnu packages ocr)
|
||||
#:use-module (gnu packages pcre)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages photo)
|
||||
|
@ -518,7 +519,7 @@ (define-public zathura-djvu
|
|||
(define-public zathura-pdf-mupdf
|
||||
(package
|
||||
(name "zathura-pdf-mupdf")
|
||||
(version "0.3.6")
|
||||
(version "0.3.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
|
@ -526,39 +527,39 @@ (define-public zathura-pdf-mupdf
|
|||
"/download/zathura-pdf-mupdf-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1r3v37k9fl2rxipvacgxr36llywvy7n20a25h3ajlyk70697sa66"))))
|
||||
"01vw0lrcj9g7d5h2xvm4xb08mvfld4syfr381fjrbdj52zm9bxvp"))))
|
||||
(native-inputs (list pkg-config))
|
||||
(inputs
|
||||
`(("jbig2dec" ,jbig2dec)
|
||||
("libjpeg" ,libjpeg-turbo)
|
||||
("mujs" ,mujs)
|
||||
("mupdf" ,mupdf)
|
||||
("openjpeg" ,openjpeg)
|
||||
("openssl" ,openssl)
|
||||
("zathura" ,zathura)))
|
||||
(list gumbo-parser
|
||||
jbig2dec
|
||||
libjpeg-turbo
|
||||
mujs
|
||||
mupdf
|
||||
openjpeg
|
||||
openssl
|
||||
tesseract-ocr
|
||||
zathura))
|
||||
(build-system meson-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; package does not contain tests
|
||||
#:configure-flags (list (string-append "-Dplugindir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/lib/zathura")
|
||||
"-Dlink-external=true")
|
||||
"/lib/zathura"))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'remove-libmupdfthird.a-requirement
|
||||
(lambda _
|
||||
;; Ignore a missing (apparently superfluous) static library.
|
||||
(substitute* "meson.build"
|
||||
((".*mupdfthird.*") ""))
|
||||
#t))
|
||||
(add-before 'configure 'add-mujs-to-dependencies
|
||||
(("mupdfthird = .*")
|
||||
"")
|
||||
((", mupdfthird")
|
||||
""))))
|
||||
(add-after 'unpack 'fix-mupdf-detection
|
||||
(lambda _
|
||||
;; Add mujs to the 'build_dependencies'.
|
||||
(substitute* "meson.build"
|
||||
(("^ libopenjp2 = dependency.*" x)
|
||||
(string-append x " mujs = cc.find_library('mujs')\n"))
|
||||
(("^ libopenjp2")
|
||||
" libopenjp2, mujs")))))))
|
||||
(("dependency\\('mupdf', required: false\\)")
|
||||
"cc.find_library('mupdf')")))))))
|
||||
(home-page "https://pwmt.org/projects/zathura-pdf-mupdf/")
|
||||
(synopsis "PDF support for zathura (mupdf backend)")
|
||||
(description "The zathura-pdf-mupdf plugin adds PDF support to zathura
|
||||
|
@ -731,20 +732,20 @@ (define-public python-pydyf
|
|||
(define-public mupdf
|
||||
(package
|
||||
(name "mupdf")
|
||||
(version "1.19.1")
|
||||
(version "1.20.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://mupdf.com/downloads/archive/"
|
||||
"mupdf-" version "-source.tar.xz"))
|
||||
"mupdf-" version "-source.tar.lz"))
|
||||
(sha256
|
||||
(base32 "0gl0wf16m1cafs20h3v1f4ysf7zlbijjyd6s1r1krwvlzriwdsmm"))
|
||||
(base32
|
||||
"0s0qclxxdjis04mczgz0fhfpv0j8llk48g82zlfrk0daz0zgcwvg"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
#~(begin
|
||||
;; Remove bundled software.
|
||||
(let* ((keep (list "extract"
|
||||
"lcms2")) ; different from our lcms2 package
|
||||
;; Remove bundled software. Keep patched variants.
|
||||
(let* ((keep (list "extract" "freeglut" "lcms2"))
|
||||
(from "thirdparty")
|
||||
(kept (string-append from "~temp")))
|
||||
(mkdir-p kept)
|
||||
|
@ -757,7 +758,9 @@ (define-public mupdf
|
|||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
(list curl
|
||||
freeglut
|
||||
libxrandr
|
||||
libxi
|
||||
freeglut ;for GL/gl.h
|
||||
freetype
|
||||
gumbo-parser
|
||||
harfbuzz
|
||||
|
@ -773,24 +776,36 @@ (define-public mupdf
|
|||
(list pkg-config))
|
||||
(arguments
|
||||
(list
|
||||
#:tests? #f ; no check target
|
||||
#:make-flags
|
||||
#~(list "verbose=yes"
|
||||
(string-append "CC=" #$(cc-for-target))
|
||||
"XCFLAGS=-fpic"
|
||||
"USE_SYSTEM_LIBS=yes"
|
||||
"USE_SYSTEM_MUJS=yes"
|
||||
"shared=yes"
|
||||
;; Even with the linkage patch we must fix RUNPATH.
|
||||
(string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib")
|
||||
(string-append "prefix=" #$output))
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(delete 'configure)))) ; no configure script
|
||||
#:tests? #f ;no check target
|
||||
#:make-flags
|
||||
#~(list "verbose=yes"
|
||||
(string-append "CC=" #$(cc-for-target))
|
||||
"XCFLAGS=-fpic"
|
||||
"USE_SYSTEM_FREETYPE=yes"
|
||||
"USE_SYSTEM_GUMBO=yes"
|
||||
"USE_SYSTEM_HARFBUZZ=yes"
|
||||
"USE_SYSTEM_JBIG2DEC=yes"
|
||||
"USE_SYSTEM_JPEGXR=no # not available"
|
||||
"USE_SYSTEM_LCMS2=no # lcms2mt is strongly preferred"
|
||||
"USE_SYSTEM_LIBJPEG=yes"
|
||||
"USE_SYSTEM_MUJS=no # not available"
|
||||
"USE_SYSTEM_OPENJPEG=yes"
|
||||
"USE_SYSTEM_ZLIB=yes"
|
||||
"USE_SYSTEM_GLUT=no"
|
||||
"USE_SYSTEM_CURL=yes"
|
||||
"USE_SYSTEM_LEPTONICA=yes"
|
||||
"USE_SYSTEM_TESSERACT=yes"
|
||||
"USE_SYSTEM_MUJS=yes"
|
||||
"shared=yes"
|
||||
(string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib")
|
||||
(string-append "prefix=" #$output))
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(delete 'configure)))) ;no configure script
|
||||
(home-page "https://mupdf.com")
|
||||
(synopsis "Lightweight PDF viewer and toolkit")
|
||||
(description
|
||||
"MuPDF is a C library that implements a PDF and XPS parsing and
|
||||
"MuPDF is a C library that implements a PDF and XPS parsing and
|
||||
rendering engine. It is used primarily to render pages into bitmaps,
|
||||
but also provides support for other operations such as searching and
|
||||
listing the table of contents and hyperlinks.
|
||||
|
@ -799,9 +814,9 @@ (define-public mupdf
|
|||
line tools for batch rendering @command{pdfdraw}, rewriting files
|
||||
@command{pdfclean}, and examining the file structure @command{pdfshow}.")
|
||||
(license (list license:agpl3+
|
||||
license:bsd-3 ; resources/cmaps
|
||||
license:x11 ; thirdparty/lcms2
|
||||
license:silofl1.1 ; resources/fonts/{han,noto,sil,urw}
|
||||
license:bsd-3 ;resources/cmaps
|
||||
license:x11 ;thirdparty/lcms2
|
||||
license:silofl1.1 ;resources/fonts/{han,noto,sil,urw}
|
||||
license:asl2.0)))) ; resources/fonts/droid
|
||||
|
||||
(define-public qpdf
|
||||
|
|
|
@ -15,6 +15,7 @@
|
|||
;;; Copyright © 2021 Bonface Munyoki Kilyungi <me@bonfacemunyoki.com>
|
||||
;;; Copyright © 2022 Malte Frank Gerdes <malte.f.gerdes@gmail.com>
|
||||
;;; Copyright © 2022 Felix Gruber <felgru@posteo.net>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -2373,3 +2374,24 @@ (define-public python-pycotap
|
|||
attachments).
|
||||
@end itemize")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public python-xvfbwrapper
|
||||
(package
|
||||
(name "python-xvfbwrapper")
|
||||
(version "0.2.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "xvfbwrapper" version))
|
||||
(sha256
|
||||
(base32
|
||||
"097wxhvp01ikqpg1z3v8rqhss6f1vwr399zpz9a05d2135bsxx5w"))))
|
||||
(build-system python-build-system)
|
||||
(propagated-inputs (list xorg-server-for-tests))
|
||||
(home-page "https://github.com/cgoldberg/xvfbwrapper")
|
||||
(synopsis "Python module for controlling virtual displays with Xvfb")
|
||||
(description
|
||||
"Xvfb (X virtual framebuffer) is a display server implementing
|
||||
the X11 display server protocol. It runs in memory and does not require a
|
||||
physical display. Only a network layer is necessary. Xvfb is useful for
|
||||
running acceptance tests on headless servers.")
|
||||
(license license:expat)))
|
||||
|
|
|
@ -608,7 +608,7 @@ (define-public python-cryptography
|
|||
(add-after 'unpack 'set-no-rust
|
||||
(lambda _
|
||||
(setenv "CRYPTOGRAPHY_DONT_BUILD_RUST" "1"))))))
|
||||
(inputs (list openssl))
|
||||
(inputs (list openssl-1.1))
|
||||
(native-inputs
|
||||
(list python-cryptography-vectors
|
||||
python-hypothesis
|
||||
|
|
|
@ -54,6 +54,8 @@
|
|||
;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
|
||||
;;; Copyright © 2022 Luis Henrique Gomes Higino <luishenriquegh2701@gmail.com>
|
||||
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;; Copyright © 2022 msimonin <matthieu.simonin@inria.fr>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -6270,17 +6272,16 @@ (define-public python-http-ece
|
|||
(define-public python-cloudscraper
|
||||
(package
|
||||
(name "python-cloudscraper")
|
||||
(version "1.2.58")
|
||||
(version "1.2.60")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/VeNoMouS/cloudscraper")
|
||||
;; Corresponds to 1.2.58
|
||||
(commit "f3a3d067ea8b5238e9a0948aed0c3fa0d9c29b96")))
|
||||
(commit version)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32 "18fbp086imabjxly04rrchbf6n6m05bpd150zxbw7z2w3mjnpsqd"))
|
||||
(base32 "00cmxgwdm0x1j4a4ipwvpzih735hdzidljbijk1b3laj3dgvnvsm"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
'(with-directory-excursion "cloudscraper"
|
||||
|
@ -6320,7 +6321,7 @@ (define-public python-cloudscraper
|
|||
python-requests
|
||||
python-requests-toolbelt
|
||||
python-responses
|
||||
python-pyparsing-2.4.7))
|
||||
python-pyparsing))
|
||||
(native-inputs
|
||||
(list python-pytest))
|
||||
(home-page "https://github.com/venomous/cloudscraper")
|
||||
|
@ -7786,3 +7787,28 @@ (define-public python-whatthepatch
|
|||
(description
|
||||
"This package provides a library to parse and apply patches.")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public python-grid5000
|
||||
(package
|
||||
(name "python-grid5000")
|
||||
(version "1.2.3")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://gitlab.inria.fr/msimonin/python-grid5000")
|
||||
(commit (string-append "v" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
"097pm8b68ihk29xz9zv29b1x0bhgjb4lfj8zxk2grbsh7wr9dipg")))
|
||||
(build-system python-build-system)
|
||||
(native-inputs (list python-wheel))
|
||||
(propagated-inputs (list python-requests python-ipython python-pyyaml))
|
||||
(arguments
|
||||
(list #:tests? #f)) ; No tests.
|
||||
(home-page "https://pypi.org/project/python-grid5000/")
|
||||
(synopsis "Grid5000 python client")
|
||||
(description
|
||||
"python-grid5000 is a python package wrapping the Grid5000 REST API.
|
||||
You can use it as a library in your python project or you can explore the
|
||||
Grid5000 resources interactively using the embedded shell.")
|
||||
(license license:gpl3+)))
|
||||
|
|
|
@ -127,6 +127,7 @@
|
|||
;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
|
||||
;;; Copyright © 2022 Marek Felšöci <marek@felsoci.sk>
|
||||
;;; Copyright © 2022 Hilton Chain <hako@ultrarare.space>
|
||||
;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -8247,7 +8248,7 @@ (define-public python-jaraco-context
|
|||
(substitute-keyword-arguments
|
||||
(package-arguments python-jaraco-context-bootstrap)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases #~%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(replace 'check
|
||||
|
@ -8298,7 +8299,7 @@ (define-public python-jaraco-functools
|
|||
(substitute-keyword-arguments
|
||||
(package-arguments python-jaraco-functools-bootstrap)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases #~%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(replace 'check
|
||||
|
@ -8698,7 +8699,7 @@ (define-public python-jupyter-client
|
|||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments base)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases #~%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(replace 'check
|
||||
|
@ -9681,7 +9682,7 @@ (define-public snakemake-6
|
|||
;; because there are no AWS credentials.
|
||||
(delete-file "tests/test_tibanna.py")
|
||||
(invoke "pytest")))))))
|
||||
(inputs
|
||||
(propagated-inputs
|
||||
(list python-appdirs
|
||||
python-configargparse
|
||||
python-connection-pool
|
||||
|
@ -9732,15 +9733,14 @@ (define-public snakemake-7
|
|||
;; For cluster execution Snakemake will call Python. Since there is
|
||||
;; no suitable GUIX_PYTHONPATH set, cluster execution will fail. We
|
||||
;; fix this by calling the snakemake wrapper instead.
|
||||
|
||||
;; XXX: There is another instance of sys.executable on line 692, but
|
||||
;; it is not clear how to patch it.
|
||||
(add-after 'unpack 'call-wrapper-not-wrapped-snakemake
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(substitute* "snakemake/executors/__init__.py"
|
||||
(("\\{sys.executable\\} -m snakemake")
|
||||
(string-append (assoc-ref outputs "out")
|
||||
"/bin/snakemake")))))
|
||||
(("self\\.get_python_executable\\(\\),")
|
||||
"")
|
||||
(("\"-m snakemake\"")
|
||||
(string-append "\"" (assoc-ref outputs "out")
|
||||
"/bin/snakemake" "\"")))))
|
||||
(replace 'check
|
||||
(lambda* (#:key tests? #:allow-other-keys)
|
||||
(when tests?
|
||||
|
@ -9752,7 +9752,7 @@ (define-public snakemake-7
|
|||
;; to the Google Storage service.
|
||||
(delete-file "tests/test_google_lifesciences.py")
|
||||
(invoke "pytest")))))))
|
||||
(inputs
|
||||
(propagated-inputs
|
||||
(list python-appdirs
|
||||
python-configargparse
|
||||
python-connection-pool
|
||||
|
@ -11298,7 +11298,7 @@ (define-public python-fonttools-full
|
|||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments python-fonttools)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases '%standard-phases)
|
||||
`(modify-phases ,phases
|
||||
(replace 'check
|
||||
|
@ -12375,7 +12375,7 @@ (define-public python-path
|
|||
(substitute-keyword-arguments
|
||||
(package-arguments python-path-bootstrap)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases #~%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(replace 'check
|
||||
|
@ -12498,7 +12498,7 @@ (define-public python-pip-run
|
|||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments python-pip-run-bootstrap)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases #~%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(replace 'check
|
||||
|
@ -30424,6 +30424,68 @@ (define-public python-bsdiff4
|
|||
and @code{bspatch4}.")
|
||||
(license license:bsd-2)))
|
||||
|
||||
(define-public python-mpv
|
||||
(package
|
||||
(name "python-mpv")
|
||||
(version "1.0.1")
|
||||
(source
|
||||
(origin
|
||||
;; python-mpv from pypi does not include the tests directory.
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/jaseg/python-mpv")
|
||||
(commit (string-append "v" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"10w6j3n62ap45sf6q487kz8z6g58sha37i14fa2hhng794z7a8jh"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
#~(begin
|
||||
;; One of the tests never completes, so neutering it using
|
||||
;; early return allows other test to run without issue.
|
||||
(substitute* "tests/test_mpv.py"
|
||||
;; Note the typo in "prooperty" - this was fixed later in
|
||||
;; upstream but has no effect on whether the tests hangs or not.
|
||||
(("test_wait_for_prooperty_event_overflow.*" line)
|
||||
;; The long whitespace between \n and return is to match the
|
||||
;; identation level, which is significant in python.
|
||||
(string-append line "\n return\n")))))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
(list #:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-before 'build 'patch-reference-to-mpv
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Without an absolute path it is not able find and
|
||||
;; load the libmpv library.
|
||||
(substitute* "mpv.py"
|
||||
(("sofile = .*")
|
||||
(string-append "sofile = \""
|
||||
(search-input-file inputs "/lib/libmpv.so")
|
||||
"\"\n")))))
|
||||
(add-before 'check 'prepare-for-tests
|
||||
(lambda _
|
||||
;; Fontconfig throws errors when it has no cache dir to use.
|
||||
(setenv "XDG_CACHE_HOME" (getcwd))
|
||||
;; Some tests fail without a writable and readable HOME.
|
||||
(setenv "HOME" (getcwd)))))))
|
||||
(native-inputs
|
||||
(list python-xvfbwrapper)) ; needed for tests only
|
||||
(inputs (list mpv))
|
||||
(propagated-inputs (list python-pillow)) ; for raw screenshots
|
||||
(home-page "https://github.com/jaseg/python-mpv")
|
||||
(synopsis "Python interface to the mpv media player")
|
||||
(description
|
||||
"python-mpv is a ctypes-based python interface to the mpv media player.
|
||||
It gives you more or less full control of all features of the player, just
|
||||
as the lua interface does.")
|
||||
;; From the project's README:
|
||||
;; python-mpv inherits the underlying libmpv's license, which can be either
|
||||
;; GPLv2 or later (default) or LGPLv2.1 or later. For details, see the mpv
|
||||
;; copyright page.
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public python-biblib
|
||||
(let ((upstream-version "0.1.0")
|
||||
(commit "ab0e857b9198fe425ec9b02fcc293b5d9fd0c406")
|
||||
|
|
|
@ -388,7 +388,7 @@ (define-public python-2.7
|
|||
gdbm
|
||||
libffi ; for ctypes
|
||||
sqlite ; for sqlite extension
|
||||
openssl
|
||||
openssl-1.1
|
||||
readline
|
||||
zlib
|
||||
tcl
|
||||
|
@ -556,6 +556,9 @@ (define-public python-3.9
|
|||
(map cdr outputs)))))
|
||||
(replace 'install-sitecustomize.py
|
||||
,(customize-site version))))))
|
||||
(inputs
|
||||
(modify-inputs (package-inputs python-2.7)
|
||||
(replace "openssl" openssl)))
|
||||
(native-inputs
|
||||
`(("tzdata" ,tzdata-for-tests)
|
||||
("unzip" ,unzip)
|
||||
|
|
|
@ -29,6 +29,7 @@
|
|||
;;; Copyright © 2020 Tomás Ortín Fernández <tomasortin@mailbox.org>
|
||||
;;; Copyright © 2021 Giovanni Biscuolo <g@xelera.eu>
|
||||
;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
|
||||
;;; Copyright © 2022 Remco van 't Veer <remco@remworks.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -100,7 +101,7 @@ (define %prawn-project-licenses
|
|||
(define-public ruby-2.6
|
||||
(package
|
||||
(name "ruby")
|
||||
(version "2.6.5")
|
||||
(version "2.6.10")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
@ -109,7 +110,7 @@ (define-public ruby-2.6
|
|||
"/ruby-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0qhsw2mr04f3lqinkh557msr35pb5rdaqy4vdxcj91flgxqxmmnm"))
|
||||
"1wn12klc44hn2nh5v1lkqbdyvljip6qhwjqvkkf8zf112gaxxn2z"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet `(begin
|
||||
;; Remove bundled libffi
|
||||
|
@ -137,7 +138,7 @@ (define-public ruby-2.6
|
|||
(("/bin/sh") (which "sh")))
|
||||
#t)))))
|
||||
(inputs
|
||||
(list readline openssl libffi gdbm))
|
||||
(list readline openssl-1.1 libffi gdbm))
|
||||
(propagated-inputs
|
||||
(list zlib))
|
||||
(native-search-paths
|
||||
|
@ -154,6 +155,7 @@ (define-public ruby-2.7
|
|||
(package
|
||||
(inherit ruby-2.6)
|
||||
(version "2.7.4")
|
||||
(replacement ruby-2.7-fixed) ; security fixes
|
||||
(source
|
||||
(origin
|
||||
(inherit (package-source ruby-2.6))
|
||||
|
@ -188,10 +190,24 @@ (define-public ruby-2.7
|
|||
(native-inputs
|
||||
(list autoconf))))
|
||||
|
||||
(define ruby-2.7-fixed
|
||||
(package
|
||||
(inherit ruby-2.7)
|
||||
(version "2.7.6")
|
||||
(source
|
||||
(origin
|
||||
(inherit (package-source ruby-2.7))
|
||||
(uri (string-append "https://cache.ruby-lang.org/pub/ruby/"
|
||||
(version-major+minor version)
|
||||
"/ruby-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"042xrdk7hsv4072bayz3f8ffqh61i8zlhvck10nfshllq063n877"))))))
|
||||
|
||||
(define-public ruby-3.0
|
||||
(package
|
||||
(inherit ruby-2.7)
|
||||
(version "3.0.2")
|
||||
(version "3.0.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
@ -200,12 +216,15 @@ (define-public ruby-3.0
|
|||
"/ruby-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0h2w2ms4gx2s96v3lzdr3add94bd2qqkhdjzaycmaqhg21rpf3jp"))))))
|
||||
"1w7jpq3flnm007z5kj8kixgm8l4smb80w8ak4993a12j0irzq8lf"))))
|
||||
(inputs
|
||||
(modify-inputs (package-inputs ruby-2.7)
|
||||
(replace "openssl" openssl)))))
|
||||
|
||||
(define-public ruby-3.1
|
||||
(package
|
||||
(inherit ruby-2.7)
|
||||
(version "3.1.1")
|
||||
(inherit ruby-3.0)
|
||||
(version "3.1.2")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
@ -214,40 +233,7 @@ (define-public ruby-3.1
|
|||
"/ruby-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1akcl7vhmwfm6ybj7493kzy58ykh2r39ri9f4xfm2xmhg1msmvvs"))))))
|
||||
|
||||
(define-public ruby-2.5
|
||||
(package
|
||||
(inherit ruby-2.6)
|
||||
(version "2.5.9")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://cache.ruby-lang.org/pub/ruby/"
|
||||
(version-major+minor version)
|
||||
"/ruby-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1w2qncacm7h3f3il1whghdabwnv9fvwmz9f1a9vcg32006ljyzx8"))))))
|
||||
|
||||
(define-public ruby-2.4
|
||||
(package
|
||||
(inherit ruby-2.6)
|
||||
(version "2.4.10")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://cache.ruby-lang.org/pub/ruby/"
|
||||
(version-major+minor version)
|
||||
"/ruby-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1prhqlgik1zmw9lakl6hkriqslspw48pvhxff17h7ns42p8qwrnm"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet `(begin
|
||||
;; Remove bundled libffi
|
||||
(delete-file-recursively "ext/fiddle/libffi-3.2.1")
|
||||
#t))))))
|
||||
"0amzqczgvr51ilcqfgw0n41hrfanzi0wh8k6am3x5dm1z0bx046a"))))))
|
||||
|
||||
(define-public ruby ruby-2.7)
|
||||
|
||||
|
@ -7203,7 +7189,8 @@ (define-public ruby-rubocop
|
|||
(arguments
|
||||
`(#:test-target "default"
|
||||
;; TODO: Figure out why test hangs.
|
||||
#:tests? ,(not (target-riscv64?))
|
||||
#:tests? ,(not (or (%current-target-system)
|
||||
(target-riscv64?)))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before 'check 'set-home
|
||||
|
|
|
@ -594,7 +594,7 @@ (define-public rust
|
|||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments base-rust)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
(not (%current-target-system)))
|
||||
((#:phases phases)
|
||||
`(modify-phases ,phases
|
||||
(add-after 'unpack 'relax-gdb-auto-load-safe-path
|
||||
|
|
|
@ -415,7 +415,7 @@ (define (target->openssl-target target)
|
|||
(error "unsupported openssl target architecture")))))
|
||||
(string-append kernel "-" arch))))
|
||||
|
||||
(define-public openssl
|
||||
(define-public openssl-1.1
|
||||
(package
|
||||
(name "openssl")
|
||||
(version "1.1.1l")
|
||||
|
@ -545,7 +545,7 @@ (define-public openssl
|
|||
|
||||
(define openssl/fixed
|
||||
(package
|
||||
(inherit openssl)
|
||||
(inherit openssl-1.1)
|
||||
(name "openssl")
|
||||
(version "1.1.1q")
|
||||
(source (origin
|
||||
|
@ -564,7 +564,7 @@ (define openssl/fixed
|
|||
|
||||
(define-public openssl-3.0
|
||||
(package
|
||||
(inherit openssl)
|
||||
(inherit openssl-1.1)
|
||||
(version "3.0.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
|
@ -580,7 +580,7 @@ (define-public openssl-3.0
|
|||
(base32
|
||||
"0yja085lygkdxbf4k4rckkj9r24p8dgix8avqljnbbbixydqszda"))))
|
||||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments openssl)
|
||||
(substitute-keyword-arguments (package-arguments openssl-1.1)
|
||||
((#:phases phases '%standard-phases)
|
||||
#~(modify-phases #$phases
|
||||
(add-before 'configure 'configure-perl
|
||||
|
@ -590,6 +590,8 @@ (define-public openssl-3.0
|
|||
"/bin/perl"))))))))
|
||||
(license license:asl2.0)))
|
||||
|
||||
(define-public openssl openssl-1.1)
|
||||
|
||||
(define-public bearssl
|
||||
(package
|
||||
(name "bearssl")
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;;; Copyright © 2017, 2018, 2020–2022 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
;;; Copyright © 2019 Jesse Gibbons <jgibbons2357+guix@gmail.com>
|
||||
;;; Copyright © 2019, 2020, 2021 Timotej Lazar <timotej.lazar@araneo.si>
|
||||
;;; Copyright © 2019 Liliana Marie Prikler <liliana.prikler@gmail.com>
|
||||
;;; Copyright © 2019, 2022 Liliana Marie Prikler <liliana.prikler@gmail.com>
|
||||
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
|
||||
;;;
|
||||
|
@ -23,22 +23,119 @@
|
|||
|
||||
(define-module (gnu packages toys)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages man)
|
||||
#:use-module (gnu packages multiprecision)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages pretty-print)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system copy)
|
||||
#:use-module (guix build-system meson)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix utils))
|
||||
|
||||
(define-public daikichi
|
||||
(package
|
||||
(name "daikichi")
|
||||
(version "0.3.0")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://gitlab.com/lilyp/daikichi")
|
||||
(commit version)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1y35f1qpxl743s0s83dg5ivkvprv19mqn0azm14k3y8pmp6cs52z"))))
|
||||
(build-system meson-build-system)
|
||||
(arguments
|
||||
(list #:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'unpack 'hard-code-test-paths
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* (list "test-dat.in" "test-strings.in")
|
||||
(("(basename|cmp|diff|mktemp|rm|sed|seq)" cmd)
|
||||
(search-input-file inputs
|
||||
(string-append "bin/" cmd)))))))))
|
||||
(inputs (list bash-minimal coreutils sed
|
||||
fmt gmp))
|
||||
(native-inputs (list pkg-config))
|
||||
(home-page "https://gitlab.com/lilyp/daikichi")
|
||||
(synopsis "Display random fortunes")
|
||||
(description "Daikichi is an alternative implementation of
|
||||
@command{fortune}, which displays random quotes from a database.
|
||||
This package provides just the utilities and no quotes.")
|
||||
(license license:gpl3+)
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "DAIKICHI_FORTUNE_PATH")
|
||||
(files '("share/fortunes")))))))
|
||||
|
||||
(define-public fortunes-jkirchartz
|
||||
;; No public release.
|
||||
;; Note to updaters: Please ensure that new quotes do not bring harm
|
||||
;; rather than fortune.
|
||||
(let ((commit "2e32ba0a57e3842dc06c8128d880ab4c8ec3aefc")
|
||||
(revision "0"))
|
||||
(package
|
||||
(name "fortunes-jkirchartz")
|
||||
(version (git-version "0" revision commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/JKirchartz/fortunes")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1ym4ldzww5yfd76q7zvhi491bqlykfjnc215bqx1cbj0c8ndb2l4"))
|
||||
(snippet
|
||||
#~(for-each delete-file
|
||||
;; incompatible license
|
||||
'("BibleAbridged")))))
|
||||
(build-system copy-build-system)
|
||||
(native-inputs (list daikichi gnu-make))
|
||||
(arguments
|
||||
(list #:install-plan
|
||||
#~`(("." "share/fortunes" #:include-regexp ("\\.dat$")))
|
||||
#:phases
|
||||
#~(modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-source
|
||||
(lambda* (#:key inputs native-inputs #:allow-other-keys)
|
||||
(substitute* "showerthoughts"
|
||||
(("<") "<")
|
||||
((">") ">")
|
||||
(("&") "&"))
|
||||
(substitute* "Makefile"
|
||||
(("strfile") "daikichi pack"))))
|
||||
(add-before 'install 'build
|
||||
(lambda _
|
||||
(invoke "make")))
|
||||
(add-after 'build 'check
|
||||
(lambda* (#:key inputs tests? #:allow-other-keys)
|
||||
(when tests?
|
||||
(apply
|
||||
invoke
|
||||
(search-input-file inputs "libexec/daikichi/test-dat")
|
||||
(find-files "." "\\.dat$"))))))))
|
||||
(home-page "https://github.com/JKirchartz/fortunes")
|
||||
(synopsis "Collection of fortunes")
|
||||
(description "This package contains a large collection of quotes to
|
||||
display via @command{fortune}, drawn from sources all around the world.")
|
||||
(license license:unlicense))))
|
||||
|
||||
(define-public lolcat
|
||||
(let ((commit "35dca3d0a381496d7195cd78f5b24aa7b62f2154")
|
||||
(revision "0"))
|
||||
|
|
|
@ -1735,15 +1735,16 @@ (define-public pre-commit
|
|||
(define-public mercurial
|
||||
(package
|
||||
(name "mercurial")
|
||||
(version "5.8.1")
|
||||
(version "6.2.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://www.mercurial-scm.org/"
|
||||
"release/mercurial-" version ".tar.gz"))
|
||||
(patches (search-patches "mercurial-hg-extension-path.patch"))
|
||||
(patches (search-patches "mercurial-hg-extension-path.patch"
|
||||
"mercurial-openssl-compat.patch"))
|
||||
(sha256
|
||||
(base32
|
||||
"16xi4bmjqzi7ig8sfa5mnypfpbbbiyafmmqrs4nxmgc743za7fl1"))))
|
||||
"1nl2726szaxyrxlyssrsir5c6vb4ci0i6g969i6xaahw1nidgica"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:make-flags
|
||||
|
@ -1753,13 +1754,11 @@ (define-public mercurial
|
|||
(delete 'configure)
|
||||
(add-after 'unpack 'patch-tests
|
||||
(lambda _
|
||||
(substitute* '("tests/test-extdiff.t"
|
||||
"tests/test-logtoprocess.t"
|
||||
"tests/test-patchbomb.t"
|
||||
"tests/test-run-tests.t"
|
||||
"tests/test-transplant.t")
|
||||
(substitute* (find-files "tests" "\\.(t|py)$")
|
||||
(("/bin/sh")
|
||||
(which "sh")))))
|
||||
(which "sh"))
|
||||
(("/usr/bin/env")
|
||||
(which "env")))))
|
||||
(replace 'check
|
||||
(lambda* (#:key tests? #:allow-other-keys)
|
||||
(with-directory-excursion "tests"
|
||||
|
@ -1770,6 +1769,12 @@ (define-public mercurial
|
|||
;; PATH from before (that's why we are building it!)?
|
||||
"test-hghave.t"
|
||||
|
||||
;; This test creates a shebang spanning multiple
|
||||
;; lines which is difficult to substitute. It
|
||||
;; only tests the test runner itself, which gets
|
||||
;; thoroughly tested during the check phase anyway.
|
||||
"test-run-tests.t"
|
||||
|
||||
;; These tests fail because the program is not
|
||||
;; connected to a TTY in the build container.
|
||||
"test-nointerrupt.t"
|
||||
|
@ -1778,6 +1783,15 @@ (define-public mercurial
|
|||
;; FIXME: This gets killed but does not receive an interrupt.
|
||||
"test-commandserver.t"
|
||||
|
||||
;; These tests get unexpected warnings about using
|
||||
;; deprecated functionality in Python, but otherwise
|
||||
;; succeed; try enabling for later Mercurial versions.
|
||||
"test-demandimport.py"
|
||||
"test-patchbomb-tls.t"
|
||||
;; Similarly, this gets a more informative error
|
||||
;; message from Python 3.10 than it expects.
|
||||
"test-http-bad-server.t"
|
||||
|
||||
;; Only works when run in a hg-repo, not in an
|
||||
;; extracted tarball
|
||||
"test-doctest.py"
|
||||
|
@ -1808,7 +1822,7 @@ (define-public mercurial
|
|||
;; The following inputs are only needed to run the tests.
|
||||
python-nose unzip which))
|
||||
(inputs
|
||||
(list python))
|
||||
(list python-wrapper))
|
||||
;; Find third-party extensions.
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
|
|
|
@ -2497,7 +2497,7 @@ (define-public yt-dlp
|
|||
(base32 "07qz1zdndlpki0asw35zk5hdjcwpl3n1g54nxg4yb1iykbyv7rll"))))
|
||||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments youtube-dl)
|
||||
((#:tests? _) #t)
|
||||
((#:tests? _) (not (%current-target-system)))
|
||||
((#:phases phases)
|
||||
#~(modify-phases #$phases
|
||||
;; See the comment for the corresponding phase in youtube-dl.
|
||||
|
|
|
@ -77,7 +77,7 @@ (define-module (gnu packages vim)
|
|||
(define-public vim
|
||||
(package
|
||||
(name "vim")
|
||||
(version "9.0.0235")
|
||||
(version "9.0.0325")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
|
@ -86,7 +86,7 @@ (define-public vim
|
|||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1fshlggcq1fw4cbsgmagwxkmdiwv2cla0vds383z49ayqgqnamnj"))))
|
||||
"18m3lhp7d8a0n3bx0kqn082gqrh7lyar1ndvwq79gj73fz5c19vh"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:test-target "test"
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
|
||||
;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
|
||||
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2020, 2021 Marius Bakke <mbakke@fastmail.com>
|
||||
;;; Copyright © 2020, 2021, 2022 Marius Bakke <marius@gnu.org>
|
||||
;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
|
||||
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
|
||||
|
@ -1311,9 +1311,16 @@ (define-public libvirt
|
|||
(substitute* "scripts/meson-install-dirs.py"
|
||||
(("destdir = .*")
|
||||
"destdir = '/tmp'"))))
|
||||
(add-after 'unpack 'use-absolute-dnsmasq
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((dnsmasq (search-input-file inputs "sbin/dnsmasq")))
|
||||
(substitute* "src/util/virdnsmasq.c"
|
||||
(("#define DNSMASQ \"dnsmasq\"")
|
||||
(string-append "#define DNSMASQ \"" dnsmasq "\""))))))
|
||||
(add-before 'configure 'disable-broken-tests
|
||||
(lambda _
|
||||
(let ((tests (list "commandtest" ; hangs idly
|
||||
"networkxml2conftest" ; fails with absolute dnsmasq
|
||||
"qemuxml2argvtest" ; fails
|
||||
"virnetsockettest"))) ; tries to network
|
||||
(substitute* "tests/meson.build"
|
||||
|
|
|
@ -482,11 +482,8 @@ (define (provenance-file channels config-file)
|
|||
(define (provenance-entry config-file)
|
||||
"Return system entries describing the operating system provenance: the
|
||||
channels in use and CONFIG-FILE, if it is true."
|
||||
(define profile
|
||||
(current-profile))
|
||||
|
||||
(define channels
|
||||
(and=> profile profile-channels))
|
||||
(current-channels))
|
||||
|
||||
(mbegin %store-monad
|
||||
(let ((config-file (cond ((string? config-file)
|
||||
|
|
687
gnu/services/lightdm.scm
Normal file
687
gnu/services/lightdm.scm
Normal file
|
@ -0,0 +1,687 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2019, 2020 L p R n d n <guix@lprndn.info>
|
||||
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu services lightdm)
|
||||
#:use-module (gnu artwork)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu packages display-managers)
|
||||
#:use-module (gnu packages freedesktop)
|
||||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages vnc)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu services configuration)
|
||||
#:use-module (gnu services dbus)
|
||||
#:use-module (gnu services desktop)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (gnu services xorg)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu system pam)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (guix diagnostics)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix i18n)
|
||||
#:use-module (guix records)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (lightdm-seat-configuration
|
||||
lightdm-seat-configuration?
|
||||
lightdm-seat-configuration-name
|
||||
lightdm-seat-configuration-type
|
||||
lightdm-seat-configuration-user-session
|
||||
lightdm-seat-configuration-autologin-user
|
||||
lightdm-seat-configuration-greeter-session
|
||||
lightdm-seat-configuration-xserver-command
|
||||
lightdm-seat-configuration-session-wrapper
|
||||
lightdm-seat-configuration-extra-config
|
||||
|
||||
lightdm-gtk-greeter-configuration
|
||||
lightdm-gtk-greeter-configuration?
|
||||
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
|
||||
lightdm-gtk-greeter-configuration-assets
|
||||
lightdm-gtk-greeter-configuration-theme-name
|
||||
lightdm-gtk-greeter-configuration-icon-theme-name
|
||||
lightdm-gtk-greeter-configuration-cursor-theme-name
|
||||
lightdm-gtk-greeter-configuration-allow-debug
|
||||
lightdm-gtk-greeter-configuration-background
|
||||
lightdm-gtk-greeter-configuration-a11y-states
|
||||
lightdm-gtk-greeter-configuration-reader
|
||||
lightdm-gtk-greeter-configuration-extra-config
|
||||
|
||||
lightdm-configuration
|
||||
lightdm-configuration?
|
||||
lightdm-configuration-lightdm
|
||||
lightdm-configuration-allow-empty-passwords?
|
||||
lightdm-configuration-xorg-configuration
|
||||
lightdm-configuration-greeters
|
||||
lightdm-configuration-seats
|
||||
lightdm-configuration-xdmcp?
|
||||
lightdm-configuration-xdmcp-listen-address
|
||||
lightdm-configuration-vnc-server?
|
||||
lightdm-configuration-vnc-server-command
|
||||
lightdm-configuration-vnc-server-listen-address
|
||||
lightdm-configuration-vnc-server-port
|
||||
lightdm-configuration-extra-config
|
||||
|
||||
lightdm-service-type))
|
||||
|
||||
;;;
|
||||
;;; Greeters.
|
||||
;;;
|
||||
|
||||
(define list-of-file-likes?
|
||||
(list-of file-like?))
|
||||
|
||||
(define %a11y-states '(contrast font keyboard reader))
|
||||
|
||||
(define (a11y-state? value)
|
||||
(memq value %a11y-states))
|
||||
|
||||
(define list-of-a11y-states?
|
||||
(list-of a11y-state?))
|
||||
|
||||
(define-maybe boolean)
|
||||
|
||||
(define (serialize-boolean name value)
|
||||
(define (strip-trailing-? name)
|
||||
;; field? -> field
|
||||
(let ((str (symbol->string name)))
|
||||
(if (string-suffix? "?" str)
|
||||
(string-drop-right str 1)
|
||||
str)))
|
||||
(format #f "~a=~:[false~;true~]~%" (strip-trailing-? name) value))
|
||||
|
||||
(define-maybe file-like)
|
||||
|
||||
(define (serialize-file-like name value)
|
||||
#~(format #f "~a=~a~%" '#$name #$value))
|
||||
|
||||
(define (serialize-list-of-a11y-states name value)
|
||||
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
|
||||
|
||||
(define (serialize-string name value)
|
||||
(format #f "~a=~a~%" name value))
|
||||
|
||||
(define (serialize-number name value)
|
||||
(format #f "~a=~a~%" name value))
|
||||
|
||||
(define (serialize-list-of-strings _ value)
|
||||
(string-join value "\n"))
|
||||
|
||||
(define-configuration lightdm-gtk-greeter-configuration
|
||||
(lightdm-gtk-greeter
|
||||
(file-like lightdm-gtk-greeter)
|
||||
"The lightdm-gtk-greeter package to use."
|
||||
empty-serializer)
|
||||
(assets
|
||||
(list-of-file-likes (list adwaita-icon-theme
|
||||
gnome-themes-extra
|
||||
;; FIXME: hicolor-icon-theme should be in the
|
||||
;; packages of the desktop templates.
|
||||
hicolor-icon-theme))
|
||||
"The list of packages complementing the greeter, such as package providing
|
||||
icon themes."
|
||||
empty-serializer)
|
||||
(theme-name
|
||||
(string "Adwaita")
|
||||
"The name of the theme to use.")
|
||||
(icon-theme-name
|
||||
(string "Adwaita")
|
||||
"The name of the icon theme to use.")
|
||||
(cursor-theme-name
|
||||
(string "Adwaita")
|
||||
"The name of the cursor theme to use.")
|
||||
(cursor-theme-size
|
||||
(number 16)
|
||||
"The size to use for the the cursor theme.")
|
||||
(allow-debugging?
|
||||
maybe-boolean
|
||||
"Set to #t to enable debug log level.")
|
||||
(background
|
||||
(file-like (file-append %artwork-repository
|
||||
"/backgrounds/guix-checkered-16-9.svg"))
|
||||
"The background image to use.")
|
||||
;; FIXME: This should be enabled by default, but it currently doesn't work,
|
||||
;; failing to connect to D-Bus, causing the login to fail.
|
||||
(at-spi-enabled?
|
||||
(boolean #f)
|
||||
"Enable accessibility support through the Assistive Technology Service
|
||||
Provider Interface (AT-SPI).")
|
||||
(a11y-states
|
||||
(list-of-a11y-states %a11y-states)
|
||||
"The accessibility features to enable, given as list of symbols.")
|
||||
(reader
|
||||
maybe-file-like
|
||||
"The command to use to launch a screen reader.")
|
||||
(extra-config
|
||||
(list-of-strings '())
|
||||
"Extra configuration values to append to the LightDM GTK Greeter
|
||||
configuration file."))
|
||||
|
||||
(define (strip-class-name-brackets name)
|
||||
"Remove the '<<' and '>>' brackets from NAME, a symbol."
|
||||
(let ((name* (symbol->string name)))
|
||||
(if (and (string-prefix? "<<" name*)
|
||||
(string-suffix? ">>" name*))
|
||||
(string->symbol (string-drop (string-drop-right name* 2) 2))
|
||||
(error "unexpected class name" name*))))
|
||||
|
||||
(define (config->name config)
|
||||
"Return the constructor name (a symbol) from CONFIG."
|
||||
(strip-class-name-brackets (class-name (class-of config))))
|
||||
|
||||
(define (greeter-configuration->greeter-fields config)
|
||||
"Return the fields of CONFIG, a greeter configuration."
|
||||
(match config
|
||||
;; Note: register any new greeter configuration here.
|
||||
((? lightdm-gtk-greeter-configuration?)
|
||||
lightdm-gtk-greeter-configuration-fields)))
|
||||
|
||||
(define (greeter-configuration->packages config)
|
||||
"Return the list of greeter packages, including assets, used by CONFIG, a
|
||||
greeter configuration."
|
||||
(match config
|
||||
;; Note: register any new greeter configuration here.
|
||||
((? lightdm-gtk-greeter-configuration?)
|
||||
(cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
|
||||
(lightdm-gtk-greeter-configuration-assets config)))))
|
||||
|
||||
;;; TODO: Implement directly in (gnu services configuration), perhaps by
|
||||
;;; making the FIELDS argument optional.
|
||||
(define (serialize-configuration* config)
|
||||
"Like `serialize-configuration', but not requiring to provide a FIELDS
|
||||
argument."
|
||||
(define fields (greeter-configuration->greeter-fields config))
|
||||
(serialize-configuration config fields))
|
||||
|
||||
(define (greeter-configuration->conf-name config)
|
||||
"Return the file name of CONFIG, a greeter configuration."
|
||||
(format #f "~a.conf" (greeter-configuration->greeter-session config)))
|
||||
|
||||
(define (greeter-configuration->file config)
|
||||
"Serialize CONFIG into a file under the output directory, so that it can be
|
||||
easily added to XDG_CONF_DIRS."
|
||||
(computed-file
|
||||
(greeter-configuration->conf-name config)
|
||||
#~(begin
|
||||
(call-with-output-file #$output
|
||||
(lambda (port)
|
||||
(format port (string-append
|
||||
"[greeter]\n"
|
||||
#$(serialize-configuration* config))))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Seats.
|
||||
;;;
|
||||
|
||||
(define seat-name? string?)
|
||||
|
||||
(define (serialize-seat-name _ value)
|
||||
(format #f "[Seat:~a]~%" value))
|
||||
|
||||
(define (seat-type? type)
|
||||
(memq type '(local xremote)))
|
||||
|
||||
(define (serialize-seat-type name value)
|
||||
(format #f "~a=~a~%" name value))
|
||||
|
||||
(define-maybe seat-type)
|
||||
|
||||
(define (greeter-session? value)
|
||||
(memq value '(lightdm-gtk-greeter)))
|
||||
|
||||
(define (serialize-greeter-session name value)
|
||||
(format #f "~a=~a~%" name value))
|
||||
|
||||
(define-maybe greeter-session)
|
||||
|
||||
(define-maybe string)
|
||||
|
||||
;;; Note: all the fields except for the seat name should be 'maybe's, since
|
||||
;;; the real default value is set by the %lightdm-seat-default define later,
|
||||
;;; and this avoids repeating ourselves in the serialized configuration file.
|
||||
(define-configuration lightdm-seat-configuration
|
||||
(name
|
||||
seat-name
|
||||
"The name of the seat. An asterisk (*) can be used in the name
|
||||
to apply the seat configuration to all the seat names it matches.")
|
||||
(user-session
|
||||
maybe-string
|
||||
"The session to use by default. The session name must be provided as a
|
||||
lowercase string, such as @code{\"gnome\"}, @code{\"ratpoison\"}, etc.")
|
||||
(type
|
||||
(seat-type 'local)
|
||||
"The type of the seat, either the @code{local} or @code{xremote} symbol.")
|
||||
(autologin-user
|
||||
maybe-string
|
||||
"The username to automatically log in with by default.")
|
||||
(greeter-session
|
||||
(greeter-session 'lightdm-gtk-greeter)
|
||||
"The greeter session to use, specified as a symbol. Currently, only
|
||||
@code{lightdm-gtk-greeter} is supported.")
|
||||
;; Note: xserver-command must be lazily computed, so that it can be
|
||||
;; overridden via 'lightdm-configuration-xorg-configuration'.
|
||||
(xserver-command
|
||||
maybe-file-like
|
||||
"The Xorg server command to run.")
|
||||
(session-wrapper
|
||||
(file-like (xinitrc))
|
||||
"The xinitrc session wrapper to use.")
|
||||
(extra-config
|
||||
(list-of-strings '())
|
||||
"Extra configuration values to append to the seat configuration section."))
|
||||
|
||||
(define (greeter-session->greater-configuration-pred identifier)
|
||||
"Return the predicate to check if a configuration is of the type specifying
|
||||
a greeter identified by IDENTIFIER."
|
||||
(match identifier
|
||||
;; Note: register any new greeter identifier here.
|
||||
('lightdm-gtk-greeter
|
||||
lightdm-gtk-greeter-configuration?)))
|
||||
|
||||
(define (greeter-configuration->greeter-session config)
|
||||
"Given CONFIG, a greeter configuration object, return its identifier,
|
||||
a symbol."
|
||||
(let ((suffix "-configuration")
|
||||
(greeter-conf-name (config->name config)))
|
||||
(string->symbol (string-drop-right (symbol->string greeter-conf-name)
|
||||
(string-length suffix)))))
|
||||
|
||||
(define list-of-seat-configurations?
|
||||
(list-of lightdm-seat-configuration?))
|
||||
|
||||
|
||||
;;;
|
||||
;;; LightDM.
|
||||
;;;
|
||||
|
||||
(define (greeter-configuration? config)
|
||||
(or (lightdm-gtk-greeter-configuration? config)
|
||||
;; Note: register any new greeter configuration here.
|
||||
))
|
||||
|
||||
(define (list-of-greeter-configurations? greeter-configs)
|
||||
(and ((list-of greeter-configuration?) greeter-configs)
|
||||
;; Greeter configurations must also not be provided more than once.
|
||||
(let* ((types (map (cut (compose class-name class-of) <>)
|
||||
greeter-configs))
|
||||
(dupes (filter (lambda (type)
|
||||
(< 1 (count (cut eq? type <>) types)))
|
||||
types)))
|
||||
(unless (null? dupes)
|
||||
(leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
|
||||
|
||||
(define-configuration/no-serialization lightdm-configuration
|
||||
(lightdm
|
||||
(file-like lightdm)
|
||||
"The lightdm package to use.")
|
||||
(allow-empty-passwords?
|
||||
(boolean #f)
|
||||
"Whether users not having a password set can login.")
|
||||
(debug?
|
||||
(boolean #f)
|
||||
"Enable verbose output.")
|
||||
(xorg-configuration
|
||||
(xorg-configuration (xorg-configuration))
|
||||
"The default Xorg server configuration to use to generate the Xorg server
|
||||
start script. It can be refined per seat via the @code{xserver-command} of
|
||||
the @code{<lightdm-seat-configuration>} record, if desired.")
|
||||
(greeters
|
||||
(list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
|
||||
"The LightDM greeter configurations specifying the greeters to use.")
|
||||
(seats
|
||||
(list-of-seat-configurations (list (lightdm-seat-configuration
|
||||
(name "*"))))
|
||||
"The seat configurations to use. A LightDM seat is akin to a user.")
|
||||
(xdmcp?
|
||||
(boolean #f)
|
||||
"Whether a XDMCP server should listen on port UDP 177.")
|
||||
(xdmcp-listen-address
|
||||
maybe-string
|
||||
"The host or IP address the XDMCP server listens for incoming connections.
|
||||
When unspecified, listen on for any hosts/IP addresses.")
|
||||
(vnc-server?
|
||||
(boolean #f)
|
||||
"Whether a VNC server is started.")
|
||||
(vnc-server-command
|
||||
(file-like (file-append tigervnc-server "bin/Xvnc"))
|
||||
"The Xvnc command to use for the VNC server, it's possible to provide extra
|
||||
options not otherwise exposed along the command, for example to disable
|
||||
security:
|
||||
@lisp
|
||||
(vnc-server-command
|
||||
(file-append tigervnc-server \"/bin/Xvnc\"
|
||||
\" -SecurityTypes None\" ))
|
||||
@end lisp
|
||||
|
||||
Or to set a PasswordFile for the classic (unsecure) VncAuth mecanism:
|
||||
@lisp
|
||||
(vnc-server-command
|
||||
(file-append tigervnc-server \"/bin/Xvnc\"
|
||||
\" -PasswordFile /var/lib/lightdm/.vnc/passwd\"))
|
||||
@end lisp
|
||||
The password file should be manually created using the @command{vncpasswd}
|
||||
command.
|
||||
|
||||
Note that LightDM will create new sessions for VNC users, which means they
|
||||
need to authenticate in the same way as local users would.
|
||||
")
|
||||
(vnc-server-listen-address
|
||||
maybe-string
|
||||
"The host or IP address the VNC server listens for incoming connections.
|
||||
When unspecified, listen for any hosts/IP addresses.")
|
||||
(vnc-server-port
|
||||
(number 5900)
|
||||
"The TCP port the VNC server should listen to.")
|
||||
(extra-config
|
||||
(list-of-strings '())
|
||||
"Extra configuration values to append to the LightDM configuration file."))
|
||||
|
||||
(define (lightdm-configuration->greeters-config-dir config)
|
||||
"Return a directory containing all the serialized greeter configurations
|
||||
from CONFIG, a <lightdm-configuration> object."
|
||||
(file-union "etc-lightdm"
|
||||
(append-map (lambda (g)
|
||||
`((,(greeter-configuration->conf-name g)
|
||||
,(greeter-configuration->file g))))
|
||||
(lightdm-configuration-greeters config))))
|
||||
|
||||
(define (lightdm-configuration->packages config)
|
||||
"Return all the greeter packages and their assets defined in CONFIG, a
|
||||
<lightdm-configuration> object, as well as the lightdm package itself."
|
||||
(cons (lightdm-configuration-lightdm config)
|
||||
(append-map greeter-configuration->packages
|
||||
(lightdm-configuration-greeters config))))
|
||||
|
||||
(define (validate-lightdm-configuration config)
|
||||
"Sanity check CONFIG, a <lightdm-configuration> record instance."
|
||||
;; This is required to make inter-field validations, such as between the
|
||||
;; seats and greeters.
|
||||
(let* ((seats (lightdm-configuration-seats config))
|
||||
(greeter-sessions (delete-duplicates
|
||||
(map lightdm-seat-configuration-greeter-session
|
||||
seats)
|
||||
eq?))
|
||||
(greeter-configurations (lightdm-configuration-greeters config))
|
||||
(missing-greeters
|
||||
(filter-map
|
||||
(lambda (id)
|
||||
(define pred (greeter-session->greater-configuration-pred id))
|
||||
(if (find pred greeter-configurations)
|
||||
#f ;happy path
|
||||
id))
|
||||
greeter-sessions)))
|
||||
(unless (null? missing-greeters)
|
||||
(leave (G_ "no greeter configured for seat greeter sessions: ~a~%")
|
||||
missing-greeters))))
|
||||
|
||||
(define (lightdm-configuration-file config)
|
||||
(match-record config <lightdm-configuration>
|
||||
(xorg-configuration seats
|
||||
xdmcp? xdmcp-listen-address
|
||||
vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
|
||||
extra-config)
|
||||
(apply
|
||||
mixed-text-file
|
||||
"lightdm.conf" "
|
||||
#
|
||||
# General configuration
|
||||
#
|
||||
[LightDM]
|
||||
greeter-user=lightdm
|
||||
sessions-directory=/run/current-system/profile/share/xsessions\
|
||||
:/run/current-system/profile/share/wayland-sessions
|
||||
remote-sessions-directory=/run/current-system/profile/share/remote-sessions
|
||||
"
|
||||
#~(string-join '#$extra-config "\n")
|
||||
"
|
||||
#
|
||||
# XDMCP Server configuration
|
||||
#
|
||||
[XDMCPServer]
|
||||
enabled=" (if xdmcp? "true" "false") "\n"
|
||||
(if (maybe-value-set? xdmcp-listen-address)
|
||||
(format #f "xdmcp-listen-address=~a" xdmcp-listen-address)
|
||||
"") "
|
||||
|
||||
#
|
||||
# VNC Server configuration
|
||||
#
|
||||
[VNCServer]
|
||||
enabled=" (if vnc-server? "true" "false") "
|
||||
command=" vnc-server-command "
|
||||
port=" (number->string vnc-server-port) "\n"
|
||||
(if (maybe-value-set? vnc-server-listen-address)
|
||||
(format #f "vnc-server-listen-address=~a" vnc-server-listen-address)
|
||||
"") "
|
||||
|
||||
#
|
||||
# Seat configuration.
|
||||
#
|
||||
"
|
||||
(map (lambda (seat)
|
||||
;; This complication exists to propagate a default value for
|
||||
;; the 'xserver-command' field of the seats. Having a
|
||||
;; 'xorg-configuration' field at the root of the
|
||||
;; lightdm-configuration enables the use of
|
||||
;; 'set-xorg-configuration' and can be more convenient.
|
||||
(let ((seat* (if (maybe-value-set?
|
||||
(lightdm-seat-configuration-xserver-command seat))
|
||||
seat
|
||||
(lightdm-seat-configuration
|
||||
(inherit seat)
|
||||
(xserver-command (xorg-start-command
|
||||
xorg-configuration))))))
|
||||
(serialize-configuration seat*
|
||||
lightdm-seat-configuration-fields)))
|
||||
seats))))
|
||||
|
||||
(define %lightdm-accounts
|
||||
(list (user-group (name "lightdm") (system? #t))
|
||||
(user-account
|
||||
(name "lightdm")
|
||||
(group "lightdm")
|
||||
(system? #t)
|
||||
(comment "LightDM user")
|
||||
(home-directory "/var/lib/lightdm")
|
||||
(shell (file-append shadow "/sbin/nologin")))))
|
||||
|
||||
(define %lightdm-activation
|
||||
;; Ensure /var/lib/lightdm is owned by the "lightdm" user. Adapted from the
|
||||
;; %gdm-activation.
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
|
||||
(define (ensure-ownership directory)
|
||||
(let* ((lightdm (getpwnam "lightdm"))
|
||||
(uid (passwd:uid lightdm))
|
||||
(gid (passwd:gid lightdm))
|
||||
(st (stat directory #f)))
|
||||
;; Recurse into directory only if it has wrong ownership.
|
||||
(when (and st
|
||||
(or (not (= uid (stat:uid st)))
|
||||
(not (= gid (stat:gid st)))))
|
||||
(for-each (lambda (file)
|
||||
(chown file uid gid))
|
||||
(find-files "directory"
|
||||
#:directories? #t)))))
|
||||
|
||||
(when (not (stat "/var/lib/lightdm-data" #f))
|
||||
(mkdir-p "/var/lib/lightdm-data"))
|
||||
(for-each ensure-ownership
|
||||
'("/var/lib/lightdm"
|
||||
"/var/lib/lightdm-data")))))
|
||||
|
||||
(define (lightdm-pam-service config)
|
||||
"Return a PAM service for @command{lightdm}."
|
||||
(unix-pam-service "lightdm"
|
||||
#:login-uid? #t
|
||||
#:allow-empty-passwords?
|
||||
(lightdm-configuration-allow-empty-passwords? config)))
|
||||
|
||||
(define (lightdm-greeter-pam-service)
|
||||
"Return a PAM service for @command{lightdm-greeter}."
|
||||
(pam-service
|
||||
(name "lightdm-greeter")
|
||||
(auth (list
|
||||
;; Load environment from /etc/environment and ~/.pam_environment.
|
||||
(pam-entry (control "required") (module "pam_env.so"))
|
||||
;; Always let the greeter start without authentication.
|
||||
(pam-entry (control "required") (module "pam_permit.so"))))
|
||||
;; No action required for account management
|
||||
(account (list (pam-entry (control "required") (module "pam_permit.so"))))
|
||||
;; Prohibit changing password.
|
||||
(password (list (pam-entry (control "required") (module "pam_deny.so"))))
|
||||
;; Setup session.
|
||||
(session (list (pam-entry (control "required") (module "pam_unix.so"))))))
|
||||
|
||||
(define (lightdm-autologin-pam-service)
|
||||
"Return a PAM service for @command{lightdm-autologin}}."
|
||||
(pam-service
|
||||
(name "lightdm-autologin")
|
||||
(auth
|
||||
(list
|
||||
;; Block login if user is globally disabled.
|
||||
(pam-entry (control "required") (module "pam_nologin.so"))
|
||||
(pam-entry (control "required") (module "pam_succeed_if.so")
|
||||
(arguments (list "uid >= 1000")))
|
||||
;; Allow access without authentication.
|
||||
(pam-entry (control "required") (module "pam_permit.so"))))
|
||||
;; Stop autologin if account requires action.
|
||||
(account (list (pam-entry (control "required") (module "pam_unix.so"))))
|
||||
;; Prohibit changing password.
|
||||
(password (list (pam-entry (control "required") (module "pam_deny.so"))))
|
||||
;; Setup session.
|
||||
(session (list (pam-entry (control "required") (module "pam_unix.so"))))))
|
||||
|
||||
(define (lightdm-pam-services config)
|
||||
(list (lightdm-pam-service config)
|
||||
(lightdm-greeter-pam-service)
|
||||
(lightdm-autologin-pam-service)))
|
||||
|
||||
(define (lightdm-shepherd-service config)
|
||||
"Return a <lightdm-service> for LightDM using CONFIG."
|
||||
|
||||
(validate-lightdm-configuration config)
|
||||
|
||||
(define lightdm-command
|
||||
#~(list #$(file-append (lightdm-configuration-lightdm config)
|
||||
"/sbin/lightdm")
|
||||
#$@(if (lightdm-configuration-debug? config)
|
||||
#~("--debug")
|
||||
#~())
|
||||
"--config"
|
||||
#$(lightdm-configuration-file config)))
|
||||
|
||||
(define lightdm-paths
|
||||
(let ((lightdm (lightdm-configuration-lightdm config)))
|
||||
#~(string-join
|
||||
'#$(map (lambda (dir)
|
||||
(file-append lightdm dir))
|
||||
'("/bin" "/sbin" "/libexec"))
|
||||
":")))
|
||||
|
||||
(define greeters-config-dir
|
||||
(lightdm-configuration->greeters-config-dir config))
|
||||
|
||||
(define data-dirs
|
||||
;; LightDM itself needs to be in XDG_DATA_DIRS for the accountsservice
|
||||
;; interface it provides to be picked up. The greeters must also be in
|
||||
;; XDG_DATA_DIRS to be found.
|
||||
(let ((packages (lightdm-configuration->packages config)))
|
||||
#~(string-join '#$(map (cut file-append <> "/share") packages)
|
||||
":")))
|
||||
|
||||
(list
|
||||
(shepherd-service
|
||||
(documentation "LightDM display manager")
|
||||
(requirement '(dbus-system user-processes host-name))
|
||||
(provision '(lightdm display-manager xorg-server))
|
||||
(respawn? #f)
|
||||
(start
|
||||
#~(lambda ()
|
||||
;; Note: sadly, environment variables defined for 'lightdm' are
|
||||
;; cleared and/or overridden by /etc/profile by its spawned greeters,
|
||||
;; so an out-of-band means such as /etc is required.
|
||||
(fork+exec-command #$lightdm-command
|
||||
;; Lightdm needs itself in its PATH.
|
||||
#:environment-variables
|
||||
(list
|
||||
;; It knows to look for greeter configurations in
|
||||
;; XDG_CONFIG_DIRS...
|
||||
(string-append "XDG_CONFIG_DIRS="
|
||||
#$greeters-config-dir)
|
||||
;; ... and for greeter .desktop files as well as
|
||||
;; lightdm accountsservice interface in
|
||||
;; XDG_DATA_DIRS.
|
||||
(string-append "XDG_DATA_DIRS="
|
||||
#$data-dirs)
|
||||
(string-append "PATH=" #$lightdm-paths)))))
|
||||
(stop #~(make-kill-destructor)))))
|
||||
|
||||
(define lightdm-service-type
|
||||
(handle-xorg-configuration
|
||||
lightdm-configuration
|
||||
(service-type
|
||||
(name 'lightdm)
|
||||
(default-value (lightdm-configuration))
|
||||
(extensions
|
||||
(list (service-extension pam-root-service-type lightdm-pam-services)
|
||||
(service-extension shepherd-root-service-type
|
||||
lightdm-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
(const %lightdm-activation))
|
||||
(service-extension dbus-root-service-type
|
||||
(compose list lightdm-configuration-lightdm))
|
||||
(service-extension polkit-service-type
|
||||
(compose list lightdm-configuration-lightdm))
|
||||
(service-extension account-service-type
|
||||
(const %lightdm-accounts))
|
||||
;; Add 'lightdm' to the system profile, so that its
|
||||
;; 'share/accountsservice' D-Bus service extension directory can be
|
||||
;; found via the 'XDG_DATA_DIRS=/run/current-system/profile/share'
|
||||
;; environment variable set in the wrapper of the
|
||||
;; libexec/accounts-daemon binary of the accountsservice package.
|
||||
;; This daemon is spawned by D-Bus, and there's little we can do to
|
||||
;; affect its environment. For more reading, see:
|
||||
;; https://github.com/NixOS/nixpkgs/issues/45059.
|
||||
(service-extension profile-service-type
|
||||
lightdm-configuration->packages)
|
||||
;; This is needed for the greeter itself to find its configuration,
|
||||
;; because XDG_CONF_DIRS gets overridden by /etc/profile.
|
||||
(service-extension
|
||||
etc-service-type
|
||||
(lambda (config)
|
||||
`(("lightdm"
|
||||
,(lightdm-configuration->greeters-config-dir config)))))))
|
||||
(description "Run @code{lightdm}, the LightDM graphical login manager."))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Generate documentation.
|
||||
;;;
|
||||
(define (generate-doc)
|
||||
(configuration->documentation 'lightdm-configuration)
|
||||
(configuration->documentation 'lightdm-gtk-greeter-configuration)
|
||||
(configuration->documentation 'lightdm-seat-configuration))
|
415
gnu/services/security.scm
Normal file
415
gnu/services/security.scm
Normal file
|
@ -0,0 +1,415 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 muradm <mail@muradm.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu services security)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services configuration)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (fail2ban-configuration
|
||||
fail2ban-ignore-cache-configuration
|
||||
fail2ban-jail-action-configuration
|
||||
fail2ban-jail-configuration
|
||||
fail2ban-jail-filter-configuration
|
||||
fail2ban-jail-service
|
||||
fail2ban-service-type))
|
||||
|
||||
(define-configuration/no-serialization fail2ban-ignore-cache-configuration
|
||||
(key string "Cache key.")
|
||||
(max-count integer "Cache size.")
|
||||
(max-time integer "Cache time."))
|
||||
|
||||
(define serialize-fail2ban-ignore-cache-configuration
|
||||
(match-lambda
|
||||
(($ <fail2ban-ignore-cache-configuration> _ key max-count max-time)
|
||||
(format #f "key=\"~a\", max-count=~d, max-time=~d"
|
||||
key max-count max-time))))
|
||||
|
||||
(define-maybe/no-serialization string)
|
||||
|
||||
(define-configuration/no-serialization fail2ban-jail-filter-configuration
|
||||
(name string "Filter to use.")
|
||||
(mode maybe-string "Mode for filter."))
|
||||
|
||||
(define serialize-fail2ban-jail-filter-configuration
|
||||
(match-lambda
|
||||
(($ <fail2ban-jail-filter-configuration> _ name mode)
|
||||
(format #f "~a~@[[mode=~a]~]" name (maybe-value mode)))))
|
||||
|
||||
(define (argument? a)
|
||||
(and (pair? a)
|
||||
(string? (car a))
|
||||
(or (string? (cdr a))
|
||||
(list-of-strings? (cdr a)))))
|
||||
|
||||
(define list-of-arguments? (list-of argument?))
|
||||
|
||||
(define-configuration/no-serialization fail2ban-jail-action-configuration
|
||||
(name string "Action name.")
|
||||
(arguments (list-of-arguments '()) "Action arguments."))
|
||||
|
||||
(define list-of-fail2ban-jail-actions?
|
||||
(list-of fail2ban-jail-action-configuration?))
|
||||
|
||||
(define (serialize-fail2ban-jail-action-configuration-arguments args)
|
||||
(let* ((multi-value
|
||||
(lambda (v)
|
||||
(format #f "~a" (string-join v ","))))
|
||||
(any-value
|
||||
(lambda (v)
|
||||
(if (list? v) (string-append "\"" (multi-value v) "\"") v)))
|
||||
(key-value
|
||||
(lambda (e)
|
||||
(format #f "~a=~a" (car e) (any-value (cdr e))))))
|
||||
(format #f "~a" (string-join (map key-value args) ","))))
|
||||
|
||||
(define serialize-fail2ban-jail-action-configuration
|
||||
(match-lambda
|
||||
(($ <fail2ban-jail-action-configuration> _ name arguments)
|
||||
(format
|
||||
#f "~a~a"
|
||||
name
|
||||
(if (null? arguments) ""
|
||||
(format
|
||||
#f "[~a]"
|
||||
(serialize-fail2ban-jail-action-configuration-arguments
|
||||
arguments)))))))
|
||||
|
||||
(define fail2ban-backend->string
|
||||
(match-lambda
|
||||
('auto "auto")
|
||||
('pyinotify "pyinotify")
|
||||
('gamin "gamin")
|
||||
('polling "polling")
|
||||
('systemd "systemd")
|
||||
(unknown
|
||||
(leave (G_ "fail2ban: '~a' is not a supported backend~%") unknown))))
|
||||
|
||||
(define fail2ban-log-encoding->string
|
||||
(match-lambda
|
||||
('auto "auto")
|
||||
('utf-8 "utf-8")
|
||||
('ascii "ascii")
|
||||
(unknown
|
||||
(leave (G_ "fail2ban: '~a' is not a supported log encoding~%") unknown))))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-field-name name)
|
||||
(cond ((symbol? name)
|
||||
(fail2ban-jail-configuration-serialize-field-name
|
||||
(symbol->string name)))
|
||||
((string-suffix? "?" name)
|
||||
(fail2ban-jail-configuration-serialize-field-name
|
||||
(string-drop-right name 1)))
|
||||
((string-prefix? "ban-time-" name)
|
||||
(fail2ban-jail-configuration-serialize-field-name
|
||||
(string-append "bantime." (substring name 9))))
|
||||
((string-contains name "-")
|
||||
(fail2ban-jail-configuration-serialize-field-name
|
||||
(string-filter (lambda (c) (equal? c #\-)) name)))
|
||||
(else name)))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-string field-name value)
|
||||
#~(string-append
|
||||
#$(fail2ban-jail-configuration-serialize-field-name field-name)
|
||||
" = " #$value "\n"))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-integer field-name value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (number->string value)))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-boolean field-name value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (if value "true" "false")))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-backend field-name value)
|
||||
(if (maybe-value-set? value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (fail2ban-backend->string value))
|
||||
""))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-fail2ban-ignore-cache-configuration field-name value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (serialize-fail2ban-ignore-cache-configuration value)))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-fail2ban-jail-filter-configuration field-name value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (serialize-fail2ban-jail-filter-configuration value)))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-log-encoding field-name value)
|
||||
(if (maybe-value-set? value)
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (fail2ban-log-encoding->string value))
|
||||
""))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-list-of-strings field-name value)
|
||||
(if (null? value)
|
||||
""
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (string-join value " "))))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-list-of-fail2ban-jail-actions field-name value)
|
||||
(if (null? value)
|
||||
""
|
||||
(fail2ban-jail-configuration-serialize-string
|
||||
field-name (string-join
|
||||
(map serialize-fail2ban-jail-action-configuration value) "\n"))))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-symbol field-name value)
|
||||
(fail2ban-jail-configuration-serialize-string field-name (symbol->string value)))
|
||||
|
||||
(define (fail2ban-jail-configuration-serialize-extra-content field-name value)
|
||||
(if (maybe-value-set? value)
|
||||
(string-append "\n" value "\n")
|
||||
""))
|
||||
|
||||
(define-maybe integer (prefix fail2ban-jail-configuration-))
|
||||
(define-maybe string (prefix fail2ban-jail-configuration-))
|
||||
(define-maybe boolean (prefix fail2ban-jail-configuration-))
|
||||
(define-maybe symbol (prefix fail2ban-jail-configuration-))
|
||||
(define-maybe fail2ban-ignore-cache-configuration (prefix fail2ban-jail-configuration-))
|
||||
(define-maybe fail2ban-jail-filter-configuration (prefix fail2ban-jail-configuration-))
|
||||
|
||||
(define-configuration fail2ban-jail-configuration
|
||||
(name
|
||||
string
|
||||
"Required name of this jail configuration.")
|
||||
(enabled?
|
||||
(boolean #t)
|
||||
"Whether this jail is enabled.")
|
||||
(backend
|
||||
maybe-symbol
|
||||
"Backend to use to detect changes in the @code{ogpath}. The default is
|
||||
'auto. To consult the defaults of the jail configuration, refer to the
|
||||
@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package."
|
||||
fail2ban-jail-configuration-serialize-backend)
|
||||
(max-retry
|
||||
maybe-integer
|
||||
"The number of failures before a host get banned
|
||||
(e.g. @code{(max-retry 5)}).")
|
||||
(max-matches
|
||||
maybe-integer
|
||||
"The number of matches stored in ticket (resolvable via
|
||||
tag @code{<matches>}) in action.")
|
||||
(find-time
|
||||
maybe-string
|
||||
"The time window during which the maximum retry count must be reached for
|
||||
an IP address to be banned. A host is banned if it has generated
|
||||
@code{max-retry} during the last @code{find-time}
|
||||
seconds (e.g. @code{(find-time \"10m\")}). It can be provided in seconds or
|
||||
using Fail2Ban's \"time abbreviation format\", as described in @command{man 5
|
||||
jail.conf}.")
|
||||
(ban-time
|
||||
maybe-string
|
||||
"The duration, in seconds or time abbreviated format, that a ban should last.
|
||||
(e.g. @code{(ban-time \"10m\")}).")
|
||||
(ban-time-increment?
|
||||
maybe-boolean
|
||||
"Whether to consider past bans to compute increases to the default ban time
|
||||
of a specific IP address.")
|
||||
(ban-time-factor
|
||||
maybe-string
|
||||
"The coefficient to use to compute an exponentially growing ban time.")
|
||||
(ban-time-formula
|
||||
maybe-string
|
||||
"This is the formula used to calculate the next value of a ban time.")
|
||||
(ban-time-multipliers
|
||||
maybe-string
|
||||
"Used to calculate next value of ban time instead of formula.")
|
||||
(ban-time-max-time
|
||||
maybe-string
|
||||
"The maximum number of seconds a ban should last.")
|
||||
(ban-time-rnd-time
|
||||
maybe-string
|
||||
"The maximum number of seconds a randomized ban time should last. This can
|
||||
be useful to stop ``clever'' botnets calculating the exact time an IP address
|
||||
can be unbanned again.")
|
||||
(ban-time-overall-jails?
|
||||
maybe-boolean
|
||||
"When true, it specifies the search of an IP address in the database should
|
||||
be made across all jails. Otherwise, only the current jail of the ban IP
|
||||
address is considered.")
|
||||
(ignore-self?
|
||||
maybe-boolean
|
||||
"Never ban the local machine's own IP address.")
|
||||
(ignore-ip
|
||||
(list-of-strings '())
|
||||
"A list of IP addresses, CIDR masks or DNS hosts to ignore.
|
||||
@code{fail2ban} will not ban a host which matches an address in this list.")
|
||||
(ignore-cache
|
||||
maybe-fail2ban-ignore-cache-configuration
|
||||
"Provide cache parameters for the ignore failure check.")
|
||||
(filter
|
||||
maybe-fail2ban-jail-filter-configuration
|
||||
"The filter to use by the jail, specified via a
|
||||
@code{<fail2ban-jail-filter-configuration>} object. By default, jails have
|
||||
names matching their filter name.")
|
||||
(log-time-zone
|
||||
maybe-string
|
||||
"The default time zone for log lines that do not have one.")
|
||||
(log-encoding
|
||||
maybe-symbol
|
||||
"The encoding of the log files handled by the jail.
|
||||
Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}."
|
||||
fail2ban-jail-configuration-serialize-log-encoding)
|
||||
(log-path
|
||||
(list-of-strings '())
|
||||
"The file names of the log files to be monitored.")
|
||||
(action
|
||||
(list-of-fail2ban-jail-actions '())
|
||||
"A list of @code{<fail2ban-jail-action-configuration>}.")
|
||||
(extra-content
|
||||
maybe-string
|
||||
"Extra content for the jail configuration."
|
||||
fail2ban-jail-configuration-serialize-extra-content)
|
||||
(prefix fail2ban-jail-configuration-))
|
||||
|
||||
(define list-of-fail2ban-jail-configurations?
|
||||
(list-of fail2ban-jail-configuration?))
|
||||
|
||||
(define (serialize-fail2ban-jail-configuration config)
|
||||
#~(string-append
|
||||
#$(format #f "[~a]\n" (fail2ban-jail-configuration-name config))
|
||||
#$(serialize-configuration
|
||||
config fail2ban-jail-configuration-fields)))
|
||||
|
||||
(define-configuration/no-serialization fail2ban-configuration
|
||||
(fail2ban
|
||||
(package fail2ban)
|
||||
"The @code{fail2ban} package to use. It is used for both binaries and as
|
||||
base default configuration that is to be extended with
|
||||
@code{<fail2ban-jail-configuration>} objects.")
|
||||
(run-directory
|
||||
(string "/var/run/fail2ban")
|
||||
"The state directory for the @code{fail2ban} daemon.")
|
||||
(jails
|
||||
(list-of-fail2ban-jail-configurations '())
|
||||
"Instances of @code{<fail2ban-jail-configuration>} collected from
|
||||
extensions.")
|
||||
(extra-jails
|
||||
(list-of-fail2ban-jail-configurations '())
|
||||
"Instances of @code{<fail2ban-jail-configuration>} explicitly provided.")
|
||||
(extra-content
|
||||
maybe-string
|
||||
"Extra raw content to add to the end of the @file{jail.local} file."))
|
||||
|
||||
(define (serialize-fail2ban-configuration config)
|
||||
(let* ((jails (fail2ban-configuration-jails config))
|
||||
(extra-jails (fail2ban-configuration-extra-jails config))
|
||||
(extra-content (fail2ban-configuration-extra-content config)))
|
||||
(interpose
|
||||
(append (map serialize-fail2ban-jail-configuration
|
||||
(append jails extra-jails))
|
||||
(list (if (maybe-value-set? extra-content)
|
||||
extra-content
|
||||
""))))))
|
||||
|
||||
(define (config->fail2ban-etc-directory config)
|
||||
(let* ((fail2ban (fail2ban-configuration-fail2ban config))
|
||||
(jail-local (apply mixed-text-file "jail.local"
|
||||
(serialize-fail2ban-configuration config))))
|
||||
(directory-union
|
||||
"fail2ban-configuration"
|
||||
(list (computed-file
|
||||
"etc-fail2ban"
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
(let ((etc (string-append #$output "/etc")))
|
||||
(mkdir-p etc)
|
||||
(symlink #$(file-append fail2ban "/etc/fail2ban")
|
||||
(string-append etc "/fail2ban"))))))
|
||||
(computed-file
|
||||
"etc-fail2ban-jail.local"
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
(define etc/fail2ban (string-append #$output
|
||||
"/etc/fail2ban"))
|
||||
(mkdir-p etc/fail2ban)
|
||||
(symlink #$jail-local (string-append etc/fail2ban
|
||||
"/jail.local")))))))))
|
||||
|
||||
(define (fail2ban-shepherd-service config)
|
||||
(match-record config <fail2ban-configuration>
|
||||
(fail2ban run-directory)
|
||||
(let* ((fail2ban-server (file-append fail2ban "/bin/fail2ban-server"))
|
||||
(pid-file (in-vicinity run-directory "fail2ban.pid"))
|
||||
(socket-file (in-vicinity run-directory "fail2ban.sock"))
|
||||
(config-dir (file-append (config->fail2ban-etc-directory config)
|
||||
"/etc/fail2ban"))
|
||||
(fail2ban-action (lambda args
|
||||
#~(lambda _
|
||||
(invoke #$fail2ban-server
|
||||
"-c" #$config-dir
|
||||
"-p" #$pid-file
|
||||
"-s" #$socket-file
|
||||
"-b"
|
||||
#$@args)))))
|
||||
|
||||
;; TODO: Add 'reload' action.
|
||||
(list (shepherd-service
|
||||
(provision '(fail2ban))
|
||||
(documentation "Run the fail2ban daemon.")
|
||||
(requirement '(user-processes))
|
||||
(modules `((ice-9 match)
|
||||
,@%default-modules))
|
||||
(start (fail2ban-action "start"))
|
||||
(stop (fail2ban-action "stop")))))))
|
||||
|
||||
(define fail2ban-service-type
|
||||
(service-type (name 'fail2ban)
|
||||
(extensions
|
||||
(list (service-extension shepherd-root-service-type
|
||||
fail2ban-shepherd-service)))
|
||||
(compose concatenate)
|
||||
(extend (lambda (config jails)
|
||||
(fail2ban-configuration
|
||||
(inherit config)
|
||||
(jails (append (fail2ban-configuration-jails config)
|
||||
jails)))))
|
||||
(default-value (fail2ban-configuration))
|
||||
(description "Run the fail2ban server.")))
|
||||
|
||||
(define (fail2ban-jail-service svc-type jail)
|
||||
"Convenience procedure to add a fail2ban service extension to SVC-TYPE, a
|
||||
<service-type> object. The fail2ban extension is specified by JAIL, a
|
||||
<fail2ban-jail-configuration> object."
|
||||
(service-type
|
||||
(inherit svc-type)
|
||||
(extensions
|
||||
(append (service-type-extensions svc-type)
|
||||
(list (service-extension fail2ban-service-type
|
||||
(lambda _ (list jail))))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Documentation generation.
|
||||
;;;
|
||||
(define (generate-doc)
|
||||
(configuration->documentation 'fail2ban-configuration)
|
||||
(configuration->documentation 'fail2ban-ignore-cache-configuration)
|
||||
(configuration->documentation 'fail2ban-jail-action-configuration)
|
||||
(configuration->documentation 'fail2ban-jail-configuration)
|
||||
(configuration->documentation 'fail2ban-jail-filter-configuration))
|
|
@ -331,6 +331,14 @@ (define gitolite-activation
|
|||
(strip-store-file-name admin-pubkey))))
|
||||
(rc-file #$(string-append home "/.gitolite.rc")))
|
||||
|
||||
;; activate-users+groups in (gnu build activation) sets the
|
||||
;; permission flags of home directories to #o700 and mentions that
|
||||
;; services needing looser permissions should chmod it during
|
||||
;; service activation. We also want the git group to be able to
|
||||
;; read from the gitolite home directory, so a chmod'ing we will
|
||||
;; go!
|
||||
(chmod #$home #o750)
|
||||
|
||||
(simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
|
||||
(copy-file #$rc-file rc-file)
|
||||
;; ensure gitolite's user can read the configuration
|
||||
|
|
|
@ -341,7 +341,7 @@ (define (user-owned? file)
|
|||
(wait-for-screen-text marionette
|
||||
(lambda (text)
|
||||
(string-contains text "Password"))
|
||||
#:ocrad
|
||||
#:ocr
|
||||
#$(file-append ocrad "/bin/ocrad"))
|
||||
(marionette-type (string-append password "\n\n")
|
||||
marionette))
|
||||
|
@ -510,7 +510,7 @@ (define (entry->list entry)
|
|||
|
||||
(test-assert "screen text"
|
||||
(let ((text (marionette-screen-text marionette
|
||||
#:ocrad
|
||||
#:ocr
|
||||
#$(file-append ocrad
|
||||
"/bin/ocrad"))))
|
||||
;; Check whether the welcome message and shell prompt are
|
||||
|
|
|
@ -784,7 +784,7 @@ (define (bios-boot-screen? text)
|
|||
;; At this point we have no choice but to use OCR to determine
|
||||
;; when the passphrase should be entered.
|
||||
(wait-for-screen-text #$marionette passphrase-prompt?
|
||||
#:ocrad #$ocrad)
|
||||
#:ocr #$ocrad)
|
||||
(marionette-type #$(string-append %luks-passphrase "\n")
|
||||
#$marionette)
|
||||
|
||||
|
@ -792,7 +792,7 @@ (define (bios-boot-screen? text)
|
|||
;; we can then be sure we match the "Enter passphrase" prompt from
|
||||
;; 'cryptsetup', in the initrd.
|
||||
(wait-for-screen-text #$marionette (negate bios-boot-screen?)
|
||||
#:ocrad #$ocrad
|
||||
#:ocr #$ocrad
|
||||
#:timeout 20)))
|
||||
|
||||
(test-assert "enter LUKS passphrase for the initrd"
|
||||
|
@ -800,7 +800,7 @@ (define (bios-boot-screen? text)
|
|||
;; XXX: Here we use OCR as well but we could instead use QEMU
|
||||
;; '-serial stdio' and run it in an input pipe,
|
||||
(wait-for-screen-text #$marionette passphrase-prompt?
|
||||
#:ocrad #$ocrad
|
||||
#:ocr #$ocrad
|
||||
#:timeout 60)
|
||||
(marionette-type #$(string-append %luks-passphrase "\n")
|
||||
#$marionette)
|
||||
|
@ -999,7 +999,7 @@ (define (passphrase-prompt? text)
|
|||
;; XXX: Here we use OCR as well but we could instead use QEMU
|
||||
;; '-serial stdio' and run it in an input pipe,
|
||||
(wait-for-screen-text #$marionette passphrase-prompt?
|
||||
#:ocrad #$ocrad
|
||||
#:ocr #$ocrad
|
||||
#:timeout 120)
|
||||
(marionette-type #$(string-append %luks-passphrase "\n")
|
||||
#$marionette)
|
||||
|
|
160
gnu/tests/lightdm.scm
Normal file
160
gnu/tests/lightdm.scm
Normal file
|
@ -0,0 +1,160 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu tests lightdm)
|
||||
#:use-module (gnu bootloader)
|
||||
#:use-module (gnu bootloader grub)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages ocr)
|
||||
#:use-module (gnu packages ratpoison)
|
||||
#:use-module (gnu packages vnc)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services dbus)
|
||||
#:use-module (gnu services desktop)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (gnu services lightdm)
|
||||
#:use-module (gnu services ssh)
|
||||
#:use-module (gnu services xorg)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix modules)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (%test-lightdm))
|
||||
|
||||
(define minimal-desktop-services
|
||||
(list polkit-wheel-service
|
||||
(service upower-service-type)
|
||||
(accountsservice-service)
|
||||
(service polkit-service-type)
|
||||
(elogind-service)
|
||||
(dbus-service)
|
||||
x11-socket-directory-service))
|
||||
|
||||
(define %lightdm-os
|
||||
(operating-system
|
||||
(inherit %simple-os)
|
||||
(packages (cons* ocrad ratpoison xterm %base-packages))
|
||||
(services
|
||||
(cons* (service lightdm-service-type
|
||||
(lightdm-configuration
|
||||
(allow-empty-passwords? #t)
|
||||
(debug? #t)
|
||||
(xdmcp? #t)
|
||||
(vnc-server? #t)
|
||||
(vnc-server-command
|
||||
(file-append tigervnc-server "/bin/Xvnc"
|
||||
" -SecurityTypes None"))
|
||||
(greeters (list (lightdm-gtk-greeter-configuration
|
||||
(allow-debugging? #t))))
|
||||
(seats (list (lightdm-seat-configuration
|
||||
(name "*")
|
||||
(user-session "ratpoison"))))))
|
||||
|
||||
;; For debugging.
|
||||
(service dhcp-client-service-type)
|
||||
(service openssh-service-type
|
||||
(openssh-configuration
|
||||
(permit-root-login #t)
|
||||
(allow-empty-passwords? #t)))
|
||||
(append minimal-desktop-services
|
||||
(remove (lambda (service)
|
||||
(eq? (service-kind service) guix-service-type))
|
||||
%base-services))))))
|
||||
|
||||
(define (run-lightdm-test)
|
||||
"Run tests in %LIGHTDM-OS."
|
||||
|
||||
(define os (marionette-operating-system
|
||||
%lightdm-os
|
||||
#:imported-modules (source-module-closure
|
||||
'((gnu services herd)))))
|
||||
|
||||
(define vm (virtual-machine os))
|
||||
|
||||
(define test
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu build marionette)))
|
||||
#~(begin
|
||||
(use-modules (gnu build marionette)
|
||||
(srfi srfi-26)
|
||||
(srfi srfi-64))
|
||||
|
||||
(let ((marionette (make-marionette (list #$vm))))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin "lightdm")
|
||||
|
||||
(test-assert "service is running"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(start-service 'lightdm))
|
||||
marionette))
|
||||
|
||||
(test-assert "service can be stopped"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(stop-service 'lightdm))
|
||||
marionette))
|
||||
|
||||
(test-assert "service can be restarted"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(restart-service 'lightdm))
|
||||
marionette))
|
||||
|
||||
(test-assert "login screen is displayed"
|
||||
;; GNU Ocrad fails to recognize the "Log In" button text, so use
|
||||
;; Tesseract.
|
||||
(wait-for-screen-text marionette
|
||||
(cut string-contains <> "Log In")
|
||||
#:ocr #$(file-append tesseract-ocr
|
||||
"/bin/tesseract")))
|
||||
|
||||
(test-assert "can connect to TCP port 5900 on IPv4"
|
||||
(wait-for-tcp-port 5900 marionette))
|
||||
|
||||
;; The VNC server fails to listen to IPv6 due to "Error binding to
|
||||
;; address [::]:5900: Address already in use" (see:
|
||||
;; https://github.com/canonical/lightdm/issues/266).
|
||||
(test-expect-fail 1)
|
||||
(test-assert "can connect to TCP port 5900 on IPv6"
|
||||
(wait-for-tcp-port 5900 marionette
|
||||
#:address
|
||||
`(make-socket-address
|
||||
AF_INET6
|
||||
(inet-pton AF_INET6 "::1")
|
||||
5900)))
|
||||
|
||||
(test-end)))))
|
||||
|
||||
(gexp->derivation "lightdm-test" test))
|
||||
|
||||
(define %test-lightdm
|
||||
(system-test
|
||||
(name "lightdm")
|
||||
(description "Basic tests for the LightDM service.")
|
||||
(value (run-lightdm-test))))
|
221
gnu/tests/security.scm
Normal file
221
gnu/tests/security.scm
Normal file
|
@ -0,0 +1,221 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 muradm <mail@muradm.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu tests security)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services security)
|
||||
#:use-module (gnu services ssh)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu tests)
|
||||
#:export (%test-fail2ban-basic
|
||||
%test-fail2ban-extension
|
||||
%test-fail2ban-simple))
|
||||
|
||||
|
||||
;;;
|
||||
;;; fail2ban tests
|
||||
;;;
|
||||
|
||||
(define-syntax-rule (fail2ban-test test-name test-os tests-more ...)
|
||||
(lambda ()
|
||||
(define os
|
||||
(marionette-operating-system
|
||||
test-os
|
||||
#:imported-modules '((gnu services herd))))
|
||||
|
||||
(define vm
|
||||
(virtual-machine
|
||||
(operating-system os)
|
||||
(port-forwardings '())))
|
||||
|
||||
(define test
|
||||
(with-imported-modules '((gnu build marionette)
|
||||
(guix build utils))
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-64)
|
||||
(gnu build marionette))
|
||||
|
||||
(define marionette (make-marionette (list #$vm)))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin test-name)
|
||||
|
||||
(test-assert "fail2ban running"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(start-service 'fail2ban))
|
||||
marionette))
|
||||
|
||||
(test-assert "fail2ban socket ready"
|
||||
(wait-for-unix-socket
|
||||
"/var/run/fail2ban/fail2ban.sock" marionette))
|
||||
|
||||
(test-assert "fail2ban running after restart"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(restart-service 'fail2ban))
|
||||
marionette))
|
||||
|
||||
(test-assert "fail2ban socket ready after restart"
|
||||
(wait-for-unix-socket
|
||||
"/var/run/fail2ban/fail2ban.sock" marionette))
|
||||
|
||||
(test-assert "fail2ban pid ready"
|
||||
(marionette-eval
|
||||
'(file-exists? "/var/run/fail2ban/fail2ban.pid")
|
||||
marionette))
|
||||
|
||||
(test-assert "fail2ban log file"
|
||||
(marionette-eval
|
||||
'(file-exists? "/var/log/fail2ban.log")
|
||||
marionette))
|
||||
|
||||
tests-more ...
|
||||
|
||||
(test-end))))
|
||||
|
||||
(gexp->derivation test-name test)))
|
||||
|
||||
(define run-fail2ban-basic-test
|
||||
(fail2ban-test
|
||||
"fail2ban-basic-test"
|
||||
|
||||
(simple-operating-system
|
||||
(service fail2ban-service-type))))
|
||||
|
||||
(define %test-fail2ban-basic
|
||||
(system-test
|
||||
(name "fail2ban-basic")
|
||||
(description "Test basic fail2ban running capability.")
|
||||
(value (run-fail2ban-basic-test))))
|
||||
|
||||
(define %fail2ban-server-cmd
|
||||
(program-file
|
||||
"fail2ban-server-cmd"
|
||||
#~(begin
|
||||
(let ((cmd #$(file-append fail2ban "/bin/fail2ban-server")))
|
||||
(apply execl cmd cmd `("-p" "/var/run/fail2ban/fail2ban.pid"
|
||||
"-s" "/var/run/fail2ban/fail2ban.sock"
|
||||
,@(cdr (program-arguments))))))))
|
||||
|
||||
(define run-fail2ban-simple-test
|
||||
(fail2ban-test
|
||||
"fail2ban-basic-test"
|
||||
|
||||
(simple-operating-system
|
||||
(service fail2ban-service-type (fail2ban-configuration
|
||||
(jails (list (fail2ban-jail-configuration
|
||||
(name "sshd")))))))
|
||||
|
||||
(test-equal "fail2ban sshd jail running status output"
|
||||
'("Status for the jail: sshd"
|
||||
"|- Filter"
|
||||
"| |- Currently failed:\t0"
|
||||
"| |- Total failed:\t0"
|
||||
"| `- File list:\t/var/log/secure"
|
||||
"`- Actions"
|
||||
" |- Currently banned:\t0"
|
||||
" |- Total banned:\t0"
|
||||
" `- Banned IP list:\t"
|
||||
"")
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports))
|
||||
(let ((call-command
|
||||
(lambda (cmd)
|
||||
(let* ((err-cons (pipe))
|
||||
(port (with-error-to-port (cdr err-cons)
|
||||
(lambda () (open-input-pipe cmd))))
|
||||
(_ (setvbuf (car err-cons) 'block
|
||||
(* 1024 1024 16)))
|
||||
(result (read-delimited "" port)))
|
||||
(close-port (cdr err-cons))
|
||||
(values result (read-delimited "" (car err-cons)))))))
|
||||
(string-split
|
||||
(call-command
|
||||
(string-join (list #$%fail2ban-server-cmd "status" "sshd") " "))
|
||||
#\newline)))
|
||||
marionette))
|
||||
|
||||
(test-equal "fail2ban sshd jail running exit code"
|
||||
0
|
||||
(marionette-eval
|
||||
'(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd"))
|
||||
marionette))))
|
||||
|
||||
(define %test-fail2ban-simple
|
||||
(system-test
|
||||
(name "fail2ban-simple")
|
||||
(description "Test simple fail2ban running capability.")
|
||||
(value (run-fail2ban-simple-test))))
|
||||
|
||||
(define run-fail2ban-extension-test
|
||||
(fail2ban-test
|
||||
"fail2ban-extension-test"
|
||||
|
||||
(simple-operating-system
|
||||
(service (fail2ban-jail-service openssh-service-type (fail2ban-jail-configuration
|
||||
(name "sshd") (enabled? #t)))
|
||||
(openssh-configuration)))
|
||||
|
||||
(test-equal "fail2ban sshd jail running status output"
|
||||
'("Status for the jail: sshd"
|
||||
"|- Filter"
|
||||
"| |- Currently failed:\t0"
|
||||
"| |- Total failed:\t0"
|
||||
"| `- File list:\t/var/log/secure"
|
||||
"`- Actions"
|
||||
" |- Currently banned:\t0"
|
||||
" |- Total banned:\t0"
|
||||
" `- Banned IP list:\t"
|
||||
"")
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports))
|
||||
(let ((call-command
|
||||
(lambda (cmd)
|
||||
(let* ((err-cons (pipe))
|
||||
(port (with-error-to-port (cdr err-cons)
|
||||
(lambda () (open-input-pipe cmd))))
|
||||
(_ (setvbuf (car err-cons) 'block
|
||||
(* 1024 1024 16)))
|
||||
(result (read-delimited "" port)))
|
||||
(close-port (cdr err-cons))
|
||||
(values result (read-delimited "" (car err-cons)))))))
|
||||
(string-split
|
||||
(call-command
|
||||
(string-join (list #$%fail2ban-server-cmd "status" "sshd") " "))
|
||||
#\newline)))
|
||||
marionette))
|
||||
|
||||
(test-equal "fail2ban sshd jail running exit code"
|
||||
0
|
||||
(marionette-eval
|
||||
'(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd"))
|
||||
marionette))))
|
||||
|
||||
(define %test-fail2ban-extension
|
||||
(system-test
|
||||
(name "fail2ban-extension")
|
||||
(description "Test extension fail2ban running capability.")
|
||||
(value (run-fail2ban-extension-test))))
|
|
@ -3,6 +3,7 @@
|
|||
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
|
||||
;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -106,6 +107,26 @@ (define marionette
|
|||
"-c" "qemu:///system" "connect"))
|
||||
marionette))
|
||||
|
||||
(test-eq "create default network"
|
||||
0
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(chdir "/tmp")
|
||||
(system* #$(file-append libvirt "/bin/virsh")
|
||||
"-c" "qemu:///system" "net-define"
|
||||
#$(file-append libvirt
|
||||
"/etc/libvirt/qemu/networks/default.xml")))
|
||||
marionette))
|
||||
|
||||
(test-eq "start default network"
|
||||
0
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(chdir "/tmp")
|
||||
(system* #$(file-append libvirt "/bin/virsh")
|
||||
"-c" "qemu:///system" "net-start" "default"))
|
||||
marionette))
|
||||
|
||||
(test-end))))
|
||||
|
||||
(gexp->derivation "libvirt-test" test))
|
||||
|
|
|
@ -2140,8 +2140,8 @@ (define* (directory-union name things
|
|||
colliding files. RESOLVE-COLLISION must return the chosen file or #f, in
|
||||
which case the colliding entry is skipped altogether.
|
||||
|
||||
When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET?
|
||||
is true, the derivation will not print anything."
|
||||
When COPY? is true, copy files instead of creating symlinks. When QUIET? is
|
||||
true, the derivation will not print anything."
|
||||
(define symlink
|
||||
(if copy?
|
||||
(gexp (lambda (old new)
|
||||
|
|
|
@ -1046,6 +1046,10 @@ (define (show-help)
|
|||
for 'describe' and 'list-generations', list installed
|
||||
packages matching REGEXP"))
|
||||
(newline)
|
||||
(show-cross-build-options-help)
|
||||
(newline)
|
||||
(show-native-build-options-help)
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (G_ "
|
||||
|
@ -1136,14 +1140,6 @@ (define %options
|
|||
(let ((level (string->number* arg)))
|
||||
(alist-cons 'verbosity level
|
||||
(alist-delete 'verbosity result)))))
|
||||
(option '(#\s "system") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'system arg
|
||||
(alist-delete 'system result eq?))))
|
||||
(option '("target") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'target arg
|
||||
(alist-delete 'target result eq?))))
|
||||
(option '(#\r "root") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'gc-root arg result)))
|
||||
|
@ -1153,7 +1149,9 @@ (define %options
|
|||
(option '(#\I "list-installed") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'list-installed (or arg "") result)))
|
||||
%standard-build-options))
|
||||
(append %standard-build-options
|
||||
%standard-cross-build-options
|
||||
%standard-native-build-options)))
|
||||
|
||||
(define %default-options
|
||||
;; Alist of default option values.
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
|
||||
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -303,4 +304,26 @@ (define operating-system-boot-parameters
|
|||
(operating-system-boot-parameters %default-operating-system
|
||||
%default-root-device)))
|
||||
|
||||
(define %uuid-menu-entry
|
||||
(menu-entry
|
||||
(label "test")
|
||||
(device (uuid "6d5b13d4-6092-46d0-8be4-073dc07413cc"))
|
||||
(linux "/boot/bzImage")
|
||||
(initrd "/boot/initrd.cpio.gz")))
|
||||
|
||||
(define %file-system-label-menu-entry
|
||||
(menu-entry
|
||||
(label "test")
|
||||
(device (file-system-label "test-label"))
|
||||
(linux "/boot/bzImage")
|
||||
(initrd "/boot/initrd.cpio.gz")))
|
||||
|
||||
(test-equal "menu-entry roundtrip, uuid"
|
||||
%uuid-menu-entry
|
||||
(sexp->menu-entry (menu-entry->sexp %uuid-menu-entry)))
|
||||
|
||||
(test-equal "menu-entry roundtrip, file-system-label"
|
||||
%file-system-label-menu-entry
|
||||
(sexp->menu-entry (menu-entry->sexp %file-system-label-menu-entry)))
|
||||
|
||||
(test-end "boot-parameters")
|
||||
|
|
52
tests/services/lightdm.scm
Normal file
52
tests/services/lightdm.scm
Normal file
|
@ -0,0 +1,52 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (tests services lightdm)
|
||||
#:use-module (guix diagnostics)
|
||||
#:use-module (gnu services lightdm)
|
||||
#:use-module (srfi srfi-64))
|
||||
|
||||
;;; Tests for the (gnu services lightdm) module.
|
||||
|
||||
;;; Access some internals for whitebox testing.
|
||||
(define validate-lightdm-configuration (@@ (gnu services lightdm)
|
||||
validate-lightdm-configuration))
|
||||
|
||||
(test-begin "lightdm-service")
|
||||
|
||||
(test-equal "error on missing greeter"
|
||||
'ok
|
||||
(catch 'quit
|
||||
(lambda ()
|
||||
(validate-lightdm-configuration (lightdm-configuration (greeters '()))))
|
||||
(lambda _
|
||||
'ok)))
|
||||
|
||||
(test-equal "error when a greeter has multiple configurations"
|
||||
'ok
|
||||
(catch 'quit
|
||||
(lambda ()
|
||||
(lightdm-configuration
|
||||
(greeters (list (lightdm-gtk-greeter-configuration
|
||||
(theme-name "boring"))
|
||||
(lightdm-gtk-greeter-configuration
|
||||
(theme-name "blue"))))))
|
||||
(lambda _
|
||||
'ok)))
|
||||
|
||||
(test-end "lightdm-service")
|
Loading…
Reference in a new issue