diff options
| author | Leo Famulari <leo@famulari.name> | 2017-02-02 10:52:24 -0500 |
|---|---|---|
| committer | Leo Famulari <leo@famulari.name> | 2017-02-02 10:52:24 -0500 |
| commit | e8c83d04e176f205b30b3d470f22ee5e1c686331 (patch) | |
| tree | 30a95626ea31414a6319b93f50eea1e69b87a619 | |
| parent | d9b4cbc2a168ca3d248c5abf1f1d14c1808e6a20 (diff) | |
| parent | de643f0c15677665acce73db9c28c5488e623633 (diff) | |
| download | patches-e8c83d04e176f205b30b3d470f22ee5e1c686331.tar patches-e8c83d04e176f205b30b3d470f22ee5e1c686331.tar.gz | |
Merge branch 'master' into core-updates
114 files changed, 3971 insertions, 897 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index adcc50c560..917fd3004a 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -52,6 +52,8 @@ (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1)) (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) + (eval . (put 'mlambda 'scheme-indent-function 1)) + (eval . (put 'mlambdaq 'scheme-indent-function 1)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1)) (eval . (put 'mbegin 'scheme-indent-function 1)) @@ -40,11 +40,12 @@ Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk> Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org> Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org> Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com> -ng0 <ng0@libertad.pw> <ng0@we.make.ritual.n0.is> -ng0 <ng0@libertad.pw> <ngillmann@runbox.com> -ng0 <ng0@libertad.pw> <niasterisk@grrlz.net> -ng0 <ng0@libertad.pw> <ng@niasterisk.space> -ng0 <ng0@libertad.pw> +ng0 <contact.ng0@cryptolab.net> +ng0 <contact.ng0@cryptolab.net> <ng0@we.make.ritual.n0.is> +ng0 <contact.ng0@cryptolab.net> <ngillmann@runbox.com> +ng0 <contact.ng0@cryptolab.net> <niasterisk@grrlz.net> +ng0 <contact.ng0@cryptolab.net> <ng@niasterisk.space> +ng0 <contact.ng0@cryptolab.net> <ng0@libertad.pw> Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public01@thebird.nl> Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@thebird.nl> Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@email> @@ -3,7 +3,7 @@ #+TITLE: Hacking GNU Guix and Its Incredible Distro Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org> -Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> +Copyright © 2015, 2017 Mathieu Lirzin <mthl@gnu.org> Copyright © 2017 Leo Famulari <leo@famulari.name> Copying and distribution of this file, with or without modification, @@ -14,7 +14,7 @@ Copyright © 2017 Leo Famulari <leo@famulari.name> See the manual for useful hacking informations, either by running - info -f doc/guix.info "(guix) Contributing" + info -f doc/guix.info "Contributing" or by checking the [[http://www.gnu.org/software/guix/manual/guix.html#Contributing][web copy of the manual]]. diff --git a/Makefile.am b/Makefile.am index ca5bb6a266..4104ccf412 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,6 +39,7 @@ MODULES = \ guix/pk-crypto.scm \ guix/pki.scm \ guix/combinators.scm \ + guix/memoization.scm \ guix/utils.scm \ guix/sets.scm \ guix/modules.scm \ @@ -42,7 +42,7 @@ When `--disable-daemon' was passed, you instead need the following: See the manual for the installation instructions, either by running - info -f doc/guix.info "(guix) Installation" + info -f doc/guix.info "Installation" or by checking the [[http://www.gnu.org/software/guix/manual/guix.html#Installation][web copy of the manual]]. diff --git a/doc/guix.texi b/doc/guix.texi index 7093bf7461..6acde6621b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -452,6 +452,7 @@ If your host distro uses the Upstart init system: @example # ln -s ~root/.guix-profile/lib/upstart/system/guix-daemon.conf /etc/init/ +# initctl reload-configuration # start guix-daemon @end example @@ -2336,7 +2337,9 @@ instance, when user @code{root} runs @command{guix pull}, this has no effect on the version of Guix that user @code{alice} sees, and vice versa@footnote{Under the hood, @command{guix pull} updates the @file{~/.config/guix/latest} symbolic link to point to the latest Guix, -and the @command{guix} command loads code from there.}. +and the @command{guix} command loads code from there. Currently, the +only way to roll back an invocation of @command{guix pull} is to +manually update this symlink to point to the previous Guix.}. The @command{guix pull} command is usually invoked with no arguments, but it supports the following options: @@ -3290,6 +3293,49 @@ specified with the @code{#:glib} parameter. Both phases are executed after the @code{install} phase. @end defvr +@defvr {Scheme Variable} ocaml-build-system +This variable is exported by @code{(guix build-sytem ocaml)}. It implements +a build procedure for @uref{https://ocaml.org, OCaml} packages, which consists +of choosing the correct set of commands to run for each package. OCaml +packages can expect many different commands to be run. This build system will +try some of them. + +When the package has a @file{setup.ml} file present at the top-level, it will +run @code{ocaml setup.ml -configure}, @code{ocaml setup.ml -build} and +@code{ocaml setup.ml -install}. The build system will assume that this file +was generated by @uref{http://oasis.forge.ocamlcore.org/, OASIS} and will take +care of setting the prefix and enabling tests if they are not disabled. You +can pass configure and build flags with the @code{#:configure-flags} and +@code{#:build-flags}. The @code{#:test-flags} key can be passed to change the +set of flags used to enable tests. The @code{#:use-make?} key can be used to +bypass this system in the build and install phases. + +When the package has a @file{configure} file, it is assumed that it is a +hand-made configure script that requires a different argument format than +in the @code{gnu-build-system}. You can add more flags with the +@code{#:configure-flags} key. + +When the package has a @file{Makefile} file (or @code{#:use-make?} is +@code{#t}), it will be used and more flags can be passed to the build and +install phases with the @code{#:make-flags} key. + +Finally, some packages do not have these files and use a somewhat standard +location for its build system. In that case, the build system will run +@code{ocaml pkg/pkg.ml} or @code{ocaml pkg/build.ml} and take care of +providing the path to the required findlib module. Additional flags can +be passed via the @code{#:build-flags} key. Install is taken care of by +@command{opam-installer}. In this case, the @code{opam} package must +be added to the @code{native-inputs} field of the package definition. + +Note that most OCaml packages assume they will be installed in the same +directory as OCaml, which is not what we want in guix. In particular, they +will install @file{.so} files in their module's directory, which is usually +fine because it is in the OCaml compiler directory. In guix though, these +libraries cannot be found and we use @code{CAML_LD_LIBRARY_PATH}. This +variable points to @file{lib/ocaml/site-lib/stubslibs} and this is where +@file{.so} libraries should be installed. +@end defvr + @defvr {Scheme Variable} python-build-system This variable is exported by @code{(guix build-system python)}. It implements the more or less standard build procedure used by Python @@ -4510,7 +4556,7 @@ guix build --quiet --keep-going \ @var{package-or-derivation} may be either the name of a package found in the software distribution such as @code{coreutils} or -@code{coreutils-8.20}, or a derivation such as +@code{coreutils@@8.20}, or a derivation such as @file{/gnu/store/@dots{}-coreutils-8.19.drv}. In the former case, a package with the corresponding name (and optionally version) is searched for among the GNU distribution modules (@pxref{Package Modules}). @@ -5670,7 +5716,7 @@ single output for a package that could easily be split (@pxref{Packages with Multiple Outputs}). Such are the typical issues that @command{guix size} can highlight. -The command can be passed a package specification such as @code{gcc-4.8} +The command can be passed a package specification such as @code{gcc@@4.8} or @code{guile:debug}, or a file name in the store. Consider this example: @@ -7017,6 +7063,26 @@ mkswap /dev/sda2 swapon /dev/sda2 @end example +Alternatively, you may use a swap file. For example, assuming that in +the new system you want to use the file @file{/swapfile} as a swap file, +you would run@footnote{This example will work for many types of file +systems (e.g., ext4). However, for copy-on-write file systems (e.g., +btrfs), the required steps may be different. For details, see the +manual pages for @command{mkswap} and @command{swapon}.}: + +@example +# This is 10 GiB of swap space. Adjust "count" to change the size. +dd if=/dev/zero of=/mnt/swapfile bs=1MiB count=10240 +# For security, make the file readable and writable only by root. +chmod 600 /mnt/swapfile +mkswap /mnt/swapfile +swapon /mnt/swapfile +@end example + +Note that if you have encrypted the root partition and created a swap +file in its file system as described above, then the encryption also +protects the swap file, just like any other file in that file system. + @node Proceeding with the Installation @subsection Proceeding with the Installation @@ -7119,8 +7185,8 @@ disk image, follow these steps: @enumerate @item -First, retrieve the GuixSD installation image as described previously -(@pxref{USB Stick Installation}). +First, retrieve and decompress the GuixSD installation image as +described previously (@pxref{USB Stick Installation}). @item Create a disk image that will hold the installed system. To make a @@ -7137,7 +7203,7 @@ Boot the USB installation image in an VM: @example qemu-system-x86_64 -m 1024 -smp 1 \ - -net default -net nic,model=virtio -boot menu=on \ + -net user -net nic,model=virtio -boot menu=on \ -drive file=guixsd.img \ -drive file=guixsd-usb-install-@value{VERSION}.@var{system} @end example @@ -7470,9 +7536,12 @@ A list of file systems. @xref{File Systems}. @item @code{swap-devices} (default: @code{'()}) @cindex swap devices -A list of strings identifying devices to be used for ``swap space'' -(@pxref{Memory Concepts,,, libc, The GNU C Library Reference Manual}). -For example, @code{'("/dev/sda3")}. +A list of strings identifying devices or files to be used for ``swap +space'' (@pxref{Memory Concepts,,, libc, The GNU C Library Reference +Manual}). For example, @code{'("/dev/sda3")} or @code{'("/swapfile")}. +It is possible to specify a swap file in a file system on a mapped +device, provided that the necessary device mapping and file system are +also specified. @xref{Mapped Devices} and @ref{File Systems}. @item @code{users} (default: @code{%base-user-accounts}) @itemx @code{groups} (default: @var{%base-groups}) @@ -7815,6 +7884,13 @@ and use it as follows: (type luks-device-mapping)) @end example +@cindex swap encryption +It is also desirable to encrypt swap space, since swap space may contain +sensitive data. One way to accomplish that is to use a swap file in a +file system on a device mapped via LUKS encryption. In this way, the +swap file is encrypted because the entire device is encrypted. +@xref{Preparing for Installation,,Disk Partitioning}, for an example. + A RAID device formed of the partitions @file{/dev/sda1} and @file{/dev/sdb1} may be declared as follows: @@ -8742,11 +8818,21 @@ Return a service that runs @var{dhcp}, a Dynamic Host Configuration Protocol (DHCP) client, on all the non-loopback network interfaces. @end deffn +@defvr {Scheme Variable} static-networking-service-type +This is the type for statically-configured network interfaces. +@c TODO Document <static-networking> data structures. +@end defvr + @deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @ [#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}] Return a service that starts @var{interface} with address @var{ip}. If @var{netmask} is true, use it as the network mask. If @var{gateway} is true, it must be a string specifying the default network gateway. + +This procedure can be called several times, one for each network +interface of interest. Behind the scenes what it does is extend +@code{static-networking-service-type} with additional network interfaces +to handle. @end deffn @cindex wicd @@ -9288,6 +9374,7 @@ makes the good ol' XlockMore usable. @node Printing Services @subsubsection Printing Services +@cindex printer support with CUPS The @code{(gnu services cups)} module provides a Guix service definition for the CUPS printing service. To add printer support to a GuixSD system, add a @code{cups-service} to the operating system definition: @@ -9308,13 +9395,17 @@ as GNOME's printer configuration services. By default, configuring a CUPS service will generate a self-signed certificate if needed, for secure connections to the print server. -One way you might want to customize CUPS is to enable or disable the web -interface. You can do that directly, like this: +Suppose you want to enable the Web interface of CUPS and also add +support for HP printers @i{via} the @code{hplip} package. You can do +that directly, like this (you need to use the @code{(gnu packages cups)} +module): @example (service cups-service-type (cups-configuration - (web-interface? #f))) + (web-interface? #t) + (extensions + (list cups-filters hplip)))) @end example The available configuration parameters follow. Each parameter @@ -13055,6 +13146,10 @@ from source. @item @code{one-shot?} (default: @code{#f}) Only evaluate specifications and build derivations once. +@item @code{load-path} (default: @code{'()}) +This allows users to define their own packages and make them visible to +cuirass as in @command{guix build} command. + @item @code{cuirass} (default: @code{cuirass}) The Cuirass package to use. @end table diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 756a6872bb..d36eeafe47 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -25,6 +25,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (activate-users+groups + activate-user-home activate-etc activate-setuid-programs activate-/bin/sh @@ -215,7 +216,7 @@ numeric gid or #f." #:supplementary-groups supplementary-groups #:comment comment #:home home - #:create-home? create-home? + #:create-home? (and create-home? system?) #:shell shell #:password password) @@ -263,6 +264,20 @@ numeric gid or #f." (((names . _) ...) names))))) +(define (activate-user-home users) + "Create and populate the home directory of USERS, a list of tuples, unless +they already exist." + (define ensure-user-home + (match-lambda + ((name uid group supplementary-groups comment home create-home? + shell password system?) + (unless (or (not home) (directory-exists? home)) + (mkdir-p home) + (unless system? + (copy-account-skeletons home)))))) + + (for-each ensure-user-home users)) + (define (activate-etc etc) "Install ETC, a directory in the store, as the source of static files for /etc." diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 6e5c6aaf15..f8ab95370c 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 David Craven <david@craven.ch> ;;; ;;; This file is part of GNU Guix. @@ -72,22 +72,33 @@ "Bind-mount SOURCE at TARGET." (mount source target "" MS_BIND)) +(define (seek* fd/port offset whence) + "Like 'seek' but return -1 instead of throwing to 'system-error' upon +EINVAL. This makes it easier to catch cases like OFFSET being too large for +FD/PORT." + (catch 'system-error + (lambda () + (seek fd/port offset whence)) + (lambda args + (if (= EINVAL (system-error-errno args)) + -1 + (apply throw args))))) + (define (read-superblock device offset size magic?) "Read a superblock of SIZE from OFFSET and DEVICE. Return the raw superblock on success, and #f if no valid superblock was found. MAGIC? takes a bytevector and returns #t when it's a valid superblock." (call-with-input-file device (lambda (port) - (seek port offset SEEK_SET) - - (let ((block (make-bytevector size))) - (match (get-bytevector-n! port block 0 (bytevector-length block)) - ((? eof-object?) - #f) - ((? number? len) - (and (= len (bytevector-length block)) - (and (magic? block) - block)))))))) + (and (= offset (seek* port offset SEEK_SET)) + (let ((block (make-bytevector size))) + (match (get-bytevector-n! port block 0 (bytevector-length block)) + ((? eof-object?) + #f) + ((? number? len) + (and (= len (bytevector-length block)) + (and (magic? block) + block))))))))) (define (sub-bytevector bv start size) "Return a copy of the SIZE bytes of BV starting from offset START." diff --git a/gnu/local.mk b/gnu/local.mk index 8c915741bc..e1b4780147 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -576,6 +576,7 @@ dist_patch_DATA = \ %D%/packages/patches/gd-fix-truecolor-format-correction.patch \ %D%/packages/patches/gegl-CVE-2012-4433.patch \ %D%/packages/patches/geoclue-config.patch \ + %D%/packages/patches/ghc-dont-pass-linker-flags-via-response-files.patch \ %D%/packages/patches/ghostscript-CVE-2013-5653.patch \ %D%/packages/patches/ghostscript-CVE-2015-3228.patch \ %D%/packages/patches/ghostscript-CVE-2016-7976.patch \ @@ -630,7 +631,6 @@ dist_patch_DATA = \ %D%/packages/patches/hdf-eos5-fortrantests.patch \ %D%/packages/patches/higan-remove-march-native-flag.patch \ %D%/packages/patches/hop-linker-flags.patch \ - %D%/packages/patches/httpd-CVE-2016-8740.patch \ %D%/packages/patches/hydra-disable-darcs-test.patch \ %D%/packages/patches/hypre-doc-tables.patch \ %D%/packages/patches/hypre-ldflags.patch \ @@ -656,6 +656,8 @@ dist_patch_DATA = \ %D%/packages/patches/laby-make-install.patch \ %D%/packages/patches/lcms-fix-out-of-bounds-read.patch \ %D%/packages/patches/ldc-disable-tests.patch \ + %D%/packages/patches/ldc-1.1.0-disable-dmd-tests.patch \ + %D%/packages/patches/ldc-1.1.0-disable-phobos-tests.patch \ %D%/packages/patches/liba52-enable-pic.patch \ %D%/packages/patches/liba52-link-with-libm.patch \ %D%/packages/patches/liba52-set-soname.patch \ @@ -666,6 +668,11 @@ dist_patch_DATA = \ %D%/packages/patches/libdrm-symbol-check.patch \ %D%/packages/patches/libepoxy-gl-null-checks.patch \ %D%/packages/patches/libevent-dns-tests.patch \ + %D%/packages/patches/libevent-2.0-evdns-fix-remote-stack-overread.patch \ + %D%/packages/patches/libevent-2.0-evdns-fix-searching-empty-hostnames.patch \ + %D%/packages/patches/libevent-2.0-evutil-fix-buffer-overflow.patch \ + %D%/packages/patches/libevent-2.1-dns-tests.patch \ + %D%/packages/patches/libevent-2.1-skip-failing-test.patch \ %D%/packages/patches/libextractor-ffmpeg-3.patch \ %D%/packages/patches/libjxr-fix-function-signature.patch \ %D%/packages/patches/libjxr-fix-typos.patch \ @@ -772,6 +779,7 @@ dist_patch_DATA = \ %D%/packages/patches/ocaml-CVE-2015-8869.patch \ %D%/packages/patches/ocaml-Add-a-.file-directive.patch \ %D%/packages/patches/ocaml-findlib-make-install.patch \ + %D%/packages/patches/omake-fix-non-determinism.patch \ %D%/packages/patches/ola-readdir-r.patch \ %D%/packages/patches/openexr-missing-samples.patch \ %D%/packages/patches/openjpeg-CVE-2016-5157.patch \ @@ -949,6 +957,8 @@ dist_patch_DATA = \ %D%/packages/patches/xfce4-panel-plugins.patch \ %D%/packages/patches/xfce4-session-fix-xflock4.patch \ %D%/packages/patches/xfce4-settings-defaults.patch \ + %D%/packages/patches/xinetd-fix-fd-leak.patch \ + %D%/packages/patches/xinetd-CVE-2013-4342.patch \ %D%/packages/patches/xmodmap-asprintf.patch \ %D%/packages/patches/libyaml-CVE-2014-9130.patch \ %D%/packages/patches/zathura-plugindir-environment-variable.patch diff --git a/gnu/packages.scm b/gnu/packages.scm index f55c294a18..0aa289d56c 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> @@ -24,6 +24,7 @@ #:use-module (guix packages) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix memoization) #:use-module (guix combinators) #:use-module ((guix build utils) #:select ((package-name->name+version @@ -234,28 +235,27 @@ decreasing version order." matching))))) (define find-newest-available-packages - (memoize - (lambda () - "Return a vhash keyed by package names, and with + (mlambda () + "Return a vhash keyed by package names, and with associated values of the form (newest-version newest-package ...) where the preferred package is listed first." - ;; FIXME: Currently, the preferred package is whichever one - ;; was found last by 'fold-packages'. Find a better solution. - (fold-packages (lambda (p r) - (let ((name (package-name p)) - (version (package-version p))) - (match (vhash-assoc name r) - ((_ newest-so-far . pkgs) - (case (version-compare version newest-so-far) - ((>) (vhash-cons name `(,version ,p) r)) - ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) - ((<) r))) - (#f (vhash-cons name `(,version ,p) r))))) - vlist-null)))) + ;; FIXME: Currently, the preferred package is whichever one + ;; was found last by 'fold-packages'. Find a better solution. + (fold-packages (lambda (p r) + (let ((name (package-name p)) + (version (package-version p))) + (match (vhash-assoc name r) + ((_ newest-so-far . pkgs) + (case (version-compare version newest-so-far) + ((>) (vhash-cons name `(,version ,p) r)) + ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) + ((<) r))) + (#f (vhash-cons name `(,version ,p) r))))) + vlist-null))) (define (find-best-packages-by-name name version) "If version is #f, return the list of packages named NAME with the highest diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 19dccdcadc..f286a8a34f 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -611,14 +611,14 @@ tools: server, client, and relay agent.") (define-public libpcap (package (name "libpcap") - (version "1.7.4") + (version "1.8.1") (source (origin (method url-fetch) (uri (string-append "http://www.tcpdump.org/release/libpcap-" version ".tar.gz")) (sha256 (base32 - "1c28ykkizd7jqgzrfkg7ivqjlqs9p6lygp26bsw2i0z8hwhi3lvs")))) + "07jlhc66z76dipj4j5v3dig8x6h3k6cb36kmnmpsixf3zmlvqgb7")))) (build-system gnu-build-system) (native-inputs `(("bison" ,bison) ("flex" ,flex))) (arguments '(#:configure-flags '("--with-pcap=linux") @@ -636,14 +636,24 @@ network statistics collection, security monitoring, network debugging, etc.") (define-public tcpdump (package (name "tcpdump") - (version "4.7.4") + (version "4.9.0") (source (origin (method url-fetch) - (uri (string-append "http://www.tcpdump.org/release/tcpdump-" - version ".tar.gz")) + ;; We use this Debian URL while the upstream URL is still + ;; officially private. This is the result of a botched + ;; coordinated release of tcpdump 4.9.0. I verified with + ;; the tcpdump maintainers that the upstream URL provides + ;; the same data as this Debian URL. + (uri + (list + (string-append "http://http.debian.net/debian/pool/main/t/" + name "/" name "_" version ".orig.tar.gz") + (string-append "http://www.tcpdump.org/release/tcpdump-" + version ".tar.gz"))) + (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "1byr8w6grk08fsq0444jmcz9ar89lq9nf4mjq2cny0w9k8k21rbb")))) + "0pjsxsy8l71i813sa934cwf1ryp9xbr7nxwsvnzavjdirchq3sga")))) (build-system gnu-build-system) (inputs `(("libpcap" ,libpcap) ("openssl" ,openssl))) diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index b859da0e7e..544b62a1da 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -202,7 +202,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.") (define-public giac-xcas (package (name "giac-xcas") - (version "1.2.2-103") + (version "1.2.3-19") (source (origin (method url-fetch) ;; "~parisse/giac" is not used because the maintainer regularly @@ -214,7 +214,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.") "source/giac_" version ".tar.gz")) (sha256 (base32 - "1qrhjw2sdvyv2x8fqs9isqv8rgldn448gfxbi7zbva8m5va5b3z1")))) + "0asynsj0xcfdjn0vkyxdgdy3hfpr6gc9f92xxa1rmn7clbqmlk1y")))) (build-system gnu-build-system) (arguments `(#:phases diff --git a/gnu/packages/benchmark.scm b/gnu/packages/benchmark.scm index df2be86424..acaeb67079 100644 --- a/gnu/packages/benchmark.scm +++ b/gnu/packages/benchmark.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> +;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,12 +22,14 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages compression) - #:use-module (gnu packages linux)) + #:use-module (gnu packages linux) + #:use-module (gnu packages maths) + #:use-module (gnu packages python)) (define-public fio (package (name "fio") - (version "2.16") + (version "2.17") (source (origin (method url-fetch) (uri (string-append @@ -35,22 +37,47 @@ "fio-" version ".tar.bz2")) (sha256 (base32 - "1v5n5hq500aidwfzmbm3k5d3mhh6ffwbgzq7nys838azga4xd3bx")))) + "1kxgad5k2m7y637g3kq8jmhwzlg3c64w9ky7066c5l09bwb6l58h")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; No tests. #:phases (modify-phases %standard-phases + (add-after + 'unpack 'patch-paths + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (gnuplot (string-append (assoc-ref inputs "gnuplot") + "/bin/gnuplot"))) + (substitute* "tools/plot/fio2gnuplot" + (("/usr/share/fio") (string-append out "/share/fio")) + ;; FIXME (upstream): The 'gnuplot' executable is used inline + ;; in various os.system() calls mixed with *.gnuplot filenames. + (("; do gnuplot") (string-append "; do " gnuplot)) + (("gnuplot mymath") (string-append gnuplot " mymath")) + (("gnuplot mygraph") (string-append gnuplot " mygraph"))) + #t))) (replace 'configure (lambda* (#:key outputs #:allow-other-keys) ;; The configure script doesn't understand some of the ;; GNU options, so we can't use #:configure-flags. (let ((out (assoc-ref outputs "out"))) (zero? (system* "./configure" - (string-append "--prefix=" out))))))))) + (string-append "--prefix=" out)))))) + (add-after + 'install 'wrap-python-scripts + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (wrap-program (string-append out "/bin/fiologparser_hist.py") + `("PYTHONPATH" ":" prefix (,(getenv "PYTHONPATH")))) + #t)))))) (inputs `(("libaio" ,libaio) - ("zlib" ,zlib))) + ("gnuplot" ,gnuplot) + ("zlib" ,zlib) + ("python-numpy" ,python2-numpy) + ("python-pandas" ,python2-pandas) + ("python" ,python-2))) (home-page "https://github.com/axboe/fio") (synopsis "Flexible I/O tester") (description diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 3bf352193c..d7089959ea 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -3501,7 +3501,6 @@ that a read originated from a particular isoform.") (version "3.8.1551") (source (origin (method url-fetch/tarbomb) - (file-name (string-append name "-" version)) (uri (string-append "http://www.drive5.com/muscle/muscle_src_" version ".tar.gz")) @@ -6325,7 +6324,8 @@ names in their natural, rather than lexicographic, order.") (build-system r-build-system) (propagated-inputs `(("r-limma" ,r-limma) - ("r-locfit" ,r-locfit))) + ("r-locfit" ,r-locfit) + ("r-statmod" ,r-statmod))) ;for estimateDisp (home-page "http://bioinf.wehi.edu.au/edgeR") (synopsis "EdgeR does empirical analysis of digital gene expression data") (description "This package can do differential expression analysis of @@ -6885,6 +6885,37 @@ dependencies between GO terms can be implemented and applied.") genome data packages and support for efficient SNP representation.") (license license:artistic2.0))) +(define-public r-bsgenome-hsapiens-1000genomes-hs37d5 + (package + (name "r-bsgenome-hsapiens-1000genomes-hs37d5") + (version "0.99.1") + (source (origin + (method url-fetch) + ;; We cannot use bioconductor-uri here because this tarball is + ;; located under "data/annotation/" instead of "bioc/". + (uri (string-append "http://www.bioconductor.org/packages/" + "release/data/annotation/src/contrib/" + "BSgenome.Hsapiens.1000genomes.hs37d5_" + version ".tar.gz")) + (sha256 + (base32 + "1cg0g5fqmsvwyw2p9hp2yy4ilk21jkbbrnpgqvb5c36ihjwvc7sr")))) + (properties + `((upstream-name . "BSgenome.Hsapiens.1000genomes.hs37d5"))) + (build-system r-build-system) + ;; As this package provides little more than a very large data file it + ;; doesn't make sense to build substitutes. + (arguments `(#:substitutable? #f)) + (propagated-inputs + `(("r-bsgenome" ,r-bsgenome))) + (home-page + "http://www.bioconductor.org/packages/BSgenome.Hsapiens.1000genomes.hs37d5/") + (synopsis "Full genome sequences for Homo sapiens") + (description + "This package provides full genome sequences for Homo sapiens from +1000genomes phase2 reference genome sequence (hs37d5), based on NCBI GRCh37.") + (license license:artistic2.0))) + (define-public r-impute (package (name "r-impute") @@ -7769,6 +7800,71 @@ for DNA and protein sequences. This package supports several sequence kernels, including: gkmSVM, kmer-SVM, mismatch kernel and wildcard kernel.") (license license:gpl2+))) +(define-public r-tximport + (package + (name "r-tximport") + (version "1.2.0") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "tximport" version)) + (sha256 + (base32 + "1k5a7dad6zqg936s17f6cmwgqp11x24z9zhxndsgwbscgpyhpcb0")))) + (build-system r-build-system) + (home-page "http://bioconductor.org/packages/tximport") + (synopsis "Import and summarize transcript-level estimates for gene-level analysis") + (description + "This package provides tools to import transcript-level abundance, +estimated counts and transcript lengths, and to summarize them into matrices +for use with downstream gene-level analysis packages. Average transcript +length, weighted by sample-specific transcript abundance estimates, is +provided as a matrix which can be used as an offset for different expression +of gene-level counts.") + (license license:gpl2+))) + +(define-public r-rhdf5 + (package + (name "r-rhdf5") + (version "2.18.0") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "rhdf5" version)) + (sha256 + (base32 + "0pb04li55ysag30s7rap7nnivc0rqmgsmpj43kin0rxdabfn1w0k")))) + (build-system r-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'unpack-smallhdf5 + (lambda* (#:key outputs #:allow-other-keys) + (system* "tar" "-xzvf" + "src/hdf5source/hdf5small.tgz" "-C" "src/" ) + (substitute* "src/Makevars" + (("^.*cd hdf5source &&.*$") "") + (("^.*gunzip -dc hdf5small.tgz.*$") "") + (("^.*rm -rf hdf5.*$") "") + (("^.*mv hdf5source/hdf5 ..*$") "")) + (substitute* "src/hdf5/configure" + (("/bin/mv") "mv")) + #t))))) + (propagated-inputs + `(("r-zlibbioc" ,r-zlibbioc))) + (inputs + `(("perl" ,perl) + ("zlib" ,zlib))) + (home-page "http://bioconductor.org/packages/rhdf5") + (synopsis "HDF5 interface to R") + (description + "This R/Bioconductor package provides an interface between HDF5 and R. +HDF5's main features are the ability to store and access very large and/or +complex datasets and a wide variety of metadata on mass storage (disk) through +a completely portable file format. The rhdf5 package is thus suited for the +exchange of large and/or complex datasets between R and other software +package, and for letting R applications work on datasets that are larger than +the available RAM.") + (license license:artistic2.0))) + (define-public emboss (package (name "emboss") diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm index 716d8b766a..9e56f667a4 100644 --- a/gnu/packages/bittorrent.scm +++ b/gnu/packages/bittorrent.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name> +;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Tomáš Čech <sleep_walker@gnu.org> ;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr> @@ -25,6 +26,7 @@ (define-module (gnu packages bittorrent) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (guix build-system python) #:use-module (guix build-system glib-or-gtk) @@ -172,6 +174,49 @@ XML-RPC over SCGI.") (home-page "https://github.com/rakshasa/rtorrent") (license l:gpl2+))) +(define-public tremc + (let ((commit "401f2303c9b5a6e2e7b0808617d794576d4aa29e") + (revision "0")) + (package + (name "tremc") + (version (string-append "0.9.0-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/louipc/tremc.git") + (commit commit))) + (sha256 + (base32 + "1h2720zn35iggmf9av65g119b0bhskwm1ng0zbkjryaf38nfzpin")))) + (build-system python-build-system) + (arguments + `(#:tests? #f ; no test suite + #:phases + (modify-phases %standard-phases + ;; The software is just a Python script that must be + ;; copied into place. + (delete 'build) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (man (string-append out "/share/man/man1")) + ;; FIXME install zsh completions + (completions (string-append out "/etc/bash_completion.d"))) + (install-file "tremc" bin) + (install-file "tremc.1" man) + (install-file + (string-append + "completion/bash/" + "transmission-remote-cli-bash-completion.sh") + completions))))))) + (synopsis "Console client for the Transmission BitTorrent daemon") + (description "Tremc is a console client, with a curses interface, for the +Transmission BitTorrent daemon.") + (home-page "https://github.com/louipc/tremc") + (license l:gpl3+)))) + (define-public transmission-remote-cli (package (name "transmission-remote-cli") @@ -209,9 +254,11 @@ XML-RPC over SCGI.") completions))))))) (synopsis "Console client for the Transmission BitTorrent daemon") (description "Transmission-remote-cli is a console client, with a curses -interface, for the Transmission BitTorrent daemon.") +interface, for the Transmission BitTorrent daemon. This package is no longer +maintained upstream.") (home-page "https://github.com/fagga/transmission-remote-cli") - (license l:gpl3+))) + (license l:gpl3+) + (properties `((superseded . ,tremc))))) (define-public aria2 (package diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index c4a3fc3e7c..3be6e1246c 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -28,7 +28,7 @@ #:use-module ((guix store) #:select (add-to-store add-text-to-store)) #:use-module ((guix derivations) #:select (derivation)) #:use-module ((guix utils) #:select (gnu-triplet->nix-system)) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -131,30 +131,29 @@ successful, or false to signal an error." (license gpl3+))) (define package-with-bootstrap-guile - (memoize - (lambda (p) + (mlambda (p) "Return a variant of P such that all its origins are fetched with %BOOTSTRAP-GUILE." (define rewritten-input (match-lambda - ((name (? origin? o)) - `(,name ,(bootstrap-origin o))) - ((name (? package? p) sub-drvs ...) - `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs)) - (x x))) + ((name (? origin? o)) + `(,name ,(bootstrap-origin o))) + ((name (? package? p) sub-drvs ...) + `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs)) + (x x))) (package (inherit p) - (source (match (package-source p) - ((? origin? o) (bootstrap-origin o)) - (s s))) - (inputs (map rewritten-input - (package-inputs p))) - (native-inputs (map rewritten-input - (package-native-inputs p))) - (propagated-inputs (map rewritten-input - (package-propagated-inputs p))) - (replacement (and=> (package-replacement p) - package-with-bootstrap-guile)))))) + (source (match (package-source p) + ((? origin? o) (bootstrap-origin o)) + (s s))) + (inputs (map rewritten-input + (package-inputs p))) + (native-inputs (map rewritten-input + (package-native-inputs p))) + (propagated-inputs (map rewritten-input + (package-propagated-inputs p))) + (replacement (and=> (package-replacement p) + package-with-bootstrap-guile))))) (define* (glibc-dynamic-linker #:optional (system (or (and=> (%current-target-system) diff --git a/gnu/packages/calendar.scm b/gnu/packages/calendar.scm index 03898dd263..70d9991659 100644 --- a/gnu/packages/calendar.scm +++ b/gnu/packages/calendar.scm @@ -84,13 +84,13 @@ data units.") (define-public khal (package (name "khal") - (version "0.9.0") + (version "0.9.1") (source (origin (method url-fetch) (uri (pypi-uri "khal" version)) (sha256 (base32 - "138gxynw7zavwqqaw5nzmj8sbpkymmb95xzgxqbdi9fiiqm9kamr")))) + "15rxjphjp46lz7gbs39d1ajd9flnhmhqicjh9bjpx3yi5xx4iawr")))) (build-system python-build-system) (arguments `(#:phases (modify-phases %standard-phases diff --git a/gnu/packages/ci.scm b/gnu/packages/ci.scm index 15a94c5ee3..c25bc389c0 100644 --- a/gnu/packages/ci.scm +++ b/gnu/packages/ci.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -186,8 +187,8 @@ their dependencies.") (license l:gpl3+)))) (define-public cuirass - (let ((commit "d0a5801e397335bb44d8033e5deddf02c1cc99c2") - (revision "3")) + (let ((commit "f695c79eb3b93a0432901844c8ede16de39b8d07") + (revision "4")) (package (name "cuirass") (version (string-append "0.0.1-" revision "." (string-take commit 7))) @@ -199,7 +200,7 @@ their dependencies.") (file-name (string-append name "-" version)) (sha256 (base32 - "0sa94dgp9w6av7i0a570fv9a9yq03jkxdrm5d75h6szsp1kiyw2i")))) + "1zsj3l85d8jq7h9a0zfb2w5pyvlwkirgvis4bv60syhbpblfvmri")))) (build-system gnu-build-system) (arguments '(#:phases diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index 873671cf52..e0eca4ef9f 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -10,7 +10,7 @@ ;;; Copyright © 2015, 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org> -;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> @@ -46,6 +46,7 @@ #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages valgrind) + #:use-module (ice-9 match) #:use-module ((srfi srfi-1) #:select (last))) (define-public zlib @@ -1001,3 +1002,61 @@ handles the 7z format which features very high compression ratios.") (description "gzstream is a small library for providing zlib functionality in a C++ iostream.") (license license:lgpl2.1+))) + +(define-public zpaq + (package + (name "zpaq") + (version "7.15") + (source + (origin + (method url-fetch/zipbomb) + (uri (string-append "http://mattmahoney.net/dc/zpaq" + (string-delete #\. version) ".zip")) + (sha256 + (base32 + "066l94yyladlfzri877nh2dhkvspagjn3m5bmv725fmhkr9c4pp8")) + (modules '((guix build utils))) + (snippet + ;; Delete irrelevant pre-compiled binaries. + '(for-each delete-file (find-files "." "\\.exe$"))))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (delete 'configure)) ; no ‘configure’ script + #:make-flags + (list + (string-append "CPPFLAGS=-Dunix" + ,(match (or (%current-target-system) + (%current-system)) + ("x86_64-linux" "") + ("i686-linux" "") + (_ " -DNOJIT"))) + ;; These should be safe, lowest-common-denominator instruction sets, + ;; allowing for some optimisation while remaining reproducible. + (string-append "CXXFLAGS=-O3 -mtune=generic -DNDEBUG" + ,(match (or (%current-target-system) + (%current-system)) + ("x86_64-linux" " -march=nocona") + ("i686-linux" " -march=i686") + (_ ""))) + (string-append "PREFIX=" + (assoc-ref %outputs "out"))))) + (native-inputs + `(("perl" ,perl))) ; for pod2man + (home-page "http://mattmahoney.net/dc/zpaq.html") + (synopsis "Incremental journaling archiver") + (description "ZPAQ is a command-line archiver for realistic situations with +many duplicate and already compressed files. It backs up only those files +modified since the last update. All previous versions remain untouched and can +be independently recovered. Identical files are only stored once (known as +@dfn{de-duplication}). Archives can also be encrypted. + +ZPAQ is intended to back up user data, not entire operating systems. It ignores +owner and group IDs, ACLs, extended attributes, or special file types like +devices, sockets, or named pipes. It does not follow or restore symbolic links +or junctions, and always follows hard links.") + (license (list license:public-domain + ;; libzpaq.cpp contains a mix of public-domain and + ;; expat-licenced (or ‘MIT’) code. + license:expat)))) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index 2638b229df..050ed0e19b 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -55,15 +55,17 @@ #:use-module (gnu packages cyrus-sasl) #:use-module (gnu packages gnupg) #:use-module (gnu packages python) + #:use-module (gnu packages parallel) #:use-module (gnu packages pcre) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages popt) #:use-module (gnu packages rdf) #:use-module (gnu packages xml) #:use-module (gnu packages bison) #:use-module (gnu packages jemalloc) #:use-module ((guix licenses) #:select (gpl2 gpl3 gpl3+ lgpl2.1+ lgpl3+ x11-style non-copyleft - bsd-2 bsd-3 public-domain)) + bsd-2 bsd-3 public-domain asl2.0)) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) @@ -510,6 +512,93 @@ types are supported, as is encryption.") (license gpl3+) (home-page "http://www.gnu.org/software/recutils/"))) +(define-public rocksdb + (package + (name "rocksdb") + (version "5.0.2") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/facebook/rocksdb" + "/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1jj8b50w8jr3bnyjzk2hmlzq9x49yihjilx3xlq2rfdx3q9x4fay")) + (modules '((guix build utils))) + (snippet + '(begin + ;; TODO: unbundle gtest. + (delete-file "build_tools/gnu_parallel") + #t)))) + (build-system gnu-build-system) + (arguments + '(#:make-flags (list "CC=gcc" + ;; Make the resulting library position-independent so the + ;; static version can be included in shared objects. + "EXTRA_CXXFLAGS=-fPIC" + (string-append "INSTALL_PATH=" + (assoc-ref %outputs "out"))) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-Makefile + (lambda _ + (substitute* "Makefile" + (("build_tools/gnu_parallel") "parallel") + (("#!/bin/sh") (string-append "#!" (which "sh")))) + #t)) + (delete 'configure) + (add-before 'check 'disable-failing-tests + (lambda _ + (substitute* "Makefile" + ;; These tests reliably fail due to "Too many open files". + (("^[[:blank:]]+env_test[[:blank:]]+\\\\") "\\") + (("^[[:blank:]]+persistent_cache_test[[:blank:]]+\\\\") "\\")) + #t)) + (add-after + 'check 'build-release-libraries + ;; The 'check' target depends on the default target which is compiled + ;; with debug symbols. The 'install' target depends on shared and + ;; static release targets so we build them here for clarity. + ;; TODO: Add debug output. + (lambda* (#:key (make-flags '()) #:allow-other-keys) + ;; Prevent the build from adding machine-specific optimizations. + ;; This does not work if passed as a make flag... + (setenv "PORTABLE" "1") + (and (zero? (apply system* "make" "static_lib" make-flags)) + (zero? (apply system* "make" "shared_lib" make-flags))))) + (add-after 'install 'delete-static-library + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lib (string-append out "/lib"))) + (for-each (lambda (file) + (delete-file file)) + (find-files lib "\\.l?a$")) + #t)))))) + (native-inputs + `(("parallel" ,parallel) + ("perl" ,perl) + ("procps" ,procps) + ("python" ,python-2))) + (inputs + `(("bzip2" ,bzip2) + ("gflags" ,gflags) + ("jemalloc" ,jemalloc) + ("lz4" ,lz4) + ("snappy" ,snappy) + ("zlib" ,zlib))) + (home-page "http://rocksdb.org/") + (synopsis "Persistent key-value store for fast storage") + (description + "RocksDB is a library that forms the core building block for a fast +key-value server, especially suited for storing data on flash drives. It +has a @dfn{Log-Structured-Merge-Database} (LSM) design with flexible tradeoffs +between @dfn{Write-Amplification-Factor} (WAF), @dfn{Read-Amplification-Factor} +(RAF) and @dfn{Space-Amplification-Factor} (SAF). It has multi-threaded +compactions, making it specially suitable for storing multiple terabytes of +data in a single database. RocksDB is partially based on @code{LevelDB}.") + ;; RocksDB is BSD-3 and the JNI adapter is Apache 2.0. + (license (list bsd-3 asl2.0)))) + (define-public sparql-query (package (name "sparql-query") diff --git a/gnu/packages/dns.scm b/gnu/packages/dns.scm index 9d77395243..643b5fe1e8 100644 --- a/gnu/packages/dns.scm +++ b/gnu/packages/dns.scm @@ -146,7 +146,7 @@ high-volume and high-reliability applications. The name BIND stands for (define-public dnscrypt-proxy (package (name "dnscrypt-proxy") - (version "1.9.2") + (version "1.9.4") (source (origin (method url-fetch) (uri (string-append @@ -154,7 +154,7 @@ high-volume and high-reliability applications. The name BIND stands for "dnscrypt-proxy-" version ".tar.bz2")) (sha256 (base32 - "1xb199hpzfj53kmbkkn3awymjh8f44yzkmaj7q5ibb67b5p9fq7d")) + "07piwsjczamwvdpv1585kg4awqakip51bwsm8nqi6bljww4agx7x")) (modules '((guix build utils))) (snippet ;; Delete bundled libltdl. XXX: This package also bundles diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index d3e64c04f6..dfdf324960 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com> -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> @@ -14,10 +14,12 @@ ;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> -;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr> +;;; Copyright © 2016, 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2016 Alex Vong <alexvong1995@gmail.com> ;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -400,7 +402,7 @@ configuration files, such as .gitattributes, .gitignore, and .git/config.") (define-public emacs-with-editor (package (name "emacs-with-editor") - (version "2.5.9") + (version "2.5.10") (source (origin (method url-fetch) (uri (string-append @@ -409,7 +411,7 @@ configuration files, such as .gitattributes, .gitignore, and .git/config.") (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "0znfznyqr360ryi7za9szbz1l5236v2cig25s4k7kkw0w8828xzh")))) + "0lsxa1hghybkzvqhqvvym3hxbyp9vjcnnpb9j800z0vyhbnlka67")))) (build-system emacs-build-system) (propagated-inputs `(("emacs-dash" ,emacs-dash))) @@ -425,7 +427,7 @@ on stdout instead of using a socket as the Emacsclient does.") (define-public magit (package (name "magit") - (version "2.10.0") + (version "2.10.1") (source (origin (method url-fetch) (uri (string-append @@ -433,7 +435,7 @@ on stdout instead of using a socket as the Emacsclient does.") version "/" name "-" version ".tar.gz")) (sha256 (base32 - "1w74vy46z922kfs7gjkrng7wjpi481calpasqmjzpn3hqvgsd5d1")))) + "1a3gsarl0zrk1dydqn93kx7pnwm7pb7av7g17pj5m7b7kc66k7jv")))) (build-system gnu-build-system) (native-inputs `(("texinfo" ,texinfo) ("emacs" ,emacs-minimal))) @@ -969,6 +971,7 @@ provides an optional IDE-like error list.") ("mpg321" ,mpg321) ("taglib" ,taglib) ("mp3info" ,mp3info))) + (properties '((upstream-name . "emms"))) (synopsis "Emacs Multimedia System") (description "EMMS is the Emacs Multimedia System. It is a small front-end which @@ -3396,14 +3399,14 @@ passive voice.") (define-public emacs-org (package (name "emacs-org") - (version "20161224") + (version "20170124") (source (origin (method url-fetch) (uri (string-append "http://elpa.gnu.org/packages/org-" version ".tar")) (sha256 (base32 - "0b10bjypn0w5ja776f8sxl1qpvb61iyz1n3c74jx6fqwypv7dmgi")))) + "0mcnjwvily0xv1xl11dj18lg38llvrxja2j9mwn6vql8n5y1srxi")))) (build-system emacs-build-system) (home-page "http://orgmode.org/") (synopsis "Outline-based notes management and organizer") @@ -3645,3 +3648,134 @@ Streams are implemented as delayed evaluation of cons cells.") (description "This package provides expression based interactive search procedures for emacs-lisp-mode.") (license license:gpl3+)))) + +(define-public emacs-ht + (package + (name "emacs-ht") + (version "2.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/Wilfred/ht.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1lpba36kzxcc966fvsbrfpy8ah9gnvay0yk26gbyjil0rggrbqzj")))) + (build-system emacs-build-system) + (propagated-inputs `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/Wilfred/ht.el") + (synopsis "Hash table library for Emacs") + (description + "This package simplifies the use of hash tables in elisp. It also +provides functions to convert hash tables from and to alists and plists.") + (license license:gpl3+))) + +(define-public emacs-log4e + (package + (name "emacs-log4e") + (version "0.3.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/aki2o/log4e/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0nbdpbw353snda3v19l9hsm6gimppwnpxj18amm350bm81lyim2g")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'remove-tests + ;; Guile builder complains about null characters in some + ;; strings of test files. Remove "test" directory (it is not + ;; needed anyway). + (lambda _ + (delete-file-recursively "test")))))) + (home-page "https://github.com/aki2o/log4e") + (synopsis "Logging framework for elisp") + (description + "This package provides a logging framework for elisp. It allows +you to deal with multiple log levels.") + (license license:gpl3+))) + +(define-public emacs-gntp + (package + (name "emacs-gntp") + (version "0.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/tekai/gntp.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "16c1dfkia9yhl206bdhjr3b8kfvqcqr38jl5lq8qsyrrzsnmghny")))) + (build-system emacs-build-system) + (home-page "https://github.com/tekai/gntp.el") + (synopsis "Growl Notification Protocol for Emacs") + (description + "This package implements the Growl Notification Protocol GNTP +described at @uref{http://www.growlforwindows.com/gfw/help/gntp.aspx}. +It is incomplete as it only lets you send but not receive +notifications.") + (license license:bsd-3))) + +(define-public emacs-alert + (package + (name "emacs-alert") + (version "1.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/jwiegley/alert/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1693kck3k2iz5zhpmxwqyafxm68hr6gzs60lkxd3j1wlp2c9fwyr")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-gntp" ,emacs-gntp) + ("emacs-log4e" ,emacs-log4e))) + (home-page "https://github.com/jwiegley/alert") + (synopsis "Growl-style notification system for Emacs") + (description + "Alert is a Growl-workalike for Emacs which uses a common notification +interface and multiple, selectable \"styles\", whose use is fully +customizable by the user.") + (license license:gpl2+))) + +(define-public emacs-mu4e-alert + (package + (name "emacs-mu4e-alert") + (version "0.4") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/iqbalansari/mu4e-alert/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1m63vyb2v5r9swmqv56q80jca8172nk5vaxl7bcm5zbfs8zsvr4b")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-alert" ,emacs-alert) + ("emacs-s" ,emacs-s) + ("emacs-ht" ,emacs-ht))) + (home-page "https://github.com/iqbalansari/mu4e-alert") + (synopsis "Desktop notification for mu4e") + (description + "This package provides desktop notifications for mu4e. +Additionally it can display the number of unread emails in the +mode-line.") + (license license:gpl3+))) diff --git a/gnu/packages/engineering.scm b/gnu/packages/engineering.scm index b147764a7d..734efcdc73 100644 --- a/gnu/packages/engineering.scm +++ b/gnu/packages/engineering.scm @@ -259,7 +259,6 @@ featuring various improvements and bug fixes."))) (version "2.0-18Sep92") (source (origin (method url-fetch/tarbomb) - (file-name (string-append name "-" version ".tar.gz")) (uri (string-append "http://www.rle.mit.edu/cpg/codes/" name "-" version ".tgz")) (sha256 diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm index 29ae579bae..1f6d1d0c36 100644 --- a/gnu/packages/fonts.scm +++ b/gnu/packages/fonts.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2016 Toni Reina <areina@riseup.net> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2017 José Miguel Sánchez García <jmi2k@openmailbox.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -996,3 +997,40 @@ designed to work well in user interface environments.") (synopsis "Mozilla's monospace font") (description "This is the typeface used by Mozilla in Firefox OS.") (license license:silofl1.1))) + +(define-public font-awesome + (package + (name "font-awesome") + (version "4.7.0") + (source (origin + (method url-fetch) + (uri (string-append "http://fontawesome.io/assets/" + name "-" version ".zip")) + (sha256 + (base32 + "1frhmw41lnnm9rda2zs202pvfi5vzlrsw4xfp4mswl0qgws61mcd")))) + (build-system trivial-build-system) + (native-inputs + `(("unzip" ,unzip))) + (arguments + `(#:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils)) + (let* ((font-dir (string-append %output + "/share/fonts/opentype")) + (source (assoc-ref %build-inputs "source")) + (src-otf-file (string-append "font-awesome-" + ,version + "/fonts/FontAwesome.otf")) + (dest-otf-file (string-append font-dir "/FontAwesome.otf")) + (unzip (assoc-ref %build-inputs "unzip"))) + (setenv "PATH" (string-append unzip "/bin")) + (mkdir-p font-dir) + (system* "unzip" source "-d" ".") + (copy-file src-otf-file dest-otf-file))))) + (home-page "http://fontawesome.io") + (synopsis "Font that contains a rich iconset") + (description + "Font Awesome is a full suite of pictographic icons for easy scalable +vector graphics.") + (license license:silofl1.1))) diff --git a/gnu/packages/ftp.scm b/gnu/packages/ftp.scm index 5ff56d7eae..7380fcfc3b 100644 --- a/gnu/packages/ftp.scm +++ b/gnu/packages/ftp.scm @@ -36,23 +36,19 @@ (define-public lftp (package (name "lftp") - (version "4.7.4") + (version "4.7.5") (source (origin (method url-fetch) - ;; XXX: Downloads from main site redirects to 'get.html' and - ;; returns HTTP 200, leading Guix to download that instead. - ;; Try official mirror first. See: - ;; https://github.com/lavv17/lftp/issues/299 and - ;; https://lftp.tech/get.html (mirror list) - (uri (list (string-append "ftp://ftp.st.ryukoku.ac.jp/pub/network/" - "ftp/lftp/lftp-" version ".tar.xz") - (string-append "https://lftp.tech/ftp/lftp-" + ;; See https://lftp.tech/get.html for mirrors. + (uri (list (string-append "https://lftp.tech/ftp/lftp-" version ".tar.xz") (string-append "https://lftp.tech/ftp/old/lftp-" - version ".tar.xz"))) + version ".tar.xz") + (string-append "ftp://ftp.st.ryukoku.ac.jp/pub/network/" + "ftp/lftp/lftp-" version ".tar.xz"))) (sha256 (base32 - "0b6r1gbpazvml1hvfjm2ccsfxibrjrm3fir912j6kxxn538w8rxz")))) + "1n6h3y5jz1rxlx7ap46vykgm0q2rvzr7c5s5ry5l32z3lbmwbdak")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index 1580d1fe1f..98a4d69013 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -11,8 +11,8 @@ ;;; Copyright © 2015, 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com> ;;; Copyright © 2015 Christopher Allan Webber <cwebber@dustycloud.org> -;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> +;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2016 Rodger Fox <thylakoid@openmailbox.org> @@ -104,6 +104,7 @@ #:use-module (gnu packages xdisorg) #:use-module (gnu packages tls) #:use-module (gnu packages pcre) + #:use-module (gnu packages cyrus-sasl) #:use-module (guix build-system gnu) #:use-module (guix build-system haskell) #:use-module (guix build-system python) @@ -942,7 +943,7 @@ Protocol).") (define-public extremetuxracer (package (name "extremetuxracer") - (version "0.7.3") + (version "0.7.4") (source (origin (method url-fetch) (uri (string-append @@ -950,7 +951,7 @@ Protocol).") version "/etr-" version ".tar.xz")) (sha256 (base32 - "1lg3z7jhzmsjym53qss8mbydny8hafwjnfsc7x91hrr9zrkwblly")))) + "0d2j4ybdjmimg67v2fndgahgq4fvgz3fpfb3a4l1ar75n6hy776s")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -1254,7 +1255,7 @@ is programmed in Haskell.") (define-public manaplus (package (name "manaplus") - (version "1.6.12.24") + (version "1.7.1.21") (source (origin (method url-fetch) (uri (string-append @@ -1262,7 +1263,7 @@ is programmed in Haskell.") version "/manaplus-" version ".tar.xz")) (sha256 (base32 - "1g64pid26vcv1ay002bzz6ymabwrmy3wmklywpcgpvrhynm6f2cq")))) + "0q9hk9jgz5jja1mmba5iafxwavk6991kjpmdxdkgbam0hk15pqmz")))) (build-system gnu-build-system) (arguments '(#:configure-flags @@ -3071,3 +3072,33 @@ symbols, the game needs graphics to render the non-euclidean world.") for Un*x systems with X11.") (home-page "http://olofson.net/kobodl/") (license license:gpl2+))) + +(define-public freeciv + (package + (name "freeciv") + (version "2.5.6") + (source + (origin + (method url-fetch) + (uri (string-append + "http://download.gna.org/freeciv/" + "stable/freeciv-" version ".tar.bz2")) + (sha256 + (base32 + "16wrnsx5rmbz6rjs03bhy0vn20i6n6g73lx7fjpai98ixhzc5bfg")))) + (build-system gnu-build-system) + (inputs + `(("curl" ,curl) + ("cyrus-sasl" ,cyrus-sasl) + ("gtk+" ,gtk+) + ("sdl-mixer" ,sdl-mixer) + ("zlib" ,zlib))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "http://www.freeciv.org/") + (synopsis "Turn based empire building strategy game") + (description "Freeciv is a turn based empire building strategy game +inspired by the history of human civilization. The game commences in +prehistory and your mission is to lead your tribe from the Stone Age +to the Space Age.") + (license license:gpl2+))) diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm index c6cc623f6c..ba1fd62a24 100644 --- a/gnu/packages/gdb.scm +++ b/gnu/packages/gdb.scm @@ -37,14 +37,14 @@ (define-public gdb (package (name "gdb") - (version "7.12") + (version "7.12.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gdb/gdb-" version ".tar.xz")) (sha256 (base32 - "152g2qa8337cxif3lkvabjcxfd9jphfb2mza8f1p2c4bjk2z6kw3")))) + "11ii260h1sd7v0bs3cz6d5l8gqxxgldry0md60ncjgixjw5nh1s6")))) (build-system gnu-build-system) (arguments `(#:tests? #f ; FIXME "make check" fails on single-processor systems. diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index cac6f02a30..2be26447a3 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -496,43 +496,36 @@ and signature functionality from Python programs.") (package-with-python2 python-gnupg)) (define-public pius - ;; pius 2.2.2 does not work with gpg-agent 2.1, so we take a newer - ;; commit. When a new pius (> 2.2.2) is released, update this package - ;; and delete this message. - ;; More info: https://github.com/jaymzh/pius/issues/46 - (let ((commit "891687ccb3d232a1fc0e7da7d22572c0318644cb") - (base-version "2.2.2")) ; i.e. there were no releases - ; between BASE-VERSION and COMMIT - (package - (name "pius") - (version (string-append base-version "-0." - (string-take commit 7))) - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://github.com/jaymzh/pius.git") - (commit commit))) - (sha256 - (base32 - "0m2na4bnf1rv0zpf404l9ga6pwyf7ijldp4lw5irgh7gkmpllxr3")))) - (build-system python-build-system) - (inputs `(("perl" ,perl) ;for 'pius-party-worksheet' - ("gpg" ,gnupg))) - (arguments - `(#:tests? #f - #:python ,python-2 ;uses the Python 2 'print' syntax - #:phases - (modify-phases %standard-phases - (add-before - 'build 'set-gpg-file-name - (lambda* (#:key inputs outputs #:allow-other-keys) - (let* ((gpg (string-append (assoc-ref inputs "gpg") - "/bin/gpg"))) - (substitute* "libpius/constants.py" - (("/usr/bin/gpg2") gpg)))))))) - (synopsis "Programs to simplify GnuPG key signing") - (description - "Pius (PGP Individual UID Signer) helps attendees of PGP keysigning + (package + (name "pius") + (version "2.2.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/jaymzh/pius/releases/download/v" + version "/pius-" version ".tar.bz2")) + (sha256 + (base32 + "0iy0gnms6lv9hpvk29313kc495a2f7pq2mg6ljxhy233vxsmjsk6")))) + (build-system python-build-system) + (inputs `(("perl" ,perl) ;for 'pius-party-worksheet' + ("gpg" ,gnupg))) + (arguments + `(#:tests? #f + #:python ,python-2 ;uses the Python 2 'print' syntax + #:phases + (modify-phases %standard-phases + (add-before + 'build 'set-gpg-file-name + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((gpg (string-append (assoc-ref inputs "gpg") + "/bin/gpg"))) + (substitute* "libpius/constants.py" + (("/usr/bin/gpg2") gpg)) + #t)))))) + (synopsis "Programs to simplify GnuPG key signing") + (description + "Pius (PGP Individual UID Signer) helps attendees of PGP keysigning parties. It is the main utility and makes it possible to quickly and easily sign each UID on a set of PGP keys. It is designed to take the pain out of the sign-all-the-keys part of PGP Keysigning Party while adding security @@ -540,8 +533,8 @@ to the process. pius-keyring-mgr and pius-party-worksheet help organisers of PGP keysigning parties.") - (license license:gpl2) - (home-page "https://www.phildev.net/pius/index.shtml")))) + (license license:gpl2) + (home-page "https://www.phildev.net/pius/index.shtml"))) (define-public signing-party (package diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index 7758f27f8b..9279c46b5d 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -441,7 +441,7 @@ standards.") ("libgnome" ,libgnome) ("libjpeg-turbo" ,libjpeg-turbo) ("libxft" ,libxft) - ("libevent" ,libevent) + ("libevent" ,libevent-2.0) ("libxinerama" ,libxinerama) ("libxscrnsaver" ,libxscrnsaver) ("libxcomposite" ,libxcomposite) diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 54f1529de4..840892d2ed 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -98,7 +98,7 @@ arrays of data.") (define-public gstreamer (package (name "gstreamer") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) @@ -107,7 +107,7 @@ arrays of data.") version ".tar.xz")) (sha256 (base32 - "0rcd4ya4k99x6ngm9v78as7ql0rqibkwshc13lb4rjdszs0qw3hm")))) + "0gdnxg5igbhnpjhrzp31w1ww95j805byqd6mj3x29wli54dxrfc5")))) (build-system gnu-build-system) (outputs '("out" "doc")) (arguments @@ -146,7 +146,7 @@ This package provides the core library and elements.") (define-public gst-plugins-base (package (name "gst-plugins-base") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) @@ -154,7 +154,7 @@ This package provides the core library and elements.") name "-" version ".tar.xz")) (sha256 (base32 - "086yjwmp4fykcqkj6zqhwrk2z49981kl8x545vz2wvblrc7x9h7v")))) + "040pifl4cgsqqz2si4s1y5khj3zwm39w21siagxwp805swbrcag6")))) (build-system gnu-build-system) (outputs '("out" "doc")) (propagated-inputs @@ -201,7 +201,7 @@ for the GStreamer multimedia library.") (define-public gst-plugins-good (package (name "gst-plugins-good") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) @@ -210,7 +210,7 @@ for the GStreamer multimedia library.") name "-" version ".tar.xz")) (sha256 (base32 - "04rksbhjj2yz32g523cfabwqn2s3byd94dpbxghxr0p9ridk53qr")))) + "0mar8ss8bvpz699ql4kgndvna8qsv7kj372py4435ffl6hzfj1sf")))) (build-system gnu-build-system) (inputs `(("aalib" ,aalib) @@ -266,14 +266,14 @@ developers consider to have good quality code and correct functionality.") (define-public gst-plugins-bad (package (name "gst-plugins-bad") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) (uri (string-append "https://gstreamer.freedesktop.org/src/" name "/" name "-" version ".tar.xz")) (sha256 (base32 - "0fisnnfpp3s8pbm6hjrfi4wjpq2da8c6w3ns9pjcg7590f9wm587")))) + "1rwla1p57yzygb68z2xk5l5kvqzj5w3nxq0davkwk139zd8r6294")))) (outputs '("out" "doc")) (build-system gnu-build-system) (arguments @@ -343,7 +343,7 @@ par compared to the rest.") (define-public gst-plugins-ugly (package (name "gst-plugins-ugly") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) @@ -351,7 +351,7 @@ par compared to the rest.") name "/" name "-" version ".tar.xz")) (sha256 (base32 - "17gc2zd3v6spmm2d6912sqfcyyv5f2ghdhq31f5kx5mw5r6ds0zk")))) + "1lkb8kznc9wxmhbp7k67b50y27nz8jp2x2flb91xzydz7b89f5f9")))) (build-system gnu-build-system) (inputs `(("gst-plugins-base" ,gst-plugins-base) @@ -382,7 +382,7 @@ distribution problems in some jurisdictions, e.g. due to patent threats.") (define-public gst-libav (package (name "gst-libav") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) (uri (string-append @@ -390,7 +390,7 @@ distribution problems in some jurisdictions, e.g. due to patent threats.") name "-" version ".tar.xz")) (sha256 (base32 - "0g778j7w4vpbhwjzyrzpajvr26nxm6vqby84v8g1w1hz44v71pd3")))) + "1aajayv63ardkbmcg7pnh2d87r067325a5wzinwihaw6n5jw2sws")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--with-system-libav") @@ -420,7 +420,7 @@ compression formats through the use of the libav library.") (define-public python-gst (package (name "python-gst") - (version "1.10.2") + (version "1.10.3") (source (origin (method url-fetch) (uri (string-append @@ -428,7 +428,7 @@ compression formats through the use of the libav library.") "gst-python-" version ".tar.xz")) (sha256 (base32 - "1sljnqkxf2ix6yzghrapw5irl0rbp8aa8w2hggk7i6d9js10ls71")))) + "1s5437bnk0j5hfg2gwfwq4b68l6vj1lfskxh73v6ikp0vw32vymx")))) (build-system gnu-build-system) (arguments ;; XXX: Factorize python-sitedir with python-build-system. diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index a506949aba..0a291370e7 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -331,18 +331,17 @@ diagrams.") (base32 "07hrabhpl6n8ajz10s0d960jdwndxs87szxyn428mpxi8cvpg1f5")))) (build-system gnu-build-system) - (inputs - `(("gtk" ,gtk+-2) - ;; These two are needed only to allow the tests to run successfully. - ("xorg-server" ,xorg-server) - ("shared-mime-info" ,shared-mime-info))) (native-inputs `(("intltool" ,intltool) ("glib" ,glib "bin") ; for glib-genmarshal, etc. - ("pkg-config" ,pkg-config))) + ("pkg-config" ,pkg-config) + ;; For testing. + ("xorg-server" ,xorg-server) + ("shared-mime-info" ,shared-mime-info))) (propagated-inputs ;; As per the pkg-config file. - `(("libxml2" ,libxml2))) + `(("gtk" ,gtk+-2) + ("libxml2" ,libxml2))) (arguments `(#:phases ;; Unfortunately, some of the tests in "make check" are highly dependent diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index 56b0090ee0..37e35c45fd 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -26,6 +26,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages haskell) + #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (gnu packages compression) #:use-module (gnu packages elf) @@ -267,14 +268,17 @@ interactive environment for the functional language Haskell.") (define-public ghc-8 (package (name "ghc") - (version "8.0.1") + (version "8.0.2") (source (origin (method url-fetch) (uri (string-append "https://www.haskell.org/ghc/dist/" version "/" name "-" version "-src.tar.xz")) (sha256 - (base32 "1lniqy29djhjkddnailpaqhlqh4ld2mqvb1fxgxw1qqjhz6j1ywh")))) + (base32 "1c8qc4fhkycynk4g1f9hvk53dj6a1vvqi6bklqznns6hw59m8qhi")) + (patches + (search-patches + "ghc-dont-pass-linker-flags-via-response-files.patch")))) (build-system gnu-build-system) (supported-systems '("i686-linux" "x86_64-linux")) (outputs '("out" "doc")) @@ -290,7 +294,7 @@ interactive environment for the functional language Haskell.") "https://www.haskell.org/ghc/dist/" version "/" name "-" version "-testsuite.tar.xz")) (sha256 - (base32 "0lc1vjivkxn01aw3jg2gd7fmqb5pj7a5j987c7pn5r7caqv1cmxw")))))) + (base32 "1wjc3x68l305bl1h1ijd3yhqp2vqj83lkp3kqbr94qmmkqlms8sj")))))) (native-inputs `(("perl" ,perl) ("python" ,python-2) ; for tests @@ -312,13 +316,6 @@ interactive environment for the functional language Haskell.") ;; then complains that they don't match. #:build #f - #:modules ((guix build gnu-build-system) - (guix build utils) - (guix build rpath) - (srfi srfi-26) - (srfi srfi-1)) - #:imported-modules (,@%gnu-build-system-modules - (guix build rpath)) #:configure-flags (list (string-append "--with-gmp-libraries=" @@ -366,19 +363,7 @@ interactive environment for the functional language Haskell.") "testsuite/tests/programs/life_space_leak/life.test") (("/bin/sh") (which "sh")) (("/bin/rm") "rm")) - #t)) - ;; the testsuite can't find shared libraries. - (add-before 'check 'configure-testsuite - (lambda* (#:key inputs #:allow-other-keys) - (let* ((gmp (assoc-ref inputs "gmp")) - (gmp-lib (string-append gmp "/lib")) - (ffi (assoc-ref inputs "libffi")) - (ffi-lib (string-append ffi "/lib")) - (ncurses (assoc-ref inputs "ncurses")) - (ncurses-lib (string-append ncurses "/lib"))) - (setenv "LD_LIBRARY_PATH" - (string-append gmp-lib ":" ffi-lib ":" ncurses-lib)) - #t)))))) + #t))))) (native-search-paths (list (search-path-specification (variable "GHC_PACKAGE_PATH") (files (list diff --git a/gnu/packages/image-viewers.scm b/gnu/packages/image-viewers.scm index bc56041f84..05d39ba877 100644 --- a/gnu/packages/image-viewers.scm +++ b/gnu/packages/image-viewers.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017 Alex Griffin <a@ajgrf.com> +;;; Copyright © 2017 ng0 <contact.ng0@cryptolab.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (guix download) #:use-module (guix packages) #:use-module (guix build-system gnu) + #:use-module (guix build-system cmake) #:use-module (gnu packages autotools) #:use-module (gnu packages base) #:use-module (gnu packages curl) @@ -33,6 +35,7 @@ #:use-module (gnu packages gnome) #:use-module (gnu packages gtk) #:use-module (gnu packages image) + #:use-module (gnu packages imagemagick) #:use-module (gnu packages photo) #:use-module (gnu packages pkg-config) #:use-module (gnu packages xorg)) @@ -205,3 +208,59 @@ your images. Among its features are: @item Configurable mouse actions @end enumerate\n") (license license:gpl3+))) + +(define-public catimg + (package + (name "catimg") + (version "2.2.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/posva/catimg/archive" + "/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "14g90zwh2d3s13hgyxypx2vc0rj1g58l6zcxhgc84wsyxfxd6xpb")))) + (build-system cmake-build-system) + (arguments + `(#:tests? #f ; No check target + #:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key inputs #:allow-other-keys) + (let* ((magic (assoc-ref %build-inputs "imagemagick")) + (convert (string-append magic "/bin/convert"))) + (substitute* "catimg" + ;; By replacing "convert", we also replace the "convert" + ;; in the message 'The version of convert is too old, don't + ;; expect good results :('. This should not happen, but in + ;; practice this error message should not affect us. + (("convert") convert)) + #t))) + (replace 'build + (lambda _ + (zero? (system* "cmake" "-D" + (string-append "CMAKE_INSTALL_PREFIX=" + (assoc-ref %outputs "out")) + ".")) + (zero? (system* "make")))) + (add-before 'install 'install-script + (lambda* (#:key outputs #:allow-other-keys) + ;; The bashscript lacks an file extension, we have to rename + ;; it so that the C program and the bash script can be happy + ;; side by side. + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (install-file "catimg" bin) + (rename-file (string-append bin "/catimg") + (string-append bin "/catimg.sh")) + #t)))))) + (inputs + `(("imagemagick" ,imagemagick))) ; For the bash script version + (home-page "https://github.com/posva/catimg") + (synopsis "Render images in the terminal") + (description + "Catimg is a little program that prints images in the terminal. +It supports JPEG, PNG and GIF formats.") + (license license:expat))) diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm index 5d53dffeec..92cbe2a02f 100644 --- a/gnu/packages/java.scm +++ b/gnu/packages/java.scm @@ -953,7 +953,7 @@ build process and its dependencies, whereas Make uses Makefile format.") ,@(package-inputs icedtea-6)))))) (define-public icedtea-8 - (let* ((version "3.2.0") + (let* ((version "3.3.0") (drop (lambda (name hash) (origin (method url-fetch) @@ -962,7 +962,7 @@ build process and its dependencies, whereas Make uses Makefile format.") "/icedtea8/" version "/" name ".tar.xz")) (sha256 (base32 hash)))))) (package (inherit icedtea-7) - (version "3.2.0") + (version "3.3.0") (source (origin (method url-fetch) (uri (string-append @@ -970,7 +970,7 @@ build process and its dependencies, whereas Make uses Makefile format.") version ".tar.xz")) (sha256 (base32 - "104g2x5nhnqqvx6x29phx5vlrhlqy7qax83b9bqj1y619irrg8gj")) + "02vmxa6gc6gizcri1fy797qmmm9y77vgi7gy9pwkk4agcw4zyr5p")) (modules '((guix build utils))) (snippet '(substitute* "Makefile.am" @@ -1040,31 +1040,31 @@ build process and its dependencies, whereas Make uses Makefile format.") `(("jdk" ,icedtea-7 "jdk") ("openjdk-src" ,(drop "openjdk" - "093r3vlmbdx78w9s6d8lv4q65i0s9wq6an6i2g2d1zaf0js4043c")) + "0889n19w6rvpzxgmmk9hlgzdh9ya95qkc2ajgpnzr3h69g15nz48")) ("corba-drop" ,(drop "corba" - "11r3h9snnj7m5bqnzc5ryd85igdv7xlwzs0zy24p9ii6gsc0f9lh")) + "0qcb72hhlsjgp6h9wd048qgyc88b7lfnxyc51xfyav0nhpfjnj8r")) ("jaxp-drop" ,(drop "jaxp" - "1mp6ps15jk8v4nnvkmbvkk7g35icdjv7892q2a4f7b268yjcgmk1")) + "1vyc7dw10x5k45jmi348y8min6sg651ns12zzn30fjzhpfi36nds")) ("jaxws-drop" ,(drop "jaxws" - "1fb5hikzzx8292nhdbp0snqn66fwnnv4rkjsk1zsjvrv4z5vk18j")) + "1dki6p39z1ms94cjvj5hd9q75q75g244c0xib82pma3q74jg6hx4")) ("jdk-drop" ,(drop "jdk" - "1if9c5grp0km7pyn4mhfwi2ynh3ix20l1fqbfcy68sl2py7psmcj")) + "17czby3nylcglp7l3d90a4pz1izc1sslifv8hrmynm9hn4m9d3k8")) ("langtools-drop" ,(drop "langtools" - "0kbah4h4pllk0gf50mp5f6720f5ci0ixqylccppb484hp95pblcl")) + "1h4azc21k58g9gn2y686wrvn9ahgac0ii7jhrrrmb5c1kjs0y2qv")) ("hotspot-drop" ,(drop "hotspot" - "1gqz9qqsi61838dj08s01sa51zlnkvrk3hy721211dhnmkvlzmwx")) + "12bfgwhrjfhgj6a2dsysdwhirg0jx88pi44y7s8a1bdan1mp03r8")) ("nashorn-drop" ,(drop "nashorn" - "04697l95g6y6n5dvy55k2040c6qp5hfz16qaibwzs594m3gzwwjz")) + "0bg9r16jffc64fhyczn4jpx7bkfw7w62prw65mh66vshqk4lbh0f")) ("shenandoah-drop" ,(drop "shenandoah" - "0k6h7jk5i98jnld2ivy4bhydmkzrp25c3l6gwhvczvrhn7mlbnfx")) + "0abjlsvz669i06mlks28wnh11mm55y5613990pn5j7hfbw8a34q5")) ,@(fold alist-delete (package-native-inputs icedtea-7) '("gcj" "openjdk-src" "corba-drop" "jaxp-drop" "jaxws-drop" "jdk-drop" "langtools-drop" "hotspot-drop"))))))) diff --git a/gnu/packages/ldc.scm b/gnu/packages/ldc.scm index 6ea7f664bd..4b10ac25e0 100644 --- a/gnu/packages/ldc.scm +++ b/gnu/packages/ldc.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2015 Pjotr Prins <pjotr.guix@thebird.nl> +;;; Copyright © 2017 Frederick Muriithi <fredmanglis@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,8 @@ #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages compression) + #:use-module (gnu packages curl) + #:use-module (gnu packages gdb) #:use-module (gnu packages libedit) #:use-module (gnu packages llvm) #:use-module (gnu packages python) @@ -171,3 +174,141 @@ latest DMD frontend and uses LLVM as backend.") (license (list license:bsd-3 license:gpl2+ license:boost1.0)))) + + +(define-public ldc-1.1.0-beta6 + ;; The phobos, druntime and dmd-testsuite dependencies do not have a newer + ;; release than 1.1.0-beta4, hence the need to make use of the older-version + ;; variable to hold this variable. + (let ((older-version "1.1.0-beta4")) + (package + (inherit ldc) + (name "ldc") + (version "1.1.0-beta6") + ;; Beta version needed to compile various scientific tools that require + ;; the newer beta versions, and won't compile successfully with the + ;; older stable version. + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/ldc-developers/ldc/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0n53brlkm86jjkppy9xmzx7nyxykzj68kcxgv8q7d10s5hfscxs8")))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'unpack-submodule-sources + (lambda* (#:key inputs #:allow-other-keys) + (let ((unpack (lambda (source target) + (with-directory-excursion target + (zero? (system* "tar" "xvf" + (assoc-ref inputs source) + "--strip-components=1")))))) + (and (unpack "phobos-src" "runtime/phobos") + (unpack "druntime-src" "runtime/druntime") + (unpack "dmd-testsuite-src" "tests/d2/dmd-testsuite"))))) + ;; The 'patch-dmd2 step in ldc causes the build to fail since + ;; dmd2/root/port.c no longer exists. Arguments needed to have + ;; 'patch-dmd2 step removed, but retain everything else. + (add-after 'unpack-submodule-sources 'patch-phobos + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "runtime/phobos/std/process.d" + (("/bin/sh") (which "sh")) + (("echo") (which "echo"))) + (substitute* "runtime/phobos/std/datetime.d" + (("/usr/share/zoneinfo/") + (string-append (assoc-ref inputs "tzdata") "/share/zoneinfo"))) + (substitute* "tests/d2/dmd-testsuite/Makefile" + (("/bin/bash") (which "bash"))) + #t))))) + (native-inputs + `(("llvm" ,llvm) + ("clang" ,clang) + ("ldc" ,ldc) + ("python-lit" ,python-lit) + ("python-wrapper" ,python-wrapper) + ("unzip" ,unzip) + ("gdb" ,gdb) + ("phobos-src" + ,(origin + (method url-fetch) + (uri (string-append + "https://github.com/ldc-developers/phobos/archive/ldc-v" + older-version ".tar.gz")) + (sha256 + (base32 + "1iwy5rs0rqkicj1zfsa5yqvk8ard99bfr8g69qmhlbzb98q0kpks")) + ;; This patch deactivates some tests that depend on network access + ;; to pass. It also deactivates some tests that have some reliance + ;; on timezone. + ;; + ;; For the network tests, there's an effort to get a version flag + ;; added to deactivate these tests for distribution packagers + ;; that is being pursued at + ;; <https://forum.dlang.org/post/zmdbdgnzrxyvtpqafvyg@forum.dlang.org>. + ;; It also deactivates a test that requires /root + (patches (search-patches "ldc-1.1.0-disable-phobos-tests.patch")))) + ("druntime-src" + ,(origin + (method url-fetch) + (uri (string-append + "https://github.com/ldc-developers/druntime/archive/ldc-v" + older-version ".tar.gz")) + (sha256 + (base32 + "1qsiw5lz1pr8ms9myjf8b94nqi7f1781k226jvxwnhkjg11d0s63")))) + ("dmd-testsuite-src" + ,(origin + (method url-fetch) + (uri (string-append + "https://github.com/ldc-developers/dmd-testsuite/archive/ldc-v" + older-version ".tar.gz")) + (sha256 + (base32 + "0jp54hyi75i9g41rvgmm3zg21yzv57q8dghrhb432rb0n9j15mbp")) + ;; Remove the gdb tests that fails with a "Error: No such file or + ;; directory" error, despite the files being present in the debug + ;; files left with the --keep-failed flag to guix build. + (patches (search-patches "ldc-1.1.0-disable-dmd-tests.patch"))))))))) + +(define-public ldc-beta ldc-1.1.0-beta6) + +(define-public dub + (package + (name "dub") + (version "1.2.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/dlang/dub/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1sd8i1rvxc7y7kk0y6km5zyvaladc5zh56r6afj74ndd63dssv43")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; it would have tested itself by installing some packages (vibe etc) + #:phases + (modify-phases %standard-phases + (delete 'configure) + (replace 'build + (lambda _ + (zero? (system* "./build.sh")))) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (outbin (string-append out "/bin"))) + (mkdir-p outbin) + (install-file "bin/dub" outbin) + #t)))))) + (inputs + `(("curl" ,curl))) + (native-inputs + `(("ldc" ,ldc))) + (home-page "https://code.dlang.org/getting_started") + (synopsis "DUB package manager") + (description "This package provides the D package manager.") + (license license:expat))) diff --git a/gnu/packages/libevent.scm b/gnu/packages/libevent.scm index cb76915ef7..bef09f9538 100644 --- a/gnu/packages/libevent.scm +++ b/gnu/packages/libevent.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr> ;;; Copyright © 2016 David Thompson <davet@gnu.org> +;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,7 @@ (define-public libevent (package (name "libevent") - (version "2.0.22") + (version "2.1.8") (source (origin (method url-fetch) (uri (string-append @@ -41,13 +42,16 @@ version "-stable/libevent-" version "-stable.tar.gz")) (sha256 (base32 - "18qz9qfwrkakmazdlwxvjmw8p76g70n3faikwvdwznns1agw9hki")) - (patches (search-patches "libevent-dns-tests.patch")))) + "1hhxnxlr0fsdv7bdmzsnhdz16fxf3jg2r6vyljcl3kj6pflcap4n")) + (patches (search-patches "libevent-2.1-dns-tests.patch" + ;; XXX: Try removing this for > 2.1.8. + ;; https://github.com/libevent/libevent/issues/452 + "libevent-2.1-skip-failing-test.patch")))) (build-system gnu-build-system) (inputs - `(;; Dependencies used for the tests and for `event_rpcgen.py'. - ("which" ,which) - ("python" ,python-wrapper))) + `(("python" ,python-2))) ; for 'event_rpcgen.py' + (native-inputs + `(("which" ,which))) (home-page "http://libevent.org/") (synopsis "Event notification library") (description @@ -62,6 +66,24 @@ then add or remove events dynamically without having to change the event loop.") (license bsd-3))) +(define-public libevent-2.0 + (package + (inherit libevent) + (version "2.0.22") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/libevent/libevent/releases/download/release-" + version "-stable/libevent-" version "-stable.tar.gz")) + (sha256 + (base32 + "18qz9qfwrkakmazdlwxvjmw8p76g70n3faikwvdwznns1agw9hki")) + (patches (search-patches + "libevent-dns-tests.patch" + "libevent-2.0-evdns-fix-remote-stack-overread.patch" + "libevent-2.0-evutil-fix-buffer-overflow.patch" + "libevent-2.0-evdns-fix-searching-empty-hostnames.patch")))))) + (define-public libev (package (name "libev") diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index aa49d40b7b..e5615c0e5b 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2016 Carlos Sánchez de La Lama <csanchezdll@gmail.com> ;;; Copyright © 2016 ng0 <ng0@libertad.pw> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> +;;; Copyright © 2017 José Miguel Sánchez García <jmi2k@openmailbox.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -62,6 +63,7 @@ #:use-module (gnu packages gperf) #:use-module (gnu packages gtk) #:use-module (gnu packages libusb) + #:use-module (gnu packages man) #:use-module (gnu packages maths) #:use-module (gnu packages ncurses) #:use-module (gnu packages perl) @@ -343,14 +345,14 @@ It has been modified to remove all non-free binary blobs.") (define %intel-compatible-systems '("x86_64-linux" "i686-linux")) (define-public linux-libre - (make-linux-libre "4.9.5" - "1s8lip1hxjsza0qqw93kwp3281rbgzhk4vnvy6fmny8iz7y75vzd" + (make-linux-libre "4.9.6" + "0mafa628la5qj26rff014mmih2widl5k2sjxg152lmpgijmf6qhd" %intel-compatible-systems #:configuration-file kernel-config)) (define-public linux-libre-4.4 - (make-linux-libre "4.4.44" - "0rg5iw7qxry84hha8vfnzrjq0sfnr3vvdwhdz858y7pblg2vr3f0" + (make-linux-libre "4.4.45" + "1c6nigbl8yrqpaz89954la956lshr3p0llm52phxq2h06zblsp87" %intel-compatible-systems #:configuration-file kernel-config)) @@ -361,8 +363,8 @@ It has been modified to remove all non-free binary blobs.") #:configuration-file kernel-config)) ;; Avoid rebuilding kernel variants when there is a minor version bump. -(define %linux-libre-version "4.9.5") -(define %linux-libre-hash "1s8lip1hxjsza0qqw93kwp3281rbgzhk4vnvy6fmny8iz7y75vzd") +(define %linux-libre-version "4.9.6") +(define %linux-libre-hash "0mafa628la5qj26rff014mmih2widl5k2sjxg152lmpgijmf6qhd") (define-public linux-libre-arm-generic (make-linux-libre %linux-libre-version @@ -1600,14 +1602,14 @@ system.") (define-public kbd (package (name "kbd") - (version "2.0.3") + (version "2.0.4") (source (origin (method url-fetch) (uri (string-append "mirror://kernel.org/linux/utils/kbd/kbd-" version ".tar.xz")) (sha256 (base32 - "0ppv953gn2zylcagr4z6zg5y2x93dxrml29plypg6xgbq3hrv2bs")) + "124swm93dm4ca0pifgkrand3r9gvj3019d4zkfxsj9djpvv0mnaz")) (modules '((guix build utils))) (snippet '(begin @@ -2475,7 +2477,7 @@ MPEG-2 and audio over Linux IEEE 1394.") (define-public mdadm (package (name "mdadm") - (version "3.4") + (version "4.0") (source (origin (method url-fetch) (uri (string-append @@ -2483,13 +2485,14 @@ MPEG-2 and audio over Linux IEEE 1394.") version ".tar.xz")) (sha256 (base32 - "0248v9f28mrbwabl94ck22gfim29sqhkf70wrpfi52nk4x3bxl17")))) + "1ad3mma641946wn5lsllwf0lifw9lps34fv1nnkhyfpd9krffshx")))) (build-system gnu-build-system) (inputs `(("udev" ,eudev))) (arguments `(#:make-flags (let ((out (assoc-ref %outputs "out"))) - (list "INSTALL=install" + (list "CC=gcc" + "INSTALL=install" "CHECK_RUN_DIR=0" ;; TODO: tell it where to find 'sendmail' ;; (string-append "MAILCMD=" <???> "/sbin/sendmail") @@ -2666,7 +2669,7 @@ is flexible, efficient and uses a modular implementation.") (define-public fuse-exfat (package (name "fuse-exfat") - (version "1.2.5") + (version "1.2.6") (source (origin (method url-fetch) (uri (string-append @@ -2674,7 +2677,7 @@ is flexible, efficient and uses a modular implementation.") version "/" name "-" version ".tar.gz")) (sha256 (base32 - "1i0sh0s6wnm4dqxli3drva871wgbbm57qjf592vnswna9hc6bvim")))) + "1rvq4hapy2anal1vg1yidv4x8rg4iw5sxfwqixkw0q2qsxb54471")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -2733,7 +2736,7 @@ and copy/paste text in the console and in xterm.") (define-public btrfs-progs (package (name "btrfs-progs") - (version "4.9") + (version "4.9.1") (source (origin (method url-fetch) (uri (string-append "mirror://kernel.org/linux/kernel/" @@ -2741,7 +2744,7 @@ and copy/paste text in the console and in xterm.") "btrfs-progs-v" version ".tar.xz")) (sha256 (base32 - "18y88avadn4wb3xmczd6pfcjr7ik62dw4phk6fmkms2j8vmvl9z2")))) + "1ppy2y9vypxw9awchari21yd3s2d7w2a9q3f4jq7dnjy5gyrnjj6")))) (build-system gnu-build-system) (outputs '("out" "static")) ; static versions of binaries in "out" (~16MiB!) @@ -3372,3 +3375,45 @@ monitoring tools for Linux. These include @code{mpstat}, @code{iostat}, @code{tapestat}, @code{cifsiostat}, @code{pidstat}, @code{sar}, @code{sadc}, @code{sadf} and @code{sa}.") (license license:gpl2+))) + +(define-public light + (package + (name "light") + (version "1.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/haikarainen/" name + "/archive/v" version ".tar.gz")) + (sha256 + (base32 + "0r5gn6c0jcxknzybl6059dplxv46dpahchqq4gymrs7z8bp0hilp")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ; no tests + #:make-flags (list "CC=gcc" + (string-append "PREFIX=" %output)) + #:phases + (modify-phases %standard-phases + (delete 'configure) + (add-after 'unpack 'patch-makefile + (lambda _ + (substitute* "Makefile" (("chown") "#"))))))) + (native-inputs + `(("help2man" ,help2man))) + (home-page "https://haikarainen.github.io/light") + (synopsis "GNU/Linux application to control backlights") + (description + "Light is a program to send commands to screen backlight controllers +under GNU/Linux. Features include: + +@itemize +@item It does not rely on X. +@item Light can automatically figure out the best controller to use, making +full use of underlying hardware. +@item It is possible to set a minimum brightness value, as some controllers +set the screen to be pitch black at a vaĺue of 0 (or higher). +@end itemize + +Light is the successor of lightscript.") + (license license:gpl3+))) diff --git a/gnu/packages/lua.scm b/gnu/packages/lua.scm index 721eceddf1..8bb9a401a6 100644 --- a/gnu/packages/lua.scm +++ b/gnu/packages/lua.scm @@ -401,3 +401,60 @@ Notable examples are GTK+, GStreamer and Webkit.") Grammars (PEGs).") (home-page "http://www.inf.puc-rio.br/~roberto/lpeg") (license license:expat))) + +(define-public lua5.2-lpeg + (package (inherit lua-lpeg) + (name "lua5.2-lpeg") + ;; XXX: The arguments field is almost an exact copy of the field in + ;; "lua-lpeg", except for the version string, which was derived from "lua" + ;; and now is taken from "lua-5.2". See this discussion for context: + ;; http://lists.gnu.org/archive/html/guix-devel/2017-01/msg02048.html + (arguments + `(#:phases + (modify-phases %standard-phases + (delete 'configure) + ;; `make install` isn't available, so we have to do it manually + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (lua-version ,(version-major+minor (package-version lua-5.2)))) + (install-file "lpeg.so" + (string-append out "/lib/lua/" lua-version)) + (install-file "re.lua" + (string-append out "/share/lua/" lua-version)) + #t)))) + #:test-target "test")) + (inputs `(("lua", lua-5.2))))) + +;; Lua 5.3 is not supported. +(define-public lua5.2-bitop + (package + (name "lua5.2-bitop") + (version "1.0.2") + (source (origin + (method url-fetch) + (uri (string-append "http://bitop.luajit.org/download/" + "LuaBitOp-" version ".tar.gz")) + (sha256 + (base32 + "16fffbrgfcw40kskh2bn9q7m3gajffwd2f35rafynlnd7llwj1qj")))) + (build-system gnu-build-system) + (arguments + `(#:test-target "test" + #:make-flags + (list "INSTALL=install -pD" + (string-append "INSTALLPATH=printf " + (assoc-ref %outputs "out") + "/lib/lua/" + ,(version-major+minor (package-version lua-5.2)) + "/bit/bit.so")) + #:phases + (modify-phases %standard-phases + (delete 'configure)))) + (inputs `(("lua", lua-5.2))) + (home-page "http://bitop.luajit.org/index.html") + (synopsis "Bitwise operations on numbers for Lua") + (description + "Lua BitOp is a C extension module for Lua which adds bitwise operations +on numbers.") + (license license:expat))) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 2318ae9b64..5434687749 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -86,6 +86,7 @@ #:use-module (gnu packages web) #:use-module (gnu packages xml) #:use-module (gnu packages xorg) + #:use-module (gnu packages docbook) #:use-module ((guix licenses) #:select (gpl2 gpl2+ gpl3 gpl3+ lgpl2.1 lgpl2.1+ lgpl3+ non-copyleft (expat . license:expat) bsd-3 @@ -247,6 +248,83 @@ aliasing facilities to work just as they would on normal mail.") operating systems.") (license gpl2+))) +(define-public neomutt + (package + (inherit mutt) + (name "neomutt") + (version "20170113") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/" name "/" name + "/archive/" name "-" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0cqr77q263b5qcmdw6g0qixdpk6gmzgzpa03v226nr55v2ips9jg")))) + (inputs + `(("cyrus-sasl" ,cyrus-sasl) + ("gdbm" ,gdbm) + ("gpgme" ,gpgme) + ("ncurses" ,ncurses) + ("gnutls" ,gnutls) + ("openssl" ,openssl) ;For smime + ("perl" ,perl) + ("libxslt" ,libxslt) + ("libidn" ,libidn) + ("libxml2" ,libxml2) + ("docbook-xsl" ,docbook-xsl) + ("notmuch" ,notmuch))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config))) + (arguments + `(#:configure-flags + (list "--enable-smtp" + "--enable-imap" + "--enable-pop" + "--enable-gpgme" + + ;; database, implies header caching + "--without-tokyocabinet" + "--without-qdbm" + "--without-bdb" + "--without-lmdb" + "--with-gdbm" + + "--with-gnutls" + "--without-ssl" + "--with-sasl" + + "--with-regex" + "--enable-smime" + "--enable-notmuch" + "--with-idn" + + ;; If we do not set this, neomutt wants to check + ;; whether the path exists, which it does not + ;; in the chroot. The workaround is this. + "--with-mailpath=/var/mail" + + "--with-external-dotlock" + "--enable-nntp" + "--enable-compressed" + + (string-append "--with-curses=" + (assoc-ref %build-inputs "ncurses"))) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'autoconf + (lambda _ + (zero? (system* "sh" "autoreconf" "-vfi"))))))) + (home-page "https://www.neomutt.org/") + (synopsis "Command-line mail reader based on Mutt") + (description + "NeoMutt is a command-line mail reader which is based on mutt. +It adds a large amount of features to mutt, and they all find their way +into mutt, so it is not a fork but a large set of feature patches."))) + (define-public gmime (package (name "gmime") @@ -327,7 +405,7 @@ and corrections. It is based on a Bayesian filter.") (define-public offlineimap (package (name "offlineimap") - (version "7.0.12") + (version "7.0.13") (source (origin (method url-fetch) (uri (string-append "https://github.com/OfflineIMAP/offlineimap/" @@ -335,7 +413,7 @@ and corrections. It is based on a Bayesian filter.") (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "1m1lp7wxnra8k7lsqc8xlm5giy3i89wvmp35jjb1gf4yslpddnkz")))) + "1kl72wcxnxb4y5lm2f7ymwjsisnnpwb4w971ajkxlsiwjhzq8i7p")))) (build-system python-build-system) (native-inputs `(("asciidoc" ,asciidoc) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index fbf0f6a546..8892ab0c56 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -12,9 +12,11 @@ ;;; Copyright © 2015 Fabian Harfert <fhmgufs@web.de> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org> -;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Thomas Danckaert <post@thomasdanckaert.be> +;;; Copyright © 2017 Paul Garlick <pgarlick@tourbillion-technology.com> +;;; Copyright © 2017 ng0 <contact.ng0@cryptolab.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +39,7 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix utils) #:use-module (guix build utils) #:use-module (guix build-system cmake) @@ -953,17 +956,72 @@ Work may be performed both at the interactive command-line as well as via script files.") (license license:gpl3+))) +(define-public opencascade-oce + (package + (name "opencascade-oce") + (version "0.17.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/tpaviot/oce/archive/OCE-" + version + ".tar.gz")) + (sha256 + (base32 + "0vpmnb0k5y2f7lpmwx9pg9yfq24zjvnsak5alzacncfm1hv9b6cd")))) + (build-system cmake-build-system) + (arguments + '(#:configure-flags + (list "-DOCE_TESTING:BOOL=ON" + "-DOCE_USE_TCL_TEST_FRAMEWORK:BOOL=ON" + "-DOCE_DRAW:BOOL=ON" + (string-append "-DOCE_INSTALL_PREFIX:PATH=" + (assoc-ref %outputs "out")) + "-UCMAKE_INSTALL_RPATH"))) + (inputs + `(("freetype" ,freetype) + ("glu" ,glu) + ("libxmu" ,libxmu) + ("mesa" ,mesa) + ("tcl" ,tcl) + ("tk" ,tk))) + (native-inputs + `(("python" ,python-wrapper))) + (home-page "https://github.com/tpaviot/oce") + (synopsis "Libraries for 3D modeling and numerical simulation") + (description + "Open CASCADE is a set of libraries for the development of applications +dealing with 3D CAD data or requiring industrial 3D capabilities. It includes +C++ class libraries providing services for 3D surface and solid modeling, CAD +data exchange, and visualization. It is used for development of specialized +software dealing with 3D models in design (CAD), manufacturing (CAM), +numerical simulation (CAE), measurement equipment (CMM), and quality +control (CAQ) domains. + +This is the ``Community Edition'' (OCE) of Open CASCADE, which gathers +patches, improvements, and experiments contributed by users over the official +Open CASCADE library.") + (license (list license:lgpl2.1; OCE libraries, with an exception for the + ; use of header files; see + ; OCCT_LGPL_EXCEPTION.txt + license:public-domain; files + ; src/Standard/Standard_StdAllocator.hxx and + ; src/NCollection/NCollection_StdAllocator.hxx + license:expat; file src/OpenGl/OpenGl_glext.h + license:bsd-3)))); test framework gtest + (define-public gmsh (package (name "gmsh") - (version "2.15.0") + (version "2.16.0") (source (origin (method url-fetch) (uri (string-append "http://gmsh.info/src/gmsh-" version "-source.tgz")) (sha256 - (base32 "02h7fk4vv8qwnq3ymm409c5sp4nksd0m9h2vkxqmy42l0ic4nalr")) + (base32 "1slf0bfkwrcgn6296wb4qhbk4ahz6i4wfb10hnim08x05vrylag8")) (modules '((guix build utils))) (snippet ;; Remove non-free METIS code @@ -2840,3 +2898,45 @@ instruction sets. Thus, an application written with Vc can be compiled for: @end enumerate\n") (home-page "https://github.com/VcDevel/Vc") (license license:bsd-3))) + +(define-public reducelcs + ;; This is the last commit which is available upstream, no + ;; release happened since 2010. + (let ((commit "474f88deb968061abe8cf11c959e02319b8ae5c0") + (revision "1")) + (package + (name "reducelcs") + (version (string-append "1.0-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/gdv/Reduce-Expand-for-LCS") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1rllzcfwc042c336mhq262a8ha90x6afq30kvk60r7i4761j4yjm")))) + (build-system gnu-build-system) + (inputs + `(("openlibm" ,openlibm))) + (arguments + `(#:tests? #f ; no tests + #:phases + (modify-phases %standard-phases + (delete 'configure) ; No configure script exists. + (replace 'install ; No install phase exists. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (install-file "Approximation" bin) + (install-file "CollectResults" bin) + (install-file "GenerateInstances" bin) + #t)))))) + (synopsis "Approximate Longest Commons Subsequence computation tool") + (description + "@code{reduceLCS} is an implementation of the Reduce-Expand +algorithm for LCS. It is a fast program to compute the approximate +Longest Commons Subsequence of a set of strings.") + (home-page "https://github.com/gdv/Reduce-Expand-for-LCS") + (license license:gpl3+)))) diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm index 5b3ed740d9..af44da5a1f 100644 --- a/gnu/packages/messaging.scm +++ b/gnu/packages/messaging.scm @@ -78,7 +78,12 @@ #:use-module (gnu packages xiph) #:use-module (gnu packages audio) #:use-module (gnu packages bison) - #:use-module (gnu packages fontutils)) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages bash) + #:use-module (gnu packages guile) + #:use-module (gnu packages less) + #:use-module (gnu packages readline) + #:use-module (gnu packages texinfo)) (define-public libotr (package @@ -111,37 +116,16 @@ keys, no previous conversation is compromised.") (home-page "https://otr.cypherpunks.ca/") (license (list license:lgpl2.1 license:gpl2)))) -;; These patches together fix https://github.com/bitlbee/bitlbee/pull/55, are -;; already upstream, and should be unnecessary when the next bitlbee comes -;; out. -(define %bitlbee-buddy-nick-change-patch - (origin - (method url-fetch) - (uri "https://github.com/bitlbee/bitlbee/commit/a42fda42.patch") - (sha256 - (base32 - "1mzjhcdn0rxir5mzgqz9kv142ai38p1iq2lajqx89wb7x0bp51zx")))) -(define %bitlbee-always-use-nicks-patch - (origin - (method url-fetch) - (uri "https://github.com/bitlbee/bitlbee/commit/3320d6d9.patch") - (sha256 - (base32 - "14d9kb5zdzh5hzakdvrbviz83rix0j2lq9rzb58b2fn92fp8yixd")))) - (define-public bitlbee (package (name "bitlbee") - (version "3.4.2") + (version "3.5.1") (source (origin (method url-fetch) (uri (string-append "https://get.bitlbee.org/src/bitlbee-" version ".tar.gz")) (sha256 - (base32 "0mza8lnfwibmklz8hdzg4f7p83hblf4h6fbf7d732kzpvra5bj39")) - (patches - (list %bitlbee-buddy-nick-change-patch - %bitlbee-always-use-nicks-patch)))) + (base32 "0sgsn0fv41rga46mih3fyv65cvfa6rvki8x92dn7bczbi7yxfdln")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) ("check" ,check))) @@ -1188,4 +1172,56 @@ support, and more.") (synopsis "Small XMPP console client") (license license:gpl2+))) +(define-public freetalk + (package + (name "freetalk") + (version "4.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/freetalk/freetalk-" + version ".tar.gz")) + (sha256 + (base32 + "1rmrn7a1bb7vm26yaklrvx008a9qhwc32s57dwrlf40lv9gffwny")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'configure 'autogen + (lambda _ + (zero? (system* "sh" "autogen.sh")))) + ;; For 'system' commands in Scheme code. + (add-after 'install 'wrap-program + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bash (assoc-ref inputs "bash")) + (coreutils (assoc-ref inputs "coreutils")) + (less (assoc-ref inputs "less"))) + (wrap-program (string-append out "/bin/freetalk") + `("PATH" ":" prefix + ,(map (lambda (dir) + (string-append dir "/bin")) + (list bash coreutils less)))) + #t)))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs + `(("bash" ,bash) + ("glib" ,glib) + ("guile" ,guile-2.0) + ("less" ,less) + ("loudmouth" ,loudmouth) + ("readline" ,readline))) + (synopsis "Extensible console-based Jabber client") + (description + "GNU Freetalk is a command-line Jabber/XMPP chat client. It notably uses +the Readline library to handle input, so it features convenient navigation of +text as well as tab-completion of buddy names, commands and English words. It +is also scriptable and extensible via Guile.") + (home-page "https://www.gnu.org/software/freetalk") + (license license:gpl3+))) + ;;; messaging.scm ends here diff --git a/gnu/packages/mg.scm b/gnu/packages/mg.scm index a315dfed33..5df6770009 100644 --- a/gnu/packages/mg.scm +++ b/gnu/packages/mg.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.org> +;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,44 +22,55 @@ #:use-module (guix download) #:use-module (guix packages) #:use-module (guix build-system gnu) + #:use-module (gnu packages libbsd) #:use-module (gnu packages ncurses) #:use-module (gnu packages pkg-config)) (define-public mg (package (name "mg") - (version "20050429") + (version "20161005") (source (origin (method url-fetch) (uri (string-append "http://homepage.boetes.org/software/mg/mg-" version ".tar.gz")) (sha256 (base32 - "19kib0aha4a40izzds7r63qfb2akq4sily6k28fl0n0zdgq0cna1")) + "0qaydk2cy765n9clghmi5gdnpwn15y2v0fj6r0jcm0v7d89vbz5p")) (modules '((guix build utils))) (snippet '(begin - (substitute* "Makefile.in" - (("-Werror") "") - (("-lcurses") "-lncurses") - (("/usr/bin/install") "install -D") - (("/usr/bin/strip") "strip")))))) + (substitute* "GNUmakefile" + (("/usr/bin/") "")))))) (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config))) (inputs - `(("ncurses" ,ncurses))) + `(("libbsd" ,libbsd) + ("ncurses" ,ncurses))) (arguments ;; No test suite available. '(#:tests? #f - #:phases (alist-cons-before - 'configure 'pre-configure - (lambda* (#:key outputs #:allow-other-keys) - (substitute* "Makefile.in" - (("(prefix=[[:blank:]]*)/usr/local" all prefix) - (string-append prefix (assoc-ref outputs "out"))))) - %standard-phases))) + #:make-flags (list (string-append "prefix=" %output) + "CURSES_LIBS=-lncurses" + "CC=gcc") + #:phases (modify-phases %standard-phases + (delete 'configure) + (add-before 'install 'patch-tutorial-location + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "mg.1" + (("/usr") (assoc-ref outputs "out"))) + #t)) + (add-after 'install 'install-tutorial + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (doc (string-append out "/share/doc/mg"))) + (install-file "tutorial" doc) + #t)))))) (home-page "http://homepage.boetes.org/software/mg/") (synopsis "Microscopic GNU Emacs clone") (description - "mg is Micro GNU Emacs; this is a portable version of the mg maintained -by the OpenBSD team.") + "Mg (mg) is a GNU Emacs style editor, with which it is \"broadly\" +compatible. This is a portable version of the mg maintained by the OpenBSD +team.") (license public-domain))) diff --git a/gnu/packages/mtools.scm b/gnu/packages/mtools.scm index 34bcb5d803..4261162427 100644 --- a/gnu/packages/mtools.scm +++ b/gnu/packages/mtools.scm @@ -48,7 +48,7 @@ FAT-specific file attributes.") (define-public exfat-utils (package (name "exfat-utils") - (version "1.2.5") + (version "1.2.6") (source (origin (method url-fetch) (uri (string-append @@ -56,7 +56,7 @@ FAT-specific file attributes.") version "/" name "-" version ".tar.gz")) (sha256 (base32 - "1qhvjd6dmzhxjdnm4cklajbr03wsjjvkxrsjij517a33napcl93s")))) + "0hxcz0y3rd79nycjlzaca9wh9qj64rw8rzm0xk4jk9ljry96csxr")))) (build-system gnu-build-system) (home-page "https://github.com/relan/exfat") (synopsis "Utilities to manipulate exFAT file systems") diff --git a/gnu/packages/networking.scm b/gnu/packages/networking.scm index 87ee0a1d8e..c2df3013c3 100644 --- a/gnu/packages/networking.scm +++ b/gnu/packages/networking.scm @@ -469,7 +469,7 @@ which can be used to encrypt a password with @code{crypt(3)}.") (define-public wireshark (package (name "wireshark") - (version "2.2.3") + (version "2.2.4") (synopsis "Network traffic analyzer") (source (origin @@ -478,7 +478,7 @@ which can be used to encrypt a password with @code{crypt(3)}.") version ".tar.bz2")) (sha256 (base32 - "0fsrvl6sp772g2q2j24h10h9lfda6q67x7wahjjm8849i2gciflp")))) + "049r5962yrajhhz9r4dsnx403dab50d6091y2mw298ymxqszp9s2")))) (build-system glib-or-gtk-build-system) (inputs `(("bison" ,bison) ("c-ares" ,c-ares) diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm index 28c6ab34fa..9a0bc91128 100644 --- a/gnu/packages/ocaml.scm +++ b/gnu/packages/ocaml.scm @@ -40,6 +40,7 @@ #:use-module (gnu packages m4) #:use-module (gnu packages multiprecision) #:use-module (gnu packages ncurses) + #:use-module (gnu packages pcre) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) @@ -65,6 +66,46 @@ (number->string file-number) "/" name "-" version ".tar.gz")) +;; Janestreet packages are found in a similar way and all need the same patch. +(define (janestreet-origin name version hash) + (origin (method url-fetch) + (uri (string-append "https://ocaml.janestreet.com/ocaml-core/" + (version-major+minor version) "/files/" + name "-" version ".tar.gz")) + (sha256 (base32 hash)) + (modules '((guix build utils))) + (snippet + (let ((pattern (string-append "lib/" name))) + `(begin + ;; install.ml contains an invalid reference to the ppx file and + ;; propagates this error to the generated META file. It + ;; looks for it in the "lib" directory, but it is installed in + ;; "lib/ocaml/site-lib/package". This substitute does not change + ;; this file for non ppx packages. + (substitute* "install.ml" + ((,pattern) (string-append "lib/ocaml/site-lib/" ,name))) + ;; The standard Makefile would try to install janestreet modules + ;; in OCaml's directory in the store, which is read-only. + (substitute* "Makefile" + (("--prefix") + "--libdir $(LIBDIR) --prefix"))))))) + +;; They also require almost the same set of arguments +(define janestreet-arguments + `(#:use-make? #t + #:make-flags + (list (string-append "CONFIGUREFLAGS=--prefix " + (assoc-ref %outputs "out") + " --enable-tests") + (string-append "LIBDIR=" + (assoc-ref %outputs "out") + "/lib/ocaml/site-lib") + ;; for ocaml-bin-prot, otherwise ignored + (string-append "OCAML_TOPLEVEL_PATH=" + (assoc-ref %build-inputs "findlib") + "/lib/ocaml/site-lib")) + #:phases (modify-phases %standard-phases (delete 'configure)))) + (define-public ocaml (package (name "ocaml") @@ -1696,3 +1737,291 @@ without a complete in-memory representation of the data.") (description "Client-side URL transfer library, supporting HTTP and a multitude of other network protocols (FTP/SMTP/RTSP/etc).") (license license:isc))) + +(define-public ocaml-base64 + (package + (name "ocaml-base64") + (version "2.1.2") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/mirage/ocaml-base64/" + "releases/download/v" version "/base64-" + version ".tbz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1p45sawchmrkr22gkmydjc4ary23pisp58zsnb7iq7d82nxs1lfq")))) + (build-system ocaml-build-system) + (arguments + `(#:build-flags (list "build" "--tests" "true") + #:phases + (modify-phases %standard-phases + (delete 'configure)))) + (native-inputs + `(("topkg" ,ocaml-topkg) + ("opam" ,opam) + ("rresult" ,ocaml-rresult) + ("bos" ,ocaml-bos) + ("alcotest" ,ocaml-alcotest))) + (home-page "https://github.com/mirage/ocaml-base64") + (synopsis "Base64 encoding for OCaml") + (description "Base64 is a group of similar binary-to-text encoding schemes +that represent binary data in an ASCII string format by translating it into a +radix-64 representation. It is specified in RFC 4648.") + (license license:isc))) + +(define-public ocamlify + (package + (name "ocamlify") + (version "0.0.2") + (source (origin + (method url-fetch) + (uri (ocaml-forge-uri name version 1209)) + (sha256 + (base32 + "1f0fghvlbfryf5h3j4as7vcqrgfjb4c8abl5y0y5h069vs4kp5ii")))) + (build-system ocaml-build-system) + ; tests are done during build + (arguments + `(#:phases + (modify-phases %standard-phases + (delete 'check)))) + (home-page "https://forge.ocamlcore.org/projects/ocamlify") + (synopsis "Include files in OCaml code") + (description "OCamlify allows to create OCaml source code by including +whole files into OCaml string or string list. The code generated can be +compiled as a standard OCaml file. It allows embedding external resources as +OCaml code.") + (license license:lgpl2.1+))); with the OCaml static compilation exception + +(define-public omake + (package + (name "omake") + (version "0.10.1") + (source (origin + (method url-fetch) + (uri (string-append "http://download.camlcity.org/download/" + "omake-" version ".tar.gz")) + (sha256 + (base32 + "093ansbppms90hiqvzar2a46fj8gm9iwnf8gn38s6piyp70lrbsj")) + (patches (search-patches "omake-fix-non-determinism.patch")))) + (build-system ocaml-build-system) + (arguments + `(#:make-flags + (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) + #:tests? #f ; no test target + #:phases + (modify-phases %standard-phases + (add-before 'configure 'fix-makefile + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "mk/osconfig_unix.mk" + (("CC = cc") "CC = gcc"))))))) + (native-inputs `(("hevea" ,hevea))) + (home-page "http://projects.camlcity.org/projects/omake.html") + (synopsis "Build system designed for scalability and portability") + (description "Similar to make utilities you may have used, but it features +many additional enhancements, including: + +@enumerate +@item Support for projects spanning several directories or directory hierarchies. +@item Fast, reliable, automated, scriptable dependency analysis using MD5 digests, + with full support for incremental builds. +@item Dependency analysis takes the command lines into account — whenever the + command line used to build a target changes, the target is considered + out-of-date. +@item Fully scriptable, includes a library that providing support for standard + tasks in C, C++, OCaml, and LaTeX projects, or a mixture thereof. +@end enumerate") + (license (list license:lgpl2.1 ; libmojave + license:expat ; OMake scripts + license:gpl2)))) ; OMake itself, with ocaml linking exception + ; see LICENSE.OMake + +(define-public ocaml-batteries + (package + (name "ocaml-batteries") + (version "2.5.3") + (source (origin + (method url-fetch) + (uri (ocaml-forge-uri "batteries" version 1650)) + (sha256 + (base32 + "1a97w3x2l1jr5x9kj5gqm1x6b0q9fjqdcsvls7arnl3bvzgsia0n")))) + (build-system ocaml-build-system) + (native-inputs + `(("qtest" ,ocaml-qtest) + ("bisect" ,ocaml-bisect) + ("ounit" ,ocaml-ounit))) + (arguments + `(#:phases + (modify-phases %standard-phases + (delete 'check) ; tests are run by the build phase + (replace 'build + (lambda* (#:key outputs #:allow-other-keys) + (zero? (system* "ocaml" "setup.ml" "-build"))))))) + (home-page "http://batteries.forge.ocamlcore.org/") + (synopsis "Development platform for the OCaml programming language") + (description "Define a standard set of libraries which may be expected on +every compliant installation of OCaml and organize these libraries into a +hierarchy of modules.") + (license license:lgpl2.1+))) + +(define-public ocaml-pcre + (package + (name "ocaml-pcre") + (version "7.2.3") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/mmottl/pcre-ocaml/archive" + "/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0rj6dw79px4sj2kq0iss2nzq3rnsn9wivvc0f44wa1mppr6njfb3")))) + (build-system ocaml-build-system) + (arguments + `(#: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/pcre"))) + (mkdir-p stubs) + (symlink (string-append lib "/dllpcre_stubs.so") + (string-append stubs "/dllpcre_stubs.so")))))))) + (native-inputs + `(("batteries" ,ocaml-batteries) + ("pcre:bin" ,pcre "bin"))) + (propagated-inputs `(("pcre" ,pcre))) + (home-page "https://mmottl.github.io/pcre-ocaml") + (synopsis "Bindings to the Perl Compatibility Regular Expressions library") + (description "Pcre-ocaml offers library functions for string pattern +matching and substitution, similar to the functionality offered by the Perl +language.") + (license license:lgpl2.1+))); with the OCaml link exception + +(define-public ocaml-expect + (package + (name "ocaml-expect") + (version "0.0.5") + (source (origin + (method url-fetch) + (uri (ocaml-forge-uri name version 1372)) + (sha256 + (base32 + "07xq8w2x2vffc32z7vk6y14jwbfb1cw0m2lm1jzi60hnr1dvg8by")))) + (build-system ocaml-build-system) + (native-inputs + `(("ocaml-pcre" ,ocaml-pcre) + ("ounit" ,ocaml-ounit))) + (propagated-inputs `(("batteries" ,ocaml-batteries))) + (home-page "https://forge.ocamlcore.org/projects/ocaml-expect/") + (synopsis "Simple implementation of expect") + (description "Help building unitary testing of interactive program. You +can match the question using a regular expression or a timeout.") + (license license:lgpl2.1+))) ; with the OCaml static compilation exception + +(define-public ocaml-fileutils + (package + (name "ocaml-fileutils") + (version "0.5.1") + (source (origin + (method url-fetch) + (uri (ocaml-forge-uri name version 1651)) + (sha256 + (base32 + "0g6zx2rcvacklxyli19ixcf6ich9ipxsps4k3jz98f5zlaab0a7g")))) + (build-system ocaml-build-system) + (native-inputs `(("ounit" ,ocaml-ounit))) + (home-page "http://ocaml-fileutils.forge.ocamlcore.org") + (synopsis "Pure OCaml functions to manipulate real file and filename") + (description "Library to provide pure OCaml functions to manipulate real +file (POSIX like) and filename.") + (license license:lgpl2.1+))) ; with the OCaml static compilation exception + +(define-public ocaml-oasis + (package + (name "ocaml-oasis") + (version "0.4.8") + (source (origin + (method url-fetch) + (uri (ocaml-forge-uri name version 1669)) + (sha256 + (base32 + "1ln7vc7ip6s5xbi20mhnn087xi4a2m5vqawx0703qqnfkzhmslqy")) + (modules '((guix build utils))) + (snippet + '(substitute* "test/test-main/Test.ml" + ;; most of these tests fail because ld cannot find crti.o, but according + ;; to the log file, the environment variables {LD_,}LIBRARY_PATH + ;; are set correctly whene LD_LIBRARY_PATH is defined beforhand. + (("TestBaseCompat.tests;") "") + (("TestExamples.tests;") "") + (("TestFull.tests;") "") + (("TestPluginDevFiles.tests;") "") + (("TestPluginInternal.tests;") "") + (("TestPluginOCamlbuild.tests;") "") + (("TestPluginOMake.tests;") ""))))) + (build-system ocaml-build-system) + (native-inputs + `(("ocamlify" ,ocamlify) + ("ocamlmod" ,ocamlmod) + ("ounit" ,ocaml-ounit) + ("omake" ,omake) + ("ocaml-expect" ,ocaml-expect) + ("ocaml-pcre" ,ocaml-pcre) + ("ocaml-fileutils" ,ocaml-fileutils) + ("camlp4" ,camlp4) + ("texlive" ,texlive) + ("pkg-config" ,pkg-config))) + (home-page "https://oasis.forge.ocamlcore.org") + (synopsis "Integrates a configure, build, install system in OCaml projects") + (description "OASIS is a tool to integrate a configure, build and install +system in your OCaml projects. It helps to create standard entry points in your +build system and allows external tools to analyse your project easily.") + (license license:lgpl2.1+))) ; with ocaml static compilation exception + +(define-public ocaml-js-build-tools + (package + (name "ocaml-js-build-tools") + (version "113.33.06") + (source (janestreet-origin "js-build-tools" version + "0r8z4fz8iy5y6hkdlkpwf6rk4qigcr3dzyv35585xgg2ahf12zy6")) + (native-inputs + `(("oasis" ,ocaml-oasis) + ("opam" ,opam))) + (build-system ocaml-build-system) + (arguments janestreet-arguments) + (home-page "https://github.com/janestreet/js-build-tools") + (synopsis "Collection of tools to help building Jane Street Packages") + (description "This package contains tools to help building Jane Street +packages, but can be used for other purposes. It contains: +@enumerate +@item an @command{oasis2opam-install} tool to produce a @file{.install} file +from the oasis build log +@item a @code{js_build_tools} ocamlbuild plugin with various goodies. +@end enumerate") + (license license:asl2.0))) + +(define-public ocaml-bin-prot + (package + (name "ocaml-bin-prot") + (version "113.33.03") + (source (janestreet-origin "bin_prot" version + "1ws8c017z8nbj3vw92ndvjk9011f71rmp3llncbv8r5fc76wqv3l")) + (native-inputs + `(("js-build-tools" ,ocaml-js-build-tools) + ("opam" ,opam))) + (build-system ocaml-build-system) + (arguments janestreet-arguments) + (home-page "https://github.com/janestreet/bin_prot/") + (synopsis "Binary protocol generator") + (description "This library contains functionality for reading and writing +OCaml-values in a type-safe binary protocol. It is extremely efficient, +typically supporting type-safe marshalling and unmarshalling of even highly +structured values at speeds sufficient to saturate a gigabit connection. The +protocol is also heavily optimized for size, making it ideal for long-term +storage of large amounts of data.") + (license license:asl2.0))) diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm index 097e4e182b..a9ce2c929a 100644 --- a/gnu/packages/parallel.scm +++ b/gnu/packages/parallel.scm @@ -45,7 +45,7 @@ (define-public parallel (package (name "parallel") - (version "20161222") + (version "20170122") (source (origin (method url-fetch) @@ -53,7 +53,7 @@ version ".tar.bz2")) (sha256 (base32 - "1chgr3csyc7hbq2wq4jnwnbsr3ix8rzsk2lf4vdnvkjpd6dvw517")))) + "19maf889vj1c4zakqwap58f44hgypyb5mzzwfsliir9gvvcq6zj1")))) (build-system gnu-build-system) (arguments `(#:phases diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm index feb6848e09..0a3b4b64e7 100644 --- a/gnu/packages/password-utils.scm +++ b/gnu/packages/password-utils.scm @@ -36,6 +36,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages glib) #:use-module (gnu packages gnupg) + #:use-module (gnu packages gtk) #:use-module (gnu packages guile) #:use-module (gnu packages linux) #:use-module (gnu packages man) @@ -240,6 +241,15 @@ random passwords that pass the checks.") #:tests? #f #:phases (modify-phases %standard-phases + (add-after 'install 'wrap-assword + (lambda* (#:key outputs #:allow-other-keys) + (let ((prog (string-append + (assoc-ref outputs "out") + "/bin/assword")) + (gi-typelib-path (getenv "GI_TYPELIB_PATH"))) + (wrap-program prog + `("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path))) + #t))) (add-after 'install 'manpage (lambda* (#:key outputs #:allow-other-keys) (and @@ -255,7 +265,8 @@ random passwords that pass the checks.") (native-inputs `(("txt2man" ,txt2man))) (inputs - `(("python-xdo" ,python-xdo) + `(("gtk+" ,gtk+) + ("python-xdo" ,python-xdo) ("python-gpg" ,python-gpg) ("python-pygobject" ,python-pygobject))) (propagated-inputs diff --git a/gnu/packages/patches/ghc-dont-pass-linker-flags-via-response-files.patch b/gnu/packages/patches/ghc-dont-pass-linker-flags-via-response-files.patch new file mode 100644 index 0000000000..40aae7a9d7 --- /dev/null +++ b/gnu/packages/patches/ghc-dont-pass-linker-flags-via-response-files.patch @@ -0,0 +1,27 @@ +Don’t add linker flags via ‘response files’ since ld-wrapper +doesn’t handle them. +See https://github.com/NixOS/nixpkgs/commit/a421e7bd4a28c69bded8b17888325e31554f61a1 +https://gcc.gnu.org/ml/gcc/2016-10/msg00151.html + +diff --git a/compiler/main/SysTools.hs.orig b/compiler/main/SysTools.hs +index 1ab5b13..99270fc 100644 +--- a/compiler/main/SysTools.hs.orig ++++ b/compiler/main/SysTools.hs +@@ -424,7 +424,7 @@ runCc dflags args = do + args1 = map Option (getOpts dflags opt_c) + args2 = args0 ++ args1 ++ args + mb_env <- getGccEnv args2 +- runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env ++ runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env + where + -- discard some harmless warnings from gcc that we can't turn off + cc_filter = unlines . doFilter . lines +@@ -945,7 +945,7 @@ runLink dflags args = do + args1 = map Option (getOpts dflags opt_l) + args2 = args0 ++ linkargs ++ args1 ++ args + mb_env <- getGccEnv args2 +- runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env ++ runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env + where + ld_filter = case (platformOS (targetPlatform dflags)) of + OSSolaris2 -> sunos_ld_filter diff --git a/gnu/packages/patches/httpd-CVE-2016-8740.patch b/gnu/packages/patches/httpd-CVE-2016-8740.patch deleted file mode 100644 index 17ba323ccf..0000000000 --- a/gnu/packages/patches/httpd-CVE-2016-8740.patch +++ /dev/null @@ -1,36 +0,0 @@ -This patch applies against httpd-2.4.23 and shouldn't be needed in later releases -http://openwall.com/lists/oss-security/2016/12/05/17 -Index: modules/http2/h2_stream.c -=================================================================== ---- modules/http2/h2_stream.c (revision 1771866) -+++ modules/http2/h2_stream.c (working copy) -@@ -322,18 +322,18 @@ - HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE); - } - } -- } -- -- if (h2_stream_is_scheduled(stream)) { -- return h2_request_add_trailer(stream->request, stream->pool, -- name, nlen, value, vlen); -- } -- else { -- if (!input_open(stream)) { -- return APR_ECONNRESET; -+ -+ if (h2_stream_is_scheduled(stream)) { -+ return h2_request_add_trailer(stream->request, stream->pool, -+ name, nlen, value, vlen); - } -- return h2_request_add_header(stream->request, stream->pool, -- name, nlen, value, vlen); -+ else { -+ if (!input_open(stream)) { -+ return APR_ECONNRESET; -+ } -+ return h2_request_add_header(stream->request, stream->pool, -+ name, nlen, value, vlen); -+ } - } - } - diff --git a/gnu/packages/patches/ldc-1.1.0-disable-dmd-tests.patch b/gnu/packages/patches/ldc-1.1.0-disable-dmd-tests.patch new file mode 100644 index 0000000000..31eb44aefc --- /dev/null +++ b/gnu/packages/patches/ldc-1.1.0-disable-dmd-tests.patch @@ -0,0 +1,35 @@ +This patch deactivates some tests that fail when ldc is built with the command: + +./pre-inst-env guix environment guix --pure -- ./pre-inst-env guix build ldc@1.1.0-beta6 + +When the --keep-failed flag is added to the build command above, and the tests +run in the resulting /tmp/guix-build-ldc-1.1.0-beta6.drv-* directory, the tests +pass. + +by Frederick M. Muriithi <fredmanglis@gmail.com> + +diff --git a/d_do_test.d b/d_do_test.d +index aa67169..8173759 100755 +--- a/d_do_test.d ++++ b/d_do_test.d +@@ -645,8 +645,6 @@ int main(string[] args) + auto gdb_output = execute(fThisRun, command, true, result_path); + if (testArgs.gdbMatch !is null) + { +- enforce(match(gdb_output, regex(testArgs.gdbMatch)), +- "\nGDB regex: '"~testArgs.gdbMatch~"' didn't match output:\n----\n"~gdb_output~"\n----\n"); + } + } + } +diff --git a/runnable/gdb15729.sh b/runnable/gdb15729.sh +index 1d390e0..906b2b6 100755 +--- a/runnable/gdb15729.sh ++++ b/runnable/gdb15729.sh +@@ -21,7 +21,6 @@ if [ $OS == "linux" ]; then + echo RESULT= + p s.val + EOF +- gdb ${dir}${SEP}gdb15729 --batch -x ${dir}${SEP}gdb15729.gdb | grep 'RESULT=.*1234' || exit 1 + fi + + rm -f ${libname} ${dir}${SEP}{gdb15729${OBJ},gdb15729${EXE},gdb15729.gdb} diff --git a/gnu/packages/patches/ldc-1.1.0-disable-phobos-tests.patch b/gnu/packages/patches/ldc-1.1.0-disable-phobos-tests.patch new file mode 100644 index 0000000000..70dd419455 --- /dev/null +++ b/gnu/packages/patches/ldc-1.1.0-disable-phobos-tests.patch @@ -0,0 +1,414 @@ +This patch deactivates failing tests that depend on network connectivity +to pass in curl.d and socket.d +It deactivates tests in path.d that assume /root + +A thread was started on the ldc forum to pursue the possibility of a +version flag to deactivate tests conditionally. The thread is at +https://forum.dlang.org/post/zmdbdgnzrxyvtpqafvyg@forum.dlang.org + +by Frederick M. Muriithi <fredmanglis@gmail.com> + +diff --git a/std/datetime.d b/std/datetime.d +index 4d4afb1..2c91a44 100644 +--- a/std/datetime.d ++++ b/std/datetime.d +@@ -27306,8 +27306,8 @@ public: + // leaving it commented out until I can sort it out. + //assert(equal(tzNames, tzNames.uniq())); + +- foreach(tzName; tzNames) +- assertNotThrown!DateTimeException(testPZSuccess(tzName)); ++ //foreach(tzName; tzNames) ++ //assertNotThrown!DateTimeException(testPZSuccess(tzName)); + } + + +@@ -29178,8 +29178,8 @@ public: + + auto tzNames = getInstalledTZNames(); + +- foreach(tzName; tzNames) +- assertNotThrown!DateTimeException(testPTZSuccess(tzName)); ++ //foreach(tzName; tzNames) ++ //assertNotThrown!DateTimeException(testPTZSuccess(tzName)); + + // No timezone directories on Android, just a single tzdata file + version(Android) {} else +diff --git a/std/net/curl.d b/std/net/curl.d +index 9c6af66..5fccb38 100644 +--- a/std/net/curl.d ++++ b/std/net/curl.d +@@ -419,7 +419,7 @@ void download(Conn = AutoProtocol)(const(char)[] url, string saveToPath, Conn co + + unittest + { +- static import std.file; ++ /*static import std.file; + foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { +@@ -430,7 +430,7 @@ unittest + scope (exit) std.file.remove(fn); + download(host, fn); + assert(std.file.readText(fn) == "Hello world"); +- } ++ }*/ + } + + /** Upload file from local files system using the HTTP or FTP protocol. +@@ -483,7 +483,7 @@ void upload(Conn = AutoProtocol)(string loadFromPath, const(char)[] url, Conn co + + unittest + { +- static import std.file; ++ /*static import std.file; + foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + auto fn = std.file.deleteme; +@@ -496,7 +496,7 @@ unittest + s.send(httpOK()); + }); + upload(fn, host ~ "/path"); +- } ++ }*/ + } + + /** HTTP/FTP get content. +@@ -551,7 +551,7 @@ T[] get(Conn = AutoProtocol, T = char)(const(char)[] url, Conn conn = Conn()) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + assert(s.recvReq.hdrs.canFind("GET /path")); +@@ -559,7 +559,7 @@ unittest + }); + auto res = get(host ~ "/path"); + assert(res == "GETRESPONSE"); +- } ++ }*/ + } + + +@@ -598,7 +598,7 @@ if (is(T == char) || is(T == ubyte)) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; +@@ -608,12 +608,12 @@ unittest + }); + auto res = post(host ~ "/path", "POSTBODY"); + assert(res == "POSTRESPONSE"); +- } ++ }*/ + } + + unittest + { +- auto data = new ubyte[](256); ++ /*auto data = new ubyte[](256); + foreach (i, ref ub; data) + ub = cast(ubyte)i; + +@@ -624,7 +624,7 @@ unittest + s.send(httpOK(cast(ubyte[])[17, 27, 35, 41])); + }); + auto res = post!ubyte(testServer.addr, data); +- assert(res == cast(ubyte[])[17, 27, 35, 41]); ++ assert(res == cast(ubyte[])[17, 27, 35, 41]);*/ + } + + +@@ -680,7 +680,7 @@ T[] put(Conn = AutoProtocol, T = char, PutUnit)(const(char)[] url, const(PutUnit + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; +@@ -690,7 +690,7 @@ unittest + }); + auto res = put(host ~ "/path", "PUTBODY"); + assert(res == "PUTRESPONSE"); +- } ++ }*/ + } + + +@@ -742,7 +742,7 @@ void del(Conn = AutoProtocol)(const(char)[] url, Conn conn = Conn()) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; +@@ -750,7 +750,7 @@ unittest + s.send(httpOK()); + }); + del(host ~ "/path"); +- } ++ }*/ + } + + +@@ -796,13 +796,13 @@ T[] options(T = char, OptionsUnit)(const(char)[] url, + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("OPTIONS /path")); + s.send(httpOK("OPTIONSRESPONSE")); + }); + auto res = options(testServer.addr ~ "/path"); +- assert(res == "OPTIONSRESPONSE"); ++ assert(res == "OPTIONSRESPONSE");*/ + } + + +@@ -836,13 +836,13 @@ T[] trace(T = char)(const(char)[] url, HTTP conn = HTTP()) + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("TRACE /path")); + s.send(httpOK("TRACERESPONSE")); + }); + auto res = trace(testServer.addr ~ "/path"); +- assert(res == "TRACERESPONSE"); ++ assert(res == "TRACERESPONSE");*/ + } + + +@@ -875,13 +875,13 @@ T[] connect(T = char)(const(char)[] url, HTTP conn = HTTP()) + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("CONNECT /path")); + s.send(httpOK("CONNECTRESPONSE")); + }); + auto res = connect(testServer.addr ~ "/path"); +- assert(res == "CONNECTRESPONSE"); ++ assert(res == "CONNECTRESPONSE");*/ + } + + +@@ -919,14 +919,14 @@ T[] patch(T = char, PatchUnit)(const(char)[] url, const(PatchUnit)[] patchData, + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("PATCH /path")); + assert(req.bdy.canFind("PATCHBODY")); + s.send(httpOK("PATCHRESPONSE")); + }); + auto res = patch(testServer.addr ~ "/path", "PATCHBODY"); +- assert(res == "PATCHRESPONSE"); ++ assert(res == "PATCHRESPONSE");*/ + } + + +@@ -1031,19 +1031,19 @@ private auto _basicHTTP(T)(const(char)[] url, const(void)[] sendData, HTTP clien + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("GET /path")); + s.send(httpNotFound()); + }); + auto e = collectException!CurlException(get(testServer.addr ~ "/path")); +- assert(e.msg == "HTTP request returned status code 404 (Not Found)"); ++ assert(e.msg == "HTTP request returned status code 404 (Not Found)");*/ + } + + // Bugzilla 14760 - content length must be reset after post + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("POST /")); + assert(req.bdy.canFind("POSTBODY")); +@@ -1061,7 +1061,7 @@ unittest + auto res = post(testServer.addr, "POSTBODY", http); + assert(res == "POSTRESPONSE"); + res = trace(testServer.addr, http); +- assert(res == "TRACERESPONSE"); ++ assert(res == "TRACERESPONSE");*/ + } + + /* +@@ -1265,14 +1265,14 @@ if (isCurlConn!Conn && isSomeChar!Char && isSomeChar!Terminator) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; + s.send(httpOK("Line1\nLine2\nLine3")); + }); + assert(byLine(host).equal(["Line1", "Line2", "Line3"])); +- } ++ }*/ + } + + /** HTTP/FTP fetch content as a range of chunks. +@@ -1337,14 +1337,14 @@ auto byChunk(Conn = AutoProtocol) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; + s.send(httpOK(cast(ubyte[])[0, 1, 2, 3, 4, 5])); + }); + assert(byChunk(host, 2).equal([[0, 1], [2, 3], [4, 5]])); +- } ++ }*/ + } + + private T[] _getForRange(T,Conn)(const(char)[] url, Conn conn) +@@ -1629,14 +1629,14 @@ auto byLineAsync(Conn = AutoProtocol, Terminator = char, Char = char) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; + s.send(httpOK("Line1\nLine2\nLine3")); + }); + assert(byLineAsync(host).equal(["Line1", "Line2", "Line3"])); +- } ++ }*/ + } + + +@@ -1778,14 +1778,14 @@ auto byChunkAsync(Conn = AutoProtocol) + + unittest + { +- foreach (host; [testServer.addr, "http://"~testServer.addr]) ++ /*foreach (host; [testServer.addr, "http://"~testServer.addr]) + { + testServer.handle((s) { + auto req = s.recvReq; + s.send(httpOK(cast(ubyte[])[0, 1, 2, 3, 4, 5])); + }); + assert(byChunkAsync(host, 2).equal([[0, 1], [2, 3], [4, 5]])); +- } ++ }*/ + } + + +@@ -2041,7 +2041,7 @@ private mixin template Protocol() + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq; + assert(req.hdrs.canFind("GET /")); + assert(req.hdrs.canFind("Basic dXNlcjpwYXNz")); +@@ -2051,7 +2051,7 @@ private mixin template Protocol() + auto http = HTTP(testServer.addr); + http.onReceive = (ubyte[] data) { return data.length; }; + http.setAuthentication("user", "pass"); +- http.perform(); ++ http.perform();*/ + } + + /** +@@ -2959,7 +2959,7 @@ struct HTTP + + unittest + { +- testServer.handle((s) { ++ /*testServer.handle((s) { + auto req = s.recvReq!ubyte; + assert(req.hdrs.canFind("POST /path")); + assert(req.bdy.canFind(cast(ubyte[])[0, 1, 2, 3, 4])); +@@ -2975,7 +2975,7 @@ struct HTTP + ubyte[] res; + http.onReceive = (data) { res ~= data; return data.length; }; + http.perform(); +- assert(res == cast(ubyte[])[17, 27, 35, 41]); ++ assert(res == cast(ubyte[])[17, 27, 35, 41]);*/ + } + + /** +diff --git a/std/path.d b/std/path.d +index 60c844f..0598104 100644 +--- a/std/path.d ++++ b/std/path.d +@@ -3953,8 +3953,10 @@ unittest + } + else + { ++/* + assert(expandTilde("~root") == "/root", expandTilde("~root")); + assert(expandTilde("~root/") == "/root/", expandTilde("~root/")); ++*/ + } + assert(expandTilde("~Idontexist/hey") == "~Idontexist/hey"); + } +diff --git a/std/socket.d b/std/socket.d +index 7f5a3c3..e68b881 100644 +--- a/std/socket.d ++++ b/std/socket.d +@@ -481,15 +481,15 @@ unittest + { + softUnittest({ + Protocol proto = new Protocol; +- assert(proto.getProtocolByType(ProtocolType.TCP)); ++ //assert(proto.getProtocolByType(ProtocolType.TCP)); + //writeln("About protocol TCP:"); + //writefln("\tName: %s", proto.name); + // foreach(string s; proto.aliases) + // { + // writefln("\tAlias: %s", s); + // } +- assert(proto.name == "tcp"); +- assert(proto.aliases.length == 1 && proto.aliases[0] == "TCP"); ++ //assert(proto.name == "tcp"); ++ //assert(proto.aliases.length == 1 && proto.aliases[0] == "TCP"); + }); + } + +@@ -832,9 +832,9 @@ unittest + InternetHost ih = new InternetHost; + + ih.getHostByAddr(0x7F_00_00_01); +- assert(ih.addrList[0] == 0x7F_00_00_01); ++ //assert(ih.addrList[0] == 0x7F_00_00_01); + ih.getHostByAddr("127.0.0.1"); +- assert(ih.addrList[0] == 0x7F_00_00_01); ++ //assert(ih.addrList[0] == 0x7F_00_00_01); + + softUnittest({ + if (!ih.getHostByName("www.digitalmars.com")) diff --git a/gnu/packages/patches/libevent-2.0-evdns-fix-remote-stack-overread.patch b/gnu/packages/patches/libevent-2.0-evdns-fix-remote-stack-overread.patch new file mode 100644 index 0000000000..f1907d53e2 --- /dev/null +++ b/gnu/packages/patches/libevent-2.0-evdns-fix-remote-stack-overread.patch @@ -0,0 +1,42 @@ +Fix buffer overread in libevents DNS code. + +Upstream bug report: + +https://github.com/libevent/libevent/issues/317 + +Patch copied from upstream source repository: + +https://github.com/libevent/libevent/commit/96f64a022014a208105ead6c8a7066018449d86d + +From 3c570970516f48da35f42fef98276531fcc0abaa Mon Sep 17 00:00:00 2001 +From: Azat Khuzhin <a3at.mail@gmail.com> +Date: Mon, 1 Feb 2016 17:32:09 +0300 +Subject: [PATCH] evdns: name_parse(): fix remote stack overread + +--- + evdns.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/evdns.c b/evdns.c +index 60b10485..137c24ea 100644 +--- a/evdns.c ++++ b/evdns.c +@@ -960,7 +960,6 @@ name_parse(u8 *packet, int length, int *idx, char *name_out, int name_out_len) { + + for (;;) { + u8 label_len; +- if (j >= length) return -1; + GET8(label_len); + if (!label_len) break; + if (label_len & 0xc0) { +@@ -981,6 +980,7 @@ name_parse(u8 *packet, int length, int *idx, char *name_out, int name_out_len) { + *cp++ = '.'; + } + if (cp + label_len >= end) return -1; ++ if (j + label_len > length) return -1; + memcpy(cp, packet + j, label_len); + cp += label_len; + j += label_len; +-- +2.11.0 + diff --git a/gnu/packages/patches/libevent-2.0-evdns-fix-searching-empty-hostnames.patch b/gnu/packages/patches/libevent-2.0-evdns-fix-searching-empty-hostnames.patch new file mode 100644 index 0000000000..c4ad0a1a4a --- /dev/null +++ b/gnu/packages/patches/libevent-2.0-evdns-fix-searching-empty-hostnames.patch @@ -0,0 +1,40 @@ +Fix OOB read on empty hostnames in evdns. + +Upstream bug report: + +https://github.com/libevent/libevent/issues/332 + +Patch copied from upstream source repository: + +https://github.com/libevent/libevent/commit/ec65c42052d95d2c23d1d837136d1cf1d9ecef9e + +From a0305cec166a5bc89f1eb362510cc4cd25ecc0bc Mon Sep 17 00:00:00 2001 +From: Azat Khuzhin <a3at.mail@gmail.com> +Date: Fri, 25 Mar 2016 00:33:47 +0300 +Subject: [PATCH] evdns: fix searching empty hostnames + +--- + evdns.c | 5 ++++- + 1 file changed, 4 insertions(+), 1 deletion(-) + +diff --git a/evdns.c b/evdns.c +index 137c24ea..6191c677 100644 +--- a/evdns.c ++++ b/evdns.c +@@ -3122,9 +3122,12 @@ search_set_from_hostname(struct evdns_base *base) { + static char * + search_make_new(const struct search_state *const state, int n, const char *const base_name) { + const size_t base_len = strlen(base_name); +- const char need_to_append_dot = base_name[base_len - 1] == '.' ? 0 : 1; ++ char need_to_append_dot; + struct search_domain *dom; + ++ if (!base_len) return NULL; ++ need_to_append_dot = base_name[base_len - 1] == '.' ? 0 : 1; ++ + for (dom = state->head; dom; dom = dom->next) { + if (!n--) { + /* this is the postfix we want */ +-- +2.11.0 + diff --git a/gnu/packages/patches/libevent-2.0-evutil-fix-buffer-overflow.patch b/gnu/packages/patches/libevent-2.0-evutil-fix-buffer-overflow.patch new file mode 100644 index 0000000000..4d16a4b917 --- /dev/null +++ b/gnu/packages/patches/libevent-2.0-evutil-fix-buffer-overflow.patch @@ -0,0 +1,42 @@ +Fix buffer overflow in evutil. + +Upstream bug report: + +https://github.com/libevent/libevent/issues/318 + +Patch copied from upstream source repository: + +https://github.com/libevent/libevent/commit/329acc18a0768c21ba22522f01a5c7f46cacc4d5 + +From 28bdc2f3f62259d21ccaf7be2b60ef0a53e6f342 Mon Sep 17 00:00:00 2001 +From: Azat Khuzhin <a3at.mail@gmail.com> +Date: Sun, 31 Jan 2016 00:57:16 +0300 +Subject: [PATCH] evutil_parse_sockaddr_port(): fix buffer overflow + +--- + evutil.c | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/evutil.c b/evutil.c +index 33445170..e2dfe6e4 100644 +--- a/evutil.c ++++ b/evutil.c +@@ -1808,12 +1808,12 @@ evutil_parse_sockaddr_port(const char *ip_as_string, struct sockaddr *out, int * + + cp = strchr(ip_as_string, ':'); + if (*ip_as_string == '[') { +- int len; ++ size_t len; + if (!(cp = strchr(ip_as_string, ']'))) { + return -1; + } +- len = (int) ( cp-(ip_as_string + 1) ); +- if (len > (int)sizeof(buf)-1) { ++ len = ( cp-(ip_as_string + 1) ); ++ if (len > sizeof(buf)-1) { + return -1; + } + memcpy(buf, ip_as_string+1, len); +-- +2.11.0 + diff --git a/gnu/packages/patches/libevent-2.1-dns-tests.patch b/gnu/packages/patches/libevent-2.1-dns-tests.patch new file mode 100644 index 0000000000..091752a49d --- /dev/null +++ b/gnu/packages/patches/libevent-2.1-dns-tests.patch @@ -0,0 +1,26 @@ +Disable tests that rely on usable DNS lookups, which aren't available +in build chroots. + +--- libevent-2.0.21-stable/test/regress_dns.c 2013-01-20 22:32:09.000000000 +0100 ++++ libevent-2.0.21-stable/test/regress_dns.c 2013-01-20 22:32:30.000000000 +0100 +@@ -2120,10 +2120,6 @@ + + struct testcase_t dns_testcases[] = { + DNS_LEGACY(server, TT_FORK|TT_NEED_BASE), +- DNS_LEGACY(gethostbyname, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT), +- DNS_LEGACY(gethostbyname6, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT), +- DNS_LEGACY(gethostbyaddr, TT_FORK|TT_NEED_BASE|TT_NEED_DNS|TT_OFF_BY_DEFAULT), +- { "resolve_reverse", dns_resolve_reverse, TT_FORK|TT_OFF_BY_DEFAULT, NULL, NULL }, + { "search_empty", dns_search_empty_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL }, + { "search", dns_search_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL }, + { "search_lower", dns_search_lower_test, TT_FORK|TT_NEED_BASE, &basic_setup, NULL }, +@@ -2163,9 +2159,6 @@ + + { "client_fail_requests", dns_client_fail_requests_test, + TT_FORK|TT_NEED_BASE, &basic_setup, NULL }, +- { "client_fail_requests_getaddrinfo", +- dns_client_fail_requests_getaddrinfo_test, +- TT_FORK|TT_NEED_BASE, &basic_setup, NULL }, + + END_OF_TESTCASES + }; diff --git a/gnu/packages/patches/libevent-2.1-skip-failing-test.patch b/gnu/packages/patches/libevent-2.1-skip-failing-test.patch new file mode 100644 index 0000000000..d9ea1d422d --- /dev/null +++ b/gnu/packages/patches/libevent-2.1-skip-failing-test.patch @@ -0,0 +1,24 @@ +These fail on 32-bit due to an overflow bug in the test program. + +See test/regress_util.c:1448. + +Upstream bug URL: + +https://github.com/libevent/libevent/issues/452 + +diff --git a/test/regress_util.c b/test/regress_util.c +index ef6a1487..4de501fc 100644 +--- a/test/regress_util.c ++++ b/test/regress_util.c +@@ -1413,9 +1413,9 @@ static struct date_rfc1123_case { + { 1323648000, "Mon, 12 Dec 2011 00:00:00 GMT"}, + #ifndef _WIN32 + /** In win32 case we have max "23:59:59 January 18, 2038, UTC" for time32 */ +- { 4294967296, "Sun, 07 Feb 2106 06:28:16 GMT"} /* 2^32 */, ++ //{ 4294967296, "Sun, 07 Feb 2106 06:28:16 GMT"} /* 2^32 */, + /** In win32 case we have max "23:59:59, December 31, 3000, UTC" for time64 */ +- {253402300799, "Fri, 31 Dec 9999 23:59:59 GMT"} /* long long future no one can imagine */, ++ //{253402300799, "Fri, 31 Dec 9999 23:59:59 GMT"} /* long long future no one can imagine */, + { 1456704000, "Mon, 29 Feb 2016 00:00:00 GMT"} /* leap year */, + #endif + { 1435708800, "Wed, 01 Jul 2015 00:00:00 GMT"} /* leap second */, diff --git a/gnu/packages/patches/omake-fix-non-determinism.patch b/gnu/packages/patches/omake-fix-non-determinism.patch new file mode 100644 index 0000000000..813ce3cd7d --- /dev/null +++ b/gnu/packages/patches/omake-fix-non-determinism.patch @@ -0,0 +1,41 @@ +From 2e7e254160506dc00f1beabf170512a8e932934b Mon Sep 17 00:00:00 2001 +From: Julien Lepiller <julien@lepiller.eu> +Date: Sat, 31 Dec 2016 15:43:38 +0100 +Subject: [PATCH] fix build date in binary + +--- + src/magic/omake_gen_magic.ml | 12 ++---------- + 1 file changed, 2 insertions(+), 10 deletions(-) + +diff --git a/src/magic/omake_gen_magic.ml b/src/magic/omake_gen_magic.ml +index b2419ba..fad52f5 100644 +--- a/src/magic/omake_gen_magic.ml ++++ b/src/magic/omake_gen_magic.ml +@@ -150,7 +150,7 @@ let ir_magic = "%s" + let obj_magic = "%s" + let lib_dir = "%s" + let version = "%s" +-let version_message = "OMake %s:\\n\\tbuild [%s %s %d %02d:%02d:%02d %d]\\n\\ton %s" ++let version_message = "OMake %s" + |} + default_save_interval + digest_len +@@ -160,15 +160,7 @@ let version_message = "OMake %s:\\n\\tbuild [%s %s %d %02d:%02d:%02d %d]\\n\\ton + (digest_files ".omo.magic" ".omo" omo_files) + (String.escaped libdir) + (String.escaped (shorten_version version)) +- (String.escaped version) +- [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|].(tm.tm_wday) +- [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|].(tm.tm_mon) +- tm.tm_mday +- tm.tm_hour +- tm.tm_min +- tm.tm_sec +- (tm.tm_year + 1900) +- (String.escaped (Unix.gethostname ())); ++ (String.escaped version); + List.iter + (fun (name,value) -> + Printf.fprintf buf "let %s = %S\n" name value +-- +2.11.0 diff --git a/gnu/packages/patches/xinetd-CVE-2013-4342.patch b/gnu/packages/patches/xinetd-CVE-2013-4342.patch new file mode 100644 index 0000000000..ad57bc7b0e --- /dev/null +++ b/gnu/packages/patches/xinetd-CVE-2013-4342.patch @@ -0,0 +1,36 @@ +Fix CVE-2013-4342: + +https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2013-4342 +https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=324678 + +Patch copied from upstream source repository: + +https://github.com/xinetd-org/xinetd/commit/91e2401a219121eae15244a6b25d2e79c1af5864 + +From 91e2401a219121eae15244a6b25d2e79c1af5864 Mon Sep 17 00:00:00 2001 +From: Thomas Swan <thomas.swan@gmail.com> +Date: Wed, 2 Oct 2013 23:17:17 -0500 +Subject: [PATCH] CVE-2013-4342: xinetd: ignores user and group directives for + TCPMUX services + +Originally reported to Debian in 2005 <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=324678> and rediscovered <https://bugzilla.redhat.com/show_bug.cgi?id=1006100>, xinetd would execute TCPMUX services without dropping privilege to match the service configuration allowing the service to run with same privilege as the xinetd process (root). +--- + xinetd/builtins.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/xinetd/builtins.c b/xinetd/builtins.c +index 3b85579..34a5bac 100644 +--- a/xinetd/builtins.c ++++ b/xinetd/builtins.c +@@ -617,7 +617,7 @@ static void tcpmux_handler( const struct server *serp ) + if( SC_IS_INTERNAL( scp ) ) { + SC_INTERNAL(scp, nserp); + } else { +- exec_server(nserp); ++ child_process(nserp); + } + } + +-- +2.7.4 + diff --git a/gnu/packages/patches/xinetd-fix-fd-leak.patch b/gnu/packages/patches/xinetd-fix-fd-leak.patch new file mode 100644 index 0000000000..77e4600185 --- /dev/null +++ b/gnu/packages/patches/xinetd-fix-fd-leak.patch @@ -0,0 +1,26 @@ +Fix a file descriptor leak: + +https://github.com/xinetd-org/xinetd/issues/23 + +Patch copied from Debian: + +https://anonscm.debian.org/cgit/collab-maint/xinetd.git/tree/debian/patches/000012-fix_fd_leak + +Patch sent upstream at https://github.com/xinetd-org/xinetd/pull/26. + +diff --git a/xinetd/xgetloadavg.c b/xinetd/xgetloadavg.c +index 5a26214..fe0f872 100644 +--- a/xinetd/xgetloadavg.c ++++ b/xinetd/xgetloadavg.c +@@ -34,7 +34,7 @@ double xgetloadavg(void) + + if( fscanf(fd, "%lf", &ret) != 1 ) { + perror("fscanf"); +- return -1; ++ ret = -1; + } + + fclose(fd); +-- +2.7.4 + diff --git a/gnu/packages/plotutils.scm b/gnu/packages/plotutils.scm index 74d209192f..bf993c66a7 100644 --- a/gnu/packages/plotutils.scm +++ b/gnu/packages/plotutils.scm @@ -173,14 +173,14 @@ colors, styles, options and details.") (define-public asymptote (package (name "asymptote") - (version "2.38") + (version "2.39") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/asymptote/" version "/asymptote-" version ".src.tgz")) (sha256 (base32 - "1dxwvq0xighqckkjkjva8s0igxfgy1j25z81pbwvlz6jzsrxpip9")))) + "187q81yw06x4gv2spfn0hcs1064ym3a8l6mdgawymfhqd60yhrs3")))) (build-system gnu-build-system) ;; Note: The 'asy' binary retains a reference to docdir for use with its ;; "help" command in interactive mode, so adding a "doc" output is not diff --git a/gnu/packages/polkit.scm b/gnu/packages/polkit.scm index e224ca22f3..0e38dd61ee 100644 --- a/gnu/packages/polkit.scm +++ b/gnu/packages/polkit.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,6 +29,7 @@ #:use-module (gnu packages) #:use-module (gnu packages freedesktop) #:use-module (gnu packages glib) + #:use-module (gnu packages gtk) #:use-module (gnu packages gnuzilla) #:use-module (gnu packages linux) #:use-module (gnu packages perl) @@ -159,3 +161,27 @@ PolicyKit API through a Qt-styled API. It is mainly a wrapper around QAction and QAbstractButton that lets you integrate those two component easily with PolicyKit.") (license lgpl2.0+))) + +(define-public polkit-gnome + (package + (name "polkit-gnome") + (version "0.105") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" + name "/" version "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0sckmcbxyj6sbrnfc5p5lnw27ccghsid6v6wxq09mgxqcd4lk10p")))) + (build-system gnu-build-system) + (inputs `(("gtk+" ,gtk+) + ("polkit" ,polkit))) + (native-inputs `(("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (synopsis "Legacy polkit authentication agent for GNOME") + (description "PolicyKit-gnome provides a D-Bus session bus service +that is used to bring up authentication dialogs used for obtaining +privileges.") + (home-page "http://www.freedesktop.org/wiki/Software/polkit/") + (license lgpl2.0+))) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 91e4d5675d..b93ab5ee78 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -2095,14 +2095,14 @@ protocol.") (define python-pbr-minimal (package (name "python-pbr-minimal") - (version "1.8.1") + (version "1.10.0") (source (origin (method url-fetch) (uri (pypi-uri "pbr" version)) (sha256 (base32 - "0jcny36cf3s8ar5r4a575npz080hndnrfs4np1fqhv0ym4k7c4p2")))) + "177kd9kbv1hvf2ban7l3x9ymzbi1md4hkaymwbgnz7ihf312hr0q")))) (build-system python-build-system) (arguments `(#:tests? #f)) @@ -2350,16 +2350,15 @@ files.") (define-public python-certifi (package (name "python-certifi") - (version "2016.8.31") + (version "2017.1.23") (source (origin (method url-fetch) (uri (pypi-uri "certifi" version)) (sha256 (base32 - "06c9dcyv8ss050gkv5xjivbxhm6qm0s9vzy4r33wqabgv118lw7p")))) + "1klrzl3hgvcf2mjk00g0k3kk1p2z27vzwnxivwar4vhjmjvpz1w1")))) (build-system python-build-system) - (arguments `(#:tests? #f)) ; no tests - (home-page "http://python-requests.org/") + (home-page "https://certifi.io/") (synopsis "Python CA certificate bundle") (description "Certifi is a Python library that contains a CA certificate bundle, which @@ -2407,14 +2406,14 @@ with sensible defaults out of the box.") (define-public python-wheel (package (name "python-wheel") - (version "0.29.0") + (version "0.30.0a0") (source (origin (method url-fetch) (uri (pypi-uri "wheel" version)) (sha256 (base32 - "0j0n38hg1jvrmyy68f9ikvzq1gs9g0sx4ws7maf8wi3bwbbqmfqy")))) + "1nm6mn8isny0hr86rhbfrpfj867c0phf001xgsd69xfp9ady1wwq")))) (build-system python-build-system) (native-inputs `(("python-jsonschema" ,python-jsonschema) @@ -3161,15 +3160,13 @@ mining and data analysis.") (define-public python-redis (package (name "python-redis") - (version "2.10.3") + (version "2.10.5") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/r/redis/redis-" - version ".tar.gz")) + (uri (pypi-uri "redis" version)) (sha256 - (base32 "1701qjwn4n05q90fdg4bsg96s27xf5s4hsb4gxhv3xk052q3gyx4")))) + (base32 "0csmrkxb29x7xs9b51zplwkkq2hwnbh9jns1g85dykn5rxmaxysx")))) (build-system python-build-system) ;; Tests require a running Redis server (arguments '(#:tests? #f)) @@ -6003,10 +6000,7 @@ complexity of Python source code.") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/m/mistune/mistune-" - version - ".tar.gz")) + (uri (pypi-uri "mistune" version)) (sha256 (base32 "04xpk1zvslhq3xpnf01g3ag0dy9wfv4z28p093r8k49vvxlyil11")))) @@ -8766,14 +8760,14 @@ interface to the Amazon Web Services (AWS) API.") (define-public awscli (package (name "awscli") - (version "1.11.35") + (version "1.11.43") (source (origin (method url-fetch) (uri (pypi-uri name version)) (sha256 (base32 - "0k6y8cg311bqak5x9pilg80w6f76dcbzm6xcdrw6rjnk6v4xwy70")))) + "1x94jmy8ygld8g4pf35zdankh4dx8g8qn3q9j3hrbawqw0vkrp3y")))) (build-system python-build-system) (propagated-inputs `(("python-colorama" ,python-colorama) @@ -8787,7 +8781,7 @@ interface to the Amazon Web Services (AWS) API.") ("python-sphinx" ,python-sphinx) ("python-tox" ,python-tox) ("python-wheel" ,python-wheel))) - (home-page "http://aws.amazon.com/cli/") + (home-page "https://aws.amazon.com/cli/") (synopsis "Command line client for AWS") (description "AWS CLI provides a unified command line interface to the Amazon Web Services (AWS) API.") @@ -8862,7 +8856,21 @@ normally the case.") "1vqh1n5yy5dhnq312kwrl90fnck4v26is3lq3lxdvcn60vv19da0")))) (build-system python-build-system) (arguments - `(#:tests? #f)) ; no tests provided + '(#:phases + (modify-phases %standard-phases + (add-before 'install 'patch-libxdo-path + ;; Hardcode the path of dynamically loaded libxdo library. + (lambda* (#:key inputs #:allow-other-keys) + (let ((libxdo (string-append + (assoc-ref inputs "xdotool") + "/lib/libxdo.so"))) + (substitute* "xdo/_xdo.py" + (("find_library\\(\"xdo\"\\)") + (simple-format #f "\"~a\"" libxdo))) + #t)))) + #:tests? #f)) ; no tests provided + (propagated-inputs + `(("python-six" ,python-six))) (inputs `(("xdotool" ,xdotool) ("libX11" ,libx11))) @@ -10998,14 +11006,14 @@ provide an easy-to-use Python interface for building OAuth1 and OAuth2 clients." (define-public python-stem (package (name "python-stem") - (version "1.5.3") + (version "1.5.4") (source (origin (method url-fetch) (uri (pypi-uri "stem" version)) (sha256 (base32 - "0fm67dfx6qaj0mg80r4yw2i72birpzn7cnbyz4p1857max3zfc97")))) + "1j7pnblrn0yr6jmxvsq6y0ihmxmj5x50jl2n2606w67f6wq16j9n")))) (build-system python-build-system) (arguments `(#:phases diff --git a/gnu/packages/regex.scm b/gnu/packages/regex.scm index a2bd2390c6..f04cba706d 100644 --- a/gnu/packages/regex.scm +++ b/gnu/packages/regex.scm @@ -27,7 +27,7 @@ (define-public re2 (package (name "re2") - (version "2016-11-01") + (version "2017-01-01") (source (origin (method url-fetch) (uri @@ -37,7 +37,7 @@ (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "0scn3rimfxz0kqxxasap04kv9cbzjsgi7krkqmyhbi710fgr9vh1")))) + "0yij1ajh66h3pj3kfz7y0ldrsww8rlpjzaavyr5lchl98as1jq74")))) (build-system gnu-build-system) (arguments `(#:test-target "test" @@ -50,7 +50,8 @@ (lambda* (#:key outputs #:allow-other-keys) ;; No make target for shared-only; delete the static version. (delete-file (string-append (assoc-ref outputs "out") - "/lib/libre2.a"))))))) + "/lib/libre2.a")) + #t))))) (home-page "https://github.com/google/re2") (synopsis "Fast, safe, thread-friendly regular expression engine") (description "RE2 is a fast, safe, thread-friendly alternative to diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 0f1ecd29d0..abb3b0e4fa 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -426,13 +426,13 @@ expectations and mocks frameworks.") (define-public bundler (package (name "bundler") - (version "1.14.2") + (version "1.14.3") (source (origin (method url-fetch) (uri (rubygems-uri "bundler" version)) (sha256 (base32 - "1sfcmqmimssjmh4gjq6ls6a33l2hc353hb13g628kjh15qmddar7")))) + "1znvh83phzvp97l3kcgk9vbwsnq45qc8nrb4dnqv17mrhgcwfqcx")))) (build-system ruby-build-system) (arguments '(#:tests? #f)) ; avoid dependency cycles @@ -1859,25 +1859,31 @@ generation of complex SQL queries and is compatible with various RDBMSes.") (license license:expat))) (define-public ruby-minitar - (package - (name "ruby-minitar") - (version "0.5.4") - (source - (origin - (method url-fetch) - (uri (rubygems-uri "minitar" version)) - (sha256 - (base32 - "1vpdjfmdq1yc4i620frfp9af02ia435dnpj8ybsd7dc3rypkvbka")))) - (build-system ruby-build-system) - (arguments - '(#:tests? #f)) ; missing a gemspec - (synopsis "Ruby library and utility for handling tar archives") - (description - "Archive::Tar::Minitar is a pure-Ruby library and command-line utility + ;; We package from the GitHub source to fix the security issue reported at + ;; https://github.com/halostatue/minitar/issues/16. + (let ((commit "e25205ecbb6277ae8a3df1e6a306d7ed4458b6e4")) + (package + (name "ruby-minitar") + (version (string-append "0.5.4-1." (string-take commit 8))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/halostatue/minitar.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1iywfx07jgjqcmixzkxk9zdwfmij1fyg1z2jlwzj15cj7s99qlfv")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; missing a gemspec + (synopsis "Ruby library and utility for handling tar archives") + (description + "Archive::Tar::Minitar is a pure-Ruby library and command-line utility that provides the ability to deal with POSIX tar archive files.") - (home-page "http://www.github.com/atoulme/minitar") - (license (list license:gpl2+ license:ruby)))) + (home-page "http://www.github.com/atoulme/minitar") + (license (list license:gpl2+ license:ruby))))) (define-public ruby-mini-portile (package diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 2756805f3d..1210ab526b 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -604,7 +604,6 @@ threads.") (snippet ;; Remove binary code '(delete-file-recursively "scmutils/mit-scheme")) - (file-name (string-append name "-" version ".tar.gz")) (uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/6946" "/scmutils-tarballs/" name "-" version "-x86-64-gnu-linux.tar.gz")) diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm index e2342266d6..f687cb0a2a 100644 --- a/gnu/packages/search.scm +++ b/gnu/packages/search.scm @@ -36,13 +36,13 @@ (define-public xapian (package (name "xapian") - (version "1.4.2") + (version "1.4.3") (source (origin (method url-fetch) (uri (string-append "https://oligarchy.co.uk/xapian/" version "/xapian-core-" version ".tar.xz")) (sha256 - (base32 "1kp18r97qm2zky9z6ym8csjg1kj81zvqn88n4cppl4lq54sw9hmf")))) + (base32 "0xg444bnxikqnxs31wsv930mvpwk4dm5zrr979371pm23i8ralkx")))) (build-system gnu-build-system) (inputs `(("zlib" ,zlib) ("util-linux" ,util-linux))) diff --git a/gnu/packages/serialization.scm b/gnu/packages/serialization.scm index 8db81c581c..9e073b7a98 100644 --- a/gnu/packages/serialization.scm +++ b/gnu/packages/serialization.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Lukas Gradl <lgradl@openmailbox.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> @@ -24,6 +24,7 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix utils) #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages) @@ -32,6 +33,7 @@ #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages documentation) + #:use-module (gnu packages lua) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python)) @@ -129,6 +131,88 @@ such as compact binary encodings, XML, or JSON.") serialization.") (license license:boost1.0))) +(define-public libmpack + (package + (name "libmpack") + (version "1.0.3") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/tarruda/libmpack/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 "08kfdl55yf66xk57aqsbf8n45f2jsw2v7qwnaan08ciim77j3sv5")))) + (build-system gnu-build-system) + (arguments + `(#:test-target "test" + #:make-flags + (list "CC=gcc" + (string-append "PREFIX=" (assoc-ref %outputs "out"))) + #:phases + (modify-phases %standard-phases + (delete 'configure)))) + (native-inputs + `(("libtool" ,libtool))) + (home-page "https://github.com/tarruda/libmpack") + (synopsis "Small binary serialization library") + (description "Libmpack is a small binary serialization and RPC library +that implements both the msgpack and msgpack-rpc specifications.") + (license license:expat))) + +(define-public lua-libmpack + (package (inherit libmpack) + (name "lua-libmpack") + (build-system gnu-build-system) + (arguments + `(;; FIXME: tests require "busted", which is not yet available in Guix. + #:tests? #f + #:test-target "test" + #:make-flags + (let* ((lua-version ,(package-version lua)) + (lua-major+minor ,(version-major+minor (package-version lua)))) + (list "CC=gcc" + "USE_SYSTEM_LUA=yes" + (string-append "LUA_VERSION=" lua-version) + (string-append "LUA_VERSION_MAJ_MIN=" lua-major+minor) + (string-append "PREFIX=" + (assoc-ref %outputs "out")) + (string-append "LUA_CMOD_INSTALLDIR=" + (assoc-ref %outputs "out") + "/lib/lua/" lua-major+minor) + ;; This is unnecessary as of upstream commit 02886c13ff8a2, + ;; which is not part of the current release. + "CFLAGS=-DLUA_C89_NUMBERS -fPIC")) + #:phases + (modify-phases %standard-phases + (delete 'configure) + (add-after 'unpack 'chdir + (lambda _ (chdir "binding/lua") #t))))) + (inputs + `(("lua" ,lua))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (synopsis "Lua bindings for the libmpack binary serialization library"))) + +(define-public lua5.2-libmpack + (package (inherit lua-libmpack) + (name "lua5.2-libmpack") + (arguments + (substitute-keyword-arguments (package-arguments lua-libmpack) + ((#:make-flags flags) + `(let* ((lua-version ,(package-version lua-5.2)) + (lua-major+minor ,(version-major+minor (package-version lua-5.2)))) + (list "CC=gcc" + "USE_SYSTEM_LUA=yes" + (string-append "LUA_VERSION=" lua-version) + (string-append "LUA_VERSION_MAJ_MIN=" lua-major+minor) + (string-append "PREFIX=" + (assoc-ref %outputs "out")) + (string-append "LUA_CMOD_INSTALLDIR=" + (assoc-ref %outputs "out") + "/lib/lua/" lua-major+minor)))))) + (inputs + `(("lua" ,lua-5.2))))) + (define-public yaml-cpp (package (name "yaml-cpp") diff --git a/gnu/packages/telephony.scm b/gnu/packages/telephony.scm index 2adf08ce97..c393caace8 100644 --- a/gnu/packages/telephony.scm +++ b/gnu/packages/telephony.scm @@ -318,14 +318,14 @@ address of one of the participants.") (define-public mumble (package (name "mumble") - (version "1.2.18") + (version "1.2.19") (source (origin (method url-fetch) (uri (string-append "https://mumble.info/snapshot/" name "-" version ".tar.gz")) (sha256 (base32 - "1ajmdzf2jqbnm4hm53wv8bzazffflzs3z8hhbl70kfci4v4arxz0")) + "1s60vaici3v034jzzi20x23hsj6mkjlc0glipjq4hffrg9qgnizh")) (modules '((guix build utils))) (snippet `(begin diff --git a/gnu/packages/text-editors.scm b/gnu/packages/text-editors.scm index 4e2324dbea..4b6aa07ee8 100644 --- a/gnu/packages/text-editors.scm +++ b/gnu/packages/text-editors.scm @@ -1,5 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 José Miguel Sánchez García <jmi2k@openmailbox.org> +;;; Copyright © 2016 Carlo Zancanaro <carlo@zancanaro.id.au> +;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,13 +21,19 @@ (define-module (gnu packages text-editors) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix utils) #:use-module (guix build-system gnu) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) + #:use-module (gnu packages boost) + #:use-module (gnu packages documentation) + #:use-module (gnu packages gcc) #:use-module (gnu packages lua) #:use-module (gnu packages ncurses) - #:use-module (gnu packages terminals)) + #:use-module (gnu packages ruby) + #:use-module (gnu packages terminals) + #:use-module (gnu packages xml)) (define-public vis (package @@ -75,3 +83,95 @@ based command language.") (license (list license:isc ; Main distribution. license:public-domain ; map.[ch] license:expat)))) ; lexers and libutf.[ch] + +(define-public kakoune + (let ((commit "125c8b7e80995732e0d8c87b82040025748f1b4f") + (revision "1")) + (package + (name "kakoune") + (version (string-append "0.0.0-" revision "." (string-take commit 7))) + (source + (origin + (file-name (string-append "kakoune-" version "-checkout")) + (method git-fetch) + (uri (git-reference + (url "https://github.com/mawww/kakoune.git") + (commit commit))) + (sha256 + (base32 + "19qs99l8r9p1vi5pxxx9an22fvi7xx40qw3jh2cnh2mbacawvdyb")) + (modules '((guix build utils))) + (snippet + ;; Kakoune uses 'gzip' to compress its manpages. Make sure + ;; timestamps are not preserved for reproducibility. + '(begin + (substitute* "src/Makefile" + (("gzip -f") "gzip -f --no-name")) + #t)))) + (build-system gnu-build-system) + (arguments + `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")) + ;; Boost is compiled with the older ABI, so we can't use + ;; the new ABI if we want to link againt it. + "CPPFLAGS=-D_GLIBCXX_USE_CXX11_ABI=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-source + (lambda _ + ;; kakoune uses confstr with _CS_PATH to find out where to find + ;; a posix shell, but this doesn't work in the build + ;; environment. This substitution just replaces that result + ;; with the "sh" path. + (substitute* "src/shell_manager.cc" + (("if \\(m_shell.empty\\(\\)\\)" line) + (string-append "m_shell = \"" (which "sh") + "\";\n " line))) + #t)) + (delete 'configure) + ;; kakoune requires us to be in the src/ directory to build + (add-before 'build 'chdir + (lambda _ (chdir "src") #t)) + (add-before 'check 'fix-test-permissions + (lambda _ + ;; Out git downloader doesn't give us write permissions, but + ;; without them the tests fail. + (zero? (system* "chmod" "-R" "u+w" "../test"))))))) + (native-inputs `(("gcc" ,gcc-5) + ("libxslt" ,libxslt) + ("asciidoc" ,asciidoc) + ("ruby" ,ruby))) + (inputs `(("gcc:lib" ,gcc-5 "lib") + ("ncurses" ,ncurses) + ("boost" ,boost))) + (synopsis "Vim-inspired code editor") + (description + "Kakoune is a code editor heavily inspired by Vim, as such most of its +commands are similar to Vi's ones, and it shares Vi's \"keystrokes as a text +editing language\" model. Kakoune has a strong focus on interactivity, most +commands provide immediate and incremental results, while still being +competitive (as in keystroke count) with Vim.") + (home-page "http://kakoune.org/") + (license license:unlicense)))) + +(define-public joe + (package + (name "joe") + (version "4.4") + (source + (origin + (method url-fetch) + (uri (string-append "https://sourceforge.net/projects/joe-editor/" + "files/JOE sources/joe-" version "/" + "joe-" version ".tar.gz")) + (sha256 + (base32 + "0y898r1xlrv75m00y598rvwwsricabplyh80wawsqafapcl4hw55")))) + (build-system gnu-build-system) + (inputs `(("ncurses" ,ncurses))) + (home-page "http://joe-editor.sourceforge.net/") + (synopsis "Console screen editor") + (description + "JOE is a powerful console screen editor with a \"mode-less\" user +interface similar to many user-friendly editors. JOE has some of the key +bindings and many of the powerful features of GNU Emacs.") + (license license:gpl3+))) diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index f02a072a24..84865a31cf 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -229,6 +229,7 @@ required structures.") (define-public openssl (package (name "openssl") + (replacement openssl-1.0.2k) (version "1.0.2j") (source (origin (method url-fetch) @@ -365,11 +366,31 @@ required structures.") (license license:openssl) (home-page "http://www.openssl.org/"))) +(define openssl-1.0.2k + (package + (inherit openssl) + (name "openssl") + (version "1.0.2k") + (source + (origin + (method url-fetch) + (uri (list (string-append "ftp://ftp.openssl.org/source/" + name "-" version ".tar.gz") + (string-append "ftp://ftp.openssl.org/source/old/" + (string-trim-right version char-set:letter) + "/" name "-" version ".tar.gz"))) + (sha256 + (base32 + "1h6qi35w6hv6rd73p4cdgdzg732pdrfgpp37cgwz1v9a3z37ffbb")) + (patches (search-patches "openssl-runpath.patch" + "openssl-c-rehash-in.patch")))))) + (define-public openssl-next (package (inherit openssl) + (replacement #f) (name "openssl") - (version "1.1.0c") + (version "1.1.0d") (source (origin (method url-fetch) (uri (list (string-append "ftp://ftp.openssl.org/source/" @@ -380,7 +401,7 @@ required structures.") (patches (search-patches "openssl-1.1.0-c-rehash-in.patch")) (sha256 (base32 - "1xfn5ydl14myd9wgxm4nxy5a42cpp1g12ijf3g9m4mz0l90n8hzw")))) + "1pv0zql3r73qpjini90hn29l28d65b7i777zav0larbmi6gbnpkx")))) (outputs '("out" "doc" ;1.3MiB of man3 pages "static")) ; 5.5MiB of .a files @@ -469,13 +490,13 @@ security, and applying best practice development processes.") (define-public python-acme (package (name "python-acme") - (version "0.10.1") + (version "0.10.2") (source (origin (method url-fetch) (uri (pypi-uri "acme" version)) (sha256 (base32 - "04d2464klbhvrsrlmca10qxyd968qz7xizdppr53cihnlfq2y77m")))) + "0y6y8d66yvwdcby96g0dlqqwy72b81yh6hws4va8r7w4aribcrb4")))) (build-system python-build-system) (arguments `(#:phases @@ -518,13 +539,13 @@ security, and applying best practice development processes.") (define-public certbot (package (name "certbot") - (version "0.10.1") + (version "0.10.2") (source (origin (method url-fetch) (uri (pypi-uri name version)) (sha256 (base32 - "0hx71ba7w8kf8hpg1wy5zf8ggczb57g3kcsdg83kxjpqnfnrkmp0")))) + "0c8nidbbq8p4rjhcrw31saw04n5rz4zgr08chbch17gw03hrqwik")))) (build-system python-build-system) (arguments `(#:python ,python-2 @@ -567,9 +588,10 @@ security, and applying best practice development processes.") ("python2-requests" ,python2-requests) ("python2-pytz" ,python2-pytz))) (synopsis "Let's Encrypt client by the Electronic Frontier Foundation") - (description "Tool to automatically receive and install X.509 certificates -to enable TLS on servers. The client will interoperate with the Let’s Encrypt CA which -will be issuing browser-trusted certificates for free.") + (description "Certbot automatically receives and installs X.509 certificates +to enable Transport Layer Security (TLS) on servers. It interoperates with the +Let’s Encrypt certificate authority (CA), which issues browser-trusted +certificates for free.") (home-page "https://certbot.eff.org/") (license license:asl2.0))) @@ -714,7 +736,7 @@ number generator") (define-public acme-client (package (name "acme-client") - (version "0.1.15") + (version "0.1.16") (source (origin (method url-fetch) (uri (string-append "https://kristaps.bsd.lv/" name "/" @@ -722,7 +744,7 @@ number generator") version ".tgz")) (sha256 (base32 - "07p723391whrswl4rir0l1k03l457sjscnj0cfaxr8mfnkx4y3wi")))) + "00q05b3b1dfnfp7sr1nbd212n0mqrycl3cr9lbs51m7ncaihbrz9")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; no test suite diff --git a/gnu/packages/tor.scm b/gnu/packages/tor.scm index c7f97ab1b4..9339dcdd70 100644 --- a/gnu/packages/tor.scm +++ b/gnu/packages/tor.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net> +;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages tor) - #:use-module ((guix licenses) #:select (bsd-3 gpl3+ gpl2+ gpl2)) + #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) @@ -48,6 +49,10 @@ (base32 "0hqdk5p6dw4bpn7c8gmhyi8jjkhc37112pfw5nx4gl0g4lmmscik")))) (build-system gnu-build-system) + (arguments + `(#:configure-flags (list "--enable-expensive-hardening" + "--enable-gcc-hardening" + "--enable-linker-hardening"))) (native-inputs `(("python" ,python-2))) ; for tests (inputs @@ -69,7 +74,7 @@ To @code{torify} applications (to take measures to ensure that an application, which has not been designed for use with Tor such as ssh, will use only Tor for internet connectivity, and also ensures that there are no leaks from DNS, UDP or the application layer) you need to install @code{torsocks}.") - (license bsd-3))) + (license license:bsd-3))) (define-public torsocks (package @@ -91,7 +96,7 @@ way with Tor. It ensures that DNS requests are handled safely and explicitly rejects UDP traffic from the application you're using.") ;; All the files explicitly say "version 2 only". - (license gpl2))) + (license license:gpl2))) (define-public privoxy (package @@ -135,7 +140,7 @@ access, and removing ads and other obnoxious Internet junk. Privoxy has a flexible configuration and can be customized to suit individual needs and tastes. It has application for both stand-alone systems and multi-user networks.") - (license gpl2+))) + (license license:gpl2+))) (define-public onionshare (package @@ -221,5 +226,68 @@ using a third party filesharing service. You host the file on your own computer and use a Tor hidden service to make it temporarily accessible over the internet. The other user just needs to use Tor Browser to download the file from you.") - (license (list gpl3+ - bsd-3)))) ; onionshare/socks.py + (license (list license:gpl3+ + license:bsd-3)))) ; onionshare/socks.py + +(define-public nyx + ;; The last ‘arm’ relase was 5 years ago. Meanwhile, python3 support has + ;; been added and the software was renamed to ‘nyx’. + (let ((commit "fea209127484d9b304b908a4711c9528b1d065bc") + (revision "1")) ; Guix package revision + (package + (name "nyx") + (version (string-append "1.9-" + revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (file-name (string-append name "-" version "-checkout")) + (uri (git-reference + (url "https://git.torproject.org/nyx.git") + (commit commit))) + (sha256 + (base32 + "1g0l4988076xg5gs0x0nxzlg58rfx5g5agmklvyh4yp03vxncdb9")))) + (build-system python-build-system) + (native-inputs + `(("python-mock" ,python-mock) + ("python-pep8" ,python-pep8) + ("python-pyflakes" ,python-pyflakes))) + (inputs + `(("python-stem" ,python-stem))) + (arguments + `(#:configure-flags + (list (string-append "--man-page=" + (assoc-ref %outputs "out") + "/share/man/man1/nyx.1") + (string-append "--sample-path=" + (assoc-ref %outputs "out") + "/share/doc/nyx/nyxrc.sample")) + #:use-setuptools? #f ; setup.py still uses distutils + #:phases + (modify-phases %standard-phases + (replace 'check + (lambda _ + (zero? (system* "./run_tests.py" "--unit"))))))) + ;; A Nyx home page is ‘being worked on’. Use Arm's for now, which at + ;; least mentions the new source repository: + (home-page "http://www.atagar.com/arm/") + (synopsis "Tor relay status monitor") + (description "Nyx (formerly Anonymizing Relay Monitor or \"arm\") +monitors the performance of relays participating in the +@uref{https://www.torproject.org/, Tor anonymity network}. It displays this +information visually and in real time, using a curses-based terminal interface. +This makes Nyx well-suited for remote shell connections and servers without a +graphical display. It's like @command{top} for Tor, providing detailed +statistics and status reports on: + +@enumerate +@item connections (with IP address, hostname, fingerprint, and consensus data), +@item bandwidth, processor, and memory usage, +@item the relay's current configuration, +@item logged events, +@item and much more. +@end enumerate + +Potential client and exit connections are scrubbed of sensitive information.") + (license license:gpl3+)))) diff --git a/gnu/packages/tv.scm b/gnu/packages/tv.scm index 2db71b8491..cb82e5b847 100644 --- a/gnu/packages/tv.scm +++ b/gnu/packages/tv.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> +;;; Copyright © 2015, 2016, 2017 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,15 +32,15 @@ (define-public tvtime (package (name "tvtime") - (version "1.0.10") + (version "1.0.11") (source (origin (method url-fetch) (uri (string-append - "http://linuxtv.org/downloads/tvtime/tvtime-" + "https://linuxtv.org/downloads/tvtime/tvtime-" version ".tar.gz")) (sha256 (base32 - "1mk6dni82n8jv5wsrrpqzcwrg9ccx9vijb5sbm7gqm2y0h40q5y9")))) + "1367rl3n6qxwf30lqyz234zpb43s9xjhig3hrvbg7cbqcl8g4fs0")))) (build-system gnu-build-system) (inputs `(("alsa-lib" ,alsa-lib) diff --git a/gnu/packages/u-boot.scm b/gnu/packages/u-boot.scm index cdd52d8747..3468fe5a78 100644 --- a/gnu/packages/u-boot.scm +++ b/gnu/packages/u-boot.scm @@ -55,8 +55,9 @@ (delete 'configure)))) (home-page "https://www.devicetree.org") (synopsis "Compiles device tree source files") - (description "@command{dtc} compiles device tree source files to device -tree binary files. These are board description files used by Linux and BSD.") + (description "@command{dtc} compiles +@uref{http://elinux.org/Device_Tree_Usage, device tree source files} to device +tree binary files. These are board description files used by Linux and BSD.") (license license:gpl2+))) (define u-boot diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 8ba229e582..ccc5760632 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -970,7 +970,7 @@ access to mpv's powerful playback capabilities.") (define-public youtube-dl (package (name "youtube-dl") - (version "2017.01.24") + (version "2017.01.29") (source (origin (method url-fetch) (uri (string-append "https://yt-dl.org/downloads/" @@ -978,7 +978,7 @@ access to mpv's powerful playback capabilities.") version ".tar.gz")) (sha256 (base32 - "1n74s6kfs4v1lfg7xls9ymk6yrq09hxwd18sz3lziv5qd1pj14b6")))) + "0visxc4rb6kw4hjcgcv5llis08z0syhian1m5hr1fdbz4w73hx9l")))) (build-system python-build-system) (arguments ;; The problem here is that the directory for the man page and completion diff --git a/gnu/packages/vim.scm b/gnu/packages/vim.scm index c2c0ccad9a..1b8b962d7c 100644 --- a/gnu/packages/vim.scm +++ b/gnu/packages/vim.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,18 +23,23 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages acl) #:use-module (gnu packages admin) ; For GNU hostname #:use-module (gnu packages attr) + #:use-module (gnu packages base) #:use-module (gnu packages fontutils) #:use-module (gnu packages gawk) #:use-module (gnu packages gettext) #:use-module (gnu packages glib) + #:use-module (gnu packages gperf) #:use-module (gnu packages groff) #:use-module (gnu packages gtk) #:use-module (gnu packages image) + #:use-module (gnu packages jemalloc) + #:use-module (gnu packages libevent) #:use-module (gnu packages linux) #:use-module (gnu packages lua) #:use-module (gnu packages ncurses) @@ -41,15 +47,17 @@ #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages ruby) + #:use-module (gnu packages serialization) #:use-module (gnu packages shells) #:use-module (gnu packages tcl) + #:use-module (gnu packages terminals) #:use-module (gnu packages xdisorg) #:use-module (gnu packages xorg)) (define-public vim (package (name "vim") - (version "8.0.0194") + (version "8.0.0257") (source (origin (method url-fetch) (uri (string-append "https://github.com/vim/vim/archive/v" @@ -57,7 +65,7 @@ (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "0rvhlgfms6w7h1v17lxwvfp32nmxx92vc0xsmgj5xgapz43l2sp0")))) + "05vz59iw77lmhnywfv9ihd0d895axqf2y81ddpjkn1qdspvw8ijj")))) (build-system gnu-build-system) (arguments `(#:test-target "test" @@ -149,6 +157,78 @@ configuration files.") ("tcl" ,tcl) ,@(package-inputs vim))))) +(define-public neovim + (package + (name "neovim") + (version "0.1.7") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/neovim/neovim/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0zjbpc4rhv5bcr353xqnbrc36zjvn7qvh8xf6s7n1bdi3788by6q")))) + (build-system cmake-build-system) + (arguments + `(#:modules ((srfi srfi-26) + (guix build cmake-build-system) + (guix build utils)) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'set-lua-paths + (lambda* (#:key inputs #:allow-other-keys) + (let* ((lua-version "5.2") + (lua-cpath-spec + (lambda (prefix) + (let ((path (string-append prefix "/lib/lua/" lua-version))) + (string-append path "/?.so;" path "/?/?.so")))) + (lua-path-spec + (lambda (prefix) + (let ((path (string-append prefix "/share/lua/" lua-version))) + (string-append path "/?.lua;" path "/?/?.lua")))) + (lua-inputs (map (cute assoc-ref %build-inputs <>) + '("lua" + "lua-lpeg" + "lua-bitop" + "lua-libmpack")))) + (setenv "LUA_PATH" + (string-join (map lua-path-spec lua-inputs) ";")) + (setenv "LUA_CPATH" + (string-join (map lua-cpath-spec lua-inputs) ";")) + #t)))))) + (inputs + `(("libuv" ,libuv) + ("msgpack" ,msgpack) + ("libtermkey" ,libtermkey) + ("libvterm" ,libvterm) + ("unibilium" ,unibilium) + ("jemalloc" ,jemalloc) + ("libiconv" ,libiconv) + ("lua" ,lua-5.2) + ("lua-lpeg" ,lua5.2-lpeg) + ("lua-bitop" ,lua5.2-bitop) + ("lua-libmpack" ,lua5.2-libmpack))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("gettext" ,gettext-minimal) + ("gperf" ,gperf))) + (home-page "http://neovim.io") + (synopsis "Fork of vim focused on extensibility and agility") + (description "Neovim is a project that seeks to aggressively +refactor Vim in order to: + +@itemize +@item Simplify maintenance and encourage contributions +@item Split the work between multiple developers +@item Enable advanced external UIs without modifications to the core +@item Improve extensibility with a new plugin architecture +@end itemize\n") + ;; Neovim is licensed under the terms of the Apache 2.0 license, + ;; except for parts that were contributed under the Vim license. + (license (list license:asl2.0 license:vim)))) + (define-public vifm (package (name "vifm") diff --git a/gnu/packages/web.scm b/gnu/packages/web.scm index 67b9797bbb..8cc80a2c45 100644 --- a/gnu/packages/web.scm +++ b/gnu/packages/web.scm @@ -88,16 +88,14 @@ (define-public httpd (package (name "httpd") - (version "2.4.23") + (version "2.4.25") (source (origin (method url-fetch) (uri (string-append "mirror://apache/httpd/httpd-" version ".tar.bz2")) (sha256 (base32 - "0n2yx3gjlpr4kgqx845fj6amnmg25r2l6a7rzab5hxnpmar985hc")) - (patches (search-patches "httpd-CVE-2016-8740.patch")) - (patch-flags '("-p0")))) + "1cl0bkqg6srb1sypga0cn8dcmdyxldavij73zmmkxvlz3kgw4zpq")))) (build-system gnu-build-system) (native-inputs `(("pcre" ,pcre "bin"))) ;for 'pcre-config' (inputs `(("apr" ,apr) @@ -128,14 +126,14 @@ and its related documentation.") (define-public nginx (package (name "nginx") - (version "1.11.6") + (version "1.11.9") (source (origin (method url-fetch) (uri (string-append "https://nginx.org/download/nginx-" version ".tar.gz")) (sha256 (base32 - "1gc5phrzm2hbpvryaya6rlvasa00vjips4hv5q1rqbcfa6xsnlri")))) + "0j2pcara9ir2xj3m2mjzf7wz46mdy51c0kal61cp0ldm2qgvf8nw")))) (build-system gnu-build-system) (inputs `(("pcre" ,pcre) ("openssl" ,openssl) @@ -3995,3 +3993,28 @@ programs' code. Its architecture is optimized for security, portability, and scalability (including load-balancing), making it suitable for large deployments.") (license l:gpl2+))) + +(define-public xinetd + (package + (name "xinetd") + (version "2.3.15") + (source + (origin + (method url-fetch) + (uri "https://github.com/xinetd-org/xinetd/archive/xinetd-2-3-15.tar.gz") + (patches (search-patches "xinetd-CVE-2013-4342.patch" "xinetd-fix-fd-leak.patch")) + (sha256 + (base32 + "0k59x52cbzp5fw0n8zn0y54j1ps0x9b72y8k5grzswjdmgs2a2v2")))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags '("--with-loadavg") + #:tests? #f )) ; no tests + (home-page "https://github.com/xinetd-org/xinetd") + (synopsis "Internet services daemon") + (description "@code{xinetd}, a more secure replacement for @code{inetd}, +listens for incoming requests over a network and launches the appropriate +service for that request. Requests are made using port numbers as identifiers +and xinetd usually launches another daemon to handle the request. It can be +used to start services with both privileged and non-privileged port numbers.") + (license (l:fsf-free "file://COPYRIGHT")))) diff --git a/gnu/packages/wine.scm b/gnu/packages/wine.scm index 367f27af5e..7b73353387 100644 --- a/gnu/packages/wine.scm +++ b/gnu/packages/wine.scm @@ -53,7 +53,7 @@ (define-public wine (package (name "wine") - (version "1.9.24") + (version "2.0") (source (origin (method url-fetch) (uri (string-append "https://dl.winehq.org/wine/source/" @@ -61,7 +61,7 @@ "/wine-" version ".tar.bz2")) (sha256 (base32 - "0qb07vfxwz41wj71lb0ss3apf22m4ch06382rqfksf7gg34pswnb")))) + "1ik6q0h3ph3jizmp7bxhf6kcm1pzrdrn2m0yf2x86slv2aigamlp")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) ("gettext" ,gettext-minimal) diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 02d0c94119..ee83934ca0 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -788,7 +788,7 @@ Wacom tablet applet.") (define-public xf86-input-wacom (package (name "xf86-input-wacom") - (version "0.29.0") + (version "0.34.0") (source (origin (method url-fetch) (uri (string-append @@ -796,7 +796,7 @@ Wacom tablet applet.") name "-" version ".tar.bz2")) (sha256 (base32 - "15lbzjkaf690i69qy0n0ibwczbclqq1nx0418c6a567by5v7wl48")))) + "0idhkigl0pnyp08sqm6bqfb4h20v6rjrb71z1gdv59gk7d7qwpgi")))) (arguments `(#:configure-flags (list (string-append "--with-sdkdir=" diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 7a534592b4..f9719c77fb 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -1930,7 +1930,7 @@ server.") (define-public xauth (package (name "xauth") - (version "1.0.9") + (version "1.0.10") (source (origin (method url-fetch) @@ -1940,7 +1940,7 @@ server.") ".tar.bz2")) (sha256 (base32 - "13y2invb0894b1in03jbglximbz6v31y2kr4yjjgica8xciibkjn")))) + "0kgwz9rmxjfdvi2syf8g0ms5rr5cgyqx4n0n1m960kyz7k745zjs")))) (build-system gnu-build-system) (inputs `(("libxmu" ,libxmu) @@ -2014,6 +2014,41 @@ the same way.") legacy X clients.") (license license:x11))) +(define-public xcalc + (package + (name "xcalc") + (version "1.0.6") + (source + (origin + (method url-fetch) + (uri (string-append + "mirror://xorg/individual/app/" name "-" + version + ".tar.gz")) + (sha256 + (base32 + "1lg8xwj0nr8anbd77n3cs87s57sr4gmb3pxs3k22a28n6ndcvmbz")))) + (build-system gnu-build-system) + (arguments + `(#:phases (modify-phases %standard-phases + (add-after + 'configure 'mutate-makefile + (lambda _ + (substitute* "Makefile" + (("^appdefaultdir = .*$") + (string-append "appdefaultdir = " %output + ,%app-defaults-dir "\n"))) + #t))))) + (inputs + `(("libxaw" ,libxaw))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "https://www.x.org/wiki/") + (synopsis "Hand calculator for the X Window system") + (description "Xcalc is a scientific calculator desktop accessory that can +emulate a TI-30 or an HP-10C.") + (license license:x11))) + (define-public xcb-proto (package @@ -2770,10 +2805,10 @@ X server.") (define-public xf86-video-intel - (let ((commit "d1672806a5222f00dcc2eb24ccddd03f727f71bc")) + (let ((commit "9fe04af4bce3057e3e94a6bf36a3d8d2e48d592c")) (package (name "xf86-video-intel") - (version (string-append "2.99.917-1-" (string-take commit 7))) + (version (string-append "2.99.917-2-" (string-take commit 7))) (source (origin ;; there's no current tarball @@ -2783,7 +2818,7 @@ X server.") (commit commit))) (sha256 (base32 - "16hfcj11lbn6lp0hgrixidbfb7mghm1yn4lynmymm985w1gg0n72")) + "06nnm9kjvmwxazp2ki0i5x1xv03bysfgpw30nd2jlf71qllybxml")) (file-name (string-append name "-" version)))) (build-system gnu-build-system) (inputs `(("mesa" ,mesa) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 1b1ce0d5e8..d9f3a1445e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> @@ -99,6 +99,18 @@ %default-authorized-guix-keys guix-configuration guix-configuration? + + guix-configuration-guix + guix-configuration-build-group + guix-configuration-build-accounts + guix-configuration-authorize-key? + guix-configuration-authorized-keys + guix-configuration-use-substitutes? + guix-configuration-substitute-urls + guix-configuration-extra-options + guix-configuration-log-file + guix-configuration-lsof + guix-service guix-service-type guix-publish-configuration @@ -301,13 +313,26 @@ FILE-SYSTEM." #:select (mount-file-system)) ,@%default-modules))))))) +(define (file-system-shepherd-services file-systems) + "Return the list of Shepherd services for FILE-SYSTEMS." + (let* ((file-systems (filter file-system-mount? file-systems))) + (define sink + (shepherd-service + (provision '(file-systems)) + (requirement (cons* 'root-file-system 'user-file-systems + (map file-system->shepherd-service-name + file-systems))) + (documentation "Target for all the initially-mounted file systems") + (start #~(const #t)) + (stop #~(const #f)))) + + (cons sink (map file-system-shepherd-service file-systems)))) + (define file-system-service-type (service-type (name 'file-systems) (extensions (list (service-extension shepherd-root-service-type - (lambda (file-systems) - (filter-map file-system-shepherd-service - file-systems))) + file-system-shepherd-services) (service-extension fstab-service-type identity))) (compose concatenate) @@ -354,93 +379,89 @@ in KNOWN-MOUNT-POINTS when it is stopped." (define user-processes-service-type (shepherd-service-type 'user-processes - (match-lambda - ((requirements grace-delay) - (shepherd-service - (documentation "When stopped, terminate all user processes.") - (provision '(user-processes)) - (requirement (cons* 'root-file-system 'user-file-systems - (map file-system->shepherd-service-name - requirements))) - (start #~(const #t)) - (stop #~(lambda _ - (define (kill-except omit signal) - ;; Kill all the processes with SIGNAL except those listed - ;; in OMIT and the current process. - (let ((omit (cons (getpid) omit))) - (for-each (lambda (pid) - (unless (memv pid omit) - (false-if-exception - (kill pid signal)))) - (processes)))) - - (define omitted-pids - ;; List of PIDs that must not be killed. - (if (file-exists? #$%do-not-kill-file) - (map string->number - (call-with-input-file #$%do-not-kill-file - (compose string-tokenize - (@ (ice-9 rdelim) read-string)))) - '())) - - (define (now) - (car (gettimeofday))) - - (define (sleep* n) - ;; Really sleep N seconds. - ;; Work around <http://bugs.gnu.org/19581>. - (define start (now)) - (let loop ((elapsed 0)) - (when (> n elapsed) - (sleep (- n elapsed)) - (loop (- (now) start))))) - - (define lset= (@ (srfi srfi-1) lset=)) - - (display "sending all processes the TERM signal\n") - - (if (null? omitted-pids) - (begin - ;; Easy: terminate all of them. - (kill -1 SIGTERM) - (sleep* #$grace-delay) - (kill -1 SIGKILL)) - (begin - ;; Kill them all except OMITTED-PIDS. XXX: We would - ;; like to (kill -1 SIGSTOP) to get a fixed list of - ;; processes, like 'killall5' does, but that seems - ;; unreliable. - (kill-except omitted-pids SIGTERM) - (sleep* #$grace-delay) - (kill-except omitted-pids SIGKILL) - (delete-file #$%do-not-kill-file))) - - (let wait () - (let ((pids (processes))) - (unless (lset= = pids (cons 1 omitted-pids)) - (format #t "waiting for process termination\ + (lambda (grace-delay) + (shepherd-service + (documentation "When stopped, terminate all user processes.") + (provision '(user-processes)) + (requirement '(file-systems)) + (start #~(const #t)) + (stop #~(lambda _ + (define (kill-except omit signal) + ;; Kill all the processes with SIGNAL except those listed + ;; in OMIT and the current process. + (let ((omit (cons (getpid) omit))) + (for-each (lambda (pid) + (unless (memv pid omit) + (false-if-exception + (kill pid signal)))) + (processes)))) + + (define omitted-pids + ;; List of PIDs that must not be killed. + (if (file-exists? #$%do-not-kill-file) + (map string->number + (call-with-input-file #$%do-not-kill-file + (compose string-tokenize + (@ (ice-9 rdelim) read-string)))) + '())) + + (define (now) + (car (gettimeofday))) + + (define (sleep* n) + ;; Really sleep N seconds. + ;; Work around <http://bugs.gnu.org/19581>. + (define start (now)) + (let loop ((elapsed 0)) + (when (> n elapsed) + (sleep (- n elapsed)) + (loop (- (now) start))))) + + (define lset= (@ (srfi srfi-1) lset=)) + + (display "sending all processes the TERM signal\n") + + (if (null? omitted-pids) + (begin + ;; Easy: terminate all of them. + (kill -1 SIGTERM) + (sleep* #$grace-delay) + (kill -1 SIGKILL)) + (begin + ;; Kill them all except OMITTED-PIDS. XXX: We would + ;; like to (kill -1 SIGSTOP) to get a fixed list of + ;; processes, like 'killall5' does, but that seems + ;; unreliable. + (kill-except omitted-pids SIGTERM) + (sleep* #$grace-delay) + (kill-except omitted-pids SIGKILL) + (delete-file #$%do-not-kill-file))) + + (let wait () + (let ((pids (processes))) + (unless (lset= = pids (cons 1 omitted-pids)) + (format #t "waiting for process termination\ (processes left: ~s)~%" - pids) - (sleep* 2) - (wait)))) + pids) + (sleep* 2) + (wait)))) - (display "all processes have been terminated\n") - #f)) - (respawn? #f)))))) + (display "all processes have been terminated\n") + #f)) + (respawn? #f))))) -(define* (user-processes-service file-systems #:key (grace-delay 4)) +(define* (user-processes-service #:key (grace-delay 4)) "Return the service that is responsible for terminating all the processes so that the root file system can be re-mounted read-only, just before rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM has been sent are terminated with SIGKILL. -The returned service will depend on 'root-file-system' and on all the shepherd -services corresponding to FILE-SYSTEMS. +The returned service will depend on 'file-systems', meaning that it is +considered started after all the auto-mount file systems have been mounted. All the services that spawn processes must depend on this one so that they are stopped before 'kill' is called." - (service user-processes-service-type - (list (filter file-system-mount? file-systems) grace-delay))) + (service user-processes-service-type grace-delay)) ;;; @@ -1525,8 +1546,10 @@ This service is not part of @var{%base-services}." (mingetty-service (mingetty-configuration (tty "tty6"))) - (static-networking-service "lo" "127.0.0.1" - #:provision '(loopback)) + (service static-networking-service-type + (list (static-networking (interface "lo") + (ip "127.0.0.1") + (provision '(loopback))))) (syslog-service) (urandom-seed-service) (guix-service) diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 1194133f63..237f71a09b 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -64,7 +64,9 @@ (use-substitutes? cuirass-configuration-use-substitutes? ;boolean (default #f)) (one-shot? cuirass-configuration-one-shot? ;boolean - (default #f))) + (default #f)) + (load-path cuirass-configuration-load-path + (default '()))) (define (cuirass-shepherd-service config) "Return a <shepherd-service> for the Cuirass service with CONFIG." @@ -80,7 +82,8 @@ (port (cuirass-configuration-port config)) (specs (cuirass-configuration-specifications config)) (use-substitutes? (cuirass-configuration-use-substitutes? config)) - (one-shot? (cuirass-configuration-one-shot? config))) + (one-shot? (cuirass-configuration-one-shot? config)) + (load-path (cuirass-configuration-load-path config))) (list (shepherd-service (documentation "Run Cuirass.") (provision '(cuirass)) @@ -94,7 +97,9 @@ "--port" #$(number->string port) "--interval" #$(number->string interval) #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if one-shot? '("--one-shot") '())) + #$@(if one-shot? '("--one-shot") '()) + #$@(if (null? load-path) '() + `("--load-path" ,(string-join load-path ":")))) #:user #$user #:group #$group #:log-file #$log-file)) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index f7412ff29e..766d979f3e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -42,6 +42,13 @@ #:use-module (ice-9 match) #:export (%facebook-host-aliases static-networking + + static-networking? + static-networking-interface + static-networking-ip + static-networking-netmask + static-networking-gateway + static-networking-service static-networking-service-type dhcp-client-service @@ -121,88 +128,138 @@ fe80::1%lo0 apps.facebook.com\n") (ip static-networking-ip) (netmask static-networking-netmask (default #f)) - (gateway static-networking-gateway) - (provision static-networking-provision) - (name-servers static-networking-name-servers)) + (gateway static-networking-gateway ;FIXME: doesn't belong here + (default #f)) + (provision static-networking-provision + (default #f)) + (name-servers static-networking-name-servers ;FIXME: doesn't belong here + (default '()))) + +(define static-networking-shepherd-service + (match-lambda + (($ <static-networking> interface ip netmask gateway provision + name-servers) + (let ((loopback? (and provision (memq 'loopback provision)))) + (shepherd-service + + ;; Unless we're providing the loopback interface, wait for udev to be up + ;; and running so that INTERFACE is actually usable. + (requirement (if loopback? '() '(udev))) + + (documentation + "Bring up the networking interface using a static IP address.") + (provision (or provision + (list (symbol-append 'networking- + (string->symbol interface))))) + + (start #~(lambda _ + ;; Return #t if successfully started. + (let* ((addr (inet-pton AF_INET #$ip)) + (sockaddr (make-socket-address AF_INET addr 0)) + (mask (and #$netmask + (inet-pton AF_INET #$netmask))) + (maskaddr (and mask + (make-socket-address AF_INET + mask 0))) + (gateway (and #$gateway + (inet-pton AF_INET #$gateway))) + (gatewayaddr (and gateway + (make-socket-address AF_INET + gateway 0)))) + (configure-network-interface #$interface sockaddr + (logior IFF_UP + #$(if loopback? + #~IFF_LOOPBACK + 0)) + #:netmask maskaddr) + (when gateway + (let ((sock (socket AF_INET SOCK_DGRAM 0))) + (add-network-route/gateway sock gatewayaddr) + (close-port sock)))))) + (stop #~(lambda _ + ;; Return #f is successfully stopped. + (let ((sock (socket AF_INET SOCK_STREAM 0))) + (when #$gateway + (delete-network-route sock + (make-socket-address + AF_INET INADDR_ANY 0))) + (set-network-interface-flags sock #$interface 0) + (close-port sock) + #f))) + (respawn? #f)))))) + +(define (static-networking-etc-files interfaces) + "Return a /etc/resolv.conf entry for INTERFACES or the empty list." + (match (delete-duplicates + (append-map static-networking-name-servers + interfaces)) + (() + '()) + ((name-servers ...) + (let ((content (string-join + (map (cut string-append "nameserver " <>) + name-servers) + "\n" 'suffix))) + `(("resolv.conf" + ,(plain-file "resolv.conf" + (string-append "\ +# Generated by 'static-networking-service'.\n" + content)))))))) + +(define (static-networking-shepherd-services interfaces) + "Return the list of Shepherd services to bring up INTERFACES, a list of +<static-networking> objects." + (define (loopback? service) + (memq 'loopback (shepherd-service-provision service))) + + (let ((services (map static-networking-shepherd-service interfaces))) + (match (remove loopback? services) + (() + ;; There's no interface other than 'loopback', so we assume that the + ;; 'networking' service will be provided by dhclient or similar. + services) + ((non-loopback ...) + ;; Assume we're providing all the interfaces, and thus, provide a + ;; 'networking' service. + (cons (shepherd-service + (provision '(networking)) + (requirement (append-map shepherd-service-provision + services)) + (start #~(const #t)) + (stop #~(const #f)) + (documentation "Bring up all the networking interfaces.")) + services))))) (define static-networking-service-type - (shepherd-service-type - 'static-networking - (match-lambda - (($ <static-networking> interface ip netmask gateway provision - name-servers) - (let ((loopback? (memq 'loopback provision))) - (shepherd-service - - ;; Unless we're providing the loopback interface, wait for udev to be up - ;; and running so that INTERFACE is actually usable. - (requirement (if loopback? '() '(udev))) - - (documentation - "Bring up the networking interface using a static IP address.") - (provision provision) - (start #~(lambda _ - ;; Return #t if successfully started. - (let* ((addr (inet-pton AF_INET #$ip)) - (sockaddr (make-socket-address AF_INET addr 0)) - (mask (and #$netmask - (inet-pton AF_INET #$netmask))) - (maskaddr (and mask - (make-socket-address AF_INET - mask 0))) - (gateway (and #$gateway - (inet-pton AF_INET #$gateway))) - (gatewayaddr (and gateway - (make-socket-address AF_INET - gateway 0)))) - (configure-network-interface #$interface sockaddr - (logior IFF_UP - #$(if loopback? - #~IFF_LOOPBACK - 0)) - #:netmask maskaddr) - (when gateway - (let ((sock (socket AF_INET SOCK_DGRAM 0))) - (add-network-route/gateway sock gatewayaddr) - (close-port sock)))) - - #$(if (pair? name-servers) - #~(call-with-output-file "/etc/resolv.conf" - (lambda (port) - (display - "# Generated by 'static-networking-service'.\n" - port) - (for-each (lambda (server) - (format port "nameserver ~a~%" - server)) - '#$name-servers) - #t)) - #t))) - (stop #~(lambda _ - ;; Return #f is successfully stopped. - (let ((sock (socket AF_INET SOCK_STREAM 0))) - (when #$gateway - (delete-network-route sock - (make-socket-address - AF_INET INADDR_ANY 0))) - (set-network-interface-flags sock #$interface 0) - (close-port sock) - #f))) - (respawn? #f))))))) + ;; The service type for statically-defined network interfaces. + (service-type (name 'static-networking) + (extensions + (list + (service-extension shepherd-root-service-type + static-networking-shepherd-services) + (service-extension etc-service-type + static-networking-etc-files))) + (compose concatenate) + (extend append))) (define* (static-networking-service interface ip #:key - netmask gateway - (provision '(networking)) + netmask gateway provision (name-servers '())) "Return a service that starts @var{interface} with address @var{ip}. If @var{netmask} is true, use it as the network mask. If @var{gateway} is true, -it must be a string specifying the default network gateway." - (service static-networking-service-type - (static-networking (interface interface) (ip ip) - (netmask netmask) (gateway gateway) - (provision provision) - (name-servers name-servers)))) +it must be a string specifying the default network gateway. + +This procedure can be called several times, one for each network +interface of interest. Behind the scenes what it does is extend +@code{static-networking-service-type} with additional network interfaces +to handle." + (simple-service 'static-network-interface + static-networking-service-type + (list (static-networking (interface interface) (ip ip) + (netmask netmask) (gateway gateway) + (provision provision) + (name-servers name-servers))))) (define dhcp-client-service-type (shepherd-service-type diff --git a/gnu/system.scm b/gnu/system.scm index 4e57f975e6..1006c842c9 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> @@ -293,8 +293,7 @@ a container or that of a \"bare metal\" system." (other-fs (non-boot-file-system-service os)) (unmount (user-unmount-service known-fs)) (swaps (swap-services os)) - (procs (user-processes-service - (service-parameters other-fs))) + (procs (user-processes-service)) (host-name (host-name-service (operating-system-host-name os))) (entries (operating-system-directory-base-entries os #:container? container?))) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 067b291a5c..7df7d4615a 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -94,8 +94,8 @@ denoting a file name." (define %background-image (grub-image (aspect-ratio 4/3) - (file #~(string-append #$%artwork-repository - "/grub/GuixSD-fully-black-4-3.svg")))) + (file (file-append %artwork-repository + "/grub/GuixSD-fully-black-4-3.svg")))) (define %default-theme ;; Default theme contributed by Felipe López. diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index cfdcf5e136..1acfcc4866 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -21,9 +21,11 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module (guix store) + #:use-module (guix modules) #:use-module (guix sets) #:use-module (guix ui) #:use-module (gnu services) + #:use-module (gnu services shepherd) #:use-module ((gnu system file-systems) #:select (%tty-gid)) #:use-module ((gnu packages admin) @@ -43,6 +45,7 @@ user-account-supplementary-groups user-account-comment user-account-home-directory + user-account-create-home-directory? user-account-shell user-account-system? @@ -81,7 +84,7 @@ (create-home-directory? user-account-create-home-directory? ;Boolean (default #t)) (shell user-account-shell ; gexp - (default #~(string-append #$bash "/bin/bash"))) + (default (file-append bash "/bin/bash"))) (system? user-account-system? ; Boolean (default #f))) @@ -128,7 +131,7 @@ (name "nobody") (uid 65534) (group "nogroup") - (shell #~(string-append #$shadow "/sbin/nologin")) + (shell (file-append shadow "/sbin/nologin")) (home-directory "/nonexistent") (create-home-directory? #f) (system? #t)))) @@ -288,6 +291,35 @@ group." (activate-users+groups (list #$@user-specs) (list #$@group-specs)))) +(define (account-shepherd-service accounts+groups) + "Return a Shepherd service that creates the home directories for the user +accounts among ACCOUNTS+GROUPS." + (define accounts + (filter user-account? accounts+groups)) + + ;; Create home directories only once 'file-systems' is up. This makes sure + ;; they are created in the right place if /home lives on a separate + ;; partition. + ;; + ;; XXX: We arrange for this service to stop right after it's done its job so + ;; that 'guix system reconfigure' knows that it can reload it fearlessly + ;; (and thus create new home directories). The cost of this hack is that + ;; there's a small window during which first-time logins could happen before + ;; the home directory has been created. + (list (shepherd-service + (requirement '(file-systems)) + (provision '(user-homes)) + (modules '((gnu build activation))) + (start (with-imported-modules (source-module-closure + '((gnu build activation))) + #~(lambda () + (activate-user-home + (list #$@(map user-account->gexp accounts))) + #f))) ;stop + (stop #~(const #f)) + (respawn? #f) + (documentation "Create user home directories.")))) + (define (shells-file shells) "Return a file-like object that builds a shell list for use as /etc/shells based on SHELLS. /etc/shells is used by xterm, polkit, and other programs." @@ -327,6 +359,8 @@ the /etc/skel directory for those." (extensions (list (service-extension activation-service-type account-activation) + (service-extension shepherd-root-service-type + account-shepherd-service) (service-extension etc-service-type etc-files))))) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index a725ca90f3..756d3df800 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -146,6 +146,43 @@ info --version") (pk 'services services) '(root #$@(operating-system-shepherd-service-names os))))) + (test-assert "homes" + (let ((homes + '#$(map user-account-home-directory + (filter user-account-create-home-directory? + (operating-system-user-accounts os))))) + (marionette-eval + `(begin + (use-modules (gnu services herd) (srfi srfi-1)) + + ;; Home directories are supposed to exist once 'user-homes' + ;; has been started. + (start-service 'user-homes) + + (every (lambda (home) + (and (file-exists? home) + (file-is-directory? home))) + ',homes)) + marionette))) + + (test-assert "skeletons in home directories" + (let ((homes + '#$(filter-map (lambda (account) + (and (user-account-create-home-directory? + account) + (not (user-account-system? account)) + (user-account-home-directory account))) + (operating-system-user-accounts os)))) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) (ice-9 ftw)) + (every (lambda (home) + (null? (lset-difference string=? + (scandir "/etc/skel/") + (scandir home)))) + ',homes)) + marionette))) + (test-equal "login on tty1" "root\n" (begin diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 4e8d594054..b104efcfd5 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -35,6 +35,7 @@ #:use-module (guix utils) #:export (%test-installed-os %test-separate-store-os + %test-separate-home-os %test-raid-root-os %test-encrypted-os %test-btrfs-root-os)) @@ -218,7 +219,6 @@ IMAGE, a disk image. The QEMU VM is has access to MEMORY-SIZE MiB of RAM." "-no-reboot" "-m" #$(number->string memory-size) "-drive" "file=disk.img,if=virtio"))))) - (define %test-installed-os (system-test (name "installed-os") @@ -234,6 +234,64 @@ build (current-guix) and then store a couple of full system images.") ;;; +;;; Separate /home. +;;; + +(define-os-with-source (%separate-home-os %separate-home-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "liberigilo") + (timezone "Europe/Paris") + (locale "en_US.utf8") + + (bootloader (grub-configuration (device "/dev/vdb"))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons* (file-system + (device "my-root") + (title 'label) + (mount-point "/") + (type "ext4")) + (file-system + (device "none") + (title 'device) + (type "tmpfs") + (mount-point "/home") + (type "tmpfs")) + %base-file-systems)) + (users (cons* (user-account + (name "alice") + (group "users") + (home-directory "/home/alice")) + (user-account + (name "charlie") + (group "users") + (home-directory "/home/charlie")) + %base-user-accounts)) + (services (cons (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix combinators))))) + %base-services)))) + +(define %test-separate-home-os + (system-test + (name "separate-home-os") + (description + "Test basic functionality of an installed OS with a separate /home +partition. In particular, home directories must be correctly created (see +<https://bugs.gnu.org/21108>).") + (value + (mlet* %store-monad ((image (run-install %separate-home-os + %separate-home-os-source + #:script + %simple-installation-script)) + (command (qemu-command/writable-image image))) + (run-basic-test %separate-home-os command "separate-home-os"))))) + + +;;; ;;; Separate /gnu/store partition. ;;; diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index f6df183da4..730e638c89 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,7 @@ (define-module (guix build-system gnu) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -84,15 +84,15 @@ builder, or the distro's final Guile when GUILE is #f." (let loop ((p p)) (define rewritten-input - (memoize - (match-lambda - ((name (? package? p) sub-drv ...) - ;; XXX: Check whether P's build system knows #:implicit-inputs, for - ;; things like `cross-pkg-config'. - (if (eq? (package-build-system p) gnu-build-system) - (cons* name (loop p) sub-drv) - (cons* name p sub-drv))) - (x x)))) + (mlambda (input) + (match input + ((name (? package? p) sub-drv ...) + ;; XXX: Check whether P's build system knows #:implicit-inputs, for + ;; things like `cross-pkg-config'. + (if (eq? (package-build-system p) gnu-build-system) + (cons* name (loop p) sub-drv) + (cons* name p sub-drv))) + (x x)))) (package (inherit p) (location (if (pair? loc) (source-properties->location loc) loc)) @@ -393,22 +393,21 @@ packages that must not be referenced." ;;; (define standard-cross-packages - (memoize - (lambda (target kind) - "Return the list of name/package tuples to cross-build for TARGET. KIND + (mlambda (target kind) + "Return the list of name/package tuples to cross-build for TARGET. KIND is one of `host' or `target'." - (let* ((cross (resolve-interface '(gnu packages cross-base))) - (gcc (module-ref cross 'cross-gcc)) - (binutils (module-ref cross 'cross-binutils)) - (libc (module-ref cross 'cross-libc))) - (case kind - ((host) - `(("cross-gcc" ,(gcc target - (binutils target) - (libc target))) - ("cross-binutils" ,(binutils target)))) - ((target) - `(("cross-libc" ,(libc target))))))))) + (let* ((cross (resolve-interface '(gnu packages cross-base))) + (gcc (module-ref cross 'cross-gcc)) + (binutils (module-ref cross 'cross-binutils)) + (libc (module-ref cross 'cross-libc))) + (case kind + ((host) + `(("cross-gcc" ,(gcc target + (binutils target) + (libc target))) + ("cross-binutils" ,(binutils target)))) + ((target) + `(("cross-libc" ,(libc target)))))))) (define* (gnu-cross-build store name #:key diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index d4d3d28f2a..17173f121e 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; @@ -21,7 +21,7 @@ (define-module (guix build-system python) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) @@ -87,49 +87,48 @@ pre-defined variants." ;; Memoize the transformations. Failing to do that, we would build a huge ;; object graph with lots of duplicates, which in turns prevents us from ;; benefiting from memoization in 'package-derivation'. - (memoize ;FIXME: use 'eq?' - (lambda (p) - (let* ((rewrite-if-package - (lambda (content) - ;; CONTENT may be a file name, in which case it is returned, - ;; or a package, which is rewritten with the new PYTHON and - ;; NEW-PREFIX. - (if (package? content) - (transform content) - content))) - (rewrite - (match-lambda - ((name content . rest) - (append (list name (rewrite-if-package content)) rest))))) - - (cond - ;; If VARIANT-PROPERTY is present, use that. - ((and variant-property - (assoc-ref (package-properties p) variant-property)) - => force) - - ;; Otherwise build the new package object graph. - ((eq? (package-build-system p) python-build-system) - (package - (inherit p) - (location (package-location p)) - (name (let ((name (package-name p))) - (string-append new-prefix - (if (string-prefix? old-prefix name) - (substring name - (string-length old-prefix)) - name)))) - (arguments - (let ((python (if (promise? python) - (force python) - python))) - (ensure-keyword-arguments (package-arguments p) - `(#:python ,python)))) - (inputs (map rewrite (package-inputs p))) - (propagated-inputs (map rewrite (package-propagated-inputs p))) - (native-inputs (map rewrite (package-native-inputs p))))) - (else - p)))))) + (mlambdaq (p) + (let* ((rewrite-if-package + (lambda (content) + ;; CONTENT may be a file name, in which case it is returned, + ;; or a package, which is rewritten with the new PYTHON and + ;; NEW-PREFIX. + (if (package? content) + (transform content) + content))) + (rewrite + (match-lambda + ((name content . rest) + (append (list name (rewrite-if-package content)) rest))))) + + (cond + ;; If VARIANT-PROPERTY is present, use that. + ((and variant-property + (assoc-ref (package-properties p) variant-property)) + => force) + + ;; Otherwise build the new package object graph. + ((eq? (package-build-system p) python-build-system) + (package + (inherit p) + (location (package-location p)) + (name (let ((name (package-name p))) + (string-append new-prefix + (if (string-prefix? old-prefix name) + (substring name + (string-length old-prefix)) + name)))) + (arguments + (let ((python (if (promise? python) + (force python) + python))) + (ensure-keyword-arguments (package-arguments p) + `(#:python ,python)))) + (inputs (map rewrite (package-inputs p))) + (propagated-inputs (map rewrite (package-propagated-inputs p))) + (native-inputs (map rewrite (package-native-inputs p))))) + (else + p))))) transform) diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm index 51dad17ba7..e948cd03d3 100644 --- a/guix/build/bournish.scm +++ b/guix/build/bournish.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -105,6 +106,14 @@ characters." ((@ (guix build utils) dump-port) port (current-output-port)) *unspecified*))) +(define (rm-command . args) + "Emit code for the 'rm' command." + (cond ((member "-r" args) + `(for-each (@ (guix build utils) delete-file-recursively) + (list ,@(delete "-r" args)))) + (else + `(for-each delete-file (list ,@args))))) + (define (lines+chars port) "Return the number of lines and number of chars read from PORT." (let loop ((lines 0) (chars 0)) @@ -194,7 +203,7 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n")) `(("echo" ,(lambda strings `(list ,@strings))) ("cd" ,(lambda (dir) `(chdir ,dir))) ("pwd" ,(lambda () `(getcwd))) - ("rm" ,(lambda (file) `(delete-file ,file))) + ("rm" ,rm-command) ("cp" ,(lambda (source dest) `(copy-file ,source ,dest))) ("help" ,help-command) ("ls" ,ls-command) diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm index 3fc13eb835..24aa73d4f2 100644 --- a/guix/build/r-build-system.scm +++ b/guix/build/r-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -84,6 +84,7 @@ (params (append configure-flags (list "--install-tests" (string-append "--library=" site-library) + "--built-timestamp=1970-01-01" "."))) (site-path (string-append site-library ":" (generate-site-path inputs)))) diff --git a/guix/combinators.scm b/guix/combinators.scm index 9e4689ba9c..11cad62ccf 100644 --- a/guix/combinators.scm +++ b/guix/combinators.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. @@ -20,8 +20,7 @@ (define-module (guix combinators) #:use-module (ice-9 match) #:use-module (ice-9 vlist) - #:export (memoize - fold2 + #:export (fold2 fold-tree fold-tree-leaves compile-time-value)) @@ -33,19 +32,6 @@ ;;; ;;; Code: -(define (memoize proc) - "Return a memoizing version of PROC." - (let ((cache (make-hash-table))) - (lambda args - (let ((results (hash-ref cache args))) - (if results - (apply values results) - (let ((results (call-with-values (lambda () - (apply proc args)) - list))) - (hash-set! cache args results) - (apply values results))))))) - (define fold2 (case-lambda ((proc seed1 seed2 lst) diff --git a/guix/derivations.scm b/guix/derivations.scm index b712c508e5..47a783f42f 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -31,6 +31,7 @@ #:use-module (ice-9 vlist) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix memoization) #:use-module (guix combinators) #:use-module (guix monads) #:use-module (guix hash) @@ -556,12 +557,11 @@ that form." (display ")" port)))) (define derivation->string - (memoize - (lambda (drv) - "Return the external representation of DRV as a string." - (with-fluids ((%default-port-encoding "UTF-8")) - (call-with-output-string - (cut write-derivation drv <>)))))) + (mlambda (drv) + "Return the external representation of DRV as a string." + (with-fluids ((%default-port-encoding "UTF-8")) + (call-with-output-string + (cut write-derivation drv <>))))) (define* (derivation->output-path drv #:optional (output "out")) "Return the store path of its output OUTPUT. Raise a @@ -583,12 +583,14 @@ DRV." (define derivation-path->output-path ;; This procedure is called frequently, so memoize it. - (memoize - (lambda* (path #:optional (output "out")) - "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store + (let ((memoized (mlambda (path output) + (derivation->output-path (call-with-input-file path + read-derivation) + output)))) + (lambda* (path #:optional (output "out")) + "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store path of its output OUTPUT." - (derivation->output-path (call-with-input-file path read-derivation) - output)))) + (memoized path output)))) (define (derivation-path->output-paths path) "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the @@ -615,23 +617,21 @@ in SIZE bytes." (loop (+ 1 i)))))) (define derivation-path->base16-hash - (memoize - (lambda (file) - "Return a string containing the base16 representation of the hash of the + (mlambda (file) + "Return a string containing the base16 representation of the hash of the derivation at FILE." - (call-with-input-file file - (compose bytevector->base16-string - derivation-hash - read-derivation))))) + (call-with-input-file file + (compose bytevector->base16-string + derivation-hash + read-derivation)))) (define derivation-hash ; `hashDerivationModulo' in derivations.cc - (memoize - (lambda (drv) + (mlambda (drv) "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector." (match drv (($ <derivation> ((_ . ($ <derivation-output> path - (? symbol? hash-algo) (? bytevector? hash) - (? boolean? recursive?))))) + (? symbol? hash-algo) (? bytevector? hash) + (? boolean? recursive?))))) ;; A fixed-output derivation. (sha256 (string->utf8 @@ -641,14 +641,14 @@ derivation at FILE." ":" (bytevector->base16-string hash) ":" path)))) (($ <derivation> outputs inputs sources - system builder args env-vars) + system builder args env-vars) ;; A regular derivation: replace the path of each input with that ;; input's hash; return the hash of serialization of the resulting ;; derivation. (let* ((inputs (map (match-lambda - (($ <derivation-input> path sub-drvs) - (let ((hash (derivation-path->base16-hash path))) - (make-derivation-input hash sub-drvs)))) + (($ <derivation-input> path sub-drvs) + (let ((hash (derivation-path->base16-hash path))) + (make-derivation-input hash sub-drvs)))) inputs)) (drv (make-derivation outputs (sort (coalesce-duplicate-inputs inputs) @@ -661,7 +661,7 @@ derivation at FILE." ;; the SHA256 port's `write' method gets called for every single ;; character. (sha256 - (string->utf8 (derivation->string drv))))))))) + (string->utf8 (derivation->string drv)))))))) (define (store-path type hash name) ; makeStorePath "Return the store path for NAME/HASH/TYPE." @@ -915,18 +915,17 @@ recursively." (define rewritten-input ;; Rewrite the given input according to MAPPING, and return an input ;; in the format used in 'derivation' calls. - (memoize - (lambda (input loop) - (match input - (($ <derivation-input> path (sub-drvs ...)) - (match (vhash-assoc path mapping) - ((_ . (? derivation? replacement)) - (cons replacement sub-drvs)) - ((_ . replacement) - (list replacement)) - (#f - (let* ((drv (loop (call-with-input-file path read-derivation)))) - (cons drv sub-drvs))))))))) + (mlambda (input loop) + (match input + (($ <derivation-input> path (sub-drvs ...)) + (match (vhash-assoc path mapping) + ((_ . (? derivation? replacement)) + (cons replacement sub-drvs)) + ((_ . replacement) + (list replacement)) + (#f + (let* ((drv (loop (call-with-input-file path read-derivation)))) + (cons drv sub-drvs)))))))) (let loop ((drv drv)) (let* ((inputs (map (cut rewritten-input <> loop) @@ -1057,13 +1056,13 @@ system, imported, and appears under FINAL-PATH in the resulting store path." (define search-path* ;; A memoizing version of 'search-path' so 'imported-modules' does not end ;; up looking for the same files over and over again. - (memoize (lambda (path file) - "Search for FILE in PATH and memoize the result. Raise a + (mlambda (path file) + "Search for FILE in PATH and memoize the result. Raise a '&file-search-error' condition if it could not be found." - (or (search-path path file) - (raise (condition - (&file-search-error (file file) - (path path)))))))) + (or (search-path path file) + (raise (condition + (&file-search-error (file file) + (path path))))))) (define (module->source-file-name module) "Return the file name corresponding to MODULE, a Guile module name (a list diff --git a/guix/download.scm b/guix/download.scm index e2e5cee777..813f51f489 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2016 David Craven <david@craven.ch> +;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,6 +36,7 @@ #:export (%mirrors url-fetch url-fetch/tarbomb + url-fetch/zipbomb download-to-store)) ;;; Commentary: @@ -86,6 +88,7 @@ "http://ftp.belnet.be/ftp.gnome.org/" "http://ftp.linux.org.uk/mirrors/ftp.gnome.org/" "http://ftp.gnome.org/pub/GNOME/" + "https://download.gnome.org/" "http://mirror.yandex.ru/mirrors/ftp.gnome.org/") (hackage "http://hackage.haskell.org/") @@ -485,17 +488,24 @@ in the store." (guile (default-guile))) "Similar to 'url-fetch' but unpack the file from URL in a directory of its own. This helper makes it easier to deal with \"tar bombs\"." + (define file-name + (match url + ((head _ ...) + (basename head)) + (_ + (basename url)))) (define gzip (module-ref (resolve-interface '(gnu packages compression)) 'gzip)) (define tar (module-ref (resolve-interface '(gnu packages base)) 'tar)) (mlet %store-monad ((drv (url-fetch url hash-algo hash - (string-append "tarbomb-" name) + (string-append "tarbomb-" + (or name file-name)) #:system system #:guile guile))) ;; Take the tar bomb, and simply unpack it as a directory. - (gexp->derivation name + (gexp->derivation (or name file-name) #~(begin (mkdir #$output) (setenv "PATH" (string-append #$gzip "/bin")) @@ -504,6 +514,35 @@ own. This helper makes it easier to deal with \"tar bombs\"." "xf" #$drv))) #:local-build? #t))) +(define* (url-fetch/zipbomb url hash-algo hash + #:optional name + #:key (system (%current-system)) + (guile (default-guile))) + "Similar to 'url-fetch' but unpack the zip file at URL in a directory of its +own. This helper makes it easier to deal with \"zip bombs\"." + (define file-name + (match url + ((head _ ...) + (basename head)) + (_ + (basename url)))) + (define unzip + (module-ref (resolve-interface '(gnu packages zip)) 'unzip)) + + (mlet %store-monad ((drv (url-fetch url hash-algo hash + (string-append "zipbomb-" + (or name file-name)) + #:system system + #:guile guile))) + ;; Take the zip bomb, and simply unpack it as a directory. + (gexp->derivation (or name file-name) + #~(begin + (mkdir #$output) + (chdir #$output) + (zero? (system* (string-append #$unzip "/bin/unzip") + #$drv))) + #:local-build? #t))) + (define* (download-to-store store url #:optional (name (basename url)) #:key (log (current-error-port)) recursive? (verify-certificate? #t)) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 789724c8c0..07e6909641 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -30,7 +30,7 @@ #:use-module (guix http-client) #:use-module (guix ftp-client) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) @@ -165,43 +165,48 @@ found." (official-gnu-packages))) (define gnu-package? - (memoize - (let ((official-gnu-packages (memoize official-gnu-packages))) - (lambda (package) - "Return true if PACKAGE is a GNU package. This procedure may access the + (let ((official-gnu-packages (memoize official-gnu-packages))) + (mlambdaq (package) + "Return true if PACKAGE is a GNU package. This procedure may access the network to check in GNU's database." - (define (mirror-type url) - (let ((uri (string->uri url))) - (and (eq? (uri-scheme uri) 'mirror) - (cond - ((member (uri-host uri) - '("gnu" "gnupg" "gcc" "gnome")) - ;; Definitely GNU. - 'gnu) - ((equal? (uri-host uri) "cran") - ;; Possibly GNU: mirror://cran could be either GNU R itself - ;; or a non-GNU package. - #f) - (else - ;; Definitely non-GNU. - 'non-gnu))))) - - (define (gnu-home-page? package) - (and=> (package-home-page package) - (lambda (url) - (and=> (uri-host (string->uri url)) - (lambda (host) - (member host '("www.gnu.org" "gnu.org"))))))) - - (or (gnu-home-page? package) - (let ((url (and=> (package-source package) origin-uri)) - (name (package-name package))) - (case (and (string? url) (mirror-type url)) - ((gnu) #t) - ((non-gnu) #f) - (else - (and (member name (map gnu-package-name (official-gnu-packages))) - #t))))))))) + (define (mirror-type url) + (let ((uri (string->uri url))) + (and (eq? (uri-scheme uri) 'mirror) + (cond + ((member (uri-host uri) + '("gnu" "gnupg" "gcc" "gnome")) + ;; Definitely GNU. + 'gnu) + ((equal? (uri-host uri) "cran") + ;; Possibly GNU: mirror://cran could be either GNU R itself + ;; or a non-GNU package. + #f) + (else + ;; Definitely non-GNU. + 'non-gnu))))) + + (define (gnu-home-page? package) + (letrec-syntax ((>> (syntax-rules () + ((_ value proc) + (and=> value proc)) + ((_ value proc rest ...) + (and=> value + (lambda (next) + (>> (proc next) rest ...))))))) + (>> package package-home-page + string->uri uri-host + (lambda (host) + (member host '("www.gnu.org" "gnu.org")))))) + + (or (gnu-home-page? package) + (let ((url (and=> (package-source package) origin-uri)) + (name (package-upstream-name package))) + (case (and (string? url) (mirror-type url)) + ((gnu) #t) + ((non-gnu) #f) + (else + (and (member name (map gnu-package-name (official-gnu-packages))) + #t)))))))) ;;; @@ -210,10 +215,11 @@ network to check in GNU's database." (define (ftp-server/directory package) "Return the FTP server and directory where PACKAGE's tarball are stored." - (values (or (assoc-ref (package-properties package) 'ftp-server) - "ftp.gnu.org") - (or (assoc-ref (package-properties package) 'ftp-directory) - (string-append "/gnu/" (package-name package))))) + (let ((name (package-upstream-name package))) + (values (or (assoc-ref (package-properties package) 'ftp-server) + "ftp.gnu.org") + (or (assoc-ref (package-properties package) 'ftp-directory) + (string-append "/gnu/" name))))) (define (sans-extension tarball) "Return TARBALL without its .tar.* or .zip extension." @@ -423,11 +429,9 @@ hosted on ftp.gnu.org, or not under that name (this is the case for \"emacs-auctex\", for instance.)" (let-values (((server directory) (ftp-server/directory package))) - (let ((name (or (assoc-ref (package-properties package) 'upstream-name) - (package-name package)))) - (false-if-ftp-error (latest-release name - #:server server - #:directory directory))))) + (false-if-ftp-error (latest-release (package-upstream-name package) + #:server server + #:directory directory)))) (define %package-name-rx ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses @@ -444,8 +448,10 @@ hosted on ftp.gnu.org, or not under that name (this is the case for (define (pure-gnu-package? package) "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package. This excludes AucTeX, for instance, whose releases are now uploaded to -elpa.gnu.org, and all the GNOME packages." - (and (not (string-prefix? "emacs-" (package-name package))) +elpa.gnu.org, and all the GNOME packages; EMMS is included though, because its +releases are on gnu.org." + (and (or (not (string-prefix? "emacs-" (package-name package))) + (gnu-hosted? package)) (not (gnome-package? package)) (gnu-package? package))) @@ -467,6 +473,9 @@ source URLs starts with PREFIX." (_ #f))) (_ #f)))) +(define gnu-hosted? + (url-prefix-predicate "mirror://gnu/")) + (define gnome-package? (url-prefix-predicate "mirror://gnome/")) @@ -491,8 +500,7 @@ source URLs starts with PREFIX." (define upstream-name ;; Some packages like "NetworkManager" have camel-case names. - (or (assoc-ref (package-properties package) 'upstream-name) - (package-name package))) + (package-upstream-name package)) (false-if-ftp-error (latest-ftp-release upstream-name @@ -516,8 +524,7 @@ source URLs starts with PREFIX." (let ((uri (string->uri (origin-uri (package-source package))))) (false-if-ftp-error (latest-ftp-release - (or (assoc-ref (package-properties package) 'upstream-name) - (package-name package)) + (package-upstream-name package) #:server "mirrors.mit.edu" #:directory (string-append "/kde" (dirname (dirname (uri-path uri)))) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 463a25514e..40cdea029b 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,7 @@ #:use-module (srfi srfi-41) #:use-module (ice-9 receive) #:use-module (web uri) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix http-client) #:use-module (guix hash) #:use-module (guix store) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 96cf5bbae6..c0b0c415cf 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,7 +35,6 @@ #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module ((guix combinators) #:select (memoize)) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (elpa->guix-package %elpa-updater)) diff --git a/guix/import/github.scm b/guix/import/github.scm index 1e0bb53d9a..b249b39067 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -49,7 +49,8 @@ "Return the extension of the archive e.g. '.tar.gz' given a URL, or false if none is recognized" (find (lambda (x) (string-suffix? x url)) - (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar" ".tgz" ".love"))) + (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar" + ".tgz" ".tbz" ".love"))) (define (updated-github-url old-package new-version) ;; Return a url for the OLD-PACKAGE with NEW-VERSION. If no source url in @@ -57,7 +58,7 @@ false if none is recognized" (define (updated-url url) (if (string-prefix? "https://github.com/" url) - (let ((ext (find-extension url)) + (let ((ext (or (find-extension url) "")) (name (package-name old-package)) (version (package-version old-package)) (prefix (string-append "https://github.com/" diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 7cce0fc594..ed0d4297a4 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -227,10 +227,8 @@ name/variable pairs describing the required inputs of this package." (sort (map (lambda (input) (list input (list 'unquote (string->symbol input)))) - (append '("python-setuptools") - ;; Argparse has been part of Python since 2.7. - (remove (cut string=? "python-argparse" <>) - (guess-requirements source-url wheel-url tarball)))) + (remove (cut string=? "python-argparse" <>) + (guess-requirements source-url wheel-url tarball))) (lambda args (match args (((a _ ...) (b _ ...)) diff --git a/guix/memoization.scm b/guix/memoization.scm new file mode 100644 index 0000000000..d64f60fe9c --- /dev/null +++ b/guix/memoization.scm @@ -0,0 +1,114 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 memoization) + #:export (memoize + mlambda + mlambdaq)) + +(define-syntax-rule (call/mv thunk) + (call-with-values thunk list)) +(define-syntax-rule (return/mv lst) + (apply values lst)) + +(define-syntax-rule (call/1 thunk) + (thunk)) +(define-syntax-rule (return/1 value) + value) + +(define %nothing ;nothingness + (list 'this 'is 'nothing)) + +(define-syntax define-cache-procedure + (syntax-rules () + "Define a procedure NAME that implements a cache using HASH-REF and +HASH-SET!. Use CALL to invoke the thunk and RETURN to return its value; CALL +and RETURN are used to distinguish between multiple-value and single-value +returns." + ((_ name hash-ref hash-set! call return) + (define (name cache key thunk) + "Cache the result of THUNK under KEY in CACHE, or return the +already-cached result." + (let ((results (hash-ref cache key %nothing))) + (if (eq? results %nothing) + (let ((results (call thunk))) + (hash-set! cache key results) + (return results)) + (return results))))) + ((_ name hash-ref hash-set!) + (define-cache-procedure name hash-ref hash-set! + call/mv return/mv)))) + +(define-cache-procedure cached/mv hash-ref hash-set!) +(define-cache-procedure cachedq/mv hashq-ref hashq-set!) +(define-cache-procedure cached hash-ref hash-set! call/1 return/1) +(define-cache-procedure cachedq hashq-ref hashq-set! call/1 return/1) + +(define (memoize proc) + "Return a memoizing version of PROC. + +This is a generic version of 'mlambda' what works regardless of the arity of +'proc'. It is more expensive since the argument list is always allocated, and +the result is returned via (apply values results)." + (let ((cache (make-hash-table))) + (lambda args + (cached/mv cache args + (lambda () + (apply proc args)))))) + +(define-syntax %mlambda + (syntax-rules () + "Return a memoizing lambda. This is restricted to procedures that return +exactly one value." + ((_ cached () body ...) + ;; The zero-argument case is equivalent to a promise. + (let ((result #f) (cached? #f)) + (lambda () + (unless cached? + (set! result (begin body ...)) + (set! cached? #t)) + result))) + + ;; Optimize the fixed-arity case such that there's no argument list + ;; allocated. XXX: We can't really avoid the closure allocation since + ;; Guile 2.0's compiler will always keep it. + ((_ cached (arg) body ...) ;one argument + (let ((cache (make-hash-table)) + (proc (lambda (arg) body ...))) + (lambda (arg) + (cached cache arg (lambda () (proc arg)))))) + ((_ _ (args ...) body ...) ;two or more arguments + (let ((cache (make-hash-table)) + (proc (lambda (args ...) body ...))) + (lambda (args ...) + ;; XXX: Always use 'cached', which uses 'equal?', to compare the + ;; argument lists. + (cached cache (list args ...) + (lambda () + (proc args ...)))))))) + +(define-syntax-rule (mlambda formals body ...) + "Define a memoizing lambda. The lambda's arguments are compared with +'equal?', and BODY is expected to yield a single return value." + (%mlambda cached formals body ...)) + +(define-syntax-rule (mlambdaq formals body ...) + "Define a memoizing lambda. If FORMALS lists a single argument, it is +compared using 'eq?'; otherwise, the argument list is compared using 'equal?'. +BODY is expected to yield a single return value." + (%mlambda cachedq formals body ...)) diff --git a/guix/modules.scm b/guix/modules.scm index 24f613ff4e..8c63f21a97 100644 --- a/guix/modules.scm +++ b/guix/modules.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix modules) - #:use-module ((guix utils) #:select (memoize)) + #:use-module (guix memoization) #:use-module (guix sets) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -71,18 +71,17 @@ CLAUSES." result))))) (define module-file-dependencies - (memoize - (lambda (file) - "Return the list of the names of modules that the Guile module in FILE + (mlambda (file) + "Return the list of the names of modules that the Guile module in FILE depends on." - (call-with-input-file file - (lambda (port) - (match (read port) - (('define-module name clauses ...) - (extract-dependencies clauses)) - ;; XXX: R6RS 'library' form is ignored. - (_ - '()))))))) + (call-with-input-file file + (lambda (port) + (match (read port) + (('define-module name clauses ...) + (extract-dependencies clauses)) + ;; XXX: R6RS 'library' form is ignored. + (_ + '())))))) (define (module-name->file-name module) "Return the file name for MODULE." diff --git a/guix/packages.scm b/guix/packages.scm index beb958f156..4bc4b017f4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> @@ -28,6 +28,7 @@ #:use-module (guix base32) #:use-module (guix grafts) #:use-module (guix derivations) + #:use-module (guix memoization) #:use-module (guix build-system) #:use-module (guix search-paths) #:use-module (guix gexp) @@ -62,6 +63,7 @@ package package? package-name + package-upstream-name package-version package-full-name package-source @@ -296,6 +298,12 @@ name of its URI." package) 16))))) +(define (package-upstream-name package) + "Return the upstream name of PACKAGE, which could be different from the name +it has in Guix." + (or (assq-ref (package-properties package) 'upstream-name) + (package-name package))) + (define (hidden-package p) "Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus, user interfaces, ignores." @@ -690,38 +698,19 @@ in INPUTS and their transitive propagated inputs." `(assoc-ref ,alist ,(label input))) (transitive-inputs inputs))) -(define-syntax define-memoized/v - (lambda (form) - "Define a memoized single-valued unary procedure with docstring. -The procedure argument is compared to cached keys using `eqv?'." - (syntax-case form () - ((_ (proc arg) docstring body body* ...) - (string? (syntax->datum #'docstring)) - #'(define proc - (let ((cache (make-hash-table))) - (define (proc arg) - docstring - (match (hashv-get-handle cache arg) - ((_ . value) - value) - (_ - (let ((result (let () body body* ...))) - (hashv-set! cache arg result) - result)))) - proc)))))) - -(define-memoized/v (package-transitive-supported-systems package) - "Return the intersection of the systems supported by PACKAGE and those +(define package-transitive-supported-systems + (mlambdaq (package) + "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (fold (lambda (input systems) - (match input - ((label (? package? p) . _) - (lset-intersection - string=? systems (package-transitive-supported-systems p))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package)))) + (fold (lambda (input systems) + (match input + ((label (? package? p) . _) + (lset-intersection + string=? systems (package-transitive-supported-systems p))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package))))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its @@ -768,14 +757,15 @@ package and returns its new name after rewrite." (_ input))) - (define-memoized/v (replace p) - "Return a variant of P with its inputs rewritten." - (package - (inherit p) - (name (rewrite-name (package-name p))) - (inputs (map rewrite (package-inputs p))) - (native-inputs (map rewrite (package-native-inputs p))) - (propagated-inputs (map rewrite (package-propagated-inputs p))))) + (define replace + (mlambdaq (p) + ;; Return a variant of P with its inputs rewritten. + (package + (inherit p) + (name (rewrite-name (package-name p))) + (inputs (map rewrite (package-inputs p))) + (native-inputs (map rewrite (package-native-inputs p))) + (propagated-inputs (map rewrite (package-propagated-inputs p)))))) replace) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index d7d71b7ab9..68402fda18 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -24,7 +24,6 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) - #:use-module (guix combinators) ;; Use the procedure that destructures "NAME-VERSION" forms. #:use-module ((guix utils) #:hide (package-name->name+version)) diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm index 9ae204e6c6..624ef73e96 100644 --- a/guix/scripts/copy.scm +++ b/guix/scripts/copy.scm @@ -63,8 +63,8 @@ Throw an error on failure." (match (connect! session) ('ok - ;; Let the SSH agent authenticate us to the server. - (match (userauth-agent! session) + ;; Use public key authentication, via the SSH agent if it's available. + (match (userauth-public-key/auto! session) ('success session) (x diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index a08367d1b1..8a3a935a10 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -421,7 +421,8 @@ host file systems to mount inside the container." ;; read-only within the ;; container. (writable? - (string=? "/etc/resolv.conf"))))) + (string=? file + "/etc/resolv.conf"))))) %network-configuration-files) '()) ;; Mappings for the union closure of all inputs. diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 79ce503a2e..9804d41929 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,12 +21,12 @@ #:use-module (guix graph) #:use-module (guix grafts) #:use-module (guix scripts) - #:use-module (guix combinators) #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix derivations) + #:use-module (guix memoization) #:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module (gnu packages) #:use-module (guix sets) @@ -191,12 +191,11 @@ Dependencies may include packages, origin, and file names." %store-monad)))) (define standard-package-set - (memoize - (lambda () - "Return the set of standard packages provided by GNU-BUILD-SYSTEM." - (match (standard-packages) - (((labels packages . output) ...) - (list->setq packages)))))) + (mlambda () + "Return the set of standard packages provided by GNU-BUILD-SYSTEM." + (match (standard-packages) + (((labels packages . output) ...) + (list->setq packages))))) (define (bag-node-edges-sans-bootstrap thing) "Like 'bag-node-edges', but pretend that the standard packages of diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index afc1369ad1..776e7332c5 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -32,7 +32,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) @@ -90,9 +90,9 @@ ;; provided MESSAGE. (let ((loc (or (package-field-location package field) (package-location package)))) - (format (guix-warning-port) "~a: ~a: ~a~%" + (format (guix-warning-port) "~a: ~a@~a: ~a~%" (location->string loc) - (package-full-name package) + (package-name package) (package-version package) message))) (define (call-with-accumulated-warnings thunk) @@ -559,12 +559,11 @@ patch could not be found." str))) (define official-gnu-packages* - (memoize - (lambda () - "A memoizing version of 'official-gnu-packages' that returns the empty + (mlambda () + "A memoizing version of 'official-gnu-packages' that returns the empty list when something goes wrong, such as a networking issue." - (let ((gnus (false-if-exception (official-gnu-packages)))) - (or gnus '()))))) + (let ((gnus (false-if-exception (official-gnu-packages)))) + (or gnus '())))) (define (check-gnu-synopsis+description package) "Make sure that, if PACKAGE is a GNU package, it uses the synopsis and diff --git a/guix/serialization.scm b/guix/serialization.scm index 5953b84616..4cab5910f7 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,7 +30,7 @@ #:export (write-int read-int write-long-long read-long-long write-padding - write-string + write-bytevector write-string read-string read-latin1-string read-maybe-utf8-string write-string-list read-string-list write-string-pairs @@ -102,15 +102,17 @@ (or (zero? m) (put-bytevector p zero 0 (- 8 m))))))) -(define (write-string s p) - (let* ((s (string->utf8 s)) - (l (bytevector-length s)) +(define (write-bytevector s p) + (let* ((l (bytevector-length s)) (m (modulo l 8)) (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m)))))) (bytevector-u32-set! b 0 l (endianness little)) (bytevector-copy! s 0 b 8 l) (put-bytevector p b))) +(define (write-string s p) + (write-bytevector (string->utf8 s) p)) + (define (read-byte-string p) (let* ((len (read-int p)) (m (modulo len 8)) diff --git a/guix/store.scm b/guix/store.scm index 7152a5556a..cce460f3ce 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -19,7 +19,7 @@ (define-module (guix store) #:use-module (guix utils) #:use-module (guix config) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix serialization) #:use-module (guix monads) #:autoload (guix base32) (bytevector->base32-string) @@ -67,6 +67,7 @@ query-path-hash hash-part->path query-path-info + add-data-to-store add-text-to-store add-to-store build-things @@ -266,12 +267,15 @@ (path-info deriver hash refs registration-time nar-size))) (define-syntax write-arg - (syntax-rules (integer boolean string string-list string-pairs + (syntax-rules (integer boolean bytevector + string string-list string-pairs store-path store-path-list base16) ((_ integer arg p) (write-int arg p)) ((_ boolean arg p) (write-int (if arg 1 0) p)) + ((_ bytevector arg p) + (write-bytevector arg p)) ((_ string arg p) (write-string arg p)) ((_ string-list arg p) @@ -669,25 +673,31 @@ string). Raise an error if no such path exists." "Return the info (hash, references, etc.) for PATH." path-info) -(define add-text-to-store +(define add-data-to-store ;; A memoizing version of `add-to-store', to avoid repeated RPCs with ;; the very same arguments during a given session. (let ((add-text-to-store - (operation (add-text-to-store (string name) (string text) + (operation (add-text-to-store (string name) (bytevector text) (string-list references)) #f store-path))) - (lambda* (server name text #:optional (references '())) - "Add TEXT under file NAME in the store, and return its store path. + (lambda* (server name bytes #:optional (references '())) + "Add BYTES under file NAME in the store, and return its store path. REFERENCES is the list of store paths referred to by the resulting store path." - (let ((args `(,text ,name ,references)) - (cache (nix-server-add-text-to-store-cache server))) + (let* ((args `(,bytes ,name ,references)) + (cache (nix-server-add-text-to-store-cache server))) (or (hash-ref cache args) - (let ((path (add-text-to-store server name text references))) + (let ((path (add-text-to-store server name bytes references))) (hash-set! cache args path) path)))))) +(define* (add-text-to-store store name text #:optional (references '())) + "Add TEXT under file NAME in the store, and return its store path. +REFERENCES is the list of store paths referred to by the resulting store +path." + (add-data-to-store store name (string->utf8 text) references)) + (define true ;; Define it once and for all since we use it as a default value for ;; 'add-to-store' and want to make sure two default values are 'eq?' for the @@ -1282,11 +1292,10 @@ valid inputs." (define store-regexp* ;; The substituter makes repeated calls to 'store-path-hash-part', hence ;; this optimization. - (memoize - (lambda (store) - "Return a regexp matching a file in STORE." - (make-regexp (string-append "^" (regexp-quote store) - "/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))) + (mlambda (store) + "Return a regexp matching a file in STORE." + (make-regexp (string-append "^" (regexp-quote store) + "/([0-9a-df-np-sv-z]{32})-([^/]+)$")))) (define (store-path-package-name path) "Return the package name part of PATH, a file name in the store." diff --git a/guix/utils.scm b/guix/utils.scm index ee06e47fe9..72dc0687a4 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -33,7 +33,7 @@ #:use-module (ice-9 binary-ports) #:autoload (rnrs io ports) (make-custom-binary-input-port) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module (ice-9 vlist) @@ -771,11 +771,10 @@ be determined." (column location-column)) ; 0-indexed column (define location - (memoize - (lambda (file line column) - "Return the <location> object for the given FILE, LINE, and COLUMN." - (and line column file - (make-location file line column))))) + (mlambda (file line column) + "Return the <location> object for the given FILE, LINE, and COLUMN." + (and line column file + (make-location file line column)))) (define (source-properties->location loc) "Return a location object based on the info in LOC, an alist as returned diff --git a/tests/bournish.scm b/tests/bournish.scm index 0f529ce42f..3b40ce2643 100644 --- a/tests/bournish.scm +++ b/tests/bournish.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,5 +39,16 @@ (read-and-compile (open-input-string "cd /foo\npwd\nls") #:from %bournish-language #:to 'scheme)) +(test-equal "rm" + '(for-each delete-file (list "foo" "bar")) + (read-and-compile (open-input-string "rm foo bar\n") + #:from %bournish-language #:to 'scheme)) + +(test-equal "rm -r" + '(for-each (@ (guix build utils) delete-file-recursively) + (list "/foo" "/bar")) + (read-and-compile (open-input-string "rm -r /foo /bar\n") + #:from %bournish-language #:to 'scheme)) + (test-end "bournish") diff --git a/tests/pypi.scm b/tests/pypi.scm index f26e7fea13..447c23ee95 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -130,8 +130,7 @@ baz > 13.37") ('propagated-inputs ('quasiquote (("python-bar" ('unquote 'python-bar)) - ("python-baz" ('unquote 'python-baz)) - ("python-setuptools" ('unquote 'python-setuptools))))) + ("python-baz" ('unquote 'python-baz))))) ('home-page "http://example.com") ('synopsis "summary") ('description "summary") @@ -194,8 +193,7 @@ baz > 13.37") ('propagated-inputs ('quasiquote (("python-bar" ('unquote 'python-bar)) - ("python-baz" ('unquote 'python-baz)) - ("python-setuptools" ('unquote 'python-setuptools))))) + ("python-baz" ('unquote 'python-baz))))) ('home-page "http://example.com") ('synopsis "summary") ('description "summary") diff --git a/tests/store.scm b/tests/store.scm index 983766d862..64d3553f25 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -92,6 +92,11 @@ (test-skip (if %store 0 13)) +(test-equal "add-data-to-store" + #vu8(1 2 3 4 5) + (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5)) + get-bytevector-all)) + (test-assert "valid-path? live" (let ((p (add-text-to-store %store "hello" "hello, world"))) (valid-path? %store p))) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 92e02f3303..1934704375 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -456,7 +456,7 @@ (eof-object? (read-utmpx (%make-void-port "r")))) (unless (access? "/var/run/utmpx" O_RDONLY) - (tes-skip 1)) + (test-skip 1)) (test-assert "read-utmpx" (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (or (utmpx? result) (eof-object? result)))) |