nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into staging

This commit is contained in:
Marius Bakke 2018-12-22 15:26:30 +01:00
parent 34f1838f04 25ec3684e3
commit f30830b2e6
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
113 changed files with 4004 additions and 1274 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -107,6 +107,7 @@ MODULES = \
guix/build-system/clojure.scm \
guix/build-system/cmake.scm \
guix/build-system/dub.scm \
guix/build-system/dune.scm \
guix/build-system/emacs.scm \
guix/build-system/font.scm \
guix/build-system/go.scm \
@ -144,6 +145,7 @@ MODULES = \
guix/build/cargo-build-system.scm \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/dune-build-system.scm \
guix/build/emacs-build-system.scm \
guix/build/meson-build-system.scm \
guix/build/minify-build-system.scm \

4
doc/contributing.texi
View File

@ -382,7 +382,9 @@ Take a look at the profile reported by @command{guix size}
(@pxref{Invoking guix size}). This will allow you to notice references
to other packages unwillingly retained. It may also help determine
whether to split the package (@pxref{Packages with Multiple Outputs}),
and which optional dependencies should be used.
and which optional dependencies should be used. In particular, avoid adding
@code{texlive} as a dependency: because of its extreme size, use
@code{texlive-tiny} or @code{texlive-union} instead.
@item
For important changes, check that dependent package (if applicable) are

366
doc/guix.texi
View File

@ -585,12 +585,12 @@ Info search path.)
@item
@cindex substitutes, authorization thereof
To use substitutes from @code{hydra.gnu.org} or one of its mirrors
To use substitutes from @code{@value{SUBSTITUTE-SERVER}} or one of its mirrors
(@pxref{Substitutes}), authorize them:
@example
# guix archive --authorize < \
~root/.config/guix/current/share/guix/hydra.gnu.org.pub
~root/.config/guix/current/share/guix/@value{SUBSTITUTE-SERVER}.pub
@end example
@item
@ -2120,7 +2120,8 @@ availability of packages:
@itemx -s @var{regexp}
@cindex searching for packages
List the available packages whose name, synopsis, or description matches
@var{regexp}, sorted by relevance. Print all the metadata of matching packages in
@var{regexp} (in a case-insensitive fashion), sorted by relevance.
Print all the metadata of matching packages in
@code{recutils} format (@pxref{Top, GNU recutils databases,, recutils,
GNU recutils manual}).
@ -3053,10 +3054,10 @@ The meta-data file should contain a simple S-expression like this:
(version 0)
(dependencies
(channel
(name 'some-collection)
(name some-collection)
(url "https://example.org/first-collection.git"))
(channel
(name 'some-other-collection)
(name some-other-collection)
(url "https://example.org/second-collection.git")
(branch "testing"))))
@end lisp
@ -4512,6 +4513,27 @@ debugging information''), which roughly means that code is compiled with
@code{-O2 -g}, as is the case for Autoconf-based packages by default.
@end defvr
@defvr {Scheme Variable} dune-build-system
This variable is exported by @code{(guix build-system dune)}. It
supports builds of packages using @uref{https://dune.build/, Dune}, a build
tool for the OCaml programming language. It is implemented as an extension
of the @code{ocaml-build-system} which is described below. As such, the
@code{#:ocaml} and @code{#:findlib} parameters can be passed to this build
system.
It automatically adds the @code{dune} package to the set of inputs.
Which package is used can be specified with the @code{#:dune}
parameter.
There is no @code{configure} phase because dune packages typically don't
need to be configured. The @code{#:build-flags} parameter is taken as a
list of flags passed to the @code{dune} command during the build.
The @code{#:jbuild?} parameter can be passed to use the @code{jbuild}
command instead of the more recent @code{dune} command while building
a package. Its default value is @code{#f}.
@end defvr
@defvr {Scheme Variable} go-build-system
This variable is exported by @code{(guix build-system go)}. It
implements a build procedure for Go packages using the standard
@ -8350,7 +8372,8 @@ guix environment --container --share=$HOME=/exchange --ad-hoc guile -- guile
@command{guix environment}
also supports all of the common build options that @command{guix
build} supports (@pxref{Common Build Options}).
build} supports (@pxref{Common Build Options}) as well as package
transformation options (@pxref{Package Transformation Options}).
@node Invoking guix publish
@ -11308,6 +11331,7 @@ Run @var{udev}, which populates the @file{/dev} directory dynamically.
udev rules can be provided as a list of files through the @var{rules}
variable. The procedures @var{udev-rule} and @var{file->udev-rule} from
@code{(gnu services base)} simplify the creation of such rule files.
@end deffn
@deffn {Scheme Procedure} udev-rule [@var{file-name} @var{contents}]
Return a udev-rule file named @var{file-name} containing the rules
@ -11325,6 +11349,9 @@ upon detecting a USB device with a given product identifier.
"ATTR@{product@}==\"Example\", "
"RUN+=\"/path/to/script\"")))
@end example
The @command{herd rules udev} command, as root, returns the name of the
directory containing all the active udev rules.
@end deffn
Here we show how the default @var{udev-service} can be extended with it.
@ -11406,7 +11433,6 @@ well as in the @var{groups} field of the @var{operating-system} record.
(rules (cons* android-udev-rules
(udev-configuration-rules config))))))))
@end example
@end deffn
@defvr {Scheme Variable} urandom-seed-service-type
Save some entropy in @var{%random-seed-file} to seed @file{/dev/urandom}
@ -16698,6 +16724,325 @@ Bind the web interface to the specified address.
@end table
@end deftp
@subsubheading Zabbix server
@cindex zabbix zabbix-server
Zabbix provides monitoring metrics, among others network utilization, CPU load
and disk space consumption:
@itemize
@item High performance, high capacity (able to monitor hundreds of thousands of devices).
@item Auto-discovery of servers and network devices and interfaces.
@item Low-level discovery, allows to automatically start monitoring new items, file systems or network interfaces among others.
@item Distributed monitoring with centralized web administration.
@item Native high performance agents.
@item SLA, and ITIL KPI metrics on reporting.
@item High-level (business) view of monitored resources through user-defined visual console screens and dashboards.
@item Remote command execution through Zabbix proxies.
@end itemize
@c %start of fragment
Available @code{zabbix-server-configuration} fields are:
@deftypevr {@code{zabbix-server-configuration} parameter} package zabbix-server
The zabbix-server package.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string user
User who will run the Zabbix server.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} group group
Group who will run the Zabbix server.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string db-host
Database host name.
Defaults to @samp{"127.0.0.1"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string db-name
Database name.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string db-user
Database user.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string db-password
Database password. Please, use @code{include-files} with
@code{DBPassword=SECRET} inside a specified file instead.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} number db-port
Database port.
Defaults to @samp{5432}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string log-type
Specifies where log messages are written to:
@itemize @bullet
@item
@code{system} - syslog.
@item
@code{file} - file specified with @code{log-file} parameter.
@item
@code{console} - standard output.
@end itemize
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string log-file
Log file name for @code{log-type} @code{file} parameter.
Defaults to @samp{"/var/log/zabbix/server.log"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string pid-file
Name of PID file.
Defaults to @samp{"/var/run/zabbix/zabbix_server.pid"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string ssl-ca-location
The location of certificate authority (CA) files for SSL server
certificate verification.
Defaults to @samp{"/etc/ssl/certs/ca-certificates.crt"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string ssl-cert-location
Location of SSL client certificates.
Defaults to @samp{"/etc/ssl/certs"}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} string extra-options
Extra options will be appended to Zabbix server configuration file.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-server-configuration} parameter} include-files include-files
You may include individual files or all files in a directory in the
configuration file.
Defaults to @samp{()}.
@end deftypevr
@c %end of fragment
@subsubheading Zabbix agent
@cindex zabbix zabbix-agent
Zabbix agent gathers information for Zabbix server.
@c %start of fragment
Available @code{zabbix-agent-configuration} fields are:
@deftypevr {@code{zabbix-agent-configuration} parameter} package zabbix-agent
The zabbix-agent package.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string user
User who will run the Zabbix agent.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} group group
Group who will run the Zabbix agent.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string hostname
Unique, case sensitive hostname which is required for active checks and
must match hostname as configured on the server.
Defaults to @samp{"Zabbix server"}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string log-type
Specifies where log messages are written to:
@itemize @bullet
@item
@code{system} - syslog.
@item
@code{file} - file specified with @code{log-file} parameter.
@item
@code{console} - standard output.
@end itemize
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string log-file
Log file name for @code{log-type} @code{file} parameter.
Defaults to @samp{"/var/log/zabbix/agent.log"}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string pid-file
Name of PID file.
Defaults to @samp{"/var/run/zabbix/zabbix_agent.pid"}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} list server
List of IP addresses, optionally in CIDR notation, or hostnames of
Zabbix servers and Zabbix proxies. Incoming connections will be
accepted only from the hosts listed here.
Defaults to @samp{("127.0.0.1")}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} list server-active
List of IP:port (or hostname:port) pairs of Zabbix servers and Zabbix
proxies for active checks. If port is not specified, default port is
used. If this parameter is not specified, active checks are disabled.
Defaults to @samp{("127.0.0.1")}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} string extra-options
Extra options will be appended to Zabbix server configuration file.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-agent-configuration} parameter} include-files include-files
You may include individual files or all files in a directory in the
configuration file.
Defaults to @samp{()}.
@end deftypevr
@c %end of fragment
@subsubheading Zabbix front-end
@cindex zabbix zabbix-front-end
This service provides a WEB interface to Zabbix server.
@c %start of fragment
Available @code{zabbix-front-end-configuration} fields are:
@deftypevr {@code{zabbix-front-end-configuration} parameter} nginx-server-configuration-list nginx
NGINX configuration.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string db-host
Database host name.
Defaults to @samp{"localhost"}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} number db-port
Database port.
Defaults to @samp{5432}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string db-name
Database name.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string db-user
Database user.
Defaults to @samp{"zabbix"}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string db-password
Database password. Please, use @code{db-secret-file} instead.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string db-secret-file
Secret file which will be appended to @file{zabbix.conf.php} file. This
file contains credentials for use by Zabbix front-end. You are expected
to create it manually.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} string zabbix-host
Zabbix server hostname.
Defaults to @samp{"localhost"}.
@end deftypevr
@deftypevr {@code{zabbix-front-end-configuration} parameter} number zabbix-port
Zabbix server port.
Defaults to @samp{10051}.
@end deftypevr
@c %end of fragment
@node Kerberos Services
@subsubsection Kerberos Services
@cindex Kerberos
@ -17450,6 +17795,8 @@ Determines whether php errors and warning should be sent to clients
and displayed in their browsers.
This is useful for local php development, but a security risk for public sites,
as error messages can reveal passwords and personal data.
@item @code{timezone} (default @code{#f})
Specifies @code{php_admin_value[date.timezone]} parameter.
@item @code{workers-logfile} (default @code{(string-append "/var/log/php" (version-major (package-version php)) "-fpm.www.log")})
This file will log the @code{stderr} outputs of php worker processes.
Can be set to @code{#f} to disable logging.
@ -17516,7 +17863,7 @@ A simple services setup for nginx with php can look like this:
(root "/srv/http/")
(locations
(list (nginx-php-location)))
(https-port #f)
(listen '("80"))
(ssl-certificate #f)
(ssl-certificate-key #f)))
%base-services))
@ -22664,6 +23011,9 @@ appear in the @code{operating-system} declaration actually exist
needed at boot time are listed in @code{initrd-modules} (@pxref{Initial
RAM Disk}). Passing this option skips these tests altogether.
@cindex on-error
@cindex on-error strategy
@cindex error strategy
@item --on-error=@var{strategy}
Apply @var{strategy} when an error occurs when reading @var{file}.
@var{strategy} may be one of the following:

2
etc/guix-install.sh
View File

@ -97,7 +97,7 @@ chk_require()
gpg --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || (
_err "${ERR}Missing OpenPGP public key. Fetch it with this command:"
echo " gpg --keyserver pgp.mit.edu --recv-keys ${OPENPGP_SIGNING_KEY_ID}"
echo " gpg --keyserver pool.sks-keyservers.net --recv-keys ${OPENPGP_SIGNING_KEY_ID}"
exit 1
)
}

15
gnu/build/file-systems.scm
View File

@ -535,10 +535,19 @@ were found."
(sleep 3)
(reboot))
('fatal-error
(format (current-error-port)
"File system check on ~a failed; spawning Bourne-like REPL~%"
(format (current-error-port) "File system check on ~a failed~%"
device)
(start-repl %bournish-language)))
;; Spawn a REPL only if someone would be able to interact with it.
(when (isatty? (current-input-port))
(format (current-error-port) "Spawning Bourne-like REPL.~%")
;; 'current-output-port' is typically connected to /dev/klog (in
;; PID 1), but here we want to make sure we talk directly to the
;; user.
(with-output-to-file "/dev/console"
(lambda ()
(start-repl %bournish-language))))))
(format (current-error-port)
"No file system check procedure for ~a; skipping~%"
device)))

8
gnu/build/vm.scm
View File

@ -105,13 +105,7 @@ the #:references-graphs parameter of 'derivation'."
;; hardware virtualization to still use these commands. KVM support is
;; still buggy on some ARM32 boards. Do not use it even if available.
,@(if (and (file-exists? "/dev/kvm")
(not target-arm32?)
;; XXX: 32-bit 'qemu-system-i386 -enable-kvm' segfaults on
;; x86_64 hosts running Linux-libre 4.17:
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31380#18> and
;; <https://lists.gnu.org/archive/html/qemu-devel/2018-07/msg01166.html>.
(not (string-suffix? "-i386" qemu)))
(not target-arm32?))
'("-enable-kvm")
'())

7
gnu/local.mk
View File

@ -579,7 +579,6 @@ dist_patch_DATA = \
%D%/packages/patches/aegisub-boost68.patch \
%D%/packages/patches/agg-am_c_prototype.patch \
%D%/packages/patches/amule-crypto-6.patch \
%D%/packages/patches/ansible-wrap-program-hack.patch \
%D%/packages/patches/antiword-CVE-2014-8123.patch \
%D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch \
%D%/packages/patches/antlr3-3_3-fix-java8-compilation.patch \
@ -672,6 +671,7 @@ dist_patch_DATA = \
%D%/packages/patches/emacs-scheme-complete-scheme-r5rs-info.patch \
%D%/packages/patches/emacs-source-date-epoch.patch \
%D%/packages/patches/emacs-realgud-fix-configure-ac.patch \
%D%/packages/patches/emacs-wordnut-require-adaptive-wrap.patch \
%D%/packages/patches/enlightenment-fix-setuid-path.patch \
%D%/packages/patches/erlang-man-path.patch \
%D%/packages/patches/eudev-rules-directory.patch \
@ -753,6 +753,7 @@ dist_patch_DATA = \
%D%/packages/patches/glibc-allow-kernel-2.6.32.patch \
%D%/packages/patches/glibc-bootstrap-system.patch \
%D%/packages/patches/glibc-hidden-visibility-ldconfig.patch \
%D%/packages/patches/glibc-hurd-magic-pid.patch \
%D%/packages/patches/glibc-ldd-x86_64.patch \
%D%/packages/patches/glibc-locales.patch \
%D%/packages/patches/glibc-memchr-overflow-i686.patch \
@ -954,7 +955,6 @@ dist_patch_DATA = \
%D%/packages/patches/mcrypt-CVE-2012-4409.patch \
%D%/packages/patches/mcrypt-CVE-2012-4426.patch \
%D%/packages/patches/mcrypt-CVE-2012-4527.patch \
%D%/packages/patches/meandmyshadow-define-paths-earlier.patch \
%D%/packages/patches/mesa-skip-disk-cache-test.patch \
%D%/packages/patches/meson-for-build-rpath.patch \
%D%/packages/patches/metabat-fix-compilation.patch \
@ -1101,8 +1101,6 @@ dist_patch_DATA = \
%D%/packages/patches/python-unittest2-remove-argparse.patch \
%D%/packages/patches/python-waitress-fix-tests.patch \
%D%/packages/patches/qemu-glibc-2.27.patch \
%D%/packages/patches/qemu-CVE-2018-16847.patch \
%D%/packages/patches/qemu-CVE-2018-16867.patch \
%D%/packages/patches/qt4-ldflags.patch \
%D%/packages/patches/qtbase-use-TZDIR.patch \
%D%/packages/patches/qtscript-disable-tests.patch \
@ -1165,6 +1163,7 @@ dist_patch_DATA = \
%D%/packages/patches/swish-e-search.patch \
%D%/packages/patches/swish-e-format-security.patch \
%D%/packages/patches/synfigstudio-fix-ui-with-gtk3.patch \
%D%/packages/patches/stumpwm-fix-broken-read-one-line.patch \
%D%/packages/patches/t1lib-CVE-2010-2642.patch \
%D%/packages/patches/t1lib-CVE-2011-0764.patch \
%D%/packages/patches/t1lib-CVE-2011-1552+.patch \

86
gnu/packages/admin.scm
View File

@ -22,6 +22,7 @@
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1408,14 +1409,14 @@ recover lost partitions and/or make non-booting disks bootable again.")
(define-public tree
(package
(name "tree")
(version "1.7.0")
(version "1.8.0")
(source (origin
(method url-fetch)
(uri (string-append
"http://mama.indstate.edu/users/ice/tree/src/tree-"
version ".tgz"))
(sha256
(base32 "04kviw799qxly08zb8n5mgxfd96gyis6x69q2qiw86jnh87c4mv9"))))
(base32 "1hmpz6k0mr6salv0nprvm1g0rdjva1kx03bdf1scw8a38d5mspbi"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases (delete 'configure))
@ -1600,15 +1601,14 @@ of supported upstream metrics systems simultaneously.")
(define-public ansible
(package
(name "ansible")
(version "2.7.4")
(version "2.7.5")
(source
(origin
(method url-fetch)
(uri (pypi-uri "ansible" version))
(sha256
(base32
"0p1n6yyc632522fl2r247p0jg4mncc7z4hqngzbh1zxq3dcb12s9"))
(patches (search-patches "ansible-wrap-program-hack.patch"))))
"1fsif2jmkrrgiawsd8r6sxrqvh01fvrmdhas0p540a6i9fby3yda"))))
(build-system python-build-system)
(native-inputs
`(("python-bcrypt" ,python-bcrypt)
@ -1625,6 +1625,42 @@ of supported upstream metrics systems simultaneously.")
("python-jinja2" ,python-jinja2)
("python-pyyaml" ,python-pyyaml)
("python-paramiko" ,python-paramiko)))
(arguments
`(#:phases
(modify-phases %standard-phases
;; Several ansible commands (ansible-config, ansible-console, etc.)
;; are just symlinks to a single ansible executable. The ansible
;; executable behaves differently based on the value of
;; sys.argv[0]. This does not work well with our wrap phase, and
;; therefore the following two phases are required as a workaround.
(add-after 'unpack 'hide-wrapping
(lambda _
;; Overwrite sys.argv[0] to hide the wrapper script from it.
(substitute* "bin/ansible"
(("import traceback" all)
(string-append all "
import re
sys.argv[0] = re.sub(r'\\.([^/]*)-real$', r'\\1', sys.argv[0])
")))
#t))
(add-after 'wrap 'fix-symlinks
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(for-each
(lambda (subprogram)
;; The symlinks point to the ansible wrapper script. Make
;; them point to the real executable (.ansible-real).
(delete-file (string-append out "/bin/.ansible-" subprogram "-real"))
(symlink (string-append out "/bin/.ansible-real")
(string-append out "/bin/.ansible-" subprogram "-real"))
;; The wrapper scripts of the symlinks invoke the ansible
;; wrapper script. Fix them to invoke the correct executable.
(substitute* (string-append out "/bin/ansible-" subprogram)
(("/bin/ansible")
(string-append "/bin/.ansible-" subprogram "-real"))))
(list "config" "console" "doc" "galaxy"
"inventory" "playbook" "pull" "vault")))
#t)))))
(home-page "https://www.ansible.com/")
(synopsis "Radically simple IT automation")
(description "Ansible is a radically simple IT automation system. It
@ -1886,7 +1922,7 @@ done with the @code{auditctl} utility.")
;; TODO Add zenmap output.
(outputs '("out" "ndiff"))
(arguments
'(#:configure-flags '("--without-zenmap")
`(#:configure-flags '("--without-zenmap")
#:phases
(modify-phases %standard-phases
(add-after 'configure 'patch-Makefile
@ -1902,7 +1938,10 @@ done with the @code{auditctl} utility.")
(string-append "prefix=" out)
args))
(define (python-path dir)
(string-append dir "/lib/python2.7/site-packages"))
(string-append dir "/lib/python"
,(version-major+minor
(package-version python))
"/site-packages"))
(let ((out (assoc-ref outputs "out"))
(ndiff (assoc-ref outputs "ndiff")))
(for-each mkdir-p (list out ndiff))
@ -2953,3 +2992,36 @@ security defenses and provide tips for further system hardening. It will also
scan for general system information, vulnerable software packages, and
possible configuration issues.")
(license license:gpl3+)))
(define-public ngrep
(package
(name "ngrep")
(version "1.47")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/jpr5/ngrep/")
(commit (string-append "V" (string-replace-substring version "." "_")))))
(file-name (git-file-name name version))
(sha256
(base32
"1x2fyd7wdqlj1r76ilal06cl2wmbz0ws6i3ys204sbjh1cj6dcl7"))))
(build-system gnu-build-system)
(inputs
`(("libpcap" ,libpcap)))
(arguments
`(#:tests? #f ;; No tests.
#:configure-flags (list (string-append "--with-pcap-includes="
(assoc-ref %build-inputs "libpcap")
"/include/pcap"))))
(home-page "https://github.com/jpr5/ngrep/")
(synopsis "Grep-like utility to search for network packets on an interface")
(description "@command{ngrep} is like GNU grep applied to the network
layer. It's a PCAP-based tool that allows you to specify an extended regular
or hexadecimal expression to match against data payloads of packets. It
understands many kinds of protocols, including IPv4/6, TCP, UDP, ICMPv4/6,
IGMP and Raw, across a wide variety of interface types, and understands BPF
filter logic in the same fashion as more common packet sniffing tools, such as
tcpdump and snoop.")
(license license:bsd-3)))

16
gnu/packages/base.scm
View File

@ -681,6 +681,18 @@ store.")
#:tests? #f ; XXX
#:phases (modify-phases %standard-phases
,@(if (hurd-target?)
`((add-after 'unpack 'apply-hurd-patch
(lambda* (#:key inputs native-inputs
#:allow-other-keys)
;; TODO: Move this to 'patches' field.
(let ((patch (or (assoc-ref native-inputs
"hurd-magic-pid-patch")
(assoc-ref inputs
"hurd-magic-pid-patch"))))
(invoke "patch" "-p1" "--force" "--input"
patch)))))
'())
(add-before
'configure 'pre-configure
(lambda* (#:key inputs native-inputs outputs
@ -806,7 +818,9 @@ store.")
,@(if (hurd-target?)
`(("mig" ,mig)
("perl" ,perl))
("perl" ,perl)
("hurd-magic-pid-patch"
,(search-patch "glibc-hurd-magic-pid.patch")))
'())))
(native-search-paths

21
gnu/packages/bioinformatics.scm
View File

@ -2298,6 +2298,22 @@ data and settings.")
("cairo" ,cairo)))
(native-inputs
`(("texlive" ,texlive)
;; TODO: Replace texlive with minimal texlive-union.
;; ("texlive" ,(texlive-union (list texlive-latex-doi
;; texlive-latex-hyperref
;; texlive-latex-oberdiek
;; texlive-generic-ifxetex
;; texlive-latex-url
;; texlive-latex-pgf
;; texlive-latex-examplep
;; texlive-latex-natbib
;; texlive-latex-verbatimbox
;; texlive-latex-ms
;; texlive-latex-xcolor
;; texlive-fonts-amsfonts
;; texlive-latex-amsfonts
;; ;; ...
;; )))
("imagemagick" ,imagemagick)))
(home-page "http://dorina.mdc-berlin.de/public/rajewsky/discrover/")
(synopsis "Discover discriminative nucleotide sequence motifs")
@ -11390,7 +11406,10 @@ remove biased methylation positions for RRBS sequence files.")
(out (assoc-ref outputs "out"))
(bin (string-append out "/bin/"))
(target (string-append
out "/lib/python2.7/site-packages/gess/")))
out "/lib/python"
,(version-major+minor
(package-version python))
"/site-packages/gess/")))
(mkdir-p target)
(copy-recursively "." target)
;; Make GESS.py executable

3
gnu/packages/cdrom.scm
View File

@ -558,7 +558,8 @@ from an audio CD.")
(for-each wrap
(find-files (string-append out "/bin")
".*"))))))
".*")))
#t)))
#:tests? #f)) ; no test target
(inputs `(("wget" ,wget)

64
gnu/packages/check.scm
View File

@ -210,12 +210,14 @@ multi-paradigm automated test framework for C++ and Objective-C.")
(version "1.12.2")
(home-page "https://github.com/catchorg/Catch2")
(source (origin
(method url-fetch)
(uri (string-append home-page "/archive/v" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/catchorg/Catch2")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0g2ysxc6adqca5wh7nsicnxb9wkxg75cd5izjsl39rcj0v903gr7"))
(file-name (string-append name "-" version ".tar.gz"))))
"1gdp5wm8khn02g2miz381llw3191k7309qj8s3jd6sasj01rhf23"))))
(build-system cmake-build-system)
(synopsis "Automated test framework for C++ and Objective-C")
(description "Catch2 stands for C++ Automated Test Cases in Headers and is
@ -294,15 +296,18 @@ format.")
(define-public cppcheck
(package
(name "cppcheck")
(version "1.85")
(version "1.86")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/danmar/cppcheck/archive/"
version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/danmar/cppcheck")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "18qlddf1i9bk5nnvy1v2nfxjd46y8wvp3rqz2hrfxjxsyvrfq5yw"))
(file-name (string-append name "-" version ".tar.gz"))))
(base32 "0jr4aah72c7wy94a8vlj3k050rx6pmc7m9nvmll1jwbscxj5f7ff"))))
(build-system cmake-build-system)
(arguments
'(#:configure-flags '("-DBUILD_TESTS=ON")))
(home-page "http://cppcheck.sourceforge.net")
(synopsis "Static C/C++ code analyzer")
(description "Cppcheck is a static code analyzer for C and C++. Unlike
@ -1249,13 +1254,14 @@ C/C++, R, and more, and uploads it to the @code{codecov.io} service.")
(version "0.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/jupyter/testpath/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/jupyter/testpath")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"04kh3fgvmqz6cfcw79q70qwjz7ib7lxm27cc548iy2rpr33qqf55"))))
"0r4iiizjql6ny1ln7ciw7rrbjadz1s9zrf2hl0xkgnh3ypd8936f"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; this package does not even have a setup.py
@ -2060,17 +2066,15 @@ retried.")
(name "python-pyhamcrest")
(version "1.9.0")
(source (origin
(method url-fetch)
(uri
(string-append
"https://github.com/hamcrest/PyHamcrest/archive/V"
version
".tar.gz"))
(file-name
(string-append name "-" version ".tar.gz"))
;; Tests not distributed from pypi release.
(method git-fetch)
(uri (git-reference
(url "https://github.com/hamcrest/PyHamcrest")
(commit (string-append "V" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1lqjajhwf7x7igvvnj5p1cm31y9njy07qby94w18kl6zwbdjqrwy"))))
"01qnzj9qnzz0y78qa3ing24ssvszb0adw59xc4qqmdn5wryy606b"))))
(native-inputs ; All native inputs are for tests
`(("python-pytest-cov" ,python-pytest-cov)
("python-mock" ,python-mock)
@ -2094,13 +2098,13 @@ retried.")
(name "unittest-cpp")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/unittest-cpp/unittest-cpp/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/unittest-cpp/unittest-cpp")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1fgmna2la7z4pwwy2gd10gpgi2q1fk89npjfvkmzvhkxhyc231bl"))))
(base32 "0sxb3835nly1jxn071f59fwbdzmqi74j040r81fanxyw3s1azw0i"))))
(arguments
`(#:tests? #f)) ; It's run after build automatically.
(build-system cmake-build-system)

18
gnu/packages/chemistry.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2018 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +20,7 @@
(define-module (gnu packages chemistry)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix download)
#:use-module (gnu packages)
@ -55,7 +57,7 @@
"avogadro-boost148.patch"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f
`(#:tests? #f
#:configure-flags
(list "-DENABLE_GLSL=ON"
(string-append "-DPYTHON_LIBRARIES="
@ -63,7 +65,9 @@
"/lib")
(string-append "-DPYTHON_INCLUDE_DIRS="
(assoc-ref %build-inputs "python")
"/include/python2.7"))
"/include/python"
,(version-major+minor
(package-version python))))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-python-lib-path
@ -76,7 +80,10 @@
(("^.*OUTPUT_VARIABLE.*")
(string-append "set(PYTHON_LIB_PATH \""
(assoc-ref outputs "out")
"/lib/python2.7/site-packages\")")))
"/lib/python"
,(version-major+minor
(package-version python))
"/site-packages\")")))
#t))
(add-after 'install 'wrap-program
(lambda* (#:key inputs outputs #:allow-other-keys)
@ -85,7 +92,10 @@
(setenv "PYTHONPATH"
(string-append
(assoc-ref outputs "out")
"/lib/python2.7/site-packages:"
"/lib/python"
,(version-major+minor
(package-version python))
"/site-packages:"
(getenv "PYTHONPATH")))
(wrap-program (string-append out "/bin/avogadro")
`("PYTHONPATH" ":" prefix (,(getenv "PYTHONPATH")))))

35
gnu/packages/chez.scm
View File

@ -88,7 +88,8 @@
("zlib:static" ,zlib "static")
("stex" ,stex)))
(native-inputs
`(("texlive" ,texlive)
`(("texlive" ,(texlive-union (list texlive-latex-oberdiek
texlive-generic-epsf)))
("ghostscript" ,ghostscript)
("netpbm" ,netpbm)))
(native-search-paths
@ -278,7 +279,15 @@ and 32-bit PowerPC architectures.")
(build-system gnu-build-system)
(native-inputs
`(("chez-scheme" ,chez-scheme)
("texlive" ,texlive)))
("ghostscript" ,ghostscript)
("texlive" ,(texlive-union (list texlive-latex-oberdiek
texlive-generic-epsf
texlive-metapost
texlive-fonts-charter
texlive-generic-pdftex
texlive-context-base
texlive-fonts-cm
texlive-tex-plain)))))
(arguments
`(#:make-flags (list (string-append "PREFIX=" %output)
(string-append "DOCDIR=" %output "/share/doc/"
@ -288,6 +297,15 @@ and 32-bit PowerPC architectures.")
#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(add-before 'build 'set-HOME
(lambda _
;; FIXME: texlive-union does not find the built
;; metafonts, so it tries to generate them in HOME.
(setenv "HOME" "/tmp")
#t))
;; This package has a custom "bootstrap" script that
;; is meant to be run from the Makefile.
(delete 'bootstrap)
(replace 'configure
(lambda* _
(copy-file "config.mk.template" "config.mk")
@ -327,7 +345,7 @@ programming in Scheme.")
(native-inputs
`(("chez-scheme" ,chez-scheme)
("chez-web" ,chez-web)
("texlive" ,texlive)))
("texlive" ,(texlive-union (list texlive-generic-pdftex)))))
(arguments
`(#:tests? #f ; no tests
#:phases
@ -343,11 +361,16 @@ programming in Scheme.")
(string-append var chez-h)))
#t)))
(add-before 'build 'tangle
(lambda _
(lambda* (#:key inputs #:allow-other-keys)
(setenv "TEXINPUTS"
(string-append
(getcwd) ":"
(assoc-ref inputs "chez-web") "/share/texmf-local/tex/generic:"
":"))
;; just using "make" tries to build the .c files before
;; they are created.
(and (zero? (system* "make" "sockets"))
(zero? (system* "make")))))
(and (invoke "make" "sockets")
(invoke "make"))))
(replace 'build
(lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))

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

@ -454,6 +454,23 @@ XBINUTILS and the cross tool chain."
flags)))
((#:phases phases)
`(modify-phases ,phases
;; XXX: The hack below allows us to make sure the
;; 'apply-hurd-patch' phase gets added in the first
;; cross-libc, but does *not* get added twice subsequently
;; when cross-building another libc.
,@(if (and (hurd-triplet? target)
(not (hurd-target?)))
`((add-after 'unpack 'apply-hurd-patch
(lambda* (#:key inputs native-inputs
#:allow-other-keys)
;; TODO: Move this to 'patches' field.
(let ((patch (or (assoc-ref native-inputs
"hurd-magic-pid-patch")
(assoc-ref inputs
"hurd-magic-pid-patch"))))
(invoke "patch" "-p1" "--force" "--input"
patch)))))
'())
(add-before 'configure 'set-cross-kernel-headers-path
(lambda* (#:key inputs #:allow-other-keys)
(let* ((kernel (assoc-ref inputs "kernel-headers"))
@ -477,7 +494,9 @@ XBINUTILS and the cross tool chain."
,@(if (hurd-triplet? target)
`(("cross-mig"
,@(assoc-ref (package-native-inputs xheaders)
"cross-mig")))
"cross-mig"))
("hurd-magic-pid-patch"
,(search-patch "glibc-hurd-magic-pid.patch")))
'())
,@(package-inputs libc) ;FIXME: static-bash
,@(package-native-inputs libc)))))))

27
gnu/packages/databases.scm
View File

@ -24,7 +24,7 @@
;;; Copyright © 2017 Adriano Peluso <catonano@gmail.com>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017, 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017, 2018 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2017, 2018 Pierre Langlois <pierre.langlois@gmx.com>
@ -1184,6 +1184,7 @@ changes.")
(define-public sqlite
(package
(name "sqlite")
(replacement sqlite-3.26.0)
(version "3.24.0")
(source (origin
(method url-fetch)
@ -1220,9 +1221,29 @@ widely deployed SQL database engine in the world. The source code for SQLite
is in the public domain.")
(license license:public-domain)))
(define-public sqlite-3.26.0
(package (inherit sqlite)
(version "3.26.0")
(source (origin
(method url-fetch)
(uri (let ((numeric-version
(match (string-split version #\.)
((first-digit other-digits ...)
(string-append first-digit
(string-pad-right
(string-concatenate
(map (cut string-pad <> 2 #\0)
other-digits))
6 #\0))))))
(string-append "https://sqlite.org/2018/sqlite-autoconf-"
numeric-version ".tar.gz")))
(sha256
(base32
"0pdzszb4sp73hl36siiv3p300jvfvbcdxi2rrmkwgs6inwznmajx"))))))
;; This is used by Tracker.
(define-public sqlite-with-fts5
(package (inherit sqlite)
(package/inherit sqlite
(name "sqlite-with-fts5")
(arguments
(substitute-keyword-arguments (package-arguments sqlite)
@ -1231,7 +1252,7 @@ is in the public domain.")
;; This is used by Qt.
(define-public sqlite-with-column-metadata
(package (inherit sqlite)
(package/inherit sqlite
(name "sqlite-with-column-metadata")
(arguments
(substitute-keyword-arguments (package-arguments sqlite)

4
gnu/packages/education.scm
View File

@ -243,7 +243,7 @@ easy.")
(define-public snap
(package
(name "snap")
(version "4.2.2.2")
(version "4.2.2.9")
(source
(origin
(method git-fetch)
@ -253,7 +253,7 @@ easy.")
(file-name (git-file-name name version))
(sha256
(base32
"0bay08yr58qj8wzpjg33gdj78rfhyskfzidknpdl3cr1jrj6i4p9"))))
"07qyhh4f8gr1fqyvxa2i6lkzaaa0vl12yzllgp81rdil8z8bi976"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))

185
gnu/packages/emacs.scm
View File

@ -24,7 +24,7 @@
;;; Copyright © 2017, 2018 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2017 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2017 George Clemmer <myglc2@gmail.com>
;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017, 2018 Feng Shu <tumashu@163.com>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017 Mekeor Melire <mekeor.melire@gmail.com>
@ -1729,7 +1729,7 @@ and stored in memory.")
(define-public emacs-bui
(package
(name "emacs-bui")
(version "1.2.0")
(version "1.2.1")
(source (origin
(method git-fetch)
(uri (git-reference
@ -1738,7 +1738,7 @@ and stored in memory.")
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0ixia5s41f2nbal3wsixacbhbc0mk9yb75ir1amqakip30sq4apv"))))
"0sszdl4kvqbihdh8d7mybpp0d8yw2p3gyiipjcxz9xhvvmw3ww4x"))))
(build-system emacs-build-system)
(propagated-inputs
`(("dash" ,emacs-dash)))
@ -1828,7 +1828,7 @@ management tasks from Emacs. To begin with, run @code{M-x guix-about} or
(define-public emacs-build-farm
(package
(name "emacs-build-farm")
(version "0.2.1")
(version "0.2.2")
(source (origin
(method git-fetch)
(uri (git-reference
@ -1837,7 +1837,7 @@ management tasks from Emacs. To begin with, run @code{M-x guix-about} or
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1a4ky0hca26p7f3i2c2s5517ygkyaaz52vs0vxy6f5q95rhlgdhd"))))
"0i0bwbav5861j2y15j9nd5m9rdqg9q97zgcbld8pivr9nyxy63lz"))))
(build-system emacs-build-system)
(propagated-inputs
`(("bui" ,emacs-bui)
@ -5370,8 +5370,8 @@ extensions.")
(license license:gpl3+))))
(define-public emacs-evil-collection
(let ((commit "abc9dd60f71ccc1f24803a12d853f84b4a8b258c")
(revision "4"))
(let ((commit "4e1f0e0b17153d460805a0da90d6191d66b2673d")
(revision "5"))
(package
(name "emacs-evil-collection")
(version (git-version "0.0.1" revision commit))
@ -5383,7 +5383,7 @@ extensions.")
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0c9l93vrsl6kzx8gg305dq8qkb2dr3s10fww7lh382911pdmsh7v"))))
"11d5ppdnb2y2mwsdd9g62h7zds962kw3nss89zv5iwgcf9f1fb5x"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-evil" ,emacs-evil)))
@ -6660,28 +6660,51 @@ containing words from the rime project.")
(define-public emacs-pyim
(package
(name "emacs-pyim")
(version "1.6.4")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/tumashu/pyim/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0hfg8q9hcjifvnlghw2g94dfxfirms2psq2ghqb28fhkf0lks13r"))))
(version "1.8")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/tumashu/pyim")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"16rma4cv7xgky0g3x4an27v30jdi6i1sqw43cl99zhkqvp43l3f9"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-async" ,emacs-async)
("emacs-pyim-basedict" ,emacs-pyim-basedict)
("emacs-popup" ,emacs-popup)
("emacs-pos-tip" ,emacs-pos-tip)))
("emacs-posframe" ,emacs-posframe)))
(home-page "https://github.com/tumashu/pyim")
(synopsis "Chinese input method")
(description "Chinese input method which supports quanpin, shuangpin, wubi
and cangjie.")
(license license:gpl2+)))
(define-public emacs-posframe
(package
(name "emacs-posframe")
(version "0.4.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://elpa.gnu.org/packages/posframe-" version ".el"))
(sha256
(base32
"1h8vvxvsg41vc1nnglqjs2q0k1yzfsn72skga9s76qa3zxmx6kds"))))
(build-system emacs-build-system)
;; emacs-minimal does not include the function font-info
(arguments `(#:emacs ,emacs))
(home-page "https://github.com/tumashu/posframe")
(synopsis "Pop a posframe (a child frame) at point")
(description "@code{emacs-posframe} can pop a posframe at point. A
posframe is a child frame displayed within its root window's buffer.
@code{emacs-posframe} is fast and works well with CJK languages.")
(license license:gpl3+)))
(define-public emacs-el2org
(package
(name "emacs-el2org")
@ -6867,16 +6890,17 @@ built on top of XELB.")
(define-public emacs-switch-window
(package
(name "emacs-switch-window")
(version "1.5.1")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/dimitri/switch-window/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"07f99apxscwvsp2bjxsbi462c433kcglrjh6xl0gyafs1nvvvnd8"))))
(version "1.6.2")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/dimitri/switch-window")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0rci96asgamr6qp6nkyr5vwrnslswjxcjd96yccy4aivh0g66yfg"))))
(build-system emacs-build-system)
(home-page "https://github.com/dimitri/switch-window")
(synopsis "Emacs window switch tool")
@ -6888,17 +6912,18 @@ other operations.")
(define-public emacs-exwm-x
(package
(name "emacs-exwm-x")
(version "1.8.1")
(version "1.9.0")
(synopsis "Derivative window manager based on EXWM")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/tumashu/exwm-x/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0ali1100aacq4zbvcck80h51pvw204jlxhn4aikkqq4ngbx03kkr"))))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/tumashu/exwm-x")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"03l3dl7s1qys1kkh40rm1sfx7axy1b8sf5f6nyksj9ps6d30p5i4"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-exwm" ,emacs-exwm)
@ -7843,6 +7868,19 @@ value of the access token.")
(base32
"10gi14kwxd81blddpvqh95lgmpbfgp0m955naxix3bs3r6a75n4s"))))
(build-system emacs-build-system)
(arguments
`(#:tests? #t
#:test-command '("buttercup" "-L" ".")
#:phases
(modify-phases %standard-phases
;; The HOME environment variable should be set to an existing
;; directory for the tests to succeed.
(add-before 'check 'set-home
(lambda _
(setenv "HOME" "/tmp")
#t)))))
(native-inputs
`(("emacs-buttercup" ,emacs-buttercup)))
;; In order to securely connect to an IRC server using TLS, Circe requires
;; the GnuTLS binary.
(propagated-inputs
@ -7863,7 +7901,7 @@ want to use it.")
;; "tracking.el" is a library extracted from Circe package. It requires
;; "shorten.el".
`(#:include '("^shorten.el$" "^tracking.el$")
#:tests? #f)) ;tests require buttercup
,@(package-arguments emacs-circe)))
(home-page "https://github.com/jorgenschaefer/circe/wiki/Tracking")
(synopsis "Buffer tracking library")
(description "@code{tracking.el} provides a way for different modes to
@ -10241,7 +10279,7 @@ downloading manager for Emacs.")
(define-public emacs-helpful
(package
(name "emacs-helpful")
(version "0.13")
(version "0.15")
(source (origin
(method url-fetch)
(uri (string-append
@ -10250,7 +10288,7 @@ downloading manager for Emacs.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"11kj04y1fa3vnw2991cyqf6adz6bb3hlrdkvypjnmpb0s64q64b6"))))
"1xmvhphzb4hbg647dz4lafy6hd19b7bk3lxni6irqrzdsrclhzn6"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-elisp-refs" ,emacs-elisp-refs)))
@ -11244,7 +11282,7 @@ device tree files.")
(define-public emacs-daemons
(package
(name "emacs-daemons")
(version "1.2.0")
(version "2.0.0")
(source
(origin
(method git-fetch)
@ -11254,7 +11292,7 @@ device tree files.")
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"00ijgm22ck76gw0x79krl05yy0m8a502yfakazfy5xhpn1zi6ab7"))))
"00bkzfaw3bqykcks610vk9wlpa2z360xn32bpsrycacwfv29j7g4"))))
(build-system emacs-build-system)
(home-page "https://github.com/cbowdon/daemons.el")
(synopsis "Emacs UI for managing init system services")
@ -12765,3 +12803,62 @@ interactive session association with the current contexts (project, directory,
buffers). While sesman can be used to manage arbitrary sessions, it primary
targets the Emacs based IDEs (CIDER, ESS, Geiser, Robe, SLIME etc.)")
(license license:gpl3+)))
(define-public emacs-buttercup
(package
(name "emacs-buttercup")
(version "1.16")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/jorgenschaefer/emacs-buttercup.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0dckgcyzsav6ld78bcyrrygy1cz1jvqgav6vy8f6klpmk3r8xrl1"))))
(build-system emacs-build-system)
(arguments
`(#:tests? #t
#:test-command '("make" "test")
#:phases
(modify-phases %standard-phases
(add-after 'install 'install-bin
(lambda* (#:key outputs #:allow-other-keys)
(install-file "bin/buttercup"
(string-append (assoc-ref outputs "out") "/bin"))
#t)))))
(home-page "https://github.com/jorgenschaefer/emacs-buttercup")
(synopsis "Behavior driven emacs lisp testing framework")
(description "Buttercup is a behavior-driven development framework for
testing Emacs Lisp code. It allows to group related tests so they can share
common set-up and tear-down code, and allows the programmer to \"spy\" on
functions to ensure they are called with the right arguments during testing.")
(license license:gpl3+)))
(define-public emacs-wordnut
(let ((commit "feac531404041855312c1a046bde7ea18c674915")
(revision "0"))
(package
(name "emacs-wordnut")
(version (git-version "0.1" revision commit))
(home-page "https://github.com/gromnitsky/wordnut")
(source (origin
(method git-fetch)
(uri (git-reference (url home-page) (commit commit)))
(sha256
(base32
"1jl0b6g64a9w0q7bfvwha67vgws5xd15b7mkfyb5gkz3pymqhfxn"))
(patches
(search-patches "emacs-wordnut-require-adaptive-wrap.patch"))
(file-name (git-file-name name version))))
(build-system emacs-build-system)
(propagated-inputs
`(("wordnet" ,wordnet)
("emacs-adaptive-wrap" ,emacs-adaptive-wrap)))
(synopsis "Major mode for WordNet")
(description "This Emacs package provides an interface for
@code{wordnet}. Features include completion, if the query is not found
too ambiguous and navigation in the result buffer.")
(license license:gpl3+))))

12
gnu/packages/emulators.scm
View File

@ -1186,7 +1186,7 @@ play them on systems for which they were never designed!")
(define-public mame
(package
(name "mame")
(version "0.203")
(version "0.204")
(source
(origin
(method git-fetch)
@ -1196,7 +1196,7 @@ play them on systems for which they were never designed!")
(file-name (git-file-name name version))
(sha256
(base32
"19ccqc00024fbjyk0k5d9xljhwq7wsrp7phwm2jmn0h77mgdj844"))
"0yn63v2f1xlksfnvbxc5p5zpc7ps044m1kf69jhzbfirx953slsi"))
(modules '((guix build utils)))
(snippet
;; Remove bundled libraries.
@ -1223,6 +1223,14 @@ play them on systems for which they were never designed!")
#:phases
(modify-phases %standard-phases
(delete 'configure)
;; Prevent compilation error: ‘atan’ is not a member of ‘std’. Also
;; fixed upstream in fec1cde5a40e197d4ed4314bf58b9e66e84e1631.
(add-after 'unpack 'fix-build
(lambda _
(substitute* "src/mame/video/xavix.cpp"
(("#include \"logmacro.h\"")
"#include \"logmacro.h\"\n#include <cmath>"))
#t))
(add-after 'build 'build-documentation
(lambda _ (invoke "make" "-C" "docs" "man" "info")))
(replace 'install

68
gnu/packages/engineering.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018 Theodoros Foradis <theodoros@foradis.org>
@ -9,6 +9,7 @@
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jonathan Brielmaier <jonathan.brielmaier@web.de>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -690,8 +691,8 @@ language.")
(method url-fetch)
(file-name (string-append name "-" version ".tar.xz"))
(uri (string-append
"https://launchpad.net/kicad/5.0/" version "/+download/" name
"-" version ".tar.xz"))
"https://launchpad.net/kicad/" (version-major+minor version)
"/" version "/+download/" name "-" version ".tar.xz"))
(sha256
(base32 "17nqjszyvd25wi6550j981whlnb1wxzmlanljdjihiki53j84x9p"))))
(build-system cmake-build-system)
@ -710,7 +711,9 @@ language.")
;; headers in the wxwidgets store item, but in wxPython.
(string-append "-DCMAKE_CXX_FLAGS=-I"
(assoc-ref %build-inputs "wxpython")
"/include/wx-3.0")
"/include/wx-"
,(version-major+minor
(package-version python2-wxpython)))
"-DCMAKE_BUILD_WITH_INSTALL_RPATH=TRUE"
"-DKICAD_SPICE=TRUE"
;; TODO: Enable this when CA certs are working with curl.
@ -732,7 +735,10 @@ language.")
(file (string-append out "/bin/kicad"))
(path (string-append
out
"/lib/python2.7/site-packages:"
"/lib/python"
,(version-major+minor
(package-version python))
"/site-packages:"
(getenv "PYTHONPATH"))))
(wrap-program file
`("PYTHONPATH" ":" prefix (,path))
@ -1853,3 +1859,55 @@ The S letter indicates SPICE. The purpose of the Qucs-S subproject is to use
free SPICE circuit simulation kernels with the Qucs GUI. It provides the
simulator backends @code{Qucsator}, @code{ngspice} and @code{Xyce}.")
(license license:gpl2+)))
(define-public librepcb
(package
(name "librepcb")
(version "0.1.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://download.librepcb.org/releases/0.1.0/librepcb-"
version "-source.zip"))
(sha256
(base32
"0affvwwgs1j2wx6bb3zfa2jbfxpckklr8cka2nkswca0p82wd3dv"))))
(build-system gnu-build-system)
(inputs
`(("qtbase" ,qtbase)
("zlib" ,zlib)))
(native-inputs
`(("qttools" ,qttools) ; for lrelease
("unzip" ,unzip)))
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(mkdir-p "build")
(chdir "build")
(let ((lrelease (string-append (assoc-ref inputs "qttools")
"/bin/lrelease"))
(out (assoc-ref outputs "out")))
(invoke "qmake"
(string-append "QMAKE_LRELEASE=" lrelease)
(string-append "PREFIX=" out)
"../librepcb.pro")))))))
(home-page "https://librepcb.org/")
(synopsis "Electronic Design Automation tool")
(description "LibrePCB is @dfn{Electronic Design Automation} (EDA)
software to develop printed circuit boards. It features human readable file
formats and complete project management with library, schematic and board
editors.")
(license (list license:gpl3+
license:boost1.0 ; libs/clipper,
; libs/optional/tests/catch.hpp,
; libs/sexpresso/tests/catch.hpp
license:expat ; libs/delaunay-triangulation,
; libs/parseagle, libs/type_safe
license:asl2.0 ; libs/fontobene, libs/googletest,
; libs/parseagle
license:isc ; libs/hoedown
license:cc0 ; libs/optional, libs/sexpresso
license:bsd-2 ; libs/optional/tests/catch.hpp
license:lgpl2.1+)))) ; libs/quazip

34
gnu/packages/finance.scm
View File

@ -847,7 +847,7 @@ Luhn and family of ISO/IEC 7064 check digit algorithms. ")
(define-public python-duniterpy
(package
(name "python-duniterpy")
(version "0.50.0")
(version "0.51.0")
(source
(origin
(method git-fetch)
@ -858,11 +858,26 @@ Luhn and family of ISO/IEC 7064 check digit algorithms. ")
(file-name (git-file-name name version))
(sha256
(base32
"0f24ihglmzphy30pgc49w0rxmsjc76mgcggg078cfsz7xrrk13gf"))))
"074mh2kh3s00ib0h99050ss3j4c51v57py6dzm7crida6l0iydbv"))))
(build-system python-build-system)
(arguments
;; Tests fail with "AttributeError: module 'attr' has no attribute 's'".
`(#:tests? #f))
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'build 'build-documentation
(lambda _
(invoke "make" "docs")))
(add-after 'build-documentation 'install-documentation
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(doc (string-append out "/share/doc/" ,name)))
(mkdir-p doc)
(copy-recursively "docs/_build/html" doc))
#t)))))
(native-inputs
`(("python-sphinx" ,python-sphinx)
("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
(propagated-inputs
`(("python-aiohttp" ,python-aiohttp)
("python-attr" ,python-attr)
@ -874,19 +889,22 @@ Luhn and family of ISO/IEC 7064 check digit algorithms. ")
(home-page "https://git.duniter.org/clients/python/duniterpy")
(synopsis "Python implementation of Duniter API")
(description "@code{duniterpy} is an implementation of
@uref{https://github.com/duniter/duniter/, duniter} API. Its
@uref{https://github.com/duniter/duniter/, duniter} API. Its
main features are:
@itemize
@item Supports Duniter's Basic Merkle API and protocol
@item Asynchronous
@item Support Duniter's Basic Merkle API and protocol
@item Asynchronous/synchronous without threads
@item Support HTTP, HTTPS and Web Socket transport for Basic Merkle API
@item Support Elasticsearch Duniter4j API
@item Duniter signing key
@item Sign/verify and encrypt/decrypt messages with the Duniter credentials
@end itemize")
(license license:gpl3+)))
(define-public silkaj
(package
(name "silkaj")
(version "0.6.0")
(version "0.6.1")
(source
(origin
(method git-fetch)
@ -896,7 +914,7 @@ main features are:
(file-name (git-file-name name version))
(sha256
(base32
"02n028rz1pshgh7w0af3b291r8lwvhzskm1q98d991gr8rscvad2"))))
"0a99gbgdd7m9wisqhqpfyaim0rlv9gkp8gmrppkagqf6j0683igh"))))
(build-system python-build-system)
(arguments
`(#:tests? #f)) ;no test

7
gnu/packages/firmware.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Vagrant Cascadian <vagrant@debian.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -450,8 +451,8 @@ such as:
(let ((base (make-arm-trusted-firmware "sun50i_a64"))
;; Use unreleased version which enables additional features needed for
;; LCD support
(commit "cabe0a31801e99e7abb84d2114ded6bb56f3c71e")
(revision "1"))
(commit "98aab97484b27e40aa74a93e5d1c1ac037a7e0b8")
(revision "2"))
(package
(inherit base)
(name "arm-trusted-firmware-sun50i-a64")
@ -465,7 +466,7 @@ such as:
(file-name (git-file-name name version))
(sha256
(base32
"0srw2zj3vn5d2fwzjpwa5h70d5bwvb79jnpdvmd395npv0gxshdz")))))))
"0z5si034vcn4m68zaixc5v8fs1c7vxbh7n4hggxs55p0jg01dan5")))))))
(define-public arm-trusted-firmware-puma-rk3399
(let ((base (make-arm-trusted-firmware "rk3399"))

78
gnu/packages/games.scm
View File

@ -146,9 +146,11 @@
#:use-module (gnu packages xml)
#:use-module (gnu packages messaging)
#:use-module (gnu packages networking)
#:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system gnu)
#:use-module (guix build-system go)
#:use-module (guix build-system haskell)
#:use-module (guix build-system meson)
#:use-module (guix build-system python)
#:use-module (guix build-system cmake)
#:use-module (guix build-system trivial))
@ -573,7 +575,7 @@ automata. The following features are available:
(define-public meandmyshadow
(package
(name "meandmyshadow")
(version "0.5")
(version "0.5a")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/meandmyshadow/"
@ -581,10 +583,7 @@ automata. The following features are available:
"-src.tar.gz"))
(sha256
(base32
"1b6qf83vdfv8jwn2jq9ywmda2qn2f5914i7mwfy04m17wx593m3m"))
(patches (search-patches
;; This will not be needed in the next release.
"meandmyshadow-define-paths-earlier.patch"))))
"0i98v6cgmpsxy7mbb0s2y6f6qq6mkwzk2nrv1nz39ncf948aky2h"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f)) ; there are no tests
@ -5877,3 +5876,72 @@ libraries. AIFF sound effects and music in MOD and OGG formats are supported
when packaged in Blorb container files or optionally from individual files.")
(home-page "http://frotz.sourceforge.net")
(license license:gpl2+))))
(define-public libmanette
(package
(name "libmanette")
(version "0.2.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"14vqz30p4693yy3yxs0gj858x25sl2kawib1g9lj8g5frgl0hd82"))))
(build-system meson-build-system)
(native-inputs
`(("glib" ,glib "bin") ; for glib-compile-resources
("gobject-introspection" ,gobject-introspection)
("pkg-config" ,pkg-config)
("vala" ,vala)))
(inputs
`(("libevdev" ,libevdev)
("libgudev" ,libgudev)))
(home-page "https://wiki.gnome.org/Apps/Games")
(synopsis "Game controller library")
(description "Libmanette is a small GObject library giving you simple
access to game controllers. It supports the de-facto standard gamepads as
defined by the W3C standard Gamepad specification or as implemented by the SDL
GameController.")
(license license:lgpl2.1+)))
(define-public quadrapassel
(package
(name "quadrapassel")
(version "3.31.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"08i01nsgfb502xzzrrcxxbs7awb0j1h4c08vmj0j18ipa1sz8vb8"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("desktop-file-utils" ,desktop-file-utils) ;for desktop-file-validate
("gettext" ,gnu-gettext)
("glib" ,glib "bin") ;for glib-compile-resources
("itstool" ,itstool)
("libxml2" ,libxml2) ;for xmllint
("pkg-config" ,pkg-config)
("vala" ,vala)))
(inputs
`(("clutter" ,clutter)
("clutter-gtk" ,clutter-gtk)
("gtk+" ,gtk+)
("libcanberra" ,libcanberra)
("libmanette" ,libmanette)
("librsvg" ,librsvg)))
(home-page "https://wiki.gnome.org/Apps/Quadrapassel")
(synopsis "GNOME version of Tetris")
(description "Quadrapassel comes from the classic falling-block game,
Tetris. The goal of the game is to create complete horizontal lines of
blocks, which will disappear. The blocks come in seven different shapes made
from four blocks each: one straight, two L-shaped, one square, and two
S-shaped. The blocks fall from the top center of the screen in a random
order. You rotate the blocks and move them across the screen to drop them in
complete lines. You score by dropping blocks fast and completing lines. As
your score gets higher, you level up and the blocks fall faster.")
(license license:gpl2+)))

2
gnu/packages/gnuzilla.scm
View File

@ -517,7 +517,6 @@ security standards.")
(mozilla-patch "icecat-CVE-2018-12405-pt03.patch" "5e1a9644aeef" "1qimrpgyrd8zkiri7w57j0aymk20y9b34am5w7rvr6qj1lhrbfla")
(mozilla-patch "icecat-bug-1485655.patch" "9055726e2d89" "1pppxr94zqh6zmi2mn1ih21qap09vk5ivbhnwxqr8iszvygjg44g")
(mozilla-patch "icecat-bug-1410214.patch" "9e641345e2ef" "0542xss2jdb8drh4g50cfy32l300x69dyywgx3dqs03vgr3qplxy")
(mozilla-patch "icecat-CVE-2018-12405-pt04.patch" "6398541ec302" "1c2yi7mkg3d5afxsgj9fp3zq8yhkmphrll5d60d5xsdv88kqqiyf")
(mozilla-patch "icecat-bug-1496736.patch" "3bed863ee656" "038k7jk3yp16410crwfdvhyb2vis49c6bplrfr83v51885cqldar")
(mozilla-patch "icecat-bug-1498765.patch" "a08c8493ba19" "0bwg4vg03j962lb9q8ihpiy4rmygykf1q9ij8x7h34q7hg43yjya")
@ -531,7 +530,6 @@ security standards.")
(mozilla-patch "icecat-bug-1507564.patch" "60619cc47b10" "09fanqr08kqgraw4xp7y2az4jc7ia8nn200rqjfj20vmkyjz97j3")
(mozilla-patch "icecat-bug-1507730.patch" "dd0f01818b9c" "14ziq1bm72n58xrvsgzpjj5z6ifpvi70r5jfhbkbj69mf4y4cx2z")
(mozilla-patch "icecat-CVE-2018-12405-pt07.patch" "a73a46ddc848" "1bvvyav3xyn6rgn6haicinxn0dasl9dyc1i37fyb7wr5wcpahybs")
(mozilla-patch "icecat-CVE-2018-18494.patch" "a72ec8e21577" "095zghmwdcbaid5426p9vpl757d8sfbsvgn201bjm7nhm03m4z7i")
(mozilla-patch "icecat-CVE-2018-12405-pt08.patch" "b6d0fc61fd0b" "0059avawxi4s4747plybjsjq8j2h4z7amw05p28xyg95a2njwnaa")
(mozilla-patch "icecat-bug-1499028.patch" "a62ede2dd3bc" "0ikmnibni8bdvpr9p42wskyyic08vzqdz5qr028bqzyg5119gily")

4
gnu/packages/golang.scm
View File

@ -406,7 +406,7 @@ in the style of communicating sequential processes (@dfn{CSP}).")
(package
(inherit go-1.9)
(name "go")
(version "1.11.1")
(version "1.11.4")
(source
(origin
(method url-fetch)
@ -414,7 +414,7 @@ in the style of communicating sequential processes (@dfn{CSP}).")
name version ".src.tar.gz"))
(sha256
(base32
"05qivf2f59pv4bfrmdr4m0xvswkmvvl9c5a2h5dy45g2k8b8r3sm"))))
"05fvp8dq0yffsrvdyii4wgl756dn0xkgm5a80al7j7kb19r45zac"))))
(arguments
(substitute-keyword-arguments (package-arguments go-1.9)
((#:phases phases)

15
gnu/packages/guile.scm
View File

@ -45,6 +45,7 @@
#:use-module (gnu packages compression)
#:use-module (gnu packages gawk)
#:use-module (gnu packages gperf)
#:use-module (gnu packages hurd)
#:use-module (gnu packages libffi)
#:use-module (gnu packages autotools)
#:use-module (gnu packages flex)
@ -288,7 +289,19 @@ without requiring the source code to be rewritten.")
(substitute* "module/Makefile.in"
(("language/elisp/boot\\.el")
"\n"))
#t)))))
#t))
,@(if (hurd-target?)
`((add-after 'unpack 'allow-madvise-ENOSYS
(lambda _
;; Do not warn about ENOSYS on 'madvise'. This is
;; what Guile commit
;; 45e4ace6603e00b297e6542362273041aebe7305 does.
;; TODO: Remove for Guile >= 2.2.5.
(substitute* "libguile/vm.c"
(("perror \\(\"madvise failed\"\\)")
"if (errno != ENOSYS) perror (\"madvised failed\");"))
#t)))
'()))))
(package-arguments guile-2.0)))))
(define-public guile-2.2/fixed

9
gnu/packages/haskell.scm
View File

@ -5069,10 +5069,11 @@ call stacks with different versions of the compiler.")
;; This is used as an input to ghc-hunit. We cannot use ghc-call-stack there,
;; because it depends on ghc-nanospec, which depends on ghc-hunit.
(define-public ghc-call-stack-boot
(package
(inherit ghc-call-stack)
(arguments '(#:tests? #f))
(inputs '())))
(hidden-package
(package
(inherit ghc-call-stack)
(arguments '(#:tests? #f))
(inputs '()))))
(define-public ghc-statevar
(package

47
gnu/packages/image-processing.scm
View File

@ -35,13 +35,18 @@
#:use-module (gnu packages compression)
#:use-module (gnu packages documentation)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages gl)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages graphics)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages image)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages maths)
#:use-module (gnu packages pdf)
#:use-module (gnu packages perl)
#:use-module (gnu packages photo)
#:use-module (gnu packages pkg-config)
@ -396,3 +401,45 @@ vision algorithms. It can be used to do things like:
@end itemize\n")
(home-page "https://opencv.org/")
(license license:bsd-3)))
(define-public vips
(package
(name "vips")
(version "8.7.1")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/libvips/libvips/releases/download/v"
version "/vips-" version ".tar.gz"))
(sha256
(base32 "1w3b90pdw7nj2p0gb4f96h6zhmga513f968ldfhz1rkhg7y81c0s"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("gobject-introspection" ,gobject-introspection)))
(inputs
`(("glib" ,glib)
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("librsvg" ,librsvg)
("libtiff" ,libtiff)
("libexif" ,libexif)
("giflib" ,giflib)
("libgsf" ,libgsf)
("fftw" ,fftw)
("poppler" ,poppler)
("pango" ,pango)
("lcms" ,lcms)
("matio" ,matio)
("libwebp" ,libwebp)
("niftilib" ,niftilib)
("openexr" ,openexr)
("orc" ,orc)
("imagemagick" ,imagemagick)
("libxml2" ,libxml2)
("expat" ,expat)
("hdf5" ,hdf5)))
(home-page "https://libvips.github.io/libvips/")
(synopsis "A free image processing system")
(description "vips is a demand-driven, horizontally threaded image processing library")
(license license:lgpl2.1+)))

29
gnu/packages/image.scm
View File

@ -22,6 +22,7 @@
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -49,6 +50,7 @@
#:use-module (gnu packages compression)
#:use-module (gnu packages documentation)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages freedesktop)
;; To provide gcc@5 and gcc@6, to work around <http://bugs.gnu.org/24703>.
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
@ -58,6 +60,7 @@
#:use-module (gnu packages graphics)
#:use-module (gnu packages gtk)
#:use-module (gnu packages lua)
#:use-module (gnu packages man)
#:use-module (gnu packages maths)
#:use-module (gnu packages mcrypt)
#:use-module (gnu packages perl)
@ -73,6 +76,7 @@
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix build-system meson)
#:use-module (guix build-system python)
#:use-module (guix build-system r)
#:use-module (guix build-system scons)
@ -1566,3 +1570,28 @@ identical visual appearance.")
(description
"Jp2a is a small utility that converts JPEG images to ASCII.")
(license license:gpl2)))
(define-public grim
(package
(name "grim")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/emersion/grim/archive/v" version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "0xkk5nqyp1px0sxz4asmchznc0q39wdx1b67ql741k8aj815km0f"))))
(build-system meson-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("cairo" ,cairo)
("libjpeg-turbo" ,libjpeg-turbo)
("scdoc" ,scdoc)
("wayland" ,wayland)
("wayland-protocols" ,wayland-protocols)))
(home-page "https://github.com/emersion/grim")
(synopsis "Create screenshots from a Wayland compositor")
(description "grim can create screenshots from a Wayland compositor.")
;; MIT license.
(license license:expat)))

16
gnu/packages/ipfs.scm
View File

@ -218,17 +218,27 @@ written in Go.")
(version "0.4.18")
(source
(origin
(method url-fetch)
(method url-fetch/tarbomb)
(uri (string-append
"https://dist.ipfs.io/go-ipfs/v" version
"/go-ipfs-source.tar.gz"))
(sha256
(base32
"19hfgbyn5sr1bw0cwm3gsjz0w3b3vh3mmkax1906raah30lavj1x"))))
"19hfgbyn5sr1bw0cwm3gsjz0w3b3vh3mmkax1906raah30lavj1x"))
(file-name (string-append name "-" version "-source"))))
(build-system go-build-system)
(arguments
'(#:unpack-path "github.com/ipfs/go-ipfs"
#:import-path "github.com/ipfs/go-ipfs/cmd/ipfs"))
#:import-path "github.com/ipfs/go-ipfs/cmd/ipfs"
#:phases (modify-phases %standard-phases
(add-before 'reset-gzip-timestamps 'make-files-writable
(lambda* (#:key outputs #:allow-other-keys)
;; Make sure .gz files are writable so that the
;; 'reset-gzip-timestamps' phase can do its work.
(let ((out (assoc-ref outputs "out")))
(for-each make-file-writable
(find-files out "\\.gz$"))
#t))))))
(home-page "https://ipfs.io")
(synopsis "Go implementation of IPFS, a peer-to-peer hypermedia protocol")
(description "IPFS is a global, versioned, peer-to-peer filesystem. It

2
gnu/packages/java.scm
View File

@ -301,7 +301,7 @@ JNI.")
`(("jikes" ,jikes)
("jamvm" ,jamvm-1-bootstrap)
("unzip" ,unzip)
("zip", zip)))
("zip" ,zip)))
(home-page "http://ant.apache.org")
(synopsis "Build tool for Java")
(description

25
gnu/packages/kde-frameworks.scm
View File

@ -3274,6 +3274,7 @@ setUrl, setUserAgent and call.")
("phonon" ,phonon)
("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)
("qtquickcontrols2" ,qtquickcontrols2)
("qtsvg" ,qtsvg)
("qtx11extras" ,qtx11extras)
("solid" ,solid)))
@ -3381,7 +3382,7 @@ workspace.")
(define-public kdelibs4support
(package
(name "kdelibs4support")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3390,7 +3391,7 @@ workspace.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "0aiig8akn6bdxrqdl96xjjy2pxw8hhfrsalbkkzyhh06j794snfb"))))
(base32 "1cz70c77l66lbw4fbgmfbq1fldybqxsiay2pg9risgqp3ra8wahi"))))
(build-system cmake-build-system)
(native-inputs
`(("dbus" ,dbus)
@ -3495,7 +3496,7 @@ http://community.kde.org/Frameworks/Porting_Notes should help with this.")
(define-public khtml
(package
(name "khtml")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3504,7 +3505,7 @@ http://community.kde.org/Frameworks/Porting_Notes should help with this.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "1bfslndxvad0zgzr22w2mz1xwavix9bh5qrrv8dpshlh043bwr3l"))))
(base32 "0k9m2pgq64grmgc6ywpzfnn65h8wfkkiwjbmz2mwbf2yi9c1ky64"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
@ -3554,7 +3555,7 @@ technology and using KJS for JavaScript support.")
(define-public kjs
(package
(name "kjs")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3563,7 +3564,7 @@ technology and using KJS for JavaScript support.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "1m26sb2qyrcgmpkw76k2yv5my2pkhld96vw6aaqm77q90faw734g"))))
(base32 "057ikyi4wffjvxdyk08hmj7h8vmbwbcxv98apmjzgsd611zvx5p0"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
@ -3587,7 +3588,7 @@ support.")
(define-public kjsembed
(package
(name "kjsembed")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3596,7 +3597,7 @@ support.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "10w4w4ncwr245bv1ii4sh154w91ghfz0l60k89j50lsydpcqcp3a"))))
(base32 "0qddjkfm6f0f5dynqvi3l23mgyfdbk4xzg967sj3a2qlq423ah0m"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
@ -3616,7 +3617,7 @@ QObjects, so you can script your applications.")
(define-public kmediaplayer
(package
(name "kmediaplayer")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3625,7 +3626,7 @@ QObjects, so you can script your applications.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "1k1pjc0cz36gs0pl2pxw8f9f82xkbqyy320nfyhan5waxbl1qd5n"))))
(base32 "0hbx48ivj4i96yagd9n9vd22ycsljrvijm6nfms4x7z7jr49flrx"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
@ -3662,7 +3663,7 @@ KParts instead.")
(define-public kross
(package
(name "kross")
(version "5.42.0")
(version "5.49.0")
(source
(origin
(method url-fetch)
@ -3671,7 +3672,7 @@ KParts instead.")
(version-major+minor version) "/portingAids/"
name "-" version ".tar.xz"))
(sha256
(base32 "1aqqwby6jslimpvx42d4n6gjsjc8l82gmsq5ajpv9zkkk91dqfqi"))))
(base32 "194zcf499fkwk3wcs3kc3l0fi9h8gn5yqh6gxrgiyn6iyy9a4qdz"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)

12
gnu/packages/kde.scm
View File

@ -90,12 +90,12 @@
("knotifyconfig" ,knotifyconfig)
("kfilemetadata" ,kfilemetadata)
("kdoctools" ,kdoctools)
("kdeclarative", kdeclarative)
("qtdeclarative", qtdeclarative)
("qtquickcontrols", qtquickcontrols)
("kiconthemes", kiconthemes)
("kdeclarative" ,kdeclarative)
("qtdeclarative" ,qtdeclarative)
("qtquickcontrols" ,qtquickcontrols)
("kiconthemes" ,kiconthemes)
("qtgraphicaleffects" ,qtgraphicaleffects)
("kplotting", kplotting)))
("kplotting" ,kplotting)))
(arguments
`(#:phases
(modify-phases %standard-phases
@ -112,7 +112,7 @@
,(map (lambda (label)
(string-append (assoc-ref inputs label)
"/lib/qt5/plugins/"))
'("qtbase", "qtsvg")))
'("qtbase" "qtsvg")))
`("FREI0R_PATH" ":" =
(,(string-append frei0r "/lib/frei0r-1/")))
`("QT_QPA_PLATFORM_PLUGIN_PATH" ":" =

20
gnu/packages/linux.scm
View File

@ -400,8 +400,8 @@ It has been modified to remove all non-free binary blobs.")
;; supports qemu "virt" machine and possibly a large number of ARM boards.
;; See : https://wiki.debian.org/DebianKernel/ARMMP.
(define %linux-libre-version "4.19.8")
(define %linux-libre-hash "1rmgf3sbcyb47s3sagac7zrrpznq0vlcbzjzlzir95biy7lbswb3")
(define %linux-libre-version "4.19.11")
(define %linux-libre-hash "1wsxh2hdb4g18vwhr91rm964g801k7ign3p353211gahpdvzay5c")
(define %linux-libre-4.19-patches
(list %boot-logo-patch
@ -423,8 +423,8 @@ It has been modified to remove all non-free binary blobs.")
#:patches %linux-libre-4.19-patches
#:configuration-file kernel-config))
(define %linux-libre-4.14-version "4.14.87")
(define %linux-libre-4.14-hash "1013h3qbsq76vlhrbl3gci25jbwydzm7k0bg08fbq42qrhjq92ak")
(define %linux-libre-4.14-version "4.14.89")
(define %linux-libre-4.14-hash "12n6qpcng7c7vdb1p3p914bn3g2namaam6d55ipvz0dv5k283h75")
(define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version
@ -433,14 +433,14 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
(define-public linux-libre-4.9
(make-linux-libre "4.9.144"
"1jckikf1j294gr3sf43bfy3h34q3yqbqgqbj9l0px427h3n2vgkk"
(make-linux-libre "4.9.146"
"0z1jdpa5z3kcgl29am19rvips03w7hr106rc3p9rzggblr623dy5"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.166"
"1pb6hk141hzf6yf2423h0jfv9bjq09cynsp1xbm12mxayn637xmm"
(make-linux-libre "4.4.168"
"12wb8fjmgkal1s4sfkfa5gi8bza22ah4p762gl33v4qc9nvjmmpf"
%intel-compatible-systems
#:configuration-file kernel-config))
@ -2613,7 +2613,7 @@ thanks to the use of namespaces.")
(define-public singularity
(package
(name "singularity")
(version "2.5.1")
(version "2.6.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/singularityware/singularity/"
@ -2621,7 +2621,7 @@ thanks to the use of namespaces.")
"/singularity-" version ".tar.gz"))
(sha256
(base32
"0f28dgf2qcy8ljjfix7p9q36q12j7rxyicfzzi4n0fl8zr8ab88g"))))
"1whx0hqqi1326scgdxxxa1d94vn95mnq0drid6s8wdp84ni4d3gk"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags

93
gnu/packages/lisp.scm
View File

@ -69,6 +69,7 @@
#:use-module (gnu packages databases)
#:use-module (gnu packages gtk)
#:use-module (gnu packages webkit)
#:use-module (gnu packages xdisorg)
#:use-module (ice-9 match)
#:use-module (srfi srfi-19))
@ -168,8 +169,7 @@
`(("gmp" ,gmp)
("readline" ,readline)))
(native-inputs
`(("gcc" ,gcc-4.9)
("m4" ,m4)
`(("m4" ,m4)
("texinfo" ,texinfo)))
(home-page "https://www.gnu.org/software/gcl/")
(synopsis "A Common Lisp implementation")
@ -772,6 +772,42 @@ thin compatibility layer for gray streams.")
(define-public ecl-trivial-gray-streams
(sbcl-package->ecl-package sbcl-trivial-gray-streams))
(define-public sbcl-fiasco
(let ((commit "d62f7558b21addc89f87e306f65d7f760632655f")
(revision "1"))
(package
(name "sbcl-fiasco")
(version (git-version "0.0.1" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/joaotavora/fiasco.git")
(commit commit)))
(file-name (git-file-name "fiasco" version))
(sha256
(base32
"1zwxs3d6iswayavcmb49z2892xhym7n556d8dnmvalc32pm9bkjh"))))
(build-system asdf-build-system/sbcl)
(inputs
`(("alexandria" ,sbcl-alexandria)
("trivial-gray-streams" ,sbcl-trivial-gray-streams)))
(synopsis "Simple and powerful test framework for Common Lisp")
(description "A Common Lisp test framework that treasures your failures,
logical continuation of Stefil. It focuses on interactive debugging.")
(home-page "https://github.com/joaotavora/fiasco")
;; LICENCE specifies this is public-domain unless the legislation
;; doesn't allow or recognize it. In that case it falls back to a
;; permissive licence.
(license (list license:public-domain
(license:x11-style "file://LICENCE"))))))
(define-public cl-fiasco
(sbcl-package->cl-source-package sbcl-fiasco))
(define-public ecl-fiasco
(sbcl-package->ecl-package sbcl-fiasco))
(define-public sbcl-flexi-streams
(package
(name "sbcl-flexi-streams")
@ -932,16 +968,21 @@ from other CLXes around the net.")
(define-public stumpwm
(package
(name "stumpwm")
(version "18.05")
(version "18.11")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/stumpwm/stumpwm/archive/"
version ".tar.gz"))
(sha256
(base32 "1n2gaab3lwgf5r1hmwdcw13dkv9xdd7drn2shx28kfxvhdc9kbb9"))
(file-name (string-append "stumpwm-" version ".tar.gz"))))
(base32 "177gxfk4c127i9crghx6fmkipznhgylvzgnjb2pna38g21gg6s39"))
(file-name (string-append "stumpwm-" version ".tar.gz"))
(patches
;; This patch is included in the post-18.11 git master tree
;; and can be removed when we move to the next release.
(search-patches "stumpwm-fix-broken-read-one-line.patch"))))
(build-system asdf-build-system/sbcl)
(native-inputs `(("fiasco" ,sbcl-fiasco)))
(inputs `(("cl-ppcre" ,sbcl-cl-ppcre)
("clx" ,sbcl-clx)
("alexandria" ,sbcl-alexandria)))
@ -3744,3 +3785,45 @@ client and server.")
(define-public ecl-s-xml-rpc
(sbcl-package->ecl-package sbcl-s-xml-rpc))
(define-public sbcl-trivial-clipboard
(let ((commit "5af3415d1484e6d69a1b5c178f24680d9fd01796"))
(package
(name "sbcl-trivial-clipboard")
(version (git-version "0.0.0.0" "2" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/snmsts/trivial-clipboard")
(commit commit)))
(file-name (git-file-name "trivial-clipboard" version))
(sha256
(base32
"1gb515z5yq6h5548pb1fwhmb0hhq1ssyb78pvxh4alq799xipxs9"))))
(build-system asdf-build-system/sbcl)
(inputs
`(("xclip" ,xclip)))
(native-inputs
`(("fiveam" ,sbcl-fiveam)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-paths
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/text.lisp"
(("\\(executable-find \"xclip\"\\)")
(string-append "(executable-find \""
(assoc-ref inputs "xclip")
"/bin/xclip\")"))))))))
(home-page "https://github.com/snmsts/trivial-clipboard")
(synopsis "Access system clipboard in Common Lisp")
(description
"@command{trivial-clipboard} gives access to the system clipboard.")
(license license:expat))))
(define-public cl-trivial-clipboard
(sbcl-package->cl-source-package sbcl-trivial-clipboard))
(define-public ecl-trivial-clipboard
(sbcl-package->ecl-package sbcl-trivial-clipboard))

15
gnu/packages/llvm.scm
View File

@ -95,6 +95,21 @@ languages is in development. The compiler infrastructure includes mirror sets
of programming tools as well as libraries with equivalent functionality.")
(license license:ncsa)))
;; TODO: Build Mesa with LLVM 7 in the next staging cycle.
;; TODO: Make LLVM 7 the default LLVM once Clang is also upgraded.
(define-public llvm-7.0.0
(package (inherit llvm)
(name "llvm")
(version "7.0.0")
(source
(origin
(method url-fetch)
(uri (string-append "http://llvm.org/releases/"
version "/llvm-" version ".src.tar.xz"))
(sha256
(base32
"08p27wv1pr9ql2zc3f3qkkymci46q7myvh8r5ijippnbwr2gihcb"))))))
(define* (clang-runtime-from-llvm llvm hash
#:optional (patches '()))
(package

4
gnu/packages/lxqt.scm
View File

@ -513,7 +513,7 @@ of other programs.")
("liblxqt" ,liblxqt)
("libqtxdg" ,libqtxdg)
("libstatgrab" ,libstatgrab)
("libsysstat", libsysstat)
("libsysstat" ,libsysstat)
("libxcomposite" ,libxcomposite)
("libxdamage" ,libxdamage)
("libxkbcommon" ,libxkbcommon)
@ -700,7 +700,7 @@ Qt with LXQt.")
("qtx11extras" ,qtx11extras)))
(native-inputs
`(("pkg-config" ,pkg-config)
("qttools", qttools)
("qttools" ,qttools)
("lxqt-build-tools" ,lxqt-build-tools)))
(arguments
'(#:tests? #f ; no tests

48
gnu/packages/mail.scm
View File

@ -47,12 +47,13 @@
#:use-module (gnu packages)
#:use-module (gnu packages aspell)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages backup)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages bison)
#:use-module (gnu packages calendar)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages crypto)
#:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl)
@ -60,11 +61,13 @@
#:use-module (gnu packages dejagnu)
#:use-module (gnu packages django)
#:use-module (gnu packages dns)
#:use-module (gnu packages docbook)
#:use-module (gnu packages documentation)
#:use-module (gnu packages emacs)
#:use-module (gnu packages enchant)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages gdb)
#:use-module (gnu packages gettext)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg)
@ -80,35 +83,31 @@
#:use-module (gnu packages linux)
#:use-module (gnu packages lua)
#:use-module (gnu packages m4)
#:use-module (gnu packages man)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages networking)
#:use-module (gnu packages openldap)
#:use-module (gnu packages onc-rpc)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-web)
#:use-module (gnu packages readline)
#:use-module (gnu packages search)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages compression)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages flex)
#:use-module (gnu packages gdb)
#:use-module (gnu packages man)
#:use-module (gnu packages ruby)
#:use-module (gnu packages search)
#:use-module (gnu packages serialization)
#:use-module (gnu packages samba)
#:use-module (gnu packages screen)
#:use-module (gnu packages tcl)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages time)
#:use-module (gnu packages tls)
#:use-module (gnu packages networking)
#:use-module (gnu packages w3m)
#:use-module (gnu packages web)
#:use-module (gnu packages webkit)
#:use-module (gnu packages w3m)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (gnu packages docbook)
#:use-module (gnu packages xml)
#:use-module ((guix licenses)
#:select (fdl1.1+
agpl3+
@ -1731,13 +1730,13 @@ maintained.")
(define-public khard
(package
(name "khard")
(version "0.11.4")
(version "0.12.2")
(source (origin
(method url-fetch)
(uri (pypi-uri name version))
(sha256
(base32
"1shhlq6ljbd8095hd82v4mw56rjcfxf1ymmgknbgh8gix02nsxw1"))))
"01y52qmab4cw9wmx87aahnxbyaxrxw8j2wx06mpcqsfvgk8d54wi"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -1748,14 +1747,17 @@ maintained.")
(doc (string-append out "/share/doc/khard")))
(copy-recursively "misc/khard" doc)
#t))))
;; FIXME: check phase fails with
;; "Config file /tmp/.config/khard/khard.conf not available"
;; Tests are currently only runnable without preexisting data on
;; the development branch:
;; https://github.com/scheibler/khard/issues/176
#:tests? #f))
(propagated-inputs
`(("python-vobject" ,python-vobject)
`(("python-atomicwrites" ,python-atomicwrites)
("python-configobj" ,python-configobj)
("python-pyyaml" ,python-pyyaml)
("python-atomicwrites" ,python-atomicwrites)
("python-configobj" ,python-configobj)))
("python-ruamel.yaml" ,python-ruamel.yaml)
("python-unidecode" ,python-unidecode)
("python-vobject" ,python-vobject)))
(synopsis "Console address book using CardDAV")
(description "Khard is an address book for the console. It creates, reads,
modifies and removes CardDAV address book entries at your local machine. For
@ -2595,14 +2597,14 @@ servers. The 4rev1 and 4 versions of IMAP are supported.")
(define-public urlscan
(package
(name "urlscan")
(version "0.9.0")
(version "0.9.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "urlscan" version))
(sha256
(base32
"133f28bisr4xj0nihpwpil8dyadss62mp8qgqdyzd676hg9xjfyc"))))
"0vpdyrx51sg9a8kswa7ibbcgcpvc7r03aq8x4n4c7v2xg0v3c7wb"))))
(build-system python-build-system)
(propagated-inputs
`(("python-urwid" ,python-urwid)))

2
gnu/packages/make-bootstrap.scm
View File

@ -382,6 +382,8 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
(parameterize ((%current-target-system #f))
(cross-libc target)))
glibc)))))
(native-inputs '())
(propagated-inputs '())
;; Only one output.
(outputs '("out")))))

32
gnu/packages/man.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -228,6 +229,37 @@ automatically.")
(base32
"1p5830h88cx0zn0snwaj0vpph81xicpsirfwlxmcgjrlmn0nm3sj"))))))
(define-public scdoc
(package
(name "scdoc")
(version "1.6.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://git.sr.ht/%7Esircmpwn/scdoc/archive/" version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1ca3js4arkg28gg2iszxxyrq7kgsrz482d1szv5dfd471h3vr5m3"))))
(build-system gnu-build-system)
(arguments
`(#:make-flags '("CC=gcc")
#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-before 'install 'hardcode-paths
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "Makefile"
(("/usr/local") (assoc-ref outputs "out")))
#t)))))
(home-page "https://git.sr.ht/~sircmpwn/scdoc")
(synopsis "Simple man page generator")
(description "scdoc is a simple man page generator written for POSIX systems
in C99.")
;; MIT license, see /share/doc/scdoc-1.6.0/COPYING.
(license expat)))
(define-public txt2man
(package
(name "txt2man")

40
gnu/packages/maths.scm
View File

@ -3707,7 +3707,13 @@ set.")
`(("doc++" ,doc++)
("netpbm" ,netpbm)
("perl" ,perl) ;needed to run 'ppmquant' during tests
("texlive" ,texlive) ;full package required for fonts
("texlive" ,(texlive-union (list texlive-generic-xypic
texlive-fonts-xypic
texlive-latex-hyperref
texlive-latex-oberdiek
texlive-generic-ifxetex
texlive-latex-url
texlive-bibtex)))
("ghostscript" ,ghostscript)))
(inputs
`(("blas" ,openblas)
@ -3724,6 +3730,12 @@ set.")
"--with-blas")
#:phases
(modify-phases %standard-phases
(add-before 'build 'set-HOME
(lambda _
;; FIXME: texlive-union does not find the built
;; metafonts, so it tries to generate them in HOME.
(setenv "HOME" "/tmp")
#t))
(add-before 'configure 'chdir-src
(lambda _ (chdir "src")))
(replace 'configure
@ -3738,7 +3750,7 @@ set.")
configure-flags)))))))
(add-after 'build 'build-docs
(lambda _
(zero? (system* "make" "-Cdocs" "pdf" "html"))))
(invoke "make" "-Cdocs" "pdf" "html")))
(replace 'check
(lambda _
(setenv "LD_LIBRARY_PATH" (string-append (getcwd) "/hypre/lib"))
@ -3959,6 +3971,7 @@ as equations, scalars, vectors, and matrices.")
(method git-fetch)
(uri (git-reference (url home-page)
(commit (string-append "z3-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1vr57bwx40sd5riijyrhy70i2wnv9xrdihf6y5zdz56yq88rl48f"))))
@ -3972,6 +3985,12 @@ as equations, scalars, vectors, and matrices.")
"/lib/python2.7/site-packages"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-compatability
;; Versions after 4.8.3 have immintrin.h IFDEFed for Windows only.
(lambda _
(substitute* "src/util/mpz.cpp"
(("#include <immintrin.h>") ""))
#t))
(add-before 'configure 'bootstrap
(lambda _
(zero?
@ -4055,13 +4074,14 @@ exclusion algorithms are typical examples of such systems.")
(name "elemental")
(version "0.87.7")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/elemental/Elemental/"
"archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/elemental/Elemental.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1nfp82w22pi8x8fg9sc37z8kf84dqi1dhxp8bbk7571y4aygvv3v"))))
"1687xpjjzig27y2pnqv7hv09smpijyfdpz7qjgmcxf4shfajlfkc"))))
(build-system cmake-build-system)
(home-page "http://libelemental.org")
(native-inputs
@ -4085,8 +4105,8 @@ exclusion algorithms are typical examples of such systems.")
"-DCMAKE_INSTALL_LIBDIR=lib"
"-DGFORTRAN_LIB=gfortran")
#:phases (modify-phases %standard-phases
(add-before 'check 'mpi-setup
,%openmpi-setup)
(add-before 'check 'mpi-setup
,%openmpi-setup)
(add-before 'check 'setup-tests
(lambda _
;; Parallelism is done at the MPI layer.
@ -4097,7 +4117,7 @@ exclusion algorithms are typical examples of such systems.")
;; Tests are installed, with no easy configuration
;; switch to prevent this, so delete them.
(delete-file-recursively
(string-append (assoc-ref outputs "out") "/bin"))
(string-append (assoc-ref outputs "out") "/bin"))
#t)))))
(synopsis "Dense and sparse-direct linear algebra and optimization")
(description "Elemental is a modern C++ library for distributed-memory

13
gnu/packages/mes.scm
View File

@ -63,14 +63,14 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(let ((triplet "i686-unknown-linux-gnu"))
(package
(name "mes")
(version "0.18")
(version "0.19")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/mes/"
"mes-" version ".tar.gz"))
(sha256
(base32
"1dsaaqyanzsq9m5wrcd2bjhb3qd6928c9q97rg5r730pyqjwxyxf"))))
"15h4yhaywdc0djpjlin2jz1kzahpqxfki0r0aav1qm9nxxmnp1l0"))))
(build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux"))
(propagated-inputs
@ -93,10 +93,11 @@ extensive examples, including parsers for the Javascript and C99 languages.")
`(#:strip-binaries? #f)) ; binutil's strip b0rkes MesCC/M1/hex2 binaries
(synopsis "Scheme interpreter and C compiler for full source bootstrapping")
(description
"GNU Mes [Maxwell Equations of Software] aims to create full source
bootstrapping for GuixSD. It consists of a mutual self-hosting [close to
Guile-] Scheme interpreter prototype in C and a Nyacc-based C compiler in
[Guile] Scheme.")
"GNU Mes--Maxwell Equations of Software--brings the Reduced Binary Seed
bootstrap to Guix and aims to help create full source bootstrapping for
GNU/Linux distributions. It consists of a mutual self-hosting Scheme
interpreter in C and a Nyacc-based C compiler in Scheme and is compatible with
Guile.")
(home-page "https://gnu.org/software/mes")
(license gpl3+))))

27
gnu/packages/monitoring.scm
View File

@ -151,7 +151,7 @@ etc. via a Web interface. Features include:
(define-public zabbix-agentd
(package
(name "zabbix-agentd")
(version "3.4.11")
(version "4.0.2")
(source
(origin
(method url-fetch)
@ -160,7 +160,7 @@ etc. via a Web interface. Features include:
"/zabbix-" version ".tar.gz"))
(sha256
(base32
"0qxgf6hx7ibhjmxd2sxizkjc8df4c9d31wz5hhql409ws98qf173"))))
"033qb4b9y02jp2ijj8ny0a0yk1mzj0a8ihxrv11h7ln8kpl55vqw"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@ -182,21 +182,34 @@ solution (client-side agent)")
(package
(inherit zabbix-agentd)
(name "zabbix-server")
(outputs '("out" "front-end" "schema"))
(arguments
(substitute-keyword-arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'install 'install-frontend
(add-after 'install 'install-front-end
(lambda* (#:key outputs #:allow-other-keys)
(let* ((php (string-append (assoc-ref outputs "out")
(let* ((php (string-append (assoc-ref outputs "front-end")
"/share/zabbix/php"))
(front-end-conf (string-append php "/conf"))
(etc (string-append php "/etc")))
(mkdir-p php)
(copy-recursively "./frontends/php" php)
(copy-recursively "frontends/php" php)
;; Make front-end write config to ‘/etc/zabbix’ directory.
(rename-file front-end-conf
(string-append front-end-conf "-example"))
(symlink "/etc/zabbix" front-end-conf)))))
(symlink "/etc/zabbix" front-end-conf))
#t))
(add-after 'install 'install-schema
(lambda* (#:key outputs #:allow-other-keys)
(let ((database-directory
(string-append (assoc-ref outputs "schema")
"/database")))
(for-each delete-file
(find-files "database" "Makefile\\.in|\\.am$"))
(mkdir-p database-directory)
(copy-recursively "database" database-directory))
#t)))
,@(package-arguments zabbix-agentd))
((#:configure-flags flags)
`(cons* "--enable-server"
@ -207,6 +220,8 @@ solution (client-side agent)")
(string-append "--with-gnutls="
(assoc-ref %build-inputs "gnutls"))
"--with-libcurl"
(string-append "--with-zlib="
(assoc-ref %build-inputs "zlib"))
,flags))))
(inputs
`(("curl" ,curl)

8
gnu/packages/mpd.scm
View File

@ -189,16 +189,16 @@ player daemon.")
(define-public ncmpc
(package
(name "ncmpc")
(version "0.32")
(version "0.33")
(source (origin
(method url-fetch)
(uri
(string-append "http://musicpd.org/download/ncmpc/"
(car (string-split version #\.))
(version-major version)
"/ncmpc-" version ".tar.xz"))
(sha256
(base32
"1b01q1pcaw5yyhvmlffc3h0r3w8qy7rhn55a7xj4qkcfqvs8ap08"))))
"19fp7xkpai4lq3vmpbppgh3ism7lg2sibv237c0sl5a0hls4mq4l"))))
(build-system meson-build-system)
(arguments
`(#:configure-flags
@ -216,7 +216,7 @@ player daemon.")
(c++ (string-append gcc "/include/c++")))
(setenv path (string-append c++ ":" (getenv path)))
#t))))))
(inputs `(("gcc", gcc-8) ; for its C++14 support
(inputs `(("gcc" ,gcc-8) ; for its C++14 support
("boost" ,boost)
("pcre" ,pcre)
("libmpdclient" ,libmpdclient)

4
gnu/packages/networking.scm
View File

@ -586,7 +586,7 @@ of the same name.")
(define-public wireshark
(package
(name "wireshark")
(version "2.6.4")
(version "2.6.5")
(source
(origin
(method url-fetch)
@ -594,7 +594,7 @@ of the same name.")
version ".tar.xz"))
(sha256
(base32
"0qf81dk726sdsmjqa9nd251j1cwvzkyb4hrlp6w4iwa3cdz00sx0"))))
"12j3fw0j8qcr86c1vsz4bsb55j9inp0ll3wjjdvg1cj4hmwmn5ck"))))
(build-system gnu-build-system)
(inputs `(("c-ares" ,c-ares)
("glib" ,glib)

286
gnu/packages/ocaml.scm
View File

@ -63,6 +63,7 @@
#:use-module (gnu packages web-browsers)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (guix build-system dune)
#:use-module (guix build-system gnu)
#:use-module (guix build-system ocaml)
#:use-module (guix download)
@ -384,7 +385,13 @@ functional, imperative and object-oriented styles of programming.")
;; Use bwrap from the store directly.
(substitute* "src/state/shellscripts/bwrap.sh"
(("-v bwrap") (string-append "-v " bwrap))
(("exec bwrap") (string-append "exec " bwrap)))
(("exec bwrap") (string-append "exec " bwrap))
;; Mount /gnu and /run/current-system in the
;; isolated environment when building with opam.
;; This is necessary for packages to find external
;; dependencies, such as a C compiler, make, etc...
(("^add_mounts ro /usr")
"add_mounts ro /gnu /run/current-system /usr"))
(substitute* "src/client/opamInitDefaults.ml"
(("\"bwrap\"") (string-append "\"" bwrap "\"")))
;; Build dependencies
@ -642,9 +649,6 @@ the OCaml core distribution.")
(variable "COQPATH")
(files (list "lib/coq/user-contrib")))))
(build-system ocaml-build-system)
(native-inputs
`(("texlive" ,texlive)
("hevea" ,hevea)))
(inputs
`(("lablgtk" ,lablgtk)
("python" ,python-2)
@ -996,7 +1000,7 @@ libpanel, librsvg and quartz.")
`(("ocaml" ,ocaml-4.02)
;; For documentation
("ghostscript" ,ghostscript)
("texlive" ,texlive)
("texlive" ,texlive-tiny)
("hevea" ,hevea)
("lynx" ,lynx)
("which" ,which)))
@ -1561,26 +1565,13 @@ following a very simple s-expression syntax.")
(sha256
(base32
"01zjp1q4hryqaxv4apkjd868fycz2kf887r6lkb6x2a545h1lh7f"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "jbuilder" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "jbuilder" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))))
#:jbuild? #t))
(propagated-inputs
`(("ocamlbuild" ,ocamlbuild)
("ocaml-result" ,ocaml-result)))
(native-inputs
`(("dune" ,dune)))
(home-page "https://github.com/ocaml-ppx/ocaml-migrate-parsetree")
(synopsis "OCaml parsetree convertor")
(description "This library converts between parsetrees of different OCaml
@ -1601,60 +1592,9 @@ functions to the next and/or previous version.")
(sha256
(base32
"1x2xfjpkzbcz4rza1d7gh3ipliw6jqfcklbsln82v3561qgkqgmh"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))))
(native-inputs
`(("dune" ,dune)))
(propagated-inputs
`(("ocaml-migrate-parsetree" ,ocaml-migrate-parsetree)))
(home-page "https://github.com/let-def/ppx_tools_versioned")
(synopsis "Variant of ppx_tools")
(description "This package is a variant of ppx_tools based on
ocaml-migrate-parsetree")
(license license:expat)))
(define-public ocaml-ppx-tools-versioned
(package
(name "ocaml-ppx-tools-versioned")
(version "5.2.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/ocaml-ppx/"
"ppx_tools_versioned/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1x2xfjpkzbcz4rza1d7gh3ipliw6jqfcklbsln82v3561qgkqgmh"))))
(build-system ocaml-build-system)
(arguments
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))))
(native-inputs
`(("dune" ,dune)))
`(#:test-target "."))
(propagated-inputs
`(("ocaml-migrate-parsetree" ,ocaml-migrate-parsetree)))
(home-page "https://github.com/let-def/ppx_tools_versioned")
@ -1675,31 +1615,19 @@ ocaml-migrate-parsetree")
(sha256
(base32
"15jjk2pq1vx311gl49s5ag6x5y0654x35w75z07g7kr2q334hqps"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(native-inputs
`(("camlp4" ,camlp4)
("time" ,time)
("autoconf" ,autoconf)
("automake" ,automake)
("bisect" ,ocaml-bisect)
("dune" ,dune)))
("bisect" ,ocaml-bisect)))
(propagated-inputs
`(("camlp4" ,camlp4)
("ocaml-ppx-tools-versioned" ,ocaml-ppx-tools-versioned)))
(arguments
`(#:tests? #f; Tests fail to build
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "jbuilder" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))))
#:jbuild? #t))
(properties
`((ocaml4.02-variant . ,(delay ocaml4.02-bitstring))))
(home-page "https://github.com/xguerin/bitstring")
@ -1725,44 +1653,45 @@ powerful.")
(base32
"0vy8ibrxccii1jbsk5q6yh1kxjigqvi7lhhcmizvd5gfhf7mfyc8"))
(patches (search-patches "ocaml-bitstring-fix-configure.patch"))))
(arguments
`(#:ocaml ,ocaml-4.02
#:findlib ,ocaml4.02-findlib
#:configure-flags
(list "CAMLP4OF=camlp4of" "--enable-coverage")
#:make-flags
(list (string-append "BISECTLIB="
(assoc-ref %build-inputs "bisect")
"/lib/ocaml/site-lib")
(string-append "OCAMLCFLAGS=-g -I "
(assoc-ref %build-inputs "camlp4")
"/lib/ocaml/site-lib/camlp4 -I "
"$(BISECTLIB)/bisect")
(string-append "OCAMLOPTFLAGS=-g -I "
(assoc-ref %build-inputs "camlp4")
"/lib/ocaml/site-lib/camlp4 -I "
"$(BISECTLIB)/bisect"))
#:phases
(modify-phases %standard-phases
(add-after 'install 'link-lib
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(stubs (string-append out
"/lib/ocaml/site-lib/stubslibs"))
(lib (string-append out
"/lib/ocaml/site-lib/bitstring")))
(mkdir-p stubs)
(symlink (string-append lib "/dllbitstring.so")
(string-append stubs "/dllbitstring.so")))
#t))
(add-before 'configure 'fix-configure
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "Makefile.in"
(("@abs_top_builddir@")
(string-append "@abs_top_builddir@:" (getenv "LIBRARY_PATH"))))
(substitute* "configure"
(("-/bin/sh") (string-append "-" (assoc-ref inputs "bash")
"/bin/sh"))))))))
(build-system ocaml-build-system)
(arguments
`(#:ocaml ,ocaml-4.02
#:findlib ,ocaml4.02-findlib
#:configure-flags
(list "CAMLP4OF=camlp4of" "--enable-coverage")
#:make-flags
(list (string-append "BISECTLIB="
(assoc-ref %build-inputs "bisect")
"/lib/ocaml/site-lib")
(string-append "OCAMLCFLAGS=-g -I "
(assoc-ref %build-inputs "camlp4")
"/lib/ocaml/site-lib/camlp4 -I "
"$(BISECTLIB)/bisect")
(string-append "OCAMLOPTFLAGS=-g -I "
(assoc-ref %build-inputs "camlp4")
"/lib/ocaml/site-lib/camlp4 -I "
"$(BISECTLIB)/bisect"))
#:phases
(modify-phases %standard-phases
(add-after 'install 'link-lib
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(stubs (string-append out
"/lib/ocaml/site-lib/stubslibs"))
(lib (string-append out
"/lib/ocaml/site-lib/bitstring")))
(mkdir-p stubs)
(symlink (string-append lib "/dllbitstring.so")
(string-append stubs "/dllbitstring.so")))
#t))
(add-before 'configure 'fix-configure
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "Makefile.in"
(("@abs_top_builddir@")
(string-append "@abs_top_builddir@:" (getenv "LIBRARY_PATH"))))
(substitute* "configure"
(("-/bin/sh") (string-append "-" (assoc-ref inputs "bash")
"/bin/sh"))))))))
(native-inputs
`(("camlp4" ,camlp4-4.02)
("time" ,time)
@ -2232,26 +2161,18 @@ through Transport Layer Security (@dfn{TLS}) encrypted connections.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256 (base32
"0mhh019bjkg5xfvpy1pxs4xdxb759fyydmgb6l4j0qww1qgr8klp"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:tests? #f; require lwt_ppx
#:jbuild? #t
#:phases
(modify-phases %standard-phases
(replace 'configure
(add-before 'build 'configure
(lambda _
(invoke "ocaml" "src/util/configure.ml" "-use-libev" "true")
#t))
(replace 'build
(lambda _
(invoke "jbuilder" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "jbuilder" "install" "--prefix" (assoc-ref outputs "out"))
#t)))))
(native-inputs
`(("dune" ,dune)
("ocaml-cppo" ,ocaml-cppo)
`(("ocaml-cppo" ,ocaml-cppo)
("ocaml-migrate-parsetree" ,ocaml-migrate-parsetree)
("pkg-config" ,pkg-config)
("ppx-tools-versioned" ,ocaml-ppx-tools-versioned)))
@ -2285,22 +2206,10 @@ locks or other synchronization primitives.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256 (base32
"1lr62j2266pbsi54xmzsfvl2z7fi7smhak7fp1ybl8hssxwi6in2"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:tests? #f; require lwt_ppx
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "jbuilder" "build" "@install")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "jbuilder" "install" "--prefix" (assoc-ref outputs "out"))
#t)))))
(native-inputs
`(("dune" ,dune)))
#:jbuild? #t))
(propagated-inputs
`(("lwt" ,ocaml-lwt)))
(home-page "https://github.com/aantron/lwt_log")
@ -3114,24 +3023,12 @@ provide a tool that can be used to:
(sha256 (base32
"1dkm3d5h6h56y937gcdk2wixlpzl59vv5pmiafglr89p20kf7gqf"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install" "--profile" "release")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))
#:tests? #f))
`(#:tests? #f
#:build-flags (list "--profile" "release")))
(native-inputs
`(("dune" ,dune)
("ocamlbuild" ,ocamlbuild)))
`(("ocamlbuild" ,ocamlbuild)))
(home-page "https://github.com/mjambon/cppo")
(synopsis "Equivalent of the C preprocessor for OCaml programs")
(description "Cppo is an equivalent of the C preprocessor for OCaml
@ -3766,26 +3663,14 @@ standard iterator type starting from 4.07.")
(sha256
(base32
"1pdb0mr6z5ax6szblr3f5lbdnqq9grm97cmsfjmdma60yrx2rqhd"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install" "--profile" "release")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))))
#:build-flags (list "--profile" "release")))
(propagated-inputs
`(("ocaml-seq" ,ocaml-seq)))
(native-inputs
`(("dune" ,dune)
("ounit" ,ocaml-ounit)))
`(("ounit" ,ocaml-ounit)))
(home-page "https://github.com/ocaml/ocaml-re/")
(synopsis "Regular expression library for OCaml")
(description "Pure OCaml regular expressions with:
@ -4518,23 +4403,11 @@ the plugins facilitate extensibility, and the frontends serve as entry points.")
(sha256
(base32
"01ssjrqz41jvrqh27jxnh9cx7ywi9b5sgsykd00i7z9nrcwhlfy2"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(native-inputs
`(("camlp4" ,camlp4)
("dune" ,dune)))
`(("camlp4" ,camlp4)))
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install" "--profile" "release")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))
`(#:build-flags (list "--profile" "realease")
#:tests? #f))
(synopsis "Comprehensive Unicode library")
(description "Camomile is a Unicode library for OCaml. Camomile provides
@ -4635,23 +4508,10 @@ connect an engine to your inputs and rendering functions to get an editor.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1hy5ryagqclgdm9lzh1qil5mrynlypv7mn6qm858hdcnmz9zzn0l"))))
(build-system ocaml-build-system)
(build-system dune-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(invoke "dune" "build" "@install" "--profile" "release")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "dune" "install"
"--prefix" (assoc-ref outputs "out"))
#t)))
`(#:build-flags (list "--profile" "release")
#:tests? #f))
(native-inputs
`(("dune" ,dune)))
(propagated-inputs
`(("lwt" ,ocaml-lwt)
("lwt-log" ,ocaml-lwt-log)

2
gnu/packages/opencl.scm
View File

@ -240,7 +240,7 @@ the system.")
("llvm@3.7" ,llvm-3.7)
("libdrm" ,libdrm)
("libedit" ,libedit)
("libpthread-stubs", libpthread-stubs)
("libpthread-stubs" ,libpthread-stubs)
("libsm" ,libsm)
("libva" ,libva)
("libxfixes" ,libxfixes)

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

@ -50,6 +50,7 @@
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
#:use-module (gnu packages linux)
#:use-module (gnu packages lisp)
@ -68,8 +69,10 @@
#:use-module (gnu packages time)
#:use-module (gnu packages tls)
#:use-module (gnu packages vim)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages web)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (guix build-system emacs)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
@ -102,8 +105,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this.
(let ((version "0.16.0")
(commit "6ddc63e599a26c302f74d0622f67cfd987f0dc5f")
(revision 3))
(commit "bdf860c2e99077d431da0cc1db4fc14db2a35d31")
(revision 6))
(package
(name "guix")
@ -119,7 +122,7 @@
(commit commit)))
(sha256
(base32
"0vzxrsfbr4phhy60m7pc6klb61whqc404c3x76ydj70xvi1xa0wz"))
"0876y2pjcrwb3ynxqlpkn3pxx2iil8hrzdadh23jd6jbhvm087q1"))
(file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system)
(arguments
@ -934,15 +937,15 @@ for packaging and deployment of cross-compiled Windows applications.")
(define-public libostree
(package
(name "libostree")
(version "2018.7")
(version "2018.9.1")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/ostreedev/ostree/releases/download/v"
version "/libostree-" version ".tar.xz"))
(version-major+minor version) "/libostree-" version ".tar.xz"))
(sha256
(base32
"1nc310lv36psxn5yslkxlgi9gjxwqpwqzkg2pldgpwrlv6gkagj8"))))
"01mygpkbl9sk2vr3hjbpih6qlg8lwx0q5lklm09f7jfwfpnwyqzj"))))
(build-system gnu-build-system)
(arguments
'(#:phases
@ -984,3 +987,51 @@ tools that combines a \"git-like\" model for committing and downloading
bootable filesystem trees, along with a layer for deploying them and managing
the bootloader configuration.")
(license license:lgpl2.0+)))
(define-public flatpak
(package
(name "flatpak")
(version "1.1.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/flatpak/flatpak/releases/download/"
version "/flatpak-" version ".tar.xz"))
(sha256
(base32
"0bkjwh49kajyd78vdh0g9arb352a7rccaifas9zxa78phhja2v2p"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ;; Tests fail due to trying to create files where it can't.
#:configure-flags (list
"--enable-documentation=no" ;; FIXME
"--enable-system-helper=no"
"--localstatedir=/var"
(string-append "--with-system-bubblewrap="
(assoc-ref %build-inputs "bubblewrap")
"/bin/bwrap"))))
(native-inputs `(("bison" ,bison)
("gettext" ,gnu-gettext)
("glib:bin" ,glib "bin") ; for glib-mkenums + gdbus-codegen
("gobject-introspection" ,gobject-introspection)
("libcap" ,libcap)
("pkg-config" ,pkg-config)))
(inputs `(("appstream-glib" ,appstream-glib)
("bubblewrap" ,bubblewrap)
("gdk-pixbuf" ,gdk-pixbuf)
("gpgme" ,gpgme)
("json-glib" ,json-glib)
("libarchive" ,libarchive)
("libostree" ,libostree)
("libseccomp" ,libseccomp)
("libsoup" ,libsoup)
("libxau" ,libxau)
("libxml2" ,libxml2)
("nettle" ,nettle)
("util-linux" ,util-linux)))
(home-page "https://flatpak.org")
(synopsis "System for building, distributing, and running sandboxed desktop
applications")
(description "Flatpak is a system for building, distributing, and running
sandboxed desktop applications on GNU/Linux.")
(license license:lgpl2.1+)))

22
gnu/packages/patches/ansible-wrap-program-hack.patch
View File

@ -1,22 +0,0 @@
Ansible changes its behaviour depending on the name of the script that it is
called as. Make it deal with guix' .real wrapper scripts.
FIXME: Remove once wrapping ansible works properly.
See http://lists.gnu.org/archive/html/bug-guix/2017-05/msg00015.html.
--- ansible-2.3.0.0/bin/ansible 2017-04-12 16:08:05.000000000 +0200
+++ ansible-2.3.0.0-fixed/bin/ansible 2017-05-21 20:11:18.720872385 +0200
@@ -75,7 +75,13 @@
# sometimes add that
target = target[:-1]
- if len(target) > 1:
+ if target[-1] == "real" and target[0].startswith('.'):
+ target = target[:-1]
+ target[0] = target[0][1:]
+ if len(target) > 1 and target[1] != "real" :
+ sub = target[1]
+ myclass = "%sCLI" % sub.capitalize()
+ elif len(target) > 2 and target[2] == "real" :
sub = target[1]
myclass = "%sCLI" % sub.capitalize()
elif target[0] == 'ansible':

20
gnu/packages/patches/emacs-wordnut-require-adaptive-wrap.patch Normal file
View File

@ -0,0 +1,20 @@
Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
This patch forces the use of adaptive-wrap. This feature is optional but we
prefer to enable it by default.
diff --git a/wordnut.el b/wordnut.el
index 0ae86ad..72f9221 100644
--- a/wordnut.el
+++ b/wordnut.el
@@ -4,6 +4,7 @@
(require 'subr-x)
(require 'outline)
(require 'imenu)
+(require 'adaptive-wrap)
(require 'wordnut-history)
--
2.17.1

190
gnu/packages/patches/glibc-hurd-magic-pid.patch Normal file
View File

@ -0,0 +1,190 @@
This patch implements "magic" lookup for "pid/…", as used when looking up
/proc/self.
The patch comes from the 't/magic-pid' branch
at <https://git.savannah.gnu.org/cgit/hurd/glibc.git>. It squashes
commit 392e52286a302ca6157fbd221295e64ab6b6d8ba (by Justus Winter)
and commit 392e52286a302ca6157fbd221295e64ab6b6d8ba (a subsequent fix by
Samuel Thibault).
From: Justus Winter <4winter@informatik.uni-hamburg.de>
Subject: [PATCH] hurd: Handle `pid' magical lookup retry
* hurd/lookup-retry.c: Handle `pid' magical lookup
retry.
diff --git a/hurd/lookup-retry.c b/hurd/lookup-retry.c
index aee2ba8f93..6ed8de1653 100644
--- a/hurd/lookup-retry.c
+++ b/hurd/lookup-retry.c
@@ -25,6 +25,7 @@
#include <string.h>
#include <_itoa.h>
#include <eloop-threshold.h>
+#include <unistd.h>
/* Translate the error from dir_lookup into the error the user sees. */
static inline error_t
@@ -59,6 +60,7 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
error_t err;
char *file_name;
int nloops;
+ file_t lastdir = MACH_PORT_NULL;
error_t lookup_op (file_t startdir)
{
@@ -107,14 +109,15 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
{
case FS_RETRY_REAUTH:
if (err = reauthenticate (*result))
- return err;
+ goto out;
/* Fall through. */
case FS_RETRY_NORMAL:
if (nloops++ >= __eloop_threshold ())
{
__mach_port_deallocate (__mach_task_self (), *result);
- return ELOOP;
+ err = ELOOP;
+ goto out;
}
/* An empty RETRYNAME indicates we have the final port. */
@@ -174,7 +177,7 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
if (err)
__mach_port_deallocate (__mach_task_self (), *result);
- return err;
+ goto out;
}
startdir = *result;
@@ -189,7 +192,10 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
if (*result != MACH_PORT_NULL)
__mach_port_deallocate (__mach_task_self (), *result);
if (nloops++ >= __eloop_threshold ())
- return ELOOP;
+ {
+ err = ELOOP;
+ goto out;
+ }
file_name = &retryname[1];
break;
@@ -208,7 +214,8 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
(*end != '/' && *end != '\0'))
{
errno = save;
- return ENOENT;
+ err = ENOENT;
+ goto out;
}
if (! get_dtable_port)
err = EGRATUITOUS;
@@ -226,9 +233,12 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
}
errno = save;
if (err)
- return err;
+ goto out;
if (*end == '\0')
- return 0;
+ {
+ err = 0;
+ goto out;
+ }
else
{
/* Do a normal retry on the remaining components. */
@@ -255,9 +265,12 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
if (err = __host_info (__mach_host_self (), HOST_BASIC_INFO,
(integer_t *) &hostinfo,
&hostinfocnt))
- return err;
+ goto out;
if (hostinfocnt != HOST_BASIC_INFO_COUNT)
- return EGRATUITOUS;
+ {
+ err = EGRATUITOUS;
+ goto out;
+ }
p = _itoa (hostinfo.cpu_subtype, &retryname[8], 10, 0);
*--p = '/';
p = _itoa (hostinfo.cpu_type, &retryname[8], 10, 0);
@@ -293,10 +306,11 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
}
case '\0':
- return opentty (result);
+ err = opentty (result);
+ goto out;
case '/':
if (err = opentty (&startdir))
- return err;
+ goto out;
strcpy (retryname, &retryname[4]);
break;
default:
@@ -306,14 +320,48 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
goto bad_magic;
break;
+ case 'p':
+ if (retryname[1] == 'i' && retryname[2] == 'd' &&
+ (retryname[3] == '/' || retryname[3] == 0))
+ {
+ char *p, buf[1024]; /* XXX */
+ size_t len;
+ p = _itoa (__getpid (), &buf[sizeof buf], 10, 0);
+ len = &buf[sizeof buf] - p;
+ memcpy (buf, p, len);
+ strcpy (buf + len, &retryname[3]);
+ strcpy (retryname, buf);
+
+ /* Do a normal retry on the remaining components. */
+ __mach_port_mod_refs (__mach_task_self (), lastdir,
+ MACH_PORT_RIGHT_SEND, 1);
+ startdir = lastdir;
+ file_name = retryname;
+ }
+ else
+ goto bad_magic;
+ break;
+
default:
bad_magic:
- return EGRATUITOUS;
+ err = EGRATUITOUS;
+ goto out;
}
break;
default:
- return EGRATUITOUS;
+ err = EGRATUITOUS;
+ goto out;
+ }
+
+ if (MACH_PORT_VALID (*result) && *result != lastdir)
+ {
+ if (MACH_PORT_VALID (lastdir))
+ __mach_port_deallocate (__mach_task_self (), lastdir);
+
+ lastdir = *result;
+ __mach_port_mod_refs (__mach_task_self (), lastdir,
+ MACH_PORT_RIGHT_SEND, 1);
}
if (startdir != MACH_PORT_NULL)
@@ -326,6 +374,10 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
err = (*use_init_port) (dirport, &lookup_op);
} while (! err);
+out:
+ if (MACH_PORT_VALID (lastdir))
+ __mach_port_deallocate (__mach_task_self (), lastdir);
+
return err;
}
weak_alias (__hurd_file_name_lookup_retry, hurd_file_name_lookup_retry)

50
gnu/packages/patches/meandmyshadow-define-paths-earlier.patch
View File

@ -1,50 +0,0 @@
From: Tobias Geerinckx-Rice <me@tobias.gr>
Date: Wed, 31 Oct 2018 02:24:26 +0100
Subject: [PATCH] gnu: meandmyshadow: Define paths earlier.
The following patch was taken verbatim from the upstream repository[0]
and will be included in the next release.
[0]: https://github.com/acmepjz/meandmyshadow/pull/29
---
From 4847e6b5755258a1e0534f2d4b91dce2ce3b459e Mon Sep 17 00:00:00 2001
From: Dmitry Marakasov <amdmi3@amdmi3.ru>
Date: Wed, 24 Oct 2018 23:31:19 +0300
Subject: [PATCH] Define paths earlier in CMakeLists.txt
At the very least, paths should be defined before Configure_File(), otherwise empty DATAROOTDIR is substituted in config.h
---
CMakeLists.txt | 13 +++++++------
1 file changed, 7 insertions(+), 6 deletions(-)
diff --git a/CMakeLists.txt b/CMakeLists.txt
index e79639a..6321d9d 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -2,6 +2,13 @@ Project (meandmyshadow)
CMake_Minimum_Required (VERSION 3.1)
Set (CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${CMAKE_SOURCE_DIR}/cmake/Modules/")
+#Path options
+Set (BINDIR "bin" CACHE STRING "Where to install binaries")
+Set (DATAROOTDIR "${CMAKE_INSTALL_PREFIX}/share" CACHE STRING "Sets the root of data directories to a non-default location")
+Set (ICONDIR "${DATAROOTDIR}/icons" CACHE STRING "Sets the icon directory for desktop entry to a non-default location.")
+Set (DESKTOPDIR "${DATAROOTDIR}/applications" CACHE STRING "Sets the desktop file directory for desktop entry to a non-default location.")
+
+#Options
Option (DEBUG_MODE "Compile the game with debug mode enabled" OFF)
Option (DISABLED_DEBUG_STUFF "Enable this you'll see a lot of annoying script debug messages which will lag the game." OFF)
@@ -164,12 +171,6 @@ Target_Link_Libraries (
${LUA_LIBRARIES}
)
-#Path options
-Set (BINDIR "bin" CACHE STRING "Where to install binaries")
-Set (DATAROOTDIR "${CMAKE_INSTALL_PREFIX}/share" CACHE STRING "Sets the root of data directories to a non-default location")
-Set (ICONDIR "${DATAROOTDIR}/icons" CACHE STRING "Sets the icon directory for desktop entry to a non-default location.")
-Set (DESKTOPDIR "${DATAROOTDIR}/applications" CACHE STRING "Sets the desktop file directory for desktop entry to a non-default location.")
-
#Install locations
Install (DIRECTORY ${PROJECT_SOURCE_DIR}/data DESTINATION ${DATAROOTDIR}/meandmyshadow/)
Install (FILES AUTHORS DESTINATION ${DATAROOTDIR}/meandmyshadow/)

158
gnu/packages/patches/qemu-CVE-2018-16847.patch
View File

@ -1,158 +0,0 @@
Fix CVE-2018-16847:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-16847
Patch copied from upstream source repository:
https://git.qemu.org/?p=qemu.git;a=commitdiff;h=87ad860c622cc8f8916b5232bd8728c08f938fce
From 87ad860c622cc8f8916b5232bd8728c08f938fce Mon Sep 17 00:00:00 2001
From: Paolo Bonzini <pbonzini@redhat.com>
Date: Tue, 20 Nov 2018 19:41:48 +0100
Subject: [PATCH] nvme: fix out-of-bounds access to the CMB
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Because the CMB BAR has a min_access_size of 2, if you read the last
byte it will try to memcpy *2* bytes from n->cmbuf, causing an off-by-one
error. This is CVE-2018-16847.
Another way to fix this might be to register the CMB as a RAM memory
region, which would also be more efficient. However, that might be a
change for big-endian machines; I didn't think this through and I don't
know how real hardware works. Add a basic testcase for the CMB in case
somebody does this change later on.
Cc: Keith Busch <keith.busch@intel.com>
Cc: qemu-block@nongnu.org
Reported-by: Li Qiang <liq3ea@gmail.com>
Reviewed-by: Li Qiang <liq3ea@gmail.com>
Tested-by: Li Qiang <liq3ea@gmail.com>
Signed-off-by: Paolo Bonzini <pbonzini@redhat.com>
Reviewed-by: Philippe Mathieu-Daudé <philmd@redhat.com>
Tested-by: Philippe Mathieu-Daudé <philmd@redhat.com>
Signed-off-by: Kevin Wolf <kwolf@redhat.com>
---
hw/block/nvme.c | 2 +-
tests/Makefile.include | 2 +-
tests/nvme-test.c | 68 +++++++++++++++++++++++++++++++++++-------
3 files changed, 60 insertions(+), 12 deletions(-)
diff --git a/hw/block/nvme.c b/hw/block/nvme.c
index 28d284346dd..8c35cab2b43 100644
--- a/hw/block/nvme.c
+++ b/hw/block/nvme.c
@@ -1201,7 +1201,7 @@ static const MemoryRegionOps nvme_cmb_ops = {
.write = nvme_cmb_write,
.endianness = DEVICE_LITTLE_ENDIAN,
.impl = {
- .min_access_size = 2,
+ .min_access_size = 1,
.max_access_size = 8,
},
};
diff --git a/tests/Makefile.include b/tests/Makefile.include
index 613242bc6ef..fb0b449c02a 100644
--- a/tests/Makefile.include
+++ b/tests/Makefile.include
@@ -730,7 +730,7 @@ tests/test-hmp$(EXESUF): tests/test-hmp.o
tests/machine-none-test$(EXESUF): tests/machine-none-test.o
tests/drive_del-test$(EXESUF): tests/drive_del-test.o $(libqos-virtio-obj-y)
tests/qdev-monitor-test$(EXESUF): tests/qdev-monitor-test.o $(libqos-pc-obj-y)
-tests/nvme-test$(EXESUF): tests/nvme-test.o
+tests/nvme-test$(EXESUF): tests/nvme-test.o $(libqos-pc-obj-y)
tests/pvpanic-test$(EXESUF): tests/pvpanic-test.o
tests/i82801b11-test$(EXESUF): tests/i82801b11-test.o
tests/ac97-test$(EXESUF): tests/ac97-test.o
diff --git a/tests/nvme-test.c b/tests/nvme-test.c
index 7674a446e4f..2700ba838aa 100644
--- a/tests/nvme-test.c
+++ b/tests/nvme-test.c
@@ -8,25 +8,73 @@
*/
#include "qemu/osdep.h"
+#include "qemu/units.h"
#include "libqtest.h"
+#include "libqos/libqos-pc.h"
+
+static QOSState *qnvme_start(const char *extra_opts)
+{
+ QOSState *qs;
+ const char *arch = qtest_get_arch();
+ const char *cmd = "-drive id=drv0,if=none,file=null-co://,format=raw "
+ "-device nvme,addr=0x4.0,serial=foo,drive=drv0 %s";
+
+ if (strcmp(arch, "i386") == 0 || strcmp(arch, "x86_64") == 0) {
+ qs = qtest_pc_boot(cmd, extra_opts ? : "");
+ global_qtest = qs->qts;
+ return qs;
+ }
+
+ g_printerr("nvme tests are only available on x86\n");
+ exit(EXIT_FAILURE);
+}
+
+static void qnvme_stop(QOSState *qs)
+{
+ qtest_shutdown(qs);
+}
-/* Tests only initialization so far. TODO: Replace with functional tests */
static void nop(void)
{
+ QOSState *qs;
+
+ qs = qnvme_start(NULL);
+ qnvme_stop(qs);
}
-int main(int argc, char **argv)
+static void nvmetest_cmb_test(void)
{
- int ret;
+ const int cmb_bar_size = 2 * MiB;
+ QOSState *qs;
+ QPCIDevice *pdev;
+ QPCIBar bar;
- g_test_init(&argc, &argv, NULL);
- qtest_add_func("/nvme/nop", nop);
+ qs = qnvme_start("-global nvme.cmb_size_mb=2");
+ pdev = qpci_device_find(qs->pcibus, QPCI_DEVFN(4,0));
+ g_assert(pdev != NULL);
+
+ qpci_device_enable(pdev);
+ bar = qpci_iomap(pdev, 2, NULL);
+
+ qpci_io_writel(pdev, bar, 0, 0xccbbaa99);
+ g_assert_cmpint(qpci_io_readb(pdev, bar, 0), ==, 0x99);
+ g_assert_cmpint(qpci_io_readw(pdev, bar, 0), ==, 0xaa99);
+
+ /* Test partially out-of-bounds accesses. */
+ qpci_io_writel(pdev, bar, cmb_bar_size - 1, 0x44332211);
+ g_assert_cmpint(qpci_io_readb(pdev, bar, cmb_bar_size - 1), ==, 0x11);
+ g_assert_cmpint(qpci_io_readw(pdev, bar, cmb_bar_size - 1), !=, 0x2211);
+ g_assert_cmpint(qpci_io_readl(pdev, bar, cmb_bar_size - 1), !=, 0x44332211);
+ g_free(pdev);
- qtest_start("-drive id=drv0,if=none,file=null-co://,format=raw "
- "-device nvme,drive=drv0,serial=foo");
- ret = g_test_run();
+ qnvme_stop(qs);
+}
- qtest_end();
+int main(int argc, char **argv)
+{
+ g_test_init(&argc, &argv, NULL);
+ qtest_add_func("/nvme/nop", nop);
+ qtest_add_func("/nvme/cmb_test", nvmetest_cmb_test);
- return ret;
+ return g_test_run();
}
--
2.19.2

49
gnu/packages/patches/qemu-CVE-2018-16867.patch
View File

@ -1,49 +0,0 @@
Fix CVE-2018-16867:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-16867
https://seclists.org/oss-sec/2018/q4/202
Patch copied from upstream source repository:
https://git.qemu.org/?p=qemu.git;a=commitdiff;h=c52d46e041b42bb1ee6f692e00a0abe37a9659f6
From c52d46e041b42bb1ee6f692e00a0abe37a9659f6 Mon Sep 17 00:00:00 2001
From: Gerd Hoffmann <kraxel@redhat.com>
Date: Mon, 3 Dec 2018 11:10:45 +0100
Subject: [PATCH] usb-mtp: outlaw slashes in filenames
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Slash is unix directory separator, so they are not allowed in filenames.
Note this also stops the classic escape via "../".
Fixes: CVE-2018-16867
Reported-by: Michael Hanselmann <public@hansmi.ch>
Signed-off-by: Gerd Hoffmann <kraxel@redhat.com>
Reviewed-by: Philippe Mathieu-Daudé <philmd@redhat.com>
Message-id: 20181203101045.27976-3-kraxel@redhat.com
---
hw/usb/dev-mtp.c | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/hw/usb/dev-mtp.c b/hw/usb/dev-mtp.c
index 0f6a9702ef1..100b7171f4e 100644
--- a/hw/usb/dev-mtp.c
+++ b/hw/usb/dev-mtp.c
@@ -1719,6 +1719,12 @@ static void usb_mtp_write_metadata(MTPState *s)
filename = utf16_to_str(dataset->length, dataset->filename);
+ if (strchr(filename, '/')) {
+ usb_mtp_queue_result(s, RES_PARAMETER_NOT_SUPPORTED, d->trans,
+ 0, 0, 0, 0);
+ return;
+ }
+
o = usb_mtp_object_lookup_name(p, filename, dataset->length);
if (o != NULL) {
next_handle = o->handle;
--
2.19.2

45
gnu/packages/patches/stumpwm-fix-broken-read-one-line.patch Normal file
View File

@ -0,0 +1,45 @@
From a13db62a4da06426cf2eb2376d1a3723b5ee52d5 Mon Sep 17 00:00:00 2001
From: Vasily Postnicov <shamaz.mazum@gmail.com>
Date: Fri, 14 Dec 2018 20:01:53 +0300
Subject: [PATCH] READ-ONE-LINE: Turn COMPLETIONS into a keyword argument
This keeps READ-ONE-line backwards compatible to changes prior
dae0422811771d179077b9336618f2b19be85b7b. Currently both
ARGUMENT-POP-OR-READ and ARGUMENT-POP-REST-OR-READ are still being
called with the previous lambda list. Update the calls to the
READ-ONE-LINE that used the 'new' lambda list, COMPLETING-READ and
YES-OR-NO-P.
Closes #538
---
input.lisp | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/input.lisp b/input.lisp
index b698a368..7904b35f 100644
--- a/input.lisp
+++ b/input.lisp
@@ -307,10 +307,13 @@ passed the substring to complete on and is expected to return a list
of matches. If require-match argument is non-nil then the input must
match with an element of the completions."
(check-type completions (or list function symbol))
- (let ((line (read-one-line screen prompt completions :initial-input initial-input :require-match require-match)))
+ (let ((line (read-one-line screen prompt
+ :completions completions
+ :initial-input initial-input
+ :require-match require-match)))
(when line (string-trim " " line))))
-(defun read-one-line (screen prompt completions &key (initial-input "") require-match password)
+(defun read-one-line (screen prompt &key completions (initial-input "") require-match password)
"Read a line of input through stumpwm and return it. Returns nil if the user aborted."
(let ((*input-last-command* nil)
(*input-completions* completions)
@@ -842,6 +845,7 @@ user presses 'y'"
user presses 'yes'"
(loop for line = (read-one-line (current-screen)
(format nil "~a(yes or no) " message)
+ :completions
'("yes" "no"))
until (find line '("yes" "no") :test 'string-equal)
do (message "Please answer yes or no")

2
gnu/packages/pdf.scm
View File

@ -429,7 +429,7 @@ using the DjVuLibre library.")
(inputs
`(("jbig2dec" ,jbig2dec)
("libjpeg" ,libjpeg)
("mujs", mujs)
("mujs" ,mujs)
("mupdf" ,mupdf)
("openjpeg" ,openjpeg)
("openssl" ,openssl)

4
gnu/packages/photo.scm
View File

@ -493,14 +493,14 @@ a complete panorama and stitch any series of overlapping pictures.")
(define-public rawtherapee
(package
(name "rawtherapee")
(version "5.4")
(version "5.5")
(source (origin
(method url-fetch)
(uri (string-append "http://rawtherapee.com/shared/source/"
"rawtherapee-" version ".tar.xz"))
(sha256
(base32
"1229hxqq824hcqg1hy2cfglsp7kjbhhis9m33ss39pgmrb1w227d"))))
"1w28a2rnxnw8hs7s8x8zkccgi5z5y653602jg7g86lfx6zxwjsf1"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f ; no test suite

28
gnu/packages/php.scm
View File

@ -48,12 +48,13 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:))
(define-public php
(package
(name "php")
(version "7.2.12")
(version "7.3.0")
(home-page "https://secure.php.net/")
(source (origin
(method url-fetch)
@ -61,7 +62,7 @@
name "-" version ".tar.xz"))
(sha256
(base32
"1qbz2j9kzqxxp0mmx02zavvz20ji7izqdnri25g1mrwyhz60974q"))
"1db0lm84hynilrjj3k1s7skp1y2gl4ip1ihr7662i2xgannmq6bx"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "ext"
@ -74,7 +75,7 @@
;;"fileinfo/libmagic" ; This is a patched version of libmagic.
'("gd/libgd"
"mbstring/oniguruma"
"pcre/pcrelib"
"pcre/pcre2lib"
"sqlite3/libsqlite"
"xmlrpc/libxmlrpc"
"zip/lib"))
@ -176,11 +177,6 @@
(substitute* "ext/standard/tests/streams/bug60602.phpt"
(("'ls'") (string-append "'" (which "ls") "'")))
;; The expected output is slightly different from what is given,
;; in a section that's not related to the actual test
(substitute* "sapi/cli/tests/upload_2G.phpt"
(("Test\\\\n") "Test\n\n"))
;; Drop tests that are known to fail.
(for-each delete-file
'("ext/posix/tests/posix_getgrgid.phpt" ; Requires /etc/group.
@ -291,7 +287,10 @@
"ext/ldap/tests/ldap_set_option_error.phpt"
;; Sometimes cannot start the LDAP server.
"ext/ldap/tests/bug76248.phpt"))
"ext/ldap/tests/bug76248.phpt"
;; Bug #76909 preg_match difference between 7.3 and < 7.3
"ext/pcre/tests/bug76909.phpt"))
;; Skip tests requiring network access.
(setenv "SKIP_ONLINE_TESTS" "1")
@ -324,7 +323,7 @@
("oniguruma" ,oniguruma-5)
("openldap" ,openldap)
("openssl" ,openssl)
("pcre" ,pcre)
("pcre" ,pcre2)
("postgresql" ,postgresql)
("readline" ,readline)
("sqlite" ,sqlite)
@ -350,3 +349,12 @@ systems, web content management systems and web frameworks." )
license:lgpl2.1+ ; ext/bcmath/libbcmath
license:bsd-2 ; ext/fileinfo/libmagic
license:expat)))) ; ext/date/lib
(define-public php-with-bcmath
(package
(inherit php)
(name "php-with-bcmath")
(arguments
(substitute-keyword-arguments (package-arguments php)
((#:configure-flags flags)
`(cons "--enable-bcmath" ,flags))))))

14
gnu/packages/python.scm
View File

@ -56,6 +56,7 @@
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018 Luther Thompson <lutheroto@gmail.com>
;;; Copyright © 2018 Vagrant Cascadian <vagrant@debian.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -10707,9 +10708,16 @@ useful as a validator for JSON data.")
(base32
"090vdksbz341f7ljvr0zswblw4lspa8qaiikzyjkf318arpxmil9"))))
(build-system python-build-system)
;; Test suite requires python-setuptools
(native-inputs
`(("python-setuptools" ,python-setuptools)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'set-pythonpath
(lambda _
(setenv "PYTHONPATH"
(string-append
(getcwd) "/test/"
":" (getenv "PYTHONPATH")))
#t)))))
(home-page
"https://github.com/eliben/pyelftools")
(synopsis

11
gnu/packages/rdf.scm
View File

@ -299,7 +299,7 @@ ideal (e.g. in LV2 implementations or embedded applications).")
(define-public python-rdflib
(package
(name "python-rdflib")
(version "4.1.2")
(version "4.2.2")
(source
(origin
(method url-fetch)
@ -307,15 +307,12 @@ ideal (e.g. in LV2 implementations or embedded applications).")
"https://pypi.python.org/packages/source/r/rdflib/rdflib-"
version
".tar.gz"))
(patches
;; The patch has no effect under Python 3.
(search-patches "python2-rdflib-drop-sparqlwrapper.patch"))
(sha256
(base32
"0kvaf332cqbi47rqzlpdx4mbkvw12mkrzkj8n9l19wk713d4py9w"))))
"0398c714znnhaa2x7v51b269hk20iz073knq2mvmqp2ma92z27fs"))))
(build-system python-build-system)
(arguments
'(;; FIXME: Three test failures. Try uncommenting the below next update.
'(;; FIXME: Three test failures. Should be fixed next release.
#:tests? #f))
;; #:phases
;; (modify-phases %standard-phases
@ -323,7 +320,7 @@ ideal (e.g. in LV2 implementations or embedded applications).")
;; (lambda _
;; ;; Run tests from the build directory so python3 only
;; ;; sees the installed 2to3 version.
;; (zero? (system* "nosetests" "--where=./build/src")))))
;; (zero? (system* "nosetests" "--where=./build/src")))))))
(native-inputs
`(("python-nose" ,python-nose)))
(propagated-inputs

26
gnu/packages/scheme.scm
View File

@ -80,7 +80,7 @@
(define-public mit-scheme
(package
(name "mit-scheme")
(version "9.2")
(version "10.1.3")
(source #f) ; see below
(outputs '("out" "doc"))
(build-system gnu-build-system)
@ -100,10 +100,7 @@
;; Delete these dangling symlinks since they break
;; `patch-shebangs'.
(for-each delete-file
(append '("src/lib/shim-config.scm")
(find-files "src/lib/lib" "\\.so$")
(find-files "src/lib" "^liarc-")
(find-files "src/compiler" "^make\\.")))
(find-files "src/compiler" "^make\\."))
(chdir "src")
#t))
;; FIXME: the texlive-union insists on regenerating fonts. It stores
@ -128,9 +125,6 @@
(invoke bin/sh "./configure"
(string-append "--prefix=" out)
(string-append "SHELL=" bin/sh))
(substitute* '("Makefile" "make-common")
(("/lib/mit-scheme/doc")
(string-append "/share/doc/" ,name "-" ,version)))
#t))))
(add-after 'build 'build-doc
(lambda* _
@ -147,11 +141,11 @@
(with-directory-excursion "../doc"
(for-each (lambda (target)
(invoke "make" target))
'("install-config" "install-info-gz" "install-man"
'("install-info-gz" "install-man"
"install-html" "install-pdf")))
(mkdir-p new-doc/mit-scheme-dir)
(copy-recursively
(string-append old-doc-dir "/" ,name "-" ,version)
(string-append old-doc-dir "/" ,name)
new-doc/mit-scheme-dir)
(delete-file-recursively old-doc-dir)
#t))))))
@ -185,16 +179,18 @@
(match (%current-system)
("x86_64-linux"
(base32
"1skzxxhr0iq96bf0j5m7mvf3i4sppfyfa6gpqn34mwgkw1fx8274"))
"03m7cc035w3avs91j2pcz9f15ssgvgp3rm045d1vbydqrkzfyw8k"))
("i686-linux"
(base32
"1fmlpnhf5a75db93phajh4ysbdgrgl72v45lk3kznriprl0a7jc6"))
"05sjyz90xxfnmi87qv8x0yx0fcallnzl1dciygdafp317pn489is"))
(_
(base32
"0w5ib5vsidihb4hb6fma3sp596ykr8izagm57axvgd6lqzwicsjg"))))))))
(base32
""))))))))
;; Fails to build on MIPS, see <http://bugs.gnu.org/18221>.
(supported-systems '("x86_64-linux" "i686-linux" "armhf-linux"))
;; Also, the portable C version of MIT/GNU Scheme did not work in time for
;; release in version 10.1.
(supported-systems '("x86_64-linux" "i686-linux"))
(home-page "https://www.gnu.org/software/mit-scheme/")
(synopsis "A Scheme implementation with integrated editor and debugger")

1
gnu/packages/serialization.scm
View File

@ -444,6 +444,7 @@ to generate and parse. The two primary functions are @code{cbor.loads} and
(method url-fetch)
(uri (string-append "https://github.com/google/flatbuffers/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0z4swldxs0s31hnkqdhsbfmc8vx3p7zsvmqaw4l31r2iikdy651p"))))

301
gnu/packages/tex.scm
View File

@ -269,7 +269,7 @@ This package contains the binaries.")
(let* ((root (string-append (assoc-ref %outputs "out")
"/share/texmf-dist"))
(dvips (string-append root "/dvips"))
(maps (string-append root "/fonts/map/dvips/tetex"))
(maps (string-append root "/fonts/map/dvips"))
(encs (string-append root "/fonts/enc/dvips/base")))
(mkdir-p dvips)
(copy-recursively (assoc-ref %build-inputs "source") dvips)
@ -285,12 +285,12 @@ This package contains the binaries.")
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/map/dvips/tetex"))
"/fonts/map/dvips"))
(revision %texlive-revision)))
(file-name (string-append "dvips-font-maps-" version "-checkout"))
(sha256
(base32
"100208pg7q6lj7swiq9p9287nn6b64bl62bnlaxpjni9y2kdrqy5"))))
"09hply3nmy24ilnc6cl8q70jcqxvq6bwri572kms008ini3h9vqh"))))
("dvips-base-enc"
,(origin
(method svn-fetch)
@ -613,20 +613,36 @@ documents.")
(find-files "." "cm(.*[0-9]+.*|inch)\\.mf$"))
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(tfm (string-append
out "/share/texmf-dist/fonts/tfm/public/cm"))
(mf (string-append
out "/share/texmf-dist/fonts/source/public/cm")))
(mf (string-append
out "/share/texmf-dist/fonts/source/public/cm"))
(type1 (string-append
out "/share/texmf-dist/fonts/type1/public/amsfonts/cm")))
(for-each (cut install-file <> tfm)
(find-files "build" "\\.*"))
(for-each (cut install-file <> mf)
(find-files "." "\\.mf"))
(mkdir-p type1)
(copy-recursively (assoc-ref inputs "cm-type1") type1)
#t))))))
(native-inputs
`(("texlive-bin" ,texlive-bin)
("texlive-metafont-base" ,texlive-metafont-base)))
("texlive-metafont-base" ,texlive-metafont-base)
("cm-type1"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/type1/public/amsfonts/cm"))
(revision %texlive-revision)))
(file-name (string-append name "-type1-" version "-checkout"))
(sha256
(base32
"12jyl9jp3hidifa4l5pmi47p71d5mb5kj5rknxkygilix8yz2iy6"))))))
(home-page "https://www.ctan.org/pkg/cm")
(synopsis "Computer Modern fonts for TeX")
(description "This package provides the Computer Modern fonts by Donald
@ -3999,10 +4015,27 @@ e-TeX.")
(begin
(use-modules (guix build utils))
(let ((target (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/tex/generic/pdftex")))
"/share/texmf-dist/tex/generic/pdftex"))
(target-map (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/fonts/map/pdftex")))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs "source") target)
(mkdir-p target-map)
(copy-recursively (assoc-ref %build-inputs "pdftex-map") target-map)
#t))))
(native-inputs
`(("pdftex-map"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/map/pdftex"))
(revision %texlive-revision)))
(file-name (string-append name "-map-" version "-checkout"))
(sha256
(base32
"197z9kx3bpnz58f5xrn5szyvmb3fxqq12y5sc4dw4jnm3xll8ji2"))))))
(home-page "https://www.ctan.org/pkg/pdftex")
(synopsis "TeX extension for direct creation of PDF")
(description
@ -4944,3 +4977,255 @@ used inside tables and moving arguments such as footnotes and section
titles.")
;; No version of the GPL is specified.
(license license:gpl3+)))
(define-public texlive-generic-xypic
(package
(name "texlive-generic-xypic")
(version (number->string %texlive-revision))
(source
(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/tex/generic/xypic"))
(revision %texlive-revision)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1g5cyxwdfznq4lk9zl6fkjkapmhmwd2cm4m5aibxj20qgwnaggfz"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
(let ((target (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/tex/generic/xypic")))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs "source") target)
#t))))
(home-page "https://www.ctan.org/pkg/xypic")
(synopsis "Flexible diagramming macros for TeX")
(description
"A package for typesetting a variety of graphs and diagrams with TeX.
Xy-pic works with most formats (including LaTeX, AMS-LaTeX, AMS-TeX, and plain
TeX).")
(license license:gpl3+)))
(define-public texlive-fonts-xypic
(package
(name "texlive-fonts-xypic")
(version (number->string %texlive-revision))
(source (origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/source/public/xypic"))
(revision %texlive-revision)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0p20v1257kwsqnrk98cdhhiz2viv8l3ly4xay4by0an3j37m9xs3"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils)
(ice-9 match))
#:builder
(begin
(use-modules (guix build utils)
(ice-9 match))
(let ((root (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/"))
(pkgs '(("source" . "fonts/source/public/xypic")
("xypic-afm" . "fonts/afm/public/xypic")
("xypic-type1" . "fonts/type1/public/xypic")
("xypic-enc" . "fonts/enc/dvips/xypic"))))
(for-each (match-lambda
((pkg . dir)
(let ((target (string-append root dir)))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs pkg)
target))))
pkgs)
#t))))
(native-inputs
`(("xypic-afm"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/afm/public/xypic"))
(revision %texlive-revision)))
(file-name (string-append name "-afm-" version "-checkout"))
(sha256
(base32
"149xdijxp8lw3s0qv2aqxxxyyn748z57dpr596rjvkqdffpnsddh"))))
("xypic-type1"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/type1/public/xypic"))
(revision %texlive-revision)))
(file-name (string-append name "-type1-" version "-checkout"))
(sha256
(base32
"1bln89wib7g3hcv2jny3qi6jb73k9d2vbgx3wnnjwp3ryg0846if"))))
("xypic-enc"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/enc/dvips/xypic"))
(revision %texlive-revision)))
(file-name (string-append name "-enc-" version "-checkout"))
(sha256
(base32
"0yi8vms3203l3p5slnhrrlzzp0f0jw77fkcvcaicrz2vmw9z99x7"))))))
(home-page "https://www.ctan.org/pkg/xypic")
(synopsis "Fonts for XY-pic")
(description "This package provides the XY-pic fonts.")
(license license:gpl3+)))
(define-public texlive-bibtex
(package
(name "texlive-bibtex")
(version (number->string %texlive-revision))
(source
(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/bibtex"))
(revision %texlive-revision)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1gk9q22fcb2fa1ql6cf9yw505x6a6axdzzfxbsya7nkrph860af8"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
(let ((target (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/bibtex")))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs "source") target)
#t))))
(home-page "https://www.ctan.org/pkg/bibtex")
(synopsis "Process bibliographies for LaTeX")
(description
"BibTeX allows the user to store his citation data in generic form, while
printing citations in a document in the form specified by a BibTeX style, to
be specified in the document itself (one often needs a LaTeX citation-style
package, such as @command{natbib} as well).")
(license license:knuth)))
(define-public texlive-fonts-charter
(package
(name "texlive-fonts-charter")
(version (number->string %texlive-revision))
(source (origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/type1/bitstrea/charter"))
(revision %texlive-revision)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0yvib45xxff3jm5270zij4q888pivbc18cqs7lz4pqfhn1am4wnv"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils)
(ice-9 match))
#:builder
(begin
(use-modules (guix build utils)
(ice-9 match))
(let ((root (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/"))
(pkgs '(("source" . "fonts/type1/bitstrea/charter")
("charter-afm" . "fonts/afm/bitstrea/charter")
("charter-tfm" . "fonts/tfm/bitstrea/charter"))))
(for-each (match-lambda
((pkg . dir)
(let ((target (string-append root dir)))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs pkg)
target))))
pkgs)
#t))))
(native-inputs
`(("charter-afm"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/afm/bitstrea/charter"))
(revision %texlive-revision)))
(file-name (string-append name "-afm-" version "-checkout"))
(sha256
(base32
"02nbkqrlr3vypnzslmr7dxg1353mmc0rl4ynx0s6qbvf313fq76a"))))
("charter-tfm"
,(origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/fonts/tfm/bitstrea/charter"))
(revision %texlive-revision)))
(file-name (string-append name "-tfm-" version "-checkout"))
(sha256
(base32
"0j7ci9vprivbhac70aq0z7m23hqcpx1g0i3wp1k0h8ilhimj80xk"))))))
(home-page "https://www.ctan.org/pkg/charter")
(synopsis "Charter fonts for TeX")
(description "A commercial text font donated for the common good. Support
for use with LaTeX is available in @code{freenfss}, part of
@command{psnfss}. ")
(license (license:non-copyleft (string-append "http://mirrors.ctan.org/"
"fonts/charter/readme.charter")))))
(define-public texlive-context-base
(package
(name "texlive-context-base")
(version (number->string %texlive-revision))
(source (origin
(method svn-fetch)
(uri (svn-reference
(url (string-append "svn://www.tug.org/texlive/tags/"
%texlive-tag "/Master/texmf-dist/"
"/tex/context/base"))
(revision %texlive-revision)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0zwl0cg6pka13i26dpqh137391f3j9sk69cpvwrm4ivsa0rqnw6g"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
(let ((target (string-append (assoc-ref %outputs "out")
"/share/texmf-dist/tex/context/case")))
(mkdir-p target)
(copy-recursively (assoc-ref %build-inputs "source") target)
#t))))
(home-page "https://www.ctan.org/pkg/context")
(synopsis "Full featured, parameter driven macro package for TeX")
(description "A full featured, parameter driven macro package, which fully
supports advanced interactive documents. See the ConTeXt garden for a wealth
of support information.")
(license license:gpl2+)))

6
gnu/packages/version-control.scm
View File

@ -146,14 +146,14 @@ as well as the classic centralized workflow.")
(name "git")
;; XXX When updating Git, check if the special 'git-source' input to cgit
;; needs to be updated as well.
(version "2.20.0")
(version "2.20.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://kernel.org/software/scm/git/git-"
version ".tar.xz"))
(sha256
(base32
"07yq186wb3wqvvmzhhsca57m979p7jprkk4h2a516jz1fd87755w"))))
"1sf3h6ms43k15h01ln8lcf24vx9n7c11s83h1ax63sm2zbi92blx"))))
(build-system gnu-build-system)
(native-inputs
`(("native-perl" ,perl)
@ -166,7 +166,7 @@ as well as the classic centralized workflow.")
version ".tar.xz"))
(sha256
(base32
"141n20migxaazy0vfkivjk6bzazi3ydyq7qkf6wmkg186l4amgbr"))))
"1fkn134y7an850l7p487v39y5zciaa65gryzqz815dyg8ziwq2h6"))))
;; For subtree documentation.
("asciidoc" ,asciidoc)
("docbook-xsl" ,docbook-xsl)

2
gnu/packages/video.scm
View File

@ -1955,7 +1955,7 @@ and custom quantization matrices.")
("python-websocket-client" ,python-websocket-client)
("python-iso3166" ,python-iso3166)
("python-iso639" ,python-iso639)
("python-isodate", python-isodate)
("python-isodate" ,python-isodate)
("python-pycryptodome" ,python-pycryptodome)
("python-requests" ,python-requests)
("python-urllib3" ,python-urllib3)))

50
gnu/packages/virtualization.scm
View File

@ -72,6 +72,8 @@
#:use-module (gnu packages web)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system go)
#:use-module (guix build-system python)
@ -95,16 +97,14 @@
(define-public qemu
(package
(name "qemu")
(version "3.0.0")
(version "3.1.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qemu.org/qemu-"
version ".tar.xz"))
(patches (search-patches "qemu-CVE-2018-16847.patch"
"qemu-CVE-2018-16867.patch"))
(sha256
(base32
"04sp3f1gp4bdb913jf7fw761njaqp2l32wgipp1sapmxx17zcyld"))))
"1z5bd5nfyjvhfi1s95labc82y4hjdjjkdabw931362ls0zghh1ba"))))
(build-system gnu-build-system)
(arguments
'(;; Running tests in parallel can occasionally lead to failures, like:
@ -388,14 +388,14 @@ manage system or application containers.")
(define-public libvirt
(package
(name "libvirt")
(version "4.3.0")
(version "4.10.0")
(source (origin
(method url-fetch)
(uri (string-append "https://libvirt.org/sources/libvirt-"
version ".tar.xz"))
(sha256
(base32
"1dy243dqaj174hcka0my7q781wf0dvyi7f9328nwnplqicnf4cd5"))))
"0v17zzyyb25nn9l18v5244myg7590dp6ppwgi8xysipifc0q77bz"))))
(build-system gnu-build-system)
(arguments
`(;; FAIL: virshtest
@ -439,6 +439,8 @@ manage system or application containers.")
#t))))))
(inputs
`(("libxml2" ,libxml2)
("eudev" ,eudev)
("libpciaccess" ,libpciaccess)
("gnutls" ,gnutls)
("dbus" ,dbus)
("qemu" ,qemu)
@ -521,13 +523,13 @@ three libraries:
(define-public python-libvirt
(package
(name "python-libvirt")
(version "4.1.0")
(version "4.10.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "libvirt-python" version))
(sha256
(base32
"1ixqhxjkczl8vk9wjx4cknw4374cw5nnsacbd2s755kpd0ys7hny"))))
"11fipj9naihgc9afc8bz5hi05xa1shp4qcy170sa18p3sl4zljb9"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -559,7 +561,7 @@ virtualization library.")
(define-public virt-manager
(package
(name "virt-manager")
(version "1.5.1")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri (string-append "https://virt-manager.org/download/sources"
@ -567,11 +569,10 @@ virtualization library.")
version ".tar.gz"))
(sha256
(base32
"1ardmd4sxdmd57y7qpka44gf09c1yq2g0xs074d3k1h925crv27f"))))
"1b48xbrx99mfiv80c60k3ydzkpcpbq57c8h8dl0gnffmnzbs8vzb"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
#:use-setuptools? #f ; Uses custom distutils 'install' command.
`(#:use-setuptools? #f ; Uses custom distutils 'install' command.
;; Some of the tests seem to require network access to install virtual
;; machines.
#:tests? #f
@ -628,12 +629,12 @@ virtualization library.")
("libosinfo" ,libosinfo)
("vte" ,vte)
("gobject-introspection" ,gobject-introspection)
("python2-libvirt" ,python2-libvirt)
("python2-requests" ,python2-requests)
("python2-ipaddr" ,python2-ipaddr)
("python2-pycairo" ,python2-pycairo)
("python2-pygobject" ,python2-pygobject)
("python2-libxml2" ,python2-libxml2)
("python-libvirt" ,python-libvirt)
("python-requests" ,python-requests)
("python-ipaddress" ,python-ipaddress)
("python-pycairo" ,python-pycairo)
("python-pygobject" ,python-pygobject)
("python-libxml2" ,python-libxml2)
("spice-gtk" ,spice-gtk)))
;; virt-manager searches for qemu-img or kvm-img in the PATH.
(propagated-inputs
@ -771,7 +772,7 @@ Machine Protocol.")
(define-public lookingglass
(package
(name "lookingglass")
(version "a11")
(version "a12")
(source
(origin
(method url-fetch)
@ -780,8 +781,8 @@ Machine Protocol.")
(file-name (string-append name "-" version))
(sha256
(base32
"11qwyp332l66sqksqa0z9439yi4accmbq7wjc6kikc5fimdh9wk5"))))
(build-system gnu-build-system)
"0x57chx83f8pq56d9sfxmc9p4qjm9nqvdyamj41bmy145mxw5w3m"))))
(build-system cmake-build-system)
(inputs `(("fontconfig" ,fontconfig)
("glu" ,glu)
("mesa" ,mesa)
@ -796,16 +797,17 @@ Machine Protocol.")
`(#:tests? #f ;; No tests are available.
#:make-flags '("CC=gcc")
#:phases (modify-phases %standard-phases
(replace 'configure
(add-before 'configure 'chdir-to-client
(lambda* (#:key outputs #:allow-other-keys)
(chdir "client")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(install-file "bin/looking-glass-client"
(install-file "looking-glass-client"
(string-append (assoc-ref outputs "out")
"/bin"))
#t)))))
#t))
)))
(home-page "https://looking-glass.hostfission.com")
(synopsis "KVM Frame Relay (KVMFR) implementation")
(description "Looking Glass allows the use of a KVM (Kernel-based Virtual

16
gnu/packages/web-browsers.scm
View File

@ -152,16 +152,16 @@ features including, tables, builtin image display, bookmarks, SSL and more.")
"0dwxhnq90whakgdg21lzcf03n2g1c7hqgliwhav8av5na5mqpn93"))
(file-name (string-append name "-" version ".tar.gz"))))
(inputs
`(("lua-5.1", lua-5.1)
`(("lua-5.1" ,lua-5.1)
("gtk+" ,gtk+)
("gsettings-desktop-schemas", gsettings-desktop-schemas)
("glib-networking", glib-networking)
("lua5.1-filesystem", lua5.1-filesystem)
("luajit", luajit)
("webkitgtk", webkitgtk)
("sqlite", sqlite)))
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("glib-networking" ,glib-networking)
("lua5.1-filesystem" ,lua5.1-filesystem)
("luajit" ,luajit)
("webkitgtk" ,webkitgtk)
("sqlite" ,sqlite)))
(native-inputs
`(("pkg-config", pkg-config)))
`(("pkg-config" ,pkg-config)))
(build-system glib-or-gtk-build-system)
(arguments
'(#:make-flags

2
gnu/packages/web.scm
View File

@ -3065,7 +3065,7 @@ select or poll.")
(native-inputs
`(("perl-test-fatal" ,perl-test-fatal)
("perl-test-needs" ,perl-test-needs)
("perl-test-requiresinternet", perl-test-requiresinternet)))
("perl-test-requiresinternet" ,perl-test-requiresinternet)))
(propagated-inputs
`(("perl-encode-locale" ,perl-encode-locale)
("perl-file-listing" ,perl-file-listing)

4
gnu/packages/webkit.scm
View File

@ -168,14 +168,14 @@ HTML/CSS applications to full-fledged web browsers.")
(define-public webkitgtk-2.22
(package/inherit webkitgtk
(name "webkitgtk")
(version "2.22.4")
(version "2.22.5")
(source (origin
(method url-fetch)
(uri (string-append "https://www.webkitgtk.org/releases/"
name "-" version ".tar.xz"))
(sha256
(base32
"1f2335hjzsvjxjf6hy5cyypsn65wykpx2pbk1sp548w0hclbxdgs"))))
"04ybyvaz5xhfkd2k65pc0sqizngjvd82j1p56wz3lz4a84zqdlwr"))))
(native-inputs
`(("gcc" ,gcc-7) ; webkitgtk-2.22 requires gcc-6 or newer
,@(package-native-inputs webkitgtk)))

4
gnu/packages/wget.scm
View File

@ -45,7 +45,7 @@
(define-public wget
(package
(name "wget")
(version "1.19.5")
(version "1.20")
(source
(origin
(method url-fetch)
@ -53,7 +53,7 @@
version ".tar.lz"))
(sha256
(base32
"0xfaxmlnih7dhkyks5wi4vrn0n1xshmy6gx6fb2k1120sprydyr9"))))
"07k8yd8rdn27x5fbzlnsz4db7z7qnisiqhs7r1b5wzy2b9b0zf5h"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases

2
gnu/packages/wm.scm
View File

@ -604,7 +604,7 @@ Haskell, no knowledge of the language is required to install and use it.")
("ghc-random" ,ghc-random)
("ghc-utf8-string" ,ghc-utf8-string)
("ghc-extensible-exceptions" ,ghc-extensible-exceptions)
("ghc-semigroups", ghc-semigroups)
("ghc-semigroups" ,ghc-semigroups)
("ghc-x11" ,ghc-x11)
("ghc-x11-xft" ,ghc-x11-xft)
("xmonad" ,xmonad)))

57
gnu/packages/xdisorg.scm
View File

@ -24,6 +24,7 @@
;;; Copyright © 2018 Thomas Sigurdsen <tonton@riseup.net>
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2018 Nam Nguyen <namn@berkeley.edu>
;;;
;;; This file is part of GNU Guix.
;;;
@ -52,6 +53,8 @@
#:use-module (guix build-system python)
#:use-module (gnu packages)
#:use-module (gnu packages documentation)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages algebra)
#:use-module (gnu packages autotools)
#:use-module (gnu packages check)
@ -1555,3 +1558,57 @@ to automatically turn it on on login.")
(description "This package provides a small utility for inverting the
colors on all monitors attached to an XRandR-capable X11 display server.")
(license license:gpl3+)))
(define-public sct
(package
(name "sct")
(version "0.4")
(source
(origin
(method url-fetch)
(uri
(string-append "https://www.umaxx.net/dl/sct-"
version ".tar.gz"))
(sha256
(base32
"0r57z9ki8pvxhawfxys0v5h85z2x211sqxki0xvk1bga88ryldlv"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags (list "CC=gcc")
#:tests? #f ; No tests exist.
#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-after 'unpack 'fix-sctd-paths
(lambda* (#:key outputs inputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(coreutils (assoc-ref inputs "coreutils"))
(inetutils (assoc-ref inputs "inetutils"))
(sed (assoc-ref inputs "sed")))
(substitute* "sctd.sh"
(("\\$\\(which sct\\)") (string-append out "/bin/sct"))
(("date") (string-append coreutils "/bin/date"))
(("printf") (string-append coreutils "/bin/printf"))
(("sleep") (string-append coreutils "/bin/sleep"))
(("logger") (string-append inetutils "/bin/logger"))
(("sed") (string-append sed "/bin/sed"))))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(install-file "sct" (string-append out "/bin"))
(install-file "sctd.sh" (string-append out "/bin"))
(install-file "sct.1" (string-append out "/man/man1"))
(install-file "sctd.1" (string-append out "/man/man1"))
(rename-file (string-append out "/bin/sctd.sh")
(string-append out "/bin/sctd"))
#t))))))
(inputs
`(("coreutils" ,coreutils) ; sctd uses "date", "printf" and "sleep"
("inetutils" ,inetutils) ; sctd uses "logger"
("libxrandr" ,libxrandr)
("sed" ,sed))) ; sctd uses "sed"
(home-page "https://www.umaxx.net")
(synopsis "Set the color temperature of the screen")
(description "@code{sct} is a lightweight utility to set the color
temperature of the screen.")
(license license:bsd-3)))

10
gnu/services/base.scm
View File

@ -1967,7 +1967,15 @@ item of @var{packages}."
(respawn? #f)
;; We need additional modules.
(modules `((gnu build linux-boot)
,@%default-modules))))))))
,@%default-modules))
(actions (list (shepherd-action
(name 'rules)
(documentation "Display the directory containing
the udev rules in use.")
(procedure #~(lambda (_)
(display #$rules)
(newline))))))))))))
(define udev-service-type
(service-type (name 'udev)

467
gnu/services/monitoring.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,17 +20,32 @@
(define-module (gnu services monitoring)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu services web)
#:use-module (gnu packages admin)
#:use-module (gnu packages monitoring)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module ((guix ui) #:select (display-hint))
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
#:export (darkstat-configuration
prometheus-node-exporter-configuration
darkstat-service-type
prometheus-node-exporter-service-type))
prometheus-node-exporter-service-type
zabbix-server-configuration
zabbix-server-service-type
zabbix-agent-configuration
zabbix-agent-service-type
zabbix-front-end-configuration
zabbix-front-end-service-type
%zabbix-front-end-configuration-nginx))
;;;
@ -125,3 +141,452 @@ prometheus.")
(list (service-extension
shepherd-root-service-type
(compose list prometheus-node-exporter-shepherd-service))))))
;;;
;;; Zabbix server
;;;
(define (uglify-field-name field-name)
(apply string-append
(map (lambda (str)
(if (member (string->symbol str) '(ca db ssl))
(string-upcase str)
(string-capitalize str)))
(string-split (string-delete #\?
(symbol->string field-name))
#\-))))
(define (serialize-field field-name val)
(format #t "~a=~a~%" (uglify-field-name field-name) val))
(define (serialize-number field-name val)
(serialize-field field-name (number->string val)))
(define (serialize-list field-name val)
(if (null? val) "" (serialize-field field-name (string-join val ","))))
(define (serialize-string field-name val)
(if (and (string? val) (string=? val ""))
""
(serialize-field field-name val)))
(define group? string?)
(define serialize-group
(const ""))
(define include-files? list?)
(define (serialize-include-files field-name val)
(if (null? val) "" (for-each (cut serialize-field 'include <>) val)))
(define extra-options? string?)
(define (serialize-extra-options field-name val)
(if (null? val) "" (display val)))
(define (nginx-server-configuration-list? val)
(and (list? val) (and-map nginx-server-configuration? val)))
(define (serialize-nginx-server-configuration-list field-name val)
"")
(define-configuration zabbix-server-configuration
(zabbix-server
(package zabbix-server)
"The zabbix-server package.")
(user
(string "zabbix")
"User who will run the Zabbix server.")
(group ;for zabbix-server-account procedure
(group "zabbix")
"Group who will run the Zabbix server.")
(db-host
(string "127.0.0.1")
"Database host name.")
(db-name
(string "zabbix")
"Database name.")
(db-user
(string "zabbix")
"Database user.")
(db-password
(string "")
"Database password. Please, use @code{include-files} with
@code{DBPassword=SECRET} inside a specified file instead.")
(db-port
(number 5432)
"Database port.")
(log-type
(string "")
"Specifies where log messages are written to:
@itemize
@item @code{system} - syslog.
@item @code{file} - file specified with @code{log-file} parameter.
@item @code{console} - standard output.
@end itemize\n")
(log-file
(string "/var/log/zabbix/server.log")
"Log file name for @code{log-type} @code{file} parameter.")
(pid-file
(string "/var/run/zabbix/zabbix_server.pid")
"Name of PID file.")
(ssl-ca-location
(string "/etc/ssl/certs/ca-certificates.crt")
"The location of certificate authority (CA) files for SSL server
certificate verification.")
(ssl-cert-location
(string "/etc/ssl/certs")
"Location of SSL client certificates.")
(extra-options
(extra-options "")
"Extra options will be appended to Zabbix server configuration file.")
(include-files
(include-files '())
"You may include individual files or all files in a directory in the
configuration file."))
(define (zabbix-server-account config)
"Return the user accounts and user groups for CONFIG."
(let ((zabbix-user (zabbix-server-configuration-user config))
(zabbix-group (zabbix-server-configuration-group config)))
(list (user-group (name zabbix-group) (system? #t))
(user-account
(name zabbix-user)
(system? #t)
(group zabbix-group)
(comment "zabbix privilege separation user")
(home-directory (string-append "/var/run/" zabbix-user))
(shell #~(string-append #$shadow "/sbin/nologin"))))))
(define (zabbix-server-config-file config)
"Return the zabbix-server configuration file corresponding to CONFIG."
(computed-file
"zabbix_server.conf"
#~(begin
(call-with-output-file #$output
(lambda (port)
(display "# Generated by 'zabbix-server-service'.\n" port)
(display #$(with-output-to-string
(lambda ()
(serialize-configuration
config zabbix-server-configuration-fields)))
port)
#t)))))
(define (zabbix-server-activation config)
"Return the activation gexp for CONFIG."
(with-imported-modules '((guix build utils)
(ice-9 rdelim))
#~(begin
(use-modules (guix build utils)
(ice-9 rdelim))
(let ((user (getpw #$(zabbix-server-configuration-user config))))
(for-each (lambda (file)
(let ((directory (dirname file)))
(mkdir-p directory)
(chown directory (passwd:uid user) (passwd:gid user))
(chmod directory #o755)))
(list #$(zabbix-server-configuration-log-file config)
#$(zabbix-server-configuration-pid-file config)
"/etc/zabbix/maintenance.inc.php"))))))
(define (zabbix-server-shepherd-service config)
"Return a <shepherd-service> for Zabbix server with CONFIG."
(list (shepherd-service
(provision '(zabbix-server))
(documentation "Run Zabbix server daemon.")
(start #~(make-forkexec-constructor
(list #$(file-append (zabbix-server-configuration-zabbix-server config)
"/sbin/zabbix_server")
"--config" #$(zabbix-server-config-file config)
"--foreground")
#:user #$(zabbix-server-configuration-user config)
#:group #$(zabbix-server-configuration-group config)
#:pid-file #$(zabbix-server-configuration-pid-file config)
#:environment-variables
(list "SSL_CERT_DIR=/run/current-system/profile\
/etc/ssl/certs"
"SSL_CERT_FILE=/run/current-system/profile\
/etc/ssl/certs/ca-certificates.crt")))
(stop #~(make-kill-destructor)))))
(define zabbix-server-service-type
(service-type
(name 'zabbix-server)
(extensions
(list (service-extension shepherd-root-service-type
zabbix-server-shepherd-service)
(service-extension account-service-type
zabbix-server-account)
(service-extension activation-service-type
zabbix-server-activation)))
(default-value (zabbix-server-configuration))))
(define (generate-zabbix-server-documentation)
(generate-documentation
`((zabbix-server-configuration
,zabbix-server-configuration-fields))
'zabbix-server-configuration))
(define-configuration zabbix-agent-configuration
(zabbix-agent
(package zabbix-agentd)
"The zabbix-agent package.")
(user
(string "zabbix")
"User who will run the Zabbix agent.")
(group
(group "zabbix")
"Group who will run the Zabbix agent.")
(hostname
(string "Zabbix server")
"Unique, case sensitive hostname which is required for active checks and
must match hostname as configured on the server.")
(log-type
(string "")
"Specifies where log messages are written to:
@itemize
@item @code{system} - syslog.
@item @code{file} - file specified with @code{log-file} parameter.
@item @code{console} - standard output.
@end itemize\n")
(log-file
(string "/var/log/zabbix/agent.log")
"Log file name for @code{log-type} @code{file} parameter.")
(pid-file
(string "/var/run/zabbix/zabbix_agent.pid")
"Name of PID file.")
(server
(list '("127.0.0.1"))
"List of IP addresses, optionally in CIDR notation, or hostnames of Zabbix
servers and Zabbix proxies. Incoming connections will be accepted only from
the hosts listed here.")
(server-active
(list '("127.0.0.1"))
"List of IP:port (or hostname:port) pairs of Zabbix servers and Zabbix
proxies for active checks. If port is not specified, default port is used.
If this parameter is not specified, active checks are disabled.")
(extra-options
(extra-options "")
"Extra options will be appended to Zabbix server configuration file.")
(include-files
(include-files '())
"You may include individual files or all files in a directory in the
configuration file."))
(define (zabbix-agent-account config)
"Return the user accounts and user groups for CONFIG."
(let ((zabbix-user "zabbix")
(zabbix-group "zabbix"))
(list (user-group (name zabbix-group) (system? #t))
(user-account
(name zabbix-user)
(system? #t)
(group zabbix-group)
(comment "zabbix privilege separation user")
(home-directory (string-append "/var/run/" zabbix-user))
(shell #~(string-append #$shadow "/sbin/nologin"))))))
(define (zabbix-agent-activation config)
"Return the activation gexp for CONFIG."
(with-imported-modules '((guix build utils)
(ice-9 rdelim))
#~(begin
(use-modules (guix build utils)
(ice-9 rdelim))
(let ((user
(getpw #$(zabbix-agent-configuration-user config))))
(for-each (lambda (file)
(let ((directory (dirname file)))
(mkdir-p directory)
(chown directory (passwd:uid user) (passwd:gid user))
(chmod directory #o755)))
(list #$(zabbix-agent-configuration-log-file config)
#$(zabbix-agent-configuration-pid-file config)))))))
(define (zabbix-agent-config-file config)
"Return the zabbix-agent configuration file corresponding to CONFIG."
(computed-file
"zabbix_agent.conf"
#~(begin
(call-with-output-file #$output
(lambda (port)
(display "# Generated by 'zabbix-agent-service'.\n" port)
(display #$(with-output-to-string
(lambda ()
(serialize-configuration
config zabbix-agent-configuration-fields)))
port)
#t)))))
(define (zabbix-agent-shepherd-service config)
"Return a <shepherd-service> for Zabbix agent with CONFIG."
(list (shepherd-service
(provision '(zabbix-agent))
(documentation "Run Zabbix agent daemon.")
(start #~(make-forkexec-constructor
(list #$(file-append (zabbix-agent-configuration-zabbix-agent config)
"/sbin/zabbix_agentd")
"--config" #$(zabbix-agent-config-file config)
"--foreground")
#:user #$(zabbix-agent-configuration-user config)
#:group #$(zabbix-agent-configuration-group config)
#:pid-file #$(zabbix-agent-configuration-pid-file config)
#:environment-variables
(list "SSL_CERT_DIR=/run/current-system/profile\
/etc/ssl/certs"
"SSL_CERT_FILE=/run/current-system/profile\
/etc/ssl/certs/ca-certificates.crt")))
(stop #~(make-kill-destructor)))))
(define zabbix-agent-service-type
(service-type
(name 'zabbix-agent)
(extensions
(list (service-extension shepherd-root-service-type
zabbix-agent-shepherd-service)
(service-extension account-service-type
zabbix-agent-account)
(service-extension activation-service-type
zabbix-agent-activation)))
(default-value (zabbix-agent-configuration))))
(define (generate-zabbix-agent-documentation)
(generate-documentation
`((zabbix-agent-configuration
,zabbix-agent-configuration-fields))
'zabbix-agent-configuration))
(define %zabbix-front-end-configuration-nginx
(nginx-server-configuration
(root #~(string-append #$zabbix-server:front-end "/share/zabbix/php"))
(index '("index.php"))
(locations
(let ((php-location (nginx-php-location)))
(list (nginx-location-configuration
(inherit php-location)
(body (append (nginx-location-configuration-body php-location)
(list "
fastcgi_param PHP_VALUE \"post_max_size = 16M
max_execution_time = 300\";
")))))))))
(define-configuration zabbix-front-end-configuration
;; TODO: Specify zabbix front-end package.
;; (zabbix-
;; (package zabbix-front-end)
;; "The zabbix-front-end package.")
(nginx
(nginx-server-configuration-list
(list %zabbix-front-end-configuration-nginx))
"NGINX configuration.")
(db-host
(string "localhost")
"Database host name.")
(db-port
(number 5432)
"Database port.")
(db-name
(string "zabbix")
"Database name.")
(db-user
(string "zabbix")
"Database user.")
(db-password
(string "")
"Database password. Please, use @code{db-secret-file} instead.")
(db-secret-file
(string "")
"Secret file which will be appended to @file{zabbix.conf.php} file. This
file contains credentials for use by Zabbix front-end. You are expected to
create it manually.")
(zabbix-host
(string "localhost")
"Zabbix server hostname.")
(zabbix-port
(number 10051)
"Zabbix server port."))
(define zabbix-front-end-config
(match-lambda
(($ <zabbix-front-end-configuration>
_ db-host db-port db-name db-user db-password db-secret-file
zabbix-host zabbix-port)
(mixed-text-file "zabbix.conf.php"
"\
<?php
// Zabbix GUI configuration file.
global $DB;
$DB['TYPE'] = 'POSTGRESQL';
$DB['SERVER'] = '" db-host "';
$DB['PORT'] = '" (number->string db-port) "';
$DB['DATABASE'] = '" db-name "';
$DB['USER'] = '" db-user "';
$DB['PASSWORD'] = '" (if (string-null? db-password)
(if (string-null? db-secret-file)
(raise (condition
(&message
(message "\
you must provide either 'db-secret-file' or 'db-password'"))))
(string-trim-both
(with-input-from-file db-secret-file
read-string)))
(begin
(display-hint "\
Consider using @code{db-secret-file} instead of @code{db-password} and unset
@code{db-password} for security in @code{zabbix-front-end-configuration}.")
db-password)) "';
// Schema name. Used for IBM DB2 and PostgreSQL.
$DB['SCHEMA'] = '';
$ZBX_SERVER = '" zabbix-host "';
$ZBX_SERVER_PORT = '" (number->string zabbix-port) "';
$ZBX_SERVER_NAME = '';
$IMAGE_FORMAT_DEFAULT = IMAGE_FORMAT_PNG;
"))))
(define %maintenance.inc.php
;; Empty php file to allow us move zabbix-frontend configs to ‘/etc/zabbix’
;; directory. See ‘install-front-end’ phase in
;; (@ (gnu packages monitoring) zabbix-server) package.
"\
<?php
")
(define (zabbix-front-end-activation config)
"Return the activation gexp for CONFIG."
#~(begin
(use-modules (guix build utils))
(mkdir-p "/etc/zabbix")
(call-with-output-file "/etc/zabbix/maintenance.inc.php"
(lambda (port)
(display #$%maintenance.inc.php port)))
(copy-file #$(zabbix-front-end-config config)
"/etc/zabbix/zabbix.conf.php")))
(define zabbix-front-end-service-type
(service-type
(name 'zabbix-front-end)
(extensions
(list (service-extension activation-service-type
zabbix-front-end-activation)
(service-extension nginx-service-type
zabbix-front-end-configuration-nginx)
;; Make sure php-fpm is instantiated.
(service-extension php-fpm-service-type
(const #t))))
(default-value (zabbix-front-end-configuration))
(description
"Run the zabbix-front-end web interface, which allows users to interact
with Zabbix server.")))
(define (generate-zabbix-front-end-documentation)
(generate-documentation
`((zabbix-front-end-configuration
,zabbix-front-end-configuration-fields))
'zabbix-front-end-configuration))

12
gnu/services/shepherd.scm
View File

@ -281,7 +281,17 @@ stored."
(start service)))
'#$(append-map shepherd-service-provision
(filter shepherd-service-auto-start?
services)))))))
services)))
;; Hang up stdin. At this point, we assume that 'start' methods
;; that required user interaction on the console (e.g.,
;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
;; completed. User interaction becomes impossible after this
;; call; this avoids situations where services wrongfully lead
;; PID 1 to read from stdin (the console), which users may not
;; have access to (see <https://bugs.gnu.org/23697>).
(redirect-port (open-input-file "/dev/null")
(current-input-port))))))
(scheme-file "shepherd.conf" config)))

48
gnu/services/web.scm
View File

@ -142,6 +142,7 @@
php-fpm-configuration-log-file
php-fpm-configuration-process-manager
php-fpm-configuration-display-errors
php-fpm-configuration-timezone
php-fpm-configuration-workers-log-file
php-fpm-configuration-file
@ -773,6 +774,8 @@ of index files."
(default (php-fpm-dynamic-process-manager-configuration)))
(display-errors php-fpm-configuration-display-errors
(default #f))
(timezone php-fpm-configuration-timezone
(default #f))
(workers-log-file php-fpm-configuration-workers-log-file
(default (string-append "/var/log/php"
(version-major (package-version php))
@ -827,7 +830,7 @@ of index files."
(shell (file-append shadow "/sbin/nologin")))))))
(define (default-php-fpm-config socket user group socket-user socket-group
pid-file log-file pm display-errors workers-log-file)
pid-file log-file pm display-errors timezone workers-log-file)
(apply mixed-text-file "php-fpm.conf"
(flatten
"[global]\n"
@ -840,6 +843,10 @@ of index files."
"listen.owner =" socket-user "\n"
"listen.group =" socket-group "\n"
(if timezone
(string-append "php_admin_value[date.timezone] = \"" timezone "\"\n")
"")
(match pm
(($ <php-fpm-dynamic-process-manager-configuration>
pm.max-children
@ -879,7 +886,8 @@ of index files."
(define php-fpm-shepherd-service
(match-lambda
(($ <php-fpm-configuration> php socket user group socket-user socket-group
pid-file log-file pm display-errors workers-log-file file)
pid-file log-file pm display-errors
timezone workers-log-file file)
(list (shepherd-service
(provision '(php-fpm))
(documentation "Run the php-fpm daemon.")
@ -890,27 +898,27 @@ of index files."
#$(or file
(default-php-fpm-config socket user group
socket-user socket-group pid-file log-file
pm display-errors workers-log-file)))
pm display-errors timezone workers-log-file)))
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))))
(define php-fpm-activation
(match-lambda
(($ <php-fpm-configuration> _ _ user _ _ _ _ log-file _ _ workers-log-file _)
#~(begin
(use-modules (guix build utils))
(let* ((user (getpwnam #$user))
(touch (lambda (file-name)
(call-with-output-file file-name (const #t))))
(init-log-file
(lambda (file-name)
(when #$workers-log-file
(when (not (file-exists? file-name))
(touch file-name))
(chown file-name (passwd:uid user) (passwd:gid user))
(chmod file-name #o660)))))
(init-log-file #$log-file)
(init-log-file #$workers-log-file))))))
(define (php-fpm-activation config)
#~(begin
(use-modules (guix build utils))
(let* ((user (getpwnam #$(php-fpm-configuration-user config)))
(touch (lambda (file-name)
(call-with-output-file file-name (const #t))))
(workers-log-file
#$(php-fpm-configuration-workers-log-file config))
(init-log-file
(lambda (file-name)
(when workers-log-file
(when (not (file-exists? file-name))
(touch file-name))
(chown file-name (passwd:uid user) (passwd:gid user))
(chmod file-name #o660)))))
(init-log-file #$(php-fpm-configuration-log-file config))
(init-log-file workers-log-file))))
(define php-fpm-service-type

16
gnu/system.scm
View File

@ -21,6 +21,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system)
#:use-module (guix inferior)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix gexp)
@ -905,10 +906,17 @@ listed in OS. The C library expects to find it under
(define (kernel->boot-label kernel)
"Return a label for the bootloader menu entry that boots KERNEL."
(string-append "GNU with "
(string-titlecase (package-name kernel)) " "
(package-version kernel)
" (beta)"))
(cond ((package? kernel)
(string-append "GNU with "
(string-titlecase (package-name kernel)) " "
(package-version kernel)
" (beta)"))
((inferior-package? kernel)
(string-append "GNU with "
(string-titlecase (inferior-package-name kernel))
(inferior-package-version kernel)
" (beta)"))
(else "GNU")))
(define (store-file-system file-systems)
"Return the file system object among FILE-SYSTEMS that contains the store."

15
gnu/tests/base.scm
View File

@ -123,6 +123,21 @@ initialization step, such as entering a LUKS passphrase."
#f))))
marionette))
(test-eq "stdin is /dev/null"
'eof
;; Make sure services can no longer read from stdin once the
;; system has booted.
(marionette-eval
`(begin
(use-modules (gnu services herd))
(start 'user-processes)
((@@ (gnu services herd) eval-there)
'(let ((result (read (current-input-port))))
(if (eof-object? result)
'eof
result))))
marionette))
(test-assert "shell and user commands"
;; Is everything in $PATH?
(zero? (marionette-eval '(system "

232
gnu/tests/monitoring.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -17,13 +18,21 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu tests monitoring)
#:use-module (gnu packages databases)
#:use-module (gnu packages monitoring)
#:use-module (gnu packages php)
#:use-module (gnu services)
#:use-module (gnu services monitoring)
#:use-module (gnu services networking)
#:use-module (gnu services databases)
#:use-module (gnu services shepherd)
#:use-module (gnu services web)
#:use-module (gnu system vm)
#:use-module (gnu system)
#:use-module (gnu tests)
#:use-module (guix gexp)
#:export (%test-prometheus-node-exporter))
#:export (%test-prometheus-node-exporter
%test-zabbix))
;;;
@ -95,3 +104,224 @@
(description "Connect to a running prometheus-node-exporter server.")
(value (run-prometheus-node-exporter-server-test
name %prometheus-node-exporter-os))))
;;;
;;; Zabbix
;;;
(define %psql-user-create-zabbix
"\
sudo -u postgres psql <<< \"create user zabbix password 'zabbix';\"
")
(define %psql-db-zabbix-create-script
"\
sudo -u postgres psql --no-align <<< \\\\du
")
(define %psql-db-create-zabbix
"\
sudo -u postgres createdb -O zabbix -E Unicode -T template0 zabbix
")
(define %psql-db-import-zabbix
#~(format #f "\
cat ~a | sudo -u zabbix psql zabbix;
cat ~a | sudo -u zabbix psql zabbix;
cat ~a | sudo -u zabbix psql zabbix;
"
(string-append #$zabbix-server:schema
"/database/postgresql/schema.sql")
(string-append #$zabbix-server:schema
"/database/postgresql/images.sql")
(string-append #$zabbix-server:schema
"/database/postgresql/data.sql")))
(define* (run-zabbix-server-test name test-os)
"Run tests in %ZABBIX-OS, which has zabbix running."
(define os
(marionette-operating-system
test-os
#:imported-modules '((gnu services herd))))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings '((8080 . 80)))
(memory-size 1024)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11)
(srfi srfi-64)
(gnu build marionette)
(web client)
(web response)
(ice-9 popen)
(ice-9 rdelim))
(define marionette
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
(test-begin #$name)
;; XXX: Shepherd reads the config file *before* binding its control
;; socket, so /var/run/shepherd/socket might not exist yet when the
;; 'marionette' service is started.
(test-assert "shepherd socket ready"
(marionette-eval
`(begin
(use-modules (gnu services herd))
(let loop ((i 10))
(cond ((file-exists? (%shepherd-socket-file))
#t)
((> i 0)
(sleep 1)
(loop (- i 1)))
(else
'failure))))
marionette))
(test-assert "postgres service running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'postgres))
marionette))
(test-eq "postgres create zabbix user"
0
(marionette-eval '(begin (system #$%psql-user-create-zabbix))
marionette))
(test-equal "postgres find zabbix user"
"List of roles
Role name|Attributes|Member of
postgres|Superuser, Create role, Create DB, Replication, Bypass RLS|{}
zabbix||{}
"
(marionette-eval
'(begin (let* ((port (open-pipe #$%psql-db-zabbix-create-script
OPEN_READ))
(output (read-string port))
(status (close-pipe port)))
output))
marionette))
(test-eq "postgres create zabbix db"
0
(marionette-eval '(begin (system #$%psql-db-create-zabbix))
marionette))
(test-eq "postgres import zabbix db"
0
(marionette-eval '(begin (system #$%psql-db-import-zabbix))
marionette))
;; Wait for zabbix-server to be up and running.
(test-assert "zabbix-server running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'zabbix-server))
marionette))
;; Make sure the PID file is created.
(test-assert "zabbix-server PID file"
(marionette-eval
'(file-exists? "/var/run/zabbix/zabbix_server.pid")
marionette))
;; Wait for zabbix-agent to be up and running.
(test-assert "zabbix-agent running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'zabbix-agent))
marionette))
;; Make sure the PID file is created.
(test-assert "zabbix-agent PID file"
(marionette-eval
'(file-exists? "/var/run/zabbix/zabbix_agent.pid")
marionette))
;; Wait for php-fpm to be up and running.
(test-assert "php-fpm running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'php-fpm))
marionette))
;; Wait for nginx to be up and running.
(test-assert "nginx running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'nginx))
marionette))
;; Make sure the PID file is created.
(test-assert "nginx PID file"
(marionette-eval
'(file-exists? "/var/run/nginx/pid")
marionette))
;; Make sure we can access pages that correspond to our repository.
(letrec-syntax ((test-url
(syntax-rules ()
((_ path code)
(test-equal (string-append "GET " path)
code
(let-values (((response body)
(http-get (string-append
"http://localhost:8080"
path))))
(response-code response))))
((_ path)
(test-url path 200)))))
(test-url "/")
(test-url "/does-not-exist" 404))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation (string-append name "-test") test))
(define %zabbix-os
;; Return operating system under test.
(let ((base-os
(simple-operating-system
(service dhcp-client-service-type)
(postgresql-service)
(service zabbix-front-end-service-type
(zabbix-front-end-configuration
(db-password "zabbix")))
(service php-fpm-service-type
(php-fpm-configuration
(timezone "Europe/Paris")
(php php-with-bcmath)))
(service zabbix-server-service-type
(zabbix-server-configuration
(db-password "zabbix")
(log-type "console")))
(service zabbix-agent-service-type))))
(operating-system
(inherit base-os)
(packages (cons* postgresql (operating-system-packages base-os))))))
(define %test-zabbix
(system-test
(name "zabbix")
(description "Connect to a running Zabbix")
(value (run-zabbix-server-test name %zabbix-os))))

159
guix/build-system/dune.scm Normal file
View File

@ -0,0 +1,159 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system dune)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module ((guix build-system gnu) #:prefix gnu:)
#:use-module ((guix build-system ocaml) #:prefix ocaml:)
#:use-module (guix packages)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%dune-build-system-modules
dune-build
dune-build-system))
;; Commentary:
;;
;; Standard build procedure for packages using dune. This is implemented as an
;; extension of `ocaml-build-system'.
;;
;; Code:
(define %dune-build-system-modules
;; Build-side modules imported by default.
`((guix build dune-build-system)
,@ocaml:%ocaml-build-system-modules))
(define (default-dune)
"Return the default OCaml package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages ocaml))))
(module-ref module 'dune)))
(define* (lower name
#:key source inputs native-inputs outputs system target
(dune (default-dune))
(ocaml (ocaml:default-ocaml))
(findlib (ocaml:default-findlib))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(let ((base (ocaml:lower name
#:source source
#:inputs inputs
#:native-inputs native-inputs
#:outputs outputs
#:system system
#:target target
#:ocaml ocaml
#:findlib findlib
arguments)))
(bag
(inherit base)
(build-inputs `(("dune" ,dune)
,@(bag-build-inputs base)))
(build dune-build)
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define* (dune-build store name inputs
#:key (guile #f)
(outputs '("out"))
(search-paths '())
(build-flags ''())
(out-of-source? #t)
(jbuild? #f)
(tests? #t)
(test-flags ''())
(test-target "test")
(install-target "install")
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build dune-build-system)
%standard-phases))
(system (%current-system))
(imported-modules %dune-build-system-modules)
(modules '((guix build dune-build-system)
(guix build utils))))
"Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
provides a 'setup.ml' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
(dune-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
#:test-flags ,test-flags
#:build-flags ,build-flags
#:out-of-source? ,out-of-source?
#:jbuild? ,jbuild?
#:tests? ,tests?
#:test-target ,test-target
#:install-target ,install-target
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define dune-build-system
(build-system
(name 'dune)
(description "The standard Dune build system")
(lower lower)))
;;; dune.scm ends here

16
guix/build-system/ocaml.scm
View File

@ -31,6 +31,9 @@
package-with-ocaml4.02
strip-ocaml4.01-variant
strip-ocaml4.02-variant
default-findlib
default-ocaml
lower
ocaml-build
ocaml-build-system))
@ -76,6 +79,13 @@
(let ((module (resolve-interface '(gnu packages ocaml))))
(module-ref module 'ocaml-findlib)))
(define (default-dune-build-system)
"Return the dune-build-system."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(guix build-system dune))))
(module-ref module 'dune-build-system)))
(define (default-ocaml4.01)
(let ((ocaml (resolve-interface '(gnu packages ocaml))))
(module-ref ocaml 'ocaml-4.01)))
@ -119,7 +129,8 @@ pre-defined variants."
=> force)
;; Otherwise build the new package object graph.
((eq? (package-build-system p) ocaml-build-system)
((or (eq? (package-build-system p) ocaml-build-system)
(eq? (package-build-system p) (default-dune-build-system)))
(package
(inherit p)
(location (package-location p))
@ -138,7 +149,8 @@ pre-defined variants."
(else p)))
(define (cut? p)
(or (not (eq? (package-build-system p) ocaml-build-system))
(or (not (or (eq? (package-build-system p) ocaml-build-system)
(eq? (package-build-system p) (default-dune-build-system))))
(package-variant p)))
(package-mapping transform cut?))

69
guix/build/dune-build-system.scm Normal file
View File

@ -0,0 +1,69 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build dune-build-system)
#:use-module ((guix build ocaml-build-system) #:prefix ocaml:)
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:export (%standard-phases
dune-build))
;; Commentary:
;;
;; Builder-side code of the standard dune build procedure.
;;
;; Code:
(define* (build #:key (build-flags '()) (jbuild? #f)
(use-make? #f) #:allow-other-keys)
"Build the given package."
(let ((program (if jbuild? "jbuilder" "dune")))
(apply invoke program "build" "@install" build-flags))
#t)
(define* (check #:key (test-flags '()) (test-target "test") tests?
(jbuild? #f) #:allow-other-keys)
"Test the given package."
(when tests?
(let ((program (if jbuild? "jbuilder" "dune")))
(apply invoke program "runtest" test-target test-flags)))
#t)
(define* (install #:key outputs (install-target "install") (jbuild? #f)
#:allow-other-keys)
"Install the given package."
(let ((out (assoc-ref outputs "out"))
(program (if jbuild? "jbuilder" "dune")))
(invoke program install-target "--prefix" out))
#t)
(define %standard-phases
;; Everything is as with the GNU Build System except for the `configure'
;; , `build', `check' and `install' phases.
(modify-phases ocaml:%standard-phases
(delete 'configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)))
(define* (dune-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order."
(apply ocaml:ocaml-build #:inputs inputs #:phases phases args))
;;; dune-build-system.scm ends here

12
guix/download.scm
View File

@ -411,17 +411,11 @@
(object->string %content-addressed-mirrors)))
(define built-in-builders*
(let ((cache (make-weak-key-hash-table)))
(let ((proc (store-lift built-in-builders)))
(lambda ()
"Return, as a monadic value, the list of built-in builders supported by
the daemon."
(lambda (store)
;; Memoize the result to avoid repeated RPCs.
(values (or (hashq-ref cache store)
(let ((result (built-in-builders store)))
(hashq-set! cache store result)
result))
store)))))
the daemon; cache the return value."
(mcached (proc) built-in-builders))))
(define* (built-in-download file-name url
#:key system hash-algo hash

45
guix/gexp.scm
View File

@ -566,15 +566,15 @@ list."
corresponding input list as a monadic value. When TARGET is true, use it as
the cross-compilation target triplet."
(with-monad %store-monad
(sequence %store-monad
(map (match-lambda
(((? struct? thing) sub-drv ...)
(mlet %store-monad ((drv (lower-object
thing system #:target target)))
(return `(,drv ,@sub-drv))))
(input
(return input)))
inputs))))
(mapm %store-monad
(match-lambda
(((? struct? thing) sub-drv ...)
(mlet %store-monad ((drv (lower-object
thing system #:target target)))
(return `(,drv ,@sub-drv))))
(input
(return input)))
inputs)))
(define* (lower-reference-graphs graphs #:key system target)
"Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
@ -606,7 +606,7 @@ names and file names suitable for the #:allowed-references argument to
#:target target)))
(return (derivation->output-path drv))))))
(sequence %store-monad (map lower lst))))
(mapm %store-monad lower lst)))
(define default-guile-derivation
;; Here we break the abstraction by talking to the higher-level layer.
@ -880,15 +880,15 @@ and in the current monad setting (system type, etc.)"
#:system system
#:target (if (or n? native?) #f target)))
(($ <gexp-input> (refs ...) output n?)
(sequence %store-monad
(map (lambda (ref)
;; XXX: Automatically convert REF to an gexp-input.
(reference->sexp
(if (gexp-input? ref)
ref
(%gexp-input ref "out" n?))
(or n? native?)))
refs)))
(mapm %store-monad
(lambda (ref)
;; XXX: Automatically convert REF to an gexp-input.
(reference->sexp
(if (gexp-input? ref)
ref
(%gexp-input ref "out" n?))
(or n? native?)))
refs))
(($ <gexp-input> (? struct? thing) output n?)
(let ((target (if (or n? native?) #f target))
(expand (lookup-expander thing)))
@ -902,8 +902,8 @@ and in the current monad setting (system type, etc.)"
(return x)))))
(mlet %store-monad
((args (sequence %store-monad
(map reference->sexp (gexp-references exp)))))
((args (mapm %store-monad
reference->sexp (gexp-references exp))))
(return (apply (gexp-proc exp) args))))
(define (syntax-location-string s)
@ -1117,8 +1117,7 @@ to the source files instead of copying them."
(mlet %store-monad ((file (lower-object file-like system)))
(return (list final-path file))))))
(mlet %store-monad ((files (sequence %store-monad
(map file-pair files))))
(mlet %store-monad ((files (mapm %store-monad file-pair files)))
(define build
(gexp
(begin

17
guix/import/cran.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
@ -23,6 +23,7 @@
#:use-module (ice-9 regex)
#:use-module ((ice-9 rdelim) #:select (read-string read-line))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (ice-9 receive)
@ -180,9 +181,9 @@ from ~s: ~a (~s)~%"
;; Currently, the bioconductor project does not offer a way to access a
;; package's DESCRIPTION file over HTTP, so we determine the version,
;; download the source tarball, and then extract the DESCRIPTION file.
(let* ((version (latest-bioconductor-package-version name))
(url (car (bioconductor-uri name version)))
(tarball (with-store store (download-to-store store url))))
(and-let* ((version (latest-bioconductor-package-version name))
(url (car (bioconductor-uri name version)))
(tarball (with-store store (download-to-store store url))))
(call-with-temporary-directory
(lambda (dir)
(parameterize ((current-error-port (%make-void-port "rw+"))
@ -346,8 +347,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(lambda* (package-name #:optional (repo 'cran))
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
(and=> (fetch-description repo package-name)
(cut description->package repo <>)))))
(let ((description (fetch-description repo package-name)))
(if (and (not description)
(eq? repo 'bioconductor))
;; Retry import from CRAN
(cran->guix-package package-name 'cran)
(description->package repo description))))))
(define* (cran-recursive-import package-name #:optional (repo 'gnu))
(recursive-import package-name repo

295
guix/import/opam.scm
View File

@ -17,132 +17,108 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import opam)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 peg)
#:use-module (ice-9 receive)
#:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (web uri)
#:use-module (guix http-client)
#:use-module (guix git)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:export (opam->guix-package))
(define (opam-urls)
"Fetch the urls.txt file from the opam repository and returns the list of
URLs it contains."
(let ((port (http-fetch/cached (string->uri "https://opam.ocaml.org/urls.txt"))))
(let loop ((result '()))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(loop (cons line result)))))))
;; Define a PEG parser for the opam format
(define-peg-pattern SP none (or " " "\n"))
(define-peg-pattern SP2 body (or " " "\n"))
(define-peg-pattern QUOTE none "\"")
(define-peg-pattern QUOTE2 body "\"")
(define-peg-pattern COLON none ":")
;; A string character is any character that is not a quote, or a quote preceded by a backslash.
(define-peg-pattern STRCHR body
(or " " "!" (and (ignore "\\") "\"")
(and (ignore "\\") "\\") (range #\# #\頋)))
(define-peg-pattern operator all (or "=" "!" "<" ">"))
(define (vhash-ref hashtable key default)
(match (vhash-assoc key hashtable)
(#f default)
((_ . x) x)))
(define-peg-pattern records body (* (and (or record weird-record) (* SP))))
(define-peg-pattern record all (and key COLON (* SP) value))
(define-peg-pattern weird-record all (and key (* SP) dict))
(define-peg-pattern key body (+ (or (range #\a #\z) "-")))
(define-peg-pattern value body (and (or conditional-value ground-value operator) (* SP)))
(define-peg-pattern ground-value body (and (or multiline-string string-pat list-pat var) (* SP)))
(define-peg-pattern conditional-value all (and ground-value (* SP) condition))
(define-peg-pattern string-pat all (and QUOTE (* STRCHR) QUOTE))
(define-peg-pattern list-pat all (and (ignore "[") (* SP) (* (and value (* SP))) (ignore "]")))
(define-peg-pattern var all (+ (or (range #\a #\z) "-")))
(define-peg-pattern multiline-string all
(and QUOTE QUOTE QUOTE (* SP)
(* (or SP2 STRCHR (and QUOTE2 (not-followed-by QUOTE))
(and QUOTE2 QUOTE2 (not-followed-by QUOTE))))
QUOTE QUOTE QUOTE))
(define-peg-pattern dict all (and (ignore "{") (* SP) records (* SP) (ignore "}")))
(define (hashtable-update hashtable line)
"Parse @var{line} to get the name and version of the package and adds them
to the hashtable."
(let* ((line (string-split line #\ )))
(match line
((url foo ...)
(if (equal? url "repo")
hashtable
(match (string-split url #\/)
((type name1 versionstr foo ...)
(if (equal? type "packages")
(match (string-split versionstr #\.)
((name2 versions ...)
(let ((version (string-join versions ".")))
(if (equal? name1 name2)
(let ((curr (vhash-ref hashtable name1 '())))
(vhash-cons name1 (cons version curr) hashtable))
hashtable)))
(_ hashtable))
hashtable))
(_ hashtable))))
(_ hashtable))))
(define-peg-pattern condition body (and (ignore "{") condition-form (ignore "}")))
(define (urls->hashtable urls)
"Transform urls.txt in a hashtable whose keys are package names and values
the list of available versions."
(let ((hashtable vlist-null))
(let loop ((urls urls) (hashtable hashtable))
(match urls
(() hashtable)
((url rest ...) (loop rest (hashtable-update hashtable url)))))))
(define-peg-pattern condition-form body
(and
(* SP)
(or condition-and condition-or condition-form2)
(* SP)))
(define-peg-pattern condition-form2 body
(and (* SP) (or condition-greater-or-equal condition-greater
condition-lower-or-equal condition-lower
condition-neq condition-eq condition-content) (* SP)))
;(define-peg-pattern condition-operator all (and (ignore operator) (* SP) condition-string))
(define-peg-pattern condition-greater-or-equal all (and (ignore (and ">" "=")) (* SP) condition-string))
(define-peg-pattern condition-greater all (and (ignore ">") (* SP) condition-string))
(define-peg-pattern condition-lower-or-equal all (and (ignore (and "<" "=")) (* SP) condition-string))
(define-peg-pattern condition-lower all (and (ignore "<") (* SP) condition-string))
(define-peg-pattern condition-and all (and condition-form2 (* SP) (? (ignore "&")) (* SP) condition-form))
(define-peg-pattern condition-or all (and condition-form2 (* SP) (ignore "|") (* SP) condition-form))
(define-peg-pattern condition-eq all (and condition-content (* SP) (ignore "=") (* SP) condition-content))
(define-peg-pattern condition-neq all (and condition-content (* SP) (ignore (and "!" "=")) (* SP) condition-content))
(define-peg-pattern condition-content body (or condition-string condition-var))
(define-peg-pattern condition-content2 body (and condition-content (* SP) (not-followed-by (or "&" "=" "!"))))
(define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE))
(define-peg-pattern condition-var all (+ (or (range #\a #\z) "-")))
(define (get-opam-repository)
"Update or fetch the latest version of the opam repository and return the
path to the repository."
(receive (location commit)
(update-cached-checkout "https://github.com/ocaml/opam-repository")
location))
(define (latest-version versions)
"Find the most recent version from a list of versions."
(match versions
((first rest ...)
(let loop ((versions rest) (m first))
(match versions
(() m)
((first rest ...)
(loop rest (if (version>? m first) m first))))))))
(fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions))
(define (fetch-package-url uri)
"Fetch and parse the url file. Return the URL the package can be downloaded
from."
(let ((port (http-fetch uri)))
(let loop ((result #f))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(let* ((line (string-split line #\ )))
(match line
((key value rest ...)
(if (member key '("archive:" "http:"))
(loop (string-trim-both value #\"))
(loop result))))))))))
(define (find-latest-version package repository)
"Get the latest version of a package as described in the given repository."
(let* ((dir (string-append repository "/packages/" package))
(versions (scandir dir (lambda (name) (not (string-prefix? "." name))))))
(if versions
(let ((versions (map
(lambda (dir)
(string-join (cdr (string-split dir #\.)) "."))
versions)))
(latest-version versions))
(begin
(format #t (G_ "Package not found in opam repository: ~a~%") package)
#f))))
(define (fetch-package-metadata uri)
"Fetch and parse the opam file. Return an association list containing the
homepage, the license and the list of inputs."
(let ((port (http-fetch uri)))
(let loop ((result '()) (dependencies? #f))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(let* ((line (string-split line #\ )))
(match line
((key value ...)
(let ((dependencies?
(if dependencies?
(not (equal? key "]"))
(equal? key "depends:")))
(val (string-trim-both (string-join value "") #\")))
(cond
((equal? key "homepage:")
(loop (cons `("homepage" . ,val) result) dependencies?))
((equal? key "license:")
(loop (cons `("license" . ,val) result) dependencies?))
((and dependencies? (not (equal? val "[")))
(match (string-split val #\{)
((val rest ...)
(let ((curr (assoc-ref result "inputs"))
(new (string-trim-both
val (list->char-set '(#\] #\[ #\")))))
(loop (cons `("inputs" . ,(cons new (if curr curr '()))) result)
(if (string-contains val "]") #f dependencies?))))))
(else (loop result dependencies?))))))))))))
(define (string->license str)
(cond
((equal? str "MIT") '(license:expat))
((equal? str "GPL2") '(license:gpl2))
((equal? str "LGPLv2") '(license:lgpl2))
(else `())))
(define (get-metadata opam-file)
(with-input-from-file opam-file
(lambda _
(peg:tree (match-pattern records (get-string-all (current-input-port)))))))
(define (ocaml-name->guix-name name)
(cond
@ -151,33 +127,85 @@ homepage, the license and the list of inputs."
((string-prefix? "conf-" name) (substring name 5))
(else (string-append "ocaml-" name))))
(define (dependencies->inputs dependencies)
"Transform the list of dependencies in a list of inputs."
(if (not dependencies)
'()
(map (lambda (input)
(list input (list 'unquote (string->symbol input))))
(map ocaml-name->guix-name dependencies))))
(define (metadata-ref file lookup)
(pk 'file file 'lookup lookup)
(fold (lambda (record acc)
(match record
((record key val)
(if (equal? key lookup)
(match val
(('list-pat . stuff) stuff)
(('string-pat stuff) stuff)
(('multiline-string stuff) stuff)
(('dict records ...) records))
acc))))
#f file))
(define (native? condition)
(match condition
(('condition-var var)
(match var
("with-test" #t)
("test" #t)
("build" #t)
(_ #f)))
((or ('condition-or cond-left cond-right) ('condition-and cond-left cond-right))
(or (native? cond-left)
(native? cond-right)))
(_ #f)))
(define (dependency->input dependency)
(match dependency
(('string-pat str) str)
(('conditional-value val condition)
(if (native? condition) "" (dependency->input val)))))
(define (dependency->native-input dependency)
(match dependency
(('string-pat str) "")
(('conditional-value val condition)
(if (native? condition) (dependency->input val) ""))))
(define (ocaml-names->guix-names names)
(map ocaml-name->guix-name
(remove (lambda (name)
(or (equal? "" name))
(equal? "ocaml" name))
names)))
(define (depends->inputs depends)
(filter (lambda (name)
(and (not (equal? "" name))
(not (equal? "ocaml" name))
(not (equal? "ocamlfind" name))))
(map dependency->input depends)))
(define (depends->native-inputs depends)
(filter (lambda (name) (not (equal? "" name)))
(map dependency->native-input depends)))
(define (dependency-list->inputs lst)
(map
(lambda (dependency)
(list dependency (list 'unquote (string->symbol dependency))))
(ocaml-names->guix-names lst)))
(define (opam->guix-package name)
(let* ((hashtable (urls->hashtable (opam-urls)))
(versions (vhash-ref hashtable name #f)))
(unless (eq? versions #f)
(let* ((version (latest-version versions))
(package-url (string-append "https://opam.ocaml.org/packages/" name
"/" name "." version "/"))
(url-url (string-append package-url "url"))
(opam-url (string-append package-url "opam"))
(source-url (fetch-package-url url-url))
(metadata (fetch-package-metadata opam-url))
(dependencies (assoc-ref metadata "inputs"))
(inputs (dependencies->inputs dependencies)))
(and-let* ((repository (get-opam-repository))
(version (find-latest-version name repository))
(file (string-append repository "/packages/" name "/" name "." (pk 'version version) "/opam"))
(opam-content (get-metadata file))
(url-dict (metadata-ref (pk 'metadata opam-content) "url"))
(source-url (metadata-ref url-dict "src"))
(requirements (metadata-ref opam-content "depends"))
(inputs (dependency-list->inputs (depends->inputs requirements)))
(native-inputs (dependency-list->inputs (depends->native-inputs requirements))))
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch source-url temp)
`(package
(name ,(ocaml-name->guix-name name))
(version ,version)
(version ,(metadata-ref opam-content "version"))
(source
(origin
(method url-fetch)
@ -187,7 +215,10 @@ homepage, the license and the list of inputs."
,@(if (null? inputs)
'()
`((inputs ,(list 'quasiquote inputs))))
(home-page ,(assoc-ref metadata "homepage"))
(synopsis "")
(description "")
(license ,@(string->license (assoc-ref metadata "license")))))))))))
,@(if (null? native-inputs)
'()
`((native-inputs ,(list 'quasiquote native-inputs))))
(home-page ,(metadata-ref opam-content "homepage"))
(synopsis ,(metadata-ref opam-content "synopsis"))
(description ,(metadata-ref opam-content "description"))
(license #f)))))))

12
guix/packages.scm
View File

@ -870,14 +870,14 @@ OVERRIDES."
SYSTEM."
;; FIXME: This memoization should be associated with the open store, because
;; otherwise it breaks when switching to a different store.
(let ((vals (call-with-values thunk list)))
(let ((result (thunk)))
;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
;; same value for all structs (as of Guile 2.0.6), and because pointer
;; equality is sufficient in practice.
(hashq-set! cache package
`((,system ,@vals)
`((,system . ,result)
,@(or (hashq-ref cache package) '())))
(apply values vals)))
result))
(define-syntax cached
(syntax-rules (=>)
@ -889,10 +889,8 @@ Return the cached result when available."
(match (hashq-ref cache package)
((alist (... ...))
(match (assoc-ref alist key)
((vals (... ...))
(apply values vals))
(#f
(cache! cache package key thunk))))
(#f (cache! cache package key thunk))
(value value)))
(#f
(cache! cache package key thunk)))))
((_ package system body ...)

60
guix/profiles.scm
View File

@ -4,7 +4,7 @@
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@ -788,7 +788,10 @@ MANIFEST."
(gexp->derivation "info-dir" build
#:local-build? #t
#:substitutable? #f))
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . info-dir))))
(define (ghc-package-cache-file manifest)
"Return a derivation that builds the GHC 'package.cache' file for all the
@ -842,7 +845,10 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
(map manifest-entry-name (manifest-entries manifest)))
(gexp->derivation "ghc-package-cache" build
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . ghc-package-cache)))
(return #f))))
(define (ca-certificate-bundle manifest)
@ -910,7 +916,10 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx."
(gexp->derivation "ca-certificate-bundle" build
#:local-build? #t
#:substitutable? #f))
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . ca-certificate-bundle))))
(define (glib-schemas manifest)
"Return a derivation that unions all schemas from manifest entries and
@ -960,7 +969,10 @@ creates the Glib 'gschemas.compiled' file."
(if %glib
(gexp->derivation "glib-schemas" build
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . glib-schemas)))
(return #f))))
(define (gtk-icon-themes manifest)
@ -1016,7 +1028,10 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
(if %gtk+
(gexp->derivation "gtk-icon-themes" build
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . gtk-icon-themes)))
(return #f))))
(define (gtk-im-modules manifest)
@ -1088,7 +1103,10 @@ for both major versions of GTK+."
(if (or gtk+ gtk+-2)
(gexp->derivation "gtk-im-modules" gexp
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . gtk-im-modules)))
(return #f)))))
(define (xdg-desktop-database manifest)
@ -1126,7 +1144,10 @@ MIME type."
(if glib
(gexp->derivation "xdg-desktop-database" build
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . xdg-desktop-database)))
(return #f))))
(define (xdg-mime-database manifest)
@ -1165,7 +1186,10 @@ entries. It's used to query the MIME type of a given file."
(if glib
(gexp->derivation "xdg-mime-database" build
#:local-build? #t
#:substitutable? #f)
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . xdg-mime-database)))
(return #f))))
;; Several font packages may install font files into same directory, so
@ -1236,7 +1260,10 @@ files for the fonts of the @var{manifest} entries."
(guix build union)
(srfi srfi-26))
#:local-build? #t
#:substitutable? #f))
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . fonts-dir))))
(define (manual-database manifest)
"Return a derivation that builds the manual page database (\"mandb\") for
@ -1306,7 +1333,10 @@ the entries in MANIFEST."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29654#23>.
#:env-vars `(("MALLOC_PERTURB_" . "1"))
#:local-build? #t))
#:local-build? #t
#:properties
`((type . profile-hook)
(hook . manual-database))))
(define %default-profile-hooks
;; This is the list of derivation-returning procedures that are called by
@ -1353,10 +1383,10 @@ are cross-built for TARGET."
#:target target)))
(extras (if (null? (manifest-entries manifest))
(return '())
(sequence %store-monad
(map (lambda (hook)
(hook manifest))
hooks)))))
(mapm %store-monad
(lambda (hook)
(hook manifest))
hooks))))
(define inputs
(append (filter-map (lambda (drv)
(and (derivation? drv)

28
guix/scripts/environment.scm
View File

@ -162,6 +162,8 @@ COMMAND or an interactive shell in that environment.\n"))
(newline)
(show-build-options-help)
(newline)
(show-transformation-options-help)
(newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
@ -261,7 +263,9 @@ COMMAND or an interactive shell in that environment.\n"))
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
%standard-build-options))
(append %transformation-options
%standard-build-options)))
(define (pick-all alist key)
"Return a list of values in ALIST associated with KEY."
@ -274,7 +278,7 @@ COMMAND or an interactive shell in that environment.\n"))
(_ memo)))
'() alist))
(define (options/resolve-packages opts)
(define (options/resolve-packages store opts)
"Return OPTS with package specification strings replaced by manifest entries
for the corresponding packages."
(define (manifest-entry=? e1 e2)
@ -282,15 +286,21 @@ for the corresponding packages."
(string=? (manifest-entry-output e1)
(manifest-entry-output e2))))
(define transform
(cut (options->transformation opts) store <>))
(define* (package->manifest-entry* package #:optional (output "out"))
(package->manifest-entry (transform package) output))
(define (packages->outputs packages mode)
(match packages
((? package? package)
(if (eq? mode 'ad-hoc-package)
(list (package->manifest-entry package))
(list (package->manifest-entry* package))
(package-environment-inputs package)))
(((? package? package) (? string? output))
(if (eq? mode 'ad-hoc-package)
(list (package->manifest-entry package output))
(list (package->manifest-entry* package output))
(package-environment-inputs package)))
((lst ...)
(append-map (cut packages->outputs <> mode) lst))))
@ -301,7 +311,7 @@ for the corresponding packages."
(('package 'ad-hoc-package (? string? spec))
(let-values (((package output)
(specification->package+output spec)))
(list (package->manifest-entry package output))))
(list (package->manifest-entry* package output))))
(('package 'package (? string? spec))
(package-environment-inputs
(specification->package+output spec)))
@ -364,8 +374,8 @@ requisite store items i.e. the union closure of all the inputs."
((? direct-store-path? path)
(list path)))))
(mlet %store-monad ((reqs (sequence %store-monad
(map input->requisites inputs))))
(mlet %store-monad ((reqs (mapm %store-monad
input->requisites inputs)))
(return (delete-duplicates (concatenate reqs)))))
(define (status->exit-code status)
@ -654,7 +664,6 @@ message if any test fails."
;; within the container.
'("/bin/sh")
(list %default-shell))))
(manifest (options/resolve-packages opts))
(mappings (pick-all opts 'file-system-mapping)))
(when container? (assert-container-features))
@ -666,6 +675,9 @@ message if any test fails."
(with-store store
(with-status-report print-build-event
(define manifest
(options/resolve-packages store opts))
(set-build-options-from-command-line store opts)
;; Use the bootstrap Guile when requested.

128
guix/scripts/offload.scm
View File

@ -321,6 +321,13 @@ hook."
(set-port-revealed! port 1)
port))
(define (node-free-disk-space node)
"Return the free disk space, in bytes, in NODE's store."
(node-eval node
`(begin
(use-modules (guix build syscalls))
(free-disk-space ,(%store-prefix)))))
(define* (transfer-and-offload drv machine
#:key
(inputs '())
@ -360,9 +367,19 @@ MACHINE."
(derivation-file-name drv)
(build-machine-name machine)
(nix-protocol-error-message c))
;; Use exit code 100 for a permanent build failure. The daemon
;; interprets other non-zero codes as transient build failures.
(primitive-exit 100)))
(let* ((space (false-if-exception
(node-free-disk-space (make-node session)))))
;; Use exit code 100 for a permanent build failure. The daemon
;; interprets other non-zero codes as transient build failures.
(if (and space (< space (* 10 (expt 2 20))))
(begin
(format (current-error-port)
(G_ "build failure may have been caused by lack \
of free disk space on '~a'~%")
(build-machine-name machine))
(primitive-exit 1))
(primitive-exit 100)))))
(parameterize ((current-build-output-port (build-log-port)))
(build-derivations store (list drv))))
@ -392,33 +409,37 @@ MACHINE."
(build-requirements-features requirements)
(build-machine-features machine))))
(define (machine-load machine)
"Return the load of MACHINE, divided by the number of parallel builds
allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; Note: This procedure is costly since it creates a new SSH session.
(match (false-if-exception (open-ssh-session machine))
((? session? session)
(let* ((pipe (open-remote-pipe* session OPEN_READ
"cat" "/proc/loadavg"))
(line (read-line pipe)))
(close-port pipe)
(disconnect! session)
(define %minimum-disk-space
;; Minimum disk space required on the build machine for a build to be
;; offloaded. This keeps us from offloading to machines that are bound to
;; run out of disk space.
(* 100 (expt 2 20))) ;100 MiB
(if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line)
((one five fifteen . x)
(let* ((raw (string->number one))
(jobs (build-machine-parallel-builds machine))
(normalized (/ raw jobs)))
(format (current-error-port) "load on machine '~a' is ~s\
(define (node-load node)
"Return the load on NODE. Return +∞ if NODE is misbehaving."
(let ((line (node-eval node
'(begin
(use-modules (ice-9 rdelim))
(call-with-input-file "/proc/loadavg"
read-string)))))
(if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line)
((one five fifteen . x)
(string->number one))
(x
+inf.0)))))
(define (normalized-load machine load)
"Divide LOAD by the number of parallel builds of MACHINE."
(if (rational? load)
(let* ((jobs (build-machine-parallel-builds machine))
(normalized (/ load jobs)))
(format (current-error-port) "load on machine '~a' is ~s\
(normalized: ~s)~%"
(build-machine-name machine) raw normalized)
normalized))
(x
+inf.0))))) ;something's fishy about MACHINE, so avoid it
(x
+inf.0))) ;failed to connect to MACHINE, so avoid it
(build-machine-name machine) load normalized)
normalized)
load))
(define (machine-lock-file machine hint)
"Return the name of MACHINE's lock file for HINT."
@ -484,21 +505,32 @@ slot (which must later be released with 'release-build-slot'), or #f and #f."
(match machines+slots
(((best slot) others ...)
;; Return the best machine unless it's already overloaded.
;; Note: We call 'machine-load' only as a last resort because it is
;; Note: We call 'node-load' only as a last resort because it is
;; too costly to call it once for every machine.
(if (< (machine-load best) 2.)
(match others
(((machines slots) ...)
;; Release slots from the uninteresting machines.
(for-each release-build-slot slots)
(let* ((session (false-if-exception (open-ssh-session best)))
(node (and session (make-node session)))
(load (and node (normalized-load best (node-load node))))
(space (and node (node-free-disk-space node))))
(when session (disconnect! session))
(if (and node (< load 2.) (>= space %minimum-disk-space))
(match others
(((machines slots) ...)
;; Release slots from the uninteresting machines.
(for-each release-build-slot slots)
;; The caller must keep SLOT to protect it from GC and to
;; eventually release it.
(values best slot)))
(begin
;; BEST is overloaded, so try the next one.
(release-build-slot slot)
(loop others))))
;; The caller must keep SLOT to protect it from GC and to
;; eventually release it.
(values best slot)))
(begin
;; BEST is unsuitable, so try the next one.
(when (and space (< space %minimum-disk-space))
(format (current-error-port)
"skipping machine '~a' because it is low \
on disk space (~,2f MiB free)~%"
(build-machine-name best)
(/ space (expt 2 20) 1.)))
(release-build-slot slot)
(loop others)))))
(()
(values #f #f))))))
@ -689,16 +721,20 @@ machine."
(info (G_ "getting status of ~a build machines defined in '~a'...~%")
(length machines) machine-file)
(for-each (lambda (machine)
(let* ((node (make-node (open-ssh-session machine)))
(uts (node-eval node '(uname))))
(let* ((session (open-ssh-session machine))
(node (make-node session))
(uts (node-eval node '(uname)))
(load (node-load node))
(free (node-free-disk-space node)))
(disconnect! session)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~%"
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%"
(build-machine-name machine)
(utsname:sysname uts) (utsname:release uts)
(utsname:machine uts)
(utsname:nodename uts)
(parameterize ((current-error-port (%make-void-port "rw+")))
(machine-load machine)))))
load
(/ free (expt 2 20) 1.))))
machines)))

11
guix/scripts/publish.scm
View File

@ -537,14 +537,19 @@ requested using POOL."
(not-found request))))
(define* (render-nar/cached store cache request store-item
#:key (compression %no-compression))
#:key ttl (compression %no-compression))
"Respond to REQUEST with a nar for STORE-ITEM. If the nar is in CACHE,
return it; otherwise, return 404."
return it; otherwise, return 404. When TTL is true, use it as the
'Cache-Control' expiration time."
(let ((cached (nar-cache-file cache store-item
#:compression compression)))
(if (file-exists? cached)
(values `((content-type . (application/octet-stream
(charset . "ISO-8859-1")))
,@(if ttl
`((cache-control (max-age . ,ttl)))
'())
;; XXX: We're not returning the actual contents, deferring
;; instead to 'http-write'. This is a hack to work around
;; <http://bugs.gnu.org/21093>.
@ -819,6 +824,7 @@ blocking."
%default-gzip-compression))))
(if cache
(render-nar/cached store cache request store-item
#:ttl narinfo-ttl
#:compression compression)
(render-nar store request store-item
#:compression compression)))
@ -829,6 +835,7 @@ blocking."
(if (nar-path? components)
(if cache
(render-nar/cached store cache request store-item
#:ttl narinfo-ttl
#:compression %no-compression)
(render-nar store request store-item
#:compression %no-compression))

13
guix/scripts/substitute.scm
View File

@ -392,12 +392,21 @@ No authentication and authorization checks are performed here!"
(define (narinfo-sha256 narinfo)
"Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
'Signature' field."
(define %mandatory-fields
;; List of fields that must be signed. If they are not signed, the
;; narinfo is considered unsigned.
'("StorePath" "NarHash" "References"))
(let ((contents (narinfo-contents narinfo)))
(match (string-contains contents "Signature:")
(#f #f)
(index
(let ((above-signature (string-take contents index)))
(sha256 (string->utf8 above-signature)))))))
(let* ((above-signature (string-take contents index))
(signed-fields (match (call-with-input-string above-signature
fields->alist)
(((fields . values) ...) fields))))
(and (every (cut member <> signed-fields) %mandatory-fields)
(sha256 (string->utf8 above-signature))))))))
(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
#:key verbose?)

3
guix/scripts/system.scm
View File

@ -993,7 +993,8 @@ Some ACTIONS support additional ARGS.\n"))
instead of reading FILE, when applicable"))
(display (G_ "
--on-error=STRATEGY
apply STRATEGY when an error occurs while reading FILE"))
apply STRATEGY (one of nothing-special, backtrace,
or debug) when an error occurs while reading FILE"))
(display (G_ "
--file-system-type=TYPE
for 'disk-image', produce a root file system of TYPE

33
guix/status.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -289,6 +290,31 @@ on."
("^(.*)(warning)([[:blank:]]*)(:)(.*)"
RESET MAGENTA BOLD BOLD BOLD)))
(define (hook-message hook-type)
"Return a human-readable string for the profile hook type HOOK-TYPE."
(match hook-type
('info-dir
(G_ "building directory of Info manuals..."))
('ghc-package-cache
(G_ "building GHC package cache..."))
('ca-certificate-bundle
(G_ "building CA certificate bundle..."))
('glib-schemas
(G_ "generating GLib schema cache..."))
('gtk-icon-themes
(G_ "creating GTK+ icon theme cache..."))
('gtk-im-modules
(G_ "building cache files for GTK+ input methods..."))
('xdg-desktop-database
(G_ "building XDG desktop file cache..."))
('xdg-mime-database
(G_ "building XDG MIME database..."))
('fonts-dir
(G_ "building fonts directory..."))
('manual-database
(G_ "building database for manual pages..."))
(_ #f)))
(define* (print-build-event event old-status status
#:optional (port (current-error-port))
#:key
@ -336,6 +362,13 @@ addition to build events."
"applying ~a grafts for ~a..."
count))
count drv)))
('profile-hook
(let ((hook-type (assq-ref properties 'hook)))
(or (and=> (hook-message hook-type)
(lambda (msg)
(format port (info msg))))
(format port (info (G_ "running profile hook of type '~a'..."))
hook-type))))
(_
(format port (info (G_ "building ~a...")) drv))))
(newline port))

63
guix/store.scm
View File

@ -846,6 +846,14 @@ bytevector) as its internal buffer, and a thunk to flush this output port."
write #f #f flush)
flush))
(define profiled?
(let ((profiled
(or (and=> (getenv "GUIX_PROFILING") string-tokenize)
'())))
(lambda (component)
"Return true if COMPONENT profiling is active."
(member component profiled))))
(define %rpc-calls
;; Mapping from RPC names (symbols) to invocation counts.
(make-hash-table))
@ -1504,24 +1512,55 @@ and RESULT is typically its derivation."
(object-cache (vhash-consq object (cons result keys)
(nix-server-object-cache store)))))))
(define record-cache-lookup!
(if (profiled? "object-cache")
(let ((fresh 0)
(lookups 0)
(hits 0))
(register-profiling-hook!
"object-cache"
(lambda ()
(format (current-error-port) "Store object cache:
fresh caches: ~5@a
lookups: ~5@a
hits: ~5@a (~,1f%)~%"
fresh lookups hits
(if (zero? lookups)
100.
(* 100. (/ hits lookups))))))
(lambda (hit? cache)
(set! fresh
(if (eq? cache vlist-null)
(+ 1 fresh)
fresh))
(set! lookups (+ 1 lookups))
(set! hits (if hit? (+ hits 1) hits))))
(lambda (x y)
#t)))
(define* (lookup-cached-object object #:optional (keys '()))
"Return the cached object in the store connection corresponding to OBJECT
and KEYS. KEYS is a list of additional keys to match against, and which are
compared with 'equal?'. Return #f on failure and the cached result
otherwise."
(lambda (store)
;; Escape as soon as we find the result. This avoids traversing the whole
;; vlist chain and significantly reduces the number of 'hashq' calls.
(values (let/ec return
(vhash-foldq* (lambda (item result)
(match item
((value . keys*)
(if (equal? keys keys*)
(return value)
result))))
#f object
(nix-server-object-cache store)))
store)))
(let* ((cache (nix-server-object-cache store))
;; Escape as soon as we find the result. This avoids traversing
;; the whole vlist chain and significantly reduces the number of
;; 'hashq' calls.
(value (let/ec return
(vhash-foldq* (lambda (item result)
(match item
((value . keys*)
(if (equal? keys keys*)
(return value)
result))))
#f object
cache))))
(record-cache-lookup! value cache)
(values value store))))
(define* (%mcached mthunk object #:optional (keys '()))
"Bind the monadic value returned by MTHUNK, which supposedly corresponds to

9
guix/store/database.scm
View File

@ -79,6 +79,15 @@ as specified by SQL-SCHEMA."
create it and initialize it as a new database."
(let ((new? (not (file-exists? file)))
(db (sqlite-open file)))
;; Turn DB in "write-ahead log" mode, which should avoid SQLITE_LOCKED
;; errors when we have several readers: <https://www.sqlite.org/wal.html>.
(sqlite-exec db "PRAGMA journal_mode=WAL;")
;; Install a busy handler such that, when the database is locked, sqlite
;; retries until 30 seconds have passed, at which point it gives up and
;; throws SQLITE_BUSY.
(sqlite-exec db "PRAGMA busy_timeout = 30000;")
(dynamic-wind noop
(lambda ()
(when new?

40
guix/store/deduplication.scm
View File

@ -99,24 +99,38 @@ LINK-PREFIX."
(define* (replace-with-link target to-replace
#:key (swap-directory (dirname target)))
"Atomically replace the file TO-REPLACE with a link to TARGET. Use
SWAP-DIRECTORY as the directory to store temporary hard links.
SWAP-DIRECTORY as the directory to store temporary hard links. Upon ENOSPC
and EMLINK, TO-REPLACE is left unchanged.
Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
(let* ((temp-link (get-temp-link target swap-directory))
(parent (dirname to-replace))
(stat (stat parent)))
(make-file-writable parent)
(define temp-link
(catch 'system-error
(lambda ()
(rename-file temp-link to-replace)
;; Restore PARENT's mtime and permissions.
(set-file-time parent stat)
(chmod parent (stat:mode stat)))
(get-temp-link target swap-directory))
(lambda args
(delete-file temp-link)
(unless (= EMLINK (system-error-errno args))
(apply throw args))))))
;; We get ENOSPC when we can't fit an additional entry in
;; SWAP-DIRECTORY.
(if (= ENOSPC (system-error-errno args))
#f
(apply throw args)))))
;; If we couldn't create TEMP-LINK, that's OK: just don't do the
;; replacement, which means TO-REPLACE won't be deduplicated.
(when temp-link
(let* ((parent (dirname to-replace))
(stat (stat parent)))
(make-file-writable parent)
(catch 'system-error
(lambda ()
(rename-file temp-link to-replace))
(lambda args
(delete-file temp-link)
(unless (= EMLINK (system-error-errno args))
(apply throw args))))
;; Restore PARENT's mtime and permissions.
(set-file-time parent stat)
(chmod parent (stat:mode stat)))))
(define* (deduplicate path hash #:key (store %store-directory))
"Check if a store item with sha256 hash HASH already exists. If so,

59
guix/ui.scm
View File

@ -502,14 +502,19 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(list (strerror (car errno)) file)
(list errno))))
(define-syntax-rule (error-reporting-wrapper proc (args ...) file)
(define-syntax apply-formals
(syntax-rules ()
((_ proc (args ...)) (proc args ...))
((_ proc (arg1 args ... . rest)) (apply proc arg1 args ... rest))))
(define-syntax-rule (error-reporting-wrapper proc formals file)
"Wrap PROC such that its 'system-error' exceptions are augmented to mention
FILE."
(let ((real-proc (@ (guile) proc)))
(lambda (args ...)
(lambda formals
(catch 'system-error
(lambda ()
(real-proc args ...))
(apply-formals real-proc formals))
(augmented-system-error-handler file)))))
(set! symlink
@ -528,6 +533,8 @@ FILE."
(set! delete-file
(error-reporting-wrapper delete-file (file) file))
(set! execlp
(error-reporting-wrapper execlp (filename . args) filename))
(define (make-regexp* regexp . flags)
"Like 'make-regexp' but error out if REGEXP is invalid, reporting the error
@ -822,6 +829,12 @@ warning."
('graft #t)
(_ #f)))
(define (profile-hook-derivation? drv)
"Return true if DRV is definitely a profile hook derivation, false otherwise."
(match (assq-ref (derivation-properties drv) 'type)
('profile-hook #t)
(_ #f)))
(define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t)
(mode (build-mode normal)))
@ -872,10 +885,28 @@ report what is prerequisites are available for download."
substitutable-references
download))))
download))
((graft build)
(partition (compose graft-derivation?
read-derivation-from-file)
build)))
((graft hook build)
(match (fold (lambda (file acc)
(let ((drv (read-derivation-from-file file)))
(match acc
((#:graft graft #:hook hook #:build build)
(cond
((graft-derivation? drv)
`(#:graft ,(cons file graft)
#:hook ,hook
#:build ,build))
((profile-hook-derivation? drv)
`(#:graft ,graft
#:hook ,(cons file hook)
#:build ,build))
(else
`(#:graft ,graft
#:hook ,hook
#:build ,(cons file build))))))))
'(#:graft () #:hook () #:build ())
build)
((#:graft graft #:hook hook #:build build)
(values graft hook build)))))
(define installed-size
(reduce + 0 (map substitutable-nar-size download)))
@ -913,7 +944,12 @@ report what is prerequisites are available for download."
(N_ "~:[The following graft would be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts would be made:~%~{ ~a~%~}~;~]"
(length graft))
(null? graft) graft))
(null? graft) graft)
(format (current-error-port)
(N_ "~:[The following profile hook would be built:~%~{ ~a~%~}~;~]"
"~:[The following profile hooks would be built:~%~{ ~a~%~}~;~]"
(length hook))
(null? hook) hook))
(begin
(format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
@ -938,7 +974,12 @@ report what is prerequisites are available for download."
(N_ "~:[The following graft will be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts will be made:~%~{ ~a~%~}~;~]"
(length graft))
(null? graft) graft)))
(null? graft) graft)
(format (current-error-port)
(N_ "~:[The following profile hook will be built:~%~{ ~a~%~}~;~]"
"~:[The following profile hooks will be built:~%~{ ~a~%~}~;~]"
(length hook))
(null? hook) hook)))
(check-available-space installed-size)

22
guix/utils.scm
View File

@ -731,17 +731,19 @@ environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
;;; Source location.
;;;
(define (absolute-dirname file)
"Return the absolute name of the directory containing FILE, or #f upon
(define absolute-dirname
;; Memoize to avoid repeated 'stat' storms from 'search-path'.
(mlambda (file)
"Return the absolute name of the directory containing FILE, or #f upon
failure."
(match (search-path %load-path file)
(#f #f)
((? string? file)
;; If there are relative names in %LOAD-PATH, FILE can be relative and
;; needs to be canonicalized.
(if (string-prefix? "/" file)
(dirname file)
(canonicalize-path (dirname file))))))
(match (search-path %load-path file)
(#f #f)
((? string? file)
;; If there are relative names in %LOAD-PATH, FILE can be relative and
;; needs to be canonicalized.
(if (string-prefix? "/" file)
(dirname file)
(canonicalize-path (dirname file)))))))
(define-syntax current-source-directory
(lambda (s)

22
nix/libstore/build.cc
View File

@ -545,7 +545,7 @@ void UserLock::acquire()
/* Sanity check... */
if (uid == getuid() || uid == geteuid())
throw Error(format("the Nix user should not be a member of `%1%'")
throw Error(format("the build user should not be a member of `%1%'")
% settings.buildUsersGroup);
/* Get the list of supplementary groups of this build user. This
@ -989,7 +989,7 @@ void DerivationGoal::init()
trace("init");
if (settings.readOnlyMode)
throw Error(format("cannot build derivation `%1%' - no write access to the Nix store") % drvPath);
throw Error(format("cannot build derivation `%1%' - no write access to the store") % drvPath);
/* The first thing to do is to make sure that the derivation
exists. If it doesn't, it may be created through a
@ -1287,7 +1287,7 @@ void DerivationGoal::tryToBuild()
}
/* Obtain locks on all output paths. The locks are automatically
released when we exit this function or Nix crashes. If we
released when we exit this function or the client crashes. If we
can't acquire the lock, then continue; hopefully some other
goal can start a build, and if not, the main loop will sleep a
few seconds and then retry this goal. */
@ -1706,7 +1706,7 @@ void DerivationGoal::startBuilder()
Path homeDir = "/homeless-shelter";
env["HOME"] = homeDir;
/* Tell the builder where the Nix store is. Usually they
/* Tell the builder where the store is. Usually they
shouldn't care, but this is useful for purity checking (e.g.,
the compiler or linker might only want to accept paths to files
in the store or in the build directory). */
@ -1827,9 +1827,9 @@ void DerivationGoal::startBuilder()
if (useChroot) {
#if CHROOT_ENABLED
/* Create a temporary directory in which we set up the chroot
environment using bind-mounts. We put it in the Nix store
environment using bind-mounts. We put it in the store
to ensure that we can create hard-links to non-directory
inputs in the fake Nix store in the chroot (see below). */
inputs in the fake store in the chroot (see below). */
chrootRootDir = drvPath + ".chroot";
if (pathExists(chrootRootDir)) deletePath(chrootRootDir);
@ -1888,11 +1888,11 @@ void DerivationGoal::startBuilder()
dirsInChroot[tmpDirInSandbox] = tmpDir;
/* Make the closure of the inputs available in the chroot,
rather than the whole Nix store. This prevents any access
rather than the whole store. This prevents any access
to undeclared dependencies. Directories are bind-mounted,
while other inputs are hard-linked (since only directories
can be bind-mounted). !!! As an extra security
precaution, make the fake Nix store only writable by the
precaution, make the fake store only writable by the
build user. */
Path chrootStoreDir = chrootRootDir + settings.nixStore;
createDirs(chrootStoreDir);
@ -2387,12 +2387,12 @@ void DerivationGoal::registerOutputs()
if (useChroot) {
actualPath = chrootRootDir + path;
if (pathExists(actualPath)) {
/* Move output paths from the chroot to the Nix store. */
/* Move output paths from the chroot to the store. */
if (buildMode == bmRepair)
replaceValidPath(path, actualPath);
else
if (buildMode != bmCheck && rename(actualPath.c_str(), path.c_str()) == -1)
throw SysError(format("moving build output `%1%' from the chroot to the Nix store") % path);
throw SysError(format("moving build output `%1%' from the chroot to the store") % path);
}
if (buildMode != bmCheck) actualPath = path;
} else {
@ -2975,7 +2975,7 @@ void SubstitutionGoal::init()
}
if (settings.readOnlyMode)
throw Error(format("cannot substitute path `%1%' - no write access to the Nix store") % storePath);
throw Error(format("cannot substitute path `%1%' - no write access to the store") % storePath);
subs = settings.substituters;

Some files were not shown because too many files have changed in this diff Show More