me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into staging

master
Marius Bakke 2019-06-03 17:03:56 +02:00
parent 136b7d81f0 3092f1b835
commit 30e12b9664
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
93 changed files with 4225 additions and 1024 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.dir-locals.el
View File

@ -53,6 +53,8 @@
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2)) (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
(eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1)) (eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
(eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1)) (eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
(eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
(eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
(eval . (put 'signature-case 'scheme-indent-function 1)) (eval . (put 'signature-case 'scheme-indent-function 1))
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0)) (eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1)) (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))

505
doc/guix.texi
View File

@ -757,6 +757,11 @@ Support for build offloading (@pxref{Daemon Offload Setup}) and
@uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH}, @uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH},
version 0.10.2 or later. version 0.10.2 or later.
@item
When @url{https://www.nongnu.org/lzip/lzlib.html, lzlib} is available, lzlib
substitutes can be used and @command{guix publish} can compress substitutes
with lzlib.
@item @item
When @url{http://www.bzip.org, libbz2} is available, When @url{http://www.bzip.org, libbz2} is available,
@command{guix-daemon} can use it to compress build logs. @command{guix-daemon} can use it to compress build logs.
@ -9656,12 +9661,20 @@ accept connections from any interface.
Change privileges to @var{user} as soon as possible---i.e., once the Change privileges to @var{user} as soon as possible---i.e., once the
server socket is open and the signing key has been read. server socket is open and the signing key has been read.
@item --compression[=@var{level}] @item --compression[=@var{method}[:@var{level}]]
@itemx -C [@var{level}] @itemx -C [@var{method}[:@var{level}]]
Compress data using the given @var{level}. When @var{level} is zero, Compress data using the given @var{method} and @var{level}. @var{method} is
disable compression. The range 1 to 9 corresponds to different gzip one of @code{lzip} and @code{gzip}; when @var{method} is omitted, @code{gzip}
compression levels: 1 is the fastest, and 9 is the best (CPU-intensive). is used.
The default is 3.
When @var{level} is zero, disable compression. The range 1 to 9 corresponds
to different compression levels: 1 is the fastest, and 9 is the best
(CPU-intensive). The default is 3.
Usually, @code{lzip} compresses noticeably better than @code{gzip} for a small
increase in CPU usage; see
@uref{https://nongnu.org/lzip/lzip_benchmark.html,benchmarks on the lzip Web
page}.
Unless @option{--cache} is used, compression occurs on the fly and Unless @option{--cache} is used, compression occurs on the fly and
the compressed streams are not the compressed streams are not
@ -9672,6 +9685,11 @@ run @command{guix publish} behind a caching proxy, or to use
allows @command{guix publish} to add @code{Content-Length} HTTP header allows @command{guix publish} to add @code{Content-Length} HTTP header
to its responses. to its responses.
This option can be repeated, in which case every substitute gets compressed
using all the selected methods, and all of them are advertised. This is
useful when users may not support all the compression methods: they can select
the one they support.
@item --cache=@var{directory} @item --cache=@var{directory}
@itemx -c @var{directory} @itemx -c @var{directory}
Cache archives and meta-data (@code{.narinfo} URLs) to @var{directory} Cache archives and meta-data (@code{.narinfo} URLs) to @var{directory}
@ -13623,11 +13641,11 @@ Directory to look for faces.
@item @code{default-path} (default "/run/current-system/profile/bin") @item @code{default-path} (default "/run/current-system/profile/bin")
Default PATH to use. Default PATH to use.
@item @code{minimum-uid} (default 1000) @item @code{minimum-uid} (default: 1000)
Minimum UID to display in SDDM. Minimum UID displayed in SDDM and allowed for log-in.
@item @code{maximum-uid} (default 2000) @item @code{maximum-uid} (default: 2000)
Maximum UID to display in SDDM Maximum UID to display in SDDM.
@item @code{remember-last-user?} (default #t) @item @code{remember-last-user?} (default #t)
Remember last user. Remember last user.
@ -16703,6 +16721,297 @@ variables.
@end table @end table
@end deftp @end deftp
@subsubheading Getmail service
@cindex IMAP
@cindex POP
@deffn {Scheme Variable} getmail-service-type
This is the type of the @uref{http://pyropus.ca/software/getmail/, Getmail}
mail retriever, whose value should be an @code{getmail-configuration}.
@end deffn
Available @code{getmail-configuration} fields are:
@deftypevr {@code{getmail-configuration} parameter} symbol name
A symbol to identify the getmail service.
Defaults to @samp{"unset"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} package package
The getmail package to use.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string user
The user to run getmail as.
Defaults to @samp{"getmail"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string group
The group to run getmail as.
Defaults to @samp{"getmail"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string directory
The getmail directory to use.
Defaults to @samp{"/var/lib/getmail/default"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} getmail-configuration-file rcfile
The getmail configuration file to use.
Available @code{getmail-configuration-file} fields are:
@deftypevr {@code{getmail-configuration-file} parameter} getmail-retriever-configuration retriever
What mail account to retrieve mail from, and how to access that account.
Available @code{getmail-retriever-configuration} fields are:
@deftypevr {@code{getmail-retriever-configuration} parameter} string type
The type of mail retriever to use. Valid values include @samp{passwd}
and @samp{static}.
Defaults to @samp{"SimpleIMAPSSLRetriever"}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string server
Space separated list of arguments to the userdb driver.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string username
Space separated list of arguments to the userdb driver.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} non-negative-integer port
Space separated list of arguments to the userdb driver.
Defaults to @samp{#f}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string password
Override fields from passwd.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} list password-command
Override fields from passwd.
Defaults to @samp{()}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string keyfile
PEM-formatted key file to use for the TLS negotiation
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string certfile
PEM-formatted certificate file to use for the TLS negotiation
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string ca-certs
CA certificates to use
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} parameter-alist extra-parameters
Extra retriever parameters
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration-file} parameter} getmail-destination-configuration destination
What to do with retrieved messages.
Available @code{getmail-destination-configuration} fields are:
@deftypevr {@code{getmail-destination-configuration} parameter} string type
The type of mail destination. Valid values include @samp{Maildir},
@samp{Mboxrd} and @samp{MDA_external}.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-destination-configuration} parameter} string-or-filelike path
The path option for the mail destination. The behaviour depends on the
chosen type.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-destination-configuration} parameter} parameter-alist extra-parameters
Extra destination parameters
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration-file} parameter} getmail-options-configuration options
Configure getmail.
Available @code{getmail-options-configuration} fields are:
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer verbose
If set to @samp{0}, getmail will only print warnings and errors. A
value of @samp{1} means that messages will be printed about retrieving
and deleting messages. If set to @samp{2}, getmail will print messages
about each of it's actions.
Defaults to @samp{1}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean read-all
If true, getmail will retrieve all available messages. Otherwise it
will only retrieve messages it hasn't seen previously.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean delete
If set to true, messages will be deleted from the server after
retrieving and successfully delivering them. Otherwise, messages will
be left on the server.
Defaults to @samp{#f}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-after
Getmail will delete messages this number of days after seeing them, if
they have not been delivered. This means messages will be left on the
server this number of days after delivering them. A value of @samp{0}
disabled this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-bigger-than
Delete messages larger than this of bytes after retrieving them, even if
the delete and delete-after options are disabled. A value of @samp{0}
disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-bytes-per-session
Retrieve messages totalling up to this number of bytes before closing
the session with the server. A value of @samp{0} disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-message-size
Don't retrieve messages larger than this number of bytes. A value of
@samp{0} disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean delivered-to
If true, getmail will add a Delivered-To header to messages.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean received
If set, getmail adds a Received header to the messages.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} string message-log
Getmail will record a log of its actions to the named file. A value of
@samp{""} disables this feature.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-syslog
If true, getmail will record a log of its actions using the system
logger.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-verbose
If true, getmail will log information about messages not retrieved and
the reason for not retrieving them, as well as starting and ending
information lines.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} parameter-alist extra-parameters
Extra options to include.
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} list idle
A list of mailboxes that getmail should wait on the server for new mail
notifications. This depends on the server supporting the IDLE
extension.
Defaults to @samp{()}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} list environment-variables
Environment variables to set for getmail.
Defaults to @samp{()}.
@end deftypevr
@subsubheading Mail Aliases Service @subsubheading Mail Aliases Service
@cindex email aliases @cindex email aliases
@ -19085,6 +19394,180 @@ Additional arguments to pass to the @command{varnishd} process.
@end table @end table
@end deftp @end deftp
@subsubheading Patchwork
@cindex Patchwork
Patchwork is a patch tracking system. It can collect patches sent to a
mailing list, and display them in a web interface.
@defvr {Scheme Variable} patchwork-service-type
Service type for Patchwork.
@end defvr
The following example is an example of a minimal service for Patchwork, for
the @code{patchwork.example.com} domain.
@example
(service patchwork-service-type
(patchwork-configuration
(domain "patchwork.example.com")
(settings-module
(patchwork-settings-module
(allowed-hosts (list domain))
(default-from-email "patchwork@@patchwork.example.com")))
(getmail-retriever-config
(getmail-retriever-configuration
(type "SimpleIMAPSSLRetriever")
(server "imap.example.com")
(port 993)
(username "patchwork")
(password-command
(list (file-append coreutils "/bin/cat")
"/etc/getmail-patchwork-imap-password"))
(extra-parameters
'((mailboxes . ("Patches"))))))))
@end example
There are three records for configuring the Patchwork service. The
@code{<patchwork-configuration>} relates to the configuration for Patchwork
within the HTTPD service.
The @code{settings-module} field within the @code{<patchwork-configuration>}
record can be populated with the @code{<patchwork-settings-module>} record,
which describes a settings module that is generated within the Guix store.
For the @code{database-configuration} field within the
@code{<patchwork-settings-module>}, the
@code{<patchwork-database-configuration>} must be used.
@deftp {Data Type} patchwork-configuration
Data type representing the Patchwork service configuration. This type has the
following parameters:
@table @asis
@item @code{patchwork} (default: @code{patchwork})
The Patchwork package to use.
@item @code{domain}
The domain to use for Patchwork, this is used in the HTTPD service virtual
host.
@item @code{settings-module}
The settings module to use for Patchwork. As a Django application, Patchwork
is configured with a Python module containing the settings. This can either be
an instance of the @code{<patchwork-settings-module>} record, any other record
that represents the settings in the store, or a directory outside of the
store.
@item @code{static-path} (default: @code{"/static/"})
The path under which the HTTPD service should serve the static files.
@item @code{getmail-retriever-config}
The getmail-retriever-configuration record value to use with
Patchwork. Getmail will be configured with this value, the messages will be
delivered to Patchwork.
@end table
@end deftp
@deftp {Data Type} patchwork-settings-module
Data type representing a settings module for Patchwork. Some of these
settings relate directly to Patchwork, but others relate to Django, the web
framework used by Patchwork, or the Django Rest Framework library. This type
has the following parameters:
@table @asis
@item @code{database-configuration} (default: @code{(patchwork-database-configuration)})
The database connection settings used for Patchwork. See the
@code{<patchwork-database-configuration>} record type for more information.
@item @code{secret-key-file} (default: @code{"/etc/patchwork/django-secret-key"})
Patchwork, as a Django web application uses a secret key for cryptographically
signing values. This file should contain a unique unpredictable value.
If this file does not exist, it will be created and populated with a random
value by the patchwork-setup shepherd service.
This setting relates to Django.
@item @code{allowed-hosts}
A list of valid hosts for this Patchwork service. This should at least include
the domain specified in the @code{<patchwork-configuration>} record.
This is a Django setting.
@item @code{default-from-email}
The email address from which Patchwork should send email by default.
This is a Patchwork setting.
@item @code{static-url} (default: @code{#f})
The URL to use when serving static assets. It can be part of a URL, or a full
URL, but must end in a @code{/}.
If the default value is used, the @code{static-path} value from the
@code{<patchwork-configuration>} record will be used.
This is a Django setting.
@item @code{admins} (default: @code{'()})
Email addresses to send the details of errors that occur. Each value should
be a list containing two elements, the name and then the email address.
This is a Django setting.
@item @code{debug?} (default: @code{#f})
Whether to run Patchwork in debug mode. If set to @code{#t}, detailed error
messages will be shown.
This is a Django setting.
@item @code{enable-rest-api?} (default: @code{#t})
Whether to enable the Patchwork REST API.
This is a Patchwork setting.
@item @code{enable-xmlrpc?} (default: @code{#t})
Whether to enable the XML RPC API.
This is a Patchwork setting.
@item @code{force-https-links?} (default: @code{#t})
Whether to use HTTPS links on Patchwork pages.
This is a Patchwork setting.
@item @code{extra-settings} (default: @code{""})
Extra code to place at the end of the Patchwork settings module.
@end table
@end deftp
@deftp {Data Type} patchwork-database-configuration
Data type representing the database configuration for Patchwork.
@table @asis
@item @code{engine} (default: @code{"django.db.backends.postgresql_psycopg2"})
The database engine to use.
@item @code{name} (default: @code{"patchwork"})
The name of the database to use.
@item @code{user} (default: @code{"httpd"})
The user to connect to the database as.
@item @code{password} (default: @code{""})
The password to use when connecting to the database.
@item @code{host} (default: @code{""})
The host to make the database connection to.
@item @code{port} (default: @code{""})
The port on which to connect to the database.
@end table
@end deftp
@subsubheading FastCGI @subsubheading FastCGI
@cindex fastcgi @cindex fastcgi
@cindex fcgiwrap @cindex fcgiwrap
@ -24132,7 +24615,7 @@ The bootloader theme object describing the theme to use. If no theme
is provided, some bootloaders might use a default theme, that's true is provided, some bootloaders might use a default theme, that's true
for GRUB. for GRUB.
@item @code{terminal-outputs} (default: @code{'gfxterm}) @item @code{terminal-outputs} (default: @code{'(gfxterm)})
The output terminals used for the bootloader boot menu, as a list of The output terminals used for the bootloader boot menu, as a list of
symbols. GRUB accepts the values: @code{console}, @code{serial}, symbols. GRUB accepts the values: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text}, @code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},

2
gnu/installer/connman.scm
View File

@ -108,7 +108,7 @@
(define-record-type* <service> (define-record-type* <service>
service make-service service make-service
service? service?
(name service-name) ; string (name service-name) ; string or #f
(type service-type) ; string (type service-type) ; string
(path service-path) ; string (path service-path) ; string
(strength service-strength) ; integer (strength service-strength) ; integer

1
gnu/installer/newt/wifi.scm
View File

@ -144,6 +144,7 @@ of <service-item> records present in LISTBOX."
(let ((services (connman-services))) (let ((services (connman-services)))
(filter (lambda (service) (filter (lambda (service)
(and (string=? (service-type service) "wifi") (and (string=? (service-type service) "wifi")
(service-name service)
(not (string-null? (service-name service))))) (not (string-null? (service-name service)))))
services))) services)))

8
gnu/local.mk
View File

@ -516,6 +516,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/docker.scm \ %D%/services/docker.scm \
%D%/services/authentication.scm \ %D%/services/authentication.scm \
%D%/services/games.scm \ %D%/services/games.scm \
%D%/services/getmail.scm \
%D%/services/kerberos.scm \ %D%/services/kerberos.scm \
%D%/services/lirc.scm \ %D%/services/lirc.scm \
%D%/services/virtualization.scm \ %D%/services/virtualization.scm \
@ -864,7 +865,6 @@ dist_patch_DATA = \
%D%/packages/patches/gmp-faulty-test.patch \ %D%/packages/patches/gmp-faulty-test.patch \
%D%/packages/patches/gnome-shell-theme.patch \ %D%/packages/patches/gnome-shell-theme.patch \
%D%/packages/patches/gnome-tweaks-search-paths.patch \ %D%/packages/patches/gnome-tweaks-search-paths.patch \
%D%/packages/patches/gnucash-fix-test-transaction-failure.patch \
%D%/packages/patches/gnutls-skip-trust-store-test.patch \ %D%/packages/patches/gnutls-skip-trust-store-test.patch \
%D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \ %D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
%D%/packages/patches/gobject-introspection-cc.patch \ %D%/packages/patches/gobject-introspection-cc.patch \
@ -895,6 +895,7 @@ dist_patch_DATA = \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \ %D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \ %D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \
%D%/packages/patches/gtkglext-disable-disable-deprecated.patch \ %D%/packages/patches/gtkglext-disable-disable-deprecated.patch \
%D%/packages/patches/gtksourceview-2-add-default-directory.patch \
%D%/packages/patches/gzdoom-search-in-installed-share.patch \ %D%/packages/patches/gzdoom-search-in-installed-share.patch \
%D%/packages/patches/haskell-mode-unused-variables.patch \ %D%/packages/patches/haskell-mode-unused-variables.patch \
%D%/packages/patches/haskell-mode-make-check.patch \ %D%/packages/patches/haskell-mode-make-check.patch \
@ -987,8 +988,6 @@ dist_patch_DATA = \
%D%/packages/patches/libevent-2.0-CVE-2016-10196.patch \ %D%/packages/patches/libevent-2.0-CVE-2016-10196.patch \
%D%/packages/patches/libevent-2.0-CVE-2016-10197.patch \ %D%/packages/patches/libevent-2.0-CVE-2016-10197.patch \
%D%/packages/patches/libevent-2.0-evbuffer-add-use-last-with-datap.patch \ %D%/packages/patches/libevent-2.0-evbuffer-add-use-last-with-datap.patch \
%D%/packages/patches/libevent-2.1-dns-tests.patch \
%D%/packages/patches/libevent-2.1-skip-failing-test.patch \
%D%/packages/patches/libexif-CVE-2016-6328.patch \ %D%/packages/patches/libexif-CVE-2016-6328.patch \
%D%/packages/patches/libexif-CVE-2017-7544.patch \ %D%/packages/patches/libexif-CVE-2017-7544.patch \
%D%/packages/patches/libgcrypt-make-yat2m-reproducible.patch \ %D%/packages/patches/libgcrypt-make-yat2m-reproducible.patch \
@ -1281,6 +1280,8 @@ dist_patch_DATA = \
%D%/packages/patches/superlu-dist-awpm-grid.patch \ %D%/packages/patches/superlu-dist-awpm-grid.patch \
%D%/packages/patches/superlu-dist-fix-mpi-deprecations.patch \ %D%/packages/patches/superlu-dist-fix-mpi-deprecations.patch \
%D%/packages/patches/superlu-dist-scotchmetis.patch \ %D%/packages/patches/superlu-dist-scotchmetis.patch \
%D%/packages/patches/supertux-fix-build-with-gcc5.patch \
%D%/packages/patches/supertux-unbundle-squirrel.patch \
%D%/packages/patches/swig-guile-gc.patch \ %D%/packages/patches/swig-guile-gc.patch \
%D%/packages/patches/swish-e-search.patch \ %D%/packages/patches/swish-e-search.patch \
%D%/packages/patches/swish-e-format-security.patch \ %D%/packages/patches/swish-e-format-security.patch \
@ -1315,6 +1316,7 @@ dist_patch_DATA = \
%D%/packages/patches/totem-meson-easy-codec.patch \ %D%/packages/patches/totem-meson-easy-codec.patch \
%D%/packages/patches/tuxpaint-stamps-path.patch \ %D%/packages/patches/tuxpaint-stamps-path.patch \
%D%/packages/patches/twinkle-include-qregexpvalidator.patch \ %D%/packages/patches/twinkle-include-qregexpvalidator.patch \
%D%/packages/patches/txr-shell.patch \
%D%/packages/patches/u-boot-fix-mkimage-header-verification.patch \ %D%/packages/patches/u-boot-fix-mkimage-header-verification.patch \
%D%/packages/patches/unzip-CVE-2014-8139.patch \ %D%/packages/patches/unzip-CVE-2014-8139.patch \
%D%/packages/patches/unzip-CVE-2014-8140.patch \ %D%/packages/patches/unzip-CVE-2014-8140.patch \

55
gnu/packages/aidc.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,8 +27,15 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages imagemagick)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages qt)
#:use-module (gnu packages video)
#:use-module (guix build-system gnu)) #:use-module (guix build-system gnu))
@ -102,3 +110,48 @@ characters, and is highly robust.")
barcodes of the modern ECC200 variety. libdmtx is a shared library, allowing barcodes of the modern ECC200 variety. libdmtx is a shared library, allowing
C/C++ programs to use its capabilities without restrictions or overhead.") C/C++ programs to use its capabilities without restrictions or overhead.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public zbar
(package
(name "zbar")
(version "0.23")
(source
(origin
(method url-fetch)
(uri (string-append "https://linuxtv.org/downloads/zbar/zbar-"
version
".tar.bz2"))
(sha256
(base32
"0bmd93a15qpgbsq9c9j33qms18rdrgz6gbc48zi6z9w5pvrvi7z9"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags (list "--with-gtk=auto"
"--with-python=auto"
(string-append "--with-dbusconfdir="
(assoc-ref %outputs "out")
"/etc")
"CXXFLAGS=-std=c++11")))
(native-inputs
`(("glib" ,glib "bin")
("pkg-config" ,pkg-config)))
(inputs
`(("gobject-introspection" ,gobject-introspection)
("gtk+" ,gtk+)
("imagemagick" ,imagemagick)
("libjpeg" ,libjpeg-turbo)
("python" ,python)
("qtbase" ,qtbase)
("qtx11extras" ,qtx11extras)
("v4l-utils" ,v4l-utils)))
(synopsis "Bar code reader")
(description
"ZBar can read barcodes from various sources, such as video streams,
image files, and raw intensity sensors. It supports EAN-13/UPC-A, UPC-E,
EAN-8, Code 128, Code 93, Code 39, Codabar, Interleaved 2 of 5, QR Code and SQ
Code. Included with the library are basic applications for decoding captured
bar code images and using a video device (e.g. webcam) as a bar code scanner.
For application developers, language bindings are included for C, C++ and
Python as well as GUI widgets for GTK and Qt.")
(home-page "https://github.com/mchehab/zbar")
(license license:lgpl2.1+)))

4
gnu/packages/algebra.scm
View File

@ -251,7 +251,7 @@ precision.")
(define-public giac (define-public giac
(package (package
(name "giac") (name "giac")
(version "1.5.0-49") (version "1.5.0-57")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
;; "~parisse/giac" is not used because the maintainer regularly ;; "~parisse/giac" is not used because the maintainer regularly
@ -263,7 +263,7 @@ precision.")
"source/giac_" version ".tar.gz")) "source/giac_" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0f4pkand9vmqfayw18jm5qxbhcwi1405qfd7ibzh9lwzz6amkm3l")))) "08c93knsisbk9dkyyrignw0wvqbr1sa5czlvk5l307ahxbbmqncf"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:modules ((ice-9 ftw) `(#:modules ((ice-9 ftw)

4
gnu/packages/audio.scm
View File

@ -3701,7 +3701,7 @@ library.")
(define-public faudio (define-public faudio
(package (package
(name "faudio") (name "faudio")
(version "19.05") (version "19.06")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -3710,7 +3710,7 @@ library.")
(commit version))) (commit version)))
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version "-checkout"))
(sha256 (sha256
(base32 "1dja2ykixk1ycqda116cg9fy4qg364dqj88amfln0r9pnsj2kbxk")))) (base32 "1azjf972hik1cizsblbvfp38xz7dx368pbpw3pd6z1xk9mnrhi6s"))))
(arguments (arguments
'(#:tests? #f ; No tests. '(#:tests? #f ; No tests.
#:configure-flags '("-DFFMPEG=ON"))) #:configure-flags '("-DFFMPEG=ON")))

4
gnu/packages/backup.scm
View File

@ -73,7 +73,7 @@
(define-public duplicity (define-public duplicity
(package (package
(name "duplicity") (name "duplicity")
(version "0.7.18.2") (version "0.7.19")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -82,7 +82,7 @@
"-series/" version "/+download/duplicity-" "-series/" version "/+download/duplicity-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 "0j37dgyji36hvb5dbzlmh5rj83jwhni02yq16g6rd3hj8f7qhdn2")))) (base32 "0ag9dknslxlasslwfjhqgcqbkb1mvzzx93ry7lch2lfzcdd91am6"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("util-linux" ,util-linux) ; setsid command, for the tests `(("util-linux" ,util-linux) ; setsid command, for the tests

74
gnu/packages/bioconductor.scm
View File

@ -1153,14 +1153,14 @@ determining dependencies between variables, code improvement suggestions.")
(define-public r-chippeakanno (define-public r-chippeakanno
(package (package
(name "r-chippeakanno") (name "r-chippeakanno")
(version "3.18.0") (version "3.18.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "ChIPpeakAnno" version)) (uri (bioconductor-uri "ChIPpeakAnno" version))
(sha256 (sha256
(base32 (base32
"089v16mm5m0rlyyyd0d6rz8gwb852zf3bcdrrw70wanlfjn258q7")))) "1mwi5s600c3jxy8f1azfrndc3g06qvhbmrp9wqac9nwjbfx1kfji"))))
(properties `((upstream-name . "ChIPpeakAnno"))) (properties `((upstream-name . "ChIPpeakAnno")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -2086,14 +2086,14 @@ independent of the p-value under the null hypothesis.")
(define-public r-icobra (define-public r-icobra
(package (package
(name "r-icobra") (name "r-icobra")
(version "1.12.0") (version "1.12.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "iCOBRA" version)) (uri (bioconductor-uri "iCOBRA" version))
(sha256 (sha256
(base32 (base32
"1w9frnczgypzc2czbwrvlizqcqhbp6cdpyws7vkmnn9k0ggzxvfc")))) "1wj0vqyb6h4rddmn4va3182yap9bv4m1r1jlzyjfyrqxhl2sqb1q"))))
(properties `((upstream-name . "iCOBRA"))) (properties `((upstream-name . "iCOBRA")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -2886,14 +2886,14 @@ to multiple hypothesis correction.")
(define-public r-dose (define-public r-dose
(package (package
(name "r-dose") (name "r-dose")
(version "3.10.0") (version "3.10.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "DOSE" version)) (uri (bioconductor-uri "DOSE" version))
(sha256 (sha256
(base32 (base32
"0dvhnfhzhhzcxm8zhdwrkif7sak4p888sjqfd3a0p77h0hs6g8pv")))) "0ab7mgj42fg6608qkciyqivr1n8s8r5ibvp0z3jfclrnyx6cl0w1"))))
(properties `((upstream-name . "DOSE"))) (properties `((upstream-name . "DOSE")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -3408,14 +3408,14 @@ position-specific scores within R and Bioconductor.")
(define-public r-atacseqqc (define-public r-atacseqqc
(package (package
(name "r-atacseqqc") (name "r-atacseqqc")
(version "1.8.0") (version "1.8.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "ATACseqQC" version)) (uri (bioconductor-uri "ATACseqQC" version))
(sha256 (sha256
(base32 (base32
"03f130vcd6hd3fv2pg60id0ddd6qkwsyx73gm907xaayf42ar2pj")))) "0h5j3724hnd86w22vy3whqx6gkf0nf2dxd2clgzdvjzblbcd5s69"))))
(properties `((upstream-name . "ATACseqQC"))) (properties `((upstream-name . "ATACseqQC")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -4548,3 +4548,61 @@ high-throughput sequencing data. It performs parallel processing of entire
files and produces a report which contains a set of high-resolution files and produces a report which contains a set of high-resolution
graphics.") graphics.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public r-birewire
(package
(name "r-birewire")
(version "3.16.0")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "BiRewire" version))
(sha256
(base32
"1gjb18l3gq3w8zl6r5d49hw0r1kfh9f7ghv9hz6y86aniprvb518"))))
(properties `((upstream-name . "BiRewire")))
(build-system r-build-system)
(propagated-inputs
`(("r-igraph" ,r-igraph)
("r-matrix" ,r-matrix)
("r-slam" ,r-slam)
("r-tsne" ,r-tsne)))
(home-page "https://bioconductor.org/packages/release/bioc/html/BiRewire.html")
(synopsis "Tools for randomization of bipartite graphs")
(description
"This package provides functions for bipartite network rewiring through N
consecutive switching steps and for the computation of the minimal number of
switching steps to be performed in order to maximise the dissimilarity with
respect to the original network. It includes functions for the analysis of
the introduced randomness across the switching steps and several other
routines to analyse the resulting networks and their natural projections.")
(license license:gpl3)))
(define-public r-birta
(package
(name "r-birta")
(version "1.28.0")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "birta" version))
(sha256
(base32
"12xjyvgmh4h0b7hi4qg50kcpb9003gnh2xyfgncb8l9mzvsbkxc2"))))
(build-system r-build-system)
(propagated-inputs
`(("r-biobase" ,r-biobase)
("r-limma" ,r-limma)
("r-mass" ,r-mass)))
(home-page "https://bioconductor.org/packages/birta")
(synopsis "Bayesian inference of regulation of transcriptional activity")
(description
"Expression levels of mRNA molecules are regulated by different
processes, comprising inhibition or activation by transcription factors and
post-transcriptional degradation by microRNAs. @dfn{birta} (Bayesian
Inference of Regulation of Transcriptional Activity) uses the regulatory
networks of transcription factors and miRNAs together with mRNA and miRNA
expression data to predict switches in regulatory activity between two
conditions. A Bayesian network is used to model the regulatory structure and
Markov-Chain-Monte-Carlo is applied to sample the activity states.")
(license license:gpl2+)))

33
gnu/packages/bioinformatics.scm
View File

@ -7245,18 +7245,19 @@ Bioconductor, CRAN, and Github.")
(define-public r-biocviews (define-public r-biocviews
(package (package
(name "r-biocviews") (name "r-biocviews")
(version "1.52.0") (version "1.52.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "biocViews" version)) (uri (bioconductor-uri "biocViews" version))
(sha256 (sha256
(base32 (base32
"1wc7a953n6qrlh9azzg1q68rk99h3xkbs82wq0yk6h2vb2c5r3zk")))) "0qwrsd9fcpkv7hhzy1scnj7ahdxi6cjary28kqk6b36gkzmnrw4r"))))
(properties (properties
`((upstream-name . "biocViews"))) `((upstream-name . "biocViews")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-biobase" ,r-biobase) `(("r-biobase" ,r-biobase)
("r-biocmanager" ,r-biocmanager)
("r-graph" ,r-graph) ("r-graph" ,r-graph)
("r-rbgl" ,r-rbgl) ("r-rbgl" ,r-rbgl)
("r-rcurl" ,r-rcurl) ("r-rcurl" ,r-rcurl)
@ -7452,13 +7453,13 @@ names in their natural, rather than lexicographic, order.")
(define-public r-edger (define-public r-edger
(package (package
(name "r-edger") (name "r-edger")
(version "3.26.3") (version "3.26.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "edgeR" version)) (uri (bioconductor-uri "edgeR" version))
(sha256 (sha256
(base32 (base32
"12889lwcray2cw0skzy1xp1y3siiz6n5cwx8ni86m7r671p6zmb2")))) "013glavk6a1wpyq3q35k343bdp6rf27w30q59i4kf47rp3i37g15"))))
(properties `((upstream-name . "edgeR"))) (properties `((upstream-name . "edgeR")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -7480,13 +7481,13 @@ CAGE.")
(define-public r-variantannotation (define-public r-variantannotation
(package (package
(name "r-variantannotation") (name "r-variantannotation")
(version "1.30.0") (version "1.30.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "VariantAnnotation" version)) (uri (bioconductor-uri "VariantAnnotation" version))
(sha256 (sha256
(base32 (base32
"1sd01yv1hnwc16412ilncrrph4gxsr9ds0nqg1czl69fqaixjn1i")))) "144x3d3b9a3q5jy4aqrk1nf2yavwjhwlf71s7qyr4x3ms3wmvf8i"))))
(properties (properties
`((upstream-name . "VariantAnnotation"))) `((upstream-name . "VariantAnnotation")))
(inputs (inputs
@ -7924,13 +7925,13 @@ as well as query and modify the browser state, such as the current viewport.")
(define-public r-genomicfeatures (define-public r-genomicfeatures
(package (package
(name "r-genomicfeatures") (name "r-genomicfeatures")
(version "1.36.0") (version "1.36.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "GenomicFeatures" version)) (uri (bioconductor-uri "GenomicFeatures" version))
(sha256 (sha256
(base32 (base32
"17jy7lrpdaafd8g5v6j70xsypi0lqljdqmhv9f2r1xpyg3yjd84p")))) "02psq3jfgghdydwbydb1j792lvfg44l5npb44mx8d54ckr8658dd"))))
(properties (properties
`((upstream-name . "GenomicFeatures"))) `((upstream-name . "GenomicFeatures")))
(build-system r-build-system) (build-system r-build-system)
@ -9040,14 +9041,14 @@ TAB-Seq.")
(define-public r-sva (define-public r-sva
(package (package
(name "r-sva") (name "r-sva")
(version "3.32.0") (version "3.32.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "sva" version)) (uri (bioconductor-uri "sva" version))
(sha256 (sha256
(base32 (base32
"100jwi43y4xdqb5lldx1ld58jg9icdjgz6c7ylx95gspipnkbgjp")))) "0jj6klfha5v5qmx2sjblf1an6s2zqd7mmgsp7sfmh4k2jpqi3jm9"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-genefilter" ,r-genefilter) `(("r-genefilter" ,r-genefilter)
@ -10568,13 +10569,13 @@ libraries.")
(define-public r-scater (define-public r-scater
(package (package
(name "r-scater") (name "r-scater")
(version "1.12.1") (version "1.12.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "scater" version)) (uri (bioconductor-uri "scater" version))
(sha256 (sha256
(base32 (base32
"0k4jc0xc2n49saylcjrg7laxq4mchg4nv06nrbc6cp4vzpf33jh5")))) "16a17161xlhh6qpna9qxph3anlc7ydgyrczmy4alfiw8si7pzmxa"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-beachmat" ,r-beachmat) `(("r-beachmat" ,r-beachmat)
@ -10603,14 +10604,14 @@ quality control.")
(define-public r-scran (define-public r-scran
(package (package
(name "r-scran") (name "r-scran")
(version "1.12.0") (version "1.12.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "scran" version)) (uri (bioconductor-uri "scran" version))
(sha256 (sha256
(base32 (base32
"19cyjjzgmhswni6js4bhbj5djp976sl9n648kk7viazgkspql884")))) "17mknpkvs7mgnlbf2hv9k7rwbx2vlg60yrwfyb8nn3nxsb6vm7yn"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-beachmat" ,r-beachmat) `(("r-beachmat" ,r-beachmat)
@ -12603,7 +12604,7 @@ expression report comparing samples in an easily configurable manner.")
(define-public pigx-chipseq (define-public pigx-chipseq
(package (package
(name "pigx-chipseq") (name "pigx-chipseq")
(version "0.0.40") (version "0.0.41")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/BIMSBbioinfo/pigx_chipseq/" (uri (string-append "https://github.com/BIMSBbioinfo/pigx_chipseq/"
@ -12611,7 +12612,7 @@ expression report comparing samples in an easily configurable manner.")
"/pigx_chipseq-" version ".tar.gz")) "/pigx_chipseq-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0y9x62cfwzhsp82imnawyamxp58bcb00yjxdy44spylqnjdlsaj8")))) "0akbxdmsjsq5fzbwaap04hqjpsfgv1l6yrc2pwgbya1xgqvcq6vy"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; parts of the tests rely on access to the network ;; parts of the tests rely on access to the network
(arguments '(#:tests? #f)) (arguments '(#:tests? #f))

1
gnu/packages/bootstrap.scm
View File

@ -177,6 +177,7 @@ return value is ignored."
((string=? system "powerpc64le-linux") "/lib/ld64.so.2") ((string=? system "powerpc64le-linux") "/lib/ld64.so.2")
((string=? system "alpha-linux") "/lib/ld-linux.so.2") ((string=? system "alpha-linux") "/lib/ld-linux.so.2")
((string=? system "s390x-linux") "/lib/ld64.so.1") ((string=? system "s390x-linux") "/lib/ld64.so.1")
((string=? system "riscv64-linux") "/lib/ld-linux-riscv64-lp64d.so.1")
;; XXX: This one is used bare-bones, without a libc, so add a case ;; XXX: This one is used bare-bones, without a libc, so add a case
;; here just so we can keep going. ;; here just so we can keep going.

4
gnu/packages/coq.scm
View File

@ -499,7 +499,7 @@ uses Ltac to synthesize the substitution operation.")
(define-public coq-equations (define-public coq-equations
(package (package
(name "coq-equations") (name "coq-equations")
(version "1.2-beta2") (version "1.2")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -508,7 +508,7 @@ uses Ltac to synthesize the substitution operation.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0y2zwv7jxs1crprj5qvg46h0v9wyfn99ln40yskq91y9h1lj5h3j")))) "1q3wvicr43bgy7xn1diwh4j43mnrhprrc2xd22qlbz9cl6bhf8bj"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("ocaml" ,ocaml) `(("ocaml" ,ocaml)

95
gnu/packages/cran.scm
View File

@ -738,6 +738,8 @@ and vice-versa.")
("js-strftime" ,js-strftime) ("js-strftime" ,js-strftime)
("js-highlight" ,js-highlight) ("js-highlight" ,js-highlight)
("js-es5-shim" ,js-es5-shim))) ("js-es5-shim" ,js-es5-shim)))
(native-inputs
`(("uglify-js" ,uglify-js)))
(home-page "http://shiny.rstudio.com") (home-page "http://shiny.rstudio.com")
(synopsis "Easy interactive web applications with R") (synopsis "Easy interactive web applications with R")
(description (description
@ -983,14 +985,14 @@ coordinates.")
(define-public r-geosphere (define-public r-geosphere
(package (package
(name "r-geosphere") (name "r-geosphere")
(version "1.5-7") (version "1.5-10")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "geosphere" version)) (uri (cran-uri "geosphere" version))
(sha256 (sha256
(base32 (base32
"186qdm5niq7v3d4w4rngx71znsgi44hnam7698bsx9ar5mg5b6wx")))) "15xlgsmn0vwky1l13n6acdz6jn2b2na3gf6x367y3qh1f5w4zkan"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs `(("r-sp" ,r-sp))) (propagated-inputs `(("r-sp" ,r-sp)))
(home-page "https://cran.r-project.org/web/packages/geosphere") (home-page "https://cran.r-project.org/web/packages/geosphere")
@ -2066,14 +2068,14 @@ topics for ecologists (ISBN 978-0-691-12522-0).")
(define-public r-lpsolve (define-public r-lpsolve
(package (package
(name "r-lpsolve") (name "r-lpsolve")
(version "5.6.13") (version "5.6.13.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "lpSolve" version)) (uri (cran-uri "lpSolve" version))
(sha256 (sha256
(base32 (base32
"13a9ry8xf5j1f2j6imqrxdgxqz3nqp9sj9b4ivyx9sid459irm6m")))) "1f10ywlaaldgjj84vs108ly0nsbkrdgbn5d6qj7nk93j1x1xrn3a"))))
(properties `((upstream-name . "lpSolve"))) (properties `((upstream-name . "lpSolve")))
(build-system r-build-system) (build-system r-build-system)
(home-page "https://cran.r-project.org/web/packages/lpSolve") (home-page "https://cran.r-project.org/web/packages/lpSolve")
@ -2204,14 +2206,14 @@ George Marsaglia are included.")
(define-public r-ksamples (define-public r-ksamples
(package (package
(name "r-ksamples") (name "r-ksamples")
(version "1.2-8") (version "1.2-9")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "kSamples" version)) (uri (cran-uri "kSamples" version))
(sha256 (sha256
(base32 (base32
"15d5q5vpp4wx5rk5kjxjdxpwc8mkq5sbdz8gi07iscrvhzb5rzfr")))) "1zs22p68d6320kcylisnk0b5wmpapxkyz15py09czxzw7npw8gms"))))
(properties `((upstream-name . "kSamples"))) (properties `((upstream-name . "kSamples")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -2892,14 +2894,14 @@ Laplace approximation and adaptive Gauss-Hermite quadrature.")
(define-public r-jomo (define-public r-jomo
(package (package
(name "r-jomo") (name "r-jomo")
(version "2.6-7") (version "2.6-8")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "jomo" version)) (uri (cran-uri "jomo" version))
(sha256 (sha256
(base32 (base32
"0lyvi32aikkvwdj0y2hc13kmmi0cw1icg8z9lcw10l8326sxm0vf")))) "097zfdcqc3a45ay8xxbraqh8xsfyivskkdmc2b4ca4n979lx8vyb"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-lme4" ,r-lme4) `(("r-lme4" ,r-lme4)
@ -3494,14 +3496,14 @@ timeout. It can also poll several processes at once.")
(define-public r-tsp (define-public r-tsp
(package (package
(name "r-tsp") (name "r-tsp")
(version "1.1-6") (version "1.1-7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "TSP" version)) (uri (cran-uri "TSP" version))
(sha256 (sha256
(base32 (base32
"1ym97xl2icjpfkrici0wig29w06bb704hp51v7h5liygjlwpkhlc")))) "0rxxhvqi55869dg2p82hzg5kvgcqf9h60cjcg00k3pv9aw4x07kb"))))
(properties `((upstream-name . "TSP"))) (properties `((upstream-name . "TSP")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs `(("r-foreach" ,r-foreach))) (propagated-inputs `(("r-foreach" ,r-foreach)))
@ -3581,14 +3583,14 @@ Markdown documents.")
(define-public r-seriation (define-public r-seriation
(package (package
(name "r-seriation") (name "r-seriation")
(version "1.2-3") (version "1.2-5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "seriation" version)) (uri (cran-uri "seriation" version))
(sha256 (sha256
(base32 (base32
"1q6hw4hjw224b4y0dc0j630v2pgj6sn455nwkilb70w8k31hpk92")))) "0sk4wfwxxhz3nwbcsfshb93gra4c9p5pvpsz00d7f9nkkmhs97ws"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-cluster" ,r-cluster) `(("r-cluster" ,r-cluster)
@ -3713,14 +3715,14 @@ to variables on the left-hand side of the assignment.")
(define-public r-pillar (define-public r-pillar
(package (package
(name "r-pillar") (name "r-pillar")
(version "1.4.0") (version "1.4.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "pillar" version)) (uri (cran-uri "pillar" version))
(sha256 (sha256
(base32 (base32
"1c8rwwh677vc92f4k6qj4mxl3acran1iqdv5dj6r1dyv7fvmcvfx")))) "0mcc09caxm69pghhz6b8vawj9ni63aijv5qba53pg4ph7rxclwgm"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-cli" ,r-cli) `(("r-cli" ,r-cli)
@ -4995,14 +4997,14 @@ additional external tools on any platform.")
(define-public r-openxlsx (define-public r-openxlsx
(package (package
(name "r-openxlsx") (name "r-openxlsx")
(version "4.1.0") (version "4.1.0.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "openxlsx" version)) (uri (cran-uri "openxlsx" version))
(sha256 (sha256
(base32 (base32
"1n7z22pm78xa77fvn77kdn68az6xzxk36y11sqf0w6h6adri4yxb")))) "1lflygpi1z4rlb1c6g6wsmi334maiiy7jhpg6ph4sw8lpvg12w4b"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-rcpp" ,r-rcpp) `(("r-rcpp" ,r-rcpp)
@ -5859,14 +5861,14 @@ intervals.")
(define-public r-snakecase (define-public r-snakecase
(package (package
(name "r-snakecase") (name "r-snakecase")
(version "0.10.0") (version "0.11.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "snakecase" version)) (uri (cran-uri "snakecase" version))
(sha256 (sha256
(base32 (base32
"0325zkpyqa15lx7biq2cbimr2773332bp4jvcvnl00bjx41ia2fm")))) "1ky1x2cp5rd0ffd9m1fji9sq4z4jsrpxzg30brw8bb4ihfjj114r"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-stringi" ,r-stringi) `(("r-stringi" ,r-stringi)
@ -6290,14 +6292,14 @@ Group (Non-)Overlap considerations.")
(define-public r-refgenome (define-public r-refgenome
(package (package
(name "r-refgenome") (name "r-refgenome")
(version "1.7.3.1") (version "1.7.7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "refGenome" version)) (uri (cran-uri "refGenome" version))
(sha256 (sha256
(base32 (base32
"1s4lxv5pqk6d0f0a9iclgv88yl346fwvzgraxh0gwpbym1yhh787")))) "1za89bn3am1zgvm641qi1ab6kaqpll4rb9p9f1sjwvcgqq6065g5"))))
(properties `((upstream-name . "refGenome"))) (properties `((upstream-name . "refGenome")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -7786,14 +7788,14 @@ correlation, censored, ordered and multivariate problems.")
(define-public r-bayesplot (define-public r-bayesplot
(package (package
(name "r-bayesplot") (name "r-bayesplot")
(version "1.6.0") (version "1.7.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "bayesplot" version)) (uri (cran-uri "bayesplot" version))
(sha256 (sha256
(base32 (base32
"0in9cq2ybpa7njrwqx4l6nc8i01cjswsvzwlyiw465pi74aapr57")))) "0h23sbfny2hcipvvfhq5aiwdh1vanizn7f8lpb9kffypxhcd7v7w"))))
(build-system r-build-system) (build-system r-build-system)
(inputs (inputs
`(("pandoc" ,ghc-pandoc) `(("pandoc" ,ghc-pandoc)
@ -7802,8 +7804,11 @@ correlation, censored, ordered and multivariate problems.")
`(("r-dplyr" ,r-dplyr) `(("r-dplyr" ,r-dplyr)
("r-ggplot2" ,r-ggplot2) ("r-ggplot2" ,r-ggplot2)
("r-ggridges" ,r-ggridges) ("r-ggridges" ,r-ggridges)
("r-glue" ,r-glue)
("r-reshape2" ,r-reshape2) ("r-reshape2" ,r-reshape2)
("r-rlang" ,r-rlang))) ("r-rlang" ,r-rlang)
("r-tibble" ,r-tibble)
("r-tidyselect" ,r-tidyselect)))
(home-page "http://mc-stan.org/bayesplot") (home-page "http://mc-stan.org/bayesplot")
(synopsis "Plotting for Bayesian models") (synopsis "Plotting for Bayesian models")
(description (description
@ -7918,14 +7923,14 @@ differentiation.")
(define-public r-bayestestr (define-public r-bayestestr
(package (package
(name "r-bayestestr") (name "r-bayestestr")
(version "0.1.0") (version "0.2.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "bayestestR" version)) (uri (cran-uri "bayestestR" version))
(sha256 (sha256
(base32 (base32
"1m6gj55z3shm3m3mgqj8nk73wij67y617sl04rbj400wz9qrhfva")))) "0729j4fdxkkvmh99nmny38dywidzgmipdjqbi2ljxygsn4jg7ysy"))))
(properties `((upstream-name . "bayestestR"))) (properties `((upstream-name . "bayestestR")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -8797,14 +8802,14 @@ isosurfaces.")
(define-public r-ks (define-public r-ks
(package (package
(name "r-ks") (name "r-ks")
(version "1.11.4") (version "1.11.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "ks" version)) (uri (cran-uri "ks" version))
(sha256 (sha256
(base32 (base32
"0d5i8458s8ri9pcx2jm003z1ajk7ha3pmw1sr6lgn6a8d7wgmvqb")))) "06ymx244yknmpl6935l4pafqbm4gcbpnhqg7rinql6rrfr9mcrag"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-fnn" ,r-fnn) `(("r-fnn" ,r-fnn)
@ -10481,14 +10486,14 @@ Differences with other sparse matrix packages are:
(define-public r-fields (define-public r-fields
(package (package
(name "r-fields") (name "r-fields")
(version "9.8-1") (version "9.8-3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "fields" version)) (uri (cran-uri "fields" version))
(sha256 (sha256
(base32 (base32
"1zb44bm9mwbnld2q915nxxji3hqa025cmlaar7da35lyqlrjl30v")))) "1q9x68dczjym56v7x90x4x5br59vj3dww6w8v42zd3yl17h7c1h1"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-maps" ,r-maps) `(("r-maps" ,r-maps)
@ -10724,14 +10729,14 @@ But it can also be used to do data analysis for small scale data sets.")
(define-public r-cmprsk (define-public r-cmprsk
(package (package
(name "r-cmprsk") (name "r-cmprsk")
(version "2.2-7") (version "2.2-8")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "cmprsk" version)) (uri (cran-uri "cmprsk" version))
(sha256 (sha256
(base32 (base32
"1imr3wpnj4g57n2x4ryahl4lk8lvq9y2r7319zv3k82mznha8bcm")))) "1nacbzx950ygaqgnj0949skhwpzar5i3xlscd44jsimk2gsppx6z"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-survival" ,r-survival))) `(("r-survival" ,r-survival)))
@ -10751,14 +10756,14 @@ JASA, 94:496-509.")
(define-public r-etm (define-public r-etm
(package (package
(name "r-etm") (name "r-etm")
(version "1.0.4") (version "1.0.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "etm" version)) (uri (cran-uri "etm" version))
(sha256 (sha256
(base32 (base32
"0ws103b3pmli0z4xbyfxkly2wnnnxnnwc0r66qjjqjrlvm7pffl1")))) "1yivbq8y0ijcl1m4nir4q9hp4pi6iphwxgjprygsdf7vp98wq677"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-data-table" ,r-data-table) `(("r-data-table" ,r-data-table)
@ -10777,14 +10782,14 @@ model with finite state space using the Aalen-Johansen estimator.")
(define-public r-epi (define-public r-epi
(package (package
(name "r-epi") (name "r-epi")
(version "2.35") (version "2.37")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "Epi" version)) (uri (cran-uri "Epi" version))
(sha256 (sha256
(base32 (base32
"1z3959761ryv54y6vsrxxvhrwzz50xrxn55pqh5y7lrxh91zdsvl")))) "1lanr9x0c6w22406p56j7cwk6wck8njq6pscb4gzc613d68zj1lk"))))
(properties `((upstream-name . "Epi"))) (properties `((upstream-name . "Epi")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -11155,14 +11160,14 @@ algorithms) can be computed and partitioned matrices can be plotted.")
(define-public r-upsetr (define-public r-upsetr
(package (package
(name "r-upsetr") (name "r-upsetr")
(version "1.3.3") (version "1.4.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "UpSetR" version)) (uri (cran-uri "UpSetR" version))
(sha256 (sha256
(base32 (base32
"08vj7l92b8fpqyqwxshll2mhk3yhgyr74axvr2lf29z78bapymhz")))) "007i0njnjjy7vbrxabwav7a1kk2n0hn2mkvqsdzzfk10ckp5y7im"))))
(properties `((upstream-name . "UpSetR"))) (properties `((upstream-name . "UpSetR")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -12895,21 +12900,21 @@ SELECT or UPDATE queries to an end-point.")
(define-public r-bookdown (define-public r-bookdown
(package (package
(name "r-bookdown") (name "r-bookdown")
(version "0.10") (version "0.11")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "bookdown" version)) (uri (cran-uri "bookdown" version))
(sha256 (sha256
(base32 (base32
"0xk57p9iyj7rqrwb89q3pm8p29ca615fj1h9blf5yb3zhga4bjk3")))) "0w4fkv5fqiaqgkx44p0s161imf29zir9742126xkz1pl1j25jn1r"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-htmltools" ,r-htmltools) `(("r-htmltools" ,r-htmltools)
("r-knitr" ,r-knitr) ("r-knitr" ,r-knitr)
("r-rmarkdown" ,r-rmarkdown) ("r-rmarkdown" ,r-rmarkdown)
("r-tinytex" ,r-tinytex) ("r-tinytex" ,r-tinytex)
("r-yaml" ,r-yaml) ("r-xfun" ,r-xfun)
("r-xfun" ,r-xfun))) ("pandoc" ,ghc-pandoc)))
(home-page "https://github.com/rstudio/bookdown") (home-page "https://github.com/rstudio/bookdown")
(synopsis "Authoring books and technical documents with R markdown") (synopsis "Authoring books and technical documents with R markdown")
(description "This package provides output formats and utilities for (description "This package provides output formats and utilities for
@ -12941,14 +12946,14 @@ that accept short and long options.")
(define-public r-wgcna (define-public r-wgcna
(package (package
(name "r-wgcna") (name "r-wgcna")
(version "1.67") (version "1.68")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "WGCNA" version)) (uri (cran-uri "WGCNA" version))
(sha256 (sha256
(base32 (base32
"09387w85lxvwr8ax2i2h602b4dgfv4wbvsl9aj1q0b1vfs4rkk69")))) "1s7gy5vd7x67hpgli8r7ba2z99w3psiyv5hqmrh94zw141dg210a"))))
(properties `((upstream-name . "WGCNA"))) (properties `((upstream-name . "WGCNA")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -14398,14 +14403,14 @@ includes data sets from oceanography.")
(define-public r-ggfortify (define-public r-ggfortify
(package (package
(name "r-ggfortify") (name "r-ggfortify")
(version "0.4.6") (version "0.4.7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "ggfortify" version)) (uri (cran-uri "ggfortify" version))
(sha256 (sha256
(base32 (base32
"1clyha9f9ygma64xbgi78lxsp1203f2ashqhhdpm71nr6w91bm88")))) "1wk9j0xg5hj9i1vf62qjiphv8cbsgq7y6baay3pfl3wyb2dwgci0"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-dplyr" ,r-dplyr) `(("r-dplyr" ,r-dplyr)

12
gnu/packages/cross-base.scm
View File

@ -39,7 +39,8 @@
#:export (cross-binutils #:export (cross-binutils
cross-libc cross-libc
cross-gcc cross-gcc
cross-newlib?)) cross-newlib?
cross-kernel-headers))
(define-syntax %xgcc (define-syntax %xgcc
;; GCC package used as the basis for cross-compilation. It doesn't have to ;; GCC package used as the basis for cross-compilation. It doesn't have to
@ -276,18 +277,19 @@ target that libc."
(define* (cross-kernel-headers target (define* (cross-kernel-headers target
#:optional #:optional
(linux-headers linux-libre-headers)
(xgcc (cross-gcc target)) (xgcc (cross-gcc target))
(xbinutils (cross-binutils target))) (xbinutils (cross-binutils target)))
"Return headers depending on TARGET." "Return headers depending on TARGET."
(define xlinux-headers (define xlinux-headers
(package (inherit linux-libre-headers) (package (inherit linux-headers)
(name (string-append (package-name linux-libre-headers) (name (string-append (package-name linux-headers)
"-cross-" target)) "-cross-" target))
(arguments (arguments
(substitute-keyword-arguments (substitute-keyword-arguments
`(#:implicit-cross-inputs? #f `(#:implicit-cross-inputs? #f
,@(package-arguments linux-libre-headers)) ,@(package-arguments linux-headers))
((#:phases phases) ((#:phases phases)
`(alist-replace `(alist-replace
'build 'build
@ -300,7 +302,7 @@ target that libc."
,phases)))) ,phases))))
(native-inputs `(("cross-gcc" ,xgcc) (native-inputs `(("cross-gcc" ,xgcc)
("cross-binutils" ,xbinutils) ("cross-binutils" ,xbinutils)
,@(package-native-inputs linux-libre-headers))))) ,@(package-native-inputs linux-headers)))))
(define xgnumach-headers (define xgnumach-headers
(package (inherit gnumach-headers) (package (inherit gnumach-headers)

4
gnu/packages/databases.scm
View File

@ -2398,14 +2398,14 @@ You might also want to install the following optional dependencies:
(define-public python-alembic (define-public python-alembic
(package (package
(name "python-alembic") (name "python-alembic")
(version "1.0.2") (version "1.0.10")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "alembic" version)) (uri (pypi-uri "alembic" version))
(sha256 (sha256
(base32 (base32
"0asqz9mwc4w8bsar1icv3ik9jslxrj3gv3yxgmhc6nc6r9qbkg04")))) "1dwl0264r6ri2jyrjr68am04x538ab26xwy4crqjnnhm4alwm3c2"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("python-mock" ,python-mock) `(("python-mock" ,python-mock)

8
gnu/packages/debian.scm
View File

@ -32,7 +32,7 @@
(define-public debian-archive-keyring (define-public debian-archive-keyring
(package (package
(name "debian-archive-keyring") (name "debian-archive-keyring")
(version "2018.1") (version "2019.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -42,7 +42,7 @@
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"136vr5dj7w0dz563qdghsndcfcqm2m8d4j1dyiq9dzx5vd0rcpcw")))) "0bphwji3ywk1zi5bq8bhqk7l51fwjy1idwsw7zfqnxca8m5wvw1g"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:test-target "verify-results" '(#:test-target "verify-results"
@ -117,7 +117,7 @@ contains the archive keys used for that.")
(define-public debootstrap (define-public debootstrap
(package (package
(name "debootstrap") (name "debootstrap")
(version "1.0.111") (version "1.0.114")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -127,7 +127,7 @@ contains the archive keys used for that.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1b8s00a2kvaajqhjlms3q2dk3gqv6g4yq9h843jal1pm66zsx19n")))) "147308flz9y8g6f972izi3szmsywf5f8xm64z2smy1cayd340i63"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

4
gnu/packages/dictionaries.scm
View File

@ -218,7 +218,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.")
(define-public grammalecte (define-public grammalecte
(package (package
(name "grammalecte") (name "grammalecte")
(version "1.1") (version "1.1.1")
(source (source
(origin (origin
(method url-fetch/zipbomb) (method url-fetch/zipbomb)
@ -226,7 +226,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.")
"Grammalecte-fr-v" version ".zip")) "Grammalecte-fr-v" version ".zip"))
(sha256 (sha256
(base32 (base32
"031d6cn1wn7ps3j38vx6s8z2gjp9nqgiypqm3bfbhxqcammyhian")))) "1al4c3976wgxijxghxqb1banarj82hwad51kln87xj2r5kwcfm05"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://grammalecte.net") (home-page "https://grammalecte.net")
(synopsis "French spelling and grammar checker") (synopsis "French spelling and grammar checker")

9
gnu/packages/display-managers.scm
View File

@ -75,6 +75,15 @@
("linux-pam" ,linux-pam) ("linux-pam" ,linux-pam)
("qtbase" ,qtbase) ("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative) ("qtdeclarative" ,qtdeclarative)
;; Some user-defined themes use QtQuick components internally. Adding
;; QtQuick & co. here; they end up in QML2_IMPORT_PATH thanks to
;; 'wrap-qt-program'.
("qtgraphicaleffects" ,qtgraphicaleffects)
("qtquickcontrols" ,qtquickcontrols)
("qtquickcontrols2" ,qtquickcontrols2)
("qtsvg" ,qtsvg)
("shadow" ,shadow) ("shadow" ,shadow)
("wayland" ,wayland))) ("wayland" ,wayland)))
(arguments (arguments

107
gnu/packages/education.scm
View File

@ -27,7 +27,10 @@
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages databases)
#:use-module (gnu packages fonts)
#:use-module (gnu packages freedesktop) #:use-module (gnu packages freedesktop)
#:use-module (gnu packages game-development)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages gnome) #:use-module (gnu packages gnome)
@ -373,3 +376,107 @@ keyboard is also available if the child does not have any other
specialized device.") specialized device.")
(home-page "https://bipede.fr/contrib/") (home-page "https://bipede.fr/contrib/")
(license license:gpl3))) (license license:gpl3)))
(define-public childsplay
(package
(name "childsplay")
(version "3.4")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/schoolsplay/"
"childsplay-" version ".tgz"))
(sha256
(base32
"0z7yp2swjnbz51vn2zyfnjn40jq38l5mbh15yafmx1z3vn2z1m77"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
#:tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'unbundle-dejavu-font
(lambda* (#:key inputs #:allow-other-keys)
(let* ((dejavu-dir
(string-append (assoc-ref inputs "font-dejavu")
"/share/fonts/truetype"))
(dejavu-font
(string-append dejavu-dir
"/DejaVuSansCondensed-Bold.ttf")))
(substitute* "SPConstants.py"
(("^(TTF(BOLD)? = ).*" _ prefix)
(string-append prefix "'" dejavu-font "'\n")))
(for-each (lambda (f) (delete-file f))
(find-files "lib/SPData" "DejaVu"))
#t)))
(delete 'build)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(pixmaps (string-append out "/share/pixmaps"))
(share (string-append out "/share/childsplay"))
(doc (string-append out "/share/doc/" ,name "-",version)))
;; Install icon.
(install-file "lib/SPData/themes/childsplay/logo_cp.svg" pixmaps)
;; Install data.
(mkdir-p share)
(for-each (lambda (f)
(copy-recursively f (string-append share "/" f)))
'("alphabet-sounds" "lib" "locale" "SPWidgets"))
(for-each (lambda (f) (install-file f share))
(find-files "." "\\.(py|dev|db)$"))
;; Install documentation.
(mkdir-p doc)
(copy-recursively "docs" doc)
#t)))
(add-after 'install 'create-executable
(lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((python (string-append (assoc-ref inputs "python")
"/bin/python"))
(out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(executable (string-append bin "/childsplay")))
(mkdir-p bin)
(call-with-output-file executable
(lambda (file)
(format file
"~a ~a"
python
(string-append out "/share/childsplay/childsplay.py"))))
(chmod executable #o555)
#t)))
(add-after 'install 'create-desktop-file
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(applications (string-append out "/share/applications")))
(mkdir-p applications)
(call-with-output-file
(string-append applications "/childsplay.desktop")
(lambda (file)
(format file
"[Desktop Entry]~@
Name=Childsplay~@
Comment=Suite of educational games for young children~@
Comment[ca]=Conjunt de jocs educatius per a xiquets~@
Comment[es]=Conjunto de juegos educativos para niños~@
Comment[de]=Sammlung mit lehrreichen Spielen für kleine Kinder~@
Exec=~a/bin/childsplay.py~@
Terminal=false~@
Icon=logo_cp.svg~@
Type=Application~@
Categories=Application;Game;Education;KidsGame;~@
Keywords=suite;children;games;young;educational;~%"
out)))
#t))))))
(inputs
`(("font-dejavu" ,font-dejavu)
("pygame" ,python2-pygame)
("sqlalchemy" ,python2-sqlalchemy)))
(synopsis "Suite of educational games for young children")
(description "Childsplay is a collection of educational activities
for young children. Childsplay can be used at home, kindergartens and
pre-schools. Childsplay is a fun and safe way to let young children
use the computer and at the same time teach them a little math,
letters of the alphabet, spelling, eye-hand coordination, etc.")
(home-page "http://www.schoolsplay.org")
(license license:gpl3+)))

23
gnu/packages/elf.scm
View File

@ -160,13 +160,19 @@ static analysis of the ELF binaries at hand.")
(package (package
(name "libelf") (name "libelf")
(version "0.8.13") (version "0.8.13")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "http://www.mr511.de/software/libelf-" (method url-fetch)
version ".tar.gz")) (uri (list
(sha256 ;; As of May 2019, the original URL at mr511.de redirects to a
(base32 ;; domain that doesn't resolve. Use these two mirrors instead.
"0vf7s9dwk2xkmhb79aigqm0x0yfbw1j0b9ksm51207qwr179n6jr")))) (string-append "https://fossies.org/linux/misc/old/"
"libelf-" version ".tar.gz")
(string-append "https://ftp.osuosl.org/pub/blfs/conglomeration/"
"libelf/libelf-" version ".tar.gz")))
(sha256
(base32
"0vf7s9dwk2xkmhb79aigqm0x0yfbw1j0b9ksm51207qwr179n6jr"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -183,7 +189,8 @@ static analysis of the ELF binaries at hand.")
(%current-system)) (%current-system))
'("--host=aarch64-unknown-linux-gnu") '("--host=aarch64-unknown-linux-gnu")
'())))))))) '()))))))))
(home-page "http://www.mr511.de/software/english.html") (home-page (string-append "https://web.archive.org/web/20181111033959/"
"http://www.mr511.de/software/english.html"))
(synopsis "ELF object file access library") (synopsis "ELF object file access library")
(description "Libelf is a C library to access ELF object files.") (description "Libelf is a C library to access ELF object files.")
(license lgpl2.0+))) (license lgpl2.0+)))

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

@ -33,7 +33,7 @@
;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org> ;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2017, 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2017, 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018 Sohom Bhattacharjee <soham.bhattacharjee15@gmail.com> ;;; Copyright © 2018 Sohom Bhattacharjee <soham.bhattacharjee15@gmail.com>
;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2018, 2019 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2018, 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> ;;; Copyright © 2018, 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2018, 2019 Jack Hill <jackhill@jackhill.us> ;;; Copyright © 2018, 2019 Jack Hill <jackhill@jackhill.us>
@ -777,7 +777,7 @@ in certain cases. It also enables recursion for anonymous functions.")
(define-public emacs-xr (define-public emacs-xr
(package (package
(name "emacs-xr") (name "emacs-xr")
(version "1.11") (version "1.12")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -785,7 +785,7 @@ in certain cases. It also enables recursion for anonymous functions.")
"https://elpa.gnu.org/packages/xr-" version ".tar")) "https://elpa.gnu.org/packages/xr-" version ".tar"))
(sha256 (sha256
(base32 (base32
"0xwfs2mkmgf63sfp5jwmw0ybc8pa0rlxh5aqwb348ddgmclv322f")))) "1vv87h0h8ldc1mbsn45w5z1m6jq8j2js4xz23a9ixdby06g60y3g"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "http://elpa.gnu.org/packages/xr.html") (home-page "http://elpa.gnu.org/packages/xr.html")
(synopsis "Convert string regexp to rx notation") (synopsis "Convert string regexp to rx notation")
@ -804,10 +804,33 @@ skip set strings, which are arguments to @code{skip-chars-forward} and
@code{skip-chars-backward}.") @code{skip-chars-backward}.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-reformatter
(package
(name "emacs-reformatter")
(version "0.4")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/purcell/reformatter.el.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0hhy6x1bkwlhdlarsgm06g3am4yh02yqv8qs34szpzgy53x84qah"))))
(build-system emacs-build-system)
(home-page "https://github.com/purcell/reformatter.el")
(synopsis "Define commands which run reformatters on the current buffer")
(description
"This library lets elisp authors easily define an idiomatic command to
reformat the current buffer using a command-line program, together with an
optional minor mode which can apply this command automatically on save.")
(license license:gpl3+)))
(define-public emacs-relint (define-public emacs-relint
(package (package
(name "emacs-relint") (name "emacs-relint")
(version "1.7") (version "1.8")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -815,7 +838,7 @@ skip set strings, which are arguments to @code{skip-chars-forward} and
"https://elpa.gnu.org/packages/relint-" version ".el")) "https://elpa.gnu.org/packages/relint-" version ".el"))
(sha256 (sha256
(base32 (base32
"0h9nc84yv5lmbaa8any6i3bqcn6xn1gy6cv6kqaywn0nnqrm17i1")))) "1bl6m2h7131acbmr0kqfnjjpv2syiv2mxfnm61g874ynnvkmmkm3"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs `(("emacs-xr" ,emacs-xr))) (propagated-inputs `(("emacs-xr" ,emacs-xr)))
(home-page "https://github.com/mattiase/relint") (home-page "https://github.com/mattiase/relint")
@ -4074,23 +4097,29 @@ well as completely new features.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-highlight-symbol (define-public emacs-highlight-symbol
(package ;; We prefer a more recent commit that provides an option to squelch
(name "emacs-highlight-symbol") ;; echo-area alerts that can drown out useful information like eldoc
(version "1.3") ;; messages.
(source (let ((commit "7a789c779648c55b16e43278e51be5898c121b3a")
(origin (version "1.3")
(method git-fetch) (revision "1"))
(uri (git-reference (package
(url "https://github.com/nschum/highlight-symbol.el.git") (name "emacs-highlight-symbol")
(commit version))) (version (git-version version revision commit))
(file-name (git-file-name name version)) (source
(sha256 (origin
(base32 "09z13kv2g21kjjkkm3iyaz93sdjmdy2d563r8n7r7ng94acrn7f6")))) (method git-fetch)
(build-system emacs-build-system) (uri (git-reference
(home-page "https://nschum.de/src/emacs/highlight-symbol") (url "https://github.com/nschum/highlight-symbol.el.git")
(synopsis "Automatic and manual symbol highlighting for Emacs") (commit commit)))
(description (file-name (git-file-name name version))
"Use @code{highlight-symbol} to toggle highlighting of the symbol at (sha256
(base32 "19cgyk0sh8nsmf3jbi92i8qsdx4l4yilfq5jj9zfdbj9p5gvwx96"))))
(build-system emacs-build-system)
(home-page "https://nschum.de/src/emacs/highlight-symbol/")
(synopsis "Automatic and manual symbol highlighting for Emacs")
(description
"Use @code{highlight-symbol} to toggle highlighting of the symbol at
point throughout the current buffer. Use @code{highlight-symbol-mode} to keep point throughout the current buffer. Use @code{highlight-symbol-mode} to keep
the symbol at point highlighted. the symbol at point highlighted.
@ -4103,7 +4132,7 @@ bindings @code{M-p} and @code{M-p} for navigation. When
regardless of @code{highlight-symbol-idle-delay}. regardless of @code{highlight-symbol-idle-delay}.
@code{highlight-symbol-query-replace} can be used to replace the symbol. ") @code{highlight-symbol-query-replace} can be used to replace the symbol. ")
(license license:gpl2+))) (license license:gpl2+))))
(define-public emacs-hl-todo (define-public emacs-hl-todo
(package (package
@ -4397,6 +4426,33 @@ splitting the input text by spaces and re-building it into a regular
expression.") expression.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-ivy-pass
(let ((commit "5b523de1151f2109fdd6a8114d0af12eef83d3c5")
(revision "1"))
(package
(name "emacs-ivy-pass")
(version (git-version "0.1" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/ecraven/ivy-pass.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"18crb4zh2pjf0cmv3b913m9vfng27girjwfqc3mk7vqd1r5a49yk"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-ivy" ,emacs-ivy)
("emacs-password-store" ,emacs-password-store)
("password-store" ,password-store)))
(home-page "https://github.com/ecraven/ivy-pass")
(synopsis "Ivy interface for password store (pass)")
(description "This package provides an Ivy interface for working with
the password store @code{pass}.")
(license license:gpl3))))
(define-public emacs-ivy-yasnippet (define-public emacs-ivy-yasnippet
(let ((commit "32580b4fd23ebf9ca7dde96704f7d53df6e253cd") (let ((commit "32580b4fd23ebf9ca7dde96704f7d53df6e253cd")
(revision "2")) (revision "2"))
@ -4455,7 +4511,7 @@ show icons as well.")
(define-public emacs-avy (define-public emacs-avy
(package (package
(name "emacs-avy") (name "emacs-avy")
(version "0.4.0") (version "0.5.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -4464,7 +4520,7 @@ show icons as well.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0rq9ab264565z83cly743nbhrd9m967apmnlhqr1gy8dm4hcy7nm")))) (base32 "09qdni1s74i5pv8741szl5g4ynj8fxn0x65qmwa9rmfkbimnc0fs"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/abo-abo/avy") (home-page "https://github.com/abo-abo/avy")
(synopsis "Tree-based completion for Emacs") (synopsis "Tree-based completion for Emacs")
@ -4554,37 +4610,35 @@ navigate code in a tree-like fashion.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-lispy (define-public emacs-lispy
;; Release 0.26.0 was almost 3 years ago, and there have been ~772 commits (package
;; since. (name "emacs-lispy")
(let ((commit "f94cfc6b8f9c3afe7d028c366928049c011023de") (version "0.27.0")
(revision "1")) (home-page "https://github.com/abo-abo/lispy")
(package (source (origin
(name "emacs-lispy") (method git-fetch)
(version (git-version "0.26.0" revision commit)) (uri (git-reference
(home-page "https://github.com/abo-abo/lispy") (url "https://github.com/abo-abo/lispy")
(source (origin (commit version)))
(method git-fetch) (sha256
(uri (git-reference (url home-page) (commit commit))) (base32
(sha256 "1cm7f4pyl73f3vhkb7ah6bbbrj2sa7n0p31g09k7dy4zgx04bgw6"))
(base32 (file-name (git-file-name name version))))
"1bm2cpwizg1qfpm377gpx1af1hm5maw69if1csnk5vwaphmv8c4g")) (build-system emacs-build-system)
(file-name (git-file-name name version)))) (propagated-inputs
(build-system emacs-build-system) `(("emacs-ace-window" ,emacs-ace-window)
(propagated-inputs ("emacs-iedit" ,emacs-iedit)
`(("emacs-ace-window" ,emacs-ace-window) ("emacs-ivy" ,emacs-ivy)
("emacs-iedit" ,emacs-iedit) ("emacs-hydra" ,emacs-hydra)
("emacs-ivy" ,emacs-ivy) ("emacs-zoutline" ,emacs-zoutline)))
("emacs-hydra" ,emacs-hydra) (synopsis "Modal S-expression editing")
("emacs-zoutline" ,emacs-zoutline))) (description
(synopsis "Modal S-expression editing") "Due to the structure of Lisp syntax it's very rare for the programmer
(description
"Due to the structure of Lisp syntax it's very rare for the programmer
to want to insert characters right before \"(\" or right after \")\". Thus to want to insert characters right before \"(\" or right after \")\". Thus
unprefixed printable characters can be used to call commands when the point is unprefixed printable characters can be used to call commands when the point is
at one of these special locations. Lispy provides unprefixed keybindings for at one of these special locations. Lispy provides unprefixed keybindings for
S-expression editing when point is at the beginning or end of an S-expression editing when point is at the beginning or end of an
S-expression.") S-expression.")
(license license:gpl3+)))) (license license:gpl3+)))
(define-public emacs-lispyville (define-public emacs-lispyville
(let ((commit "d28b937f0cabd8ce61e2020fe9a733ca80d82c74") (let ((commit "d28b937f0cabd8ce61e2020fe9a733ca80d82c74")
@ -5554,7 +5608,7 @@ ack, ag, helm and pt.")
(define-public emacs-helm (define-public emacs-helm
(package (package
(name "emacs-helm") (name "emacs-helm")
(version "3.1") (version "3.2")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -5563,7 +5617,7 @@ ack, ag, helm and pt.")
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1x3nv8zvp8vvl30bm2d83hd7zxb0ca64pc8kwb81ml9al6r3mm01")))) (base32 "12yyprpgh2by2pd41i4z9gz55fxg0f90x03bfrsf791xwbhf6931"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-async" ,emacs-async) `(("emacs-async" ,emacs-async)
@ -7019,26 +7073,27 @@ actually changing the buffer's text.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-diff-hl (define-public emacs-diff-hl
(package (package
(name "emacs-diff-hl") (name "emacs-diff-hl")
(version "1.8.5") (version "1.8.6")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://elpa.gnu.org/packages/diff-hl-" (uri (git-reference
version ".tar")) (url "https://github.com/dgutov/diff-hl")
(sha256 (commit version)))
(sha256
(base32 (base32
"1vxc7z7c2qs0mx7l5sa4sybi5qbzv0s79flj74p1ynw8dl3qxg3d")))) "1xlsg728mz3cwhrsqvisa0aidic67nymd9g7h4c1h3q63j39yb2s"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/dgutov/diff-hl") (home-page "https://github.com/dgutov/diff-hl")
(synopsis (synopsis
"Highlight uncommitted changes using VC") "Highlight uncommitted changes using VC")
(description (description
"@code{diff-hl-mode} highlights uncommitted changes on the side of the "@code{diff-hl-mode} highlights uncommitted changes on the side of the
window (using the fringe, by default), allows you to jump between window (using the fringe, by default), allows you to jump between
the hunks and revert them selectively.") the hunks and revert them selectively.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-diminish (define-public emacs-diminish
(package (package
@ -9223,16 +9278,16 @@ functionality is inherited from @code{hcl-mode}.")
(define-public emacs-exec-path-from-shell (define-public emacs-exec-path-from-shell
(package (package
(name "emacs-exec-path-from-shell") (name "emacs-exec-path-from-shell")
(version "1.11") (version "1.12")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append (uri (git-reference
"https://stable.melpa.org/packages/exec-path-from-shell-" (url "https://github.com/purcell/exec-path-from-shell")
version ".el")) (commit version)))
(sha256 (sha256
(base32 (base32
"03qjgb81cq1l3j54lvlf98r75vmmgd06mj6qh5wa6mz4xzp4w26r")))) "1ga8bpxngd3ph2hdiik92c612ki71qxw818i6rgx6f6a5r0sbf3p"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/purcell/exec-path-from-shell") (home-page "https://github.com/purcell/exec-path-from-shell")
(synopsis "Get environment variables such as @var{PATH} from the shell") (synopsis "Get environment variables such as @var{PATH} from the shell")
@ -12467,16 +12522,17 @@ the GIF result.")
(define-public emacs-google-translate (define-public emacs-google-translate
(package (package
(name "emacs-google-translate") (name "emacs-google-translate")
(version "0.11.16") (version "0.11.17")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://github.com/atykhonov/google-translate/" (uri (git-reference
"archive/v" version ".tar.gz")) (url "https://github.com/atykhonov/google-translate/")
(file-name (string-append name "-" version ".tar.gz")) (commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"01n9spj1d0gjfj39x526rl3m9c28wnx9afipmf5s8y77cx3mfwhl")))) "05ljjw7kbnszygw3w085kv57swfiiqxri2b5xvsf5dw3pc3g7j3c"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/atykhonov/google-translate") (home-page "https://github.com/atykhonov/google-translate")
(synopsis "Emacs interface to Google Translate") (synopsis "Emacs interface to Google Translate")
@ -13405,7 +13461,7 @@ backends, including the @command{wordnet} offline backend.")
(define-public emacs-editorconfig (define-public emacs-editorconfig
(package (package
(name "emacs-editorconfig") (name "emacs-editorconfig")
(version "0.7.14") (version "0.8.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -13415,7 +13471,7 @@ backends, including the @command{wordnet} offline backend.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"19j2428ij7sqvrqs7rqg1mcnv9109y6drqba40dkv3vrkk5d2yia")))) "1b2cpqz75pivl323bs60j5rszwi787x6vy68csycikqz9mhpmjn9"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/editorconfig/editorconfig-emacs") (home-page "https://github.com/editorconfig/editorconfig-emacs")
(synopsis "Define and maintain consistent coding styles between different (synopsis "Define and maintain consistent coding styles between different
@ -15346,7 +15402,7 @@ well as an option for visually flashing evaluated s-expressions.")
(define-public emacs-counsel-tramp (define-public emacs-counsel-tramp
(package (package
(name "emacs-counsel-tramp") (name "emacs-counsel-tramp")
(version "0.6.2") (version "0.6.3")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -15356,7 +15412,7 @@ well as an option for visually flashing evaluated s-expressions.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0nz0733x2b9b5nkwivvhv5c8747dng451na1sdfbkx5x9fjs5gc7")))) "1qy9lf7cyv6hp9mmpwh92cpdcffbxzyzchx6878d5pmk9qh6xy92"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-ivy" ,emacs-ivy))) `(("emacs-ivy" ,emacs-ivy)))

4
gnu/packages/emulators.scm
View File

@ -407,7 +407,7 @@ Super Game Boy, BS-X Satellaview, and Sufami Turbo.")
(define-public mgba (define-public mgba
(package (package
(name "mgba") (name "mgba")
(version "0.7.1") (version "0.7.2")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -416,7 +416,7 @@ Super Game Boy, BS-X Satellaview, and Sufami Turbo.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0q0yg2zna7gjbvpaswyykbg3lr9k3c8l8fydqa407xrgq77lahq4")) "0g0xa1mzvan0sl1p5c784j2g5mcw9kd2b7wiahy06gy0c1nmbcnp"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Make sure we don't use the bundled software. ;; Make sure we don't use the bundled software.

1
gnu/packages/game-development.scm
View File

@ -1521,5 +1521,4 @@ the original, ioquake3 has been cleaned up, bugs have been fixed and features
added. The permanent goal is to create the open source Quake 3 distribution added. The permanent goal is to create the open source Quake 3 distribution
upon which people base their games, ports to new platforms, and other upon which people base their games, ports to new platforms, and other
projects.") projects.")
(supported-systems '("x86_64-linux" "i686-linux"))
(license license:gpl2)))) (license license:gpl2))))

28
gnu/packages/games.scm
View File

@ -141,6 +141,7 @@
#:use-module (gnu packages sdl) #:use-module (gnu packages sdl)
#:use-module (gnu packages serialization) #:use-module (gnu packages serialization)
#:use-module (gnu packages sqlite) #:use-module (gnu packages sqlite)
#:use-module (gnu packages squirrel)
#:use-module (gnu packages swig) #:use-module (gnu packages swig)
#:use-module (gnu packages tcl) #:use-module (gnu packages tcl)
#:use-module (gnu packages terminals) #:use-module (gnu packages terminals)
@ -3495,19 +3496,36 @@ with the \"Stamp\" tool within Tux Paint.")
(define-public supertux (define-public supertux
(package (package
(name "supertux") (name "supertux")
(version "0.5.1") (version "0.6.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/SuperTux/supertux/" (uri (string-append "https://github.com/SuperTux/supertux/"
"releases/download/v" version "/SuperTux-v" "releases/download/v" version "/SuperTux-v"
version "-Source.tar.gz")) version "-Source.tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1i8avad7w7ikj870z519j383ldy29r6f956bs38cbr8wk513pp69")))) "1h1s4abirkdv4ag22zvyk6zkk64skqbjmcnnba67ps4hdzxfbhy4"))
(patches
(search-patches "supertux-fix-build-with-gcc5.patch"
"supertux-unbundle-squirrel.patch"))))
(arguments (arguments
'(#:tests? #f '(#:tests? #f
#:configure-flags '("-DINSTALL_SUBDIR_BIN=bin" #:configure-flags '("-DINSTALL_SUBDIR_BIN=bin"
"-DENABLE_BOOST_STATIC_LIBS=OFF"))) "-DENABLE_BOOST_STATIC_LIBS=OFF"
"-DUSE_SYSTEM_PHYSFS=ON")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-squirrel-path
(lambda* (#:key inputs #:allow-other-keys)
(let ((squirrel (assoc-ref inputs "squirrel")))
(substitute* "CMakeLists.txt"
(("set\\(SQUIRREL_PREFIX.*")
(string-append "set(SQUIRREL_PREFIX " squirrel ")"))
(("add_dependencies\\(supertux2_lib squirrel\\)") "")
(("\\$\\{SQUIRREL_PREFIX\\}/include")
(string-append "${SQUIRREL_PREFIX}/include/squirrel"))))
#t)))))
(build-system cmake-build-system) (build-system cmake-build-system)
(inputs `(("sdl2" ,sdl2) (inputs `(("sdl2" ,sdl2)
("sdl2-image" ,sdl2-image) ("sdl2-image" ,sdl2-image)
@ -3519,7 +3537,9 @@ with the \"Stamp\" tool within Tux Paint.")
("libogg" ,libogg) ("libogg" ,libogg)
("physfs" ,physfs) ("physfs" ,physfs)
("curl" ,curl) ("curl" ,curl)
("boost" ,boost))) ("boost" ,boost)
("freetype" ,freetype)
("squirrel" ,squirrel)))
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(synopsis "2D platformer game") (synopsis "2D platformer game")
(description "SuperTux is a free classic 2D jump'n run sidescroller game (description "SuperTux is a free classic 2D jump'n run sidescroller game

29
gnu/packages/geo.scm
View File

@ -7,6 +7,7 @@
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Joshua Sierles, Nextjournal <joshua@nextjournal.com> ;;; Copyright © 2018 Joshua Sierles, Nextjournal <joshua@nextjournal.com>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,6 +37,7 @@
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages autotools)
#:use-module (gnu packages boost) #:use-module (gnu packages boost)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
@ -840,3 +842,30 @@ map, geocoding with Nominatim, or general analysis.")
the texture and density of features is visible at every zoom level, instead of the texture and density of features is visible at every zoom level, instead of
dropping features at lower levels.") dropping features at lower levels.")
(license license:bsd-2))) (license license:bsd-2)))
(define-public osmctools
(package
(name "osmctools")
(version "0.9")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/osm-c-tools/osmctools")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"1m8d3r1q1v05pkr8k9czrmb4xjszw6hvgsf3kn9pf0v14gpn4r8f"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)))
(inputs
`(("zlib" ,zlib)))
(home-page "https://gitlab.com/osm-c-tools/osmctools")
(synopsis "Tools to convert, filter and update OpenStreetMap data files")
(description "This project contains a few tools which are used in the
OpenStreetMap project. They can be used to convert, filter and update
OpenStreetMap data files.")
(license license:agpl3)))

98
gnu/packages/gnome.scm
View File

@ -162,6 +162,7 @@
#:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system meson) #:use-module (guix build-system meson)
#:use-module (guix build-system python)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
@ -4444,7 +4445,7 @@ principles are simplicity and standards compliance.")
(define-public d-feet (define-public d-feet
(package (package
(name "d-feet") (name "d-feet")
(version "0.3.11") (version "0.3.14")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/" (uri (string-append "mirror://gnome/sources/" name "/"
@ -4452,7 +4453,7 @@ principles are simplicity and standards compliance.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1hmrijm4d9vwzx2r8qzzsy8ccpj79l1y6cc569n9jjzqcq699p53")))) "1m8lwiwl5jhi0x7y6x5zmd3hjplgvdjrb8a8jg74rvkygslj1p7f"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
'(#:out-of-source? #f ; tests need to run in the source directory. '(#:out-of-source? #f ; tests need to run in the source directory.
@ -4491,6 +4492,7 @@ principles are simplicity and standards compliance.")
`(("gobject-introspection" ,gobject-introspection) `(("gobject-introspection" ,gobject-introspection)
("gtk+" ,gtk+) ("gtk+" ,gtk+)
("python" ,python-wrapper) ("python" ,python-wrapper)
("hicolor-icon-theme" ,hicolor-icon-theme)
("python-pygobject" ,python-pygobject))) ("python-pygobject" ,python-pygobject)))
(home-page "https://wiki.gnome.org/Apps/DFeet") (home-page "https://wiki.gnome.org/Apps/DFeet")
(synopsis "D-Bus debugger") (synopsis "D-Bus debugger")
@ -7973,3 +7975,95 @@ functionality.")
(license (list license:lgpl2.1 license:lgpl3 ; either one of these (license (list license:lgpl2.1 license:lgpl3 ; either one of these
license:openldap2.8 ; addressbook/gui/component/openldap-extract.h license:openldap2.8 ; addressbook/gui/component/openldap-extract.h
license:lgpl2.1+)))) ; smime/lib/* license:lgpl2.1+)))) ; smime/lib/*
(define-public gthumb
(package
(name "gthumb")
(version "3.8.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/gthumb/"
(version-major+minor version) "/"
"gthumb-" version ".tar.xz"))
(sha256
(base32
"1l2s1facq1r6yvqjqc34aqfzlvb3nhkhn79xisxbbdlgrrxdq52f"))))
(build-system meson-build-system)
(arguments
`(#:glib-or-gtk? #t
#:configure-flags
;; Ensure the RUNPATH contains all installed library locations.
(list (string-append "-Dc_link_args=-Wl,-rpath="
(assoc-ref %outputs "out")
"/lib/gthumb/extensions")
(string-append "-Dcpp_link_args=-Wl,-rpath="
(assoc-ref %outputs "out")
"/lib/gthumb/extensions"))))
(native-inputs
`(("pkg-config" ,pkg-config)
("glib:bin" ,glib "bin") ; for glib-compile-resources
("gtk+:bin" ,gtk+ "bin") ; for gtk-update-icon-cache
("desktop-file-utils" ,desktop-file-utils) ; for update-desktop-database
("intltool" ,intltool)
("itstool" ,itstool)))
(inputs
`(("exiv2" ,exiv2)
("gtk" ,gtk+)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("gstreamer" ,gstreamer)
("clutter" ,clutter)
("clutter-gst" ,clutter-gst)
("clutter-gtk" ,clutter-gtk)
("libjpeg" ,libjpeg)
("libtiff" ,libtiff)
("libraw" ,libraw)))
(home-page "https://wiki.gnome.org/Apps/Gthumb")
(synopsis "GNOME image viewer and browser")
(description "GThumb is an image viewer, browser, organizer, editor and
advanced image management tool")
(license license:gpl2+)))
(define-public terminator
(package
(name "terminator")
(version "1.91")
(source (origin
(method url-fetch)
(uri (string-append "https://launchpad.net/" name "/"
"gtk3/" version "/" "+download/"
name "-" version ".tar.gz"))
(sha256
(base32
"0sdyqwydmdnh7j6mn74vrywz35m416kqsbxbrqcnv5ak08y6xxwm"))))
(build-system python-build-system)
(native-inputs
`(("intltool" ,intltool)
("glib:bin" ,glib "bin") ; for glib-compile-resources
("gettext" ,gettext-minimal)
("pkg-config" ,pkg-config)))
(inputs
`(("cairo" ,cairo)
("gobject-introspection" ,gobject-introspection)
("python2-pycairo" ,python2-pycairo)
("python2-pygobject" ,python2-pygobject)
("python2-psutil" ,python2-psutil)
("vte" ,vte)))
(arguments
`(#:python ,python-2 ;Python 3 not supported
#:phases
(modify-phases %standard-phases
(add-after
'install 'wrap-program
(lambda* (#:key outputs #:allow-other-keys)
(let ((prog (string-append (assoc-ref outputs "out")
"/bin/terminator")))
(wrap-program prog
`("PYTHONPATH" = (,(getenv "PYTHONPATH")))
`("GI_TYPELIB_PATH" = (,(getenv "GI_TYPELIB_PATH"))))
#t))))))
(home-page "https://gnometerminator.blogspot.com/")
(synopsis "Store and run multiple GNOME terminals in one window")
(description
"Terminator allows you to run multiple GNOME terminals in a grid and
+tabs, and it supports drag and drop re-ordering of terminals.")
(license license:gpl2)))

9
gnu/packages/gnucash.scm
View File

@ -54,7 +54,7 @@
;; directory. ;; directory.
(package (package
(name "gnucash") (name "gnucash")
(version "3.4") (version "3.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -62,8 +62,7 @@
version "/gnucash-" version ".tar.bz2")) version "/gnucash-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1ms2wg4sh5gq3rpjmmnp85rh5nc9ahca1imxkvhz4d3yiwy8hm52")) "0ibp7g6aknvnkwkin97kv04ipksy3l18dsz9qysjb7h2nr8hnvbp"))))
(patches (search-patches "gnucash-fix-test-transaction-failure.patch"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(inputs (inputs
`(("guile" ,guile-2.2) `(("guile" ,guile-2.2)
@ -197,7 +196,7 @@ installed as well as Yelp, the Gnome help browser.")
;; This package is not public, since we use it to build the "doc" output of ;; This package is not public, since we use it to build the "doc" output of
;; the gnucash package (see above). It would be confusing if it were public. ;; the gnucash package (see above). It would be confusing if it were public.
(define gnucash-docs (define gnucash-docs
(let ((revision "a")) ;set to the empty string when no revision (let ((revision "")) ;set to the empty string when no revision
(package (package
(name "gnucash-docs") (name "gnucash-docs")
(version (package-version gnucash)) (version (package-version gnucash))
@ -208,7 +207,7 @@ installed as well as Yelp, the Gnome help browser.")
version "/gnucash-docs-" version revision ".tar.gz")) version "/gnucash-docs-" version revision ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0bgjxpxgk7hy8ihn1kvd8p6vv191q5md2hz6jb9mqc4aykpvdlq7")))) "0gjndyms413vilf5nqh39frs1691sxib8l7y9mbvcyirj1f8285k"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; These are native-inputs because they are only required for building the ;; These are native-inputs because they are only required for building the
;; documentation. ;; documentation.

20
gnu/packages/golang.scm
View File

@ -14,6 +14,7 @@
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright @ 2018, 2019 Katherine Cox-Buday <cox.katherine.e@gmail.com> ;;; Copyright @ 2018, 2019 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright @ 2019 Giovanni Biscuolo <g@xelera.eu> ;;; Copyright @ 2019 Giovanni Biscuolo <g@xelera.eu>
;;; Copyright @ 2019 Alex Griffin <a@ajgrf.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -61,14 +62,16 @@
(define-public go-1.4 (define-public go-1.4
(package (package
(name "go") (name "go")
(version "1.4.3") ;; The C-language bootstrap of Go:
;; https://golang.org/doc/install/source#go14
(version "1.4-bootstrap-20171003")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://storage.googleapis.com/golang/" (uri (string-append "https://storage.googleapis.com/golang/"
name version ".src.tar.gz")) name version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0na9yqilzpvq0bjndbibfp07wr796gf252y471cip10bbdqgqiwr")))) "0liybk5z00hizsb5ypkbhqcawnwwa6mkwgvjjg4y3jm3ndg5pzzl"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" (outputs '("out"
"doc" "doc"
@ -135,13 +138,6 @@
("os/os_test.go" "(.+)(TestHostname.+)") ("os/os_test.go" "(.+)(TestHostname.+)")
("time/format_test.go" "(.+)(TestParseInSydney.+)") ("time/format_test.go" "(.+)(TestParseInSydney.+)")
;; Tzdata 2016g changed the name of the time zone used in this
;; test, and the patch for Go 1.7 does not work for 1.4.3:
;; https://github.com/golang/go/issues/17545
;; https://github.com/golang/go/issues/17276
("time/time_test.go" "(.+)(TestLoadFixed.+)")
("time/format_test.go" "(.+)(TestParseInLocation.+)")
("os/exec/exec_test.go" "(.+)(TestEcho.+)") ("os/exec/exec_test.go" "(.+)(TestEcho.+)")
("os/exec/exec_test.go" "(.+)(TestCommandRelativeName.+)") ("os/exec/exec_test.go" "(.+)(TestCommandRelativeName.+)")
("os/exec/exec_test.go" "(.+)(TestCatStdin.+)") ("os/exec/exec_test.go" "(.+)(TestCatStdin.+)")
@ -168,9 +164,7 @@
(setenv "GOOS" "linux") (setenv "GOOS" "linux")
(setenv "GOROOT" (dirname (getcwd))) (setenv "GOROOT" (dirname (getcwd)))
(setenv "GOROOT_FINAL" output) (setenv "GOROOT_FINAL" output)
;; Go 1.4's cgo will not work with binutils >= 2.27: (setenv "GO14TESTS" "1")
;; https://github.com/golang/go/issues/16906
(setenv "CGO_ENABLED" "0")
(invoke "sh" "all.bash")))) (invoke "sh" "all.bash"))))
(replace 'install (replace 'install

5
gnu/packages/gtk.scm
View File

@ -348,7 +348,10 @@ diagrams.")
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"07hrabhpl6n8ajz10s0d960jdwndxs87szxyn428mpxi8cvpg1f5")))) "07hrabhpl6n8ajz10s0d960jdwndxs87szxyn428mpxi8cvpg1f5"))
(patches
(search-patches
"gtksourceview-2-add-default-directory.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("intltool" ,intltool) `(("intltool" ,intltool)

75
gnu/packages/guile-xyz.scm
View File

@ -9,7 +9,7 @@
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org> ;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2016 Amirouche <amirouche@hypermove.net> ;;; Copyright © 2016 Amirouche <amirouche@hypermove.net>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016, 2019 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 David Thompson <davet@gnu.org> ;;; Copyright © 2017 David Thompson <davet@gnu.org>
;;; Copyright © 2017, 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017, 2018 Mathieu Othacehe <m.othacehe@gmail.com>
@ -53,8 +53,10 @@
#:use-module (gnu packages gawk) #:use-module (gnu packages gawk)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome) #:use-module (gnu packages gnome)
#:use-module (gnu packages gperf) #:use-module (gnu packages gperf)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages hurd) #:use-module (gnu packages hurd)
#:use-module (gnu packages image) #:use-module (gnu packages image)
@ -76,11 +78,13 @@
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages version-control) #:use-module (gnu packages version-control)
#:use-module (gnu packages webkit)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (guix hg-download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system guile) #:use-module (guix build-system guile)
#:use-module (guix utils) #:use-module (guix utils)
@ -2232,3 +2236,72 @@ slashes are present and accounted for, resolving @code{.} and @code{..}, etc).
Inevitably, you have to break the string up into chunks and operate on that Inevitably, you have to break the string up into chunks and operate on that
list of components. This module takes care of that for you.") list of components. This module takes care of that for you.")
(license license:lgpl3+))) (license license:lgpl3+)))
(define-public guile-gi
(let ((commit "91753258892c4a1fbf7ed43ff793a00ac0f77cf6")
(revision "0"))
(package
(name "guile-gi")
(version (string-append "0.0.1-" revision "." (string-take commit 7)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/janneke/guile-gi.git")
(commit commit)))
(file-name (string-append name "-" version))
(sha256
(base32
"1i76jfs90p8pbx0bfrjd4sias9380pmjb9x387rx7hav4kvnsd1b"))))
(build-system gnu-build-system)
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)
("gettext" ,gnu-gettext)
("libtool" ,libtool)
("pkg-config" ,pkg-config)
("texinfo" ,texinfo)))
(propagated-inputs `(("glib" ,glib)
("gobject-introspection" ,gobject-introspection)
("gssettings-desktop-schemas" ,gsettings-desktop-schemas)
("gtk+" ,gtk+)
("guile-lib" ,guile-lib)
("webkitgtk" ,webkitgtk)))
(inputs `(("guile" ,guile-2.2)))
(arguments
`(#:configure-flags '("--with-gnu-filesystem-hierarchy")))
(home-page "https://github.com/spk121/guile-gi")
(synopsis "GObject bindings for Guile")
(description
"Guile-GI is a library for Guile that allows using GObject-based
libraries, such as GTK+3. Its README comes with the disclaimer: This is
pre-alpha code.")
(license license:gpl3+))))
(define-public guile-srfi-159
(let ((commit "1bd98abda2ae4ef8f36761a167903e55c6bda7bb")
(revision "0"))
(package
(name "guile-srfi-159")
(version (git-version "0" revision commit))
(home-page "https://bitbucket.org/bjoli/guile-srfi-159")
(source (origin
(method hg-fetch)
(uri (hg-reference (changeset commit)
(url home-page)))
(sha256
(base32
"1zw6cmcy7xdbfiz3nz9arqnn7l2daidaps6ixkcrc9b6k51fdv3p"))
(file-name (git-file-name name version))))
(build-system guile-build-system)
(arguments
;; The *-impl.scm files are actually included from module files; they
;; should not be compiled separately, but they must be installed.
'(#:not-compiled-file-regexp "-impl\\.scm$"))
(inputs
`(("guile" ,guile-2.2)))
(synopsis "Formatting combinators for Guile")
(description
"The @code{(srfi-159)} module and its sub-modules implement the
formatting combinators specified by
@uref{https://srfi.schemers.org/srfi-159/srfi-159.html, SRFI-159}. These are
more expressive and flexible than the traditional @code{format} procedure.")
(license license:bsd-3))))

10
gnu/packages/haskell.scm
View File

@ -1325,6 +1325,16 @@ postfix notation. For more information on stack based languages, see
(base32 (base32
"138xpxdb7x62lpmgmb6b3v3vgdqqvqn4273jaap3mjmc2gla709y")))) "138xpxdb7x62lpmgmb6b3v3vgdqqvqn4273jaap3mjmc2gla709y"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'skip-test-issue93
(lambda _
;; Tests run out of memory on a system with 2GB of available RAM,
;; in 'issue93.a.hs' and 'issue93.n.hs'.
(substitute* "tests/Makefile"
((" issue93.y ") " "))
#t)))))
(home-page "https://hackage.haskell.org/package/happy") (home-page "https://hackage.haskell.org/package/happy")
(synopsis "Parser generator for Haskell") (synopsis "Parser generator for Haskell")
(description "Happy is a parser generator for Haskell. Given a grammar (description "Happy is a parser generator for Haskell. Given a grammar

23
gnu/packages/libevent.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2015, 2017 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2017 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr> ;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
;;; Copyright © 2016 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017, 2019 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
@ -41,7 +41,7 @@
(define-public libevent (define-public libevent
(package (package
(name "libevent") (name "libevent")
(version "2.1.8") (version "2.1.10")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -49,11 +49,7 @@
version "-stable/libevent-" version "-stable.tar.gz")) version "-stable/libevent-" version "-stable.tar.gz"))
(sha256 (sha256
(base32 (base32
"1hhxnxlr0fsdv7bdmzsnhdz16fxf3jg2r6vyljcl3kj6pflcap4n")) "1c25928gdv495clxk2v1d4gkr5py7ack4gx2n7d13frnld0syr78"))))
(patches (search-patches "libevent-2.1-dns-tests.patch"
;; XXX: Try removing this for > 2.1.8.
;; https://github.com/libevent/libevent/issues/452
"libevent-2.1-skip-failing-test.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
;; This skips some of the tests which fail on armhf and aarch64. ;; This skips some of the tests which fail on armhf and aarch64.
@ -154,19 +150,6 @@ resolution, asynchronous file system operations, and threading primitives.")
;; details. Documentation is CC-BY 4.0 as of 1.12.0; see 'LICENSE-docs'. ;; details. Documentation is CC-BY 4.0 as of 1.12.0; see 'LICENSE-docs'.
(license (list expat cc-by4.0)))) (license (list expat cc-by4.0))))
;; This version is required for Node versions < 10.
(define-public libuv-1.19
(package
(inherit libuv)
(version "1.19.2")
(source (origin
(method url-fetch)
(uri (string-append "https://dist.libuv.org/dist/v" version
"/libuv-v" version ".tar.gz"))
(sha256
(base32
"1msk9ac1z69whww88ibrwjqkd1apdla6l77cm2fwy5kigq0z5g3w"))))))
(define-public perl-anyevent (define-public perl-anyevent
(package (package
(name "perl-anyevent") (name "perl-anyevent")

193
gnu/packages/linux.scm
View File

@ -34,6 +34,7 @@
;;; Copyright © 2018 Vasile Dumitrascu <va511e@yahoo.com> ;;; Copyright © 2018 Vasile Dumitrascu <va511e@yahoo.com>
;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Stefan Stefanović <stefanx2ovic@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -143,6 +144,7 @@
((string-prefix? "alpha" arch) "alpha") ((string-prefix? "alpha" arch) "alpha")
((string-prefix? "powerpc" arch) "powerpc") ;including "powerpc64le" ((string-prefix? "powerpc" arch) "powerpc") ;including "powerpc64le"
((string-prefix? "s390" arch) "s390") ((string-prefix? "s390" arch) "s390")
((string-prefix? "riscv" arch) "riscv")
(else arch)))) (else arch))))
(define-public (system->defconfig system) (define-public (system->defconfig system)
@ -169,18 +171,20 @@ defconfig. Return the appropriate make target if applicable, otherwise return
"mirror://gnu/linux-libre/" version "-gnu/linux-libre-" "mirror://gnu/linux-libre/" version "-gnu/linux-libre-"
version "-gnu.tar.xz"))) version "-gnu.tar.xz")))
(define-public linux-libre-headers (define (make-linux-libre-headers version hash)
(package (package
(name "linux-libre-headers") (name "linux-libre-headers")
(version "4.14.67") (version version)
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (linux-libre-urls version)) (uri (linux-libre-urls version))
(sha256 (sha256 (base32 hash))))
(base32
"050zvdxjy6sc64q75pr1gxsmh49chwav2pwxz8xlif39bvahnrpg"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl))) (native-inputs `(("perl" ,perl)
,@(if (version>=? version "4.16")
`(("flex" ,flex)
("bison" ,bison))
'())))
(arguments (arguments
`(#:modules ((guix build gnu-build-system) `(#:modules ((guix build gnu-build-system)
(guix build utils) (guix build utils)
@ -246,7 +250,7 @@ defconfig. Return the appropriate make target if applicable, otherwise return
"/raw/34a7d9011fcfcfa38b68282fd2b1a8797e6834f0" "/raw/34a7d9011fcfcfa38b68282fd2b1a8797e6834f0"
"/debian/patches/bugfix/arm/" "/debian/patches/bugfix/arm/"
"arm-mm-export-__sync_icache_dcache-for-xen-privcmd.patch")) "arm-mm-export-__sync_icache_dcache-for-xen-privcmd.patch"))
(file-name "linux-libre-4.19-arm-export-__sync_icache_dcache.patch") (file-name "linux-libre-arm-export-__sync_icache_dcache.patch")
(sha256 (sha256
(base32 "1ifnfhpakzffn4b8n7x7w5cps9mzjxlkcfz9zqak2vaw8nzvl39f")))) (base32 "1ifnfhpakzffn4b8n7x7w5cps9mzjxlkcfz9zqak2vaw8nzvl39f"))))
@ -426,22 +430,26 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
It has been modified to remove all non-free binary blobs.") It has been modified to remove all non-free binary blobs.")
(license license:gpl2))) (license license:gpl2)))
(define %linux-libre-version "5.1.4") (define %linux-libre-version "5.1.6")
(define %linux-libre-hash "02pzad29w2apcqsk4r4fq93539z3by8kvk1f59lb8xnl0gvhdi5v") (define %linux-libre-hash "0m7yi23wlgrh16z5z9dxb7dd64i2irrkdwxi71i88mradn55iq42")
(define %linux-libre-5.1-patches (define %linux-libre-5.1-patches
(list %boot-logo-patch (list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch)) %linux-libre-arm-export-__sync_icache_dcache-patch))
(define-public linux-libre (define-public linux-libre-5.1
(make-linux-libre %linux-libre-version (make-linux-libre %linux-libre-version
%linux-libre-hash %linux-libre-hash
'("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux") '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")
#:patches %linux-libre-5.1-patches #:patches %linux-libre-5.1-patches
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define %linux-libre-4.19-version "4.19.45") (define-public linux-libre-headers-5.1
(define %linux-libre-4.19-hash "1wiy8vzpzzml4k76nv3ycjx7ky55x7dqx3mgpjqbh73mj2gcr5bx") (make-linux-libre-headers %linux-libre-version
%linux-libre-hash))
(define %linux-libre-4.19-version "4.19.47")
(define %linux-libre-4.19-hash "155rn6f555d2r1bqzi74zdif44ay7gk25xxjgw36s9n26dml8wf7")
(define %linux-libre-4.19-patches (define %linux-libre-4.19-patches
(list %boot-logo-patch (list %boot-logo-patch
@ -454,8 +462,26 @@ It has been modified to remove all non-free binary blobs.")
#:patches %linux-libre-4.19-patches #:patches %linux-libre-4.19-patches
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define %linux-libre-4.14-version "4.14.121") (define-public linux-libre-headers-4.19
(define %linux-libre-4.14-hash "1g7gyjmp056pasf9m34dqs8pa15my6hqasdd551jw8mgkbhsfnxg") (make-linux-libre-headers %linux-libre-4.19-version
%linux-libre-4.19-hash))
(define %linux-libre-4.15-version "4.15.18")
(define %linux-libre-4.15-hash "0f0s4drx888ydlwjcm9qcxqian4850yiv2vamyw9bbjf83frwxyw")
(define-public linux-libre-4.15
(make-linux-libre %linux-libre-4.15-version
%linux-libre-4.15-hash
'("x86_64-linux" "i686-linux" "armhf-linux")
#:configuration-file kernel-config))
(define-public linux-libre-headers-4.15
(make-linux-libre-headers %linux-libre-4.15-version
%linux-libre-4.15-hash))
(define %linux-libre-4.14-version "4.14.123")
(define %linux-libre-4.14-hash "185kf576rwhsaq7jqrnmg8r5fh2nh4k8lifxaxwi3amshnwbj2qg")
(define-public linux-libre-4.14 (define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version (make-linux-libre %linux-libre-4.14-version
@ -463,9 +489,13 @@ It has been modified to remove all non-free binary blobs.")
'("x86_64-linux" "i686-linux" "armhf-linux") '("x86_64-linux" "i686-linux" "armhf-linux")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-headers-4.14
(make-linux-libre-headers %linux-libre-4.14-version
%linux-libre-4.14-hash))
(define-public linux-libre-4.9 (define-public linux-libre-4.9
(make-linux-libre "4.9.178" (make-linux-libre "4.9.180"
"1ridlkymf382qnkc6hi07pkghrrxfv2avx55snjnkfcpdccvsmrb" "062ybvc5ljpbn8llj62zsvvykl5rikn0jfzh62nrrdsnj7mvi77a"
'("x86_64-linux" "i686-linux") '("x86_64-linux" "i686-linux")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
@ -481,14 +511,6 @@ It has been modified to remove all non-free binary blobs.")
("CONFIG_DEVPTS_MULTIPLE_INSTANCES" . #t)) ("CONFIG_DEVPTS_MULTIPLE_INSTANCES" . #t))
%default-extra-linux-options))) %default-extra-linux-options)))
(define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version
%linux-libre-hash
'("armhf-linux")
#:patches %linux-libre-5.1-patches
#:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic"))
(define-public linux-libre-arm-veyron (define-public linux-libre-arm-veyron
(make-linux-libre %linux-libre-version (make-linux-libre %linux-libre-version
%linux-libre-hash %linux-libre-hash
@ -497,6 +519,21 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config-veyron #:configuration-file kernel-config-veyron
#:extra-version "arm-veyron")) #:extra-version "arm-veyron"))
(define-public linux-libre-headers-4.14.67
(make-linux-libre-headers "4.14.67"
"050zvdxjy6sc64q75pr1gxsmh49chwav2pwxz8xlif39bvahnrpg"))
(define-public linux-libre-headers linux-libre-headers-4.14.67)
(define-public linux-libre linux-libre-5.1)
(define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version
%linux-libre-hash
'("armhf-linux")
#:patches %linux-libre-5.1-patches
#:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic"))
(define-public linux-libre-arm-generic-4.19 (define-public linux-libre-arm-generic-4.19
(make-linux-libre %linux-libre-4.19-version (make-linux-libre %linux-libre-4.19-version
%linux-libre-4.19-hash %linux-libre-4.19-hash
@ -535,28 +572,6 @@ It has been modified to remove all non-free binary blobs.")
#:defconfig "omap2plus_defconfig" #:defconfig "omap2plus_defconfig"
#:extra-version "arm-omap2plus")) #:extra-version "arm-omap2plus"))
(define-public vhba-module
(package
(name "vhba-module")
(version "20190410")
(source (origin
(method url-fetch)
(uri (string-append
"http://downloads.sourceforge.net/cdemu/vhba-module/vhba-module-"
version ".tar.bz2"))
(sha256
(base32
"1513hq130raxp9z5grj54cwfjfxj05apipxg425j0zicii59a60c"))))
(build-system linux-module-build-system)
(arguments
;; TODO: No tests?
`(#:tests? #f))
(home-page "https://cdemu.sourceforge.io/")
(synopsis "Kernel module that emulates SCSI devices")
(description "VHBA module provides a Virtual (SCSI) HBA, which is the link
between the CDemu userspace daemon and linux kernel.")
(license license:gpl2+)))
;;; ;;;
;;; Linux kernel modules. ;;; Linux kernel modules.
@ -4061,6 +4076,39 @@ Linux kernel to retrieve and control processor features related to power saving,
such as frequency and voltage scaling.") such as frequency and voltage scaling.")
(license license:gpl2))) (license license:gpl2)))
(define-public x86-energy-perf-policy
(package
(name "x86-energy-perf-policy")
(version (package-version linux-libre))
(source (package-source linux-libre))
(build-system gnu-build-system)
(arguments
'(#:tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-subdirectory
(lambda _
(chdir "tools/power/x86/x86_energy_perf_policy")
#t))
(delete 'configure)
(add-before 'build 'fix-makefile
(lambda _
(substitute* "Makefile" (("/usr") ""))
#t)))
#:make-flags
(let ((out (assoc-ref %outputs "out")))
(list (string-append "DESTDIR=" out)
(string-append "LDFLAGS=-Wl,-rpath=" out "/lib")))))
(supported-systems '("i686-linux" "x86_64-linux"))
(home-page (package-home-page linux-libre))
(synopsis "Display and update Intel-CPU energy-performance policy")
(description
"@command{x86_energy_perf_policy} displays and updates energy-performance
policy settings specific to Intel Architecture Processors. Settings are
accessed via Model Specific Register (MSR) updates, no matter if the Linux
cpufreq sub-system is enabled or not.")
(license license:gpl2)))
(define-public haveged (define-public haveged
(package (package
(name "haveged") (name "haveged")
@ -4589,10 +4637,19 @@ interface in sysfs, which can be accomplished with the included udev rules.")
("sed" ,sed) ("sed" ,sed)
("usbutils" ,usbutils) ("usbutils" ,usbutils)
("util-linux" ,util-linux) ("util-linux" ,util-linux)
("wireless-tools" ,wireless-tools))) ("wireless-tools" ,wireless-tools)
,@(if (let ((system (or (%current-target-system)
(%current-system))))
(or (string-prefix? "i686-" system)
(string-prefix? "x86_64-" system)))
`(("x86-energy-perf-policy" ,x86-energy-perf-policy))
'())))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1))
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(delete 'configure) ; no configure script (delete 'configure) ; no configure script
(add-before 'build 'setenv (add-before 'build 'setenv
@ -4630,30 +4687,34 @@ interface in sysfs, which can be accomplished with the included udev rules.")
(let* ((bin (string-append (assoc-ref outputs "out") "/bin")) (let* ((bin (string-append (assoc-ref outputs "out") "/bin"))
(bin-files (find-files bin ".*"))) (bin-files (find-files bin ".*")))
(define (bin-directory input-name) (define (bin-directory input-name)
(string-append (assoc-ref inputs input-name) "/bin")) (let ((p (assoc-ref inputs input-name)))
(and p (string-append p "/bin"))))
(define (sbin-directory input-name) (define (sbin-directory input-name)
(string-append (assoc-ref inputs input-name) "/sbin")) (string-append (assoc-ref inputs input-name) "/sbin"))
(for-each (lambda (program) (for-each (lambda (program)
(wrap-program program (wrap-program program
`("PATH" ":" prefix `("PATH" ":" prefix
,(append ,(append
(map bin-directory '("bash" (filter-map bin-directory
"coreutils" '("bash"
"dbus" "coreutils"
"eudev" "dbus"
"grep" "eudev"
"inetutils" "grep"
"kmod" "inetutils"
"perl" "kmod"
"sed" "perl"
"usbutils" "sed"
"util-linux")) "usbutils"
(map sbin-directory '("ethtool" "util-linux"
"hdparm" "x86-energy-perf-policy"))
"iw" (filter-map sbin-directory
"pciutils" '("ethtool"
"rfkill" "hdparm"
"wireless-tools")))))) "iw"
"pciutils"
"rfkill"
"wireless-tools"))))))
bin-files) bin-files)
#t)))))) #t))))))
(home-page "http://linrunner.de/en/tlp/tlp.html") (home-page "http://linrunner.de/en/tlp/tlp.html")

48
gnu/packages/lisp.scm
View File

@ -14,6 +14,7 @@
;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2019 Katherine Cox-Buday <cox.katherine.e@gmail.com> ;;; Copyright © 2019 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com> ;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -45,8 +46,10 @@
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bdw-gc) #:use-module (gnu packages bdw-gc)
#:use-module (gnu packages bison)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages ed) #:use-module (gnu packages ed)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
@ -5321,3 +5324,48 @@ port within a range.")
(define-public ecl-find-port (define-public ecl-find-port
(sbcl-package->ecl-package sbcl-find-port)) (sbcl-package->ecl-package sbcl-find-port))
(define-public txr
(package
(name "txr")
(version "216")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.kylheku.com/cgit/txr/snapshot/txr-"
version
".tar.bz2"))
(patches (search-patches "txr-shell.patch"))
(sha256
(base32
"07cxdpc9zsqd0c2668g00dqjpd6zc4mfdn74aarr6d2hpzdhh937"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("cc=gcc")
#:phases (modify-phases %standard-phases
(add-after 'configure 'fix-tests
(lambda _
(substitute* "tests/017/realpath.tl"
(("/usr/bin") "/"))
(substitute* "tests/017/realpath.expected"
(("/usr/bin") "/"))
#t))
(replace 'check
(lambda _
(zero? (system* "make" "tests")))))))
(native-inputs
`(("bison" ,bison)
("flex" ,flex)))
(inputs
`(("libffi" ,libffi)))
(synopsis "General-purpose, multi-paradigm programming language")
(description
"TXR is a general-purpose, multi-paradigm programming language. It
comprises two languages integrated into a single tool: a text scanning and
extraction language referred to as the TXR Pattern Language (sometimes just
\"TXR\"), and a general-purpose dialect of Lisp called TXR Lisp. TXR can be
used for everything from \"one liner\" data transformation tasks at the
command line, to data scanning and extracting scripts, to full application
development in a wide-range of areas.")
(home-page "https://nongnu.org/txr/")
(license license:bsd-2)))

14
gnu/packages/machine-learning.scm
View File

@ -573,16 +573,16 @@ in terms of new algorithms.")
(define-public rxcpp (define-public rxcpp
(package (package
(name "rxcpp") (name "rxcpp")
(version "4.0.0") (version "4.1.0")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://github.com/ReactiveX/RxCpp/archive/v" (uri (git-reference
version ".tar.gz")) (url "https://github.com/ReactiveX/RxCpp.git")
(commit (string-append "v" version))))
(sha256 (sha256
(base32 (base32 "1rdpa3jlc181jd08nk437aar085h28i45s6nzrv65apb3xyyz0ij"))
"0y2isr8dy2n1yjr9c5570kpc9lvdlch6jv0jvw000amwn5d3krsh")) (file-name (git-file-name name version))))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:phases `(#:phases

165
gnu/packages/mate.scm
View File

@ -79,8 +79,7 @@
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -136,14 +135,14 @@ actions.")
(package (package
(name "mate-icon-theme") (name "mate-icon-theme")
(version "1.22.0") (version "1.22.0")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/" (method url-fetch)
(version-major+minor version) "/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"090vfxpn1b1wwvkilv1j3cx4swdm4z0s7xyvhvqhdzj58zsf2000")))) "090vfxpn1b1wwvkilv1j3cx4swdm4z0s7xyvhvqhdzj58zsf2000"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
@ -159,14 +158,14 @@ actions.")
(package (package
(name "mate-icon-theme-faenza") (name "mate-icon-theme-faenza")
(version "1.20.0") (version "1.20.0")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/" (method url-fetch)
(version-major+minor version) "/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"000vr9cnbl2qlysf2gyg1lsjirqdzmwrnh6d3hyrsfc0r2vh4wna")))) "000vr9cnbl2qlysf2gyg1lsjirqdzmwrnh6d3hyrsfc0r2vh4wna"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -197,11 +196,11 @@ from Mint-X-F and Faenza-Fresh icon packs.")
(package (package
(name "mate-themes") (name "mate-themes")
(version "3.22.19") (version "3.22.19")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/themes/" (method url-fetch)
(version-major+minor version) "/mate-themes-" (uri (string-append "mirror://mate/themes/" (version-major+minor version)
version ".tar.xz")) "/mate-themes-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1ycb8b8r0s8d1h1477135mynr53s5781gdb2ap8xlvj2g58492wq")))) "1ycb8b8r0s8d1h1477135mynr53s5781gdb2ap8xlvj2g58492wq"))))
@ -225,14 +224,14 @@ themes for both gtk+-2 and gtk+-3.")
(package (package
(name "mate-desktop") (name "mate-desktop")
(version "1.22.0") (version "1.22.0")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/" (method url-fetch)
(version-major+minor version) "/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"09gn840p6qds21kxab4pidjd53g76s76i7178fdibrz462mda217")))) "09gn840p6qds21kxab4pidjd53g76s76i7178fdibrz462mda217"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
@ -259,14 +258,14 @@ desktop and the mate-about program.")
(package (package
(name "libmateweather") (name "libmateweather")
(version "1.22.0") (version "1.22.0")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/" (method url-fetch)
(version-major+minor version) "/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1ribgcwl4ncfbcf9bkcbxrgc7yzajdnxg12837psngymkqswlp6a")))) "1ribgcwl4ncfbcf9bkcbxrgc7yzajdnxg12837psngymkqswlp6a"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags
@ -308,8 +307,7 @@ the MATE desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -349,8 +347,7 @@ configurations (profiles).")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -417,8 +414,7 @@ configuration program to choose applications starting on login.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -460,8 +456,7 @@ configuration program to choose applications starting on login.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -490,8 +485,7 @@ sound systems.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -519,14 +513,14 @@ MATE desktop environment.")
(package (package
(name "mate-menus") (name "mate-menus")
(version "1.22.0") (version "1.22.0")
(source (origin (source
(method url-fetch) (origin
(uri (string-append "https://pub.mate-desktop.org/releases/" (method url-fetch)
(version-major+minor version) "/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1lkakbf2f1815c146z4xp5f0h4lim6jzr02681wbvzalc6k97v5c")))) "1lkakbf2f1815c146z4xp5f0h4lim6jzr02681wbvzalc6k97v5c"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -563,8 +557,7 @@ assorted menu related utility programs.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -637,8 +630,7 @@ Interactive Weather Information Network (IWIN).
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -674,8 +666,7 @@ mate-volume-control, a MATE volume control application and applet.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -748,8 +739,7 @@ infamous 'Wanda the Fish'.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -852,8 +842,7 @@ infamous 'Wanda the Fish'.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -911,8 +900,7 @@ icons on the MATE desktop. It works on local and remote file systems.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -966,8 +954,7 @@ icons on the MATE desktop. It works on local and remote file systems.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1026,8 +1013,7 @@ of various aspects of your desktop.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1077,8 +1063,7 @@ for use with MATE or as a standalone window manager.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1117,8 +1102,7 @@ sessions, panels, menus, file management, and preferences.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1149,8 +1133,7 @@ sessions, panels, menus, file management, and preferences.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1172,8 +1155,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1214,8 +1196,7 @@ Re-decorates windows on un-maximise.
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1286,8 +1267,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1339,8 +1319,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1390,8 +1369,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1444,8 +1422,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1495,8 +1472,7 @@ can be used as backgrounds in the MATE Desktop environment.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1536,8 +1512,7 @@ MATE Desktop to monitor your system resources and usage.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://pub.mate-desktop.org/releases/" (uri (string-append "mirror://mate/" (version-major+minor version) "/"
(version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32

23
gnu/packages/maths.scm
View File

@ -1692,7 +1692,7 @@ September 2004}")
(define-public petsc (define-public petsc
(package (package
(name "petsc") (name "petsc")
(version "3.10.4") (version "3.11.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1700,7 +1700,7 @@ September 2004}")
(uri (string-append "http://ftp.mcs.anl.gov/pub/petsc/release-snapshots/" (uri (string-append "http://ftp.mcs.anl.gov/pub/petsc/release-snapshots/"
"petsc-lite-" version ".tar.gz")) "petsc-lite-" version ".tar.gz"))
(sha256 (sha256
(base32 "0fk16944zh3473ra198kdkxdn08rq7b6ap838hxy1mh1i0hb488r")))) (base32 "1645nwwcp9bcnfnxikk480mhbbacdvhsay2c401818hk97dqj5nx"))))
(outputs '("out" ; libraries and headers (outputs '("out" ; libraries and headers
"examples")) ; ~30MiB of examples "examples")) ; ~30MiB of examples
(build-system gnu-build-system) (build-system gnu-build-system)
@ -1845,7 +1845,11 @@ scientific applications modeled by partial differential equations.")
``("--with-mpiexec=mpirun" ``("--with-mpiexec=mpirun"
,(string-append "--with-mpi-dir=" ,(string-append "--with-mpi-dir="
(assoc-ref %build-inputs "openmpi")) (assoc-ref %build-inputs "openmpi"))
,@(delete "--with-mpi=0" ,cf))))) ,@(delete "--with-mpi=0" ,cf)))
((#:phases phases)
`(modify-phases ,phases
(add-before 'configure 'mpi-setup
,%openmpi-setup)))))
(synopsis "Library to solve PDEs (with complex scalars and MPI support)"))) (synopsis "Library to solve PDEs (with complex scalars and MPI support)")))
(define-public python-petsc4py (define-public python-petsc4py
@ -1910,7 +1914,7 @@ savings are consistently > 5x.")
(define-public slepc (define-public slepc
(package (package
(name "slepc") (name "slepc")
(version "3.10.1") (version "3.11.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1918,10 +1922,11 @@ savings are consistently > 5x.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"188j1a133q91h8pivpnzwcf78kz8dvz2nzf6ndnjygdbqb48fizn")))) "1yq84q9wannc8xwapxpay4ypdd675picwi395hhsdvng9q6hf5j8"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("python" ,python-2))) `(("python" ,python-2)
("petsc:examples" ,petsc "examples"))) ;for gmakegen.py script
(inputs (inputs
`(("arpack" ,arpack-ng) `(("arpack" ,arpack-ng)
("gfortran" ,gfortran))) ("gfortran" ,gfortran)))
@ -1933,7 +1938,10 @@ savings are consistently > 5x.")
`(,(string-append "--with-arpack-dir=" `(,(string-append "--with-arpack-dir="
(assoc-ref %build-inputs "arpack") "/lib")) (assoc-ref %build-inputs "arpack") "/lib"))
#:make-flags ;honor (parallel-job-count) #:make-flags ;honor (parallel-job-count)
`(,(format #f "MAKE_NP=~a" (parallel-job-count))) `(,(format #f "MAKE_NP=~a" (parallel-job-count))
,(string-append "PETSCCONFIGDIR="
(assoc-ref %build-inputs "petsc:examples")
"/share/petsc/examples/config"))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(replace 'configure (replace 'configure
@ -3553,6 +3561,7 @@ in finite element programs.")
(inputs (inputs
`(("mpi" ,openmpi) `(("mpi" ,openmpi)
;;Supported only with MPI: ;;Supported only with MPI:
("hdf5" ,hdf5-parallel-openmpi) ;TODO: have petsc-openmpi propagate?
("p4est" ,p4est-openmpi) ("p4est" ,p4est-openmpi)
("petsc" ,petsc-openmpi) ("petsc" ,petsc-openmpi)
("slepc" ,slepc-openmpi) ("slepc" ,slepc-openmpi)

12
gnu/packages/messaging.scm
View File

@ -371,15 +371,14 @@ authentication.")
(define-public pidgin (define-public pidgin
(package (package
(name "pidgin") (name "pidgin")
(version "2.12.0") (version "2.13.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/pidgin/Pidgin/" (uri (string-append "mirror://sourceforge/pidgin/Pidgin/"
version "/" name "-" version ".tar.bz2")) version "/pidgin-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32 "13vdqj70315p9rzgnbxjp9c51mdzf1l4jg1kvnylc4bidw61air7"))
"1y5p2mq3bfw35b66jsafmbva0w5gg1k99y9z8fyp3jfksqv3agcc"))
(patches (search-patches "pidgin-add-search-path.patch")))) (patches (search-patches "pidgin-add-search-path.patch"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(native-inputs (native-inputs
@ -403,13 +402,13 @@ authentication.")
;; TODO: gstreamer: patches needed to support gstreamer-1.0 or later ;; TODO: gstreamer: patches needed to support gstreamer-1.0 or later
;; TODO: farstream ;; TODO: farstream
;; TODO: meanwhile ;; TODO: meanwhile
;; TODO: network-manager
;; TODO: gtkspell ;; TODO: gtkspell
;; TODO: libxephyr ;; TODO: libxephyr
;; TODO: libgadu ;; TODO: libgadu
("libxslt" ,libxslt) ("libxslt" ,libxslt)
("avahi" ,avahi) ("avahi" ,avahi)
("ncurses" ,ncurses) ("ncurses" ,ncurses)
("network-manager" ,network-manager)
("sqlite" ,sqlite) ("sqlite" ,sqlite)
("libice" ,libice) ("libice" ,libice)
("libsm" ,libsm) ("libsm" ,libsm)
@ -420,7 +419,6 @@ authentication.")
(list "--disable-gtkspell" (list "--disable-gtkspell"
"--disable-tcl" "--disable-tcl"
"--disable-meanwhile" "--disable-meanwhile"
"--disable-nm" ; XXX remove when we have network-manager
"--disable-vv" ; XXX remove when we have farstream and gstreamer "--disable-vv" ; XXX remove when we have farstream and gstreamer
"--disable-gstreamer" ; XXX patches needed to support gstreamer-1.0 "--disable-gstreamer" ; XXX patches needed to support gstreamer-1.0
"--enable-cyrus-sasl" "--enable-cyrus-sasl"
@ -433,7 +431,7 @@ authentication.")
(files (list (string-append "lib/purple-" (files (list (string-append "lib/purple-"
(version-major version)) (version-major version))
"lib/pidgin"))))) "lib/pidgin")))))
(home-page "http://www.pidgin.im/") (home-page "https://www.pidgin.im/")
(synopsis "Graphical multi-protocol instant messaging client") (synopsis "Graphical multi-protocol instant messaging client")
(description (description
"Pidgin is a modular instant messaging client that supports many popular "Pidgin is a modular instant messaging client that supports many popular

4
gnu/packages/music.scm
View File

@ -3727,7 +3727,7 @@ audio samples and various soft sythesizers. It can receive input from a MIDI ke
(define-public musescore (define-public musescore
(package (package
(name "musescore") (name "musescore")
(version "3.0.5") (version "3.1")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -3736,7 +3736,7 @@ audio samples and various soft sythesizers. It can receive input from a MIDI ke
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1inf6zdyh6yspjv1i7g6rw9wn90vki1s2qgilkp0j4aphayj4mic")) "07xkn8gnnqzhj9cn1li5qpm2rfm86bmxbbfd76i1jx4v999icn0j"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Un-bundle OpenSSL and remove unused libraries. ;; Un-bundle OpenSSL and remove unused libraries.

48
gnu/packages/node.scm
View File

@ -5,7 +5,7 @@
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org> ;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -45,14 +45,14 @@
(define-public node (define-public node
(package (package
(name "node") (name "node")
(version "9.11.1") (version "10.15.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://nodejs.org/dist/v" version (uri (string-append "https://nodejs.org/dist/v" version
"/node-v" version ".tar.gz")) "/node-v" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1vjh9zvw7wkdz6b0l99ya7mqjk0l8lbg9isr1q8rxwp400dhkk32")) "1mcijznh481s44i59p571a38bfvcxm9f8x2l0l1005aly0kdj8jf"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
`(begin `(begin
@ -83,18 +83,14 @@
"--shared-zlib" "--shared-zlib"
"--without-snapshot" "--without-snapshot"
"--with-intl=system-icu") "--with-intl=system-icu")
;; Run only the CI tests. The default test target requires additional
;; add-ons from NPM that are not distributed with the source.
#:test-target "test-ci-js"
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'configure 'patch-files (add-before 'configure 'patch-files
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
;; This phase is inherited by Node LTS, which does not have all
;; the files listed here. Use this helper for convenience.
(define (delete-if-exists file)
(if (file-exists? file)
(delete-file file)
'()))
;; Fix hardcoded /bin/sh references. ;; Fix hardcoded /bin/sh references.
(substitute* '("lib/child_process.js" (substitute* '("lib/child_process.js"
"lib/internal/v8_prof_polyfill.js" "lib/internal/v8_prof_polyfill.js"
@ -110,17 +106,9 @@
(("'/usr/bin/env'") (("'/usr/bin/env'")
(string-append "'" (which "env") "'"))) (string-append "'" (which "env") "'")))
;; FIXME: These tests depend on being able to install eslint.
;; See https://github.com/nodejs/node/issues/17098.
(for-each delete-if-exists
'("test/parallel/test-eslint-alphabetize-errors.js"
"test/parallel/test-eslint-buffer-constructor.js"
"test/parallel/test-eslint-documented-errors.js"
"test/parallel/test-eslint-inspector-check.js"))
;; FIXME: These tests fail in the build container, but they don't ;; FIXME: These tests fail in the build container, but they don't
;; seem to be indicative of real problems in practice. ;; seem to be indicative of real problems in practice.
(for-each delete-if-exists (for-each delete-file
'("test/async-hooks/test-ttywrap.readstream.js" '("test/async-hooks/test-ttywrap.readstream.js"
"test/parallel/test-util-inspect.js" "test/parallel/test-util-inspect.js"
"test/parallel/test-v8-serdes.js" "test/parallel/test-v8-serdes.js"
@ -132,14 +120,13 @@
"test/parallel/test-net-listen-after-destroying-stdin.js" "test/parallel/test-net-listen-after-destroying-stdin.js"
"test/parallel/test-npm-install.js" "test/parallel/test-npm-install.js"
"test/sequential/test-child-process-emfile.js" "test/sequential/test-child-process-emfile.js"
"test/sequential/test-benchmark-child-process.js"
"test/sequential/test-http-regr-gh-2928.js")) "test/sequential/test-http-regr-gh-2928.js"))
;; These tests have an expiry date: they depend on the validity of ;; These tests have an expiry date: they depend on the validity of
;; TLS certificates that are bundled with the source. We want this ;; TLS certificates that are bundled with the source. We want this
;; package to be reproducible forever, so remove those. ;; package to be reproducible forever, so remove those.
;; TODO: Regenerate certs instead. ;; TODO: Regenerate certs instead.
(for-each delete-if-exists (for-each delete-file
'("test/parallel/test-tls-passphrase.js" '("test/parallel/test-tls-passphrase.js"
"test/parallel/test-tls-server-verify.js")) "test/parallel/test-tls-server-verify.js"))
#t)) #t))
@ -184,9 +171,9 @@
`(("c-ares" ,c-ares) `(("c-ares" ,c-ares)
("http-parser" ,http-parser) ("http-parser" ,http-parser)
("icu4c" ,icu4c) ("icu4c" ,icu4c)
("libuv" ,libuv-1.19) ("libuv" ,libuv)
("nghttp2" ,nghttp2 "lib") ("nghttp2" ,nghttp2 "lib")
("openssl" ,openssl) ("openssl" ,openssl-next)
("zlib" ,zlib))) ("zlib" ,zlib)))
(synopsis "Evented I/O for V8 JavaScript") (synopsis "Evented I/O for V8 JavaScript")
(description "Node.js is a platform built on Chrome's JavaScript runtime (description "Node.js is a platform built on Chrome's JavaScript runtime
@ -197,16 +184,3 @@ devices.")
(home-page "https://nodejs.org/") (home-page "https://nodejs.org/")
(license expat) (license expat)
(properties '((timeout . 3600))))) ; 1 h (properties '((timeout . 3600))))) ; 1 h
(define-public node-lts
(package
(inherit node)
(name "node-lts")
(version "8.12.0")
(source (origin
(inherit (package-source node))
(uri (string-append "https://nodejs.org/dist/v" version
"/node-v" version ".tar.xz"))
(sha256
(base32
"16j1rrxkhmvpcw689ndw1raql1gz4jqn7n82z55zn63c05cgz7as"))))))

30
gnu/packages/package-management.scm
View File

@ -111,8 +111,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to ;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this. ;; start precisely like this.
(let ((version "1.0.1") (let ((version "1.0.1")
(commit "820429517f9cc8333704a839b4346ac4b02468c4") (commit "4a54ed774913480c0f8dad3caf0cd627e4fa8ebf")
(revision 1)) (revision 3))
(package (package
(name "guix") (name "guix")
@ -128,7 +128,7 @@
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"1vfp7ps1k1cwn8p0gsgarlxcy982hzyvb7zqnj66jqd258a1qfgh")) "14m4a4bn0d5hav6mrks5d7r223knx9dpswgbsc875wgr2921na2h"))
(file-name (string-append "guix-" version "-checkout")))) (file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
@ -272,6 +272,7 @@
`(("bzip2" ,bzip2) `(("bzip2" ,bzip2)
("gzip" ,gzip) ("gzip" ,gzip)
("zlib" ,zlib) ;for 'guix publish' ("zlib" ,zlib) ;for 'guix publish'
("lzlib" ,lzlib) ;for 'guix publish' and 'guix substitute'
("sqlite" ,sqlite) ("sqlite" ,sqlite)
("libgcrypt" ,libgcrypt) ("libgcrypt" ,libgcrypt)
@ -547,13 +548,16 @@ transactions from C or Python.")
(define-public diffoscope (define-public diffoscope
(package (package
(name "diffoscope") (name "diffoscope")
(version "114") (version (git-version "115" "1" "7f3416ffd12572b42c814e43ac15cee44ef48155"))
(source (origin (source (origin
(method url-fetch) (method git-fetch)
(uri (pypi-uri name version)) (uri (git-reference
(url "https://salsa.debian.org/reproducible-builds/diffoscope.git")
(commit "7f3416ffd12572b42c814e43ac15cee44ef48155")))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"07sma4izcqxdv0zi1s5fnsybvkc47c3vbpm372sg83q8l7rhizzp")))) "1pn2rwlz5shdx7s63798wx2v7029bl5if6dlq3i2r6zsnpp0laki"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:phases (modify-phases %standard-phases `(#:phases (modify-phases %standard-phases
@ -589,7 +593,8 @@ transactions from C or Python.")
#t)) #t))
(add-before 'check 'delete-failing-test (add-before 'check 'delete-failing-test
(lambda _ (lambda _
(delete-file "tests/test_tools.py") ;this requires /sbin to be on the path ;; this requires /sbin to be on the path
(delete-file "tests/test_tools.py")
#t))))) #t)))))
(inputs `(("rpm" ,rpm) ;for rpm-python (inputs `(("rpm" ,rpm) ;for rpm-python
("python-file" ,python-file) ("python-file" ,python-file)
@ -598,11 +603,10 @@ transactions from C or Python.")
("python-tlsh" ,python-tlsh) ("python-tlsh" ,python-tlsh)
("acl" ,acl) ;for getfacl ("acl" ,acl) ;for getfacl
("colordiff" ,colordiff) ("colordiff" ,colordiff)
("xxd" ,xxd) ("xxd" ,xxd)))
;; Below are modules used for tests.
;; Below are modules used for tests. (native-inputs `(("python-pytest" ,python-pytest)
("python-pytest" ,python-pytest) ("python-chardet" ,python-chardet)))
("python-chardet" ,python-chardet)))
(home-page "https://diffoscope.org/") (home-page "https://diffoscope.org/")
(synopsis "Compare files, archives, and directories in depth") (synopsis "Compare files, archives, and directories in depth")
(description (description

4
gnu/packages/password-utils.scm
View File

@ -108,7 +108,7 @@ human.")
(define-public keepassxc (define-public keepassxc
(package (package
(name "keepassxc") (name "keepassxc")
(version "2.4.1") (version "2.4.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -117,7 +117,7 @@ human.")
version "-src.tar.xz")) version "-src.tar.xz"))
(sha256 (sha256
(base32 (base32
"1aw9airx9z846p0xc0qjgy5hg35b8cxp57rvlq39n6wx4z8ppa8d")))) "0f31lmpbkw0wrhq0qa4yw5b51bjv7vqp3ikr355qcm905456vyhm"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:configure-flags '("-DWITH_XC_NETWORKING=YES" '(#:configure-flags '("-DWITH_XC_NETWORKING=YES"

54
gnu/packages/patches/gnucash-fix-test-transaction-failure.patch
View File

@ -1,54 +0,0 @@
# This patch was submitted upstream to: https://bugs.gnucash.org/show_bug.cgi?id=797008.
From c20d74bebca516d0e391724202aad511967fe109 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Wed, 2 Jan 2019 14:46:28 -0500
Subject: [PATCH] tests: Fix a test failure in test-transaction.scm.
With the New Year upon us, a test which was hard-coded to use 2018 now
failed.
Fixes issue #797008 (see:
https://bugs.gnucash.org/show_bug.cgi?id=797008).
* gnucash/report/standard-reports/test/test-transaction.scm:
(trep-tests): Use the current year in the test string instead of a
static one.
---
gnucash/report/standard-reports/test/test-transaction.scm | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 755aba298..ae3fbd5c1 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -5,6 +5,7 @@
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-19))
(use-modules (srfi srfi-64))
(use-modules (gnucash engine test srfi64-extras))
(use-modules (sxml simple))
@@ -643,7 +644,8 @@
(set-option! options "General" "Show original currency amount" #t)
(set-option! options "Sorting" "Primary Key" 'date)
(set-option! options "Sorting" "Primary Subtotal for Date Key" 'none)
- (let* ((sxml (options->sxml options "dual columns")))
+ (let* ((sxml (options->sxml options "dual columns"))
+ (current-year (date->string (current-date) "~y")))
(test-equal "dual amount column, with original currency headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account"
"Debit (USD)" "Credit (USD)" "Debit" "Credit")
@@ -652,7 +654,8 @@
(list "Grand Total" "$2,280.00" "$2,280.00")
(get-row-col sxml -1 #f))
(test-equal "dual amount column, first transaction correct"
- (list "01/03/18" "$103 income" "Root.Asset.Bank" "$103.00" "$103.00")
+ (list (string-append "01/03/" current-year) "$103 income"
+ "Root.Asset.Bank" "$103.00" "$103.00")
(get-row-col sxml 1 #f)))
)
--
2.19.0

33
gnu/packages/patches/gtksourceview-2-add-default-directory.patch 100644
View File

@ -0,0 +1,33 @@
From fc401acb15f15d487c942437b6fb429289dd3c67 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Fri, 31 May 2019 13:22:25 +0200
Subject: [PATCH] Add installation directory as a default directory.
In Guix, this library is installed in a separate directory in the store,
and it's typically not installed system-wide in a fixed directory. Add
the store path to the set of default directories so dependents can find
default langs and source highlighting scheme.
---
gtksourceview/gtksourceview-utils.c | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/gtksourceview/gtksourceview-utils.c b/gtksourceview/gtksourceview-utils.c
index 6f06bab..c3467d5 100644
--- a/gtksourceview/gtksourceview-utils.c
+++ b/gtksourceview/gtksourceview-utils.c
@@ -66,6 +66,12 @@ _gtk_source_view_get_default_dirs (const char *basename,
basename,
NULL));
+ /* installed dir */
+ g_ptr_array_add (dirs, g_build_filename (DATADIR,
+ SOURCEVIEW_DIR,
+ basename,
+ NULL));
+
g_ptr_array_add (dirs, NULL);
return (gchar**) g_ptr_array_free (dirs, FALSE);
--
2.21.0

26
gnu/packages/patches/libevent-2.1-dns-tests.patch
View File

@ -1,26 +0,0 @@
Disable tests that rely on usable DNS lookups, which aren't available
in build chroots.
--- libevent-2.0.21-stable/test/regress_dns.c 2013-01-20 22:32:09.000000000 +0100
+++ libevent-2.0.21-stable/test/regress_dns.c 2013-01-20 22:32:30.000000000 +0100
@@ -2120,10 +2120,6 @@
struct testcase_t dns_testcases[] = {
DNS_LEGACY(server, TT_FORK|TT_NEED_BASE),
- DNS_LEGACY(gethostbyname, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT),
- DNS_LEGACY(gethostbyname6, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT),
- DNS_LEGACY(gethostbyaddr, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT),
- { "resolve_reverse", dns_resolve_reverse, TT_FORK|TT_OFF_BY_DEFAULT, NULL, NULL },
{ "search_empty", dns_search_empty_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL },
{ "search", dns_search_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL },
{ "search_lower", dns_search_lower_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL },
@@ -2163,9 +2159,6 @@
{ "client_fail_requests", dns_client_fail_requests_test,
TT_FORK|TT_NEED_BASE, &basic_setup, NULL },
- { "client_fail_requests_getaddrinfo",
- dns_client_fail_requests_getaddrinfo_test,
- TT_FORK|TT_NEED_BASE, &basic_setup, NULL },
END_OF_TESTCASES
};

24
gnu/packages/patches/libevent-2.1-skip-failing-test.patch
View File

@ -1,24 +0,0 @@
These fail on 32-bit due to an overflow bug in the test program.
See test/regress_util.c:1448.
Upstream bug URL:
https://github.com/libevent/libevent/issues/452
diff --git a/test/regress_util.c b/test/regress_util.c
index ef6a1487..4de501fc 100644
--- a/test/regress_util.c
+++ b/test/regress_util.c
@@ -1413,9 +1413,9 @@ static struct date_rfc1123_case {
{ 1323648000, "Mon, 12 Dec 2011 00:00:00 GMT"},
#ifndef _WIN32
/** In win32 case we have max "23:59:59 January 18, 2038, UTC" for time32 */
- { 4294967296, "Sun, 07 Feb 2106 06:28:16 GMT"} /* 2^32 */,
+ //{ 4294967296, "Sun, 07 Feb 2106 06:28:16 GMT"} /* 2^32 */,
/** In win32 case we have max "23:59:59, December 31, 3000, UTC" for time64 */
- {253402300799, "Fri, 31 Dec 9999 23:59:59 GMT"} /* long long future no one can imagine */,
+ //{253402300799, "Fri, 31 Dec 9999 23:59:59 GMT"} /* long long future no one can imagine */,
{ 1456704000, "Mon, 29 Feb 2016 00:00:00 GMT"} /* leap year */,
#endif
{ 1435708800, "Wed, 01 Jul 2015 00:00:00 GMT"} /* leap second */,

75
gnu/packages/patches/supertux-fix-build-with-gcc5.patch 100644
View File

@ -0,0 +1,75 @@
Taken from https://github.com/SuperTux/supertux/commit/a75317ef0a94847d9b6a7833b9c6652ef29edde3.
This patch fixes building with gcc versions earlier than 6.
From a75317ef0a94847d9b6a7833b9c6652ef29edde3 Mon Sep 17 00:00:00 2001
From: Ingo Ruhnke <grumbel@gmail.com>
Date: Fri, 28 Dec 2018 22:45:35 +0100
Subject: [PATCH] Add workaround for backwards compatibilty with gcc5
Fixes #1014
---
src/video/gl/gl_painter.cpp | 11 ++++++-----
src/video/ttf_surface.cpp | 16 +++++++++-------
2 files changed, 15 insertions(+), 12 deletions(-)
diff --git a/src/video/gl/gl_painter.cpp b/src/video/gl/gl_painter.cpp
index 5e0d1e7b1e..32fb7a09b6 100644
--- a/src/video/gl/gl_painter.cpp
+++ b/src/video/gl/gl_painter.cpp
@@ -37,12 +37,13 @@ namespace {
inline std::tuple<GLenum, GLenum> blend_factor(Blend blend)
{
+ using B = std::tuple<GLenum, GLenum>;
switch(blend) {
- case Blend::NONE: return {GL_ONE, GL_ZERO};
- case Blend::BLEND: return {GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA};
- case Blend::ADD: return {GL_SRC_ALPHA, GL_ONE};
- case Blend::MOD: return {GL_DST_COLOR, GL_ZERO};
- default: return {GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA};
+ case Blend::NONE: return B(GL_ONE, GL_ZERO);
+ case Blend::BLEND: return B(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ case Blend::ADD: return B(GL_SRC_ALPHA, GL_ONE);
+ case Blend::MOD: return B(GL_DST_COLOR, GL_ZERO);
+ default: return B(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
}
}
diff --git a/src/video/ttf_surface.cpp b/src/video/ttf_surface.cpp
index 7c9505004f..b41d67b2c8 100644
--- a/src/video/ttf_surface.cpp
+++ b/src/video/ttf_surface.cpp
@@ -55,12 +55,13 @@ TTFSurface::create(const TTFFont& font, const std::string& text)
SDL_SetSurfaceColorMod(text_surface.get(), 0, 0, 0);
SDL_SetSurfaceBlendMode(text_surface.get(), SDL_BLENDMODE_BLEND);
+ using P = std::tuple<int, int>;
const std::initializer_list<std::tuple<int, int> > positions[] = {
{},
- {{0, 0}},
- {{-1, 0}, {1, 0}, {0, -1}, {0, 1}},
- {{-2, 0}, {2, 0}, {0, -2}, {0, 2},
- {-1, -1}, {1, -1}, {-1, 1}, {1, 1}}
+ {P{0, 0}},
+ {P{-1, 0}, P{1, 0}, P{0, -1}, P{0, 1}},
+ {P{-2, 0}, P{2, 0}, P{0, -2}, P{0, 2},
+ P{-1, -1}, P{1, -1}, P{-1, 1}, P{1, 1}}
};
int shadow_size = std::min(2, font.get_shadow_size());
@@ -77,11 +78,12 @@ TTFSurface::create(const TTFFont& font, const std::string& text)
SDL_SetSurfaceColorMod(text_surface.get(), 0, 0, 0);
SDL_SetSurfaceBlendMode(text_surface.get(), SDL_BLENDMODE_BLEND);
+ using P = std::tuple<int, int>;
const std::initializer_list<std::tuple<int, int> > positions[] = {
{},
- {{-1, 0}, {1, 0}, {0, -1}, {0, 1}},
- {{-2, 0}, {2, 0}, {0, -2}, {0, 2},
- {-1, -1}, {1, -1}, {-1, 1}, {1, 1}}
+ {P{-1, 0}, P{1, 0}, P{0, -1}, P{0, 1}},
+ {P{-2, 0}, P{2, 0}, P{0, -2}, P{0, 2},
+ P{-1, -1}, P{1, -1}, P{-1, 1}, P{1, 1}}
};
int border = std::min(2, font.get_border());

53
gnu/packages/patches/supertux-unbundle-squirrel.patch 100644
View File

@ -0,0 +1,53 @@
diff -ur a/CMakeLists.txt b/CMakeLists.txt
--- a/CMakeLists.txt 2019-05-24 17:58:19.693090158 -0400
+++ b/CMakeLists.txt 2019-05-24 17:57:43.349473252 -0400
@@ -375,44 +375,15 @@
include(ConfigureChecks)
-
-## Also build external/squirrel
-
-if(NOT EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/external/squirrel/CMakeLists.txt)
- message(FATAL_ERROR "squirrel submodule is not checked out or ${CMAKE_CURRENT_SOURCE_DIR}/external/squirrel/CMakeLists.txt is missing")
-endif()
-
set(SQUIRREL_PREFIX ${CMAKE_BINARY_DIR}/squirrel/ex)
-ExternalProject_Add(squirrel
- SOURCE_DIR "${CMAKE_SOURCE_DIR}/external/squirrel/"
- CMAKE_ARGS
- -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE}
- -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
- -DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
- -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER}
- -DCMAKE_CXX_FLAGS=${CMAKE_CXX_FLAGS}
- -DCMAKE_INSTALL_PREFIX=${SQUIRREL_PREFIX}
- -DINSTALL_INC_DIR=include)
-
-if(WIN32)
- add_library(squirrel_lib SHARED IMPORTED)
- set_target_properties(squirrel_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/bin/${CMAKE_SHARED_LIBRARY_PREFIX}squirrel${CMAKE_SHARED_LIBRARY_SUFFIX}")
- set_target_properties(squirrel_lib PROPERTIES IMPORTED_IMPLIB "${SQUIRREL_PREFIX}/lib/squirrel${CMAKE_LINK_LIBRARY_SUFFIX}")
- add_library(sqstdlib_lib SHARED IMPORTED)
- set_target_properties(sqstdlib_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/bin/${CMAKE_SHARED_LIBRARY_PREFIX}sqstdlib${CMAKE_SHARED_LIBRARY_SUFFIX}")
- set_target_properties(sqstdlib_lib PROPERTIES IMPORTED_IMPLIB "${SQUIRREL_PREFIX}/lib/sqstdlib${CMAKE_LINK_LIBRARY_SUFFIX}")
-
- #For debug run purposes
- configure_file("${CMAKE_CURRENT_SOURCE_DIR}/mk/msvc/run_supertux.bat.in" "${PROJECT_BINARY_DIR}/run_supertux.bat")
-else()
- add_library(squirrel_lib STATIC IMPORTED)
- set_target_properties(squirrel_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/lib/${CMAKE_STATIC_LIBRARY_PREFIX}squirrel_static${CMAKE_STATIC_LIBRARY_SUFFIX}")
- add_library(sqstdlib_lib STATIC IMPORTED)
- set_target_properties(sqstdlib_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/lib/${CMAKE_STATIC_LIBRARY_PREFIX}sqstdlib_static${CMAKE_STATIC_LIBRARY_SUFFIX}")
-endif()
include_directories(SYSTEM ${SQUIRREL_PREFIX}/include)
+add_library(squirrel_lib SHARED IMPORTED)
+set_target_properties(squirrel_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/lib/${CMAKE_SHARED_LIBRARY_PREFIX}squirrel${CMAKE_SHARED_LIBRARY_SUFFIX}")
+add_library(sqstdlib_lib SHARED IMPORTED)
+set_target_properties(sqstdlib_lib PROPERTIES IMPORTED_LOCATION "${SQUIRREL_PREFIX}/lib/${CMAKE_SHARED_LIBRARY_PREFIX}sqstdlib${CMAKE_SHARED_LIBRARY_SUFFIX}")
+
## Also build external/tinygettext
if(NOT EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/external/tinygettext/CMakeLists.txt)

59
gnu/packages/patches/txr-shell.patch 100644
View File

@ -0,0 +1,59 @@
Use the current shell instead of trying to find another one and
failing to do so.
diff --git a/configure b/configure
index f1adb919..7891b4dc 100755
--- a/configure
+++ b/configure
@@ -26,28 +26,6 @@
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-# The #!/bin/sh might be some legacy piece of crap,
-# not even up to 1990 POSIX.2 spec. So the first step
-# is to look for a better shell in some known places
-# and re-execute ourselves with that interpreter.
-#
-
-if test x$txr_shell = x ; then
- for shell in /bin/bash /usr/bin/bash /usr/xpg4/bin/sh ; do
- if test -x $shell ; then
- txr_shell=$shell
- break
- fi
- done
- if test x$txr_shell = x ; then
- echo "No known POSIX shell found: falling back on /bin/sh, which may not work"
- txr_shell=/bin/sh
- fi
- export txr_shell
- exec $txr_shell $0 ${@+"$@"}
-fi
-
set -u
#
@@ -190,13 +168,6 @@ while [ $# -gt 0 ] ; do
exit 1
fi
- eval "var_exists=\${$var+y}"
-
- if [ "$var_exists" != y ] ; then
- printf "$0: nonexistent option: '%s'\n" "$1"
- exit 1
- fi
-
eval "$var='$val'"
eval "var_given_exists=\${${var}_given+y}"
@@ -208,6 +179,8 @@ while [ $# -gt 0 ] ; do
shift
done
+txr_shell=$CONFIG_SHELL
+
#
# If --help was given (or --help=<nonempty> or help=<nonempty>) then
# print help and exit. The termination status is failed, to indicate

167
gnu/packages/patchutils.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015, 2018 Leo Famulari <leo@famulari.name> ;;; Copyright © 2015, 2018 Leo Famulari <leo@famulari.name>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -31,6 +32,8 @@
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages databases)
#:use-module (gnu packages django)
#:use-module (gnu packages file) #:use-module (gnu packages file)
#:use-module (gnu packages gawk) #:use-module (gnu packages gawk)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
@ -300,3 +303,167 @@ directories, and has support for many popular version control systems.
Meld helps you review code changes and understand patches. It might even help Meld helps you review code changes and understand patches. It might even help
you to figure out what is going on in that merge you keep avoiding.") you to figure out what is going on in that merge you keep avoiding.")
(license gpl2))) (license gpl2)))
(define-public patchwork
(package
(name "patchwork")
(version "2.1.2")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/getpatchwork/patchwork.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw"))))
(build-system python-build-system)
(arguments
`(;; TODO: Tests require a running database
#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(add-after 'unpack 'replace-wsgi.py
(lambda* (#:key inputs outputs #:allow-other-keys)
(delete-file "patchwork/wsgi.py")
(call-with-output-file "patchwork/wsgi.py"
(lambda (port)
;; Embed the PYTHONPATH containing the dependencies, as well
;; as the python modules in this package in the wsgi.py file,
;; as this will ensure they are available at runtime.
(define pythonpath
(string-append (getenv "PYTHONPATH")
":"
(site-packages inputs outputs)))
(display
(string-append "
import os, sys
sys.path.extend('" pythonpath "'.split(':'))
from django.core.wsgi import get_wsgi_application
# By default, assume that patchwork is running as a Guix service, which
# provides the settings as the 'guix.patchwork.settings' Python module.
#
# When using httpd, it's hard to set environment variables, so rely on the
# default set here.
os.environ['DJANGO_SETTINGS_MODULE'] = os.getenv(
'DJANGO_SETTINGS_MODULE',
'guix.patchwork.settings' # default
)
application = get_wsgi_application()\n") port)))))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(when tests?
(setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
(invoke "python" "-Wonce" "./manage.py" "test" "--noinput"))
#t))
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(out-site-packages (site-packages inputs outputs)))
(for-each (lambda (directory)
(copy-recursively
directory
(string-append out-site-packages directory)))
'(;; Contains the python code
"patchwork"
;; Contains the templates for the generated HTML
"templates"))
(delete-file-recursively
(string-append out-site-packages "patchwork/tests"))
;; Install patchwork related tools
(for-each (lambda (file)
(install-file file (string-append out "/bin")))
(list
(string-append out-site-packages
"patchwork/bin/pwclient")
(string-append out-site-packages
"patchwork/bin/parsemail.sh")
(string-append out-site-packages
"patchwork/bin/parsemail-batch.sh")))
;; Delete the symlink to pwclient, and replace it with the
;; actual file, as this can cause issues when serving the file
;; from a webserver.
(let ((template-pwclient (string-append
out-site-packages
"patchwork/templates/patchwork/pwclient")))
(delete-file template-pwclient)
(copy-file (string-append out-site-packages
"patchwork/bin/pwclient")
template-pwclient))
;; Collect the static assets, this includes JavaScript, CSS and
;; fonts. This is a standard Django process when running a
;; Django application for regular use, and includes assets for
;; dependencies like the admin site from Django.
;;
;; The intent here is that you can serve files from this
;; directory through a webserver, which is recommended when
;; running Django applications.
(let ((static-root
(string-append out "/share/patchwork/htdocs")))
(mkdir-p static-root)
(copy-file "patchwork/settings/production.example.py"
"patchwork/settings/assets.py")
(setenv "DJANGO_SECRET_KEY" "dummyvalue")
(setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
(setenv "STATIC_ROOT" static-root)
(invoke "./manage.py" "collectstatic" "--no-input"))
;; The lib directory includes example configuration files that
;; may be useful when deploying patchwork.
(copy-recursively "lib"
(string-append
out "/share/doc/" ,name "-" ,version)))
#t))
;; The hasher script is used from the post-receive.hook
(add-after 'install 'install-hasher
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(out-site-packages (site-packages inputs outputs))
(out-hasher.py (string-append out-site-packages
"/patchwork/hasher.py")))
(chmod out-hasher.py #o555)
(symlink out-hasher.py (string-append out "/bin/hasher")))
#t))
;; Create a patchwork specific version of Django's command line admin
;; utility.
(add-after 'install 'install-patchwork-admin
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(mkdir-p (string-append out "/bin"))
(call-with-output-file (string-append out "/bin/patchwork-admin")
(lambda (port)
(simple-format port "#!~A
import os, sys
if __name__ == \"__main__\":
from django.core.management import execute_from_command_line
execute_from_command_line(sys.argv)" (which "python"))))
(chmod (string-append out "/bin/patchwork-admin") #o555))
#t)))))
(inputs
`(("python-wrapper" ,python-wrapper)))
(propagated-inputs
`(("python-django" ,python-django)
;; TODO: Make this configurable
("python-psycopg2" ,python-psycopg2)
("python-mysqlclient" ,python-mysqlclient)
("python-django-filter" ,python-django-filter)
("python-djangorestframework" ,python-djangorestframework)
("python-django-debug-toolbar" ,python-django-debug-toolbar)))
(synopsis "Web based patch tracking system")
(description
"Patchwork is a patch tracking system. It takes in emails containing
patches, and displays the patches along with comments and state information.
Users can login allowing them to change the state of patches.")
(home-page "http://jk.ozlabs.org/projects/patchwork/")
(license gpl2+)))

8
gnu/packages/php.scm
View File

@ -58,7 +58,7 @@
(define-public php (define-public php
(package (package
(name "php") (name "php")
(version "7.3.5") (version "7.3.6")
(home-page "https://secure.php.net/") (home-page "https://secure.php.net/")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
@ -66,7 +66,7 @@
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0wi4vd1c3ylsv7cs5b74pkspybb22qwk6fs5r2as3m3glhw1h0g1")) "0r51aiff2abbr3d2swhvja0wm56sjxzqbciabcvvq3m3v9kqkz7y"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(with-directory-excursion "ext" '(with-directory-excursion "ext"
@ -255,6 +255,10 @@
;; but the bug report suggests the issue was in ;; but the bug report suggests the issue was in
;; the bundled gd, not upstream. ;; the bundled gd, not upstream.
"ext/gd/tests/bug77272.phpt" "ext/gd/tests/bug77272.phpt"
;; Expected invalid XBM but got EOF before image was
;; complete. It's a warning in both cases and test
;; result is the same.
"ext/gd/tests/bug77973.phpt"
;; XXX: These iconv tests have the expected outcome, ;; XXX: These iconv tests have the expected outcome,
;; but with different error messages. ;; but with different error messages.

25
gnu/packages/python-web.scm
View File

@ -57,6 +57,7 @@
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (gnu packages django) #:use-module (gnu packages django)
#:use-module (gnu packages groff)
#:use-module (gnu packages libffi) #:use-module (gnu packages libffi)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages python) #:use-module (gnu packages python)
@ -1541,6 +1542,19 @@ supports url redirection and retries, and also gzip and deflate decoding.")
(base32 (base32
"0sispclx263lybbk19zp1n9yhg8xxx4jddypzgi24vpjaqnsbwlc")))) "0sispclx263lybbk19zp1n9yhg8xxx4jddypzgi24vpjaqnsbwlc"))))
(build-system python-build-system) (build-system python-build-system)
(arguments
;; FIXME: The 'pypi' release does not contain tests.
'(#:tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-reference-to-groff
(lambda _
(substitute* "awscli/help.py"
(("if not self._exists_on_path\\('groff'\\):") "")
(("raise ExecutableNotFoundError\\('groff'\\)") "")
(("cmdline = \\['groff'")
(string-append "cmdline = ['" (which "groff") "'")))
#t)))))
(propagated-inputs (propagated-inputs
`(("python-colorama" ,python-colorama) `(("python-colorama" ,python-colorama)
("python-botocore" ,python-botocore) ("python-botocore" ,python-botocore)
@ -1548,9 +1562,8 @@ supports url redirection and retries, and also gzip and deflate decoding.")
("python-docutils" ,python-docutils) ("python-docutils" ,python-docutils)
("python-pyyaml" ,python-pyyaml) ("python-pyyaml" ,python-pyyaml)
("python-rsa" ,python-rsa))) ("python-rsa" ,python-rsa)))
(arguments (inputs
;; FIXME: The 'pypi' release does not contain tests. `(("groff" ,groff)))
'(#:tests? #f))
(home-page "https://aws.amazon.com/cli/") (home-page "https://aws.amazon.com/cli/")
(synopsis "Command line client for AWS") (synopsis "Command line client for AWS")
(description "AWS CLI provides a unified command line interface to the (description "AWS CLI provides a unified command line interface to the
@ -1647,13 +1660,13 @@ minimum of WSGI.")
(define-public python-flask (define-public python-flask
(package (package
(name "python-flask") (name "python-flask")
(version "1.0.2") (version "1.0.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "flask" version)) (uri (pypi-uri "Flask" version))
(sha256 (sha256
(base32 (base32
"0j6f4a9rpfh25k1gp7azqhnni4mb4fgy50jammgjgddw1l3w0w92")))) "1wxnhjlxwwjhjxmghykjhllpahv5pkdc5hln4ab6nab43s26sz5d"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
'(#:phases '(#:phases

12
gnu/packages/python-xyz.scm
View File

@ -157,14 +157,14 @@
(define-public python-psutil (define-public python-psutil
(package (package
(name "python-psutil") (name "python-psutil")
(version "5.4.3") (version "5.6.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "psutil" version)) (uri (pypi-uri "psutil" version))
(sha256 (sha256
(base32 (base32
"063v69x7spyclyaxrd3gmzj3p16q5ayg97xqhwb1kyn22a9pwip2")))) "1v95vb5385qscfdvphv8l2w22bmir3d7yhpi02n58v3mlqy1r3l2"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; FIXME: some tests does not return and times out. ;; FIXME: some tests does not return and times out.
@ -193,14 +193,14 @@ pidof, tty, taskset, pmap.")
(define-public python-shapely (define-public python-shapely
(package (package
(name "python-shapely") (name "python-shapely")
(version "1.6.3") (version "1.6.4.post2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "Shapely" version)) (uri (pypi-uri "Shapely" version))
(sha256 (sha256
(base32 (base32
"0svc58dzcw9gj92b4sgq35sdxkf85z0qwlzxarkzq4bp3h8jy58l")))) "03r42fmd9alp6r3q95ad6rldq2f7n1wimrw53zy5kpn33yv7pf64"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("python-cython" ,python-cython) `(("python-cython" ,python-cython)
@ -11474,13 +11474,13 @@ and bit flag values.")
(define-public python-attrs (define-public python-attrs
(package (package
(name "python-attrs") (name "python-attrs")
(version "18.2.0") (version "19.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "attrs" version)) (uri (pypi-uri "attrs" version))
(sha256 (sha256
(base32 (base32
"0s9ydh058wmmf5v391pym877x4ahxg45dw6a0w4c7s5wgpigdjqh")))) "16g33zr5f449lqc5wgvzpknxryfzrfsxcr6kpgxwn7l5fkv71f7h"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:modules ((guix build utils) `(#:modules ((guix build utils)

26
gnu/packages/shells.scm
View File

@ -10,6 +10,7 @@
;;; Copyright © 2017, 2018 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017, 2018 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com> ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -34,6 +35,7 @@
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages groff) #:use-module (gnu packages groff)
#:use-module (gnu packages guile)
#:use-module (gnu packages libbsd) #:use-module (gnu packages libbsd)
#:use-module (gnu packages libedit) #:use-module (gnu packages libedit)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
@ -789,3 +791,27 @@ is commonly written.")
(home-page "https://www.oilshell.org/") (home-page "https://www.oilshell.org/")
(license (list psfl ; The Oil sources include a patched Python 2 source tree (license (list psfl ; The Oil sources include a patched Python 2 source tree
asl2.0)))) asl2.0))))
(define-public gash
(package
(name "gash")
(version "0.1")
(source
(origin (method url-fetch)
(uri (string-append "mirror://savannah/gash/gash-"
version ".tar.gz"))
(sha256
(base32
"00m3lif64zyxd41cnk208kc81nl6qz659676qgiaqgwrw0brzrid"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("guile" ,guile-2.2)))
(home-page "https://savannah.nongnu.org/projects/gash/")
(synopsis "POSIX-compatible shell written in Guile Scheme")
(description "Gash is a POSIX-compatible shell written in Guile
Scheme. It provides both the shell interface, as well as a Guile
library for parsing shell scripts. Gash is designed to bootstrap Bash
as part of the Guix bootstrap process.")
(license gpl3+)))

76
gnu/packages/squirrel.scm
View File

@ -19,37 +19,65 @@
(define-module (gnu packages squirrel) (define-module (gnu packages squirrel)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages cmake) #:use-module (gnu packages cmake)
#:use-module (gnu packages sphinx)
#:use-module (guix build-system cmake) #:use-module (guix build-system cmake)
#:use-module (guix git-download) #:use-module (guix download)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils)) #:use-module (guix utils))
(define-public squirrel (define-public squirrel
(let ((commit "51137b84e66c4d526809fd8a59f4ba1d38138c76")) (package
(package (name "squirrel")
(name "squirrel") (version "3.1")
(version "3.1") (source (origin
(source (origin (method url-fetch)
(method git-fetch) (uri (string-append "mirror://sourceforge/squirrel/squirrel3/"
(uri (git-reference "squirrel " version " stable/squirrel_"
(url "https://github.com/albertodemichelis/squirrel.git") (string-join (string-split version #\.) "_")
(commit commit))) "_stable.tar.gz"))
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0vbiv1q3qcy2vj8y0b9a2ckswl9ld398n3jnxijvwddrjgya5zav")))) "1jyh1523zrrnh9swanfrda0s14mvwc9431dh07g0nx74hbxsfia8"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f)) ; no tests '(#:configure-flags '("-DDISABLE_STATIC=ON")
(native-inputs #:tests? #f ; no tests
`(("cmake" ,cmake))) #:phases
(home-page "https://squirrel-lang.org/") (modify-phases %standard-phases
(synopsis "High level imperative, object-oriented programming language") (add-after 'install 'install-documentation
(description (lambda* (#:key outputs #:allow-other-keys)
"Squirrel is a high level imperative, object-oriented programming (let* ((out (assoc-ref outputs "out"))
(doc-dir (string-append out "/share/doc/squirrel")))
(for-each
(lambda (file)
(install-file (string-append "../squirrel3/" file) doc-dir))
'("COPYRIGHT" "HISTORY" "README"
"doc/sqstdlib3.pdf" "doc/squirrel3.pdf")))
#t))
(add-after 'install 'install-headers
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(include-dir (string-append out "/include/squirrel")))
(mkdir-p include-dir)
(for-each
(lambda (header-file)
(copy-recursively header-file
(string-append include-dir
"/"
(basename header-file))))
(find-files "../squirrel3/include")))
#t)))))
(native-inputs
`(("cmake" ,cmake)
("python-sphinx" ,python-sphinx)))
(home-page "https://squirrel-lang.org/")
(synopsis "High level imperative, object-oriented programming language")
(description
"Squirrel is a high level imperative, object-oriented programming
language, designed to be a light-weight scripting language that fits in the language, designed to be a light-weight scripting language that fits in the
size, memory bandwidth, and real-time requirements of applications like video size, memory bandwidth, and real-time requirements of applications like video
games.") games.")
(license license:expat)))) (license license:expat)))

40
gnu/packages/statistics.scm
View File

@ -1327,13 +1327,13 @@ for template use among CRAN packages.")
(define-public r-evaluate (define-public r-evaluate
(package (package
(name "r-evaluate") (name "r-evaluate")
(version "0.13") (version "0.14")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "evaluate" version)) (uri (cran-uri "evaluate" version))
(sha256 (sha256
(base32 (base32
"0igvc27rsqxcswjb9slnpi5d509rffxn1y5d82hgqvv970nl3p2q")))) "0a2y7j534gbgixkwj9r1z76l2vssw4g1hznzbpclc076wkdqpj58"))))
(build-system r-build-system) (build-system r-build-system)
(home-page "https://github.com/hadley/evaluate") (home-page "https://github.com/hadley/evaluate")
(synopsis "Parsing and evaluation tools for R") (synopsis "Parsing and evaluation tools for R")
@ -1670,14 +1670,14 @@ like tidy evaluation.")
(define-public r-tibble (define-public r-tibble
(package (package
(name "r-tibble") (name "r-tibble")
(version "2.1.1") (version "2.1.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "tibble" version)) (uri (cran-uri "tibble" version))
(sha256 (sha256
(base32 (base32
"111jl0hdjhh7hkydxvsr5l19gb0ylxq7xrkc28awnc9pzglpgis5")))) "1sb5j6k8hp7yf7grjjhn45hhc163fcndiw9zw976zc74f1856kpj"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-cli" ,r-cli) `(("r-cli" ,r-cli)
@ -2333,14 +2333,14 @@ collation, and NAMESPACE files.")
(define-public r-openssl (define-public r-openssl
(package (package
(name "r-openssl") (name "r-openssl")
(version "1.3") (version "1.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "openssl" version)) (uri (cran-uri "openssl" version))
(sha256 (sha256
(base32 (base32
"1gx4mk7js1irzkql5rgk48ja9c6mm28ccxz483ngbhdd57az90qw")))) "0mh4xwb9wnn5j2n1zzmjldqjqv2nn4wdidiixxciaqrqsi0l9834"))))
(build-system r-build-system) (build-system r-build-system)
(inputs (inputs
`(("libressl" ,libressl))) `(("libressl" ,libressl)))
@ -2695,14 +2695,14 @@ certain criterion, e.g., it contains a certain regular file.")
(define-public r-rmarkdown (define-public r-rmarkdown
(package (package
(name "r-rmarkdown") (name "r-rmarkdown")
(version "1.12") (version "1.13")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "rmarkdown" version)) (uri (cran-uri "rmarkdown" version))
(sha256 (sha256
(base32 (base32
"0milpdaf4nd36kq6sci9wc5dhwswl4w9c9fychfbppgjsgfp6kfv")))) "1vv3b8nlw8ra19492rjg3na42lwh3xr5a2jy2ia81fvvs846pywn"))))
(properties `((upstream-name . "rmarkdown"))) (properties `((upstream-name . "rmarkdown")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -2714,6 +2714,7 @@ certain criterion, e.g., it contains a certain regular file.")
("r-mime" ,r-mime) ("r-mime" ,r-mime)
("r-stringr" ,r-stringr) ("r-stringr" ,r-stringr)
("r-tinytex" ,r-tinytex) ("r-tinytex" ,r-tinytex)
("r-xfun" ,r-xfun)
("r-yaml" ,r-yaml) ("r-yaml" ,r-yaml)
("ghc-pandoc" ,ghc-pandoc))) ("ghc-pandoc" ,ghc-pandoc)))
(home-page "http://rmarkdown.rstudio.com") (home-page "http://rmarkdown.rstudio.com")
@ -4314,13 +4315,13 @@ mechanism.")
(define-public r-zoo (define-public r-zoo
(package (package
(name "r-zoo") (name "r-zoo")
(version "1.8-5") (version "1.8-6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "zoo" version)) (uri (cran-uri "zoo" version))
(sha256 (sha256
(base32 (base32
"09p8gmd5ifz80ahnhiianarsr5xx3nz76jzp90d7v3fjffcrcww7")))) "1k1pmzr9nfwbxq1xf0jzn3nawv4sgnkxkgzxnm1i887jcbrs85r2"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-lattice" ,r-lattice))) `(("r-lattice" ,r-lattice)))
@ -4470,13 +4471,13 @@ Wall Street Journal, among others. This package also provides
(define-public r-statmod (define-public r-statmod
(package (package
(name "r-statmod") (name "r-statmod")
(version "1.4.30") (version "1.4.32")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "statmod" version)) (uri (cran-uri "statmod" version))
(sha256 (sha256
(base32 (base32
"07v4x8af60alcw6vbiwf5fp25bhra61kvxz9kqx64lszm0i1fb4x")))) "083yyp84xj85zg4bhz7i90bqzl3p6155ch4abwsfc9k1lv7s2rrg"))))
(build-system r-build-system) (build-system r-build-system)
(home-page "https://cran.r-project.org/web/packages/statmod") (home-page "https://cran.r-project.org/web/packages/statmod")
(native-inputs (native-inputs
@ -4771,14 +4772,14 @@ and resampling-based inference.")
(define-public r-prabclus (define-public r-prabclus
(package (package
(name "r-prabclus") (name "r-prabclus")
(version "2.2-7") (version "2.2-7.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "prabclus" version)) (uri (cran-uri "prabclus" version))
(sha256 (sha256
(base32 (base32
"0h2nml8ri27mhfs2p6ngb6kfd6lyq30sc6813yybpskkrb6gs1pb")))) "0x998nidd7abq5nqynyr8q79z056qbli23mvad6f09fjn2xz6nrc"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-mass" ,r-mass) `(("r-mass" ,r-mass)
@ -4967,14 +4968,14 @@ of the points.")
(define-public r-fpc (define-public r-fpc
(package (package
(name "r-fpc") (name "r-fpc")
(version "2.1-11.2") (version "2.2-1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "fpc" version)) (uri (cran-uri "fpc" version))
(sha256 (sha256
(base32 (base32
"0wjjp9xn283acfg6cm1wa6fsi7pf0z97227hrnlpmprks3mbj8kr")))) "183awn9fbigsy3rwmg5l39zpfg2zpbb94hkx7k99v2dir8dpdy85"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-class" ,r-class) `(("r-class" ,r-class)
@ -4986,8 +4987,7 @@ of the points.")
("r-mclust" ,r-mclust) ("r-mclust" ,r-mclust)
("r-mvtnorm" ,r-mvtnorm) ("r-mvtnorm" ,r-mvtnorm)
("r-prabclus" ,r-prabclus) ("r-prabclus" ,r-prabclus)
("r-robustbase" ,r-robustbase) ("r-robustbase" ,r-robustbase)))
("r-trimcluster" ,r-trimcluster)))
(home-page "https://cran.r-project.org/web/packages/fpc") (home-page "https://cran.r-project.org/web/packages/fpc")
(synopsis "Flexible procedures for clustering") (synopsis "Flexible procedures for clustering")
(description (description
@ -5270,14 +5270,14 @@ Companion to Applied Regression, Third Edition, Sage.")
(define-public r-car (define-public r-car
(package (package
(name "r-car") (name "r-car")
(version "3.0-2") (version "3.0-3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "car" version)) (uri (cran-uri "car" version))
(sha256 (sha256
(base32 (base32
"0l3wyc9ia0ypcbap2p39slazfpbl84mjzydqvpsywrzdiyxajnfz")))) "0vy3g3bjljd2al8xb9qr45f98is7yppc9jilqn7b6zvf5yqpr07s"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-abind" ,r-abind) `(("r-abind" ,r-abind)

4
gnu/packages/terminals.scm
View File

@ -924,7 +924,7 @@ tmux.")
(define-public kitty (define-public kitty
(package (package
(name "kitty") (name "kitty")
(version "0.13.3") (version "0.14.1")
(home-page "https://sw.kovidgoyal.net/kitty/") (home-page "https://sw.kovidgoyal.net/kitty/")
(source (source
(origin (origin
@ -935,7 +935,7 @@ tmux.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1y0vd75j8g61jdj8miml79w5ri3pqli5rv9iq6zdrxvzfa4b2rmb")) "0nm8l8ki0csdapf5mj3vg605ki5hjsx7h7i3m01x1a4vjzjmk8bv"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

8
gnu/packages/video.scm
View File

@ -1446,7 +1446,7 @@ access to mpv's powerful playback capabilities.")
(define-public youtube-dl (define-public youtube-dl
(package (package
(name "youtube-dl") (name "youtube-dl")
(version "2019.05.11") (version "2019.05.20")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/rg3/youtube-dl/releases/" (uri (string-append "https://github.com/rg3/youtube-dl/releases/"
@ -1454,7 +1454,7 @@ access to mpv's powerful playback capabilities.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1y272jgdqwhf2njzqfln80zb2pmw83rvp6lxza6wghb7cld249j1")))) "18xwdfvpkqrnj0kb8xj8hgwhgiqpv7x7x7zzr4x3vynb9grcv9m8"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; The problem here is that the directory for the man page and completion ;; The problem here is that the directory for the man page and completion
@ -1565,7 +1565,7 @@ other site that youtube-dl supports.")
(define-public you-get (define-public you-get
(package (package
(name "you-get") (name "you-get")
(version "0.4.1270") (version "0.4.1302")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -1574,7 +1574,7 @@ other site that youtube-dl supports.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"123g6x8sh32v4yn4ss55lfw7j79hgl3l6aiwgrk4ndq7dzhnz46q")))) "1fwwzslv1vpjr8q0fq10dbngr8zai1n3d6na700cgpky4j9y0y99"))))
(build-system python-build-system) (build-system python-build-system)
(inputs (inputs
`(("ffmpeg" ,ffmpeg))) ; for multi-part and >=1080p videos `(("ffmpeg" ,ffmpeg))) ; for multi-part and >=1080p videos

4
gnu/packages/vpn.scm
View File

@ -456,14 +456,14 @@ The peer-to-peer VPN implements a Layer 2 (Ethernet) network between the peers
(define-public wireguard (define-public wireguard
(package (package
(name "wireguard") (name "wireguard")
(version "0.0.20190406") (version "0.0.20190601")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://git.zx2c4.com/WireGuard/snapshot/" (uri (string-append "https://git.zx2c4.com/WireGuard/snapshot/"
"WireGuard-" version ".tar.xz")) "WireGuard-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0ns1s31mfkj7nmapsnx126rj7xlydv7jv8infx5fg58byynz61ig")))) "0s2mys78whsr0yw045a132iqx6nfy3c6hppiskbln5x04hc4ca3m"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" ; The WireGuard userspace tools (outputs '("out" ; The WireGuard userspace tools
"kernel-patch")) ; A patch to build Linux with WireGuard support "kernel-patch")) ; A patch to build Linux with WireGuard support

8
gnu/packages/wine.scm
View File

@ -4,7 +4,7 @@
;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com> ;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -310,7 +310,7 @@ integrate Windows applications into your desktop.")
(define-public wine-staging-patchset-data (define-public wine-staging-patchset-data
(package (package
(name "wine-staging-patchset-data") (name "wine-staging-patchset-data")
(version "4.8") (version "4.9")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -320,7 +320,7 @@ integrate Windows applications into your desktop.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0npm44zdys78qbqqyvjczqqjdgacpsfds3jxyy1y4yj2xjqzagsq")))) "17v66rsxvm3grglidxxzllw4msfrgwg35hmzanvrf8x8jfzjlvv2"))))
(build-system trivial-build-system) (build-system trivial-build-system)
(native-inputs (native-inputs
`(("bash" ,bash) `(("bash" ,bash)
@ -366,7 +366,7 @@ integrate Windows applications into your desktop.")
(file-name (string-append name "-" version ".tar.xz")) (file-name (string-append name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0dd1vw3bq47ypdpflgmmbi68pjw5z3wz26kfwvnkxqbp28fapfa8")))) "16vrzhhk0x862mfhninx5515s76j2kbjgmz7gzdigjzkzwi8x14i"))))
(inputs `(("autoconf" ,autoconf) ; for autoreconf (inputs `(("autoconf" ,autoconf) ; for autoreconf
("faudio" ,faudio) ("faudio" ,faudio)
("ffmpeg" ,ffmpeg) ("ffmpeg" ,ffmpeg)

42
gnu/packages/xfce.scm
View File

@ -1023,3 +1023,45 @@ the libburnia libraries. It can blank CD/DVD/BD(-RW)s, burn and
create iso images, audio CDs, as well as burn personal compositions create iso images, audio CDs, as well as burn personal compositions
of data to either CD/DVD/BD.") of data to either CD/DVD/BD.")
(license gpl2+))) (license gpl2+)))
(define-public mousepad
(package
(name "mousepad")
(version "0.4.1")
(source (origin
(method url-fetch)
(uri (string-append "http://archive.xfce.org/src/apps/mousepad/"
(version-major+minor version) "/mousepad-"
version ".tar.bz2"))
(sha256
(base32
"12si6fvhp68wz4scr339c23jxqq5ywn5nf4w55jld5lxjadkg9rr"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--enable-gtk3"
;; Use the GSettings keyfile backend rather than
;; DConf.
"--enable-keyfile-settings")
#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-program
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(gtksourceview (assoc-ref inputs "gtksourceview")))
(wrap-program (string-append out "/bin/mousepad")
;; For language-specs.
`("XDG_DATA_DIRS" ":" prefix (,(string-append gtksourceview
"/share")))))
#t)))))
(native-inputs
`(("intltool" ,intltool)
("glib" ,glib "bin") ; for glib-compile-schemas.
("pkg-config" ,pkg-config)))
(inputs
`(("gtk+" ,gtk+)
("gtksourceview" ,gtksourceview-3)))
(home-page "https://git.xfce.org/apps/mousepad/")
(synopsis "Simple text editor for Xfce")
(description
"Mousepad is a graphical text editor for Xfce based on Leafpad.")
(license gpl2+)))

3
gnu/services/cgit.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -581,7 +582,7 @@ removed for the URL and name.")
(root-readme (root-readme
(string "") (string "")
"The content of the file specified with this option will be included "The content of the file specified with this option will be included
verbatim below thef \"about\" link on the repository index page.") verbatim below the \"about\" link on the repository index page.")
(root-title (root-title
(string "") (string "")
"Text printed as heading on the repository index page.") "Text printed as heading on the repository index page.")

380
gnu/services/getmail.scm 100644
View File

@ -0,0 +1,380 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Christopher Baines <mail@cbaines.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 getmail)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (gnu packages mail)
#:use-module (gnu packages admin)
#:use-module (gnu packages tls)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:export (getmail-retriever-configuration
getmail-retriever-configuration-extra-parameters
getmail-destination-configuration
getmail-options-configuration
getmail-configuration-file
getmail-configuration
getmail-service-type))
;;; Commentary:
;;;
;;; Service for the getmail mail retriever.
;;;
;;; Code:
(define (uglify-field-name field-name)
(let ((str (symbol->string field-name)))
(string-join (string-split (if (string-suffix? "?" str)
(substring str 0 (1- (string-length str)))
str)
#\-)
"_")))
(define (serialize-field field-name val)
#~(let ((val '#$val))
(format #f "~a = ~a\n"
#$(uglify-field-name field-name)
(cond
((list? val)
(string-append
"("
(string-concatenate
(map (lambda (list-val)
(format #f "\"~a\", " list-val))
val))
")"))
(else
val)))))
(define (serialize-string field-name val)
(if (string=? val "")
""
(serialize-field field-name val)))
(define (string-or-filelike? val)
(or (string? val)
(file-like? val)))
(define (serialize-string-or-filelike field-name val)
(if (equal? val "")
""
(serialize-field field-name val)))
(define (serialize-boolean field-name val)
(serialize-field field-name (if val "true" "false")))
(define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
(serialize-field field-name val))
(define serialize-list serialize-field)
(define parameter-alist? list?)
(define (serialize-parameter-alist field-name val)
#~(string-append
#$@(map (match-lambda
((key . value)
(serialize-field key value)))
val)))
(define (serialize-getmail-retriever-configuration field-name val)
(serialize-configuration val getmail-retriever-configuration-fields))
(define-configuration getmail-retriever-configuration
(type
(string "SimpleIMAPSSLRetriever")
"The type of mail retriever to use. Valid values include
@samp{passwd} and @samp{static}.")
(server
(string 'unset)
"Space separated list of arguments to the userdb driver.")
(username
(string 'unset)
"Space separated list of arguments to the userdb driver.")
(port
(non-negative-integer #f)
"Space separated list of arguments to the userdb driver.")
(password
(string "")
"Override fields from passwd.")
(password-command
(list '())
"Override fields from passwd.")
(keyfile
(string "")
"PEM-formatted key file to use for the TLS negotiation")
(certfile
(string "")
"PEM-formatted certificate file to use for the TLS negotiation")
(ca-certs
(string "")
"CA certificates to use")
(extra-parameters
(parameter-alist '())
"Extra retriever parameters"))
(define (serialize-getmail-destination-configuration field-name val)
(serialize-configuration val getmail-destination-configuration-fields))
(define-configuration getmail-destination-configuration
(type
(string 'unset)
"The type of mail destination. Valid values include @samp{Maildir},
@samp{Mboxrd} and @samp{MDA_external}.")
(path
(string-or-filelike "")
"The path option for the mail destination. The behaviour depends on the
chosen type.")
(extra-parameters
(parameter-alist '())
"Extra destination parameters"))
(define (serialize-getmail-options-configuration field-name val)
(serialize-configuration val getmail-options-configuration-fields))
(define-configuration getmail-options-configuration
(verbose
(non-negative-integer 1)
"If set to @samp{0}, getmail will only print warnings and errors. A value
of @samp{1} means that messages will be printed about retrieving and deleting
messages. If set to @samp{2}, getmail will print messages about each of it's
actions.")
(read-all
(boolean #t)
"If true, getmail will retrieve all available messages. Otherwise it will
only retrieve messages it hasn't seen previously.")
(delete
(boolean #f)
"If set to true, messages will be deleted from the server after retrieving
and successfully delivering them. Otherwise, messages will be left on the
server.")
(delete-after
(non-negative-integer 0)
"Getmail will delete messages this number of days after seeing them, if
they have not been delivered. This means messages will be left on the server
this number of days after delivering them. A value of @samp{0} disabled this
feature.")
(delete-bigger-than
(non-negative-integer 0)
"Delete messages larger than this of bytes after retrieving them, even if
the delete and delete-after options are disabled. A value of @samp{0}
disables this feature.")
(max-bytes-per-session
(non-negative-integer 0)
"Retrieve messages totalling up to this number of bytes before closing the
session with the server. A value of @samp{0} disables this feature.")
(max-message-size
(non-negative-integer 0)
"Don't retrieve messages larger than this number of bytes. A value of
@samp{0} disables this feature.")
(delivered-to
(boolean #t)
"If true, getmail will add a Delivered-To header to messages.")
(received
(boolean #t)
"If set, getmail adds a Received header to the messages.")
(message-log
(string "")
"Getmail will record a log of its actions to the named file. A value of
@samp{\"\"} disables this feature.")
(message-log-syslog
(boolean #t)
"If true, getmail will record a log of its actions using the system
logger.")
(message-log-verbose
(boolean #t)
"If true, getmail will log information about messages not retrieved and the
reason for not retrieving them, as well as starting and ending information
lines.")
(extra-parameters
(parameter-alist '())
"Extra options to include."))
(define (serialize-getmail-configuration-file field-name val)
(match val
(($ <getmail-configuration-file> location
retriever destination options)
#~(string-append
"[retriever]\n"
#$(serialize-getmail-retriever-configuration #f retriever)
"\n[destination]\n"
#$(serialize-getmail-destination-configuration #f destination)
"\n[options]\n"
#$(serialize-getmail-options-configuration #f options)))))
(define-configuration getmail-configuration-file
(retriever
(getmail-retriever-configuration (getmail-retriever-configuration))
"What mail account to retrieve mail from, and how to access that account.")
(destination
(getmail-destination-configuration (getmail-destination-configuration))
"What to do with retrieved messages.")
(options
(getmail-options-configuration (getmail-options-configuration))
"Configure getmail."))
(define (serialize-symbol field-name val) "")
(define (serialize-getmail-configuration field-name val) "")
(define-configuration getmail-configuration
(name
(symbol "unset")
"A symbol to identify the getmail service.")
(package
(package getmail)
"The getmail package to use.")
(user
(string "getmail")
"The user to run getmail as.")
(group
(string "getmail")
"The group to run getmail as.")
(directory
(string "/var/lib/getmail/default")
"The getmail directory to use.")
(rcfile
(getmail-configuration-file (getmail-configuration-file))
"The getmail configuration file to use.")
(idle
(list '())
"A list of mailboxes that getmail should wait on the server for new mail
notifications. This depends on the server supporting the IDLE extension.")
(environment-variables
(list '())
"Environment variables to set for getmail."))
(define (generate-getmail-documentation)
(generate-documentation
`((getmail-configuration
,getmail-configuration-fields
(rcfile getmail-configuration-file))
(getmail-configuration-file
,getmail-configuration-file-fields
(retriever getmail-retriever-configuration)
(destination getmail-destination-configuration)
(options getmail-options-configuration))
(getmail-retriever-configuration ,getmail-retriever-configuration-fields)
(getmail-destination-configuration ,getmail-destination-configuration-fields)
(getmail-options-configuration ,getmail-options-configuration-fields))
'getmail-configuration))
(define-gexp-compiler (getmail-configuration-file-compiler
(rcfile <getmail-configuration-file>) system target)
(gexp->derivation
"getmailrc"
#~(call-with-output-file #$output
(lambda (port)
(display #$(serialize-getmail-configuration-file #f rcfile)
port)))
#:system system
#:target target))
(define (getmail-accounts configs)
(let ((users (delete-duplicates
(map getmail-configuration-user
configs)))
(groups (delete-duplicates
(map getmail-configuration-group
configs))))
(append
(map (lambda (group)
(user-group
(name group)
(system? #t)))
groups)
(map (lambda (user)
(user-account
(name user)
(group (getmail-configuration-group
(find (lambda (config)
(and
(string=? user (getmail-configuration-user config))
(getmail-configuration-group config)))
configs)))
(system? #t)
(comment "Getmail user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin"))))
users))))
(define (getmail-activation configs)
"Return the activation GEXP for CONFIGS."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
#$@(map
(lambda (config)
#~(let* ((pw (getpw #$(getmail-configuration-user config)))
(uid (passwd:uid pw))
(gid (passwd:gid pw))
(getmaildir #$(getmail-configuration-directory config)))
(mkdir-p getmaildir)
(chown getmaildir uid gid)))
configs))))
(define (getmail-shepherd-services configs)
"Return a list of <shepherd-service> for CONFIGS."
(map (match-lambda
(($ <getmail-configuration> location name package
user group directory rcfile idle
environment-variables)
(shepherd-service
(documentation "Run getmail.")
(provision (list (symbol-append 'getmail- name)))
(requirement '(networking))
(start #~(make-forkexec-constructor
`(#$(file-append package "/bin/getmail")
,(string-append "--getmaildir=" #$directory)
#$@(map (lambda (idle)
(string-append "--idle=" idle))
idle)
,(string-append "--rcfile=" #$rcfile))
#:user #$user
#:group #$group
#:environment-variables
(list #$@environment-variables)
#:log-file
#$(string-append "/var/log/getmail-"
(symbol->string name)))))))
configs))
(define getmail-service-type
(service-type
(name 'getmail)
(extensions
(list (service-extension shepherd-root-service-type
getmail-shepherd-services)
(service-extension activation-service-type
getmail-activation)
(service-extension account-service-type
getmail-accounts)))
(description
"Run @command{getmail}, a mail retriever program.")
(default-value '())
(compose concatenate)
(extend append)))

4
gnu/services/herd.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -76,7 +76,7 @@ return the socket."
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock address) (connect sock address)
(setvbuf sock _IOFBF 1024) (setvbuf sock 'block 1024)
sock) sock)
(lambda args (lambda args
(close-port sock) (close-port sock)

16
gnu/services/sddm.scm
View File

@ -175,7 +175,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(define (sddm-etc-service config) (define (sddm-etc-service config)
(list `("sddm.conf" ,(sddm-configuration-file config)))) (list `("sddm.conf" ,(sddm-configuration-file config))))
(define (sddm-pam-service) (define (sddm-pam-service config)
"Return a PAM service for @command{sddm}." "Return a PAM service for @command{sddm}."
(pam-service (pam-service
(name "sddm") (name "sddm")
@ -190,7 +190,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(pam-entry (pam-entry
(control "required") (control "required")
(module "pam_succeed_if.so") (module "pam_succeed_if.so")
(arguments (list "uid >= 1000" "quiet"))) (arguments (list (string-append "uid >= "
(number->string (sddm-configuration-minimum-uid config)))
"quiet")))
;; should be factored out into system-auth ;; should be factored out into system-auth
(pam-entry (pam-entry
(control "required") (control "required")
@ -249,7 +251,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(control "required") (control "required")
(module "pam_unix.so")))))) (module "pam_unix.so"))))))
(define (sddm-autologin-pam-service) (define (sddm-autologin-pam-service config)
"Return a PAM service for @command{sddm-autologin}" "Return a PAM service for @command{sddm-autologin}"
(pam-service (pam-service
(name "sddm-autologin") (name "sddm-autologin")
@ -261,7 +263,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(pam-entry (pam-entry
(control "required") (control "required")
(module "pam_succeed_if.so") (module "pam_succeed_if.so")
(arguments (list "uid >= 1000" "quiet"))) (arguments (list (string-append "uid >= "
(number->string (sddm-configuration-minimum-uid config)))
"quiet")))
(pam-entry (pam-entry
(control "required") (control "required")
(module "pam_permit.so")))) (module "pam_permit.so"))))
@ -282,9 +286,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(module "sddm")))))) (module "sddm"))))))
(define (sddm-pam-services config) (define (sddm-pam-services config)
(list (sddm-pam-service) (list (sddm-pam-service config)
(sddm-greeter-pam-service) (sddm-greeter-pam-service)
(sddm-autologin-pam-service))) (sddm-autologin-pam-service config)))
(define %sddm-accounts (define %sddm-accounts
(list (user-group (name "sddm") (system? #t)) (list (user-group (name "sddm") (system? #t))

368
gnu/services/web.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2017 nee <nee-git@hidamari.blue> ;;; Copyright © 2017 nee <nee-git@hidamari.blue>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr> ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -29,14 +29,23 @@
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services admin) #:use-module (gnu services admin)
#:use-module (gnu services getmail)
#:use-module (gnu services mail)
#:use-module (gnu system pam) #:use-module (gnu system pam)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages databases)
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages patchutils)
#:use-module (gnu packages php) #:use-module (gnu packages php)
#:use-module (gnu packages python)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages guile)
#:use-module (gnu packages logging) #:use-module (gnu packages logging)
#:use-module (guix packages)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (guix utils)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module ((guix store) #:select (text-file)) #:use-module ((guix store) #:select (text-file))
#:use-module ((guix utils) #:select (version-major)) #:use-module ((guix utils) #:select (version-major))
@ -210,7 +219,42 @@
varnish-configuration-parameters varnish-configuration-parameters
varnish-configuration-extra-options varnish-configuration-extra-options
varnish-service-type)) varnish-service-type
<patchwork-database-configuration>
patchwork-database-configuration
patchwork-database-configuration?
patchwork-database-configuration-engine
patchwork-database-configuration-name
patchwork-database-configuration-user
patchwork-database-configuration-password
patchwork-database-configuration-host
patchwork-database-configuration-port
<patchwork-settings-module>
patchwork-settings-module
patchwork-settings-module?
patchwork-settings-module-database-configuration
patchwork-settings-module-secret-key
patchwork-settings-module-allowed-hosts
patchwork-settings-module-default-from-email
patchwork-settings-module-static-url
patchwork-settings-module-admins
patchwork-settings-module-debug?
patchwork-settings-module-enable-rest-api?
patchwork-settings-module-enable-xmlrpc?
patchwork-settings-module-force-https-links?
patchwork-settings-module-extra-settings
<patchwork-configuration>
patchwork-configuration
patchwork-configuration?
patchwork-configuration-patchwork
patchwork-configuration-settings-module
patchwork-configuration-domain
patchwork-virtualhost
patchwork-service-type))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -1268,3 +1312,323 @@ files.")
varnish-shepherd-service))) varnish-shepherd-service)))
(default-value (default-value
(varnish-configuration)))) (varnish-configuration))))
;;;
;;; Patchwork
;;;
(define-record-type* <patchwork-database-configuration>
patchwork-database-configuration make-patchwork-database-configuration
patchwork-database-configuration?
(engine patchwork-database-configuration-engine
(default "django.db.backends.postgresql_psycopg2"))
(name patchwork-database-configuration-name
(default "patchwork"))
(user patchwork-database-configuration-user
(default "httpd"))
(password patchwork-database-configuration-password
(default ""))
(host patchwork-database-configuration-host
(default ""))
(port patchwork-database-configuration-port
(default "")))
(define-record-type* <patchwork-settings-module>
patchwork-settings-module make-patchwork-settings-module
patchwork-settings-module?
(database-configuration patchwork-settings-module-database-configuration
(default (patchwork-database-configuration)))
(secret-key-file patchwork-settings-module-secret-key-file
(default "/etc/patchwork/django-secret-key"))
(allowed-hosts patchwork-settings-module-allowed-hosts)
(default-from-email patchwork-settings-module-default-from-email)
(static-url patchwork-settings-module-static-url
(default "/static/"))
(admins patchwork-settings-module-admins
(default '()))
(debug? patchwork-settings-module-debug?
(default #f))
(enable-rest-api? patchwork-settings-module-enable-rest-api?
(default #t))
(enable-xmlrpc? patchwork-settings-module-enable-xmlrpc?
(default #t))
(force-https-links? patchwork-settings-module-force-https-links?
(default #t))
(extra-settings patchwork-settings-module-extra-settings
(default "")))
(define-record-type* <patchwork-configuration>
patchwork-configuration make-patchwork-configuration
patchwork-configuration?
(patchwork patchwork-configuration-patchwork
(default patchwork))
(domain patchwork-configuration-domain)
(settings-module patchwork-configuration-settings-module)
(static-path patchwork-configuration-static-url
(default "/static/"))
(getmail-retriever-config getmail-retriever-config))
;; Django uses a Python module for configuration, so this compiler generates a
;; Python module from the configuration record.
(define-gexp-compiler (patchwork-settings-module-compiler
(file <patchwork-settings-module>) system target)
(match file
(($ <patchwork-settings-module> database-configuration secret-key-file
allowed-hosts default-from-email
static-url admins debug? enable-rest-api?
enable-xmlrpc? force-https-links?
extra-configuration)
(gexp->derivation
"patchwork-settings"
(with-imported-modules '((guix build utils))
#~(let ((output #$output))
(define (create-__init__.py filename)
(call-with-output-file filename
(lambda (port) (display "" port))))
(use-modules (guix build utils)
(srfi srfi-1))
(mkdir-p (string-append output "/guix/patchwork"))
(create-__init__.py
(string-append output "/guix/__init__.py"))
(create-__init__.py
(string-append output "/guix/patchwork/__init__.py"))
(call-with-output-file
(string-append output "/guix/patchwork/settings.py")
(lambda (port)
(display
(string-append "from patchwork.settings.base import *
# Configuration from Guix
with open('" #$secret-key-file "') as f:
SECRET_KEY = f.read().strip()
ALLOWED_HOSTS = [
" #$(string-concatenate
(map (lambda (allowed-host)
(string-append " '" allowed-host "'\n"))
allowed-hosts))
"]
ADMINS = [
" #$(string-concatenate
(map (match-lambda
((name email-address)
(string-append
"('" name "','" email-address "'),")))
admins))
"]
DEBUG = " #$(if debug? "True" "False") "
ENABLE_REST_API = " #$(if enable-xmlrpc? "True" "False") "
ENABLE_XMLRPC = " #$(if enable-xmlrpc? "True" "False") "
FORCE_HTTPS_LINKS = " #$(if force-https-links? "True" "False") "
DATABASES = {
'default': {
" #$(match database-configuration
(($ <patchwork-database-configuration>
engine name user password host port)
(string-append
" 'ENGINE': '" engine "',\n"
" 'NAME': '" name "',\n"
" 'USER': '" user "',\n"
" 'PASSWORD': '" password "',\n"
" 'HOST': '" host "',\n"
" 'PORT': '" port "',\n"))) "
},
}
" #$(if debug?
#~(string-append "STATIC_ROOT = '"
#$(file-append patchwork "/share/patchwork/htdocs")
"'")
#~(string-append "STATIC_URL = '" #$static-url "'")) "
STATICFILES_STORAGE = (
'django.contrib.staticfiles.storage.StaticFilesStorage'
)
# Guix Extra Configuration
" #$extra-configuration "
") port)))
#t))
#:local-build? #t))))
(define patchwork-virtualhost
(match-lambda
(($ <patchwork-configuration> patchwork domain
settings-module static-path
getmail-retriever-config)
(define wsgi.py
(file-append patchwork
(string-append
"/lib/python"
(version-major+minor
(package-version python))
"/site-packages/patchwork/wsgi.py")))
(httpd-virtualhost
"*:8080"
`("ServerAdmin admin@example.com`
ServerName " ,domain "
LogFormat \"%v %h %l %u %t \\\"%r\\\" %>s %b \\\"%{Referer}i\\\" \\\"%{User-Agent}i\\\"\" customformat
LogLevel info
CustomLog \"/var/log/httpd/" ,domain "-access_log\" customformat
ErrorLog /var/log/httpd/error.log
WSGIScriptAlias / " ,wsgi.py "
WSGIDaemonProcess " ,(package-name patchwork) " user=httpd group=httpd processes=1 threads=2 display-name=%{GROUP} lang='en_US.UTF-8' locale='en_US.UTF-8' python-path=" ,settings-module "
WSGIProcessGroup " ,(package-name patchwork) "
WSGIPassAuthorization On
<Files " ,wsgi.py ">
Require all granted
</Files>
" ,@(if static-path
`("Alias " ,static-path " " ,patchwork "/share/patchwork/htdocs/")
'())
"
<Directory \"/srv/http/" ,domain "/\">
AllowOverride None
Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec
Require method GET POST OPTIONS
</Directory>")))))
(define (patchwork-httpd-configuration patchwork-configuration)
(list "WSGISocketPrefix /var/run/mod_wsgi"
(list "LoadModule wsgi_module "
(file-append mod-wsgi "/modules/mod_wsgi.so"))
(patchwork-virtualhost patchwork-configuration)))
(define (patchwork-django-admin-gexp patchwork settings-module)
#~(lambda command
(let ((pid (primitive-fork))
(user (getpwnam "httpd")))
(if (eq? pid 0)
(dynamic-wind
(const #t)
(lambda ()
(setgid (passwd:gid user))
(setuid (passwd:uid user))
(setenv "DJANGO_SETTINGS_MODULE" "guix.patchwork.settings")
(setenv "PYTHONPATH" #$settings-module)
(primitive-exit
(if (zero?
(apply system*
#$(file-append patchwork "/bin/patchwork-admin")
command))
0
1)))
(lambda ()
(primitive-exit 1)))
(zero? (cdr (waitpid pid)))))))
(define (patchwork-django-admin-action patchwork settings-module)
(shepherd-action
(name 'django-admin)
(documentation
"Run a django admin command for patchwork")
(procedure (patchwork-django-admin-gexp patchwork settings-module))))
(define patchwork-shepherd-services
(match-lambda
(($ <patchwork-configuration> patchwork domain
settings-module static-path
getmail-retriever-config)
(define secret-key-file-creation-gexp
(if (patchwork-settings-module? settings-module)
(with-extensions (list guile-gcrypt)
#~(let ((secret-key-file
#$(patchwork-settings-module-secret-key-file
settings-module)))
(use-modules (guix build utils)
(gcrypt random))
(unless (file-exists? secret-key-file)
(mkdir-p (dirname secret-key-file))
(call-with-output-file secret-key-file
(lambda (port)
(display (random-token 30 'very-strong) port)))
(let* ((pw (getpwnam "httpd"))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))
(chown secret-key-file uid gid)
(chmod secret-key-file #o400)))))
#~()))
(list (shepherd-service
(requirement '(postgres))
(provision (list (string->symbol
(string-append (package-name patchwork)
"-setup"))))
(start
#~(lambda ()
(define run-django-admin-command
#$(patchwork-django-admin-gexp patchwork
settings-module))
#$secret-key-file-creation-gexp
(run-django-admin-command "migrate")))
(stop #~(const #f))
(actions
(list (patchwork-django-admin-action patchwork
settings-module)))
(respawn? #f)
(documentation "Setup Patchwork."))))))
(define patchwork-getmail-configs
(match-lambda
(($ <patchwork-configuration> patchwork domain
settings-module static-path
getmail-retriever-config)
(list
(getmail-configuration
(name (string->symbol (package-name patchwork)))
(user "httpd")
(directory (string-append
"/var/lib/getmail/" (package-name patchwork)))
(rcfile
(getmail-configuration-file
(retriever getmail-retriever-config)
(destination
(getmail-destination-configuration
(type "MDA_external")
(path (file-append patchwork "/bin/patchwork-admin"))
(extra-parameters
'((arguments . ("parsemail"))))))
(options
(getmail-options-configuration
(read-all #f)
(delivered-to #f)
(received #f)))))
(idle (assq-ref
(getmail-retriever-configuration-extra-parameters
getmail-retriever-config)
'mailboxes))
(environment-variables
(list "DJANGO_SETTINGS_MODULE=guix.patchwork.settings"
#~(string-append "PYTHONPATH=" #$settings-module))))))))
(define patchwork-service-type
(service-type
(name 'patchwork-setup)
(extensions
(list (service-extension httpd-service-type
patchwork-httpd-configuration)
(service-extension shepherd-root-service-type
patchwork-shepherd-services)
(service-extension getmail-service-type
patchwork-getmail-configs)))
(description
"Patchwork patch tracking system.")))

53
gnu/system/linux-container.scm
View File

@ -109,7 +109,10 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(memq (service-kind service) (memq (service-kind service)
useless-services)) useless-services))
(operating-system-user-services os))) (operating-system-user-services os)))
(file-systems (append (map mapping->fs mappings) (file-systems (append (map mapping->fs
(if shared-network?
(append %network-file-mappings mappings)
mappings))
extra-file-systems extra-file-systems
user-file-systems user-file-systems
@ -124,32 +127,33 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
"Return a derivation of a script that runs OS as a Linux container. "Return a derivation of a script that runs OS as a Linux container.
MAPPINGS is a list of <file-system> objects that specify the files/directories MAPPINGS is a list of <file-system> objects that specify the files/directories
that will be shared with the host system." that will be shared with the host system."
(define network-mappings (define nscd-run-directory "/var/run/nscd")
;; Files to map if network is to be shared with the host
(append %network-file-mappings (define nscd-mapping
(let ((nscd-run-directory "/var/run/nscd")) (file-system-mapping
(if (file-exists? nscd-run-directory) (source nscd-run-directory)
(list (file-system-mapping (target nscd-run-directory)))
(source nscd-run-directory)
(target nscd-run-directory)))
'()))))
(define (mountable-file-system? file-system) (define (mountable-file-system? file-system)
;; Return #t if FILE-SYSTEM should be mounted in the container. ;; Return #t if FILE-SYSTEM should be mounted in the container.
(and (not (string=? "/" (file-system-mount-point file-system))) (and (not (string=? "/" (file-system-mount-point file-system)))
(file-system-needed-for-boot? file-system))) (file-system-needed-for-boot? file-system)))
(let* ((os (containerized-operating-system (define (os-file-system-specs os)
os (map file-system->spec
(cons %store-mapping (filter mountable-file-system?
(if shared-network? (operating-system-file-systems os))))
(append network-mappings mappings)
mappings)) (let* ((os (containerized-operating-system
#:shared-network? shared-network? os (cons %store-mapping mappings)
#:extra-file-systems %container-file-systems)) #:shared-network? shared-network?
(file-systems (filter mountable-file-system? #:extra-file-systems %container-file-systems))
(operating-system-file-systems os))) (nscd-os (containerized-operating-system
(specs (map file-system->spec file-systems))) os (cons* nscd-mapping %store-mapping mappings)
#:shared-network? shared-network?
#:extra-file-systems %container-file-systems))
(specs (os-file-system-specs os))
(nscd-specs (os-file-system-specs nscd-os)))
(define script (define script
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
@ -160,7 +164,12 @@ that will be shared with the host system."
(gnu system file-systems) ;spec->file-system (gnu system file-systems) ;spec->file-system
(guix build utils)) (guix build utils))
(call-with-container (map spec->file-system '#$specs) (call-with-container
(map spec->file-system
(if (and #$shared-network?
(file-exists? #$nscd-run-directory))
'#$nscd-specs
'#$specs))
(lambda () (lambda ()
(setenv "HOME" "/root") (setenv "HOME" "/root")
(setenv "TMPDIR" "/tmp") (setenv "TMPDIR" "/tmp")

178
gnu/tests/mail.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +26,7 @@
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services getmail)
#:use-module (gnu services mail) #:use-module (gnu services mail)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -32,7 +34,8 @@
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:export (%test-opensmtpd #:export (%test-opensmtpd
%test-exim %test-exim
%test-dovecot)) %test-dovecot
%test-getmail))
(define %opensmtpd-os (define %opensmtpd-os
(simple-operating-system (simple-operating-system
@ -394,3 +397,176 @@ Subject: Hello Nice to meet you!")
(name "dovecot") (name "dovecot")
(description "Connect to a running Dovecot server.") (description "Connect to a running Dovecot server.")
(value (run-dovecot-test)))) (value (run-dovecot-test))))
(define %getmail-os
(simple-operating-system
(service dhcp-client-service-type)
(service dovecot-service-type
(dovecot-configuration
(disable-plaintext-auth? #f)
(ssl? "no")
(auth-mechanisms '("anonymous" "plain"))
(auth-anonymous-username "alice")
(mail-location
(string-append "maildir:~/Maildir"
":INBOX=~/Maildir/INBOX"
":LAYOUT=fs"))))
(service getmail-service-type
(list
(getmail-configuration
(name 'test)
(user "alice")
(directory "/var/lib/getmail/alice")
(idle '("TESTBOX"))
(rcfile
(getmail-configuration-file
(retriever
(getmail-retriever-configuration
(type "SimpleIMAPRetriever")
(server "localhost")
(username "alice")
(port 143)
(extra-parameters
'((password . "testpass")
(mailboxes . ("TESTBOX"))))))
(destination
(getmail-destination-configuration
(type "Maildir")
(path "/home/alice/TestMaildir/")))
(options
(getmail-options-configuration
(read-all #f))))))))))
(define (run-getmail-test)
"Return a test of an OS running Getmail service."
(define vm
(virtual-machine
(operating-system (marionette-operating-system
%getmail-os
#:imported-modules '((gnu services herd))))
(port-forwardings '((8143 . 143)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(ice-9 iconv)
(ice-9 rdelim)
(rnrs base)
(rnrs bytevectors)
(srfi srfi-64))
(define marionette
(make-marionette '(#$vm)))
(define* (message-length message #:key (encoding "iso-8859-1"))
(bytevector-length (string->bytevector message encoding)))
(define message "From: test@example.com\n\
Subject: Hello Nice to meet you!")
(mkdir #$output)
(chdir #$output)
(test-begin "getmail")
;; Wait for dovecot to be up and running.
(test-assert "dovecot running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'dovecot))
marionette))
(test-assert "set password for alice"
(marionette-eval
'(system "echo -e \"testpass\ntestpass\" | passwd alice")
marionette))
;; Wait for getmail to be up and running.
(test-assert "getmail-test running"
(marionette-eval
'(let* ((pw (getpw "alice"))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))
(use-modules (gnu services herd))
(for-each
(lambda (dir)
(mkdir dir)
(chown dir uid gid))
'("/home/alice/TestMaildir"
"/home/alice/TestMaildir/cur"
"/home/alice/TestMaildir/new"
"/home/alice/TestMaildir/tmp"
"/home/alice/TestMaildir/TESTBOX"
"/home/alice/TestMaildir/TESTBOX/cur"
"/home/alice/TestMaildir/TESTBOX/new"
"/home/alice/TestMaildir/TESTBOX/tmp"))
(start-service 'getmail-test))
marionette))
;; Check Dovecot service's PID.
(test-assert "service process id"
(let ((pid
(number->string (wait-for-file "/var/run/dovecot/master.pid"
marionette))))
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
marionette)))
(test-assert "accept an email"
(let ((imap (socket AF_INET SOCK_STREAM 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
(connect imap addr)
;; Be greeted.
(read-line imap) ;OK
;; Authenticate
(write-line "a AUTHENTICATE ANONYMOUS" imap)
(read-line imap) ;+
(write-line "c2lyaGM=" imap)
(read-line imap) ;OK
;; Create a TESTBOX mailbox
(write-line "a CREATE TESTBOX" imap)
(read-line imap) ;OK
;; Append a message to a TESTBOX mailbox
(write-line (format #f "a APPEND TESTBOX {~a}"
(number->string (message-length message)))
imap)
(read-line imap) ;+
(write-line message imap)
(read-line imap) ;OK
;; Logout
(write-line "a LOGOUT" imap)
(close imap)
#t))
(sleep 1)
(test-assert "mail arrived"
(string-contains
(marionette-eval
'(begin
(use-modules (ice-9 ftw)
(ice-9 match))
(let ((TESTBOX/new "/home/alice/TestMaildir/new/"))
(match (scandir TESTBOX/new)
(("." ".." message-file)
(call-with-input-file
(string-append TESTBOX/new message-file)
get-string-all)))))
marionette)
message))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "getmail-test" test))
(define %test-getmail
(system-test
(name "getmail")
(description "Connect to a running Getmail server.")
(value (run-getmail-test))))
%getmail-os

164
gnu/tests/web.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr> ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
@ -28,15 +28,29 @@
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services web) #:use-module (gnu services web)
#:use-module (gnu services databases)
#:use-module (gnu services getmail)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu services shepherd)
#:use-module (gnu services mail)
#:use-module (gnu packages databases)
#:use-module (gnu packages patchutils)
#:use-module (gnu packages python)
#:use-module (gnu packages web)
#:use-module (guix packages)
#:use-module (guix modules)
#:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils)
#:use-module (ice-9 match)
#:export (%test-httpd #:export (%test-httpd
%test-nginx %test-nginx
%test-varnish %test-varnish
%test-php-fpm %test-php-fpm
%test-hpcguix-web %test-hpcguix-web
%test-tailon)) %test-tailon
%test-patchwork))
(define %index.html-contents (define %index.html-contents
;; Contents of the /index.html file. ;; Contents of the /index.html file.
@ -498,3 +512,149 @@ HTTP-PORT."
(name "tailon") (name "tailon")
(description "Connect to a running Tailon server.") (description "Connect to a running Tailon server.")
(value (run-tailon-test)))) (value (run-tailon-test))))
;;;
;;; Patchwork
;;;
(define patchwork-initial-database-setup-service
(match-lambda
(($ <patchwork-database-configuration>
engine name user password host port)
(define start-gexp
#~(lambda ()
(let ((pid (primitive-fork))
(postgres (getpwnam "postgres")))
(if (eq? pid 0)
(dynamic-wind
(const #t)
(lambda ()
(setgid (passwd:gid postgres))
(setuid (passwd:uid postgres))
(primitive-exit
(if (and
(zero?
(system* #$(file-append postgresql "/bin/createuser")
#$user))
(zero?
(system* #$(file-append postgresql "/bin/createdb")
"-O" #$user #$name)))
0
1)))
(lambda ()
(primitive-exit 1)))
(zero? (cdr (waitpid pid)))))))
(shepherd-service
(requirement '(postgres))
(provision '(patchwork-postgresql-user-and-database))
(start start-gexp)
(stop #~(const #f))
(respawn? #f)
(documentation "Setup patchwork database.")))))
(define (patchwork-os patchwork)
(simple-operating-system
(service dhcp-client-service-type)
(service httpd-service-type
(httpd-configuration
(config
(httpd-config-file
(listen '("8080"))))))
(service postgresql-service-type)
(service patchwork-service-type
(patchwork-configuration
(patchwork patchwork)
(domain "localhost")
(settings-module
(patchwork-settings-module
(allowed-hosts (list domain))
(default-from-email "")))
(getmail-retriever-config
(getmail-retriever-configuration
(type "SimpleIMAPSSLRetriever")
(server "imap.example.com")
(port 993)
(username "username")
(password "password")
(extra-parameters
'((mailboxes . ("INBOX"))))))))
(simple-service 'patchwork-database-setup
shepherd-root-service-type
(list
(patchwork-initial-database-setup-service
(patchwork-database-configuration))))))
(define (run-patchwork-test patchwork)
"Run tests in %NGINX-OS, which has nginx running and listening on
HTTP-PORT."
(define os
(marionette-operating-system
(patchwork-os patchwork)
#:imported-modules '((gnu services herd)
(guix combinators))))
(define forwarded-port 8080)
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((8080 . ,forwarded-port)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11) (srfi srfi-64)
(gnu build marionette)
(web uri)
(web client)
(web response))
(define marionette
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
(test-begin "patchwork")
(test-assert "patchwork-postgresql-user-and-service started"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(match (start-service 'patchwork-postgresql-user-and-database)
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((#t) #t)
((pid) (number? pid))))))
marionette))
(test-assert "httpd running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'httpd))
marionette))
(test-equal "http-get"
200
(let-values
(((response text)
(http-get #$(simple-format
#f "http://localhost:~A/" forwarded-port)
#:decode-body? #t)))
(response-code response)))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "patchwork-test" test))
(define %test-patchwork
(system-test
(name "patchwork")
(description "Connect to a running Patchwork service.")
(value (run-patchwork-test patchwork))))

6
guix/build-system/guile.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -75,6 +75,7 @@
(search-paths '()) (search-paths '())
(system (%current-system)) (system (%current-system))
(source-directory ".") (source-directory ".")
not-compiled-file-regexp
(compile-flags %compile-flags) (compile-flags %compile-flags)
(imported-modules %guile-build-system-modules) (imported-modules %guile-build-system-modules)
(modules '((guix build guile-build-system) (modules '((guix build guile-build-system)
@ -92,6 +93,7 @@
(source (source
source)) source))
#:source-directory ,source-directory #:source-directory ,source-directory
#:not-compiled-file-regexp ,not-compiled-file-regexp
#:compile-flags ,compile-flags #:compile-flags ,compile-flags
#:phases ,phases #:phases ,phases
#:system ,system #:system ,system
@ -128,6 +130,7 @@
(phases '%standard-phases) (phases '%standard-phases)
(source-directory ".") (source-directory ".")
not-compiled-file-regexp
(compile-flags %compile-flags) (compile-flags %compile-flags)
(imported-modules %guile-build-system-modules) (imported-modules %guile-build-system-modules)
(modules '((guix build guile-build-system) (modules '((guix build guile-build-system)
@ -168,6 +171,7 @@
#:target ,target #:target ,target
#:outputs %outputs #:outputs %outputs
#:source-directory ,source-directory #:source-directory ,source-directory
#:not-compiled-file-regexp ,not-compiled-file-regexp
#:compile-flags ,compile-flags #:compile-flags ,compile-flags
#:inputs %build-target-inputs #:inputs %build-target-inputs
#:native-inputs %build-host-inputs #:native-inputs %build-host-inputs

8
guix/build/compile.scm
View File

@ -40,8 +40,12 @@
(define %default-optimizations (define %default-optimizations
;; Default optimization options (equivalent to -O2 on Guile 2.2). ;; Default optimization options (equivalent to -O2 on Guile 2.2).
(append (tree-il-default-optimization-options) (append (if (defined? 'tree-il-default-optimization-options)
(cps-default-optimization-options))) (tree-il-default-optimization-options) ;Guile 2.2
(tree-il-optimizations)) ;Guile 3
(if (defined? 'cps-default-optimization-options)
(cps-default-optimization-options) ;Guile 2.2
(cps-optimizations)))) ;Guile 3
(define %lightweight-optimizations (define %lightweight-optimizations
;; Lightweight optimizations (like -O0, but with partial evaluation). ;; Lightweight optimizations (like -O0, but with partial evaluation).

52
guix/build/guile-build-system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,10 +19,13 @@
(define-module (guix build guile-build-system) (define-module (guix build guile-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:use-module (guix build utils) #:use-module (guix build utils)
#:export (target-guile-effective-version #:export (target-guile-effective-version
%standard-phases %standard-phases
@ -74,11 +77,19 @@ Raise an error if one of the processes exit with non-zero."
(define total (define total
(length commands)) (length commands))
(define processes
(make-hash-table))
(define (wait-for-one-process) (define (wait-for-one-process)
(match (waitpid WAIT_ANY) (match (waitpid WAIT_ANY)
((_ . status) ((pid . status)
(unless (zero? (status:exit-val status)) (let ((command (hashv-ref processes pid)))
(error "process failed" status))))) (hashv-remove! processes command)
(unless (zero? (status:exit-val status))
(format (current-error-port)
"process '~{~a ~}' failed with status ~a~%"
command status)
(exit 1))))))
(define (fork-and-run-command command) (define (fork-and-run-command command)
(match (primitive-fork) (match (primitive-fork)
@ -90,6 +101,7 @@ Raise an error if one of the processes exit with non-zero."
(lambda () (lambda ()
(primitive-exit 127)))) (primitive-exit 127))))
(pid (pid
(hashv-set! processes pid command)
#t))) #t)))
(let loop ((commands commands) (let loop ((commands commands)
@ -117,17 +129,20 @@ Raise an error if one of the processes exit with non-zero."
(define* (report-build-progress total completed (define* (report-build-progress total completed
#:optional (log-port (current-error-port))) #:optional (log-port (current-error-port)))
"Report that COMPLETED out of TOTAL files have been completed." "Report that COMPLETED out of TOTAL files have been completed."
(format log-port "compiling...\t~5,1f% of ~d files~%" ;FIXME: i18n (format log-port "[~2d/~2d] Compiling...~%"
(* 100. (/ completed total)) total) completed total)
(force-output log-port)) (force-output log-port))
(define* (build #:key outputs inputs native-inputs (define* (build #:key outputs inputs native-inputs
(source-directory ".") (source-directory ".")
(compile-flags '()) (compile-flags '())
(scheme-file-regexp %scheme-file-regexp) (scheme-file-regexp %scheme-file-regexp)
(not-compiled-file-regexp #f)
target target
#:allow-other-keys) #:allow-other-keys)
"Build files in SOURCE-DIRECTORY that match SCHEME-FILE-REGEXP." "Build files in SOURCE-DIRECTORY that match SCHEME-FILE-REGEXP. Files
matching NOT-COMPILED-FILE-REGEXP, if true, are not compiled but are
installed; this is useful for files that are meant to be included."
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(guile (assoc-ref (or native-inputs inputs) "guile")) (guile (assoc-ref (or native-inputs inputs) "guile"))
(effective (target-guile-effective-version guile)) (effective (target-guile-effective-version guile))
@ -162,16 +177,19 @@ Raise an error if one of the processes exit with non-zero."
(with-directory-excursion source-directory (with-directory-excursion source-directory
(find-files "." scheme-file-regexp)))) (find-files "." scheme-file-regexp))))
(invoke-each (invoke-each
(map (lambda (file) (filter-map (lambda (file)
(cons* guild (and (or (not not-compiled-file-regexp)
"guild" "compile" (not (string-match not-compiled-file-regexp
"-L" source-directory file)))
"-o" (string-append go-dir (cons* guild
(file-sans-extension file) "guild" "compile"
".go") "-L" source-directory
(string-append source-directory "/" file) "-o" (string-append go-dir
flags)) (file-sans-extension file)
source-files) ".go")
(string-append source-directory "/" file)
flags)))
source-files)
#:max-processes (parallel-job-count) #:max-processes (parallel-job-count)
#:report-progress report-build-progress) #:report-progress report-build-progress)

4
guix/discovery.scm
View File

@ -145,8 +145,8 @@ Call (PROC MODULE RESULT) for each module that is found."
"Return the list of package modules found in PATH, a list of directories to "Return the list of package modules found in PATH, a list of directories to
search. Entries in PATH can be directory names (strings) or (DIRECTORY search. Entries in PATH can be directory names (strings) or (DIRECTORY
. SUB-DIRECTORY) pairs, in which case modules are searched for beneath . SUB-DIRECTORY) pairs, in which case modules are searched for beneath
SUB-DIRECTORY." SUB-DIRECTORY. Modules are listed in the order they appear on the path."
(fold-modules cons '() path #:warn warn)) (reverse (fold-modules cons '() path #:warn warn)))
(define (fold-module-public-variables* proc init modules) (define (fold-module-public-variables* proc init modules)
"Call (PROC MODULE SYMBOL VARIABLE) for each variable exported by one of MODULES, "Call (PROC MODULE SYMBOL VARIABLE) for each variable exported by one of MODULES,

35
guix/import/cabal.scm
View File

@ -270,6 +270,10 @@ following lines with indentation larger than MIN-INDENT."
(peek-next-line-indent port))) (peek-next-line-indent port)))
val))) val)))
(define* (read-braced-value port)
"Read up to a closing brace."
(string-trim-both (read-delimited "}" port 'trim)))
(define (lex-white-space port bol) (define (lex-white-space port bol)
"Consume white spaces and comment lines on PORT. If a new line is started return #t, "Consume white spaces and comment lines on PORT. If a new line is started return #t,
otherwise return BOL (beginning-of-line)." otherwise return BOL (beginning-of-line)."
@ -343,8 +347,11 @@ matching a string against the created regexp."
(make-regexp pat)))) (make-regexp pat))))
(cut regexp-exec rx <>))) (cut regexp-exec rx <>)))
(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$" (define is-layout-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?[^{}]*)$"
regexp/icase)) regexp/icase))
(define is-braced-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*\\{[ \t]*$"
regexp/icase))
(define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)" (define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
regexp/icase)) regexp/icase))
@ -435,13 +442,19 @@ string with the read characters."
(begin (unread-char c) (list->string res))))) (begin (unread-char c) (list->string res)))))
(else (list->string res))))) (else (list->string res)))))
(define (lex-property k-v-rx-res loc port) (define (lex-layout-property k-v-rx-res loc port)
(let ((key (string-downcase (match:substring k-v-rx-res 1))) (let ((key (string-downcase (match:substring k-v-rx-res 1)))
(value (match:substring k-v-rx-res 2))) (value (match:substring k-v-rx-res 2)))
(make-lexical-token (make-lexical-token
'PROPERTY loc 'PROPERTY loc
(list key `(,(read-value port value (current-indentation))))))) (list key `(,(read-value port value (current-indentation)))))))
(define (lex-braced-property k-rx-res loc port)
(let ((key (string-downcase (match:substring k-rx-res 1))))
(make-lexical-token
'PROPERTY loc
(list key `(,(read-braced-value port))))))
(define (lex-rx-res rx-res token loc) (define (lex-rx-res rx-res token loc)
(let ((name (string-downcase (match:substring rx-res 1)))) (let ((name (string-downcase (match:substring rx-res 1))))
(make-lexical-token token loc name))) (make-lexical-token token loc name)))
@ -552,7 +565,6 @@ LOC is the current port location."
the current port location." the current port location."
(let* ((s (read-delimited "\n{}" port 'peek))) (let* ((s (read-delimited "\n{}" port 'peek)))
(cond (cond
((is-property s) => (cut lex-property <> loc port))
((is-flag s) => (cut lex-flag <> loc)) ((is-flag s) => (cut lex-flag <> loc))
((is-src-repo s) => (cut lex-src-repo <> loc)) ((is-src-repo s) => (cut lex-src-repo <> loc))
((is-exec s) => (cut lex-exec <> loc)) ((is-exec s) => (cut lex-exec <> loc))
@ -561,13 +573,22 @@ the current port location."
((is-benchmark s) => (cut lex-benchmark <> loc)) ((is-benchmark s) => (cut lex-benchmark <> loc))
((is-lib s) (lex-lib loc)) ((is-lib s) (lex-lib loc))
((is-else s) (lex-else loc)) ((is-else s) (lex-else loc))
(else (else (unread-string s port) #f))))
#f))))
(define (lex-property port loc)
(let* ((s (read-delimited "\n" port 'peek)))
(cond
((is-braced-property s) => (cut lex-braced-property <> loc port))
((is-layout-property s) => (cut lex-layout-property <> loc port))
(else #f))))
(define (lex-token port) (define (lex-token port)
(let* ((loc (make-source-location (cabal-file-name) (port-line port) (let* ((loc (make-source-location (cabal-file-name) (port-line port)
(port-column port) -1 -1))) (port-column port) -1 -1)))
(or (lex-single-char port loc) (lex-word port loc) (lex-line port loc)))) (or (lex-single-char port loc)
(lex-word port loc)
(lex-line port loc)
(lex-property port loc))))
;; Lexer- and error-function generators ;; Lexer- and error-function generators

4
guix/import/cran.scm
View File

@ -313,7 +313,9 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(tarball (download source-url)) (tarball (download source-url))
(sysdepends (append (sysdepends (append
(if (needs-zlib? tarball) '("zlib") '()) (if (needs-zlib? tarball) '("zlib") '())
(map string-downcase (listify meta "SystemRequirements")))) (filter (lambda (name)
(not (member name invalid-packages)))
(map string-downcase (listify meta "SystemRequirements")))))
(propagate (filter (lambda (name) (propagate (filter (lambda (name)
(not (member name (append default-r-packages (not (member name (append default-r-packages
invalid-packages)))) invalid-packages))))

61
guix/import/hackage.scm
View File

@ -51,34 +51,35 @@
hackage-package?)) hackage-package?))
(define ghc-standard-libraries (define ghc-standard-libraries
;; List of libraries distributed with ghc (7.10.2). We include GHC itself as ;; List of libraries distributed with ghc (8.4.3).
;; some packages list it. ;; https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html
'("array" '("ghc"
"base"
"bin-package-db"
"binary"
"bytestring"
"cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
;; hackage-name->package-name takes this into account. ;; hackage-name->package-name takes this into account.
"win32" ;; similarly uppercased
"array"
"base"
"binary"
"bytestring"
"containers" "containers"
"deepseq" "deepseq"
"directory" "directory"
"filepath" "filepath"
"ghc" "ghc-boot"
"ghc-compact"
"ghc-prim" "ghc-prim"
"ghci"
"haskeline" "haskeline"
"hoopl"
"hpc" "hpc"
"integer-gmp" "integer-gmp"
"pretty" "mtl"
"parsec"
"process" "process"
"rts"
"template-haskell" "template-haskell"
"terminfo" "text"
"time" "time"
"transformers" "transformers"
"unix" "unix"
"win32"
"xhtml")) "xhtml"))
(define package-name-prefix "ghc-") (define package-name-prefix "ghc-")
@ -145,10 +146,12 @@ version."
("LGPL" "'lgpl??") ("LGPL" "'lgpl??")
("BSD2" 'bsd-2) ("BSD2" 'bsd-2)
("BSD3" 'bsd-3) ("BSD3" 'bsd-3)
("BSD-3-Clause" 'bsd-3)
("MIT" 'expat) ("MIT" 'expat)
("ISC" 'isc) ("ISC" 'isc)
("MPL" 'mpl2.0) ("MPL" 'mpl2.0)
("Apache-2.0" 'asl2.0) ("Apache-2.0" 'asl2.0)
("PublicDomain" 'public-domain)
((x) (string->license x)) ((x) (string->license x))
((lst ...) `(list ,@(map string->license lst))) ((lst ...) `(list ,@(map string->license lst)))
(_ #f))) (_ #f)))
@ -277,13 +280,11 @@ representation of a Cabal file as produced by 'read-cabal'."
(license ,(string->license (cabal-package-license cabal)))) (license ,(string->license (cabal-package-license cabal))))
(append hackage-dependencies hackage-native-dependencies)))) (append hackage-dependencies hackage-native-dependencies))))
(define hackage->guix-package (define* (hackage->guix-package package-name #:key
(memoize (include-test-dependencies? #t)
(lambda* (package-name #:key (port #f)
(include-test-dependencies? #t) (cabal-environment '()))
(port #f) "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
(cabal-environment '()))
"Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
called with keyword parameter PORT, from PORT. Return the `package' called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure. S-expression corresponding to that package, or #f on failure.
CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
@ -293,18 +294,22 @@ symbol 'true' or 'false'. The value associated with other keys has to conform
to the Cabal file format definition. The default value associated with the to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively." respectively."
(let ((cabal-meta (if port (let ((cabal-meta (if port
(read-cabal (canonical-newline-port port)) (read-cabal (canonical-newline-port port))
(hackage-fetch package-name)))) (hackage-fetch package-name))))
(and=> cabal-meta (compose (cut hackage-module->sexp <> (and=> cabal-meta (compose (cut hackage-module->sexp <>
#:include-test-dependencies? #:include-test-dependencies?
include-test-dependencies?) include-test-dependencies?)
(cut eval-cabal <> cabal-environment))))))) (cut eval-cabal <> cabal-environment)))))
(define hackage->guix-package/m ;memoized variant
(memoize hackage->guix-package))
(define* (hackage-recursive-import package-name . args) (define* (hackage-recursive-import package-name . args)
(recursive-import package-name #f (recursive-import package-name #f
#:repo->guix-package (lambda (name repo) #:repo->guix-package (lambda (name repo)
(apply hackage->guix-package (cons name args))) (apply hackage->guix-package/m
(cons name args)))
#:guix-name hackage-name->package-name)) #:guix-name hackage-name->package-name))
(define (hackage-package? package) (define (hackage-package? package)

116
guix/lzlib.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,9 +24,11 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (system foreign) #:use-module (system foreign)
#:use-module (guix config) #:use-module (guix config)
#:use-module (srfi srfi-11)
#:export (lzlib-available? #:export (lzlib-available?
make-lzip-input-port make-lzip-input-port
make-lzip-output-port make-lzip-output-port
make-lzip-input-port/compressed
call-with-lzip-input-port call-with-lzip-input-port
call-with-lzip-output-port call-with-lzip-output-port
%default-member-length-limit %default-member-length-limit
@ -168,7 +171,7 @@ so use it only when needed. "
(let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int)))) (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int))))
(lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv))) (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv)))
"Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV. "Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV.
Return the number of uncompressed bytes written, a strictly positive integer." Return the number of uncompressed bytes written, a positive integer."
(let ((ret (proc (lz-encoder->pointer encoder) (let ((ret (proc (lz-encoder->pointer encoder)
(bytevector->pointer lzfile-bv start) (bytevector->pointer lzfile-bv start)
count))) count)))
@ -491,29 +494,50 @@ perhaps not yet read."
;; High level functions. ;; High level functions.
(define* (lzread! decoder file-port bv
(define* (lzread! decoder port bv
#:optional (start 0) (count (bytevector-length bv))) #:optional (start 0) (count (bytevector-length bv)))
"Read up to COUNT bytes from FILE-PORT into BV at offset START. Return the "Read up to COUNT bytes from PORT into BV at offset START. Return the
number of uncompressed bytes actually read; it is zero if COUNT is zero or if number of uncompressed bytes actually read; it is zero if COUNT is zero or if
the end-of-stream has been reached." the end-of-stream has been reached."
;; WARNING: Because we don't alternate between lz-reads and lz-writes, we can't (define (feed-decoder! decoder)
;; process more than lz-decompress-write-size from the file-port. ;; Feed DECODER with data read from PORT.
(when (> count (lz-decompress-write-size decoder)) (match (get-bytevector-n port (lz-decompress-write-size decoder))
(set! count (lz-decompress-write-size decoder))) ((? eof-object? eof) eof)
(let ((file-bv (get-bytevector-n file-port count))) (bv (lz-decompress-write decoder bv))))
(unless (eof-object? file-bv)
(lz-decompress-write decoder file-bv 0 (bytevector-length file-bv)))) (let loop ((read 0)
(let ((read 0)) (start start))
(let loop ((rd 0)) (cond ((< read count)
(if (< start (bytevector-length bv)) (match (lz-decompress-read decoder bv start (- count read))
(begin (0 (cond ((lz-decompress-finished? decoder)
(set! rd (lz-decompress-read decoder bv start (- (bytevector-length bv) start))) read)
(set! start (+ start rd)) ((eof-object? (feed-decoder! decoder))
(set! read (+ read rd))) (lz-decompress-finish decoder)
(set! rd 0)) (loop read start))
(unless (= rd 0) (else ;read again
(loop rd))) (loop read start))))
read)) (n (loop (+ read n) (+ start n)))))
(else
read))))
(define (lzwrite! encoder source source-offset source-count
target target-offset target-count)
"Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to
TARGET-COUNT bytes into TARGET at TARGET-OFFSET. Return two values: the
number of bytes read from SOURCE, and the number of bytes written to TARGET,
possibly zero."
(define read
(if (> (lz-compress-write-size encoder) 0)
(match (lz-compress-write encoder source source-offset source-count)
(0 (lz-compress-finish encoder) 0)
(n n))
0))
(define written
(lz-compress-read encoder target target-offset target-count))
(values read written))
(define* (lzwrite encoder bv lz-port (define* (lzwrite encoder bv lz-port
#:optional (start 0) (count (bytevector-length bv))) #:optional (start 0) (count (bytevector-length bv)))
@ -597,6 +621,56 @@ port is closed."
(lz-compress-close encoder) (lz-compress-close encoder)
(close-port port)))) (close-port port))))
(define* (make-lzip-input-port/compressed port
#:key
(level %default-compression-level))
"Return an input port that compresses data read from PORT, with the given LEVEL.
PORT is automatically closed when the resulting port is closed."
(define encoder (apply lz-compress-open
(car (assoc-ref %compression-levels level))))
(define input-buffer (make-bytevector 8192))
(define input-len 0)
(define input-offset 0)
(define input-eof? #f)
(define (read! bv start count)
(cond
(input-eof?
(match (lz-compress-read encoder bv start count)
(0 (if (lz-compress-finished? encoder)
0
(read! bv start count)))
(n n)))
((= input-offset input-len)
(match (get-bytevector-n! port input-buffer 0
(bytevector-length input-buffer))
((? eof-object?)
(set! input-eof? #t)
(lz-compress-finish encoder))
(count
(set! input-offset 0)
(set! input-len count)))
(read! bv start count))
(else
(let-values (((read written)
(lzwrite! encoder
input-buffer input-offset
(- input-len input-offset)
bv start count)))
(set! input-offset (+ input-offset read))
;; Make sure we don't return zero except on EOF.
(if (= 0 written)
(read! bv start count)
written)))))
(make-custom-binary-input-port "lzip-input/compressed"
read! #f #f
(lambda ()
(close-port port))))
(define* (call-with-lzip-input-port port proc) (define* (call-with-lzip-input-port port proc)
"Call PROC with a port that wraps PORT and decompresses data read from it. "Call PROC with a port that wraps PORT and decompresses data read from it.
PORT is closed upon completion." PORT is closed upon completion."

4
guix/progress.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -229,7 +229,7 @@ throughput."
(define %progress-interval (define %progress-interval
;; Default interval between subsequent outputs for rate-limited displays. ;; Default interval between subsequent outputs for rate-limited displays.
(make-time time-monotonic 200000000 0)) (make-time time-duration 200000000 0))
(define* (progress-reporter/file file size (define* (progress-reporter/file file size
#:optional (log-port (current-output-port)) #:optional (log-port (current-output-port))

4
guix/scripts/challenge.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -192,7 +192,7 @@ inconclusive reports."
(report (G_ " no local build for '~a'~%") item)) (report (G_ " no local build for '~a'~%") item))
(for-each (lambda (narinfo) (for-each (lambda (narinfo)
(report (G_ " ~50a: ~a~%") (report (G_ " ~50a: ~a~%")
(uri->string (narinfo-uri narinfo)) (uri->string (first (narinfo-uris narinfo)))
(hash->string (hash->string
(narinfo-hash->sha256 (narinfo-hash narinfo))))) (narinfo-hash->sha256 (narinfo-hash narinfo)))))
narinfos)) narinfos))

351
guix/scripts/publish.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -51,6 +51,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix serialization) #:select (write-file)) #:use-module ((guix serialization) #:select (write-file))
#:use-module (guix zlib) #:use-module (guix zlib)
#:autoload (guix lzlib) (lzlib-available?)
#:use-module (guix cache) #:use-module (guix cache)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts) #:use-module (guix scripts)
@ -74,8 +75,8 @@ Publish ~a over HTTP.\n") %store-directory)
(display (G_ " (display (G_ "
-u, --user=USER change privileges to USER as soon as possible")) -u, --user=USER change privileges to USER as soon as possible"))
(display (G_ " (display (G_ "
-C, --compression[=LEVEL] -C, --compression[=METHOD:LEVEL]
compress archives at LEVEL")) compress archives with METHOD at LEVEL"))
(display (G_ " (display (G_ "
-c, --cache=DIRECTORY cache published items to DIRECTORY")) -c, --cache=DIRECTORY cache published items to DIRECTORY"))
(display (G_ " (display (G_ "
@ -121,11 +122,14 @@ Publish ~a over HTTP.\n") %store-directory)
;; Since we compress on the fly, default to fast compression. ;; Since we compress on the fly, default to fast compression.
(compression 'gzip 3)) (compression 'gzip 3))
(define (actual-compression item requested) (define (default-compression type)
"Return the actual compression used for ITEM, which may be %NO-COMPRESSION (compression type 3))
(define (actual-compressions item requested)
"Return the actual compressions used for ITEM, which may be %NO-COMPRESSION
if ITEM is already compressed." if ITEM is already compressed."
(if (compressed-file? item) (if (compressed-file? item)
%no-compression (list %no-compression)
requested)) requested))
(define %options (define %options
@ -153,18 +157,28 @@ if ITEM is already compressed."
name))))) name)))))
(option '(#\C "compression") #f #t (option '(#\C "compression") #f #t
(lambda (opt name arg result) (lambda (opt name arg result)
(match (if arg (string->number* arg) 3) (let* ((colon (string-index arg #\:))
(0 (type (cond
(alist-cons 'compression %no-compression result)) (colon (string-take arg colon))
(level ((string->number arg) "gzip")
(if (zlib-available?) (else arg)))
(alist-cons 'compression (level (if colon
(compression 'gzip level) (string->number*
result) (string-drop arg (+ 1 colon)))
(begin (or (string->number arg) 3))))
(warning (G_ "zlib support is missing; \ (match level
compression disabled~%")) (0
result)))))) (alist-cons 'compression %no-compression result))
(level
(match (string->compression-type type)
((? symbol? type)
(alist-cons 'compression
(compression type level)
result))
(_
(warning (G_ "~a: unsupported compression type~%")
type)
result)))))))
(option '(#\c "cache") #t #f (option '(#\c "cache") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'cache arg result))) (alist-cons 'cache arg result)))
@ -203,11 +217,6 @@ compression disabled~%"))
(public-key-file . ,%public-key-file) (public-key-file . ,%public-key-file)
(private-key-file . ,%private-key-file) (private-key-file . ,%private-key-file)
;; Default to fast & low compression.
(compression . ,(if (zlib-available?)
%default-gzip-compression
%no-compression))
;; Default number of workers when caching is enabled. ;; Default number of workers when caching is enabled.
(workers . ,(current-processor-count)) (workers . ,(current-processor-count))
@ -235,29 +244,40 @@ compression disabled~%"))
(define base64-encode-string (define base64-encode-string
(compose base64-encode string->utf8)) (compose base64-encode string->utf8))
(define* (store-item->recutils store-item
#:key
(nar-path "nar")
(compression %no-compression)
file-size)
"Return the 'Compression' and 'URL' fields of the narinfo for STORE-ITEM,
with COMPRESSION, starting at NAR-PATH."
(let ((url (encode-and-join-uri-path
`(,@(split-and-decode-uri-path nar-path)
,@(match compression
(($ <compression> 'none)
'())
(($ <compression> type)
(list (symbol->string type))))
,(basename store-item)))))
(format #f "URL: ~a~%Compression: ~a~%~@[FileSize: ~a~%~]"
url (compression-type compression) file-size)))
(define* (narinfo-string store store-path key (define* (narinfo-string store store-path key
#:key (compression %no-compression) #:key (compressions (list %no-compression))
(nar-path "nar") file-size) (nar-path "nar") (file-sizes '()))
"Generate a narinfo key/value string for STORE-PATH; an exception is raised "Generate a narinfo key/value string for STORE-PATH; an exception is raised
if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The
narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs. narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs.
Optionally, FILE-SIZE can specify the size in bytes of the compressed NAR; it
informs the client of how much needs to be downloaded." Optionally, FILE-SIZES is a list of compression/integer pairs, where the
integer is size in bytes of the compressed NAR; it informs the client of how
much needs to be downloaded."
(let* ((path-info (query-path-info store store-path)) (let* ((path-info (query-path-info store store-path))
(compression (actual-compression store-path compression)) (compressions (actual-compressions store-path compressions))
(url (encode-and-join-uri-path
`(,@(split-and-decode-uri-path nar-path)
,@(match compression
(($ <compression> 'none)
'())
(($ <compression> type)
(list (symbol->string type))))
,(basename store-path))))
(hash (bytevector->nix-base32-string (hash (bytevector->nix-base32-string
(path-info-hash path-info))) (path-info-hash path-info)))
(size (path-info-nar-size path-info)) (size (path-info-nar-size path-info))
(file-size (or file-size (file-sizes `((,%no-compression . ,size) ,@file-sizes))
(and (eq? compression %no-compression) size)))
(references (string-join (references (string-join
(map basename (path-info-references path-info)) (map basename (path-info-references path-info))
" ")) " "))
@ -265,17 +285,21 @@ informs the client of how much needs to be downloaded."
(base-info (format #f (base-info (format #f
"\ "\
StorePath: ~a StorePath: ~a
URL: ~a ~{~a~}\
Compression: ~a
NarHash: sha256:~a NarHash: sha256:~a
NarSize: ~d NarSize: ~d
References: ~a~%~a" References: ~a~%"
store-path url store-path
(compression-type compression) (map (lambda (compression)
hash size references (let ((size (assoc-ref file-sizes
(if file-size compression)))
(format #f "FileSize: ~a~%" file-size) (store-item->recutils store-path
""))) #:file-size size
#:nar-path nar-path
#:compression
compression)))
compressions)
hash size references))
;; Do not render a "Deriver" or "System" line if we are rendering ;; Do not render a "Deriver" or "System" line if we are rendering
;; info for a derivation. ;; info for a derivation.
(info (if (not deriver) (info (if (not deriver)
@ -318,7 +342,7 @@ References: ~a~%~a"
%nix-cache-info)))) %nix-cache-info))))
(define* (render-narinfo store request hash (define* (render-narinfo store request hash
#:key ttl (compression %no-compression) #:key ttl (compressions (list %no-compression))
(nar-path "nar")) (nar-path "nar"))
"Render metadata for the store path corresponding to HASH. If TTL is true, "Render metadata for the store path corresponding to HASH. If TTL is true,
advertise it as the maximum validity period (in seconds) via the advertise it as the maximum validity period (in seconds) via the
@ -334,7 +358,7 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
(cut display (cut display
(narinfo-string store store-path (%private-key) (narinfo-string store store-path (%private-key)
#:nar-path nar-path #:nar-path nar-path
#:compression compression) #:compressions compressions)
<>))))) <>)))))
(define* (nar-cache-file directory item (define* (nar-cache-file directory item
@ -350,6 +374,9 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
"/" (basename item) "/" (basename item)
".narinfo")) ".narinfo"))
(define (hash-part-mapping-cache-file directory hash)
(string-append directory "/hashes/" hash))
(define run-single-baker (define run-single-baker
(let ((baking (make-weak-value-hash-table)) (let ((baking (make-weak-value-hash-table))
(mutex (make-mutex))) (mutex (make-mutex)))
@ -403,8 +430,29 @@ items. Failing that, we could eventually have to recompute them and return
+inf.0 +inf.0
(expiration-time file)))))) (expiration-time file))))))
(define (hash-part->path* store hash cache)
"Like 'hash-part->path' but cached results under CACHE. This ensures we can
still map HASH to the corresponding store file name, even if said store item
vanished from the store in the meantime."
(let ((cached (hash-part-mapping-cache-file cache hash)))
(catch 'system-error
(lambda ()
(call-with-input-file cached read-string))
(lambda args
(if (= ENOENT (system-error-errno args))
(match (hash-part->path store hash)
("" "")
(result
(mkdir-p (dirname cached))
(call-with-output-file (string-append cached ".tmp")
(lambda (port)
(display result port)))
(rename-file (string-append cached ".tmp") cached)
result))
(apply throw args))))))
(define* (render-narinfo/cached store request hash (define* (render-narinfo/cached store request hash
#:key ttl (compression %no-compression) #:key ttl (compressions (list %no-compression))
(nar-path "nar") (nar-path "nar")
cache pool) cache pool)
"Respond to the narinfo request for REQUEST. If the narinfo is available in "Respond to the narinfo request for REQUEST. If the narinfo is available in
@ -412,17 +460,22 @@ CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
requested using POOL." requested using POOL."
(define (delete-entry narinfo) (define (delete-entry narinfo)
;; Delete NARINFO and the corresponding nar from CACHE. ;; Delete NARINFO and the corresponding nar from CACHE.
(let ((nar (string-append (string-drop-right narinfo (let* ((nar (string-append (string-drop-right narinfo
(string-length ".narinfo")) (string-length ".narinfo"))
".nar"))) ".nar"))
(base (basename narinfo ".narinfo"))
(hash (string-take base (string-index base #\-)))
(mapping (hash-part-mapping-cache-file cache hash)))
(delete-file* narinfo) (delete-file* narinfo)
(delete-file* nar))) (delete-file* nar)
(delete-file* mapping)))
(let* ((item (hash-part->path store hash)) (let* ((item (hash-part->path* store hash cache))
(compression (actual-compression item compression)) (compressions (actual-compressions item compressions))
(cached (and (not (string-null? item)) (cached (and (not (string-null? item))
(narinfo-cache-file cache item (narinfo-cache-file cache item
#:compression compression)))) #:compression
(first compressions)))))
(cond ((string-null? item) (cond ((string-null? item)
(not-found request)) (not-found request))
((file-exists? cached) ((file-exists? cached)
@ -446,7 +499,7 @@ requested using POOL."
;; (format #t "baking ~s~%" item) ;; (format #t "baking ~s~%" item)
(bake-narinfo+nar cache item (bake-narinfo+nar cache item
#:ttl ttl #:ttl ttl
#:compression compression #:compressions compressions
#:nar-path nar-path))) #:nar-path nar-path)))
(when ttl (when ttl
@ -463,47 +516,75 @@ requested using POOL."
(else (else
(not-found request #:phrase ""))))) (not-found request #:phrase "")))))
(define (compress-nar cache item compression)
"Save in directory CACHE the nar for ITEM compressed with COMPRESSION."
(define nar
(nar-cache-file cache item #:compression compression))
(mkdir-p (dirname nar))
(match (compression-type compression)
('gzip
;; Note: the file port gets closed along with the gzip port.
(call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
(lambda (port)
(write-file item port))
#:level (compression-level compression)
#:buffer-size (* 128 1024))
(rename-file (string-append nar ".tmp") nar))
('lzip
;; Note: the file port gets closed along with the lzip port.
(call-with-lzip-output-port (open-output-file (string-append nar ".tmp"))
(lambda (port)
(write-file item port))
#:level (compression-level compression))
(rename-file (string-append nar ".tmp") nar))
('none
;; Cache nars even when compression is disabled so that we can
;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
(with-atomic-file-output nar
(lambda (port)
(write-file item port))))))
(define* (bake-narinfo+nar cache item (define* (bake-narinfo+nar cache item
#:key ttl (compression %no-compression) #:key ttl (compressions (list %no-compression))
(nar-path "/nar")) (nar-path "/nar"))
"Write the narinfo and nar for ITEM to CACHE." "Write the narinfo and nar for ITEM to CACHE."
(let* ((compression (actual-compression item compression)) (define (compressed-nar-size compression)
(nar (nar-cache-file cache item (let* ((nar (nar-cache-file cache item #:compression compression))
#:compression compression)) (stat (stat nar #f)))
(narinfo (narinfo-cache-file cache item (and stat
#:compression compression))) (cons compression (stat:size stat)))))
(mkdir-p (dirname nar)) (let ((compression (actual-compressions item compressions)))
(match (compression-type compression)
('gzip
;; Note: the file port gets closed along with the gzip port.
(call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
(lambda (port)
(write-file item port))
#:level (compression-level compression)
#:buffer-size (* 128 1024))
(rename-file (string-append nar ".tmp") nar))
('none
;; Cache nars even when compression is disabled so that we can
;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
(with-atomic-file-output nar
(lambda (port)
(write-file item port)))))
(mkdir-p (dirname narinfo)) (for-each (cut compress-nar cache item <>) compressions)
(with-atomic-file-output narinfo
(lambda (port) (match compressions
;; Open a new connection to the store. We cannot reuse the main ((main others ...)
;; thread's connection to the store since we would end up sending (let ((narinfo (narinfo-cache-file cache item
;; stuff concurrently on the same channel. #:compression main)))
(with-store store (with-atomic-file-output narinfo
(display (narinfo-string store item (lambda (port)
(%private-key) ;; Open a new connection to the store. We cannot reuse the main
#:nar-path nar-path ;; thread's connection to the store since we would end up sending
#:compression compression ;; stuff concurrently on the same channel.
#:file-size (and=> (stat nar #f) (with-store store
stat:size)) (let ((sizes (filter-map compressed-nar-size compression)))
port)))))) (display (narinfo-string store item
(%private-key)
#:nar-path nar-path
#:compressions compressions
#:file-sizes sizes)
port)))))
;; Make narinfo files for OTHERS hard links to NARINFO such that the
;; atime-based cache eviction considers either all the nars or none
;; of them as candidates.
(for-each (lambda (other)
(let ((other (narinfo-cache-file cache item
#:compression other)))
(link narinfo other)))
others))))))
;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for ;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for
;; internal consumption: it allows us to pass the compression info to ;; internal consumption: it allows us to pass the compression info to
@ -687,6 +768,9 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(make-gzip-output-port (response-port response) (make-gzip-output-port (response-port response)
#:level level #:level level
#:buffer-size (* 64 1024))) #:buffer-size (* 64 1024)))
(($ <compression> 'lzip level)
(make-lzip-output-port (response-port response)
#:level level))
(($ <compression> 'none) (($ <compression> 'none)
(response-port response)) (response-port response))
(#f (#f
@ -761,12 +845,33 @@ blocking."
http-write http-write
(@@ (web server http) http-close)) (@@ (web server http) http-close))
(define (string->compression-type string)
"Return a symbol denoting the compression method expressed by STRING; return
#f if STRING doesn't match any supported method."
(match string
("gzip" (and (zlib-available?) 'gzip))
("lzip" (and (lzlib-available?) 'lzip))
(_ #f)))
(define (effective-compression requested-type compressions)
"Given the REQUESTED-TYPE for compression and the set of chosen COMPRESSION
methods, return the applicable compression."
(or (find (match-lambda
(($ <compression> type)
(and (eq? type requested-type)
compression)))
compressions)
(default-compression requested-type)))
(define* (make-request-handler store (define* (make-request-handler store
#:key #:key
cache pool cache pool
narinfo-ttl narinfo-ttl
(nar-path "nar") (nar-path "nar")
(compression %no-compression)) (compressions (list %no-compression)))
(define compression-type?
string->compression-type)
(define nar-path? (define nar-path?
(let ((expected (split-and-decode-uri-path nar-path))) (let ((expected (split-and-decode-uri-path nar-path)))
(cut equal? expected <>))) (cut equal? expected <>)))
@ -785,19 +890,17 @@ blocking."
(render-home-page request)) (render-home-page request))
;; /<hash>.narinfo ;; /<hash>.narinfo
(((= extract-narinfo-hash (? string? hash))) (((= extract-narinfo-hash (? string? hash)))
;; TODO: Register roots for HASH that will somehow remain for
;; NARINFO-TTL.
(if cache (if cache
(render-narinfo/cached store request hash (render-narinfo/cached store request hash
#:cache cache #:cache cache
#:pool pool #:pool pool
#:ttl narinfo-ttl #:ttl narinfo-ttl
#:nar-path nar-path #:nar-path nar-path
#:compression compression) #:compressions compressions)
(render-narinfo store request hash (render-narinfo store request hash
#:ttl narinfo-ttl #:ttl narinfo-ttl
#:nar-path nar-path #:nar-path nar-path
#:compression compression))) #:compressions compressions)))
;; /nar/file/NAME/sha256/HASH ;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash) (("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c) (guard (c ((invalid-base32-character? c)
@ -815,13 +918,11 @@ blocking."
;; is restarted with different compression parameters. ;; is restarted with different compression parameters.
;; /nar/gzip/<store-item> ;; /nar/gzip/<store-item>
((components ... "gzip" store-item) ((components ... (? compression-type? type) store-item)
(if (and (nar-path? components) (zlib-available?)) (if (nar-path? components)
(let ((compression (match compression (let* ((compression-type (string->compression-type type))
(($ <compression> 'gzip) (compression (effective-compression compression-type
compression) compressions)))
(_
%default-gzip-compression))))
(if cache (if cache
(render-nar/cached store cache request store-item (render-nar/cached store cache request store-item
#:ttl narinfo-ttl #:ttl narinfo-ttl
@ -845,7 +946,8 @@ blocking."
(not-found request)))) (not-found request))))
(define* (run-publish-server socket store (define* (run-publish-server socket store
#:key (compression %no-compression) #:key
(compressions (list %no-compression))
(nar-path "nar") narinfo-ttl (nar-path "nar") narinfo-ttl
cache pool) cache pool)
(run-server (make-request-handler store (run-server (make-request-handler store
@ -853,7 +955,7 @@ blocking."
#:pool pool #:pool pool
#:nar-path nar-path #:nar-path nar-path
#:narinfo-ttl narinfo-ttl #:narinfo-ttl narinfo-ttl
#:compression compression) #:compressions compressions)
concurrent-http-server concurrent-http-server
`(#:socket ,socket))) `(#:socket ,socket)))
@ -892,7 +994,17 @@ blocking."
(user (assoc-ref opts 'user)) (user (assoc-ref opts 'user))
(port (assoc-ref opts 'port)) (port (assoc-ref opts 'port))
(ttl (assoc-ref opts 'narinfo-ttl)) (ttl (assoc-ref opts 'narinfo-ttl))
(compression (assoc-ref opts 'compression)) (compressions (match (filter-map (match-lambda
(('compression . compression)
compression)
(_ #f))
opts)
(()
;; Default to fast & low compression.
(list (if (zlib-available?)
%default-gzip-compression
%no-compression)))
(lst (reverse lst))))
(address (let ((addr (assoc-ref opts 'address))) (address (let ((addr (assoc-ref opts 'address)))
(make-socket-address (sockaddr:fam addr) (make-socket-address (sockaddr:fam addr)
(sockaddr:addr addr) (sockaddr:addr addr)
@ -919,10 +1031,17 @@ consider using the '--user' option!~%")))
(parameterize ((%public-key public-key) (parameterize ((%public-key public-key)
(%private-key private-key)) (%private-key private-key))
(format #t (G_ "publishing ~a on ~a, port ~d~%") (info (G_ "publishing ~a on ~a, port ~d~%")
%store-directory %store-directory
(inet-ntop (sockaddr:fam address) (sockaddr:addr address)) (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(sockaddr:port address)) (sockaddr:port address))
(for-each (lambda (compression)
(info (G_ "using '~a' compression method, level ~a~%")
(compression-type compression)
(compression-level compression)))
compressions)
(when repl-port (when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
@ -936,7 +1055,7 @@ consider using the '--user' option!~%")))
#:thread-name #:thread-name
"publish worker")) "publish worker"))
#:nar-path nar-path #:nar-path nar-path
#:compression compression #:compressions compressions
#:narinfo-ttl ttl)))))) #:narinfo-ttl ttl))))))
;;; Local Variables: ;;; Local Variables:

141
guix/scripts/substitute.scm
View File

@ -42,6 +42,7 @@
#:use-module (guix progress) #:use-module (guix progress)
#:use-module ((guix build syscalls) #:use-module ((guix build syscalls)
#:select (set-thread-name)) #:select (set-thread-name))
#:autoload (guix lzlib) (lzlib-available?)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -66,11 +67,11 @@
narinfo? narinfo?
narinfo-path narinfo-path
narinfo-uri narinfo-uris
narinfo-uri-base narinfo-uri-base
narinfo-compression narinfo-compressions
narinfo-file-hash narinfo-file-hashes
narinfo-file-size narinfo-file-sizes
narinfo-hash narinfo-hash
narinfo-size narinfo-size
narinfo-references narinfo-references
@ -280,15 +281,16 @@ failure, return #f and #f."
(define-record-type <narinfo> (define-record-type <narinfo>
(%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size (%make-narinfo path uri-base uris compressions file-sizes file-hashes
references deriver system signature contents) nar-hash nar-size references deriver system
signature contents)
narinfo? narinfo?
(path narinfo-path) (path narinfo-path)
(uri narinfo-uri) (uri-base narinfo-uri-base) ;URI of the cache it originates from
(uri-base narinfo-uri-base) ; URI of the cache it originates from (uris narinfo-uris) ;list of strings
(compression narinfo-compression) (compressions narinfo-compressions) ;list of strings
(file-hash narinfo-file-hash) (file-sizes narinfo-file-sizes) ;list of (integers | #f)
(file-size narinfo-file-size) (file-hashes narinfo-file-hashes)
(nar-hash narinfo-hash) (nar-hash narinfo-hash)
(nar-size narinfo-size) (nar-size narinfo-size)
(references narinfo-references) (references narinfo-references)
@ -334,17 +336,25 @@ s-expression: ~s~%")
(define (narinfo-maker str cache-url) (define (narinfo-maker str cache-url)
"Return a narinfo constructor for narinfos originating from CACHE-URL. STR "Return a narinfo constructor for narinfos originating from CACHE-URL. STR
must contain the original contents of a narinfo file." must contain the original contents of a narinfo file."
(lambda (path url compression file-hash file-size nar-hash nar-size (lambda (path urls compressions file-hashes file-sizes
references deriver system signature) nar-hash nar-size references deriver system
signature)
"Return a new <narinfo> object." "Return a new <narinfo> object."
(%make-narinfo path (define len (length urls))
(%make-narinfo path cache-url
;; Handle the case where URL is a relative URL. ;; Handle the case where URL is a relative URL.
(or (string->uri url) (map (lambda (url)
(string->uri (string-append cache-url "/" url))) (or (string->uri url)
cache-url (string->uri
(string-append cache-url "/" url))))
compression file-hash urls)
(and=> file-size string->number) compressions
(match file-sizes
(() (make-list len #f))
((lst ...) (map string->number lst)))
(match file-hashes
(() (make-list len #f))
((lst ...) (map string->number lst)))
nar-hash nar-hash
(and=> nar-size string->number) (and=> nar-size string->number)
(string-tokenize references) (string-tokenize references)
@ -360,7 +370,7 @@ must contain the original contents of a narinfo file."
#:optional (acl (current-acl))) #:optional (acl (current-acl)))
"Bail out if SIGNATURE, a canonical sexp representing the signature of "Bail out if SIGNATURE, a canonical sexp representing the signature of
NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO." NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
(let ((uri (uri->string (narinfo-uri narinfo)))) (let ((uri (uri->string (first (narinfo-uris narinfo)))))
(signature-case (signature hash acl) (signature-case (signature hash acl)
(valid-signature #t) (valid-signature #t)
(invalid-signature (invalid-signature
@ -387,7 +397,8 @@ No authentication and authorization checks are performed here!"
'("StorePath" "URL" "Compression" '("StorePath" "URL" "Compression"
"FileHash" "FileSize" "NarHash" "NarSize" "FileHash" "FileSize" "NarHash" "NarSize"
"References" "Deriver" "System" "References" "Deriver" "System"
"Signature")))) "Signature")
'("URL" "Compression" "FileSize" "FileHash"))))
(define (narinfo-sha256 narinfo) (define (narinfo-sha256 narinfo)
"Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
@ -414,7 +425,7 @@ No authentication and authorization checks are performed here!"
(or %allow-unauthenticated-substitutes? (or %allow-unauthenticated-substitutes?
(let ((hash (narinfo-sha256 narinfo)) (let ((hash (narinfo-sha256 narinfo))
(signature (narinfo-signature narinfo)) (signature (narinfo-signature narinfo))
(uri (uri->string (narinfo-uri narinfo)))) (uri (uri->string (first (narinfo-uris narinfo)))))
(and hash signature (and hash signature
(signature-case (signature hash acl) (signature-case (signature hash acl)
(valid-signature #t) (valid-signature #t)
@ -919,9 +930,11 @@ expected by the daemon."
(length (narinfo-references narinfo))) (length (narinfo-references narinfo)))
(for-each (cute format #t "~a/~a~%" (%store-prefix) <>) (for-each (cute format #t "~a/~a~%" (%store-prefix) <>)
(narinfo-references narinfo)) (narinfo-references narinfo))
(format #t "~a\n~a\n"
(or (narinfo-file-size narinfo) 0) (let-values (((uri compression file-size) (select-uri narinfo)))
(or (narinfo-size narinfo) 0))) (format #t "~a\n~a\n"
(or file-size 0)
(or (narinfo-size narinfo) 0))))
(define* (process-query command (define* (process-query command
#:key cache-urls acl) #:key cache-urls acl)
@ -947,17 +960,73 @@ authorized substitutes."
(wtf (wtf
(error "unknown `--query' command" wtf)))) (error "unknown `--query' command" wtf))))
(define %compression-methods
;; Known compression methods and a thunk to determine whether they're
;; supported. See 'decompressed-port' in (guix utils).
`(("gzip" . ,(const #t))
("lzip" . ,lzlib-available?)
("xz" . ,(const #t))
("bzip2" . ,(const #t))
("none" . ,(const #t))))
(define (supported-compression? compression)
"Return true if COMPRESSION, a string, denotes a supported compression
method."
(match (assoc-ref %compression-methods compression)
(#f #f)
(supported? (supported?))))
(define (compresses-better? compression1 compression2)
"Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
this is a rough approximation."
(match compression1
("none" #f)
("gzip" (string=? compression2 "none"))
(_ (or (string=? compression2 "none")
(string=? compression2 "gzip")))))
(define (select-uri narinfo)
"Select the \"best\" URI to download NARINFO's nar, and return three values:
the URI, its compression method (a string), and the compressed file size."
(define choices
(filter (match-lambda
((uri compression file-size)
(supported-compression? compression)))
(zip (narinfo-uris narinfo)
(narinfo-compressions narinfo)
(narinfo-file-sizes narinfo))))
(define (file-size<? c1 c2)
(match c1
((uri1 compression1 (? integer? file-size1))
(match c2
((uri2 compression2 (? integer? file-size2))
(< file-size1 file-size2))
(_ #t)))
((uri compression1 #f)
(match c2
((uri2 compression2 _)
(compresses-better? compression1 compression2))))
(_ #f))) ;we can't tell
(match (sort choices file-size<?)
(((uri compression file-size) _ ...)
(values uri compression file-size))))
(define* (process-substitution store-item destination (define* (process-substitution store-item destination
#:key cache-urls acl print-build-trace?) #:key cache-urls acl print-build-trace?)
"Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
DESTINATION as a nar file. Verify the substitute against ACL." DESTINATION as a nar file. Verify the substitute against ACL."
(let* ((narinfo (lookup-narinfo cache-urls store-item (define narinfo
(cut valid-narinfo? <> acl))) (lookup-narinfo cache-urls store-item
(uri (and=> narinfo narinfo-uri))) (cut valid-narinfo? <> acl)))
(unless uri
(leave (G_ "no valid substitute for '~a'~%")
store-item))
(unless narinfo
(leave (G_ "no valid substitute for '~a'~%")
store-item))
(let-values (((uri compression file-size)
(select-uri narinfo)))
;; Tell the daemon what the expected hash of the Nar itself is. ;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo)) (format #t "~a~%" (narinfo-hash narinfo))
@ -971,9 +1040,8 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; DOWNLOAD-SIZE is #f in practice. ;; DOWNLOAD-SIZE is #f in practice.
(fetch uri #:buffered? #f #:timeout? #f)) (fetch uri #:buffered? #f #:timeout? #f))
((progress) ((progress)
(let* ((comp (narinfo-compression narinfo)) (let* ((dl-size (or download-size
(dl-size (or download-size (and (equal? compression "none")
(and (equal? comp "none")
(narinfo-size narinfo)))) (narinfo-size narinfo))))
(reporter (if print-build-trace? (reporter (if print-build-trace?
(progress-reporter/trace (progress-reporter/trace
@ -989,8 +1057,7 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; NOTE: This 'progress' port of current process will be ;; NOTE: This 'progress' port of current process will be
;; closed here, while the child process doing the ;; closed here, while the child process doing the
;; reporting will close it upon exit. ;; reporting will close it upon exit.
(decompressed-port (and=> (narinfo-compression narinfo) (decompressed-port (string->symbol compression)
string->symbol)
progress))) progress)))
;; Unpack the Nar at INPUT into DESTINATION. ;; Unpack the Nar at INPUT into DESTINATION.
(restore-file input destination) (restore-file input destination)

5
guix/scripts/weather.scm
View File

@ -175,7 +175,10 @@ about the derivations queued, as is the case with Hydra."
(requested (length items)) (requested (length items))
(missing (lset-difference string=? (missing (lset-difference string=?
items (map narinfo-path narinfos))) items (map narinfo-path narinfos)))
(sizes (filter-map narinfo-file-size narinfos)) (sizes (append-map (lambda (narinfo)
(filter integer?
(narinfo-file-sizes narinfo)))
narinfos))
(time (+ (time-second time) (time (+ (time-second time)
(/ (time-nanosecond time) 1e9)))) (/ (time-nanosecond time) 1e9))))
(format #t (G_ " ~2,1f% substitutes available (~h out of ~h)~%") (format #t (G_ " ~2,1f% substitutes available (~h out of ~h)~%")

27
guix/self.scm
View File

@ -57,6 +57,7 @@
("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt)) ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt))
("gnutls" (ref '(gnu packages tls) 'gnutls)) ("gnutls" (ref '(gnu packages tls) 'gnutls))
("zlib" (ref '(gnu packages compression) 'zlib)) ("zlib" (ref '(gnu packages compression) 'zlib))
("lzlib" (ref '(gnu packages compression) 'lzlib))
("gzip" (ref '(gnu packages compression) 'gzip)) ("gzip" (ref '(gnu packages compression) 'gzip))
("bzip2" (ref '(gnu packages compression) 'bzip2)) ("bzip2" (ref '(gnu packages compression) 'bzip2))
("xz" (ref '(gnu packages compression) 'xz)) ("xz" (ref '(gnu packages compression) 'xz))
@ -603,7 +604,21 @@ Info manual."
(define (wrap daemon) (define (wrap daemon)
(program-file "guix-daemon" (program-file "guix-daemon"
#~(begin #~(begin
;; Refer to the right 'guix' command for 'guix
;; substitute' & co.
(setenv "GUIX" #$command) (setenv "GUIX" #$command)
;; Honor the user's settings rather than those hardcoded
;; in the 'guix-daemon' package.
(unless (getenv "GUIX_STATE_DIRECTORY")
(setenv "GUIX_STATE_DIRECTORY"
#$(string-append %localstatedir "/guix")))
(unless (getenv "GUIX_CONFIGURATION_DIRECTORY")
(setenv "GUIX_CONFIGURATION_DIRECTORY"
#$(string-append %sysconfdir "/guix")))
(unless (getenv "NIX_STORE_DIR")
(setenv "NIX_STORE_DIR" #$%storedir))
(apply execl #$(file-append daemon "/bin/guix-daemon") (apply execl #$(file-append daemon "/bin/guix-daemon")
"guix-daemon" (cdr (command-line)))))) "guix-daemon" (cdr (command-line))))))
@ -646,6 +661,7 @@ Info manual."
(guile-version (effective-version)) (guile-version (effective-version))
(guile-for-build (default-guile)) (guile-for-build (default-guile))
(zlib (specification->package "zlib")) (zlib (specification->package "zlib"))
(lzlib (specification->package "lzlib"))
(gzip (specification->package "gzip")) (gzip (specification->package "gzip"))
(bzip2 (specification->package "bzip2")) (bzip2 (specification->package "bzip2"))
(xz (specification->package "xz")) (xz (specification->package "xz"))
@ -800,6 +816,7 @@ Info manual."
#:extra-modules #:extra-modules
`(((guix config) `(((guix config)
=> ,(make-config.scm #:zlib zlib => ,(make-config.scm #:zlib zlib
#:lzlib lzlib
#:gzip gzip #:gzip gzip
#:bzip2 bzip2 #:bzip2 bzip2
#:xz xz #:xz xz
@ -897,7 +914,7 @@ Info manual."
(variables rest ...)))))) (variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir))) (variables %localstatedir %storedir %sysconfdir)))
(define* (make-config.scm #:key zlib gzip xz bzip2 (define* (make-config.scm #:key zlib lzlib gzip xz bzip2
(package-name "GNU Guix") (package-name "GNU Guix")
(package-version "0") (package-version "0")
(bug-report-address "bug-guix@gnu.org") (bug-report-address "bug-guix@gnu.org")
@ -919,7 +936,7 @@ Info manual."
%store-database-directory %store-database-directory
%config-directory %config-directory
%libz %libz
;; TODO: %liblz %liblz
%gzip %gzip
%bzip2 %bzip2
%xz)) %xz))
@ -966,7 +983,11 @@ Info manual."
(define %libz (define %libz
#+(and zlib #+(and zlib
(file-append zlib "/lib/libz")))) (file-append zlib "/lib/libz")))
(define %liblz
#+(and lzlib
(file-append lzlib "/lib/liblz"))))
;; Guile 2.0 *requires* the 'define-module' to be at the ;; Guile 2.0 *requires* the 'define-module' to be at the
;; top-level or the 'toplevel-ref' in the resulting .go file are ;; top-level or the 'toplevel-ref' in the resulting .go file are

2
guix/store.scm
View File

@ -980,7 +980,7 @@ store directory (/gnu/store)."
store-path))) store-path)))
(lambda (server hash-part) (lambda (server hash-part)
"Return the store path whose hash part is HASH-PART (a nix-base32 "Return the store path whose hash part is HASH-PART (a nix-base32
string). Raise an error if no such path exists." string). Return the empty string if no such path exists."
;; This RPC is primarily used by Hydra to reply to HTTP GETs of ;; This RPC is primarily used by Hydra to reply to HTTP GETs of
;; /HASH.narinfo. ;; /HASH.narinfo.
(query-path-from-hash-part server hash-part)))) (query-path-from-hash-part server hash-part))))

1
guix/tests.scm
View File

@ -33,6 +33,7 @@
#:use-module (web uri) #:use-module (web uri)
#:export (open-connection-for-tests #:export (open-connection-for-tests
with-external-store with-external-store
%seed
random-text random-text
random-bytevector random-bytevector
file=? file=?

27
guix/utils.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@ -169,6 +169,17 @@ buffered data is lost."
(close-port out) (close-port out)
(loop in (cons child pids))))))))) (loop in (cons child pids)))))))))
(define (lzip-port proc port . args)
"Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
Raise an error if lzlib support is missing."
(let* ((lzlib (false-if-exception (resolve-interface '(guix lzlib))))
(supported? (and lzlib
((module-ref lzlib 'lzlib-available?)))))
(if supported?
(let ((make-port (module-ref lzlib proc)))
(values (make-port port) '()))
(error "lzip compression not supported" lzlib))))
(define (decompressed-port compression input) (define (decompressed-port compression input)
"Return an input port where INPUT is decompressed according to COMPRESSION, "Return an input port where INPUT is decompressed according to COMPRESSION,
a symbol such as 'xz." a symbol such as 'xz."
@ -177,17 +188,21 @@ a symbol such as 'xz."
('bzip2 (filtered-port `(,%bzip2 "-dc") input)) ('bzip2 (filtered-port `(,%bzip2 "-dc") input))
('xz (filtered-port `(,%xz "-dc") input)) ('xz (filtered-port `(,%xz "-dc") input))
('gzip (filtered-port `(,%gzip "-dc") input)) ('gzip (filtered-port `(,%gzip "-dc") input))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-input-port input)
'()))
(_ (error "unsupported compression scheme" compression))))
(define (compressed-port compression input) (define (compressed-port compression input)
"Return an input port where INPUT is decompressed according to COMPRESSION, "Return an input port where INPUT is compressed according to COMPRESSION,
a symbol such as 'xz." a symbol such as 'xz."
(match compression (match compression
((or #f 'none) (values input '())) ((or #f 'none) (values input '()))
('bzip2 (filtered-port `(,%bzip2 "-c") input)) ('bzip2 (filtered-port `(,%bzip2 "-c") input))
('xz (filtered-port `(,%xz "-c") input)) ('xz (filtered-port `(,%xz "-c") input))
('gzip (filtered-port `(,%gzip "-c") input)) ('gzip (filtered-port `(,%gzip "-c") input))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-input-port/compressed input)
'()))
(_ (error "unsupported compression scheme" compression))))
(define (call-with-decompressed-port compression port proc) (define (call-with-decompressed-port compression port proc)
"Call PROC with a wrapper around PORT, a file port, that decompresses data "Call PROC with a wrapper around PORT, a file port, that decompresses data
@ -244,7 +259,9 @@ program--e.g., '(\"--fast\")."
('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output)) ('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output))
('xz (filtered-output-port `(,%xz "-c" ,@options) output)) ('xz (filtered-output-port `(,%xz "-c" ,@options) output))
('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output))
(else (error "unsupported compression scheme" compression)))) ('lzip (values (lzip-port 'make-lzip-output-port output)
'()))
(_ (error "unsupported compression scheme" compression))))
(define* (call-with-compressed-output-port compression port proc (define* (call-with-compressed-output-port compression port proc
#:key (options '())) #:key (options '()))

14
tests/guix-package.sh
View File

@ -280,6 +280,20 @@ export GUIX_PACKAGE_PATH
guix package -A emacs-foo-bar | grep 42 guix package -A emacs-foo-bar | grep 42
guix package -i emacs-foo-bar@42 -n guix package -i emacs-foo-bar@42 -n
# Make sure GUIX_PACKAGE_PATH/'-L' takes precedence in case of duplicate packages.
cat > "$module_dir/bar.scm"<<EOF
(define-module (bar)
#:use-module (guix packages))
(define-public hello
(package (inherit (@@ (gnu packages base) hello))
(synopsis "an overridden version of GNU hello")))
EOF
guix package -i hello -n 2>&1 | grep choosing.*bar.scm
( unset GUIX_PACKAGE_PATH; \
guix package -i hello -n -L "$module_dir" 2>&1 | grep choosing.*bar.scm )
# Make sure patches that live under $GUIX_PACKAGE_PATH are found. # Make sure patches that live under $GUIX_PACKAGE_PATH are found.
cat > "$module_dir/emacs.patch"<<EOF cat > "$module_dir/emacs.patch"<<EOF
This is a fake patch. This is a fake patch.

168
tests/hackage.scm
View File

@ -155,78 +155,142 @@ library
(test-begin "hackage") (test-begin "hackage")
(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '())) (define-syntax-rule (define-package-matcher name pattern)
(mock (define* (name obj)
((guix import hackage) hackage-fetch (match obj
(lambda (name-version) (pattern #t)
(call-with-input-string test-cabal (x (pk 'fail x #f)))))
read-cabal)))
(match (hackage->guix-package "foo" #:cabal-environment cabal-environment) (define-package-matcher match-ghc-foo
(('package ('package
('name "ghc-foo") ('name "ghc-foo")
('version "1.0.0") ('version "1.0.0")
('source ('source
('origin ('origin
('method 'url-fetch) ('method 'url-fetch)
('uri ('string-append ('uri ('string-append
"https://hackage.haskell.org/package/foo/foo-" "https://hackage.haskell.org/package/foo/foo-"
'version 'version
".tar.gz")) ".tar.gz"))
('sha256 ('sha256
('base32 ('base32
(? string? hash))))) (? string? hash)))))
('build-system 'haskell-build-system) ('build-system 'haskell-build-system)
('inputs ('inputs
('quasiquote ('quasiquote
(("ghc-http" ('unquote 'ghc-http)) (("ghc-http" ('unquote 'ghc-http)))))
("ghc-mtl" ('unquote 'ghc-mtl))))) ('home-page "http://test.org")
('home-page "http://test.org") ('synopsis (? string?))
('synopsis (? string?)) ('description (? string?))
('description (? string?)) ('license 'bsd-3)))
('license 'bsd-3))
#t) (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
(x (define port (open-input-string test-cabal))
(pk 'fail x #f))))) (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
(test-assert "hackage->guix-package test 1" (test-assert "hackage->guix-package test 1"
(eval-test-with-cabal test-cabal-1)) (eval-test-with-cabal test-cabal-1 match-ghc-foo))
(test-assert "hackage->guix-package test 2" (test-assert "hackage->guix-package test 2"
(eval-test-with-cabal test-cabal-2)) (eval-test-with-cabal test-cabal-2 match-ghc-foo))
(test-assert "hackage->guix-package test 3" (test-assert "hackage->guix-package test 3"
(eval-test-with-cabal test-cabal-3 (eval-test-with-cabal test-cabal-3 match-ghc-foo
#:cabal-environment '(("impl" . "ghc-7.8")))) #:cabal-environment '(("impl" . "ghc-7.8"))))
(test-assert "hackage->guix-package test 4" (test-assert "hackage->guix-package test 4"
(eval-test-with-cabal test-cabal-4 (eval-test-with-cabal test-cabal-4 match-ghc-foo
#:cabal-environment '(("impl" . "ghc-7.8")))) #:cabal-environment '(("impl" . "ghc-7.8"))))
(test-assert "hackage->guix-package test 5" (test-assert "hackage->guix-package test 5"
(eval-test-with-cabal test-cabal-5 (eval-test-with-cabal test-cabal-5 match-ghc-foo
#:cabal-environment '(("impl" . "ghc-7.8")))) #:cabal-environment '(("impl" . "ghc-7.8"))))
(define-package-matcher match-ghc-foo-6
('package
('name "ghc-foo")
('version "1.0.0")
('source
('origin
('method 'url-fetch)
('uri ('string-append
"https://hackage.haskell.org/package/foo/foo-"
'version
".tar.gz"))
('sha256
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
('inputs
('quasiquote
(("ghc-b" ('unquote 'ghc-b))
("ghc-http" ('unquote 'ghc-http)))))
('native-inputs
('quasiquote
(("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
('home-page "http://test.org")
('synopsis (? string?))
('description (? string?))
('license 'bsd-3)))
(test-assert "hackage->guix-package test 6" (test-assert "hackage->guix-package test 6"
(eval-test-with-cabal test-cabal-6 (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
#:cabal-environment '(("impl" . "ghc-7.8"))))
;; Check multi-line layouted description
(define test-cabal-multiline-layout
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: first line
second line
license: BSD3
executable cabal
build-depends:
HTTP >= 4000.2.5 && < 4000.3,
mtl >= 2.0 && < 3
")
(test-assert "hackage->guix-package test multiline desc (layout)"
(eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
;; Check multi-line braced description
(define test-cabal-multiline-braced
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: {
first line
second line
}
license: BSD3
executable cabal
build-depends:
HTTP >= 4000.2.5 && < 4000.3,
mtl >= 2.0 && < 3
")
(test-assert "hackage->guix-package test multiline desc (braced)"
(eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
(test-assert "read-cabal test 1" (test-assert "read-cabal test 1"
(match (call-with-input-string test-read-cabal-1 read-cabal) (match (call-with-input-string test-read-cabal-1 read-cabal)
((("name" ("test-me")) ((("name" ("test-me"))
('section 'library ('section 'library
(('if ('flag "base4point8") (('if ('flag "base4point8")
(("build-depends" ("base >= 4.8 && < 5"))) (("build-depends" ("base >= 4.8 && < 5")))
(('if ('flag "base4") (('if ('flag "base4")
(("build-depends" ("base >= 4 && < 4.8"))) (("build-depends" ("base >= 4 && < 4.8")))
(('if ('flag "base3") (('if ('flag "base3")
(("build-depends" ("base >= 3 && < 4"))) (("build-depends" ("base >= 3 && < 4")))
(("build-depends" ("base < 3")))))))) (("build-depends" ("base < 3"))))))))
('if ('or ('flag "base4point8") ('if ('or ('flag "base4point8")
('and ('flag "base4") ('flag "base3"))) ('and ('flag "base4") ('flag "base3")))
(("build-depends" ("random"))) (("build-depends" ("random")))
()) ())
("build-depends" ("containers")) ("build-depends" ("containers"))
("exposed-modules" ("Test.QuickCheck.Exception"))))) ("exposed-modules" ("Test.QuickCheck.Exception")))))
#t) #t)
(x (pk 'fail x #f)))) (x (pk 'fail x #f))))

10
tests/lzlib.scm
View File

@ -108,4 +108,14 @@
(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)" (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
(compress-and-decompress (random-bytevector (1+ (* 1024 1024))))) (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
(test-assert "make-lzip-input-port/compressed"
(let* ((len (pk 'len (+ 10 (random 4000 %seed))))
(data (random-bytevector len))
(compressed (make-lzip-input-port/compressed
(open-bytevector-input-port data)))
(result (call-with-lzip-input-port compressed
get-bytevector-all)))
(pk (bytevector-length result) (bytevector-length data))
(bytevector=? result data)))
(test-end) (test-end)

154
tests/publish.scm
View File

@ -36,6 +36,7 @@
#:use-module (gcrypt pk-crypto) #:use-module (gcrypt pk-crypto)
#:use-module ((guix pki) #:select (%public-key-file %private-key-file)) #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
#:use-module (guix zlib) #:use-module (guix zlib)
#:use-module (guix lzlib)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web client) #:use-module (web client)
#:use-module (web response) #:use-module (web response)
@ -137,17 +138,17 @@
"StorePath: ~a "StorePath: ~a
URL: nar/~a URL: nar/~a
Compression: none Compression: none
FileSize: ~a
NarHash: sha256:~a NarHash: sha256:~a
NarSize: ~d NarSize: ~d
References: ~a References: ~a~%"
FileSize: ~a~%"
%item %item
(basename %item) (basename %item)
(path-info-nar-size info)
(bytevector->nix-base32-string (bytevector->nix-base32-string
(path-info-hash info)) (path-info-hash info))
(path-info-nar-size info) (path-info-nar-size info)
(basename (first (path-info-references info))) (basename (first (path-info-references info)))))
(path-info-nar-size info)))
(signature (base64-encode (signature (base64-encode
(string->utf8 (string->utf8
(canonical-sexp->string (canonical-sexp->string
@ -169,15 +170,15 @@ FileSize: ~a~%"
"StorePath: ~a "StorePath: ~a
URL: nar/~a URL: nar/~a
Compression: none Compression: none
FileSize: ~a
NarHash: sha256:~a NarHash: sha256:~a
NarSize: ~d NarSize: ~d
References: ~%\ References: ~%"
FileSize: ~a~%"
item item
(uri-encode (basename item)) (uri-encode (basename item))
(path-info-nar-size info)
(bytevector->nix-base32-string (bytevector->nix-base32-string
(path-info-hash info)) (path-info-hash info))
(path-info-nar-size info)
(path-info-nar-size info))) (path-info-nar-size info)))
(signature (base64-encode (signature (base64-encode
(string->utf8 (string->utf8
@ -229,6 +230,19 @@ FileSize: ~a~%"
(string-append "/nar/gzip/" (basename %item)))))) (string-append "/nar/gzip/" (basename %item))))))
(get-bytevector-n nar (bytevector-length %gzip-magic-bytes)))) (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
(unless (lzlib-available?)
(test-skip 1))
(test-equal "/nar/lzip/*"
"bar"
(call-with-temporary-output-file
(lambda (temp port)
(let ((nar (http-get-port
(publish-uri
(string-append "/nar/lzip/" (basename %item))))))
(call-with-lzip-input-port nar
(cut restore-file <> temp)))
(call-with-input-file temp read-string))))
(unless (zlib-available?) (unless (zlib-available?)
(test-skip 1)) (test-skip 1))
(test-equal "/*.narinfo with compression" (test-equal "/*.narinfo with compression"
@ -251,6 +265,28 @@ FileSize: ~a~%"
(_ #f))) (_ #f)))
(recutils->alist body))))) (recutils->alist body)))))
(unless (lzlib-available?)
(test-skip 1))
(test-equal "/*.narinfo with lzip compression"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
(guix-publish "--port=6790" "-Clzip"))))))
(wait-until-ready 6790)
(let* ((url (string-append "http://localhost:6790/"
(store-path-hash-part %item) ".narinfo"))
(body (http-get-port url)))
(filter (lambda (item)
(match item
(("Compression" . _) #t)
(("StorePath" . _) #t)
(("URL" . _) #t)
(_ #f)))
(recutils->alist body)))))
(unless (zlib-available?) (unless (zlib-available?)
(test-skip 1)) (test-skip 1))
(test-equal "/*.narinfo for a compressed file" (test-equal "/*.narinfo for a compressed file"
@ -265,6 +301,35 @@ FileSize: ~a~%"
(list (assoc-ref info "Compression") (list (assoc-ref info "Compression")
(dirname (assoc-ref info "URL"))))) (dirname (assoc-ref info "URL")))))
(unless (and (zlib-available?) (lzlib-available?))
(test-skip 1))
(test-equal "/*.narinfo with lzip + gzip"
`((("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
("Compression" . "gzip")
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
200
200)
(call-with-temporary-directory
(lambda (cache)
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
(guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
(wait-until-ready 6793)
(let* ((base "http://localhost:6793/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(body (http-get-port url)))
(list (take (recutils->alist body) 5)
(response-code
(http-get (string-append base "nar/gzip/"
(basename %item))))
(response-code
(http-get (string-append base "nar/lzip/"
(basename %item))))))))))
(test-equal "custom nar path" (test-equal "custom nar path"
;; Serve nars at /foo/bar/chbouib instead of /nar. ;; Serve nars at /foo/bar/chbouib instead of /nar.
(list `(("StorePath" . ,%item) (list `(("StorePath" . ,%item)
@ -405,6 +470,52 @@ FileSize: ~a~%"
(stat:size (stat nar))) (stat:size (stat nar)))
(response-code uncompressed))))))))) (response-code uncompressed)))))))))
(unless (and (zlib-available?) (lzlib-available?))
(test-skip 1))
(test-equal "with cache, lzip + gzip"
'(200 200 404)
(call-with-temporary-directory
(lambda (cache)
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
(guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
(string-append "--cache=" cache)))))))
(wait-until-ready 6794)
(let* ((base "http://localhost:6794/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(nar-url (cute string-append "nar/" <> "/"
(basename %item)))
(cached (cute string-append cache "/" <> "/"
(basename %item) ".narinfo"))
(nar (cute string-append cache "/" <> "/"
(basename %item) ".nar"))
(response (http-get url)))
(wait-for-file (cached "gzip"))
(let* ((body (http-get-port url))
(narinfo (recutils->alist body))
(uncompressed (string-append base "nar/"
(basename %item))))
(and (file-exists? (nar "gzip"))
(file-exists? (nar "lzip"))
(equal? (take (pk 'narinfo/gzip+lzip narinfo) 7)
`(("StorePath" . ,%item)
("URL" . ,(nar-url "gzip"))
("Compression" . "gzip")
("FileSize" . ,(number->string
(stat:size (stat (nar "gzip")))))
("URL" . ,(nar-url "lzip"))
("Compression" . "lzip")
("FileSize" . ,(number->string
(stat:size (stat (nar "lzip")))))))
(list (response-code
(http-get (string-append base (nar-url "gzip"))))
(response-code
(http-get (string-append base (nar-url "lzip"))))
(response-code
(http-get uncompressed))))))))))
(unless (zlib-available?) (unless (zlib-available?)
(test-skip 1)) (test-skip 1))
(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz" (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
@ -469,6 +580,35 @@ FileSize: ~a~%"
(assoc-ref narinfo "FileSize")) (assoc-ref narinfo "FileSize"))
(response-code compressed)))))))))) (response-code compressed))))))))))
(test-equal "with cache, vanishing item" ;<https://bugs.gnu.org/33897>
200
(call-with-temporary-directory
(lambda (cache)
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
(guix-publish "--port=6795"
(string-append "--cache=" cache)))))))
(wait-until-ready 6795)
;; Make sure that, even if ITEM disappears, we're still able to fetch
;; it.
(let* ((base "http://localhost:6795/")
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
(url (string-append base part ".narinfo"))
(cached (string-append cache
(if (zlib-available?)
"/gzip/" "/none/")
(basename item)
".narinfo"))
(response (http-get url)))
(and (= 404 (response-code response))
(wait-for-file cached)
(begin
(delete-paths %store (list item))
(response-code (pk 'response (http-get url))))))))))
(test-equal "/log/NAME" (test-equal "/log/NAME"
`(200 #t application/x-bzip2) `(200 #t application/x-bzip2)
(let ((drv (run-with-store %store (let ((drv (run-with-store %store

51
tests/substitute.scm
View File

@ -28,8 +28,10 @@
#:use-module (guix base32) #:use-module (guix base32)
#:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix store) #:select (%store-prefix))
#:use-module ((guix ui) #:select (guix-warning-port)) #:use-module ((guix ui) #:select (guix-warning-port))
#:use-module ((guix utils) #:select (call-with-compressed-output-port))
#:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (mkdir-p delete-file-recursively)) #:select (mkdir-p delete-file-recursively dump-port))
#:use-module (guix tests http) #:use-module (guix tests http)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
@ -475,6 +477,53 @@ System: mips64el-linux\n")
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"substitute-retrieved")))) "substitute-retrieved"))))
(test-equal "substitute, narinfo with several URLs"
"Substitutable data."
(let ((narinfo (string-append "StorePath: " (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
URL: example.nar.gz
Compression: gzip
URL: example.nar.lz
Compression: lzip
URL: example.nar
Compression: none
NarHash: sha256:" (bytevector->nix-base32-string
(sha256 (string->utf8 "Substitutable data."))) "
NarSize: 42
References: bar baz
Deriver: " (%store-prefix) "/foo.drv
System: mips64el-linux\n")))
(with-narinfo (string-append narinfo "Signature: "
(signature-field narinfo))
(dynamic-wind
(const #t)
(lambda ()
(define (compress input output compression)
(call-with-output-file output
(lambda (port)
(call-with-compressed-output-port compression port
(lambda (port)
(call-with-input-file input
(lambda (input)
(dump-port input port))))))))
(let ((nar (string-append %main-substitute-directory
"/example.nar")))
(compress nar (string-append nar ".gz") 'gzip)
(when (lzlib-available?)
(compress nar (string-append nar ".lz") 'lzip)))
(parameterize ((substitute-urls
(list (string-append "file://"
%main-substitute-directory))))
(guix-substitute "--substitute"
(string-append (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
(test-end "substitute") (test-end "substitute")
;;; Local Variables: ;;; Local Variables:

64
tests/utils.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
@ -23,6 +23,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix store) #:select (%store-prefix store-path-package-name)) #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
#:use-module ((guix search-paths) #:select (string-tokenize*)) #:use-module ((guix search-paths) #:select (string-tokenize*))
#:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
@ -174,30 +175,47 @@
(any (compose (negate zero?) cdr waitpid) (any (compose (negate zero?) cdr waitpid)
pids)))) pids))))
(test-assert "compressed-port, decompressed-port, non-file" (define (test-compression/decompression method run?)
(let ((data (call-with-input-file (search-path %load-path "guix.scm") "Test METHOD, a symbol such as 'gzip. Call RUN? to determine whether to
get-bytevector-all))) skip these tests."
(let*-values (((compressed pids1) (unless (run?) (test-skip 1))
(compressed-port 'xz (open-bytevector-input-port data))) (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]"
((decompressed pids2) method)
(decompressed-port 'xz compressed))) (let ((data (call-with-input-file (search-path %load-path "guix.scm")
(and (every (compose zero? cdr waitpid) get-bytevector-all)))
(append pids1 pids2)) (let*-values (((compressed pids1)
(equal? (get-bytevector-all decompressed) data))))) (compressed-port method (open-bytevector-input-port data)))
((decompressed pids2)
(decompressed-port method compressed)))
(and (every (compose zero? cdr waitpid)
(pk 'pids method (append pids1 pids2)))
(let ((result (get-bytevector-all decompressed)))
(pk 'len method
(if (bytevector? result)
(bytevector-length result)
result)
(bytevector-length data))
(equal? result data))))))
(false-if-exception (delete-file temp-file)) (false-if-exception (delete-file temp-file))
(test-assert "compressed-output-port + decompressed-port" (unless (run?) (test-skip 1))
(let* ((file (search-path %load-path "guix/derivations.scm")) (test-assert (format #f "compressed-output-port + decompressed-port [~a]"
(data (call-with-input-file file get-bytevector-all)) method)
(port (open-file temp-file "w0b"))) (let* ((file (search-path %load-path "guix/derivations.scm"))
(call-with-compressed-output-port 'xz port (data (call-with-input-file file get-bytevector-all))
(lambda (compressed) (port (open-file temp-file "w0b")))
(put-bytevector compressed data))) (call-with-compressed-output-port method port
(close-port port) (lambda (compressed)
(put-bytevector compressed data)))
(close-port port)
(bytevector=? data (bytevector=? data
(call-with-decompressed-port 'xz (open-file temp-file "r0b") (call-with-decompressed-port method (open-file temp-file "r0b")
get-bytevector-all)))) get-bytevector-all)))))
(for-each test-compression/decompression
'(gzip xz lzip)
(list (const #t) (const #t) lzlib-available?))
;; This is actually in (guix store). ;; This is actually in (guix store).
(test-equal "store-path-package-name" (test-equal "store-path-package-name"