me/guix
Archived
1
0
Fork 0
Code Activity

Merge branch 'master' into staging

Browse source
This commit is contained in:
Marius Bakke 2017-05-22 14:56:50 +02:00
commit e4cddbbcac
No known key found for this signature in database
GPG key ID: A2A06DF2A33A54FA
106 changed files with 5083 additions and 1492 deletions
.dir-locals.elMakefile.am
build-aux/hydra
gnu-system.scm
doc
guix.texi
gnu.scm
gnu
bootloader.scm
bootloader
extlinux.scmgrub.scm
build
activation.scminstall.scmvm.scm
local.mk
packages
admin.scmaspell.scm
aux-files/linux-libre
4.11-i686.conf4.11-x86_64.conf
backup.scmbase.scmbenchmark.scmbioinformatics.scmdns.scmebook.scmemacs.scmengineering.scmgames.scmghostscript.scmgnome.scmgnupg.scmicu4c.scmimage-processing.scmimage.scmimagemagick.scmjava.scmkde-frameworks.scmlibusb.scmlinux.scmlisp.scmlogging.scmmail.scmmc.scmmes.scmmusic.scmnano.scmpackage-management.scm
patches
aspell-default-dict-dir.patchcalibre-dont-load-remote-icons.patchcalibre-drop-unrar.patchcalibre-use-packaged-feedparser.patchgspell-dash-test.patchguile-ssh-double-free.patchguile-ssh-rexec-bug.patchjbig2dec-CVE-2017-7885.patchjbig2dec-CVE-2017-7975.patchjbig2dec-CVE-2017-7976.patchnetworkmanager-qt-activeconnection-test-1.patchnetworkmanager-qt-activeconnection-test-2.patchqemu-CVE-2017-7493.patchqtscript-disable-tests.patchruby-concurrent-test-arm.patchshadow-4.4-su-snprintf-fix.patchshadow-CVE-2017-2616.patch
php.scmpython.scmqemu.scmqt.scmruby.scmsecurity-token.scmshells.scmssh.scmsssd.scmtextutils.scmtls.scmtor.scmvideo.scmvim.scmweb.scmxml.scm
services
base.scmpm.scmssh.scm
system.scm
system
examples
lightweight-desktop.tmplvm-image.tmpl
install.scmlinux-initrd.scmvm.scm
tests.scm
tests
base.scmnfs.scm
guix
build-system
asdf.scm
build
asdf-build-system.scmlisp-utils.scmunion.scm
download.scm
import
cran.scm
licenses.scmmodules.scmprofiles.scm
scripts
lint.scmpack.scm
Show more

1
.dir-locals.el
View file

@ -17,6 +17,7 @@
(eval . (put 'call-with-prompt 'scheme-indent-function 1))
(eval . (put 'test-assert 'scheme-indent-function 1))
(eval . (put 'test-assertm 'scheme-indent-function 1))
(eval . (put 'test-equalm 'scheme-indent-function 1))
(eval . (put 'test-equal 'scheme-indent-function 1))
(eval . (put 'test-eq 'scheme-indent-function 1))
(eval . (put 'call-with-input-string 'scheme-indent-function 1))

37
Makefile.am
View file

@ -5,6 +5,7 @@
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2016, 2017 Mark H Weaver <mhw@netris.org>
# Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
# Copyright © 2017 Leo Famulari <leo@famulari.name>
#
# This file is part of GNU Guix.
#
@ -160,7 +161,6 @@ MODULES = \
guix/scripts/import/gnu.scm \
guix/scripts/import/nix.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/stackage.scm \
guix/scripts/import/elpa.scm \
guix/scripts/environment.scm \
guix/scripts/publish.scm \
@ -185,7 +185,8 @@ MODULES += \
guix/import/stackage.scm \
guix/scripts/import/crate.scm \
guix/scripts/import/gem.scm \
guix/scripts/import/pypi.scm
guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm
endif
@ -224,7 +225,8 @@ AUX_FILES = \
EXAMPLES = \
gnu/system/examples/bare-bones.tmpl \
gnu/system/examples/desktop.tmpl \
gnu/system/examples/lightweight-desktop.tmpl
gnu/system/examples/lightweight-desktop.tmpl \
gnu/system/examples/vm-image.tmpl
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)
@ -571,12 +573,21 @@ BINARY_TARBALLS = \
# Systems supported by GuixSD.
GUIXSD_SUPPORTED_SYSTEMS ?= x86_64-linux i686-linux
# Systems for which we build GuixSD VMs.
GUIXSD_VM_SYSTEMS ?= x86_64-linux
# Prefix of the GuixSD installation image file name.
GUIXSD_IMAGE_BASE = guixsd-usb-install-$(PACKAGE_VERSION)
# Prefix of the GuixSD VM image file name.
GUIXSD_VM_IMAGE_BASE = guixsd-vm-image-$(PACKAGE_VERSION)
# Size of the installation image (for x86_64 typically).
GUIXSD_INSTALLATION_IMAGE_SIZE ?= 950MiB
# Size of the VM image (for x86_64 typically).
GUIXSD_VM_IMAGE_SIZE ?= 2GiB
# The release process works in several phases:
#
# 0. We assume the developer created a 'vX.Y' tag.
@ -589,7 +600,10 @@ GUIXSD_INSTALLATION_IMAGE_SIZE ?= 950MiB
#
# This 'release' target takes care of everything and copies the resulting
# files to $(releasedir).
release: distcheck
#
# XXX: Depend on 'dist' rather than 'distcheck' to work around the Gettext
# issue described at <https://savannah.gnu.org/bugs/index.php?51027>.
release: dist
cd po; git checkout .
@if ! git diff-index --quiet HEAD; then \
echo "There are uncommitted changes; stopping." >&2 ; \
@ -617,6 +631,7 @@ release: distcheck
for system in $(GUIXSD_SUPPORTED_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system disk-image \
--system=$$system \
--image-size=$(GUIXSD_INSTALLATION_IMAGE_SIZE) \
gnu/system/install.scm` ; \
if [ ! -f "$$image" ] ; then \
@ -627,6 +642,20 @@ release: distcheck
mv "$(releasedir)/$(GUIXSD_IMAGE_BASE).$$system.xz.tmp" \
"$(releasedir)/$(GUIXSD_IMAGE_BASE).$$system.xz" ; \
done
for system in $(GUIXSD_VM_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system vm-image \
--system=$$system \
--image-size=$(GUIXSD_VM_IMAGE_SIZE) \
gnu/system/examples/vm-image.tmpl` ; \
if [ ! -f "$$image" ] ; then \
echo "failed to produced GuixSD VM image for $$system" >&2 ; \
exit 1 ; \
fi ; \
xz < "$$image" > "$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz.tmp" ; \
mv "$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz.tmp" \
"$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz" ; \
done
@echo
@echo "Congratulations! All the release files are now in $(releasedir)."
@echo

2
build-aux/hydra/gnu-system.scm
View file

@ -111,7 +111,7 @@ SYSTEM."
;; chain.)
(list gcc-4.8 gcc-4.9 gcc-5 glibc binutils
gmp mpfr mpc coreutils findutils diffutils patch sed grep
gawk gnu-gettext hello guile-2.0 zlib gzip xz
gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
%bootstrap-binaries-tarball
%binutils-bootstrap-tarball
(%glibc-bootstrap-tarball)

177
doc/guix.texi
View file

@ -35,7 +35,9 @@ Copyright @copyright{} 2017 Mathieu Othacehe@*
Copyright @copyright{} 2017 Federico Beffa@*
Copyright @copyright{} 2017 Carlo Zancanaro@*
Copyright @copyright{} 2017 Thomas Danckaert@*
Copyright @copyright{} 2017 humanitiesNerd
Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017 Christopher Allan Webber@*
Copyright @copyright{} 2017 Marius Bakke
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -2892,6 +2894,10 @@ package definition using the @command{guix edit} command
more information on how to test package definitions, and
@ref{Invoking guix lint}, for information on how to check a definition
for style conformance.
@vindex GUIX_PACKAGE_PATH
Lastly, @pxref{Package Modules}, for information
on how to extend the distribution by adding your own package definitions
to @code{GUIX_PACKAGE_PATH}.
Finally, updating the package definition to a new upstream version
can be partly automated by the @command{guix refresh} command
@ -3353,23 +3359,8 @@ These build systems can also be used to produce executable programs, or
lisp images which contain a set of packages pre-loaded.
The build system uses naming conventions. For binary packages, the
package itself as well as its run-time dependencies should begin their
name with the lisp implementation, such as @code{sbcl-} for
@code{asdf-build-system/sbcl}. Beginning the input name with this
prefix will allow the build system to encode its location into the
resulting library, so that the input can be found at run-time.
If dependencies are used only for tests, it is convenient to use a
different prefix in order to avoid having a run-time dependency on such
systems. For example,
@example
(define-public sbcl-bordeaux-threads
(package
...
(native-inputs `(("tests:cl-fiveam" ,sbcl-fiveam)))
...))
@end example
package name should be prefixed with the lisp implementation, such as
@code{sbcl-} for @code{asdf-build-system/sbcl}.
Additionally, the corresponding source package should be labeled using
the same convention as python packages (see @ref{Python Modules}), using
@ -3389,7 +3380,16 @@ expressions to be passed as the @code{#:entry-program} argument.
If the system is not defined within its own @code{.asd} file of the same
name, then the @code{#:asd-file} parameter should be used to specify
which file the system is defined in.
which file the system is defined in. Furthermore, if the package
defines a system for its tests in a separate file, it will be loaded
before the tests are run if it is specified by the
@code{#:test-asd-file} parameter. If it is not set, the files
@code{<system>-tests.asd}, @code{<system>-test.asd}, @code{tests.asd},
and @code{test.asd} will be tried if they exist.
If for some reason the package must be named in a different way than the
naming conventions suggest, the @code{#:asd-system-name} parameter can
be used to specify the name of the system.
@end defvr
@ -7315,14 +7315,15 @@ copy the image with:
@example
dd if=guixsd-usb-install-@value{VERSION}.x86_64 of=/dev/sdX
sync
@end example
Access to @file{/dev/sdX} usually requires root privileges.
@end enumerate
Once this is done, you should be able to reboot the system and boot from
the USB stick. The latter usually requires you to get in the BIOS' boot
menu, where you can choose to boot from the USB stick.
the USB stick. The latter usually requires you to get in the BIOS' or
UEFI boot menu, where you can choose to boot from the USB stick.
@xref{Installing GuixSD in a VM}, if, instead, you would like to install
GuixSD in a virtual machine (VM).
@ -7446,6 +7447,17 @@ ping -c 3 gnu.org
Setting up network access is almost always a requirement because the
image does not contain all the software and tools that may be needed.
@cindex installing over SSH
If you want to, you can continue the installation remotely by starting
an SSH server:
@example
herd start ssh-daemon
@end example
Make sure to either set a password with @command{passwd}, or configure
OpenSSH public key authentication before logging in.
@subsubsection Disk Partitioning
Unless this has already been done, the next step is to partition, and
@ -7465,6 +7477,17 @@ install BIOS-based GRUB (which is the default), make sure a BIOS Boot
Partition is available (@pxref{BIOS installation,,, grub, GNU GRUB
manual}).
@cindex EFI, installation
@cindex UEFI, installation
@cindex ESP, EFI system partition
If you instead wish to use EFI-based GRUB, a FAT32 @dfn{EFI System Partition}
(ESP) is required. This partition should be mounted at @file{/boot/efi} and
must have the @code{esp} flag set. E.g., for @command{parted}:
@example
parted /dev/sda set 1 esp on
@end example
Once you are done partitioning the target hard disk drive, you have to
create a file system on the relevant partition(s)@footnote{Currently
GuixSD only supports ext4 and btrfs file systems. In particular, code
@ -7504,6 +7527,11 @@ root partition):
mount LABEL=my-root /mnt
@end example
Also mount any other partitions you would like to use on the target
system relative to this path. If you have @file{/boot} on a separate
partition for example, mount it at @file{/mnt/boot} now so it is found
by @code{guix system init} afterwards.
Finally, if you plan to use one or more swap partitions (@pxref{Memory
Concepts, swap space,, libc, The GNU C Library Reference Manual}), make
sure to initialize them with @command{mkswap}. Assuming you have one
@ -7578,7 +7606,8 @@ in particular:
@itemize
@item
Make sure the @code{grub-configuration} form refers to the device you
want to install GRUB on.
want to install GRUB on. You also need to specify the @code{grub-efi}
package if you wish to use native UEFI boot.
@item
Be sure that your partition labels match the value of their respective
@ -7628,8 +7657,11 @@ good.
@subsection Installing GuixSD in a Virtual Machine
@cindex virtual machine, GuixSD installation
If you'd like to install GuixSD in a virtual machine (VM) rather than on
your beloved machine, this section is for you.
@cindex virtual private server (VPS)
@cindex VPS (virtual private server)
If you'd like to install GuixSD in a virtual machine (VM) or on a
virtual private server (VPS) rather than on your beloved machine, this
section is for you.
To boot a @uref{http://qemu.org/,QEMU} VM for installing GuixSD in a
disk image, follow these steps:
@ -7864,7 +7896,7 @@ management, power management, and more, would look like this:
@include os-config-desktop.texi
@end lisp
A graphical environment with a choice of lightweight window managers
A graphical UEFI system with a choice of lightweight window managers
instead of full-blown desktop environments would look like this:
@lisp
@ -14617,6 +14649,31 @@ Defaults to @samp{#f}.
@end deftypevr
The @code{(gnu services pm)} module provides an interface to
thermald, a CPU frequency scaling service which helps prevent overheating.
@defvr {Scheme Variable} thermald-service-type
This is the service type for
@uref{https://01.org/linux-thermal-daemon/, thermald}, the Linux
Thermal Daemon, which is responsible for controlling the thermal state
of processors and preventing overheating.
@end defvr
@deftp {Data Type} thermald-configuration
Data type representing the configuration of @code{thermald-service-type}.
@table @asis
@item @code{ignore-cpuid-check?} (default: @code{#f})
Ignore cpuid check for supported CPU models.
@item @code{thermald} (default: @var{thermald})
Package object of thermald.
@end table
@end deftp
@node Miscellaneous Services
@subsubsection Miscellaneous Services
@ -14906,6 +14963,19 @@ $ export SSL_CERT_FILE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
$ export GIT_SSL_CAINFO="$SSL_CERT_FILE"
@end example
As another example, R requires the @code{CURL_CA_BUNDLE} environment
variable to point to a certificate bundle, so you would have to run
something like this:
@example
$ guix package -i nss-certs
$ export CURL_CA_BUNDLE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
@end example
For other applications you may want to look up the required environment
variable in the relevant documentation.
@node Name Service Switch
@subsection Name Service Switch
@ -15224,7 +15294,38 @@ The number of seconds to wait for keyboard input before booting. Set to
The @code{grub-theme} object describing the theme to use.
@item @code{grub} (default: @code{grub})
The GRUB package to use.
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
The GRUB package to use. Currently either @code{grub}, for ``legacy''
x86 BIOS systems, or @code{grub-efi}, for modern systems using the
@dfn{Unified Extensible Firmware Interface} (UEFI).
@item @code{terminal-outputs} (default: @code{'gfxterm})
The output terminals used for the GRUB boot menu, as a list of symbols.
These values are accepted: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text}, @code{mda_text},
@code{morse}, and @code{pkmodem}. This field corresponds to the GRUB
variable GRUB_TERMINAL_OUTPUT (@pxref{Simple configuration,,, grub,GNU
GRUB manual}).
@item @code{terminal-inputs} (default: @code{'()})
The input terminals used for the GRUB boot menu, as a list of symbols.
The default is the native platform terminal as determined by GRUB at
run-time. These values are accepted: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{at_keyboard}, and @code{usb_keyboard}.
This field corresponds to the GRUB variable GRUB_TERMINAL_INPUT
(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
@item @code{serial-unit} (default: @code{#f})
The serial unit used by GRUB, as an integer from 0 to 3. The default
value is chosen by GRUB at run-time; currently GRUB chooses 0, which
corresponds to COM1 (@pxref{Serial terminal,,, grub,GNU GRUB manual}).
@item @code{serial-speed} (default: @code{#f})
The speed of the serial interface, as an integer. The default value is
chosen by GRUB at run-time; currently GRUB chooses 9600@tie{}bps
(@pxref{Serial terminal,,, grub,GNU GRUB manual}).
@end table
@end deftp
@ -15623,17 +15724,21 @@ example graph.
@subsection Running GuixSD in a Virtual Machine
@cindex virtual machine
One way to run GuixSD in a virtual machine (VM) is to build a GuixSD
virtual machine image using @command{guix system vm-image}
(@pxref{Invoking guix system}). The returned image is in qcow2 format,
which the @uref{http://qemu.org/, QEMU emulator} can efficiently use.
To run GuixSD in a virtual machine (VM), one can either use the
pre-built GuixSD VM image distributed at
@indicateurl{ftp://alpha.gnu.org/guix/guixsd-vm-image-@value{VERSION}.@var{system}.tar.xz}
, or build their own virtual machine image using @command{guix system
vm-image} (@pxref{Invoking guix system}). The returned image is in
qcow2 format, which the @uref{http://qemu.org/, QEMU emulator} can
efficiently use.
@cindex QEMU
To run the image in QEMU, copy it out of the store (@pxref{The Store})
and give yourself permission to write to the copy. When invoking QEMU,
you must choose a system emulator that is suitable for your hardware
platform. Here is a minimal QEMU invocation that will boot the result
of @command{guix system vm-image} on x86_64 hardware:
If you built your own image, you must copy it out of the store
(@pxref{The Store}) and give yourself permission to write to the copy
before you can use it. When invoking QEMU, you must choose a system
emulator that is suitable for your hardware platform. Here is a minimal
QEMU invocation that will boot the result of @command{guix system
vm-image} on x86_64 hardware:
@example
$ qemu-system-x86_64 \
@ -15679,7 +15784,7 @@ to your system definition and start the VM using
@command{`guix system vm config.scm` -net user}. An important caveat of using
@command{-net user} for networking is that @command{ping} will not work, because
it uses the ICMP protocol. You'll have to use a different command to check for
network connectivity, like for example @command{curl}.
network connectivity, for example @command{guix download}.
@subsubsection Connecting Through SSH

4
gnu.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -34,7 +35,8 @@
'((gnu system)
(gnu system mapped-devices)
(gnu system file-systems)
(gnu system grub) ; 'grub-configuration'
(gnu bootloader)
(gnu bootloader grub)
(gnu system pam)
(gnu system shadow) ; 'user-account'
(gnu system linux-initrd)

127
gnu/bootloader.scm Normal file
View file

@ -0,0 +1,127 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
#:use-module (guix discovery)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:export (bootloader
bootloader?
bootloader-name
bootloader-package
bootloader-installer
bootloader-configuration-file
bootloader-configuration-file-generator
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
bootloader-configuration-device
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
bootloader-configuration-timeout
bootloader-configuration-theme
bootloader-configuration-terminal-outputs
bootloader-configuration-terminal-inputs
bootloader-configuration-serial-unit
bootloader-configuration-serial-speed
bootloader-configuration-additional-configuration
%bootloaders
lookup-bootloader-by-name))
;;;
;;; Bootloader record.
;;;
;; The <bootloader> record contains fields expressing how the bootloader
;; should be installed. Every bootloader in gnu/bootloader/ directory
;; has to be described by this record.
(define-record-type* <bootloader>
bootloader make-bootloader
bootloader?
(name bootloader-name)
(package bootloader-package)
(installer bootloader-installer)
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
;;;
;;; Bootloader configuration record.
;;;
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader bootloader-configuration-bootloader) ; <bootloader>
(device bootloader-configuration-device ; string
(default #f))
(menu-entries bootloader-configuration-menu-entries ; list of <boot-parameters>
(default '()))
(default-entry bootloader-configuration-default-entry ; integer
(default 0))
(timeout bootloader-configuration-timeout ; seconds as integer
(default 5))
(theme bootloader-configuration-theme ; bootloader-specific theme
(default #f))
(terminal-outputs bootloader-configuration-terminal-outputs ; list of symbols
(default '(gfxterm)))
(terminal-inputs bootloader-configuration-terminal-inputs ; list of symbols
(default '()))
(serial-unit bootloader-configuration-serial-unit ; integer | #f
(default #f))
(serial-speed bootloader-configuration-serial-speed ; integer | #f
(default #f))
(additional-configuration bootloader-configuration-additional-configuration ; record
(default #f)))
;;;
;;; Bootloaders.
;;;
(define (bootloader-modules)
"Return the list of bootloader modules."
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
%load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
(delay (fold-module-public-variables (lambda (obj result)
(if (bootloader? obj)
(cons obj result)
result))
'()
(bootloader-modules))))
(define (lookup-bootloader-by-name name)
"Return the bootloader called NAME."
(or (find (lambda (bootloader)
(eq? name (bootloader-name bootloader)))
(force %bootloaders))
(leave (G_ "~a: no such bootloader~%") name)))

120
gnu/bootloader/extlinux.scm Normal file
View file

@ -0,0 +1,120 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu system)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix utils)
#:export (extlinux-bootloader))
(define* (extlinux-configuration-file config entries
#:key
(system (%current-system))
(old-entries '()))
"Return the U-Boot configuration file corresponding to CONFIG, a
<u-boot-configuration> object, and where the store is available at STORE-FS, a
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (boot-parameters->gexp params)
(let ((label (boot-parameters-label params))
(kernel (boot-parameters-kernel params))
(kernel-arguments (boot-parameters-kernel-arguments params))
(initrd (boot-parameters-initrd params)))
#~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
FDTDIR ~a/lib/dtbs
INITRD ~a
APPEND ~a
~%"
#$label #$label
#$kernel #$kernel #$initrd
(string-join (list #$@kernel-arguments)))))
(define builder
#~(call-with-output-file #$output
(lambda (port)
(let ((timeout #$(bootloader-configuration-timeout config)))
(format port "# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
PROMPT ~a
TIMEOUT ~a~%"
(if (> timeout 0) 1 0)
;; timeout is expressed in 1/10s of seconds.
(* 10 timeout))
#$@(map boot-parameters->gexp all-entries)
#$@(if (pair? old-entries)
#~((format port "~%")
#$@(map boot-parameters->gexp old-entries)
(format port "~%"))
#~())))))
(gexp->derivation "extlinux.conf" builder))
;;;
;;; Install procedures.
;;;
(define dd
#~(lambda (bs count if of)
(zero? (system* "dd"
(string-append "bs=" (number->string bs))
(string-append "count=" (number->string count))
(string-append "if=" if)
(string-append "of=" of)))))
(define install-extlinux
#~(lambda (bootloader device mount-point)
(let ((extlinux (string-append bootloader "/sbin/extlinux"))
(install-dir (string-append mount-point "/boot/extlinux"))
(syslinux-dir (string-append bootloader "/share/syslinux")))
(for-each (lambda (file)
(install-file file install-dir))
(find-files syslinux-dir "\\.c32$"))
(unless (and (zero? (system* extlinux "--install" install-dir))
(#$dd 440 1 (string-append syslinux-dir "/mbr.bin") device))
(error "failed to install SYSLINUX")))))
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
(name 'extlinux)
(package syslinux)
(installer install-extlinux)
(configuration-file "/boot/extlinux/extlinux.conf")
(configuration-file-generator extlinux-configuration-file)))

184
gnu/system/grub.scm → gnu/bootloader/grub.scm
View file

@ -1,6 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -17,7 +19,7 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system grub)
(define-module (gnu bootloader grub)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations)
@ -27,6 +29,7 @@
#:use-module (guix download)
#:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
@ -49,15 +52,10 @@
%background-image
%default-theme
grub-configuration
grub-configuration?
grub-configuration-device
grub-configuration-grub
grub-bootloader
grub-efi-bootloader
menu-entry
menu-entry?
grub-configuration-file))
grub-configuration))
;;; Commentary:
;;;
@ -105,21 +103,6 @@ denoting a file name."
(color-highlight '((fg . yellow) (bg . black)))
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030
(define-record-type* <grub-configuration>
grub-configuration make-grub-configuration
grub-configuration?
(grub grub-configuration-grub ; package
(default (@ (gnu packages bootloaders) grub)))
(device grub-configuration-device) ; string
(menu-entries grub-configuration-menu-entries ; list
(default '()))
(default-entry grub-configuration-default-entry ; integer
(default 0))
(timeout grub-configuration-timeout ; integer
(default 5))
(theme grub-configuration-theme ; <grub-theme>
(default %default-theme)))
(define-record-type* <menu-entry>
menu-entry make-menu-entry
menu-entry?
@ -138,6 +121,11 @@ denoting a file name."
;;; Background image & themes.
;;;
(define (bootloader-theme config)
"Return user defined theme in CONFIG if defined or %default-theme
otherwise."
(or (bootloader-configuration-theme config) %default-theme))
(define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG."
(gexp->derivation "grub-image.png"
@ -162,7 +150,8 @@ WIDTH/HEIGHT, or #f if none was found."
(let* ((ratio (/ width height))
(image (find (lambda (image)
(= (grub-image-aspect-ratio image) ratio))
(grub-theme-images (grub-configuration-theme config)))))
(grub-theme-images
(bootloader-theme config)))))
(if image
(svg->png (grub-image-file image)
#:width width #:height height)
@ -199,13 +188,18 @@ system string---e.g., \"x86_64-linux\"."
insmod vbe
insmod vga
fi
terminal_output gfxterm
"
""))
(define (setup-gfxterm config font-file)
(if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
#~(format #f "if loadfont ~a; then
setup_gfxterm
fi~%" #$font-file)
""))
(define (theme-colors type)
(let* ((theme (grub-configuration-theme config))
(let* ((theme (bootloader-theme config))
(colors (type theme)))
(string-append (symbol->string (assoc-ref colors 'fg)) "/"
(symbol->string (assoc-ref colors 'bg)))))
@ -222,9 +216,8 @@ function setup_gfxterm {~a}
# Set 'root' to the partition that contains /gnu/store.
~a
if loadfont ~a; then
setup_gfxterm
fi
~a
~a
insmod png
if background_image ~a; then
@ -236,7 +229,8 @@ else
fi~%"
#$setup-gfxterm-body
#$(grub-root-search store-device font-file)
#$font-file
#$(setup-gfxterm config font-file)
#$(grub-setup-io config)
#$(strip-mount-point store-mount-point image)
#$(theme-colors grub-theme-color-normal)
@ -247,6 +241,57 @@ fi~%"
;;; Configuration file.
;;;
(define (grub-setup-io config)
"Return GRUB commands to configure the input / output interfaces. The result
is a string that can be inserted in grub.cfg."
(let* ((symbols->string (lambda (list)
(string-join (map symbol->string list) " ")))
(outputs (bootloader-configuration-terminal-outputs config))
(inputs (bootloader-configuration-terminal-inputs config))
(unit (bootloader-configuration-serial-unit config))
(speed (bootloader-configuration-serial-speed config))
;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
;; as documented in GRUB manual section "Simple Configuration
;; Handling".
(valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
gfxterm vga_text mda_text morse spkmodem))
(valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
at_keyboard usb_keyboard))
(io (string-append
"terminal_output "
(symbols->string
(map
(lambda (output)
(if (memq output valid-outputs) output #f)) outputs)) "\n"
(if (null? inputs)
""
(string-append
"terminal_input "
(symbols->string
(map
(lambda (input)
(if (memq input valid-inputs) input #f)) inputs)) "\n"))
;; UNIT and SPEED are arguments to the same GRUB command
;; ("serial"), so we process them together.
(if (or unit speed)
(string-append
"serial"
(if unit
;; COM ports 1 through 4
(if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
(string-append " --unit=" (number->string unit))
#f)
"")
(if speed
(if (exact-integer? speed)
(string-append " --speed=" (number->string speed))
#f)
""))
""))))
(format #f "~a" io)))
(define (grub-root-search device file)
"Return the GRUB 'search' command to look for DEVICE, which contains FILE,
a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
@ -282,12 +327,13 @@ code."
(system (%current-system))
(old-entries '()))
"Return the GRUB configuration file corresponding to CONFIG, a
<grub-configuration> object, and where the store is available at STORE-FS, a
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
<bootloader-configuration> object, and where the store is available at
STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
(define all-entries
(append (map boot-parameters->menu-entry entries)
(grub-configuration-menu-entries config)))
(map boot-parameters->menu-entry
(append entries
(bootloader-configuration-menu-entries config))))
(define entry->gexp
(match-lambda
@ -326,8 +372,8 @@ corresponding to old generations of the system."
(format port "
set default=~a
set timeout=~a~%"
#$(grub-configuration-default-entry config)
#$(grub-configuration-timeout config))
#$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config))
#$@(map entry->gexp all-entries)
#$@(if (pair? old-entries)
@ -339,4 +385,64 @@ submenu \"GNU system, old configurations...\" {~%")
(gexp->derivation "grub.cfg" builder)))
;;;
;;; Install procedures.
;;;
(define install-grub
#~(lambda (bootloader device mount-point)
;; Install GRUB on DEVICE which is mounted at MOUNT-POINT.
(let ((grub (string-append bootloader "/sbin/grub-install"))
(install-dir (string-append mount-point "/boot")))
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
;; root partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* grub "--no-floppy"
"--boot-directory" install-dir
device))
(error "failed to install GRUB")))))
;;;
;;; Bootloader definitions.
;;;
(define grub-bootloader
(bootloader
(name 'grub)
(package grub)
(installer install-grub)
(configuration-file "/boot/grub/grub.cfg")
(configuration-file-generator grub-configuration-file)))
(define* grub-efi-bootloader
(bootloader
(inherit grub-bootloader)
(name 'grub-efi)
(package grub-efi)))
;;;
;;; Compatibility macros.
;;;
(define-syntax grub-configuration
(syntax-rules (grub)
((_ (grub package) fields ...)
(if (eq? package grub)
(bootloader-configuration
(bootloader grub-bootloader)
fields ...)
(bootloader-configuration
(bootloader grub-efi-bootloader)
fields ...)))
((_ fields ...)
(bootloader-configuration
(bootloader grub-bootloader)
fields ...))))
;;; grub.scm ends here

9
gnu/build/activation.scm
View file

@ -227,7 +227,11 @@ numeric gid or #f."
#:supplementary-groups supplementary-groups
#:comment comment
#:home home
;; Home directories of non-system accounts are created by
;; 'activate-user-home'.
#:create-home? (and create-home? system?)
#:shell shell
#:password password)
@ -282,7 +286,10 @@ they already exist."
(match-lambda
((name uid group supplementary-groups comment home create-home?
shell password system?)
(unless (or (not home) (directory-exists? home))
;; The home directories of system accounts are created during
;; activation, not here.
(unless (or (not home) (not create-home?) system?
(directory-exists? home))
(let* ((pw (getpwnam name))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))

36
gnu/build/install.scm
View file

@ -22,8 +22,7 @@
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
install-grub-config
#:export (install-boot-config
evaluate-populate-directive
populate-root-file-system
reset-timestamps
@ -39,36 +38,17 @@
;;;
;;; Code:
(define (install-grub grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
MOUNT-POINT.
Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd."
(install-grub-config grub.cfg mount-point)
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
;; partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB")))
(define (install-grub-config grub.cfg mount-point)
"Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. Note
that the caller must make sure that GRUB.CFG is registered as a GC root so
that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
(define (install-boot-config bootcfg bootcfg-location mount-point)
"Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
that the caller must make sure that BOOTCFG is registered as a GC root so
that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
(let* ((target (string-append mount-point bootcfg-location))
(pivot (string-append target ".new")))
(mkdir-p (dirname target))
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
;; work when /boot is on a separate partition. Do that atomically.
(copy-file grub.cfg pivot)
(copy-file bootcfg pivot)
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)

125
gnu/build/vm.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,6 +27,7 @@
#:use-module (gnu build linux-boot)
#:use-module (gnu build install)
#:use-module (guix records)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
@ -41,7 +43,7 @@
partition-size
partition-file-system
partition-label
partition-bootable?
partition-flags
partition-initializer
root-partition-initializer
@ -141,7 +143,7 @@ the #:references-graphs parameter of 'derivation'."
(size partition-size)
(file-system partition-file-system (default "ext4"))
(label partition-label (default #f))
(bootable? partition-bootable? (default #f))
(flags partition-flags (default '()))
(initializer partition-initializer (default (const #t))))
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
@ -168,9 +170,10 @@ actual /dev name based on DEVICE."
(cons* "mkpart" "primary" "ext2"
(format #f "~aB" offset)
(format #f "~aB" (+ offset (partition-size part)))
(if (partition-bootable? part)
`("set" ,(number->string index) "boot" "on")
'())))
(append-map (lambda (flag)
(list "set" (number->string index)
(symbol->string flag) "on"))
(partition-flags part))))
(define (options partitions offset)
(let loop ((partitions partitions)
@ -211,10 +214,10 @@ actual /dev name based on DEVICE."
(define MS_BIND 4096) ; <sys/mounts.h> again!
(define* (format-partition partition type
#:key label)
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
volume name."
(define* (create-ext-file-system partition type
#:key label)
"Create an ext-family filesystem of TYPE on PARTITION. If LABEL is true,
use that as the volume name."
(format #t "creating ~a partition...\n" type)
(unless (zero? (apply system* (string-append "mkfs." type)
"-F" partition
@ -223,6 +226,28 @@ volume name."
'())))
(error "failed to create partition")))
(define* (create-fat-file-system partition
#:key label)
"Create a FAT filesystem on PARTITION. The number of File Allocation Tables
will be determined based on filesystem size. If LABEL is true, use that as the
volume name."
(format #t "creating FAT partition...\n")
(unless (zero? (apply system* "mkfs.fat" partition
(if label
`("-n" ,label)
'())))
(error "failed to create FAT partition")))
(define* (format-partition partition type
#:key label)
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
volume name."
(cond ((string-prefix? "ext" type)
(create-ext-file-system partition type #:label label))
((or (string-prefix? "fat" type) (string= "vfat" type))
(create-fat-file-system partition #:label label))
(else (error "Unsupported file system."))))
(define (initialize-partition partition)
"Format PARTITION, a <partition> object with a non-#f 'device' field, mount
it, run its initializer, and unmount it."
@ -285,23 +310,65 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(unless register-closures?
(reset-timestamps target))))
(define (register-grub.cfg-root target bootcfg)
(define (register-bootcfg-root target bootcfg)
"On file system TARGET, register BOOTCFG as a GC root."
(let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory)
(symlink bootcfg (string-append directory "/grub.cfg"))))
(symlink bootcfg (string-append directory "/bootcfg"))))
(define (install-efi grub esp config-file)
"Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
(let* ((system %host-type)
;; Hard code the output location to a well-known path recognized by
;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
(grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
(efi-directory (string-append esp "/EFI/BOOT"))
;; Map grub target names to boot file names.
(efi-targets (cond ((string-prefix? "x86_64" system)
'("x86_64-efi" . "BOOTX64.EFI"))
((string-prefix? "i686" system)
'("i386-efi" . "BOOTIA32.EFI"))
((string-prefix? "armhf" system)
'("arm-efi" . "BOOTARM.EFI"))
((string-prefix? "aarch64" system)
'("arm64-efi" . "BOOTAA64.EFI")))))
;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
(setenv "TMPDIR" esp)
(mkdir-p efi-directory)
(unless (zero? (system* grub-mkstandalone "-O" (car efi-targets)
"-o" (string-append efi-directory "/"
(cdr efi-targets))
;; Graft the configuration file onto the image.
(string-append "boot/grub/grub.cfg=" config-file)))
(error "failed to create GRUB EFI image"))))
(define* (initialize-hard-disk device
#:key
grub.cfg
bootloader-package
bootcfg
bootcfg-location
bootloader-installer
(grub-efi #f)
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted."
(define (partition-bootable? partition)
"Return the first partition found with the boot flag set."
(member 'boot (partition-flags partition)))
(define (partition-esp? partition)
"Return the first EFI System Partition."
(member 'esp (partition-flags partition)))
(let* ((partitions (initialize-partition-table device partitions))
(root (find partition-bootable? partitions))
(esp (find partition-esp? partitions))
(target "/fs"))
(unless root
(error "no bootable partition specified" partitions))
@ -311,10 +378,38 @@ passing it a directory name where it is mounted."
(display "mounting root partition...\n")
(mkdir-p target)
(mount (partition-device root) target (partition-file-system root))
(install-grub grub.cfg device target)
(install-boot-config bootcfg bootcfg-location target)
(when bootloader-installer
(display "installing bootloader...\n")
(bootloader-installer bootloader-package device target))
;; Register GRUB.CFG as a GC root.
(register-grub.cfg-root target grub.cfg)
(when esp
;; Mount the ESP somewhere and install GRUB UEFI image.
(let ((mount-point (string-append target "/boot/efi"))
(grub-config (string-append target "/tmp/grub-standalone.cfg")))
(display "mounting EFI system partition...\n")
(mkdir-p mount-point)
(mount (partition-device esp) mount-point
(partition-file-system esp))
;; Create a tiny configuration file telling the embedded grub
;; where to load the real thing.
(call-with-output-file grub-config
(lambda (port)
(format port
"insmod part_msdos~@
search --set=root --label gnu-disk-image~@
configfile /boot/grub/grub.cfg~%")))
(display "creating EFI firmware image...")
(install-efi grub-efi mount-point grub-config)
(display "done.\n")
(delete-file grub-config)
(umount mount-point)))
;; Register BOOTCFG as a GC root.
(register-bootcfg-root target bootcfg)
(umount target)))

21
gnu/local.mk
View file

@ -36,6 +36,9 @@
GNU_SYSTEM_MODULES = \
gnu.scm \
%D%/artwork.scm \
%D%/bootloader.scm \
%D%/bootloader/grub.scm \
%D%/bootloader/extlinux.scm \
%D%/packages.scm \
%D%/packages/abduco.scm \
%D%/packages/abiword.scm \
@ -194,6 +197,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/idris.scm \
%D%/packages/idutils.scm \
%D%/packages/image.scm \
%D%/packages/image-processing.scm \
%D%/packages/image-viewers.scm \
%D%/packages/imagemagick.scm \
%D%/packages/indent.scm \
@ -356,6 +360,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/speech.scm \
%D%/packages/spice.scm \
%D%/packages/ssh.scm \
%D%/packages/sssd.scm \
%D%/packages/stalonetray.scm \
%D%/packages/statistics.scm \
%D%/packages/storage.scm \
@ -441,7 +446,6 @@ GNU_SYSTEM_MODULES = \
\
%D%/system.scm \
%D%/system/file-systems.scm \
%D%/system/grub.scm \
%D%/system/install.scm \
%D%/system/linux-container.scm \
%D%/system/linux-initrd.scm \
@ -497,6 +501,7 @@ dist_patch_DATA = \
%D%/packages/patches/antiword-CVE-2014-8123.patch \
%D%/packages/patches/apr-skip-getservbyname-test.patch \
%D%/packages/patches/artanis-fix-Makefile.in.patch \
%D%/packages/patches/aspell-default-dict-dir.patch \
%D%/packages/patches/ath9k-htc-firmware-binutils.patch \
%D%/packages/patches/ath9k-htc-firmware-gcc.patch \
%D%/packages/patches/ath9k-htc-firmware-objcopy.patch \
@ -515,7 +520,9 @@ dist_patch_DATA = \
%D%/packages/patches/byobu-writable-status.patch \
%D%/packages/patches/cairo-CVE-2016-9082.patch \
%D%/packages/patches/calibre-drop-unrar.patch \
%D%/packages/patches/calibre-dont-load-remote-icons.patch \
%D%/packages/patches/calibre-no-updates-dialog.patch \
%D%/packages/patches/calibre-use-packaged-feedparser.patch \
%D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch \
%D%/packages/patches/ceph-disable-cpu-optimizations.patch \
@ -641,12 +648,15 @@ dist_patch_DATA = \
%D%/packages/patches/graphite2-non-linear-classes-even-number.patch \
%D%/packages/patches/grep-timing-sensitive-test.patch \
%D%/packages/patches/gsl-test-i686.patch \
%D%/packages/patches/gspell-dash-test.patch \
%D%/packages/patches/guile-1.8-cpp-4.5.patch \
%D%/packages/patches/guile-default-utf8.patch \
%D%/packages/patches/guile-linux-syscalls.patch \
%D%/packages/patches/guile-present-coding.patch \
%D%/packages/patches/guile-relocatable.patch \
%D%/packages/patches/guile-rsvg-pkgconfig.patch \
%D%/packages/patches/guile-ssh-rexec-bug.patch \
%D%/packages/patches/guile-ssh-double-free.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_IM_MODULE_FILE.patch \
%D%/packages/patches/gtk2-theme-paths.patch \
@ -679,6 +689,9 @@ dist_patch_DATA = \
%D%/packages/patches/jasper-CVE-2017-6850.patch \
%D%/packages/patches/jbig2dec-ignore-testtest.patch \
%D%/packages/patches/jbig2dec-CVE-2016-9601.patch \
%D%/packages/patches/jbig2dec-CVE-2017-7885.patch \
%D%/packages/patches/jbig2dec-CVE-2017-7975.patch \
%D%/packages/patches/jbig2dec-CVE-2017-7976.patch \
%D%/packages/patches/jq-CVE-2015-8863.patch \
%D%/packages/patches/kdbusaddons-kinit-file-name.patch \
%D%/packages/patches/khmer-use-libraries.patch \
@ -834,8 +847,6 @@ dist_patch_DATA = \
%D%/packages/patches/netsurf-system-utf8proc.patch \
%D%/packages/patches/netsurf-y2038-tests.patch \
%D%/packages/patches/netsurf-longer-test-timeout.patch \
%D%/packages/patches/networkmanager-qt-activeconnection-test-1.patch \
%D%/packages/patches/networkmanager-qt-activeconnection-test-2.patch \
%D%/packages/patches/ngircd-handle-zombies.patch \
%D%/packages/patches/ninja-zero-mtime.patch \
%D%/packages/patches/node-9077.patch \
@ -938,7 +949,9 @@ dist_patch_DATA = \
%D%/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \
%D%/packages/patches/python-pygpgme-fix-pinentry-tests.patch \
%D%/packages/patches/python2-subprocess32-disable-input-test.patch \
%D%/packages/patches/qemu-CVE-2017-7493.patch \
%D%/packages/patches/qt4-ldflags.patch \
%D%/packages/patches/qtscript-disable-tests.patch \
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \
%D%/packages/patches/rapicorn-isnan.patch \
%D%/packages/patches/ratpoison-shell.patch \
@ -961,8 +974,6 @@ dist_patch_DATA = \
%D%/packages/patches/screen-fix-info-syntax-error.patch \
%D%/packages/patches/sdl-libx11-1.6.patch \
%D%/packages/patches/seq24-rename-mutex.patch \
%D%/packages/patches/shadow-4.4-su-snprintf-fix.patch \
%D%/packages/patches/shadow-CVE-2017-2616.patch \
%D%/packages/patches/slim-session.patch \
%D%/packages/patches/slim-config.patch \
%D%/packages/patches/slim-sigusr1.patch \

60
gnu/packages/admin.scm
View file

@ -17,6 +17,7 @@
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Ben Sturmfels <ben@sturm.com.au>
;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -80,7 +81,8 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages gnome)
#:use-module (gnu packages kerberos)
#:use-module (gnu packages gtk))
#:use-module (gnu packages gtk)
#:use-module (gnu packages xml))
(define-public aide
(package
@ -279,17 +281,15 @@ client and server, a telnet client and server, and an rsh client and server.")
(define-public shadow
(package
(name "shadow")
(version "4.4")
(version "4.5")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/shadow-maint/shadow/releases/"
"download/" version "/shadow-" version ".tar.xz"))
(patches (search-patches "shadow-4.4-su-snprintf-fix.patch"
"shadow-CVE-2017-2616.patch"))
(sha256
(base32
"0g7hf55ar2pafg5g3ldx0fwzjk36wf4xb21p4ndanbjm3c2a9ab1"))))
"0hdpai78n63l3v3fgr3kkiqzhd0awrpfnnzz4mf7lmxdh61qb37w"))))
(build-system gnu-build-system)
(arguments
'(;; Assume System V `setpgrp (void)', which is the default on GNU
@ -2180,3 +2180,53 @@ navigation, opening files and running tasks. There is no config file and
mime associations are hard-coded. The incredible user-friendliness and speed
make it a perfect utility on modern distros.")
(license license:bsd-2)))
(define-public thermald
(package
(name "thermald")
(version "1.6")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/01org/thermal_daemon/archive/v"
version ".tar.gz"))
(sha256 (base32
"14klz9fnvi9jdlaqwrp61xa5nh051n8ykrs1fh1wxd7j66qf2fn6"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(add-after
'unpack 'autogen.sh-and-fix-paths
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; upstartconfir is hardcoded to /etc/init and the build
;; system tries to mkdir that. We don't even need upstart
;; files at all; this is a fast and kludgy workaround
(substitute* "data/Makefile.am"
(("upstartconfdir = /etc/init")
(string-append "upstartconfdir = "
out "/etc/init")))
;; Now run autogen
(zero? (system* "sh" "autogen.sh"))))))
#:configure-flags
(let ((out (assoc-ref %outputs "out")))
(list (string-append "--sysconfdir="
out "/etc")
(string-append "--with-udev-dir="
out "/lib/udev")
(string-append "--with-dbus-sys-dir="
out "/etc/dbus-1/system.d")
"--localstatedir=/var"))))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("glib" ,glib "bin") ; for glib-genmarshal, etc.
("pkg-config" ,pkg-config)))
(inputs
`(("dbus-glib" ,dbus-glib)
("libxml2" ,libxml2)))
(home-page "https://01.org/linux-thermal-daemon/")
(synopsis "CPU scaling for thermal management")
(description "The Linux Thermal Daemon helps monitor and control temperature
on systems running the Linux kernel.")
(license license:gpl2+)))

18
gnu/packages/aspell.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
@ -26,6 +26,7 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix licenses)
#:use-module (gnu packages)
#:use-module (gnu packages perl)
#:use-module (gnu packages base))
@ -40,7 +41,8 @@
version ".tar.gz"))
(sha256
(base32
"1qgn5psfyhbrnap275xjfrzppf5a83fb67gpql0kfqv37al869gm"))))
"1qgn5psfyhbrnap275xjfrzppf5a83fb67gpql0kfqv37al869gm"))
(patches (search-patches "aspell-default-dict-dir.patch"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@ -53,6 +55,15 @@
'("ASPELL_CONF" "" =
("${ASPELL_CONF:-\"dict-dir ${GUIX_PROFILE:-$HOME/.guix-profile}/lib/aspell\"}")))))))))
(inputs `(("perl" ,perl)))
(native-search-paths
;; This is a Guix-specific environment variable that takes a single
;; entry, not an actual search path.
(list (search-path-specification
(variable "ASPELL_DICT_DIR")
(separator #f)
(files '("lib/aspell")))))
(home-page "http://aspell.net/")
(synopsis "Spell checker")
(description
@ -66,7 +77,8 @@ dictionaries, including personal ones.")
;;; Dictionaries.
;;;
;;; Use 'export ASPELL_CONF="dict-dir $HOME/.guix-profile/lib/aspell"' to use
;;; them.
;;; them, or set the Guix-specific 'ASPELL_DICT_DIR', or just do nothing (as
;;; long as 'HOME' is set, that's fine!).
;;;
(define* (aspell-dictionary dict-name full-name

3
gnu/packages/aux-files/linux-libre/4.11-i686.conf
View file

@ -935,8 +935,7 @@ CONFIG_XFRM_STATISTICS=y
CONFIG_XFRM_IPCOMP=m
CONFIG_NET_KEY=m
# CONFIG_NET_KEY_MIGRATE is not set
CONFIG_SMC=m
CONFIG_SMC_DIAG=m
# CONFIG_SMC is not set
CONFIG_INET=y
CONFIG_IP_MULTICAST=y
CONFIG_IP_ADVANCED_ROUTER=y

3
gnu/packages/aux-files/linux-libre/4.11-x86_64.conf
View file

@ -919,8 +919,7 @@ CONFIG_XFRM_STATISTICS=y
CONFIG_XFRM_IPCOMP=m
CONFIG_NET_KEY=m
# CONFIG_NET_KEY_MIGRATE is not set
CONFIG_SMC=m
CONFIG_SMC_DIAG=m
# CONFIG_SMC is not set
CONFIG_INET=y
CONFIG_IP_MULTICAST=y
CONFIG_IP_ADVANCED_ROUTER=y

15
gnu/packages/backup.scm
View file

@ -118,7 +118,7 @@ spying and/or modification by the server.")
(define-public par2cmdline
(package
(name "par2cmdline")
(version "0.6.14")
(version "0.7.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/Parchive/par2cmdline/archive/v"
@ -126,21 +126,14 @@ spying and/or modification by the server.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0ykfb7ar0x0flfdgf6i8xphyv5b93dalbjj2jb6hx7sdjax33n1g"))
;; This test merely needs a file to test recovery on, but
;; /dev/random is essentially /dev/urandom plus minimum entropy
;; locking, making the test hang indefinitely. This change is
;; already upstream: remove on upgrade to future 0.6.15.
;; https://github.com/Parchive/par2cmdline/commit/27723a678f780da82c79b98592592009c779a4fb
(modules '((guix build utils)))
(snippet
'(substitute* "tests/test20" (("if=/dev/random") "if=/dev/urandom")))))
"1m9vnv3pg0nds47raq2rd2kfpaad1sc10hv40hll5byksqlbfxyq"))))
(native-inputs
`(("automake" ,automake)
("autoconf" ,autoconf)))
(build-system gnu-build-system)
(arguments
`(#:phases
`(#:parallel-tests? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'autoreconf
(lambda _ (zero? (system* "autoreconf" "-vfi")))))))

121
gnu/packages/base.scm
View file

@ -778,35 +778,98 @@ with the Linux kernel.")
((#:phases original-phases)
;; Add libmachuser.so and libhurduser.so to libc.so's search path.
;; See <http://lists.gnu.org/archive/html/bug-hurd/2015-07/msg00051.html>.
`(alist-cons-after
'install 'augment-libc.so
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(substitute* (string-append out "/lib/libc.so")
(("/[^ ]+/lib/libc.so.0.3")
(string-append out "/lib/libc.so.0.3" " libmachuser.so" " libhurduser.so"))))
#t)
(alist-cons-after
'pre-configure 'pre-configure-set-pwd
(lambda _
;; Use the right 'pwd'.
(substitute* "configure"
(("/bin/pwd") "pwd")))
(alist-replace
'build
(lambda _
;; Force mach/hurd/libpthread subdirs to build first in order to avoid
;; linking errors.
;; See <https://lists.gnu.org/archive/html/bug-hurd/2016-11/msg00045.html>
(let ((-j (list "-j" (number->string (parallel-job-count)))))
(let-syntax ((make (syntax-rules ()
((_ target)
(zero? (apply system* "make" target -j))))))
(and (make "mach/subdir_lib")
(make "hurd/subdir_lib")
(make "libpthread/subdir_lib")
(zero? (apply system* "make" -j))))))
,original-phases))))
`(modify-phases ,original-phases
;; TODO: This is almost an exact copy of the phase of the same name
;; in glibc/linux. The only difference is that the i686 patch is
;; not applied here. In the next update cycle the patch moves to
;; the patches field and this overwritten phase won't be needed any
;; more.
(replace 'pre-configure
(lambda* (#:key inputs native-inputs outputs
#:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
;; FIXME: Normally we would look it up only in INPUTS
;; but cross-base uses it as a native input.
(bash (or (assoc-ref inputs "static-bash")
(assoc-ref native-inputs "static-bash"))))
;; Install the rpc data base file under `$out/etc/rpc'.
;; FIXME: Use installFlags = [ "sysconfdir=$(out)/etc" ];
(substitute* "sunrpc/Makefile"
(("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix)
(string-append out "/etc/rpc" suffix "\n"))
(("^install-others =.*$")
(string-append "install-others = " out "/etc/rpc\n")))
(substitute* "Makeconfig"
;; According to
;; <http://www.linuxfromscratch.org/lfs/view/stable/chapter05/glibc.html>,
;; linking against libgcc_s is not needed with GCC
;; 4.7.1.
((" -lgcc_s") ""))
;; Have `system' use that Bash.
(substitute* "sysdeps/posix/system.c"
(("#define[[:blank:]]+SHELL_PATH.*$")
(format #f "#define SHELL_PATH \"~a/bin/bash\"\n"
bash)))
;; Same for `popen'.
(substitute* "libio/iopopen.c"
(("/bin/sh")
(string-append bash "/bin/sh")))
;; Same for the shell used by the 'exec' functions for
;; scripts that lack a shebang.
(substitute* (find-files "." "^paths\\.h$")
(("#define[[:blank:]]+_PATH_BSHELL[[:blank:]].*$")
(string-append "#define _PATH_BSHELL \""
bash "/bin/sh\"\n")))
;; Nscd uses __DATE__ and __TIME__ to create a string to
;; make sure the client and server come from the same
;; libc. Use something deterministic instead.
(substitute* "nscd/nscd_stat.c"
(("static const char compilation\\[21\\] =.*$")
(string-append
"static const char compilation[21] = \""
(string-take (basename out) 20) "\";\n")))
;; Make sure we don't retain a reference to the
;; bootstrap Perl.
(substitute* "malloc/mtrace.pl"
(("^#!.*")
;; The shebang can be omitted, because there's the
;; "bilingual" eval/exec magic at the top of the file.
"")
(("exec @PERL@")
"exec perl")))))
(add-after 'install 'augment-libc.so
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(substitute* (string-append out "/lib/libc.so")
(("/[^ ]+/lib/libc.so.0.3")
(string-append out "/lib/libc.so.0.3" " libmachuser.so" " libhurduser.so"))))
#t))
(add-after 'pre-configure 'pre-configure-set-pwd
(lambda _
;; Use the right 'pwd'.
(substitute* "configure"
(("/bin/pwd") "pwd"))
#t))
(replace 'build
(lambda _
;; Force mach/hurd/libpthread subdirs to build first in order to avoid
;; linking errors.
;; See <https://lists.gnu.org/archive/html/bug-hurd/2016-11/msg00045.html>
(let ((-j (list "-j" (number->string (parallel-job-count)))))
(let-syntax ((make (syntax-rules ()
((_ target)
(zero? (apply system* "make" target -j))))))
(and (make "mach/subdir_lib")
(make "hurd/subdir_lib")
(make "libpthread/subdir_lib")
(zero? (apply system* "make" -j)))))))))
((#:configure-flags original-configure-flags)
`(append (list "--host=i586-pc-gnu"

8
gnu/packages/benchmark.scm
View file

@ -30,7 +30,7 @@
(define-public fio
(package
(name "fio")
(version "2.19")
(version "2.20")
(source (origin
(method url-fetch)
(uri (string-append
@ -38,7 +38,7 @@
"fio-" version ".tar.bz2"))
(sha256
(base32
"0dwx2dpbsg3xyd8jzm64gazy6ij4zirlfdrbgcxr1a0z5smcmcw1"))))
"15vgbzlcjd21bi9ahlbs8h9ca4raw5qgi711n802qmagjdjbmlxw"))))
(build-system gnu-build-system)
(arguments
'(#:test-target "test"
@ -78,8 +78,8 @@
(dst (string-append newbin "/" file)))
(link src dst)
(delete-file src)))
'("fio2gnuplot" "fio_latency2csv.py"
"fiologparser_hist.py" "fiologparser.py"))
'("fio2gnuplot" "fiologparser_hist.py"
"fiologparser.py"))
;; Make sure numpy et.al is found.
(wrap-program (string-append newbin "/fiologparser_hist.py")
`("PYTHONPATH" ":" prefix (,(getenv "PYTHONPATH"))))

102
gnu/packages/bioinformatics.scm
View file

@ -614,7 +614,7 @@ Python.")
(define-public python-biom-format
(package
(name "python-biom-format")
(version "2.1.5")
(version "2.1.6")
(source
(origin
(method url-fetch)
@ -625,14 +625,15 @@ Python.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1n25w3p1rixbpac8iysmzcja6m4ip5r6sz19l8y6wlwi49hxn278"))))
"08cr7wpahk6zb31h4bs7jmzpvxcqv9s13xz40h6y2h656jvdvnpj"))))
(build-system python-build-system)
(propagated-inputs
`(("python-numpy" ,python-numpy)
("python-scipy" ,python-scipy)
("python-future" ,python-future)
("python-click" ,python-click)
("python-h5py" ,python-h5py)))
("python-h5py" ,python-h5py)
("python-pandas" ,python-pandas)))
(native-inputs
`(("python-nose" ,python-nose)))
(home-page "http://www.biom-format.org")
@ -2092,7 +2093,7 @@ identify enrichments with functional annotations of the genome.")
(define-public diamond
(package
(name "diamond")
(version "0.8.38")
(version "0.9.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -2101,7 +2102,7 @@ identify enrichments with functional annotations of the genome.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0q2z6z5f7c0kbbzpjamkcyqg0rc6h5rxfp97qbmb0wxaycr7jajq"))))
"19lvz661mmgikbry0nvnsjc01fdxqbw9rl2868dvjfraxbcx9ras"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f ; no "check" target
@ -2121,8 +2122,7 @@ translated DNA query sequences against a protein reference database (BLASTP
and BLASTX alignment mode). The speedup over BLAST is up to 20,000 on short
reads at a typical sensitivity of 90-99% relative to BLAST depending on the
data and settings.")
(license (license:non-copyleft "file://src/COPYING"
"See src/COPYING in the distribution."))))
(license license:agpl3+)))
(define-public discrover
(package
@ -2417,7 +2417,7 @@ similarity of community members.")
(define-public fasttree
(package
(name "fasttree")
(version "2.1.9")
(version "2.1.10")
(source (origin
(method url-fetch)
(uri (string-append
@ -2425,7 +2425,7 @@ similarity of community members.")
version ".c"))
(sha256
(base32
"0ljvvw8i1als1wbfzvrf15c3ii2vw9db20a259g6pzg34xyyb97k"))))
"0vcjdvy1j4m702vmak4svbfkrpcw63k7wymfksjp9a982zy8kjsl"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no "check" target
@ -2551,7 +2551,7 @@ Illumina, Roche 454, and the SOLiD platform.")
(define-public fraggenescan
(package
(name "fraggenescan")
(version "1.20")
(version "1.30")
(source
(origin
(method url-fetch)
@ -2559,7 +2559,7 @@ Illumina, Roche 454, and the SOLiD platform.")
(string-append "mirror://sourceforge/fraggenescan/"
"FragGeneScan" version ".tar.gz"))
(sha256
(base32 "1zzigqmvqvjyqv4945kv6nc5ah2xxm1nxgrlsnbzav3f5c0n0pyj"))))
(base32 "158dcnwczgcyhwm4qlx19sanrwgdpzf6bn2y57mbpx55lkgz1mzj"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@ -2574,6 +2574,7 @@ Illumina, Roche 454, and the SOLiD platform.")
(string-append "system(\"" (which "rm")))
(("system\\(\"mv")
(string-append "system(\"" (which "mv")))
(("\\\"awk") (string-append "\"" (which "awk")))
;; This script and other programs expect the training files
;; to be in the non-standard location bin/train/XXX. Change
;; this to be share/fraggenescan/train/XXX instead.
@ -2583,10 +2584,7 @@ Illumina, Roche 454, and the SOLiD platform.")
"train/\".$FGS_train_file;")))
(substitute* "run_hmm.c"
(("^ strcat\\(train_dir, \\\"train/\\\"\\);")
(string-append " strcpy(train_dir, \"" share "/train/\");")))
(substitute* "post_process.pl"
(("^my \\$dir = substr.*")
(string-append "my $dir = \"" share "\";"))))
(string-append " strcpy(train_dir, \"" share "/train/\");"))))
#t))
(replace 'build
(lambda _ (and (zero? (system* "make" "clean"))
@ -2598,8 +2596,6 @@ Illumina, Roche 454, and the SOLiD platform.")
(share (string-append out "/share/fraggenescan/train")))
(install-file "run_FragGeneScan.pl" bin)
(install-file "FragGeneScan" bin)
(install-file "FGS_gff.py" bin)
(install-file "post_process.pl" bin)
(copy-recursively "train" share))))
(delete 'check)
(add-after 'install 'post-install-check
@ -2607,8 +2603,9 @@ Illumina, Roche 454, and the SOLiD platform.")
;; output files gets created.
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (string-append (assoc-ref outputs "out")))
(bin (string-append out "/bin/")))
(and (zero? (system* (string-append bin "run_FragGeneScan.pl")
(bin (string-append out "/bin/"))
(frag (string-append bin "run_FragGeneScan.pl")))
(and (zero? (system* frag ; Test complete genome.
"-genome=./example/NC_000913.fna"
"-out=./test2"
"-complete=1"
@ -2616,7 +2613,13 @@ Illumina, Roche 454, and the SOLiD platform.")
(file-exists? "test2.faa")
(file-exists? "test2.ffn")
(file-exists? "test2.gff")
(file-exists? "test2.out"))))))))
(file-exists? "test2.out")
(zero? (system* ; Test incomplete sequences.
frag
"-genome=./example/NC_000913-fgs.ffn"
"-out=out"
"-complete=0"
"-train=454_30")))))))))
(inputs
`(("perl" ,perl)
("python" ,python-2))) ;not compatible with python 3.
@ -2696,6 +2699,46 @@ comment or quality sections.")
(supported-systems '("x86_64-linux"))
(license license:expat))))
(define-public gemma
(package
(name "gemma")
(version "0.96")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/xiangzhou/GEMMA/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"055ynn16gd12pf78n4vr2a9jlwsbwzajpdnf2y2yilg1krfff222"))))
(inputs
`(("gsl" ,gsl)
("lapack" ,lapack)
("zlib" ,zlib)))
(build-system gnu-build-system)
(arguments
`(#:make-flags '("FORCE_DYNAMIC=1") ; use shared libs
#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'bin-mkdir
(lambda _
(mkdir-p "bin")))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(install-file "bin/gemma"
(string-append
out "/bin"))))))
#:tests? #f)) ; no tests included yet
(home-page "https://github.com/xiangzhou/GEMMA")
(synopsis "Tool for genome-wide efficient mixed model association")
(description
"Genome-wide Efficient Mixed Model Association (GEMMA) provides a
standard linear mixed model resolver with application in genome-wide
association studies (GWAS).")
(license license:gpl3)))
(define-public grit
(package
(name "grit")
@ -4054,7 +4097,7 @@ partial genes, and identifies translation initiation sites.")
(define-public roary
(package
(name "roary")
(version "3.7.0")
(version "3.8.2")
(source
(origin
(method url-fetch)
@ -4063,7 +4106,7 @@ partial genes, and identifies translation initiation sites.")
version ".tar.gz"))
(sha256
(base32
"0x2hpb3nfsc6x2nq1788w0fhqfzc7cn2dp4xwyva9m3k6xlz0m43"))))
"03dfr2cd5fp80bcr65923zpdzrasvcxl7c2vgh8373v25a1yfap7"))))
(build-system perl-build-system)
(arguments
`(#:phases
@ -5396,18 +5439,13 @@ Cuffdiff or Ballgown programs.")
(define-public taxtastic
(package
(name "taxtastic")
(version "0.5.7")
;; Versions after 0.5.4 do not appear to be distributed on PyPI so we
;; download the package from GitHub.
(version "0.6.4")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/fhcrc/taxtastic/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(uri (pypi-uri "taxtastic" version))
(sha256
(base32
"1s0h5y1lds1c40jhir5585ffm6yjyn8h5aqimpgv64rhqhfv56xx"))))
"0s79z8kfl853x7l4h8ms05k31q87aw62nrchlk20w9n227j35929"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
@ -7904,14 +7942,14 @@ library implementing most of the pipeline's features.")
(define-public r-mutationalpatterns
(package
(name "r-mutationalpatterns")
(version "1.2.0")
(version "1.2.1")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "MutationalPatterns" version))
(sha256
(base32
"00jh1qklj8jb9j7mwvkfybq368h2wg9yc2cwkgb7yb9vsw72r61d"))))
"1s50diwh1j6vg3mgahh6bczvq74mfdbmwjrad4d5lh723gnc5pjg"))))
(build-system r-build-system)
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)

4
gnu/packages/dns.scm
View file

@ -88,7 +88,9 @@ and BOOTP/TFTP for network booting of diskless machines.")
;; Source files only say GPL2 and GPL3 are allowed.
(license (list license:gpl2 license:gpl3))))
(define-public bind
;; 'bind' is the name of a built-in Guile procedure, which is why we choose a
;; different name here.
(define-public isc-bind
(package
(name "bind")
(version "9.11.1")

72
gnu/packages/ebook.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2017 Brendan Tildesley <brendan.tildesley@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages ebook)
#:use-module ((guix licenses) #:select (gpl3 lgpl2.1+))
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
@ -27,8 +28,10 @@
#:use-module (guix build-system python)
#:use-module (gnu packages)
#:use-module (gnu packages databases)
#:use-module (gnu packages fonts)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gnome)
#:use-module (gnu packages glib)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages image)
@ -38,6 +41,7 @@
#:use-module (gnu packages python)
#:use-module (gnu packages qt)
#:use-module (gnu packages tls)
#:use-module (gnu packages web)
#:use-module (gnu packages xorg))
(define-public chmlib
@ -56,12 +60,12 @@
(home-page "http://www.jedrea.com/chmlib/")
(synopsis "Library for CHM files")
(description "CHMLIB is a library for dealing with ITSS/CHM format files.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public calibre
(package
(name "calibre")
(version "2.76.0")
(version "2.85.1")
(source
(origin
(method url-fetch)
@ -70,33 +74,35 @@
version ".tar.xz"))
(sha256
(base32
"1xfm586n6gm44mkyn25mbiyhj6w9ji9yl6fvmnr4zk1q6qcga3v8"))
"1g8s0kp1gj05yysfgqpp2lgrxvzc0fsny1hwzx5jh9hvqn0b53cc"))
;; Remove non-free or doubtful code, see
;; https://lists.gnu.org/archive/html/guix-devel/2015-02/msg00478.html
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "src/calibre/ebooks/markdown")
(delete-file-recursively "src/unrar")
(delete-file "src/odf/thumbnail.py")))
(delete-file "src/odf/thumbnail.py")
(delete-file-recursively "resources/fonts/liberation")
(delete-file-recursively "src/chardet")
(substitute* (find-files "." "\\.py")
(("calibre\\.ebooks\\.markdown") "markdown"))
#t))
(patches (search-patches "calibre-drop-unrar.patch"
"calibre-use-packaged-feedparser.patch"
"calibre-dont-load-remote-icons.patch"
"calibre-no-updates-dialog.patch"))))
(build-system python-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("font-liberation" ,font-liberation)
("qtbase" ,qtbase) ; for qmake
;; xdg-utils is supposed to be used for desktop integration, but it
;; also creates lots of messages
;; mkdir: cannot create directory '/homeless-shelter': Permission denied
("python2-flake8" ,python2-flake8)
("xdg-utils" ,xdg-utils)))
;; FIXME: The following are missing inputs according to the documentation,
;; but the package can apparently be used without them,
;; They may need to be added if a deficiency is detected.
;; BeautifulSoup >= 3.0.5
;; dnspython >= 1.6.0
;; poppler >= 0.20.2
;; libwmf >= 0.2.8
;; psutil >= 0.6.1
;; python-pygments >= 2.0.1 ; used for ebook editing
;; Beautifulsoup3 is bundled but obsolete and not packaged, so just leave it bundled.
(inputs
`(("chmlib" ,chmlib)
("fontconfig" ,fontconfig)
@ -108,16 +114,22 @@
("libxrender" ,libxrender)
("openssl" ,openssl)
("podofo" ,podofo)
("poppler" ,poppler)
("python" ,python-2)
("python2-apsw" ,python2-apsw)
("python2-chardet" ,python2-chardet)
("python2-cssselect" ,python2-cssselect)
("python2-cssutils" ,python2-cssutils)
("python2-dateutil" ,python2-dateutil)
("python2-dbus" ,python2-dbus)
("python2-dnspython" ,python2-dnspython)
("python2-feedparser" ,python2-feedparser)
("python2-lxml" ,python2-lxml)
("python2-markdown" ,python2-markdown)
("python2-mechanize" ,python2-mechanize)
("python2-netifaces" ,python2-netifaces)
("python2-pillow" ,python2-pillow)
("python2-pygments" ,python2-pygments)
("python2-pyqt" ,python2-pyqt)
("python2-sip" ,python2-sip)
("sqlite" ,sqlite)))
@ -130,6 +142,12 @@
#:use-setuptools? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-source
(lambda _
(substitute* "src/calibre/linux.py"
;; We can't use the uninstaller in Guix. Don't build it.
(("self\\.create_uninstaller()") ""))
#t))
(add-before 'build 'configure
(lambda* (#:key inputs #:allow-other-keys)
(let ((podofo (assoc-ref inputs "podofo"))
@ -137,7 +155,17 @@
(substitute* "setup/build_environment.py"
(("sys.prefix") (string-append "'" pyqt "'")))
(setenv "PODOFO_INC_DIR" (string-append podofo "/include/podofo"))
(setenv "PODOFO_LIB_DIR" (string-append podofo "/lib"))))))))
(setenv "PODOFO_LIB_DIR" (string-append podofo "/lib")))))
(add-after 'install 'install-font-liberation
(lambda* (#:key inputs outputs #:allow-other-keys)
(for-each (lambda (file)
(install-file file (string-append
(assoc-ref outputs "out")
"/share/calibre/fonts/liberation")))
(find-files (string-append
(assoc-ref inputs "font-liberation")
"/share/fonts/truetype")))
#t)))))
(home-page "http://calibre-ebook.com/")
(synopsis "E-book library management software")
(description "Calibre is an ebook library manager. It can view, convert
@ -145,4 +173,16 @@ and catalog ebooks in most of the major ebook formats. It can also talk
to many ebook reader devices. It can go out to the Internet and fetch
metadata for books. It can download newspapers and convert them into
ebooks for convenient reading.")
(license gpl3))) ; some files are under various other licenses, see COPYRIGHT
;; Calibre is largely GPL3+, but includes a number of components covered
;; by other licenses. See COPYRIGHT for more details.
(license (list license:gpl3+
license:gpl2+
license:lgpl2.1+
license:lgpl2.1
license:bsd-3
license:expat
license:zpl2.1
license:asl2.0
license:public-domain
license:silofl1.1
license:cc-by-sa3.0))))

113
gnu/packages/emacs.scm
View file

@ -1156,14 +1156,14 @@ rather than the contents of files.")
(define-public emacs-async
(package
(name "emacs-async")
(version "1.9")
(version "1.9.2")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/async-"
version ".tar"))
(sha256
(base32
"1ip5nc8xyln5szvqwp6wqva9xr84pn8ssn3nnphrszr19y4js2bm"))))
"17fnvrj7jww29sav6a6jpizclg4w2962m6h37akpii71gf0vrffw"))))
(build-system emacs-build-system)
(home-page "https://elpa.gnu.org/packages/async.html")
(synopsis "Asynchronous processing in Emacs")
@ -3361,7 +3361,7 @@ Dust.js, React/JSX, Angularjs, ejs, etc.")
(define-public emacs-helm
(package
(name "emacs-helm")
(version "1.9.8")
(version "2.7.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -3370,7 +3370,7 @@ Dust.js, React/JSX, Angularjs, ejs, etc.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"019dpzr6l83k1fgxn40aqxjvrpz4dl5d9vi7fc5wjnifmxaqxia6"))))
"1scdirpclgq3pi1j2c90gqaaqg1pgvasp98f4jqw8c5xbqcr7jdw"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-async" ,emacs-async)
@ -3387,6 +3387,55 @@ considered to be its successor. Helm sets out to clean up the legacy code in
not tied in the trap of backward compatibility.")
(license license:gpl3+)))
(define-public emacs-helm-swoop
(package
(name "emacs-helm-swoop")
(version "1.7.2")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/ShingoFukuyama/helm-swoop/archive/"
version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1z34pfi0gsk054pxr906ilaalaw0xz3s536163gf9ykkwmc2356d"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-helm" ,emacs-helm)))
(home-page "https://github.com/ShingoFukuyama/helm-swoop")
(synopsis "Filter and jump to lines in an Emacs buffer using Helm")
(description
"This package builds on the Helm interface to provide several commands
for search-based navigation of buffers.")
(license license:gpl2+)))
(define-public emacs-helm-projectile
(package
(name "emacs-helm-projectile")
(version "0.14.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/bbatsov/helm-projectile/archive/v"
version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"19cfmilqh8kbab3b2hmx6lyrj73q6vfmn3p730x95g23iz16mnd5"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-dash" ,emacs-dash)
("emacs-helm" ,emacs-helm)
("emacs-projectile" ,emacs-projectile)))
(home-page "https://github.com/bbatsov/helm-projectile")
(synopsis "Helm integration for Projectile")
(description
"This Emacs library provides a Helm interface for Projectile.")
(license license:gpl3+)))
(define-public emacs-cider
(package
(name "emacs-cider")
@ -3579,14 +3628,14 @@ passive voice.")
(define-public emacs-org
(package
(name "emacs-org")
(version "20170502")
(version "20170515")
(source (origin
(method url-fetch)
(uri (string-append "http://elpa.gnu.org/packages/org-"
version ".tar"))
(sha256
(base32
"12inz804j55ycprb2m3ay54d1bhwhjssmn5nrfm7cfklyhfsy27s"))))
"0lfapcxil69x1a63cszgq72lqks1z3gpyxw7vcllqlgi7n7a4y6f"))))
(build-system emacs-build-system)
(home-page "http://orgmode.org/")
(synopsis "Outline-based notes management and organizer")
@ -4145,7 +4194,7 @@ jQuery and Bootstrap resources included via osscdn.")
(define-public emacspeak
(package
(name "emacspeak")
(version "45.0")
(version "46.0")
(source
(origin
(method url-fetch)
@ -4154,7 +4203,11 @@ jQuery and Bootstrap resources included via osscdn.")
version "/emacspeak-" version ".tar.bz2"))
(sha256
(base32
"0npcr867xbbhwa0i7v26hnk4z2d51522jwcfwc594j74kbv3g6ka"))))
"15x4yfp3wl2fxm1nkx6pz3clw6zyw3argcsqxgcx6pa28sivlg2n"))
(modules '((guix build utils)))
(snippet
;; Delete the bundled byte-compiled elisp files.
'(for-each delete-file (find-files "lisp" "\\.elc$")))))
(build-system gnu-build-system)
(arguments
'(#:make-flags (list (string-append "prefix="
@ -4162,25 +4215,35 @@ jQuery and Bootstrap resources included via osscdn.")
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "Makefile"
(("\\$\\(INSTALL\\) -d \\$\\(libdir\\)/servers/linux-outloud")
"")
(("\\$\\(INSTALL\\) -m 755 \\$\\{OUTLOUD\\}.*$") "")
(("\\*info\\*") "*"))
(substitute* "etc/emacspeak.sh.def"
(("<emacspeak-dir>")
(string-append (assoc-ref outputs "out")
"/share/emacs/site-lisp/emacspeak/lisp")))
(lambda _
;; Configure Emacspeak according to etc/install.org.
(zero? (system* "make" "config"))))
(add-after 'install 'install-espeak-server
(add-after 'build 'build-espeak
(lambda _
(zero? (system* "make" "espeak"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(with-directory-excursion "servers/linux-espeak"
(and (zero? (system* "make"))
(zero? (system* "make" "install"
(string-append "PREFIX=" out))))))))
(add-after 'install-espeak-server 'wrap-program
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(lisp (string-append out "/share/emacs/site-lisp/emacspeak"))
(info (string-append out "/share/info")))
;; According to etc/install.org, the Emacspeak directory should
;; be copied to its installation destination.
(for-each
(lambda (file)
(copy-recursively file (string-append lisp "/" file)))
'("etc" "info" "lisp" "media" "servers" "sounds" "stumpwm"
"xsl"))
;; Make sure emacspeak is loaded from the correct directory.
(substitute* "etc/emacspeak.sh"
(("exec emacs.*$")
(string-append "exec emacs -l " lisp
"/lisp/emacspeak-setup.el $CL_ALL")))
;; Install the convenient startup script.
(mkdir-p bin)
(copy-file "etc/emacspeak.sh" (string-append bin "/emacspeak")))
#t))
(add-after 'install 'wrap-program
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(emacspeak (string-append out "/bin/emacspeak"))

3
gnu/packages/engineering.scm
View file

@ -108,7 +108,8 @@
`(("boost" ,boost)
("muparser" ,muparser)
("freetype" ,freetype)
("qt" ,qt)))
("qtbase" ,qtbase)
("qtsvg" ,qtsvg)))
(native-inputs
`(("pkg-config" ,pkg-config)
("which" ,which)))

26
gnu/packages/games.scm
View file

@ -1059,14 +1059,14 @@ reference interpreter, using the Glk API.")
(define-public fizmo
(package
(name "fizmo")
(version "0.7.9")
(version "0.8.4")
(source (origin
(method url-fetch)
(uri (string-append "https://christoph-ender.de/fizmo/source/"
name "-" version ".tar.gz"))
(sha256
(base32
"1w7cgyjrhgkadjrazijzhq7zh0pl5bfc6wl7mdpgh020y4kp46d7"))))
"1sd988db2302r7cbfcfghbmg8ck43c6hvnlnlpb0rqxb7pm9cwyy"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
@ -1079,12 +1079,13 @@ reference interpreter, using the Glk API.")
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("libjpeg" ,libjpeg)
`(("freetype" ,freetype)
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("libsndfile" ,libsndfile)
("libxml2" ,libxml2)
("ncurses" ,ncurses)
("sdl" ,sdl)))
("sdl2" ,sdl2)))
(home-page "https://christoph-ender.de/fizmo/")
(synopsis "Z-machine interpreter")
(description
@ -1410,14 +1411,14 @@ older games.")
(define-public gamine
(package
(name "gamine")
(version "1.4")
(version "1.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/gamine-game/"
"gamine-" version ".tar.gz"))
(sha256
(base32
"1iny959i1kl2ab6z5xi4s66mrvrwcarxyvjfp2k1sx532s8knk8h"))))
"08wnk7w84c2413hwny89j2cn89cvfdf67bfc6wl0bf475if0mf4h"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
@ -1490,7 +1491,7 @@ is programmed in Haskell.")
(define-public manaplus
(package
(name "manaplus")
(version "1.7.3.4")
(version "1.7.5.14")
(source (origin
(method url-fetch)
(uri (string-append
@ -1498,7 +1499,7 @@ is programmed in Haskell.")
version "/manaplus-" version ".tar.xz"))
(sha256
(base32
"0mbxzsgjg16pqa3jnxkd7wwvw1lrx455r7fvwjfhzp0yv7acrn10"))))
"1b5q79jkdrck5lq8lvhnpq2mly257r8lylp7b8sp8xn4365f86ch"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
@ -1512,7 +1513,6 @@ is programmed in Haskell.")
("curl" ,curl)
("libxml2" ,libxml2)
("mesa" ,mesa)
("physfs" ,physfs)
("sdl-union" ,(sdl-union))))
(home-page "http://manaplus.org")
(synopsis "Client for 'The Mana World' and similar games")
@ -2160,14 +2160,14 @@ and a game metadata scraper.")
(define openttd-engine
(package
(name "openttd-engine")
(version "1.6.1")
(version "1.7.0")
(source
(origin (method url-fetch)
(uri (string-append "http://binaries.openttd.org/releases/"
version "/openttd-" version "-source.tar.xz"))
(sha256
(base32
"1ak32fj5xkk2fvmm3g8i7wzmk4bh2ijsp8fzvvw5wj6365p9j24v"))
"1q4r5860dpkkw4fpfz3f8mvdd8xjpnwwzr9zybgmgb255bs0g4yz"))
(modules '((guix build utils)))
(snippet
;; The DOS port contains proprietary software.
@ -2207,8 +2207,8 @@ and a game metadata scraper.")
passengers by land, water and air. It is a re-implementation of Transport
Tycoon Deluxe with many enhancements including multiplayer mode,
internationalization support, conditional orders and the ability to clone,
autoreplace and autoupdate vehicles. This package only includes the game engine. When you start
it you will be prompted to download a graphics set.")
autoreplace and autoupdate vehicles. This package only includes the game
engine. When you start it you will be prompted to download a graphics set.")
(home-page "http://openttd.org/")
;; This package is GPLv2, except for a few files located in
;; "src/3rdparty/" which are under the 3-clause BSD, LGPLv2.1+ and Zlib

1
gnu/packages/ghostscript.scm
View file

@ -132,6 +132,7 @@ printing, and psresize, for adjusting page sizes.")
(name "ghostscript")
(replacement ghostscript/fixed)
(version "9.14.0")
;; XXX Try removing the bundled copy of jbig2dec.
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/ghostscript/gnu-ghostscript-"

54
gnu/packages/gnome.scm
View file

@ -51,6 +51,7 @@
#:use-module (guix build-system trivial)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages aspell)
#:use-module (gnu packages autotools)
#:use-module (gnu packages avahi)
#:use-module (gnu packages base)
@ -6130,3 +6131,56 @@ accessibility infrastructure.")
via speech and refreshable braille. Orca works with applications and toolkits
that support the Assistive Technology Service Provider Interface (AT-SPI).")
(license license:lgpl2.1+)))
(define-public gspell
(package
(name "gspell")
(version "1.3.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"1n4kd5i11l79h8bpvx3cz79ww0b4z89y99h4czvyg80qlarn585w"))
(patches (search-patches "gspell-dash-test.patch"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-before 'check 'pre-check
(lambda* (#:key inputs #:allow-other-keys)
;; Tests require a running X server.
(system "Xvfb :1 &")
(setenv "DISPLAY" ":1")
;; For the missing /etc/machine-id.
(setenv "DBUS_FATAL_WARNINGS" "0")
;; Allow Enchant and its Aspell backend to find the en_US
;; dictionary.
(setenv "ASPELL_DICT_DIR"
(string-append (assoc-ref inputs "aspell-dict-en")
"/lib/aspell"))
#t)))))
(inputs
`(("enchant" ,enchant)
("iso-codes" ,iso-codes)
("gtk+" ,gtk+)
("glib" ,glib)))
(native-inputs
`(("glib" ,glib "bin")
("pkg-config" ,pkg-config)
("xmllint" ,libxml2)
;; For tests.
("xorg-server" ,xorg-server)
("aspell-dict-en" ,aspell-dict-en)))
(home-page "https://wiki.gnome.org/Projects/gspell")
(synopsis "GNOME's alternative spell checker")
(description
"gspell provides a flexible API to add spell-checking to a GTK+
application. It provides a GObject API, spell-checking to text entries and
text views, and buttons to choose the language.")
(license license:gpl2+)))

12
gnu/packages/gnupg.scm
View file

@ -192,16 +192,14 @@ specifications are building blocks of S/MIME and TLS.")
(define-public npth
(package
(name "npth")
(version "1.3")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://gnupg/npth/npth-"
version ".tar.bz2"))
(uri (string-append "mirror://gnupg/npth/npth-" version ".tar.bz2"))
(sha256
(base32
"0am86vblapwz84254qpmhz0chk70g6qzh3wdxcs0gvba8d01ka5w"))))
"1wpijvxg5svj893q9vp5r83d9ipwhpbyphb55m89l5m36qc185c9"))))
(build-system gnu-build-system)
(home-page "https://www.gnupg.org")
(synopsis "Non-preemptive thread library")
@ -217,14 +215,14 @@ compatible to GNU Pth.")
(define-public gnupg
(package
(name "gnupg")
(version "2.1.20")
(version "2.1.21")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2"))
(sha256
(base32
"03cnd6gz8f4lf69inskssw57idrswcdimhccdyglmrlv6rlrmkr4"))))
"1p97limv29p01y79mgnzpwixa50lv53wgdl3ymk9idkmpaldisks"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

29
gnu/packages/icu4c.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,6 +26,7 @@
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system ant)
#:use-module (guix build-system gnu))
(define-public icu4c
@ -75,3 +77,30 @@ C/C++ part.")
(patches
(search-patches "icu4c-CVE-2017-7867-CVE-2017-7868.patch"
"icu4c-reset-keyword-list-iterator.patch"))))))
(define-public java-icu4j
(package
(name "java-icu4j")
(version "59.1")
(source (origin
(method url-fetch)
(uri (string-append "http://download.icu-project.org/files/icu4j/"
version "/icu4j-"
(string-map (lambda (x)
(if (char=? x #\.) #\_ x))
version)
"-src.jar"))
(sha256
(base32
"0bgxsvgi0qcwj60pvcxrf7a3fbk7aksyxnfwpbzavyfrfzixqh0c"))))
(build-system ant-build-system)
(arguments
`(#:tests? #f ; no tests included
#:jar-name "icu4j.jar"))
(home-page "http://site.icu-project.org/")
(synopsis "International Components for Unicode")
(description
"ICU is a set of C/C++ and Java libraries providing Unicode and
globalisation support for software applications. This package contains the
Java part.")
(license x11)))

130
gnu/packages/image-processing.scm Normal file
View file

@ -0,0 +1,130 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages image-processing)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages boost)
#:use-module (gnu packages compression)
#:use-module (gnu packages documentation)
#:use-module (gnu packages gnome)
#:use-module (gnu packages graphics)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages image)
#:use-module (gnu packages maths)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages xml)
#:use-module (gnu packages vtk))
;; We use the latest snapshot of this package because the latest release is
;; from 2011 and has known vulnerabilities that cannot easily be fixed by
;; applying patches.
(define-public dcmtk
(package
(name "dcmtk")
(version "3.6.1_20170228")
(source (origin
(method url-fetch)
(uri (string-append "ftp://dicom.offis.de/pub/dicom/offis/"
"software/dcmtk/snapshot/dcmtk-"
version ".tar.gz"))
(sha256
(base32
"04cwfx8yrscqcd59mxk2fh6314ckayi9cp68iql5a57pf2pg5qld"))))
(build-system gnu-build-system)
(inputs
`(("libtiff" ,libtiff)
("libpng" ,libpng)
("doxygen" ,doxygen)
("zlib" ,zlib)))
(native-inputs
`(("perl" ,perl)))
(home-page "http://dcmtk.org")
(synopsis "Libraries and programs implementing parts of the DICOM standard")
(description "DCMTK is a collection of libraries and applications
implementing large parts the DICOM standard. It includes software for
examining, constructing and converting DICOM image files, handling offline
media, sending and receiving images over a network connection, as well as
demonstrative image storage and worklist servers.")
(license (license:fsf-free
"file://COPYRIGHT"
"A union of the Apache 2.0 licence and various non-copyleft
licences similar to the Modified BSD licence."))))
(define-public mia
(package
(name "mia")
(version "2.4.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/mia/mia/"
(version-major+minor version)
"/mia-" version ".tar.xz"))
(sha256
(base32
"124gvf8nkls59mlnx8ynq00n9zrah7a54gsywafx7qmfr0y95ra7"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags
(list "-DMIA_CREATE_NIPYPE_INTERFACES=0"
(string-append "-DCMAKE_INSTALL_LIBDIR="
(assoc-ref %outputs "out") "/lib")
"-DCMAKE_CXX_FLAGS=-fpermissive")))
(inputs
`(("boost" ,boost)
("dcmtk" ,dcmtk)
("doxygen" ,doxygen)
("eigen" ,eigen)
("fftw" ,fftw)
("fftwf" ,fftwf)
("gsl" ,gsl)
("gts" ,gts)
("hdf5" ,hdf5)
("itpp" ,itpp)
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("libtiff" ,libtiff)
("libxml" ,libxml2)
("libxml++" ,libxml++)
("maxflow" ,maxflow)
("niftilib" ,niftilib)
("nlopt" ,nlopt)
("openexr" ,openexr)
("python-lxml" ,python2-lxml)
("vtk" ,vtk)))
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python-2)))
(home-page "http://mia.sourceforge.net")
(synopsis "Toolkit for gray scale medical image analysis")
(description "MIA provides a combination of command line tools, plug-ins,
and libraries that make it possible run image processing tasks interactively
in a command shell and to prototype using the shell's scripting language. It
is built around a plug-in structure that makes it easy to add functionality
without compromising the original code base and it makes use of a wide variety
of external libraries that provide additional functionality.")
(license license:gpl3+)))

5
gnu/packages/image.scm
View file

@ -509,7 +509,10 @@ arithmetic ops.")
(sha256
(base32 "04akiwab8iy5iy34razcvh9mcja9wy737civ3sbjxk4j143s1b2s"))
(patches (search-patches "jbig2dec-ignore-testtest.patch"
"jbig2dec-CVE-2016-9601.patch"))))
"jbig2dec-CVE-2016-9601.patch"
"jbig2dec-CVE-2017-7885.patch"
"jbig2dec-CVE-2017-7975.patch"
"jbig2dec-CVE-2017-7976.patch"))))
(build-system gnu-build-system)
(synopsis "Decoder of the JBIG2 image compression format")

4
gnu/packages/imagemagick.scm
View file

@ -46,14 +46,14 @@
;; The 7 release series has an incompatible API, while the 6 series is still
;; maintained. Don't update to 7 until we've made sure that the ImageMagick
;; users are ready for the 7-series API.
(version "6.9.8-4")
(version "6.9.8-6")
(source (origin
(method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz"))
(sha256
(base32
"04fb0x8zc9z11127wsnxlzg0jcgs4xwlx8fxy4jac2y3mmmlzhm6"))))
"1sxg2wx3nrzbymh5wcqiv1x401nrz95xkrqgk3x446vx8lq7ln6w"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch")

1250
gnu/packages/java.scm
View file

File diff suppressed because it is too large Load diff

302
gnu/packages/kde-frameworks.scm
View file

File diff suppressed because it is too large Load diff

100
gnu/packages/libusb.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
;;;
@ -27,12 +27,16 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system ant)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system python)
#:use-module (gnu packages autotools)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gtk)
#:use-module (gnu packages java)
#:use-module (gnu packages linux)
#:use-module (gnu packages mp3)
#:use-module (gnu packages pkg-config)
@ -91,6 +95,100 @@ devices on various operating systems.")
version of libusb to run with newer libusb.")
(license lgpl2.1+)))
(define-public libusb4java
;; There is no public release so we take the latest version from git.
(let ((commit "396d642a57678a0d9663b062c980fe100cc0ea1e")
(revision "1"))
(package
(name "libusb4java")
(version (string-append "0-" revision "." (string-take commit 9)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/usb4java/libusb4java.git")
(commit commit)))
(sha256
(base32
"0wqgapalhfh9v38ycbl6i2f5lh1wpr6fzwn5dwd0rdacypkd1gml"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; there are no tests
#:phases
(modify-phases %standard-phases
(add-before 'configure 'set-JAVA_HOME
(lambda* (#:key inputs #:allow-other-keys)
(setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
#t)))))
(inputs
`(("libusb" ,libusb)))
(native-inputs
`(("jdk" ,icedtea "jdk")))
(home-page "https://github.com/usb4java/libusb4java/")
(synopsis "JNI bindings to libusb")
(description
"This package provides Java JNI bindings to the libusb library for use
with usb4java.")
(license expat))))
(define-public java-usb4java
(package
(name "java-usb4java")
(version "1.2.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/usb4java/usb4java/"
"archive/usb4java-" version ".tar.gz"))
(sha256
(base32
"0gzpsnzwgsdyra3smq288yvxnwrgvdwxr6g8jbknnsk56kv6wc34"))))
(build-system ant-build-system)
(arguments
`(#:jar-name "usb4java.jar"
#:phases
(modify-phases %standard-phases
;; Usually, native libusb4java libraries for all supported systems
;; would be included in the jar and extracted at runtime. Since we
;; build everything from source we cannot just bundle pre-built
;; binaries for other systems. Instead, we patch the loader to
;; directly return the appropriate library for this system. The
;; downside is that the jar will only work on the same architecture
;; that it was built on.
(add-after 'unpack 'copy-libusb4java
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/main/java/org/usb4java/Loader.java"
(("private static String extractLibrary" line)
(string-append
line "(final String a, final String b) {"
"return \""
(assoc-ref inputs "libusb4java") "/lib/libusb4java.so"
"\"; }\n"
"private static String _extractLibrary")))
#t))
(add-after 'unpack 'disable-broken-tests
(lambda _
(with-directory-excursion "src/test/java/org/usb4java"
;; These tests should only be run when USB devices are present.
(substitute* '("LibUsbGlobalTest.java"
"TransferTest.java")
(("this.context = new Context\\(\\);")
"this.context = null;")
(("LibUsb.init") "//"))
(substitute* "DeviceListIteratorTest.java"
(("this.iterator.remove" line)
(string-append "assumeUsbTestsEnabled();" line))))
#t)))))
(inputs
`(("libusb4java" ,libusb4java)
("java-commons-lang3" ,java-commons-lang3)
("java-junit" ,java-junit)
("java-hamcrest-core" ,java-hamcrest-core)))
(home-page "http://usb4java.org/")
(synopsis "USB library for Java")
(description
"This package provides a USB library for Java based on libusb and
implementing @code{javax.usb} (JSR-80).")
(license expat)))
(define-public python-pyusb
(package
(name "python-pyusb")

27
gnu/packages/linux.scm
View file

@ -354,8 +354,8 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define %linux-libre-version "4.11")
(define %linux-libre-hash "0j1bzzq9iq5i1zm7gnig8v0clr8wq303kvcdsaifc0r0ggz1mx1n")
(define %linux-libre-version "4.11.2")
(define %linux-libre-hash "0vp6hjc7cb6q6bhbg6jcf08r27xbf293cdib2vfng15ygvxpyfij")
(define-public linux-libre
(make-linux-libre %linux-libre-version
@ -364,14 +364,14 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
(define-public linux-libre-4.9
(make-linux-libre "4.9.27"
"1b39zijjkv21kya359y4g88w5ff110v95pvc4wfvc83dvik9hny5"
(make-linux-libre "4.9.29"
"0yj4gajdzilxnh9lhb2zl0hs654lagdfx8cp7bv2w4q41bnmc3l9"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.67"
"1nadmrd26llc17ipig7bx7rf2gwns94g86a3ilcvgdk17hq5riss"
(make-linux-libre "4.4.69"
"14q5lqsfmwyiilbhffr3bwsm6i3z1jv6y09rg8x3faibcg766wny"
%intel-compatible-systems
#:configuration-file kernel-config))
@ -1568,7 +1568,12 @@ UnionFS-FUSE additionally supports copy-on-write.")
(exe (string-append out "/bin/unionfs")))
;; By default, 'unionfs' keeps references to
;; $glibc/share/locale and similar stuff. Remove them.
(remove-store-references exe)))
(remove-store-references exe)
;; 'unionfsctl' has references to glibc as well. Since
;; we don't need it, remove it.
(delete-file (string-append out "/bin/unionfsctl"))
#t))
%standard-phases)))
(inputs `(("fuse" ,fuse-static)))))
@ -2859,7 +2864,7 @@ and copy/paste text in the console and in xterm.")
(define-public btrfs-progs
(package
(name "btrfs-progs")
(version "4.10.2")
(version "4.11")
(source (origin
(method url-fetch)
(uri (string-append "mirror://kernel.org/linux/kernel/"
@ -2867,7 +2872,7 @@ and copy/paste text in the console and in xterm.")
"btrfs-progs-v" version ".tar.xz"))
(sha256
(base32
"02p63nz78lrr156cmbb759z76cn95hv6mmz7v592lmiq0dkxy2gd"))))
"03mzv89f08gdsqv4ima793g44kdavcfyjialf5dr0zd2ab66hyp1"))))
(build-system gnu-build-system)
(outputs '("out"
"static")) ; static versions of binaries in "out" (~16MiB!)
@ -3320,14 +3325,14 @@ the default @code{nsswitch} and the experimental @code{umich_ldap}.")
(define-public mcelog
(package
(name "mcelog")
(version "149")
(version "150")
(source (origin
(method url-fetch)
(uri (string-append "https://git.kernel.org/cgit/utils/cpu/mce/"
"mcelog.git/snapshot/v" version ".tar.gz"))
(sha256
(base32
"08hd8bl9rgss990icb69srarrfwcg8k7py979ak753j92ybbkhdm"))
"1skfiracl3a1afmml8mvnccr4rym4ibv33c342rkyxn0j3088h24"))
(file-name (string-append name "-" version ".tar.gz"))
(modules '((guix build utils)))
(snippet

159
gnu/packages/lisp.scm
View file

@ -4,7 +4,7 @@
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net>
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
@ -659,7 +659,7 @@ portable between implementations.")
(sha256
(base32 "0f48pcbhqs3wwwzjl5nk57d4hcbib4l9xblxc66b8c2fhvhmhxnv"))
(file-name (string-append "fiveam-" version ".tar.gz"))))
(inputs `(("sbcl-alexandria" ,sbcl-alexandria)))
(inputs `(("alexandria" ,sbcl-alexandria)))
(build-system asdf-build-system/sbcl)
(synopsis "Common Lisp testing framework")
(description "FiveAM is a simple (as far as writing and running tests
@ -687,8 +687,8 @@ interactive development model in mind.")
(base32 "10ryrcx832fwqdawb6jmknymi7wpdzhi30qzx7cbrk0cpnka71w2"))
(file-name
(string-append "bordeaux-threads-" version ".tar.gz"))))
(inputs `(("sbcl-alexandria" ,sbcl-alexandria)))
(native-inputs `(("tests:cl-fiveam" ,sbcl-fiveam)))
(inputs `(("alexandria" ,sbcl-alexandria)))
(native-inputs `(("fiveam" ,sbcl-fiveam)))
(build-system asdf-build-system/sbcl)
(synopsis "Portable shared-state concurrency library for Common Lisp")
(description "BORDEAUX-THREADS is a proposed standard for a minimal
@ -749,7 +749,7 @@ thin compatibility layer for gray streams.")
(base32 "16grnxvs7vqm5s6myf8a5s7vwblzq1kgwj8i7ahz8vwvihm9gzfi"))
(file-name (string-append "flexi-streams-" version ".tar.gz"))))
(build-system asdf-build-system/sbcl)
(inputs `(("sbcl-trivial-gray-streams" ,sbcl-trivial-gray-streams)))
(inputs `(("trivial-gray-streams" ,sbcl-trivial-gray-streams)))
(synopsis "Implementation of virtual bivalent streams for Common Lisp")
(description "Flexi-streams is an implementation of \"virtual\" bivalent
streams that can be layered atop real binary or bivalent streams and that can
@ -779,7 +779,7 @@ streams which are similar to string streams.")
(base32 "1i7daxf0wnydb0pgwiym7qh2wy70n14lxd6dyv28sy0naa8p31gd"))
(file-name (string-append "cl-ppcre-" version ".tar.gz"))))
(build-system asdf-build-system/sbcl)
(native-inputs `(("tests:cl-flexi-streams" ,sbcl-flexi-streams)))
(native-inputs `(("flexi-streams" ,sbcl-flexi-streams)))
(synopsis "Portable regular expression library for Common Lisp")
(description "CL-PPCRE is a portable regular expression library for Common
Lisp, which is compatible with perl. It is pretty fast, thread-safe, and
@ -793,6 +793,51 @@ compatible with ANSI-compliant Common Lisp implementations.")
(define-public ecl-cl-ppcre
(sbcl-package->ecl-package sbcl-cl-ppcre))
(define sbcl-cl-unicode-base
(let ((revision "1")
(commit "9fcd06fba1ddc9e66aed2f2d6c32dc9b764f03ea"))
(package
(name "sbcl-cl-unicode-base")
(version (string-append "0.1.5-" revision "." (string-take commit 7)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/edicl/cl-unicode.git")
(commit commit)))
(file-name (string-append "cl-unicode-" version "-checkout"))
(sha256
(base32
"1jicprb5b3bv57dy1kg03572gxkcaqdjhak00426s76g0plmx5ki"))))
(build-system asdf-build-system/sbcl)
(arguments
'(#:asd-file "cl-unicode.asd"
#:asd-system-name "cl-unicode/base"))
(inputs
`(("cl-ppcre" ,sbcl-cl-ppcre)))
(home-page "http://weitz.de/cl-unicode/")
(synopsis "Portable Unicode library for Common Lisp")
(description "CL-UNICODE is a portable Unicode library Common Lisp, which
is compatible with perl. It is pretty fast, thread-safe, and compatible with
ANSI-compliant Common Lisp implementations.")
(license license:bsd-2))))
(define-public sbcl-cl-unicode
(package
(inherit sbcl-cl-unicode-base)
(name "sbcl-cl-unicode")
(inputs
`(("cl-unicode/base" ,sbcl-cl-unicode-base)
,@(package-inputs sbcl-cl-unicode-base)))
(native-inputs
`(("flexi-streams" ,sbcl-flexi-streams)))
(arguments '())))
(define-public ecl-cl-unicode
(sbcl-package->ecl-package sbcl-cl-unicode))
(define-public cl-unicode
(sbcl-package->cl-source-package sbcl-cl-unicode))
(define-public sbcl-clx
(let ((revision "1")
(commit "1c62774b03c1cf3fe6e5cb532df8b14b44c96b95"))
@ -822,8 +867,6 @@ compatible with ANSI-compliant Common Lisp implementations.")
(substitute* "clx.asd"
(("\\(:file \"trapezoid\"\\)") ""))))))
(build-system asdf-build-system/sbcl)
(arguments
'(#:special-dependencies '("sb-bsd-sockets")))
(home-page "http://www.cliki.net/portable-clx")
(synopsis "X11 client library for Common Lisp")
(description "CLX is an X11 client library for Common Lisp. The code was
@ -851,31 +894,27 @@ from other CLXes around the net.")
(base32 "1maxp98gh64az3d9vz9br6zdd6rc9fmj2imvax4by85g6kxvdz1i"))
(file-name (string-append "stumpwm-" version ".tar.gz"))))
(build-system asdf-build-system/sbcl)
(inputs `(("sbcl-cl-ppcre" ,sbcl-cl-ppcre)
("sbcl-clx" ,sbcl-clx)))
(outputs '("out" "bin"))
(inputs `(("cl-ppcre" ,sbcl-cl-ppcre)
("clx" ,sbcl-clx)))
(outputs '("out" "lib"))
(arguments
'(#:special-dependencies '("sb-posix")
#:phases
'(#:phases
(modify-phases %standard-phases
(add-after 'create-symlinks 'build-program
(lambda* (#:key lisp outputs inputs #:allow-other-keys)
(lambda* (#:key outputs #:allow-other-keys)
(build-program
lisp
(string-append (assoc-ref outputs "bin") "/bin/stumpwm")
#:inputs inputs
(string-append (assoc-ref outputs "out") "/bin/stumpwm")
outputs
#:entry-program '((stumpwm:stumpwm) 0))))
(add-after 'build-program 'create-desktop-file
(lambda* (#:key outputs lisp binary? #:allow-other-keys)
(let ((output (or (assoc-ref outputs "bin")
(assoc-ref outputs "out")))
(xsessions "/share/xsessions"))
(mkdir-p (string-append output xsessions))
(with-output-to-file
(string-append output xsessions
"/stumpwm.desktop")
(lambda _
(format #t
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(xsessions (string-append out "/share/xsessions")))
(mkdir-p xsessions)
(call-with-output-file
(string-append xsessions "/stumpwm.desktop")
(lambda (file)
(format file
"[Desktop Entry]~@
Name=stumpwm~@
Comment=The Stump Window Manager~@
@ -883,7 +922,7 @@ from other CLXes around the net.")
TryExec=~@*~a/bin/stumpwm~@
Icon=~@
Type=Application~%"
output)))
out)))
#t))))))
(synopsis "Window manager written in Common Lisp")
(description "Stumpwm is a window manager written entirely in Common Lisp.
@ -904,11 +943,15 @@ productive, customizable lisp based systems.")
(outputs '("out"))
(arguments '()))))
;; The slynk that users expect to install includes all of slynk's contrib
;; modules. Therefore, we build the base module and all contribs first; then
;; we expose the union of these as `sbcl-slynk'. The following variable
;; describes the base module.
(define sbcl-slynk-boot0
(let ((revision "1")
(commit "5706cd45d484a4f25795abe8e643509d31968aa2"))
(package
(name "sbcl-slynk")
(name "sbcl-slynk-boot0")
(version (string-append "1.0.0-beta-" revision "." (string-take commit 7)))
(source
(origin
@ -948,19 +991,22 @@ productive, customizable lisp based systems.")
(scandir "slynk"))))))
(build-system asdf-build-system/sbcl)
(arguments
`(#:tests? #f)) ; No test suite
`(#:tests? #f ; No test suite
#:asd-system-name "slynk"))
(synopsis "Common Lisp IDE for Emacs")
(description "SLY is a fork of SLIME. It also features a completely
redesigned REPL based on Emacs's own full-featured comint.el, live code
annotations, and a consistent interactive button interface. Everything can be
copied to the REPL. One can create multiple inspectors with independent
history.")
(description "SLY is a fork of SLIME, an IDE backend for Common Lisp.
It also features a completely redesigned REPL based on Emacs's own
full-featured comint.el, live code annotations, and a consistent interactive
button interface. Everything can be copied to the REPL. One can create
multiple inspectors with independent history.")
(home-page "https://github.com/joaotavora/sly")
(license license:public-domain)
(properties `((cl-source-variant . ,(delay cl-slynk)))))))
(define-public cl-slynk
(sbcl-package->cl-source-package sbcl-slynk-boot0))
(package
(inherit (sbcl-package->cl-source-package sbcl-slynk-boot0))
(name "cl-slynk")))
(define ecl-slynk-boot0
(sbcl-package->ecl-package sbcl-slynk-boot0))
@ -969,10 +1015,11 @@ history.")
(package
(inherit sbcl-slynk-boot0)
(name "sbcl-slynk-arglists")
(inputs `(("sbcl-slynk" ,sbcl-slynk-boot0)))
(inputs `(("slynk" ,sbcl-slynk-boot0)))
(arguments
`(#:asd-file "slynk.asd"
,@(package-arguments sbcl-slynk-boot0)))))
(substitute-keyword-arguments (package-arguments sbcl-slynk-boot0)
((#:asd-file _ "") "slynk.asd")
((#:asd-system-name _ #f) #f)))))
(define ecl-slynk-arglists
(sbcl-package->ecl-package sbcl-slynk-arglists))
@ -989,7 +1036,7 @@ history.")
(package
(inherit sbcl-slynk-arglists)
(name "sbcl-slynk-fancy-inspector")
(inputs `(("sbcl-slynk-util" ,sbcl-slynk-util)
(inputs `(("slynk-util" ,sbcl-slynk-util)
,@(package-inputs sbcl-slynk-arglists)))))
(define ecl-slynk-fancy-inspector
@ -1067,6 +1114,7 @@ history.")
(define-public sbcl-slynk
(package
(inherit sbcl-slynk-boot0)
(name "sbcl-slynk")
(inputs
`(("slynk" ,sbcl-slynk-boot0)
("slynk-util" ,sbcl-slynk-util)
@ -1104,12 +1152,15 @@ history.")
(prepend-to-source-registry
(string-append (assoc-ref %outputs "out") "//"))
(build-image "sbcl"
(string-append
(assoc-ref %outputs "image")
"/bin/slynk")
#:inputs %build-inputs
#:dependencies ',slynk-systems))))))
(parameterize ((%lisp-type "sbcl")
(%lisp (string-append (assoc-ref %build-inputs "sbcl")
"/bin/sbcl")))
(build-image (string-append
(assoc-ref %outputs "image")
"/bin/slynk")
%outputs
#:dependencies ',slynk-systems)))))))
(define-public ecl-slynk
(package
@ -1138,28 +1189,30 @@ history.")
(inherit sbcl-stumpwm)
(name "sbcl-stumpwm-with-slynk")
(outputs '("out"))
(native-inputs
`(("stumpwm" ,sbcl-stumpwm)
(inputs
`(("stumpwm" ,sbcl-stumpwm "lib")
("slynk" ,sbcl-slynk)))
(arguments
(substitute-keyword-arguments (package-arguments sbcl-stumpwm)
((#:phases phases)
`(modify-phases ,phases
(replace 'build-program
(lambda* (#:key lisp inputs outputs #:allow-other-keys)
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(program (string-append out "/bin/stumpwm")))
(build-program lisp program
#:inputs inputs
(build-program program outputs
#:entry-program '((stumpwm:stumpwm) 0)
#:dependencies '("stumpwm"
,@slynk-systems))
,@slynk-systems)
#:dependency-prefixes
(map (lambda (input) (assoc-ref inputs input))
'("stumpwm" "slynk")))
;; Remove unneeded file.
(delete-file (string-append out "/bin/stumpwm-exec.fasl"))
#t)))
(delete 'copy-source)
(delete 'build)
(delete 'check)
(delete 'link-dependencies)
(delete 'create-asd-file)
(delete 'cleanup)
(delete 'create-symlinks)))))))

15
gnu/packages/logging.scm
View file

@ -109,6 +109,21 @@ command line.")
`(("python-pyyaml" ,python-pyyaml)
("python-sockjs-tornado" ,python-sockjs-tornado)
("python-tornado" ,python-tornado)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-commands.py
(lambda args
(substitute* "tailon/commands.py"
(("self\\.first_in_path\\('grep'\\)")
(string-append"'" (which "grep") "'"))
(("self\\.first_in_path\\('gawk', 'awk'\\)")
(string-append"'" (which "gawk") "'"))
(("self\\.first_in_path\\('gsed', 'sed'\\)")
(string-append"'" (which "sed") "'"))
(("self\\.first_in_path\\('gtail', 'tail'\\)")
(string-append"'" (which "tail") "'")))
#t)))))
(home-page "https://tailon.readthedocs.io/")
(synopsis
"Webapp for looking at and searching through log files")

4
gnu/packages/mail.scm
View file

@ -1608,13 +1608,13 @@ maintained.")
(define-public khard
(package
(name "khard")
(version "0.11.3")
(version "0.11.4")
(source (origin
(method url-fetch)
(uri (pypi-uri name version))
(sha256
(base32
"1v66khq5w17xdbkpb00pf9xbl84dlzx4lq286fvzskb949b3y4yn"))))
"1shhlq6ljbd8095hd82v4mw56rjcfxf1ymmgknbgh8gix02nsxw1"))))
(build-system python-build-system)
(arguments
`(#:phases

8
gnu/packages/mc.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 ng0 <ng0@libertad.pw>
;;; Copyright © 2016, 2017 ng0 <ng0@no-reply.pragmatique.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@ -30,7 +30,8 @@
#:use-module (gnu packages ssh)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages check)
#:use-module (gnu packages perl))
#:use-module (gnu packages perl)
#:use-module (gnu packages zip))
(define-public mc
(package
@ -51,7 +52,8 @@
("ncurses" ,ncurses)
("libssh2" ,libssh2)
("glib" ,glib)
("check" ,check)))
("check" ,check)
("unzip" ,unzip)))
(arguments
`(#:configure-flags
'("--with-screen=ncurses" "--enable-aspell")

27
gnu/packages/mes.scm
View file

@ -54,30 +54,35 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(license (list gpl3+ lgpl3+))))
(define-public mes
(let ((commit "a437c173b9da1949ad966fd50dd4f26e522a910a")
(let ((commit "d4420bbcc9f994e2cce430cf156f383dc4092bca")
(revision "0")
(triplet "i686-unknown-linux-gnu"))
(triplet "i686-unknown-linux-gnu")
(version "0.6"))
(package
(name "mes")
(version (string-append "0.5-" revision "." (string-take commit 7)))
(version (string-append version "-" revision "." (string-take commit 7)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/janneke/mes")
(commit commit)))
(file-name (string-append name "-" version))
;; TODO: Unbundle nyacc.
(sha256
(base32 "1ynr0hc0k15307sgzv09k3y5rvy46h0wbh7zcblx1f9v7y8k90zv"))))
(base32 "0qqywk3siyhf08v7xac08lqldklrqfndlp495wgy6ii9fn93197k"))))
(build-system gnu-build-system)
(supported-systems '("x86_64-linux"))
(supported-systems '("i686-linux" "x86_64-linux"))
(propagated-inputs
`(("nyacc" ,nyacc)))
(native-inputs
`(("guile" ,guile-2.2)
;; Use cross-compiler rather than #:system "i686-linux" to get
;; MesCC 64 bit .go files installed ready for use with Guile.
("i686-linux-binutils" ,(cross-binutils triplet))
("i686-linux-gcc" ,(let ((triplet triplet)) (cross-gcc triplet)))
("perl" ,perl))) ;build-aux/gitlog-to-changelog
,@(if (string-prefix? "x86_64-linux" (or (%current-target-system)
(%current-system)))
;; Use cross-compiler rather than #:system "i686-linux" to get
;; MesCC 64 bit .go files installed ready for use with Guile.
`(("i686-linux-binutils" ,(cross-binutils triplet))
("i686-linux-gcc" ,(cross-gcc triplet)))
'())
("perl" ,perl))) ;build-aux/gitlog-to-changelog
(arguments
`(#:phases
(modify-phases %standard-phases

51
gnu/packages/music.scm
View file

@ -786,6 +786,57 @@ session management. NSM clients use a well-specified OSC protocol to
communicate with the session management daemon.")
(license license:gpl2+)))
(define-public non-mixer
(package (inherit non-sequencer)
(name "non-mixer")
(arguments
(substitute-keyword-arguments (package-arguments non-sequencer)
((#:configure-flags flags)
`(cons "--project=mixer"
(delete "--project=sequencer" ,flags)))))
(inputs
`(("jack" ,jack-1)
("liblo" ,liblo)
("ladspa" ,ladspa)
("lrdf" ,lrdf)
("ntk" ,ntk)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://non.tuxfamily.org/wiki/Non%20Mixer")
(synopsis "Modular digital audio mixer")
(description
"The Non Mixer is a powerful, reliable and fast modular digital audio
mixer. It utilizes JACK for inter-application audio I/O and the NTK GUI
toolkit for a fast and lightweight user interface. Non Mixer can be used
alone or in concert with Non Timeline and Non Sequencer to form a complete
studio.")
(license license:gpl2+)))
(define-public non-timeline
(package (inherit non-sequencer)
(name "non-timeline")
(arguments
(substitute-keyword-arguments (package-arguments non-sequencer)
((#:configure-flags flags)
`(cons "--project=timeline"
(delete "--project=sequencer" ,flags)))))
(inputs
`(("jack" ,jack-1)
("liblo" ,liblo)
("libsndfile" ,libsndfile)
("ntk" ,ntk)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://non.tuxfamily.org/wiki/Non%20Timeline")
(synopsis "Modular digital audio timeline arranger")
(description
"The Non Timeline is a powerful, reliable and fast modular digital audio
timeline arranger. It utilizes JACK for inter-application audio I/O and the
NTK GUI toolkit for a fast and lightweight user interface. Non Timeline can
be used alone or in concert with Non Mixer and Non Sequencer to form a
complete studio.")
(license license:gpl2+)))
(define-public solfege
(package
(name "solfege")

4
gnu/packages/nano.scm
View file

@ -29,7 +29,7 @@
(define-public nano
(package
(name "nano")
(version "2.8.2")
(version "2.8.4")
(source
(origin
(method url-fetch)
@ -37,7 +37,7 @@
version ".tar.xz"))
(sha256
(base32
"1q5rxkvsv974085xrd2k11ffazadabcb9cnpfra0shmj71xqlgh2"))))
"04bvmimrw40cbcnm3xm5l5lir0qy7cncfkmwrlzg8jiy1x7jdky7"))))
(build-system gnu-build-system)
(inputs
`(("gettext" ,gettext-minimal)

19
gnu/packages/package-management.scm
View file

@ -52,6 +52,7 @@
#:use-module (gnu packages tls)
#:use-module (gnu packages ssh)
#:use-module (gnu packages vim)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match))
(define (boot-guile-uri arch)
@ -73,8 +74,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this.
(let ((version "0.12.0")
(commit "ba2260dbbc5a3c915e2cbd54d93f2f3af2a864c3")
(revision 10))
(commit "ce92d269fea0a2bfac0ac20414f77127d2f07500")
(revision 11))
(package
(name "guix")
@ -90,7 +91,7 @@
(commit commit)))
(sha256
(base32
"0nkwbblsnl7kv2n8jf8c6rl3a7dynaqxizhhni18vbnmvza35c79"))
"17l9r2mdzzv8vfxb3bc5zkdqkl472q979iwsarp7lcqss1jxys7w"))
(file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system)
(arguments
@ -265,6 +266,18 @@ the Nix package manager.")
;; Alias for backward compatibility.
(define-public guix-devel guix)
(define-public guile2.0-guix
(package
(inherit guix)
(name "guile2.0-guix")
(inputs
`(("guile" ,guile-2.0)
,@(alist-delete "guile" (package-inputs guix))))
(propagated-inputs
`(("gnutls" ,gnutls)
("guile-json" ,guile2.0-json)
("guile-ssh" ,guile2.0-ssh)))))
(define (source-file? file stat)
"Return true if FILE is likely a source file, false if it is a typical
generated file."

20
gnu/packages/patches/aspell-default-dict-dir.patch Normal file
View file

@ -0,0 +1,20 @@
This patch changes the default value of 'dict-dir' to correspond
to ~/.guix-profile/lib/aspell rather than $prefix/lib/aspell-X.Y.
This is not strictly necessary for the 'aspell' program itself since
one can simply set "ASPELL_CONF=dict-dir $HOME/.guix-profile/lib/aspell".
However it is necessary for applications that use libaspell since
'ASPELL_CONF' is not honored in this case. See <https://bugs.gnu.org/25836>.
--- a/common/config.cpp
+++ b/common/config.cpp
@@ -1349,6 +1349,9 @@ namespace acommon {
# define REPL ".aspell.<lang>.prepl"
#endif
+#undef DICT_DIR
+#define DICT_DIR "<$ASPELL_DICT_DIR|home-dir/.guix-profile/lib/aspell>"
+
static const KeyInfo config_keys[] = {
// the description should be under 50 chars
{"actual-dict-dir", KeyInfoString, "<dict-dir^master>", 0}

45
gnu/packages/patches/calibre-dont-load-remote-icons.patch Normal file
View file

@ -0,0 +1,45 @@
From: Martin Pitt <mpitt@debian.org>
Date: Mon, 14 Nov 2016 22:41:24 +0100
Subject: content-server: Don't load external URLs for privacy
Spotted by lintian.
---
resources/content_server/browse/browse.html | 4 +---
resources/content_server/index.html | 2 +-
2 files changed, 2 insertions(+), 4 deletions(-)
diff --git a/resources/content_server/browse/browse.html b/resources/content_server/browse/browse.html
index 36f7199..e615707 100644
--- a/resources/content_server/browse/browse.html
+++ b/resources/content_server/browse/browse.html
@@ -7,7 +7,7 @@
<title>..:: calibre {library} ::.. {title}</title>
<meta http-equiv="X-UA-Compatible" content="IE=100" />
<meta name="robots" content="noindex" />
- <link rel="icon" type="image/x-icon" href="//calibre-ebook.com/favicon.ico" />
+ <link rel="icon" type="image/x-icon" href="favicon.ico" />
<link rel="stylesheet" type="text/css" href="{prefix}/static/browse/browse.css" />
<link type="text/css" href="{prefix}/static/jquery_ui/css/humanity-custom/jquery-ui-1.8.5.custom.css" rel="stylesheet" />
@@ -63,8 +63,6 @@
<input type="image"
src="{prefix}/static/button-donate.png"
name="submit"></input>
- <img alt="" src="https://www.paypal.com/en_US/i/scr/pixel.gif"
- width="1" height="1"></img>
</div>
</form>
<div id="calibre-home-link" title="Go to the calibre website"></div>
diff --git a/resources/content_server/index.html b/resources/content_server/index.html
index 51cc33a..e71d0e8 100644
--- a/resources/content_server/index.html
+++ b/resources/content_server/index.html
@@ -9,7 +9,7 @@
<script type="text/javascript" src="{prefix}/static/date.js" charset="utf-8"></script>
<script type="text/javascript" src="{prefix}/static/jquery.js" charset="utf-8"></script>
<script type="text/javascript" src="{prefix}/static/gui.js" charset="utf-8"></script>
- <link rel="icon" href="//calibre-ebook.com/favicon.ico" type="image/x-icon" />
+ <link rel="icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
<div id="banner">

48
gnu/packages/patches/calibre-drop-unrar.patch
View file

@ -1,15 +1,20 @@
Taken from Debian. Updated by Alex Griffin.
Recreated old debian patch on the latest calibre version
Author: Dmitry Shachnev <mitya57@gmail.com>
Description: do not build unrar extension as we strip unrar from the tarball
Forwarded: not-needed
Last-Update: 2013-04-04
From 6764e4c211e50d4f4633dbabfba7cbc3089c51dc Mon Sep 17 00:00:00 2001
From: Brendan Tildesley <brendan.tildesley@openmailbox.org>
Date: Sat, 13 May 2017 21:12:12 +1000
Subject: [PATCH] Remove unrar extension
Index: calibre/setup/extensions.py
===================================================================
--- calibre.orig/setup/extensions.json 2016-07-21 21:21:05.000000000 -0500
+++ calibre/setup/extensions.json 2016-07-27 11:22:17.167710112 -0500
@@ -211,14 +211,5 @@
---
setup/extensions.json | 11 -----------
src/calibre/ebooks/metadata/archive.py | 2 +-
2 files changed, 1 insertion(+), 12 deletions(-)
diff --git a/setup/extensions.json b/setup/extensions.json
index 1f6d1fb5fd..127390450f 100644
--- a/setup/extensions.json
+++ b/setup/extensions.json
@@ -211,16 +211,5 @@
"sources": "calibre/devices/mtp/unix/devices.c calibre/devices/mtp/unix/libmtp.c",
"headers": "calibre/devices/mtp/unix/devices.h calibre/devices/mtp/unix/upstream/music-players.h calibre/devices/mtp/unix/upstream/device-flags.h",
"libraries": "mtp"
@ -20,22 +25,25 @@ Index: calibre/setup/extensions.py
- "inc_dirs": "unrar",
- "defines": "SILENT RARDLL UNRAR _FILE_OFFSET_BITS=64 _LARGEFILE_SOURCE",
- "windows_defines": "SILENT RARDLL UNRAR",
- "haiku_defines": "LITTLE_ENDIAN SILENT RARDLL UNRAR _FILE_OFFSET_BITS=64 _LARGEFILE_SOURCE _BSD_SOURCE",
- "haiku_libraries": "bsd",
- "optimize_level": 2,
- "windows_libraries": "User32 Advapi32 kernel32 Shell32"
}
]
Index: calibre/src/calibre/ebooks/metadata/archive.py
===================================================================
--- calibre.orig/src/calibre/ebooks/metadata/archive.py 2016-07-21 21:21:05.000000000 -0500
+++ calibre/src/calibre/ebooks/metadata/archive.py 2016-07-27 11:21:07.793616039 -0500
@@ -42,7 +42,7 @@
description = _('Extract common e-book formats from archives '
'(zip/rar) files. Also try to autodetect if they are actually '
'cbz/cbr files.')
diff --git a/src/calibre/ebooks/metadata/archive.py b/src/calibre/ebooks/metadata/archive.py
index f5c0b7bed3..32257dcdae 100644
--- a/src/calibre/ebooks/metadata/archive.py
+++ b/src/calibre/ebooks/metadata/archive.py
@@ -44,7 +44,7 @@ class ArchiveExtract(FileTypePlugin):
description = _('Extract common e-book formats from archive files '
'(ZIP/RAR). Also try to autodetect if they are actually '
'CBZ/CBR files.')
- file_types = set(['zip', 'rar'])
+ file_types = set(['zip'])
supported_platforms = ['windows', 'osx', 'linux']
on_import = True
--
2.12.2

51
gnu/packages/patches/calibre-use-packaged-feedparser.patch Normal file
View file

@ -0,0 +1,51 @@
From: Martin Pitt <mpitt@debian.org>
Date: Mon, 14 Nov 2016 22:41:23 +0100
Subject: Use packaged instead of bundled feedparser Python module
---
recipes/lenta_ru.recipe | 4 +++-
src/calibre/web/feeds/__init__.py | 4 +++-
2 files changed, 6 insertions(+), 2 deletions(-)
diff --git a/recipes/lenta_ru.recipe b/recipes/lenta_ru.recipe
index aa4dac4..4b6710c 100644
--- a/recipes/lenta_ru.recipe
+++ b/recipes/lenta_ru.recipe
@@ -4,11 +4,13 @@
Lenta.ru
'''
-from calibre.web.feeds.feedparser import parse
from calibre.ebooks.BeautifulSoup import Tag
from calibre.web.feeds.news import BasicNewsRecipe
+from feedparser import parse
+from functools import partial
import re
+parse = partial(parse, agent='Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.2.11) Gecko/20101012 Firefox/3.6.11')
class LentaRURecipe(BasicNewsRecipe):
title = u'Lenta.ru: \u041d\u043e\u0432\u043e\u0441\u0442\u0438'
diff --git a/src/calibre/web/feeds/__init__.py b/src/calibre/web/feeds/__init__.py
index 8c9d748..f262604 100644
--- a/src/calibre/web/feeds/__init__.py
+++ b/src/calibre/web/feeds/__init__.py
@@ -11,7 +11,10 @@ from calibre.utils.logging import default_log
from calibre import entity_to_unicode, strftime, force_unicode
from calibre.utils.date import dt_factory, utcnow, local_tz
from calibre.utils.cleantext import clean_ascii_chars, clean_xml_chars
+from feedparser import parse
+from functools import partial
+parse = partial(parse, agent='Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.2.11) Gecko/20101012 Firefox/3.6.11')
class Article(object):
@@ -334,7 +337,6 @@ def feed_from_xml(raw_xml, title=None, oldest_article=7,
max_articles_per_feed=100,
get_article_url=lambda item: item.get('link', None),
log=default_log):
- from calibre.web.feeds.feedparser import parse
# Handle unclosed escaped entities. They trip up feedparser and HBR for one
# generates them
raw_xml = re.sub(r'(&amp;#\d+)([^0-9;])', r'\1;\2', raw_xml)

16
gnu/packages/patches/gspell-dash-test.patch Normal file
View file

@ -0,0 +1,16 @@
Somehow, Aspell 0.60.6.1 and aspell-dict-en-2016.11.20-0 don't consider
this a valid spelling. Skip it.
--- gspell-1.3.2/testsuite/test-checker.c 2017-05-17 16:02:40.832415940 +0200
+++ gspell-1.3.2/testsuite/test-checker.c 2017-05-17 16:02:50.768351895 +0200
@@ -101,9 +101,6 @@ test_dashes (void)
checker = gspell_checker_new (lang);
- correctly_spelled = gspell_checker_check_word (checker, "spell-checking", -1, &error);
- g_assert_no_error (error);
- g_assert (correctly_spelled);
correctly_spelled = gspell_checker_check_word (checker, "nrst-auie", -1, &error);
g_assert_no_error (error);

37
gnu/packages/patches/guile-ssh-double-free.patch Normal file
View file

@ -0,0 +1,37 @@
Fix a double-free or use-after-free issue with Guile-SSH used
with Guile 2.2. See <https://bugs.gnu.org/26976>.
diff --git a/libguile-ssh/channel-type.c b/libguile-ssh/channel-type.c
index 3dd641f..0839854 100644
--- a/libguile-ssh/channel-type.c
+++ b/libguile-ssh/channel-type.c
@@ -229,10 +229,11 @@ ptob_close (SCM channel)
ssh_channel_free (ch->ssh_channel);
}
+ SCM_SETSTREAM (channel, NULL);
+
#if USING_GUILE_BEFORE_2_2
scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer");
scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer");
- SCM_SETSTREAM (channel, NULL);
return 0;
#endif
diff --git a/libguile-ssh/sftp-file-type.c b/libguile-ssh/sftp-file-type.c
index 8879924..f87cf03 100644
--- a/libguile-ssh/sftp-file-type.c
+++ b/libguile-ssh/sftp-file-type.c
@@ -224,10 +224,11 @@ ptob_close (SCM sftp_file)
sftp_close (fd->file);
}
+ SCM_SETSTREAM (sftp_file, NULL);
+
#if USING_GUILE_BEFORE_2_2
scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer");
scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer");
- SCM_SETSTREAM (sftp_file, NULL);
return 1;
#endif

16
gnu/packages/patches/guile-ssh-rexec-bug.patch Normal file
View file

@ -0,0 +1,16 @@
Fix a bug whereby 'node-guile-version' would pass a node instead of
a session to 'rexec'.
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index 9c065c7..29a3906 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -411,7 +411,8 @@ procedure returns the 1st evaluated value if multiple values were returned."
"Get Guile version installed on a NODE, return the version string. Return
#f if Guile is not installed."
(receive (result rc)
- (rexec node "which guile > /dev/null && guile --version")
+ (rexec (node-session node)
+ "which guile > /dev/null && guile --version")
(and (zero? rc)
(car result))))

38
gnu/packages/patches/jbig2dec-CVE-2017-7885.patch Normal file
View file

@ -0,0 +1,38 @@
Fix CVE-2017-7885:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-7885
https://bugs.ghostscript.com/show_bug.cgi?id=697703
Patch copied from upstream source repository:
https://git.ghostscript.com/?p=jbig2dec.git;a=commit;h=258290340bb657c9efb44457f717b0d8b49f4aa3
From 258290340bb657c9efb44457f717b0d8b49f4aa3 Mon Sep 17 00:00:00 2001
From: Shailesh Mistry <shailesh.mistry@hotmail.co.uk>
Date: Wed, 3 May 2017 22:06:01 +0100
Subject: [PATCH] Bug 697703: Prevent integer overflow vulnerability.
Add extra check for the offset being greater than the size
of the image and hence reading off the end of the buffer.
Thank you to Dai Ge for finding this issue and suggesting a patch.
---
jbig2_symbol_dict.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/jbig2_symbol_dict.c b/jbig2_symbol_dict.c
index 4acaba9..36225cb 100644
--- a/jbig2_symbol_dict.c
+++ b/jbig2_symbol_dict.c
@@ -629,7 +629,7 @@ jbig2_decode_symbol_dict(Jbig2Ctx *ctx,
byte *dst = image->data;
/* SumatraPDF: prevent read access violation */
- if (size - jbig2_huffman_offset(hs) < image->height * stride) {
+ if ((size - jbig2_huffman_offset(hs) < image->height * stride) || (size < jbig2_huffman_offset(hs))) {
jbig2_error(ctx, JBIG2_SEVERITY_FATAL, segment->number, "not enough data for decoding (%d/%d)", image->height * stride,
size - jbig2_huffman_offset(hs));
jbig2_image_release(ctx, image);
--
2.13.0

40
gnu/packages/patches/jbig2dec-CVE-2017-7975.patch Normal file
View file

@ -0,0 +1,40 @@
Fix CVE-2017-7975:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-7975
https://bugs.ghostscript.com/show_bug.cgi?id=697693
Patch copied from upstream source repository:
https://git.ghostscript.com/?p=jbig2dec.git;a=commit;h=f8992b8fe65c170c8624226f127c5c4bfed42c66
From f8992b8fe65c170c8624226f127c5c4bfed42c66 Mon Sep 17 00:00:00 2001
From: Shailesh Mistry <shailesh.mistry@hotmail.co.uk>
Date: Wed, 26 Apr 2017 22:12:14 +0100
Subject: [PATCH] Bug 697693: Prevent SEGV due to integer overflow.
While building a Huffman table, the start and end points were susceptible
to integer overflow.
Thank you to Jiaqi for finding this issue and suggesting a patch.
---
jbig2_huffman.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/jbig2_huffman.c b/jbig2_huffman.c
index 511e461..b4189a1 100644
--- a/jbig2_huffman.c
+++ b/jbig2_huffman.c
@@ -421,8 +421,8 @@ jbig2_build_huffman_table(Jbig2Ctx *ctx, const Jbig2HuffmanParams *params)
if (PREFLEN == CURLEN) {
int RANGELEN = lines[CURTEMP].RANGELEN;
- int start_j = CURCODE << shift;
- int end_j = (CURCODE + 1) << shift;
+ uint32_t start_j = CURCODE << shift;
+ uint32_t end_j = (CURCODE + 1) << shift;
byte eflags = 0;
if (end_j > max_j) {
--
2.13.0

122
gnu/packages/patches/jbig2dec-CVE-2017-7976.patch Normal file
View file

@ -0,0 +1,122 @@
Fix CVE-2017-7976:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-7976
https://bugs.ghostscript.com/show_bug.cgi?id=697683
In order to make the bug-fix patch apply, we also include an earlier commit
that it depends on.
Patches copied from upstream source repository:
Earlier commit, creating context for the CVE fix:
https://git.ghostscript.com/?p=jbig2dec.git;a=commit;h=9d2c4f3bdb0bd003deae788e7187c0f86e624544
CVE-2017-7976 bug fix:
https://git.ghostscript.com/?p=jbig2dec.git;a=commit;h=cfa054925de49675ac5445515ebf036fa9379ac6
From 9d2c4f3bdb0bd003deae788e7187c0f86e624544 Mon Sep 17 00:00:00 2001
From: Tor Andersson <tor.andersson@artifex.com>
Date: Wed, 14 Dec 2016 15:56:31 +0100
Subject: [PATCH] Fix warnings: remove unsigned < 0 tests that are always
false.
---
jbig2_image.c | 2 +-
jbig2_mmr.c | 2 +-
jbig2_symbol_dict.c | 9 ++-------
3 files changed, 4 insertions(+), 9 deletions(-)
diff --git a/jbig2_image.c b/jbig2_image.c
index 94e5a4c..00f966b 100644
--- a/jbig2_image.c
+++ b/jbig2_image.c
@@ -256,7 +256,7 @@ jbig2_image_compose(Jbig2Ctx *ctx, Jbig2Image *dst, Jbig2Image *src, int x, int
/* general OR case */
s = ss;
d = dd = dst->data + y * dst->stride + leftbyte;
- if (d < dst->data || leftbyte > dst->stride || h * dst->stride < 0 || d - leftbyte + h * dst->stride > dst->data + dst->height * dst->stride) {
+ if (d < dst->data || leftbyte > dst->stride || d - leftbyte + h * dst->stride > dst->data + dst->height * dst->stride) {
return jbig2_error(ctx, JBIG2_SEVERITY_FATAL, -1, "preventing heap overflow in jbig2_image_compose");
}
if (leftbyte == rightbyte) {
diff --git a/jbig2_mmr.c b/jbig2_mmr.c
index 390e27c..da54934 100644
--- a/jbig2_mmr.c
+++ b/jbig2_mmr.c
@@ -977,7 +977,7 @@ jbig2_decode_mmr_line(Jbig2MmrCtx *mmr, const byte *ref, byte *dst)
if (b1 < 2)
break;
if (c) {
- if (b1 - 2 < a0 || a0 < 0)
+ if (a0 == MINUS1 || b1 - 2 < a0)
return -1;
jbig2_set_bits(dst, a0, b1 - 2);
}
diff --git a/jbig2_symbol_dict.c b/jbig2_symbol_dict.c
index 11a2252..4acaba9 100644
--- a/jbig2_symbol_dict.c
+++ b/jbig2_symbol_dict.c
@@ -92,11 +92,6 @@ jbig2_sd_new(Jbig2Ctx *ctx, uint32_t n_symbols)
{
Jbig2SymbolDict *new_dict = NULL;
- if (n_symbols < 0) {
- jbig2_error(ctx, JBIG2_SEVERITY_FATAL, -1, "Negative number of symbols in symbol dict: %d", n_symbols);
- return NULL;
- }
-
new_dict = jbig2_new(ctx, Jbig2SymbolDict, 1);
if (new_dict != NULL) {
new_dict->glyphs = jbig2_new(ctx, Jbig2Image *, n_symbols);
@@ -613,7 +608,7 @@ jbig2_decode_symbol_dict(Jbig2Ctx *ctx,
uint32_t j;
int x;
- if (code || (BMSIZE < 0)) {
+ if (code) {
jbig2_error(ctx, JBIG2_SEVERITY_FATAL, segment->number, "error decoding size of collective bitmap!");
goto cleanup4;
}
@@ -716,7 +711,7 @@ jbig2_decode_symbol_dict(Jbig2Ctx *ctx,
code = jbig2_arith_int_decode(IAEX, as, (int32_t *)&exrunlength);
/* prevent infinite loop */
zerolength = exrunlength > 0 ? 0 : zerolength + 1;
- if (code || (exrunlength > limit - i) || (exrunlength < 0) || (zerolength > 4) || (exflag && (exrunlength + j > params->SDNUMEXSYMS))) {
+ if (code || (exrunlength > limit - i) || (zerolength > 4) || (exflag && (exrunlength + j > params->SDNUMEXSYMS))) {
if (code)
jbig2_error(ctx, JBIG2_SEVERITY_FATAL, segment->number, "failed to decode exrunlength for exported symbols");
else if (exrunlength <= 0)
--
2.13.0
From cfa054925de49675ac5445515ebf036fa9379ac6 Mon Sep 17 00:00:00 2001
From: Shailesh Mistry <shailesh.mistry@hotmail.co.uk>
Date: Wed, 10 May 2017 17:50:39 +0100
Subject: [PATCH] Bug 697683: Bounds check before reading from image source
data.
Add extra check to prevent reading off the end of the image source
data buffer.
Thank you to Dai Ge for finding this issue and suggesting a patch.
---
jbig2_image.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/jbig2_image.c b/jbig2_image.c
index 661d0a5..ae161b9 100644
--- a/jbig2_image.c
+++ b/jbig2_image.c
@@ -263,7 +263,8 @@ jbig2_image_compose(Jbig2Ctx *ctx, Jbig2Image *dst, Jbig2Image *src, int x, int
/* general OR case */
s = ss;
d = dd = dst->data + y * dst->stride + leftbyte;
- if (d < dst->data || leftbyte > dst->stride || d - leftbyte + h * dst->stride > dst->data + dst->height * dst->stride) {
+ if (d < dst->data || leftbyte > dst->stride || d - leftbyte + h * dst->stride > dst->data + dst->height * dst->stride ||
+ s - leftbyte + (h - 1) * src->stride + rightbyte > src->data + src->height * src->stride) {
return jbig2_error(ctx, JBIG2_SEVERITY_FATAL, -1, "preventing heap overflow in jbig2_image_compose");
}
if (leftbyte == rightbyte) {
--
2.13.0

60
gnu/packages/patches/networkmanager-qt-activeconnection-test-1.patch
View file

@ -1,60 +0,0 @@
From 61337983ba74361938b7d5323de5d2819a235fdc Mon Sep 17 00:00:00 2001
From: Jan Grulich <jgrulich@redhat.com>
Date: Mon, 3 Apr 2017 12:53:12 +0200
Subject: Fix unit test for active connections
Instead of sending PropertiesChanged signal for an active connection we
added recently we should set all properties initially and just advertise
that we have a new active connection once everything is set
---
src/fakenetwork/fakenetwork.cpp | 26 +++++++-------------------
1 file changed, 7 insertions(+), 19 deletions(-)
diff --git a/src/fakenetwork/fakenetwork.cpp b/src/fakenetwork/fakenetwork.cpp
index bc1144e..261fe8e 100644
--- a/src/fakenetwork/fakenetwork.cpp
+++ b/src/fakenetwork/fakenetwork.cpp
@@ -215,8 +215,14 @@ void FakeNetwork::unregisterService()
QDBusObjectPath FakeNetwork::ActivateConnection(const QDBusObjectPath &connection, const QDBusObjectPath &device, const QDBusObjectPath &specific_object)
{
- ActiveConnection *newActiveConnection = new ActiveConnection(this);
QString newActiveConnectionPath = QString("/org/kde/fakenetwork/ActiveConnection/") + QString::number(m_activeConnectionsCounter++);
+ ActiveConnection *newActiveConnection = new ActiveConnection(this);
+ newActiveConnection->addDevice(device);
+ newActiveConnection->setActiveConnectionPath(newActiveConnectionPath);
+ newActiveConnection->setConnection(connection);
+ newActiveConnection->setSpecificObject(specific_object);
+ newActiveConnection->setState(NetworkManager::ActiveConnection::Activating);
+
m_activeConnections.insert(QDBusObjectPath(newActiveConnectionPath), newActiveConnection);
QDBusConnection::sessionBus().registerObject(newActiveConnectionPath, newActiveConnection, QDBusConnection::ExportScriptableContents);
@@ -227,24 +233,6 @@ QDBusObjectPath FakeNetwork::ActivateConnection(const QDBusObjectPath &connectio
map.insert(QLatin1Literal("ActivatingConnection"), QVariant::fromValue(QDBusObjectPath(newActiveConnectionPath)));
Q_EMIT PropertiesChanged(map);
- newActiveConnection->addDevice(device);
- newActiveConnection->setActiveConnectionPath(newActiveConnectionPath);
- newActiveConnection->setConnection(connection);
- newActiveConnection->setSpecificObject(specific_object);
- newActiveConnection->setState(NetworkManager::ActiveConnection::Activating);
-
- map.clear();
- const QList<QDBusObjectPath> deviceList { device };
- map.insert(QLatin1Literal("Devices"), QVariant::fromValue<QList<QDBusObjectPath> >(deviceList));
- map.insert(QLatin1Literal("Connection"), QVariant::fromValue<QDBusObjectPath>(connection));
- if (!specific_object.path().isEmpty()) {
- map.insert(QLatin1Literal("SpecificObject"), QVariant::fromValue<QDBusObjectPath>(connection));
- }
- map.insert(QLatin1Literal("State"), NetworkManager::ActiveConnection::Activating);
- QDBusMessage message = QDBusMessage::createSignal(newActiveConnectionPath, QLatin1Literal("org.kde.fakenetwork.Connection.Active"), QLatin1Literal("PropertiesChanged"));
- message << map;
- QDBusConnection::sessionBus().send(message);
-
Device *usedDevice = static_cast<Device *>(QDBusConnection::sessionBus().objectRegisteredAt(device.path()));
if (usedDevice) {
m_activatedDevice = usedDevice->devicePath();
--
cgit v0.11.2

57
gnu/packages/patches/networkmanager-qt-activeconnection-test-2.patch
View file

@ -1,57 +0,0 @@
From 3f6155389abc8e2b3dafc5eefa1ce0c929b007fa Mon Sep 17 00:00:00 2001
From: Jan Grulich <jgrulich@redhat.com>
Date: Mon, 3 Apr 2017 14:13:54 +0200
Subject: One more attempt to fix unit test for active connections
---
src/activeconnection.cpp | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/src/activeconnection.cpp b/src/activeconnection.cpp
index 05582fa..3a8e6b2 100644
--- a/src/activeconnection.cpp
+++ b/src/activeconnection.cpp
@@ -79,11 +79,13 @@ NetworkManager::ActiveConnection::ActiveConnection(const QString &path, QObject
connect(&d->iface, &OrgFreedesktopNetworkManagerConnectionActiveInterface::PropertiesChanged, d, &ActiveConnectionPrivate::propertiesChanged);
#endif
+#ifndef NMQT_STATIC
/*
* Workaround: Re-check connection state before we watch changes in case it gets changed too quickly
* BUG:352326
*/
d->recheckProperties();
+#endif
}
NetworkManager::ActiveConnection::ActiveConnection(ActiveConnectionPrivate &dd, QObject *parent)
@@ -91,18 +93,26 @@ NetworkManager::ActiveConnection::ActiveConnection(ActiveConnectionPrivate &dd,
{
Q_D(ActiveConnection);
+#ifndef NMQT_STATIC
#if NM_CHECK_VERSION(1, 4, 0)
QDBusConnection::systemBus().connect(NetworkManagerPrivate::DBUS_SERVICE, d->path, NetworkManagerPrivate::FDO_DBUS_PROPERTIES,
QLatin1String("PropertiesChanged"), d, SLOT(dbusPropertiesChanged(QString,QVariantMap,QStringList)));
#else
connect(&d->iface, &OrgFreedesktopNetworkManagerConnectionActiveInterface::PropertiesChanged, d, &ActiveConnectionPrivate::propertiesChanged);
#endif
+#endif
+
+#ifdef NMQT_STATIC
+ connect(&d->iface, &OrgFreedesktopNetworkManagerConnectionActiveInterface::PropertiesChanged, d, &ActiveConnectionPrivate::propertiesChanged);
+#endif
+#ifndef NMQT_STATIC
/*
* Workaround: Re-check connection state before we watch changes in case it gets changed too quickly
* BUG:352326
*/
d->recheckProperties();
+#endif
}
NetworkManager::ActiveConnection::~ActiveConnection()
--
cgit v0.11.2

182
gnu/packages/patches/qemu-CVE-2017-7493.patch Normal file
View file

@ -0,0 +1,182 @@
Fix CVE-2017-7493:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-7493
Patch copied from upstream source repository:
http://git.qemu.org/?p=qemu.git;a=commit;h=7a95434e0ca8a037fd8aa1a2e2461f92585eb77b
From 7a95434e0ca8a037fd8aa1a2e2461f92585eb77b Mon Sep 17 00:00:00 2001
From: Greg Kurz <groug@kaod.org>
Date: Fri, 5 May 2017 14:48:08 +0200
Subject: [PATCH] 9pfs: local: forbid client access to metadata (CVE-2017-7493)
When using the mapped-file security mode, we shouldn't let the client mess
with the metadata. The current code already tries to hide the metadata dir
from the client by skipping it in local_readdir(). But the client can still
access or modify it through several other operations. This can be used to
escalate privileges in the guest.
Affected backend operations are:
- local_mknod()
- local_mkdir()
- local_open2()
- local_symlink()
- local_link()
- local_unlinkat()
- local_renameat()
- local_rename()
- local_name_to_path()
Other operations are safe because they are only passed a fid path, which
is computed internally in local_name_to_path().
This patch converts all the functions listed above to fail and return
EINVAL when being passed the name of the metadata dir. This may look
like a poor choice for errno, but there's no such thing as an illegal
path name on Linux and I could not think of anything better.
This fixes CVE-2017-7493.
Reported-by: Leo Gaspard <leo@gaspard.io>
Signed-off-by: Greg Kurz <groug@kaod.org>
Reviewed-by: Eric Blake <eblake@redhat.com>
---
hw/9pfs/9p-local.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 56 insertions(+), 2 deletions(-)
diff --git a/hw/9pfs/9p-local.c b/hw/9pfs/9p-local.c
index f3ebca4f7a..a2486566af 100644
--- a/hw/9pfs/9p-local.c
+++ b/hw/9pfs/9p-local.c
@@ -452,6 +452,11 @@ static off_t local_telldir(FsContext *ctx, V9fsFidOpenState *fs)
return telldir(fs->dir.stream);
}
+static bool local_is_mapped_file_metadata(FsContext *fs_ctx, const char *name)
+{
+ return !strcmp(name, VIRTFS_META_DIR);
+}
+
static struct dirent *local_readdir(FsContext *ctx, V9fsFidOpenState *fs)
{
struct dirent *entry;
@@ -465,8 +470,8 @@ again:
if (ctx->export_flags & V9FS_SM_MAPPED) {
entry->d_type = DT_UNKNOWN;
} else if (ctx->export_flags & V9FS_SM_MAPPED_FILE) {
- if (!strcmp(entry->d_name, VIRTFS_META_DIR)) {
- /* skp the meta data directory */
+ if (local_is_mapped_file_metadata(ctx, entry->d_name)) {
+ /* skip the meta data directory */
goto again;
}
entry->d_type = DT_UNKNOWN;
@@ -559,6 +564,12 @@ static int local_mknod(FsContext *fs_ctx, V9fsPath *dir_path,
int err = -1;
int dirfd;
+ if (fs_ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(fs_ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
dirfd = local_opendir_nofollow(fs_ctx, dir_path->data);
if (dirfd == -1) {
return -1;
@@ -605,6 +616,12 @@ static int local_mkdir(FsContext *fs_ctx, V9fsPath *dir_path,
int err = -1;
int dirfd;
+ if (fs_ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(fs_ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
dirfd = local_opendir_nofollow(fs_ctx, dir_path->data);
if (dirfd == -1) {
return -1;
@@ -694,6 +711,12 @@ static int local_open2(FsContext *fs_ctx, V9fsPath *dir_path, const char *name,
int err = -1;
int dirfd;
+ if (fs_ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(fs_ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
/*
* Mark all the open to not follow symlinks
*/
@@ -752,6 +775,12 @@ static int local_symlink(FsContext *fs_ctx, const char *oldpath,
int err = -1;
int dirfd;
+ if (fs_ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(fs_ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
dirfd = local_opendir_nofollow(fs_ctx, dir_path->data);
if (dirfd == -1) {
return -1;
@@ -826,6 +855,12 @@ static int local_link(FsContext *ctx, V9fsPath *oldpath,
int ret = -1;
int odirfd, ndirfd;
+ if (ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
odirfd = local_opendir_nofollow(ctx, odirpath);
if (odirfd == -1) {
goto out;
@@ -1096,6 +1131,12 @@ static int local_lremovexattr(FsContext *ctx, V9fsPath *fs_path,
static int local_name_to_path(FsContext *ctx, V9fsPath *dir_path,
const char *name, V9fsPath *target)
{
+ if (ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
if (dir_path) {
v9fs_path_sprintf(target, "%s/%s", dir_path->data, name);
} else if (strcmp(name, "/")) {
@@ -1116,6 +1157,13 @@ static int local_renameat(FsContext *ctx, V9fsPath *olddir,
int ret;
int odirfd, ndirfd;
+ if (ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ (local_is_mapped_file_metadata(ctx, old_name) ||
+ local_is_mapped_file_metadata(ctx, new_name))) {
+ errno = EINVAL;
+ return -1;
+ }
+
odirfd = local_opendir_nofollow(ctx, olddir->data);
if (odirfd == -1) {
return -1;
@@ -1206,6 +1254,12 @@ static int local_unlinkat(FsContext *ctx, V9fsPath *dir,
int ret;
int dirfd;
+ if (ctx->export_flags & V9FS_SM_MAPPED_FILE &&
+ local_is_mapped_file_metadata(ctx, name)) {
+ errno = EINVAL;
+ return -1;
+ }
+
dirfd = local_opendir_nofollow(ctx, dir->data);
if (dirfd == -1) {
return -1;
--
2.13.0

64
gnu/packages/patches/qtscript-disable-tests.patch Normal file
View file

@ -0,0 +1,64 @@
In all of these tests the result wraps around and comes out the negative of the exptected value.
---
tests/auto/qscriptjstestsuite/tests/ecma/Expressions/11.4.7-02.js | 2 +-
tests/auto/qscriptjstestsuite/tests/ecma/TypeConversion/9.3.1-3.js | 5 ++++-
2 files changed, 5 insertions(+), 2 deletions(-)
diff --git a/tests/auto/qscriptjstestsuite/tests/ecma/Expressions/11.4.7-02.js b/tests/auto/qscriptjstestsuite/tests/ecma/Expressions/11.4.7-02.js
index 43bd923..103f251 100644
--- a/tests/auto/qscriptjstestsuite/tests/ecma/Expressions/11.4.7-02.js
+++ b/tests/auto/qscriptjstestsuite/tests/ecma/Expressions/11.4.7-02.js
@@ -74,7 +74,7 @@ test_negation(-1073741823, 1073741823);
//2147483648 == (1 << 31)
test_negation(2147483648, -2147483648);
-test_negation(-2147483648, 2147483648);
+//test_negation(-2147483648, 2147483648);
//2147483648 == (1 << 31) - 1
test_negation(2147483647, -2147483647);
diff --git a/tests/auto/qscriptjstestsuite/tests/ecma/TypeConversion/9.3.1-3.js b/tests/auto/qscriptjstestsuite/tests/ecma/TypeConversion/9.3.1-3.js
index dc56427..c1a4bf3 100644
--- a/tests/auto/qscriptjstestsuite/tests/ecma/TypeConversion/9.3.1-3.js
+++ b/tests/auto/qscriptjstestsuite/tests/ecma/TypeConversion/9.3.1-3.js
@@ -86,11 +86,12 @@ new TestCase(
// test cases from bug http://scopus.mcom.com/bugsplat/show_bug.cgi?id=122882
-
+/*
new TestCase( SECTION,
'- -"0x80000000"',
2147483648,
- -"0x80000000" );
+*/
new TestCase( SECTION,
'- -"0x100000000"',
@@ -280,10 +281,12 @@ new TestCase( SECTION,
305419896,
0x12345678 );
+/*
new TestCase( SECTION,
"0x80000000",
2147483648,
0x80000000 );
+*/
new TestCase( SECTION,
"0xffffffff",
@@ -681,10 +681,12 @@ new TestCase( SECTION,
NaN,
-"+Infiniti" );
+/*
new TestCase( SECTION,
"- -\"0x80000000\"",
2147483648,
- -"0x80000000" );
+*/
new TestCase( SECTION,
"- -\"0x100000000\"",

26
gnu/packages/patches/ruby-concurrent-test-arm.patch
View file

@ -5,27 +5,27 @@ Work around two test suite failures on ARM:
The regexps here assume addresses like "0x1234" but on ARM (32-bit)
we get something like "0x-7db1e810" (notice the dash).
diff --git a/spec/concurrent/edge/future_spec.rb b/spec/concurrent/edge/future_spec.rb
index a48fd29..4344d7e 100644
--- b/spec/concurrent/edge/future_spec.rb
+++ a/spec/concurrent/edge/future_spec.rb
@@ -322,9 +322,9 @@
diff --git a/spec/concurrent/edge/promises_spec.rb b/spec/concurrent/edge/promises_spec.rb
index 727210f..149f7cd 100644
--- a/spec/concurrent/edge/promises_spec.rb
+++ b/spec/concurrent/edge/promises_spec.rb
@@ -371,9 +371,9 @@ describe 'Concurrent::Promises' do
four = three.delay.then(&:succ)
# meaningful to_s and inspect defined for Future and Promise
- expect(head.to_s).to match /<#Concurrent::Edge::Future:0x[\da-f]+ pending>/
+ expect(head.to_s).to match /<#Concurrent::Edge::Future:0x-?[\da-f]+ pending>/
- expect(head.to_s).to match /<#Concurrent::Promises::Future:0x[\da-f]+ pending>/
+ expect(head.to_s).to match /<#Concurrent::Promises::Future:0x-?[\da-f]+ pending>/
expect(head.inspect).to(
- match(/<#Concurrent::Edge::Future:0x[\da-f]+ pending blocks:\[<#Concurrent::Edge::ThenPromise:0x[\da-f]+ pending>\]>/))
+ match(/<#Concurrent::Edge::Future:0x-?[\da-f]+ pending blocks:\[<#Concurrent::Edge::ThenPromise:0x-?[\da-f]+ pending>\]>/))
- match(/<#Concurrent::Promises::Future:0x[\da-f]+ pending>/))
+ match(/<#Concurrent::Promises::Future:0x-?[\da-f]+ pending>/))
# evaluates only up to three, four is left unevaluated
expect(three.value!).to eq 3
diff --git a/spec/concurrent/map_spec.rb b/spec/concurrent/map_spec.rb
index 13fd5b7..1c82ebe 100644
--- b/spec/concurrent/map_spec.rb
+++ a/spec/concurrent/map_spec.rb
@@ -827,7 +827,7 @@
index c4050be..0a9095d 100644
--- a/spec/concurrent/map_spec.rb
+++ b/spec/concurrent/map_spec.rb
@@ -794,7 +794,7 @@ module Concurrent
end
it '#inspect' do

31
gnu/packages/patches/shadow-4.4-su-snprintf-fix.patch
View file

@ -1,31 +0,0 @@
Patch copied from upstream source repository:
https://github.com/shadow-maint/shadow/commit/67d2bb6e0a5ac124ce1f026dd5723217b1493194
From 67d2bb6e0a5ac124ce1f026dd5723217b1493194 Mon Sep 17 00:00:00 2001
From: Serge Hallyn <serge@hallyn.com>
Date: Sun, 18 Sep 2016 21:31:18 -0500
Subject: [PATCH] su.c: fix missing length argument to snprintf
---
src/su.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/su.c b/src/su.c
index 0c50a9456afd..93ffd2fbe2b4 100644
--- a/src/su.c
+++ b/src/su.c
@@ -373,8 +373,8 @@ static void prepare_pam_close_session (void)
stderr);
(void) kill (-pid_child, caught);
- snprintf (kill_msg, _(" ...killed.\n"));
- snprintf (wait_msg, _(" ...waiting for child to terminate.\n"));
+ snprintf (kill_msg, 256, _(" ...killed.\n"));
+ snprintf (wait_msg, 256, _(" ...waiting for child to terminate.\n"));
(void) signal (SIGALRM, kill_child);
(void) alarm (2);
--
2.11.0.rc2

72
gnu/packages/patches/shadow-CVE-2017-2616.patch
View file

@ -1,72 +0,0 @@
Fix CVE-2017-2616:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-2616
http://seclists.org/oss-sec/2017/q1/490
http://seclists.org/oss-sec/2017/q1/474
Patch copied from upstream source repository:
https://github.com/shadow-maint/shadow/commit/08fd4b69e84364677a10e519ccb25b71710ee686
From 08fd4b69e84364677a10e519ccb25b71710ee686 Mon Sep 17 00:00:00 2001
From: Tobias Stoeckmann <tobias@stoeckmann.org>
Date: Thu, 23 Feb 2017 09:47:29 -0600
Subject: [PATCH] su: properly clear child PID
If su is compiled with PAM support, it is possible for any local user
to send SIGKILL to other processes with root privileges. There are
only two conditions. First, the user must be able to perform su with
a successful login. This does NOT have to be the root user, even using
su with the same id is enough, e.g. "su $(whoami)". Second, SIGKILL
can only be sent to processes which were executed after the su process.
It is not possible to send SIGKILL to processes which were already
running. I consider this as a security vulnerability, because I was
able to write a proof of concept which unlocked a screen saver of
another user this way.
---
src/su.c | 19 +++++++++++++++++--
1 file changed, 17 insertions(+), 2 deletions(-)
diff --git a/src/su.c b/src/su.c
index f20d230..d86aa86 100644
--- a/src/su.c
+++ b/src/su.c
@@ -379,11 +379,13 @@ static void prepare_pam_close_session (void)
/* wake child when resumed */
kill (pid, SIGCONT);
stop = false;
+ } else {
+ pid_child = 0;
}
} while (!stop);
}
- if (0 != caught) {
+ if (0 != caught && 0 != pid_child) {
(void) fputs ("\n", stderr);
(void) fputs (_("Session terminated, terminating shell..."),
stderr);
@@ -393,9 +395,22 @@ static void prepare_pam_close_session (void)
snprintf (wait_msg, sizeof wait_msg, _(" ...waiting for child to terminate.\n"));
(void) signal (SIGALRM, kill_child);
+ (void) signal (SIGCHLD, catch_signals);
(void) alarm (2);
- (void) wait (&status);
+ sigemptyset (&ourset);
+ if ((sigaddset (&ourset, SIGALRM) != 0)
+ || (sigprocmask (SIG_BLOCK, &ourset, NULL) != 0)) {
+ fprintf (stderr, _("%s: signal masking malfunction\n"), Prog);
+ kill_child (0);
+ } else {
+ while (0 == waitpid (pid_child, &status, WNOHANG)) {
+ sigsuspend (&ourset);
+ }
+ pid_child = 0;
+ (void) sigprocmask (SIG_UNBLOCK, &ourset, NULL);
+ }
+
(void) fputs (_(" ...terminated.\n"), stderr);
}

10
gnu/packages/php.scm
View file

@ -53,7 +53,7 @@
(define-public php
(package
(name "php")
(version "7.1.4")
(version "7.1.5")
(home-page "https://secure.php.net/")
(source (origin
(method url-fetch)
@ -61,7 +61,7 @@
name "-" version ".tar.xz"))
(sha256
(base32
"02rh1lcfj2hakyls73gwn6w00yblnfh4883w13gn7sgkmn346lbi"))
"1b7njiqgy66ga5c8wsm78mqqjr7lj3hlpwbbvksi2mn4jv1s6jfi"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "ext"
@ -169,12 +169,6 @@
"ext/standard/tests/general_functions/proc_open.phpt")
(("/bin/cat") (which "cat")))
;; These tests fail because they include a file whose modification
;; time is 0. Touch them to make the test pass. The issue is reported
;; upstream as #74137.
(utime "sapi/phpdbg/tests/include.inc" 1 1)
(utime "sapi/phpdbg/tests/phpdbg_get_executable_stream_wrapper.inc" 1 1)
;; The encoding of this file is not recognized, so we simply drop it.
(delete-file "ext/mbstring/tests/mb_send_mail07.phpt")

4
gnu/packages/python.scm
View file

@ -10717,14 +10717,14 @@ development version of CPython that are not available in older releases.")
(define-public python-future
(package
(name "python-future")
(version "0.15.2")
(version "0.16.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "future" version))
(sha256
(base32
"15wvcfzssc68xqnqi1dq4fhd0848hwi9jn42hxyvlqna40zijfrx"))))
"1nzy1k4m9966sikp0qka7lirh8sqrsyainyf8rk97db7nwdfv773"))))
(build-system python-build-system)
;; Many tests connect to the network or are otherwise flawed.
;; https://github.com/PythonCharmers/python-future/issues/210

1
gnu/packages/qemu.scm
View file

@ -74,6 +74,7 @@
(method url-fetch)
(uri (string-append "http://wiki.qemu-project.org/download/qemu-"
version ".tar.xz"))
(patches (search-patches "qemu-CVE-2017-7493.patch"))
(sha256
(base32
"08mhfs0ndbkyqgw7fjaa9vjxf4dinrly656f6hjzvmaz7hzc677h"))))

162
gnu/packages/qt.scm
View file

@ -47,7 +47,7 @@
#:use-module (gnu packages icu4c)
#:use-module (gnu packages image)
#:use-module (gnu packages linux)
#:use-module (gnu packages databases)
#:use-module (gnu packages maths)
#:use-module (gnu packages pciutils)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
@ -349,7 +349,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtbase
(package
(name "qtbase")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -358,7 +358,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0zjmcrmnnmaz1lr9wc5i6y565hsvl8ycn790ivqaz62dv54zbkgd"))
"01f07yjly7y24njl2h4hyknmi7pf8yd9gky23szcfkd40ap12wf1"))
(modules '((guix build utils)))
(snippet
'(begin
@ -375,6 +375,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
`(("alsa-lib" ,alsa-lib)
("cups" ,cups)
("dbus" ,dbus)
("double-conversion" ,double-conversion)
("eudev" ,eudev)
("expat" ,expat)
("fontconfig" ,fontconfig)
@ -467,19 +468,15 @@ developers using C++ or QML, a CSS & JavaScript like language.")
"-openssl-linked"
;; explicitly link with dbus instead of dlopening it
"-dbus-linked"
;; drop special machine instructions not supported
;; on all instances of the target
;; don't use the precompiled headers
"-no-pch"
;; drop special machine instructions that do not have
;; runtime detection
,@(if (string-prefix? "x86_64"
(or (%current-target-system)
(%current-system)))
'()
'("-no-sse2"))
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-avx2"
"-no-mips_dsp"
"-no-mips_dspr2")))))
(add-after 'install 'patch-qt_config.prf
@ -532,7 +529,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtsvg
(package (inherit qtbase)
(name "qtsvg")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -541,7 +538,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0irr9h566hl9nx8p919rz276zbfvvd6vqdb6i9g6b3piikdigw5h"))))
"12fwzbp28szqw1sk3flb8i6xnxgl94siwyy41ffdmd0s44f1jwwq"))))
(propagated-inputs `())
(native-inputs `(("perl" ,perl)))
(inputs
@ -575,7 +572,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtimageformats
(package (inherit qtsvg)
(name "qtimageformats")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -584,11 +581,10 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1x3p1xmw7spxa4bwriyrwsfrq31jabsdjsi5fras9y39naia55sg"))
"0vv0wh5q5sih294x661djzwvgdwy7r6xpnxsc111k5hwq7m5w13m"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "src/3rdparty")))))
'(delete-file-recursively "src/3rdparty"))))
(native-inputs `())
(inputs
`(("jasper" ,jasper)
@ -602,7 +598,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtx11extras
(package (inherit qtsvg)
(name "qtx11extras")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -611,7 +607,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"09z49jm70f5i0gcdz9a16z00pg96x8pz7vri5wpirh3fqqn0qnjz"))))
"03i8lk9qcdf8h2k4f3rkqqkzbrlnyaspv9mgjkn4k61s2asz5mxy"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -623,7 +619,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtxmlpatterns
(package (inherit qtsvg)
(name "qtxmlpatterns")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -632,7 +628,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1rgqnpg64gn5agmvjwy0am8hp5fpxl3cdkixr1yrsdxi5a6961d8"))))
"016s75j2cml7kc8scdm9a6pmxm8jhs424lml2h9znm1flmgadzvv"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:phases phases)
@ -640,7 +636,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(add-after 'unpack 'disable-network-tests
(lambda _ (substitute* "tests/auto/auto.pro"
(("qxmlquery") "# qxmlquery")
(("xmlpatterns") "# xmlpatterns"))
(("xmlpatterns ") "# xmlpatterns"))
#t))))))
(native-inputs `(("perl" ,perl)))
(inputs `(("qtbase" ,qtbase)))))
@ -648,7 +644,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtdeclarative
(package (inherit qtsvg)
(name "qtdeclarative")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -657,7 +653,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0mjxfwnplpx60jc6y94krg00isddl9bfwc7dayl981njb4qds4zx"))))
"0ilaf2sprpk9fg2j3905hxnhm0xbnm88ppk4zifp7n0jmnwix51j"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -674,7 +670,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtconnectivity
(package (inherit qtsvg)
(name "qtconnectivity")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -683,7 +679,18 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0rmr7bd4skby7bax9hpj2sid2bq3098nkw7xm02mdp04hc3bks5k"))))
"1w97na5s420y08dcydqinbqb0rd9h4pfdnjbwslr0qvzsvlh2bbv"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'disable-failing-tests
;; this test fails on armhf and aarch64
(lambda _
(substitute* "tests/auto/qndefnfcsmartposterrecord/tst_qndefnfcsmartposterrecord.cpp"
(("QCOMPARE\\(record.action\\(\\), QNdefNfcSmartPosterRecord::UnspecifiedAction")
"//QCOMPARE(record.action(), QNdefNfcSmartPosterRecord::UnspecifiedAction"))
#t))))))
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)
@ -695,7 +702,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtwebsockets
(package (inherit qtsvg)
(name "qtwebsockets")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -704,7 +711,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1laj0slwibs0bg69kgrdhc9k1s6yisq3pcsr0r9rhbkzisv7aajw"))))
"1xa5p36grqxz3fa08amn7r3dy6k28g6y0gkc6jgj7lyhjzr0l4da"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -716,7 +723,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtsensors
(package (inherit qtsvg)
(name "qtsensors")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -725,7 +732,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"041v1x8pwfzpyk6y0sy5zgm915pi15xdhiy18fd5wqayvcp99cyc"))))
"15p7bp21yj4cdl5yfc9qnn4lhhiwiwx3b71lrb431kgqxhwhcp9s"))))
(native-inputs
`(("perl" ,perl)
("qtdeclarative" ,qtdeclarative)))
@ -734,7 +741,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtmultimedia
(package (inherit qtsvg)
(name "qtmultimedia")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -743,7 +750,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1vvxmgmvjnz9w1h2ph1j2fy77ij141ycx5fric60lq02pxzifax5"))
"01sakngvsqr90qhrxyghfqdpddpxwbjyzzhm34k0hlpr6i409g58"))
(modules '((guix build utils)))
(snippet
'(begin
@ -769,7 +776,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtwayland
(package (inherit qtsvg)
(name "qtwayland")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -778,7 +785,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1iq1c89y4ggq0dxjlf62jyhh8a9l3x7y914x84w5pby8h3hwagzj"))))
"06ilh55vaxbkyv7irw0n11gxgc34ypx2qhqawxzy7kllzg9zcl7z"))))
(native-inputs
`(("glib" ,glib)
("perl" ,perl)
@ -800,7 +807,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtserialport
(package (inherit qtsvg)
(name "qtserialport")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -809,7 +816,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"09jsryc0z49cz9783kq48rkn42f10c6krzivp812ddwjsfdy3mbn"))))
"1b86al3zn1pxyk0n59vh8bqxrpz2m0j33ygclaqbxl1sszg7ycaj"))))
(native-inputs `(("perl" ,perl)))
(inputs
`(("qtbase" ,qtbase)
@ -818,7 +825,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtserialbus
(package (inherit qtsvg)
(name "qtserialbus")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -827,7 +834,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0mxi43l2inpbar8rmg21qjg33bv3f1ycxjgvzjf12ncnybhdnzkj"))))
"02n1b1wrvfg6c7z15c5c5gv9r5gd4pp58jrd1a8d8fg3ybcksd2q"))))
(inputs
`(("qtbase" ,qtbase)
("qtserialport" ,qtserialport)))))
@ -835,7 +842,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtwebchannel
(package (inherit qtsvg)
(name "qtwebchannel")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -844,7 +851,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"16rij92dxy4k5231l3dpmhy7cnz0cjkn50cpzaf014zrdz3kmav3"))))
"0jhbgp9rdp5lpwjrykxmg4lb60wk7gm3dldz5kp3b8ms2dab3xav"))))
(native-inputs
`(("perl" ,perl)
("qtdeclarative" ,qtdeclarative)
@ -854,7 +861,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtlocation
(package (inherit qtsvg)
(name "qtlocation")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -863,7 +870,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"17zkzffzwbg6aqhsggs23cmwzq4y45m938842lsc423hfm7fdsgr"))))
"1fqssa8rhq83lnxjcdh4ijqck3lmqglpk8yax8x17w49v6gf78a8"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -877,7 +884,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qttools
(package (inherit qtsvg)
(name "qttools")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -886,7 +893,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1b6zqa5690b8lqms7rrhb8rcq0xg5hp117v3m08qngbcd0i706b4"))))
"10wx4vydj91yag30457c7azx4ihrwky42l7zzwkbmdlksdv8xv4m"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -900,7 +907,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtscript
(package (inherit qtsvg)
(name "qtscript")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -909,7 +916,8 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"09m41n95448pszr7inlg03ycb66s1a9hzfylaka92382acf1myav"))))
"1lssbsjf2p2ag02fjq6k6vk7vywhj4jsl286r2fqi78q5lfvjfi9"))
(patches (search-patches "qtscript-disable-tests.patch"))))
(native-inputs
`(("perl" ,perl)
("qttools" ,qttools)))
@ -919,7 +927,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtquickcontrols
(package (inherit qtsvg)
(name "qtquickcontrols")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -928,7 +936,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"17cyfyqzjbm9dhq9pjscz36y84y16rmxwk6h826gjfprddrimsvg"))))
"09mkswxw7wa2l8xz9fbblxr1pbi86hggis55j4k8ifnrrw60vrq4"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -939,7 +947,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtquickcontrols2
(package (inherit qtsvg)
(name "qtquickcontrols2")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -948,7 +956,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1v77ydy4k15lksp3bi2kgha2h7m79g4n7c2qhbr09xnvpb8ars7j"))))
"06yy98x4vic2yrlpp83gf4kvl7kd93q62k178w0cy4sgqxp8d6dh"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -959,7 +967,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtgraphicaleffects
(package (inherit qtsvg)
(name "qtgraphicaleffects")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -968,7 +976,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1j2drnx7zp3w6cgvy7bn00fyk5v7vw1j1hidaqcg78lzb6zgls1c"))))
"06frknb7m8bgg55rs7jjm61iziisy2ykzrrc5dy3vj0aad89najz"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -977,6 +985,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
("qtdeclarative" ,qtdeclarative)))))
(define-public qtdeclarative-render2d
;; As of Qt-5.8.0 this module has been merged into qtdeclarative
(package (inherit qtsvg)
(name "qtdeclarative-render2d")
(version "5.7.1")
@ -995,12 +1004,13 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(native-inputs `())
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
("qtdeclarative" ,qtdeclarative)))
(properties `((superseded . ,qtdeclarative)))))
(define-public qtgamepad
(package (inherit qtsvg)
(name "qtgamepad")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1009,7 +1019,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"10lijbsg9xx5ddbbjymdgl41nxz99yn1qgiww2kkggxwwdjj2axv"))))
"0dwcrq60h802z694h4108figlr3yvp8fpzhwjzbjm503v8yaxw5j"))))
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)))
@ -1024,7 +1034,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtscxml
(package (inherit qtsvg)
(name "qtscxml")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1033,7 +1043,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"135kknqdmib2cjryfmvfgv7a2qx9pyba3m7i7nkbc5d742r4mbcx"))
"1i4xl24q4i32mbhyndrwaz0xj79d9n84s320gmkf5rwnfcwrvfxn"))
(modules '((guix build utils)))
(snippet
'(begin
@ -1048,7 +1058,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtpurchasing
(package (inherit qtsvg)
(name "qtpurchasing")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1057,7 +1067,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0hkvrgafz1hx9q4yc3nskv3pd3fszghvvd5a7mj33ynf55wpb57n"))))
"0mdkw73yx1csz9mf3wl0w1x1b8cv9j5px4nvakrknkjzaa9qgzdk"))))
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
@ -1065,7 +1075,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtcanvas3d
(package (inherit qtsvg)
(name "qtcanvas3d")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1074,7 +1084,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1d5xpq3mhjg4ipxzap7s2vnlfcd02d3yq720npv10xxp2ww0i1x8"))
"18yaikbwk4d7sh09psi3kjn1mxjp4d2f3qchfzgq5x96yn8gfijl"))
(modules '((guix build utils)))
(snippet
'(delete-file-recursively "examples/canvas3d/3rdparty"))))
@ -1099,7 +1109,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtcharts
(package (inherit qtsvg)
(name "qtcharts")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1108,7 +1118,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1qrzcddwff2hxsbxrraff16j4abah2zkra2756s1mvydj9lyxzl5"))))
"11m5g1fxip6z2xk1z6g6h4rq7v282qbkxflan8hs87hadnzars03"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -1119,7 +1129,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public qtdatavis3d
(package (inherit qtsvg)
(name "qtdatavis3d")
(version "5.7.1")
(version "5.8.0")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
@ -1128,7 +1138,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1y00p0wyj5cw9c2925y537vpmmg9q3kpf7qr1s7sv67dvvf8bzqv"))))
"1n2vdf6n7pr9xrjwbvbar899q74shx6cy19x32adxfn2iilygwbp"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
@ -1139,7 +1149,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(define-public python-sip
(package
(name "python-sip")
(version "4.18.1")
(version "4.19.2")
(source
(origin
(method url-fetch)
@ -1148,7 +1158,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
"sip-" version "/sip-" version ".tar.gz"))
(sha256
(base32
"1452zy3g0qv4fpd9c0y4gq437kn0xf7bbfniibv5n43zpwnpmklv"))))
"0cq5r21fmjyw5v7a6l4sfbaj3zgm7k5b2cryj6bnjki54nnllas3"))))
(build-system gnu-build-system)
(native-inputs
`(("python" ,python-wrapper)))
@ -1202,7 +1212,7 @@ module provides support functions to the automatically generated code.")
(define-public python-pyqt
(package
(name "python-pyqt")
(version "5.7")
(version "5.8.2")
(source
(origin
(method url-fetch)
@ -1212,7 +1222,7 @@ module provides support functions to the automatically generated code.")
version ".tar.gz"))
(sha256
(base32
"01avscn1bir0h8zzfh1jvpljgwg6qkax5nk142xrm63rbyx969l9"))
"1s1nalcspam9dc7f63jkqn1i2sv9lrqn57p2zsc61g8bncahbmzb"))
(patches (search-patches "pyqt-configure.patch"))))
(build-system gnu-build-system)
(native-inputs
@ -1292,17 +1302,17 @@ contain over 620 classes.")
(define-public python-pyqt-4
(package (inherit python-pyqt)
(name "python-pyqt")
(version "4.11.4")
(version "4.12")
(source
(origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/pyqt/PyQt4/"
"PyQt-" version "/PyQt-x11-gpl-"
"PyQt-" version "/PyQt4_gpl_x11-"
version ".tar.gz"))
(sha256
(base32
"01zlviy5lq8g6db84wnvvpsrfnip9lbcpxagsyqa6as3jmsff7zw"))))
"1nw8r88a5g2d550yvklawlvns8gd5slw53yy688kxnsa65aln79w"))))
(native-inputs
`(("python-sip" ,python-sip)
("qt" ,qt-4)))
@ -1431,19 +1441,19 @@ different kinds of sliders, and much more.")
(define-public qtwebkit
(package
(name "qtwebkit")
(version "5.7.1")
(version "5.8.0")
(source
(origin
(method url-fetch)
(uri (string-append "http://download.qt.io/community_releases/"
(version-major+minor version)
"/" version "/qtwebkit-opensource-src-" version
".tar.xz"))
"/" version "-final/qtwebkit-opensource-src-"
version ".tar.xz"))
;; Note: since Qt 5.6, Qt no longer officially supports qtwebkit:
;; <http://lists.qt-project.org/pipermail/development/2016-May/025923.html>.
(sha256
(base32
"00szgcra6pf2myfjrdbsr1gmrxycpbjqlzkplna5yr1rjg4gfv54"))))
"1v0vj6slyh19mjrrpbqdzb47fr0f4xk7bc8803xjzybb11h8dbkr"))))
(build-system gnu-build-system)
(native-inputs
`(("perl" ,perl)

12
gnu/packages/ruby.scm
View file

@ -446,13 +446,13 @@ expectations and mocks frameworks.")
(define-public bundler
(package
(name "bundler")
(version "1.14.5")
(version "1.14.6")
(source (origin
(method url-fetch)
(uri (rubygems-uri "bundler" version))
(sha256
(base32
"0635s6naz9hn4iqbvkhnm1by4j4spvv13mb7nzwwimnpbqgx663i"))))
"0h3x2csvlz99v2ryj1w72vn6kixf7rl35lhdryvh7s49brnj0cgl"))))
(build-system ruby-build-system)
(arguments
'(#:tests? #f)) ; avoid dependency cycles
@ -2910,7 +2910,7 @@ differences (added or removed nodes) between two XML/HTML documents.")
(define-public ruby-rack
(package
(name "ruby-rack")
(version "2.0.1")
(version "2.0.3")
(source
(origin
(method url-fetch)
@ -2922,7 +2922,7 @@ differences (added or removed nodes) between two XML/HTML documents.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"00k62v8lpyjzghkn0h0awrnqj1jmlcs2wp57py27m43y65v89cp3"))
"12bnqrcg43x9hsswjqg31qqwk8cwj2fh0d2m179y20bjghhn54kx"))
;; Ignore test which fails inside the build environment but works
;; outside.
(patches (search-patches "ruby-rack-ignore-failing-test.patch"))))
@ -4106,7 +4106,7 @@ call.")
(define-public ruby-concurrent
(package
(name "ruby-concurrent")
(version "1.0.2")
(version "1.0.5")
(source
(origin
(method url-fetch)
@ -4119,7 +4119,7 @@ call.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1x3g2admp14ykwfxidsicqbhlfsnxh9wyc806np4i15hws4if1d8"))
"0qhv0qzsby4iijgwa4s9r88zj8123pmyz1dwaqzdk57xgqll9pny"))
;; Exclude failing test reported at
;; https://github.com/ruby-concurrency/concurrent-ruby/issues/534
(patches (search-patches "ruby-concurrent-ignore-broken-test.patch"

12
gnu/packages/security-token.scm
View file

@ -35,15 +35,15 @@
(define-public ccid
(package
(name "ccid")
(version "1.4.26")
(version "1.4.27")
(source (origin
(method url-fetch)
(uri (string-append
"https://alioth.debian.org/frs/download.php/file/4205/"
"https://alioth.debian.org/frs/download.php/file/4218/"
"ccid-" version ".tar.bz2"))
(sha256
(base32
"0bxy835c133ajalpj4gx60nqkjvpf9y1n97n04pw105pi9qbyrrj"))))
"0dyikpmhsph36ndgd61bs4yx437v5y0bmm8ahjacp1k9c1ly4q56"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list (string-append "--enable-usbdropdir=" %output
@ -93,15 +93,15 @@ the low-level development kit for the Yubico YubiKey authentication device.")
(define-public pcsc-lite
(package
(name "pcsc-lite")
(version "1.8.20")
(version "1.8.21")
(source (origin
(method url-fetch)
(uri (string-append
"https://alioth.debian.org/frs/download.php/file/4203/"
"https://alioth.debian.org/frs/download.php/file/4216/"
"pcsc-lite-" version ".tar.bz2"))
(sha256
(base32
"1ckb0jf4n585a4j26va3jm2nrv3c1y38974514f8qy3c04a02zgc"))))
"1b8kwl81f6s3y7qh68ahr8sp8a0w6m464v9b3s4zxq2cgpmnaczy"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--enable-usbdropdir=/var/lib/pcsc/drivers")))

37
gnu/packages/shells.scm
View file

@ -32,6 +32,7 @@
#:use-module (gnu packages bison)
#:use-module (gnu packages documentation)
#:use-module (gnu packages groff)
#:use-module (gnu packages libbsd)
#:use-module (gnu packages libedit)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages pcre)
@ -457,3 +458,39 @@ components: a process notation for running programs and setting up pipelines
and redirections, and a complete syscall library for low-level access to the
operating system.")
(license bsd-3))))
(define-public loksh
(package
(name "loksh")
(version "6.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/dimkr/loksh/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1wg7ds56yr8fgg1m149bi53bvrwccwiashmwknggza1sqgj9m2lq"))))
(build-system gnu-build-system)
(inputs
`(("libbsd" ,libbsd)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(arguments
`(#:tests? #f ;No tests included
#:make-flags (list "CC=gcc" "HAVE_LIBBSD=1"
(string-append "DESTDIR="
(assoc-ref %outputs "out"))
"PREFIX=")
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ;No configure script
(home-page "https://github.com/dimkr/loksh")
(synopsis "Korn Shell from OpenBSD")
(description
"loksh is a Linux port of OpenBSD's @command{ksh}. It is a small,
interactive POSIX shell targeted at resource-constrained systems.")
;; The file 'LEGAL' says it is the public domain, and the 2
;; exceptions which are listed are not included in this port.
(license public-domain)))

8
gnu/packages/ssh.scm
View file

@ -68,6 +68,7 @@
(base32
"03bcp9ksqp0s1pmwfmzhcknvkxay5k0mjzzxp3rjlifbng1vxq9r"))))
(build-system cmake-build-system)
(outputs '("out" "debug"))
(arguments
'(#:configure-flags '("-DWITH_GCRYPT=ON")
@ -226,6 +227,8 @@ Additionally, various channel-specific options can be negotiated.")
(sha256
(base32
"0r261i8kc3avbmbwgyzak2vnqwssjlgz37g2y2fwm80w9bmn2m7j"))
(patches (search-patches "guile-ssh-rexec-bug.patch"
"guile-ssh-double-free.patch"))
(modules '((guix build utils)))
(snippet
;; 'configure.ac' mistakenly tries to link files from examples/
@ -236,6 +239,7 @@ Additionally, various channel-specific options can be negotiated.")
"], [chmod +x examples/"
file "])\n"))))))
(build-system gnu-build-system)
(outputs '("out" "debug"))
(arguments
'(#:phases (modify-phases %standard-phases
(add-after 'unpack 'autoreconf
@ -378,7 +382,7 @@ especially over Wi-Fi, cellular, and long-distance links.")
(define-public dropbear
(package
(name "dropbear")
(version "2016.74")
(version "2017.75")
(source (origin
(method url-fetch)
(uri (string-append
@ -386,7 +390,7 @@ especially over Wi-Fi, cellular, and long-distance links.")
name "-" version ".tar.bz2"))
(sha256
(base32
"14c8f4gzixf0j9fkx68jgl85q7b05852kk0vf09gi6h0xmafl817"))))
"1309cm2aw62n9m3h38prvgsqr8bj85hfasgnvwkd42cp3k5ivg3c"))))
(build-system gnu-build-system)
(arguments `(#:tests? #f)) ; There is no "make check" or anything similar
(inputs `(("zlib" ,zlib)))

173
gnu/packages/sssd.scm Normal file
View file

@ -0,0 +1,173 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages sssd)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages)
#:use-module (gnu packages adns)
#:use-module (gnu packages augeas)
#:use-module (gnu packages check)
#:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages databases)
#:use-module (gnu packages dns)
#:use-module (gnu packages docbook)
#:use-module (gnu packages documentation)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages libunistring)
#:use-module (gnu packages linux)
#:use-module (gnu packages kerberos)
#:use-module (gnu packages openldap)
#:use-module (gnu packages tls)
#:use-module (gnu packages pcre)
#:use-module (gnu packages popt)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages samba)
#:use-module (gnu packages selinux)
#:use-module (gnu packages web)
#:use-module (gnu packages xml))
(define-public ding-libs
(package
(name "ding-libs")
(version "0.6.0")
(source (origin
(method url-fetch)
(uri (string-append "https://releases.pagure.org/SSSD/ding-libs/"
"ding-libs-" version ".tar.gz"))
(sha256
(base32
"1bczkvq7cblp75kqn6r2d7j5x7brfw6wxirzc6d2rkyb80gj2jkn"))))
(build-system gnu-build-system)
(home-page "https://pagure.io/SSSD/ding-libs/")
(synopsis "Libraries for SSSD")
(description
"DING-LIBS (DING Is Not Glib) are a set of small, useful libraries that
the @dfn{System Security Services Daemon} (SSSD) uses and makes available to
other projects. They include: libdhash, an implementation of a dynamic hash
table which will dynamically resize to achieve optimal storage and access time
properties; ini_config, a library for parsing and managing @code{INI} files;
path_utils, a library to manage UNIX paths and subsets of paths; collection, a
generic, hierarchical grouping mechanism for complex data sets; ref_array, a
dynamically-growing, reference-counted array; libbasicobjects, a set of
fundamental object types for C.")
(license license:lgpl3+)))
;; Note: This package installs modules for ldb and nss. For the former we
;; need to set LDB_MODULES_PATH. For the latter LD_PRELOAD or LD_LIBRARY_PATH
;; is needed.
(define-public sssd
(package
(name "sssd")
(version "1.15.2")
(source (origin
(method url-fetch)
(uri (string-append "http://releases.pagure.org/SSSD/sssd/"
"sssd-" version ".tar.gz"))
(sha256
(base32
"0r6j28f7vjb1aw65gkw4nz2l3jy605h7wsr1k815hynp2jrzrmac"))))
(build-system gnu-build-system)
(arguments
`(#:make-flags
(list (string-append "DOCBOOK_XSLT="
(assoc-ref %build-inputs "docbook-xsl")
"/xml/xsl/docbook-xsl-"
,(package-version docbook-xsl)
"/manpages/docbook.xsl")
;; Remove "--postvalid" option, because that requires access to
;; online DTDs.
"XMLLINT_FLAGS = --catalogs --nonet --noent --xinclude --noout")
#:configure-flags
(list "--disable-cifs-idmap-plugin"
"--without-nfsv4-idmapd-plugin"
"--without-python2-bindings"
"--without-python3-bindings"
(string-append "--with-plugin-path="
(assoc-ref %outputs "out")
"/lib/sssd")
(string-append "--with-krb5-plugin-path="
(assoc-ref %outputs "out")
"/lib/krb5/plugins/libkrb5")
(string-append "--with-cifs-plugin-path="
(assoc-ref %outputs "out")
"/lib/cifs-utils")
(string-append "--with-init-dir="
(assoc-ref %outputs "out")
"/etc/init.d")
(string-append "--with-ldb-lib-dir="
(assoc-ref %outputs "out")
"/lib/ldb/modules/ldb")
(string-append "--with-xml-catalog-path="
(assoc-ref %build-inputs "docbook-xml")
"/xml/dtd/docbook/catalog.xml"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'disable-failing-test
(lambda _
(substitute* "src/tests/responder_socket_access-tests.c"
(("tcase_add_test\\(tc_utils, resp_str_to_array_test\\);") ""))
#t)))))
(inputs
`(("augeas" ,augeas)
("bind" ,isc-bind "utils")
("c-ares" ,c-ares)
("curl" ,curl)
("cyrus-sasl" ,cyrus-sasl)
("dbus" ,dbus)
("ding-libs" ,ding-libs)
("glib" ,glib)
("gnutls" ,gnutls)
("http-parser" ,http-parser)
("jansson" ,jansson)
("ldb" ,ldb)
("libselinux" ,libselinux)
("libsemanage" ,libsemanage)
("libunistring" ,libunistring)
("linux-pam" ,linux-pam)
("mit-krb5" ,mit-krb5)
("nss" ,nss)
("openldap" ,openldap)
("openssl" ,openssl)
("pcre" ,pcre)
("popt" ,popt)
("samba" ,samba)
("talloc" ,talloc)
("tdb" ,tdb)
("tevent" ,tevent)))
(native-inputs
`(("check" ,check)
("docbook-xsl" ,docbook-xsl)
("docbook-xml" ,docbook-xml)
("libxslt" ,libxslt)
("pkg-config" ,pkg-config)))
(home-page "https://pagure.io/SSSD/sssd/")
(synopsis "System security services daemon")
(description "SSSD is a system daemon. Its primary function is to provide
access to identity and authentication remote resource through a common
framework that can provide caching and offline support to the system. It
provides PAM and NSS modules, and in the future will D-BUS based interfaces
for extended user information. It also provides a better database to store
local users as well as extended user data.")
(license license:gpl3+)))

76
gnu/packages/textutils.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2015 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
@ -10,6 +10,7 @@
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017 Rene Saavedra <rennes@openmailbox.org>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -31,11 +32,13 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system ant)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix build-system trivial)
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages java)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
@ -368,6 +371,45 @@ to everybody, because they believe that everybody runs Windows and therefore
runs Word\".")
(license license:gpl2+)))
(define-public catdoc
(package
(name "catdoc")
(version "0.95")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.wagner.pp.ru/pub/catdoc/"
"catdoc-" version ".tar.gz"))
(sha256
(base32
"15h7v3bmwfk4z8r78xs5ih6vd0pskn0rj90xghvbzdjj0cc88jji"))))
(build-system gnu-build-system)
;; TODO: Also build `wordview` which requires `tk` – make a separate
;; package for this.
(arguments
'(#:tests? #f ; There are no tests
#:configure-flags '("--disable-wordview")
#:phases
(modify-phases %standard-phases
(add-before 'install 'fix-install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(mkdir-p (string-append out "/share/man/man1"))))))))
(home-page "http://www.wagner.pp.ru/~vitus/software/catdoc/")
(synopsis "MS-Word to TeX or plain text converter")
(description "@command{catdoc} extracts text from MS-Word files, trying to
preserve as many special printable characters as possible. It supports
everything up to Word-97. Also supported are MS Write documents and RTF files.
@command{catdoc} does not preserve complex word formatting, but it can
translate some non-ASCII characters into TeX escape codes. It's goal is to
extract plain text and allow you to read it and, probably, reformat with TeX,
according to TeXnical rules.
This package also provides @command{xls2csv}, which extracts data from Excel
spreadsheets and outputs it in comma-separated-value format, and
@command{catppt}, which extracts data from PowerPoint presentations.")
(license license:gpl2+)))
(define-public utfcpp
(package
(name "utfcpp")
@ -518,3 +560,35 @@ categories.")
"C library for creating and parsing configuration files.")
(license (list license:lgpl2.1 ; Main distribution.
license:asl1.1)))) ; src/readdir.{c,h}
(define-public java-rsyntaxtextarea
(package
(name "java-rsyntaxtextarea")
(version "2.6.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/bobbylight/"
"RSyntaxTextArea/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0c5mqg2klj5rvf8fhycrli8rf6s37l9p7a8knw9gpp65r1c120q2"))))
(build-system ant-build-system)
(arguments
`(;; FIXME: some tests fail because locale resources cannot be found.
;; Even when I add them to the class path,
;; RSyntaxTextAreaEditorKitDumbCompleteWordActionTest fails.
#:tests? #f
#:jar-name "rsyntaxtextarea.jar"))
(native-inputs
`(("java-junit" ,java-junit)
("java-hamcrest-core" ,java-hamcrest-core)))
(home-page "https://bobbylight.github.io/RSyntaxTextArea/")
(synopsis "Syntax highlighting text component for Java Swing")
(description "RSyntaxTextArea is a syntax highlighting, code folding text
component for Java Swing. It extends @code{JTextComponent} so it integrates
completely with the standard @code{javax.swing.text} package. It is fast and
efficient, and can be used in any application that needs to edit or view
source code.")
(license license:bsd-3)))

7
gnu/packages/tls.scm
View file

@ -474,15 +474,14 @@ security, and applying best practice development processes.")
(package
(name "python-acme")
;; Remember to update the hash of certbot when updating python-acme.
(version "0.14.0")
(version "0.14.1")
(source (origin
(method url-fetch)
(uri (pypi-uri "acme" version))
(sha256
(base32
"0hrmh28rrc0fsiw6nqfwbkwb1s4nkl54x50c0g0xlnp86752nzff"))))
"0asmkfkzbswnkrvbj5m01xgy4f6g1fjbj2nir1hhrn3ipcdrsv8f"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
@ -540,7 +539,7 @@ security, and applying best practice development processes.")
(uri (pypi-uri name version))
(sha256
(base32
"0hbp3njss01a0d3brvcfzja0w0j9plwrv6l70jsfvnhy3rrd7bcq"))))
"0rdby57hw35qdrbl7kigscphnz4kqb608bqzrcb73nb99092i6si"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2

6
gnu/packages/tor.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
@ -43,14 +43,14 @@
(define-public tor
(package
(name "tor")
(version "0.3.0.6")
(version "0.3.0.7")
(source (origin
(method url-fetch)
(uri (string-append "https://dist.torproject.org/tor-"
version ".tar.gz"))
(sha256
(base32
"057vq8wagppmrlg85dgbsrk1v67yqpbi9n87s8gn0mdm7kli5rd3"))))
"00kxa83bn0axh7479fynp6r8znq5wy26kvb8ghixgjpkir2c8h4n"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list "--enable-expensive-hardening"

27
gnu/packages/video.scm
View file

@ -273,7 +273,7 @@ H.264 (MPEG-4 AVC) video streams.")
(define-public x265
(package
(name "x265")
(version "2.3")
(version "2.4")
(source
(origin
(method url-fetch)
@ -281,7 +281,7 @@ H.264 (MPEG-4 AVC) video streams.")
"x265_" version ".tar.gz"))
(sha256
(base32
"07z4ydxg0lk6j43h0wlh2xddb91cy4y4mny2ln71d4278b1hllj7"))
"0afp0xlk0fb4q6j4sh3hyvjnjccdp61sn21zg3fyqvwgswcafalw"))
(modules '((guix build utils)))
(snippet
'(delete-file-recursively "source/compat/getopt"))))
@ -458,14 +458,14 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).")
(define-public ffmpeg
(package
(name "ffmpeg")
(version "3.3")
(version "3.3.1")
(source (origin
(method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz"))
(sha256
(base32
"17anx7rnbi63if1ndr61836lf76dpn47n0y424hc48bj05y7z7jr"))))
"0bwgm6z6k3khb91qh9xv15inykkfchpkm0lcdckkxhkacpyaf0mp"))))
(build-system gnu-build-system)
(inputs
`(("fontconfig" ,fontconfig)
@ -646,7 +646,7 @@ audio/video codec library.")
(define-public vlc
(package
(name "vlc")
(version "2.2.4")
(version "2.2.5.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -654,14 +654,7 @@ audio/video codec library.")
version "/vlc-" version ".tar.xz"))
(sha256
(base32
"1gjkrwlg8ab3skzl67cxb9qzg4187ifckd1z9kpy11q058fyjchn"))
(modules '((guix build utils)))
(snippet
;; There are two occurrences where __DATE__ and __TIME__ are
;; used to capture the build time and show it to the user.
'(substitute* (find-files "." "help\\.c(pp)?$")
(("__DATE__") "\"2016\"")
(("__TIME__") "\"00:00\"")))))
"1k51vm6piqlrnld7sxyg0s4kdkd3lan97lmy3v5wdh3qyll8m2xj"))))
(build-system gnu-build-system)
(native-inputs
`(("git" ,git) ; needed for a test
@ -1599,14 +1592,14 @@ tools, XML authoring components, and an extensible plug-in based API.")
(define-public v4l-utils
(package
(name "v4l-utils")
(version "1.12.3")
(version "1.12.5")
(source (origin
(method url-fetch)
(uri (string-append "https://linuxtv.org/downloads/v4l-utils"
"/v4l-utils-" version ".tar.bz2"))
(sha256
(base32
"0vpl3jl0x441y7b5cn7zhdsyi954hp9h2p30jhnr1zkx1rpxsiss"))))
"03g2b4rivrilimcp57mwrlsa3qvrxmk4sza08mygwmqbvcnic606"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
@ -1816,14 +1809,14 @@ specifications.")
(define-public libaacs
(package
(name "libaacs")
(version "0.8.1")
(version "0.9.0")
(source
(origin
(method url-fetch)
(uri (string-append "ftp://ftp.videolan.org/pub/videolan/libaacs/"
version "/" name "-" version ".tar.bz2"))
(sha256
(base32 "1s5v075hnbs57995r6lljm79wgrip3gnyf55a0y7bja75jh49hwm"))))
(base32 "1kms92i0c7i1yl659kqjf19lm8172pnpik5lsxp19xphr74vvq27"))))
(inputs
`(("libgcrypt" ,libgcrypt)))
(native-inputs

8
gnu/packages/vim.scm
View file

@ -60,7 +60,7 @@
(define-public vim
(package
(name "vim")
(version "8.0.0566")
(version "8.0.0600")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v"
@ -68,7 +68,7 @@
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0qq9pj8391sikzaahlqi289l5wdkbvsdhz8qb6np268yqizpg4p2"))))
"1ifaj0lfzqn06snkcd83l58m9r6lg7lk3wspx71k5ycvypyfi67s"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
@ -138,6 +138,10 @@ configuration files.")
;; https://github.com/vim/vim/issues/1460
(substitute* "src/testdir/test_cmdline.vim"
(("call assert_equal\\(.+getcmd.+\\(\\)\\)") ""))
;; FIXME: This test broke after GCC-5 core-updates merge.
;; "Test_system_exmode line 7: Expected '0' but got '/'"
(substitute* "src/testdir/test_system.vim"
(("call assert_equal\\('0', a\\[0\\]\\)") ""))
#t))
(add-before 'check 'start-xserver
(lambda* (#:key inputs #:allow-other-keys)

32
gnu/packages/web.scm
View file

@ -4552,3 +4552,35 @@ into your tests. It automatically starts up a HTTP server in a separate thread
(define-public python2-pytest-httpbin
(package-with-python2 python-pytest-httpbin))
(define-public http-parser
(package
(name "http-parser")
(version "2.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/nodejs/http-parser/"
"archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1cw6nf8xy4jhib1w0jd2y0gpqjbdasg8b7pkl2k2vpp54k9rlh3h"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
#:make-flags
(list (string-append "PREFIX="
(assoc-ref %outputs "out"))
"CC=gcc" "library")
#:phases
(modify-phases %standard-phases
(delete 'configure))))
(home-page "https://github.com/nodejs/http-parser")
(synopsis "HTTP request/response parser for C")
(description "This is a parser for HTTP messages written in C. It parses
both requests and responses. The parser is designed to be used in
high-performance HTTP applications. It does not make any syscalls nor
allocations, it does not buffer data, it can be interrupted at anytime.
Depending on your architecture, it only requires about 40 bytes of data per
message stream (in a web server that is per connection).")
(license l:expat)))

31
gnu/packages/xml.scm
View file

@ -44,6 +44,7 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system ant)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system perl)
@ -1175,3 +1176,33 @@ to read and write XML data. A shared library is provided for parsing,
generating, manipulating, and validating XML documents using the DOM, SAX, and
SAX2 APIs.")
(license license:asl2.0)))
(define-public java-simple-xml
(package
(name "java-simple-xml")
(version "2.7.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/simple/simple-xml-"
version ".zip"))
(sha256
(base32
"0w19k1awslmihpwsxwjbg89hv0vjhk4k3i0vrfchy3mqknd988y5"))))
(build-system ant-build-system)
(arguments
`(#:build-target "build"
#:test-target "test"
#:phases
(modify-phases %standard-phases
(replace 'install (install-jars "jar")))))
(native-inputs
`(("unzip" ,unzip)))
(home-page "http://simple.sourceforge.net/")
(synopsis "XML serialization framework for Java")
(description "Simple is a high performance XML serialization and
configuration framework for Java. Its goal is to provide an XML framework
that enables rapid development of XML configuration and communication systems.
This framework aids the development of XML systems with minimal effort and
reduced errors. It offers full object serialization and deserialization,
maintaining each reference encountered.")
(license license:asl2.0)))

3
gnu/services/base.scm
View file

@ -1332,7 +1332,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(define %default-authorized-guix-keys
;; List of authorized substitute keys.
(list (file-append guix "/share/guix/hydra.gnu.org.pub")))
(list (file-append guix "/share/guix/hydra.gnu.org.pub")
(file-append guix "/share/guix/bayfront.guixsd.org.pub")))
(define-record-type* <guix-configuration>
guix-configuration make-guix-configuration

41
gnu/services/pm.scm
View file

@ -20,6 +20,7 @@
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
#:use-module (gnu services)
#:use-module (gnu services base)
@ -27,7 +28,10 @@
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:export (tlp-service-type
tlp-configuration))
tlp-configuration
thermald-configuration
thermald-service-type))
(define (uglify-field-name field-name)
(let ((str (symbol->string field-name)))
@ -403,3 +407,38 @@ shutdown on system startup."))
(generate-documentation
`((tlp-configuration ,tlp-configuration-fields))
'tlp-configuration))
;;;
;;; thermald
;;;
;;; This service implements cpu scaling. Helps prevent overheating!
(define-record-type* <thermald-configuration>
thermald-configuration make-thermald-configuration
thermald-configuration?
(ignore-cpuid-check? thermald-ignore-cpuid-check? ;boolean
(default #f))
(thermald thermald-thermald ;package
(default thermald)))
(define (thermald-shepherd-service config)
(list
(shepherd-service
(provision '(thermald))
(documentation "Run thermald cpu frequency scaling.")
(start #~(make-forkexec-constructor
'(#$(file-append (thermald-thermald config) "/sbin/thermald")
"--no-daemon"
#$@(if (thermald-ignore-cpuid-check? config)
'("--ignore-cpuid-check")
'()))))
(stop #~(make-kill-destructor)))))
(define thermald-service-type
(service-type
(name 'thermald)
(extensions (list (service-extension shepherd-root-service-type
thermald-shepherd-service)))
(default-value (thermald-configuration))))

2
gnu/services/ssh.scm
View file

@ -385,7 +385,7 @@ The other options should be self-descriptive."
(list (shepherd-service
(documentation "OpenSSH server.")
(requirement '(networking syslogd))
(requirement '(syslogd))
(provision '(ssh-daemon))
(start #~(make-forkexec-constructor #$openssh-command
#:pid-file #$pid-file))

28
gnu/system.scm
View file

@ -48,6 +48,7 @@
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@ -103,6 +104,7 @@
boot-parameters?
boot-parameters-label
boot-parameters-root-device
boot-parameters-boot-name
boot-parameters-store-device
boot-parameters-store-mount-point
boot-parameters-kernel
@ -139,7 +141,7 @@ booted from ROOT-DEVICE"
(default linux-libre))
(kernel-arguments operating-system-user-kernel-arguments
(default '())) ; list of gexps/strings
(bootloader operating-system-bootloader) ; <grub-configuration>
(bootloader operating-system-bootloader) ; <bootloader-configuration>
(initrd operating-system-initrd ; (list fs) -> M derivation
(default base-initrd))
@ -213,6 +215,7 @@ directly by the user."
;; exactly to the device field of the <file-system> object representing the
;; OS's root file system, so it might be a device path like "/dev/sda3".
(root-device boot-parameters-root-device)
(boot-name boot-parameters-boot-name)
(store-device boot-parameters-store-device)
(store-mount-point boot-parameters-store-mount-point)
(kernel boot-parameters-kernel)
@ -231,6 +234,11 @@ directly by the user."
(label label)
(root-device root)
(boot-name
(match (assq 'boot-name rest)
((_ args) args)
(#f 'grub))) ; for compatibility reasons.
;; In the past, we would store the directory name of the kernel instead
;; of the absolute file name of its image. Detect that and correct it.
(kernel (if (string=? linux (direct-store-path linux))
@ -494,7 +502,7 @@ explicitly appear in OS."
;; The packages below are also in %FINAL-INPUTS, so take them from
;; there to avoid duplication.
(map canonical-package
(list guile-2.0 bash coreutils-8.27 findutils grep sed
(list guile-2.2 bash coreutils-8.27 findutils grep sed
diffutils patch gawk tar gzip bzip2 xz lzip))))
(define %default-issue
@ -847,12 +855,11 @@ populate the \"old entries\" menu."
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs))
(file-system-device root-fs)))
(entry (operating-system-boot-parameters os system root-device)))
((module-ref (resolve-interface '(gnu system grub))
'grub-configuration-file)
(operating-system-bootloader os)
(list entry)
#:old-entries old-entries)))
(entry (operating-system-boot-parameters os system root-device))
(bootloader-conf -> (operating-system-bootloader os)))
((bootloader-configuration-file-generator
(bootloader-configuration-bootloader bootloader-conf))
bootloader-conf (list entry) #:old-entries old-entries)))
(define (fs->boot-device fs)
"Given FS, a <file-system> object, return a value suitable for use as the
@ -869,6 +876,9 @@ kernel arguments for that derivation to <boot-parameters>."
(mlet* %store-monad
((initrd (operating-system-initrd-file os))
(store -> (operating-system-store-file-system os))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
(boot-name -> (bootloader-name bootloader))
(label -> (kernel->boot-label (operating-system-kernel os))))
(return (boot-parameters
(label label)
@ -879,6 +889,7 @@ kernel arguments for that derivation to <boot-parameters>."
(operating-system-kernel-arguments os system.drv root-device)
(operating-system-user-kernel-arguments os)))
(initrd initrd)
(boot-name boot-name)
(store-device (fs->boot-device store))
(store-mount-point (file-system-mount-point store))))))
@ -904,6 +915,7 @@ being stored into the \"parameters\" file)."
(kernel-arguments
#$(boot-parameters-kernel-arguments params))
(initrd #$(boot-parameters-initrd params))
(boot-name #$(boot-parameters-boot-name params))
(store
(device #$(boot-parameters-store-device params))
(mount-point #$(boot-parameters-store-mount-point params))))

28
gnu/system/examples/lightweight-desktop.tmpl
View file

@ -4,23 +4,31 @@
(use-modules (gnu) (gnu system nss))
(use-service-modules desktop)
(use-package-modules wm ratpoison certs suckless)
(use-package-modules bootloaders certs ratpoison suckless wm)
(operating-system
(host-name "antelope")
(timezone "Europe/Paris")
(locale "en_US.utf8")
;; Assuming /dev/sdX is the target hard disk, and "my-root"
;; is the label of the target root file system.
(bootloader (grub-configuration (device "/dev/sdX")))
;; Use the UEFI variant of GRUB with the EFI System
;; Partition on /dev/sda1.
(bootloader (grub-configuration (grub grub-efi)
(device "/dev/sda1")))
(file-systems (cons (file-system
(device "my-root")
(title 'label)
(mount-point "/")
(type "ext4"))
%base-file-systems))
;; Assume the target root file system is labelled "my-root".
(file-systems (cons* (file-system
(device "my-root")
(title 'label)
(mount-point "/")
(type "ext4"))
(file-system
;; Specify partition here since FAT
;; labels are currently unsupported.
(device "/dev/sda1")
(mount-point "/boot/efi")
(type "vfat"))
%base-file-systems))
(users (cons (user-account
(name "alice")

53
gnu/system/examples/vm-image.tmpl Normal file
View file

@ -0,0 +1,53 @@
;;; This is an operating system configuration template for a "bare-bones" setup,
;;; suitable for booting in a virtualized environment, including virtual private
;;; servers (VPS).
(use-modules (gnu))
(use-package-modules bootloaders disk nvi)
(define vm-image-motd (plain-file "motd" "
This is the GNU system. Welcome!
This instance of GuixSD is a bare-bones template for virtualized environments.
You will probably want to do these things first if you booted in a virtual
private server (VPS):
* Set a password for 'root'.
* Set up networking.
* Expand the root partition to fill the space available by 0) deleting and
recreating the partition with fdisk, 1) reloading the partition table with
partprobe, and then 2) resizing the filesystem with resize2fs.\n"))
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
(locale "en_US.utf8")
;; Assuming /dev/sdX is the target hard disk, and "my-root" is
;; the label of the target root file system.
(bootloader (grub-configuration (device "/dev/sda")
(terminal-outputs '(console))))
(file-systems (cons (file-system
(device "my-root")
(title 'label)
(mount-point "/")
(type "ext4"))
%base-file-systems))
;; This is where user accounts are specified. The "root"
;; account is implicit, and is initially created with the
;; empty password.
(users %base-user-accounts)
;; Globally-installed packages.
(packages (cons* nvi fdisk
grub ; mostly so xrefs to its manual work
parted ; partprobe
%base-packages))
(services (modify-services %base-services
(login-service-type config =>
(login-configuration
(inherit config)
(motd vm-image-motd))))))

12
gnu/system/install.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,6 +26,7 @@
#:use-module (guix monads)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (gnu services shepherd)
#:use-module (gnu services ssh)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages bootloaders)
@ -262,6 +264,16 @@ You have been warned. Thanks for being so brave.
;; To facilitate copy/paste.
(gpm-service)
;; Add an SSH server to facilitate remote installs.
(service openssh-service-type
(openssh-configuration
(port-number 22)
(permit-root-login #t)
;; The root account is passwordless, so make sure
;; a password is set before allowing logins.
(allow-empty-passwords? #f)
(password-authentication? #t)))
;; Since this is running on a USB stick with a unionfs as the root
;; file system, use an appropriate cache configuration.
(nscd-service (nscd-configuration

4
gnu/system/linux-initrd.scm
View file

@ -268,6 +268,7 @@ loaded at boot time in the order in which they appear."
"usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
"dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
"nvme" ;for new SSD NVMe devices
"nls_iso8859-1" ;for `mkfs.fat`, et.al
,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
'("pata_acpi" "pata_atiixp" ;for ATA controllers
"isci") ;for SAS controllers like Intel C602
@ -281,9 +282,6 @@ loaded at boot time in the order in which they appear."
,@(if (find (file-system-type-predicate "9p") file-systems)
virtio-9p-modules
'())
,@(if (find (file-system-type-predicate "vfat") file-systems)
'("nls_iso8859-1")
'())
,@(if (find (file-system-type-predicate "btrfs") file-systems)
'("btrfs")
'())

60
gnu/system/vm.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -46,10 +47,11 @@
#:select (%guile-static-stripped))
#:use-module (gnu packages admin)
#:use-module (gnu bootloader)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system grub)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system)
#:use-module (gnu services)
@ -176,8 +178,9 @@ made available under the /xchg CIFS share."
(disk-image-format "qcow2")
(file-system-type "ext4")
file-system-label
os-derivation
grub-configuration
os-drv
bootcfg-drv
bootloader
(register-closures? #t)
(inputs '())
copy-inputs?)
@ -201,7 +204,7 @@ the image."
(guix build utils))
(let ((inputs
'#$(append (list qemu parted grub e2fsprogs)
'#$(append (list qemu parted e2fsprogs dosfstools)
(map canonical-package
(list sed grep coreutils findutils gawk))
(if register-closures? (list guix) '())))
@ -223,17 +226,36 @@ the image."
#:closures graphs
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
#:system-directory #$os-derivation))
#:system-directory #$os-drv))
(partitions (list (partition
(size #$(- disk-image-size
(* 10 (expt 2 20))))
(* 50 (expt 2 20))))
(label #$file-system-label)
(file-system #$file-system-type)
(bootable? #t)
(initializer initialize)))))
(flags '(boot))
(initializer initialize))
;; Append a small EFI System Partition for
;; use with UEFI bootloaders.
(partition
;; The standalone grub image is about 10MiB, but
;; leave some room for custom or multiple images.
(size (* 40 (expt 2 20)))
(label "GNU-ESP") ;cosmetic only
;; Use "vfat" here since this property is used
;; when mounting. The actual FAT-ness is based
;; on filesystem size (16 in this case).
(file-system "vfat")
(flags '(esp))))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
#:grub.cfg #$grub-configuration)
#:grub-efi #$grub-efi
#:bootloader-package
#$(bootloader-package bootloader)
#:bootcfg #$bootcfg-drv
#:bootcfg-location
#$(bootloader-configuration-file bootloader)
#:bootloader-installer
#$(bootloader-installer bootloader))
(reboot)))))
#:system system
#:make-disk-image? #t
@ -287,8 +309,10 @@ to USB sticks meant to be read-only."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
(qemu-image #:name name
#:os-derivation os-drv
#:grub-configuration bootcfg
#:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
@ -330,8 +354,10 @@ of the GNU system as described by OS."
(mlet* %store-monad
((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
(qemu-image #:os-derivation os-drv
#:grub-configuration bootcfg
(qemu-image #:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:inputs `(("system" ,os-drv)
@ -429,8 +455,10 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
;; BOOTCFG and all its dependencies, including the output of OS-DRV.
;; This is more than needed (we only need the kernel, initrd, GRUB for its
;; font, and the background image), but it's hard to filter that.
(qemu-image #:os-derivation os-drv
#:grub-configuration bootcfg
(qemu-image #:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:inputs (if full-boot?
`(("bootcfg" ,bootcfg))
@ -471,7 +499,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
(mappings '())
full-boot?
(disk-image-size
(* (if full-boot? 500 30)
(* (if full-boot? 500 70)
(expt 2 20))))
"Return a derivation that builds a script to run a virtual machine image of
OS that shares its store with the host.

3
gnu/tests.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,8 +21,8 @@
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (guix records)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (gnu services)

22
gnu/tests/base.scm
View file

@ -199,6 +199,28 @@ info --version")
',users+homes))
marionette)))
(test-equal "no extra home directories"
'()
;; Make sure the home directories that are not supposed to be
;; created are indeed not created.
(let ((nonexistent
'#$(filter-map (lambda (user)
(and (not
(user-account-create-home-directory?
user))
(user-account-home-directory user)))
(operating-system-user-accounts os))))
(marionette-eval
`(begin
(use-modules (srfi srfi-1))
;; Note: Do not flag "/var/empty".
(filter file-exists?
',(remove (cut string-prefix? "/var/" <>)
nonexistent)))
marionette)))
(test-equal "login on tty1"
"root\n"
(begin

3
gnu/tests/nfs.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,8 +20,8 @@
(define-module (gnu tests nfs)
#:use-module (gnu tests)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (gnu system vm)

107
guix/build-system/asdf.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +22,9 @@
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module ((guix build utils)
#:select ((package-name->name+version
. hyphen-separated-name->name+version)))
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
@ -163,39 +166,40 @@ set up using CL source package conventions."
(match-lambda
((name content . rest)
(let* ((is-package? (package? content))
(new-content (if is-package? (transform content) content))
(new-name (if (and is-package?
(string-prefix? from-prefix name))
(package-name new-content)
name)))
`(,new-name ,new-content ,@rest)))))
(new-content (if is-package? (transform content) content)))
`(,name ,new-content ,@rest)))))
;; Special considerations for source packages: CL inputs become
;; propagated, and un-handled arguments are removed. Native inputs are
;; removed as are extraneous outputs.
;; propagated, and un-handled arguments are removed.
(define new-propagated-inputs
(if target-is-source?
(map rewrite
(filter (match-lambda
((_ input . _)
(has-from-build-system? input)))
(package-inputs pkg)))
'()))
(append
(filter (match-lambda
((_ input . _)
(has-from-build-system? input)))
(append (package-inputs pkg)
;; The native inputs might be needed just
;; to load the system.
(package-native-inputs pkg)))
(package-propagated-inputs pkg)))
(define new-inputs
(map rewrite (package-propagated-inputs pkg))))
(define (new-inputs inputs-getter)
(if target-is-source?
(map rewrite
(filter (match-lambda
((_ input . _)
(not (has-from-build-system? input))))
(package-inputs pkg)))
(map rewrite (package-inputs pkg))))
(inputs-getter pkg)))
(map rewrite (inputs-getter pkg))))
(define base-arguments
(if target-is-source?
(strip-keyword-arguments
'(#:tests? #:special-dependencies #:asd-file
#:test-only-systems #:lisp)
'(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
(package-arguments pkg))
(package-arguments pkg)))
@ -213,11 +217,9 @@ set up using CL source package conventions."
(arguments
(substitute-keyword-arguments base-arguments
((#:phases phases) (list phases-transformer phases))))
(inputs new-inputs)
(inputs (new-inputs package-inputs))
(propagated-inputs new-propagated-inputs)
(native-inputs (if target-is-source?
'()
(map rewrite (package-native-inputs pkg))))
(native-inputs (new-inputs package-native-inputs))
(outputs (if target-is-source?
'("out")
(package-outputs pkg)))))
@ -233,10 +235,10 @@ set up using CL source package conventions."
(properties (alist-delete variant properties)))
pkg))
(define (lower lisp-implementation)
(define (lower lisp-type)
(lambda* (name
#:key source inputs outputs native-inputs system target
(lisp (default-lisp (string->symbol lisp-implementation)))
(lisp (default-lisp (string->symbol lisp-type)))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME"
@ -252,20 +254,19 @@ set up using CL source package conventions."
'())
,@inputs
,@(standard-packages)))
(build-inputs `((,lisp-implementation ,lisp)
(build-inputs `((,lisp-type ,lisp)
,@native-inputs))
(outputs outputs)
(build (asdf-build lisp-implementation))
(build (asdf-build lisp-type))
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define (asdf-build lisp-implementation)
(define (asdf-build lisp-type)
(lambda* (store name inputs
#:key source outputs
(tests? #t)
(special-dependencies ''())
(asd-file #f)
(test-only-systems ''())
(lisp lisp-implementation)
(asd-system-name #f)
(test-asd-file #f)
(phases '(@ (guix build asdf-build-system)
%standard-phases))
(search-paths '())
@ -274,26 +275,36 @@ set up using CL source package conventions."
(imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules))
(define system-name
(or asd-system-name
(string-drop
;; NAME is the value returned from `package-full-name'.
(hyphen-separated-name->name+version name)
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
(define builder
`(begin
(use-modules ,@modules)
(asdf-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source) source)
(source source))
#:lisp ,lisp
#:special-dependencies ,special-dependencies
#:asd-file ,asd-file
#:test-only-systems ,test-only-systems
#:system ,system
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(parameterize ((%lisp (string-append
(assoc-ref %build-inputs ,lisp-type)
"/bin/" ,lisp-type))
(%lisp-type ,lisp-type))
(asdf-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source) source)
(source source))
#:asd-file ,(or asd-file (string-append system-name ".asd"))
#:asd-system-name ,system-name
#:test-asd-file ,test-asd-file
#:system ,system
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(define guile-for-build
(match guile

176
guix/build/asdf-build-system.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,6 +21,7 @@
#:use-module (guix build utils)
#:use-module (guix build lisp-utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
@ -42,50 +43,42 @@
(define %object-prefix "/lib")
(define (source-install-prefix lisp)
(string-append %install-prefix "/" lisp "-source"))
(define (%lisp-source-install-prefix)
(string-append %source-install-prefix "/" (%lisp-type) "-source"))
(define %system-install-prefix
(string-append %install-prefix "/systems"))
(string-append %source-install-prefix "/systems"))
(define (output-path->package-name path)
(package-name->name+version (strip-store-file-name path)))
(define (outputs->name outputs)
(output-path->package-name
(assoc-ref outputs "out")))
(define (lisp-source-directory output lisp name)
(string-append output (source-install-prefix lisp) "/" name))
(define (lisp-source-directory output name)
(string-append output (%lisp-source-install-prefix) "/" name))
(define (source-directory output name)
(string-append output %install-prefix "/source/" name))
(string-append output %source-install-prefix "/source/" name))
(define (library-directory output lisp)
(define (library-directory output)
(string-append output %object-prefix
"/" lisp))
"/" (%lisp-type)))
(define (output-translation source-path
object-output
lisp)
object-output)
"Return a translation for the system's source path
to it's binary output."
`((,source-path
:**/ :*.*.*)
(,(library-directory object-output lisp)
(,(library-directory object-output)
:**/ :*.*.*)))
(define (source-asd-file output lisp name asd-file)
(string-append (lisp-source-directory output lisp name) "/" asd-file))
(define (source-asd-file output name asd-file)
(string-append (lisp-source-directory output name) "/" asd-file))
(define (copy-files-to-output outputs output name)
"Copy all files from OUTPUT to \"out\". Create an extra link to any
system-defining files in the source to a convenient location. This is done
before any compiling so that the compiled source locations will be valid."
(let* ((out (assoc-ref outputs output))
(source (getcwd))
(target (source-directory out name))
(system-path (string-append out %system-install-prefix)))
(define (copy-files-to-output out name)
"Copy all files from the current directory to OUT. Create an extra link to
any system-defining files in the source to a convenient location. This is
done before any compiling so that the compiled source locations will be
valid."
(let ((source (getcwd))
(target (source-directory out name))
(system-path (string-append out %system-install-prefix)))
(copy-recursively source target)
(mkdir-p system-path)
(for-each
@ -97,45 +90,38 @@ before any compiling so that the compiled source locations will be valid."
(define* (install #:key outputs #:allow-other-keys)
"Copy and symlink all the source files."
(copy-files-to-output outputs "out" (outputs->name outputs)))
(define output (assoc-ref outputs "out"))
(copy-files-to-output output
(package-name->name+version
(strip-store-file-name output))))
(define* (copy-source #:key outputs lisp #:allow-other-keys)
"Copy the source to \"out\"."
(let* ((out (assoc-ref outputs "out"))
(name (remove-lisp-from-name (output-path->package-name out) lisp))
(install-path (string-append out %install-prefix)))
(copy-files-to-output outputs "out" name)
(define* (copy-source #:key outputs asd-system-name #:allow-other-keys)
"Copy the source to the library output."
(let* ((out (library-output outputs))
(install-path (string-append out %source-install-prefix)))
(copy-files-to-output out asd-system-name)
;; Hide the files from asdf
(with-directory-excursion install-path
(rename-file "source" (string-append lisp "-source"))
(rename-file "source" (string-append (%lisp-type) "-source"))
(delete-file-recursively "systems")))
#t)
(define* (build #:key outputs inputs lisp asd-file
(define* (build #:key outputs inputs asd-file asd-system-name
#:allow-other-keys)
"Compile the system."
(let* ((out (assoc-ref outputs "out"))
(name (remove-lisp-from-name (output-path->package-name out) lisp))
(source-path (lisp-source-directory out lisp name))
(let* ((out (library-output outputs))
(source-path (lisp-source-directory out asd-system-name))
(translations (wrap-output-translations
`(,(output-translation source-path
out
lisp))))
(asd-file (and=> asd-file (cut source-asd-file out lisp name <>))))
out))))
(asd-file (source-asd-file out asd-system-name asd-file)))
(setenv "ASDF_OUTPUT_TRANSLATIONS"
(replace-escaped-macros (format #f "~S" translations)))
;; We don't need this if we have the asd file, and it can mess with the
;; load ordering we're trying to enforce
(unless asd-file
(prepend-to-source-registry (string-append source-path "//")))
(setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
(parameterize ((%lisp (string-append
(assoc-ref inputs lisp) "/bin/" lisp)))
(compile-system name lisp asd-file))
(compile-system asd-system-name asd-file)
;; As above, ecl will sometimes create this even though it doesn't use it
@ -144,56 +130,48 @@ before any compiling so that the compiled source locations will be valid."
(delete-file-recursively cache-directory))))
#t)
(define* (check #:key lisp tests? outputs inputs asd-file
(define* (check #:key tests? outputs inputs asd-file asd-system-name
test-asd-file
#:allow-other-keys)
"Test the system."
(let* ((name (remove-lisp-from-name (outputs->name outputs) lisp))
(out (assoc-ref outputs "out"))
(asd-file (and=> asd-file (cut source-asd-file out lisp name <>))))
(let* ((out (library-output outputs))
(asd-file (source-asd-file out asd-system-name asd-file))
(test-asd-file
(and=> test-asd-file
(cut source-asd-file out asd-system-name <>))))
(if tests?
(parameterize ((%lisp (string-append
(assoc-ref inputs lisp) "/bin/" lisp)))
(test-system name lisp asd-file))
(test-system asd-system-name asd-file test-asd-file)
(format #t "test suite not run~%")))
#t)
(define* (patch-asd-files #:key outputs
(define* (create-asd-file #:key outputs
inputs
lisp
special-dependencies
test-only-systems
asd-file
asd-system-name
#:allow-other-keys)
"Patch any asd files created by the compilation process so that they can
find their dependencies. Exclude any TEST-ONLY-SYSTEMS which were only
included to run tests. Add any SPECIAL-DEPENDENCIES which the LISP
implementation itself provides."
(let* ((out (assoc-ref outputs "out"))
(name (remove-lisp-from-name (output-path->package-name out) lisp))
(registry (lset-difference
(lambda (input system)
(match input
((name . path) (string=? name system))))
(lisp-dependencies lisp inputs)
test-only-systems))
(lisp-systems (map first registry)))
"Create a system definition file for the built system."
(let*-values (((out) (library-output outputs))
((_ version) (package-name->name+version
(strip-store-file-name out)))
((new-asd-file) (string-append
(library-directory out)
"/" (normalize-string asd-system-name)
".asd")))
(for-each
(lambda (asd-file)
(patch-asd-file asd-file registry lisp
(append lisp-systems special-dependencies)))
(find-files out "\\.asd$")))
(make-asd-file new-asd-file
#:system asd-system-name
#:version version
#:inputs inputs
#:system-asd-file asd-file))
#t)
(define* (symlink-asd-files #:key outputs lisp #:allow-other-keys)
(define* (symlink-asd-files #:key outputs #:allow-other-keys)
"Create an extra reference to the system in a convenient location."
(let* ((out (assoc-ref outputs "out")))
(let* ((out (library-output outputs)))
(for-each
(lambda (asd-file)
(substitute* asd-file
((";;; Built for.*") "") ; remove potential non-determinism
(("^\\(DEFSYSTEM(.*)$" all end) (string-append "(asdf:defsystem" end)))
(receive (new-asd-file asd-file-directory)
(bundle-asd-file out asd-file lisp)
(bundle-asd-file out asd-file)
(mkdir-p asd-file-directory)
(symlink asd-file new-asd-file)
;; Update the source registry for future phases which might want to
@ -201,15 +179,14 @@ implementation itself provides."
(prepend-to-source-registry
(string-append asd-file-directory "/"))))
(find-files (string-append out %object-prefix) "\\.asd$"))
)
(find-files (string-append out %object-prefix) "\\.asd$")))
#t)
(define* (cleanup-files #:key outputs lisp
#:allow-other-keys)
(define* (cleanup-files #:key outputs
#:allow-other-keys)
"Remove any compiled files which are not a part of the final bundle."
(let ((out (assoc-ref outputs "out")))
(match lisp
(let ((out (library-output outputs)))
(match (%lisp-type)
("sbcl"
(for-each
(lambda (file)
@ -219,10 +196,9 @@ implementation itself provides."
("ecl"
(for-each delete-file
(append (find-files out "\\.fas$")
(find-files out "\\.o$")
(find-files out "\\.a$")))))
(find-files out "\\.o$")))))
(with-directory-excursion (library-directory out lisp)
(with-directory-excursion (library-directory out)
(for-each
(lambda (file)
(rename-file file
@ -237,9 +213,9 @@ implementation itself provides."
(string<> ".." file)))))))
#t)
(define* (strip #:key lisp #:allow-other-keys #:rest args)
(define* (strip #:rest args)
;; stripping sbcl binaries removes their entry program and extra systems
(or (string=? lisp "sbcl")
(or (string=? (%lisp-type) "sbcl")
(apply (assoc-ref gnu:%standard-phases 'strip) args)))
(define %standard-phases/source
@ -257,8 +233,8 @@ implementation itself provides."
(add-before 'build 'copy-source copy-source)
(replace 'check check)
(replace 'strip strip)
(add-after 'check 'link-dependencies patch-asd-files)
(add-after 'link-dependencies 'cleanup cleanup-files)
(add-after 'check 'create-asd-file create-asd-file)
(add-after 'create-asd-file 'cleanup cleanup-files)
(add-after 'cleanup 'create-symlinks symlink-asd-files)))
(define* (asdf-build #:key inputs

370
guix/build/lisp-utils.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,13 +18,15 @@
(define-module (guix build lisp-utils)
#:use-module (ice-9 format)
#:use-module (ice-9 hash-table)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (guix build utils)
#:export (%lisp
%install-prefix
%lisp-type
%source-install-prefix
lisp-eval-program
compile-system
test-system
@ -32,15 +34,16 @@
generate-executable-wrapper-system
generate-executable-entry-point
generate-executable-for-system
patch-asd-file
bundle-install-prefix
lisp-dependencies
%bundle-install-prefix
bundle-asd-file
remove-lisp-from-name
wrap-output-translations
prepend-to-source-registry
build-program
build-image))
build-image
make-asd-file
valid-char-set
normalize-string
library-output))
;;; Commentary:
;;;
@ -54,102 +57,164 @@
;; File name of the Lisp compiler.
(make-parameter "lisp"))
(define %install-prefix "/share/common-lisp")
(define %lisp-type
;; String representing the class of implementation being used.
(make-parameter "lisp"))
(define (bundle-install-prefix lisp)
(string-append %install-prefix "/" lisp "-bundle-systems"))
;; The common parent for Lisp source files, as will as the symbolic
;; link farm for system definition (.asd) files.
(define %source-install-prefix "/share/common-lisp")
(define (remove-lisp-from-name name lisp)
(string-drop name (1+ (string-length lisp))))
(define (%bundle-install-prefix)
(string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
(define (library-output outputs)
"If a `lib' output exists, build things there. Otherwise use `out'."
(or (assoc-ref outputs "lib") (assoc-ref outputs "out")))
;; See nix/libstore/store-api.cc#checkStoreName.
(define valid-char-set
(string->char-set
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
(define (normalize-string str)
"Replace invalid characters in STR with a hyphen."
(string-join (string-tokenize str valid-char-set) "-"))
(define (inputs->asd-file-map inputs)
"Produce a hash table of the form (system . asd-file), where system is the
name of an ASD system, and asd-file is the full path to its definition."
(alist->hash-table
(filter-map
(match-lambda
((_ . path)
(let ((prefix (string-append path (%bundle-install-prefix))))
(and (directory-exists? prefix)
(match (find-files prefix "\\.asd$")
((asd-file)
(cons
(string-drop-right (basename asd-file) 4) ; drop ".asd"
asd-file))
(_ #f))))))
inputs)))
(define (wrap-output-translations translations)
`(:output-translations
,@translations
:inherit-configuration))
(define (lisp-eval-program lisp program)
(define (lisp-eval-program program)
"Evaluate PROGRAM with a given LISP implementation."
(unless (zero? (apply system*
(lisp-invoke lisp (format #f "~S" program))))
(error "lisp-eval-program failed!" lisp program)))
(lisp-invocation program)))
(error "lisp-eval-program failed!" (%lisp) program)))
(define (lisp-invoke lisp program)
(define (spread-statements program argument-name)
"Return a list with the statements from PROGRAM spread between
ARGUMENT-NAME, a string representing the argument a lisp implementation uses
to accept statements to be evaluated before starting."
(append-map (lambda (statement)
(list argument-name (format #f "~S" statement)))
program))
(define (lisp-invocation program)
"Return a list of arguments for system* determining how to invoke LISP
with PROGRAM."
(match lisp
("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program))
("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)"))))
(match (%lisp-type)
("sbcl" `(,(%lisp) "--non-interactive"
,@(spread-statements program "--eval")))
("ecl" `(,(%lisp)
,@(spread-statements program "--eval")
"--eval" "(quit)"))
(_ (error "The LISP provided is not supported at this time."))))
(define (asdf-load-all systems)
(map (lambda (system)
`(funcall
(find-symbol
(symbol-name :load-system)
(symbol-name :asdf))
,system))
`(asdf:load-system ,system))
systems))
(define (compile-system system lisp asd-file)
(define (compile-system system asd-file)
"Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE
first if SYSTEM is defined there."
(lisp-eval-program lisp
`(progn
(require :asdf)
(in-package :asdf)
,@(if asd-file
`((load ,asd-file))
'())
(in-package :cl-user)
(funcall (find-symbol
(symbol-name :operate)
(symbol-name :asdf))
(find-symbol
(symbol-name :compile-bundle-op)
(symbol-name :asdf))
,system)
(funcall (find-symbol
(symbol-name :operate)
(symbol-name :asdf))
(find-symbol
(symbol-name :deliver-asd-op)
(symbol-name :asdf))
,system))))
first."
(lisp-eval-program
`((require :asdf)
(let ((*package* (find-package :asdf)))
(load ,asd-file))
(asdf:operate 'asdf:compile-bundle-op ,system))))
(define (test-system system lisp asd-file)
"Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first
if SYSTEM is defined there."
(lisp-eval-program lisp
`(progn
(require :asdf)
(in-package :asdf)
,@(if asd-file
`((load ,asd-file))
'())
(in-package :cl-user)
(funcall (find-symbol
(symbol-name :test-system)
(symbol-name :asdf))
,system))))
(define (system-dependencies system asd-file)
"Return the dependencies of SYSTEM, as reported by
asdf:system-depends-on. First load the system's ASD-FILE."
(define deps-file ".deps.sexp")
(define program
`((require :asdf)
(let ((*package* (find-package :asdf)))
(load ,asd-file))
(with-open-file
(stream ,deps-file :direction :output)
(format stream
"~s~%"
(asdf:system-depends-on
(asdf:find-system ,system))))))
(dynamic-wind
(lambda _
(lisp-eval-program program))
(lambda _
(call-with-input-file deps-file read))
(lambda _
(when (file-exists? deps-file)
(delete-file deps-file)))))
(define (compiled-system system)
(let ((system (basename system))) ; this is how asdf handles slashes
(match (%lisp-type)
("sbcl" (string-append system "--system"))
(_ system))))
(define* (generate-system-definition system
#:key version dependencies)
`(asdf:defsystem
,(normalize-string system)
:class asdf/bundle:prebuilt-system
:version ,version
:depends-on ,dependencies
:components ((:compiled-file ,(compiled-system system)))
,@(if (string=? "ecl" (%lisp-type))
`(:lib ,(string-append system ".a"))
'())))
(define (test-system system asd-file test-asd-file)
"Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first.
Also load TEST-ASD-FILE if necessary."
(lisp-eval-program
`((require :asdf)
(let ((*package* (find-package :asdf)))
(load ,asd-file)
,@(if test-asd-file
`((load ,test-asd-file))
;; Try some likely files.
(map (lambda (file)
`(when (uiop:file-exists-p ,file)
(load ,file)))
(list
(string-append system "-tests.asd")
(string-append system "-test.asd")
"tests.asd"
"test.asd"))))
(asdf:test-system ,system))))
(define (string->lisp-keyword . strings)
"Return a lisp keyword for the concatenation of STRINGS."
(string->symbol (apply string-append ":" strings)))
(define (generate-executable-for-system type system lisp)
"Use LISP to generate an executable, whose TYPE can be \"image\" or
\"program\". The latter will always be standalone. Depends on having created
a \"SYSTEM-exec\" system which contains the entry program."
(define (generate-executable-for-system type system)
"Use LISP to generate an executable, whose TYPE can be 'asdf:image-op or
'asdf:program-op. The latter will always be standalone. Depends on having
created a \"SYSTEM-exec\" system which contains the entry program."
(lisp-eval-program
lisp
`(progn
(require :asdf)
(funcall (find-symbol
(symbol-name :operate)
(symbol-name :asdf))
(find-symbol
(symbol-name ,(string->lisp-keyword type "-op"))
(symbol-name :asdf))
,(string-append system "-exec")))))
`((require :asdf)
(asdf:operate ',type ,(string-append system "-exec")))))
(define (generate-executable-wrapper-system system dependencies)
"Generates a system which can be used by asdf to produce an image or program
@ -183,65 +248,59 @@ ENTRY-PROGRAM for SYSTEM within the current directory."
(declare (ignorable arguments))
,@entry-program))))))))
(define (wrap-perform-method lisp registry dependencies file-name)
"Creates a wrapper method which allows the system to locate its dependent
systems from REGISTRY, an alist of the same form as %outputs, which contains
lisp systems which the systems is dependent on. All DEPENDENCIES which the
system depends on will the be loaded before this system."
(let* ((system (string-drop-right (basename file-name) 4))
(system-symbol (string->lisp-keyword system)))
(define (generate-dependency-links registry system)
"Creates a program which populates asdf's source registry from REGISTRY, an
alist of dependency names to corresponding asd files. This allows the system
to locate its dependent systems."
`(progn
(asdf/source-registry:ensure-source-registry)
,@(map (match-lambda
((name . asd-file)
`(setf
(gethash ,name
asdf/source-registry:*source-registry*)
,(string->symbol "#p")
,asd-file)))
registry)))
`(defmethod asdf:perform :before
(op (c (eql (asdf:find-system ,system-symbol))))
(asdf/source-registry:ensure-source-registry)
,@(map (match-lambda
((name . path)
(let ((asd-file (string-append path
(bundle-install-prefix lisp)
"/" name ".asd")))
`(setf
(gethash ,name
asdf/source-registry:*source-registry*)
,(string->symbol "#p")
,(bundle-asd-file path asd-file lisp)))))
registry)
,@(map (lambda (system)
`(asdf:load-system ,(string->lisp-keyword system)))
dependencies))))
(define* (make-asd-file asd-file
#:key system version inputs
(system-asd-file #f))
"Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(define dependencies
(let ((deps
(system-dependencies system system-asd-file)))
(if (eq? 'NIL deps)
'()
(map normalize-string deps))))
(define (patch-asd-file asd-file registry lisp dependencies)
"Patches ASD-FILE with a perform method as described in WRAP-PERFORM-METHOD."
(chmod asd-file #o644)
(let ((port (open-file asd-file "a")))
(dynamic-wind
(lambda _ #t)
(lambda _
(display
(replace-escaped-macros
(format #f "~%~y~%"
(wrap-perform-method lisp registry
dependencies asd-file)))
port))
(lambda _ (close-port port))))
(chmod asd-file #o444))
(define lisp-input-map
(inputs->asd-file-map inputs))
(define (lisp-dependencies lisp inputs)
"Determine which inputs are lisp system dependencies, by using the convention
that a lisp system dependency will resemble \"system-LISP\"."
(filter-map (match-lambda
((name . value)
(and (string-prefix? lisp name)
(string<> lisp name)
`(,(remove-lisp-from-name name lisp)
. ,value))))
inputs))
(define registry
(filter-map hash-get-handle
(make-list (length dependencies)
lisp-input-map)
dependencies))
(define (bundle-asd-file output-path original-asd-file lisp)
(call-with-output-file asd-file
(lambda (port)
(display
(replace-escaped-macros
(format #f "~y~%~y~%"
(generate-system-definition system
#:version version
#:dependencies dependencies)
(generate-dependency-links registry system)))
port))))
(define (bundle-asd-file output-path original-asd-file)
"Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in
OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd. Returns two
values: the asd file itself and the directory in which it resides."
(let ((bundle-asd-path (string-append output-path
(bundle-install-prefix lisp))))
(%bundle-install-prefix))))
(values (string-append bundle-asd-path "/" (basename original-asd-file))
bundle-asd-path)))
@ -256,19 +315,22 @@ which are not nested."
(setenv "CL_SOURCE_REGISTRY"
(string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") ""))))
(define* (build-program lisp program #:key inputs
(define* (build-program program outputs #:key
(dependency-prefixes (list (library-output outputs)))
(dependencies (list (basename program)))
entry-program
#:allow-other-keys)
"Generate an executable program containing all DEPENDENCIES, and which will
execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it
will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments'
has been bound to the command-line arguments which were passed."
(generate-executable lisp program
#:inputs inputs
has been bound to the command-line arguments which were passed. Link in any
asd files from DEPENDENCY-PREFIXES to ensure references to those libraries are
retained."
(generate-executable program
#:dependencies dependencies
#:dependency-prefixes dependency-prefixes
#:entry-program entry-program
#:type "program")
#:type 'asdf:program-op)
(let* ((name (basename program))
(bin-directory (dirname program)))
(with-directory-excursion bin-directory
@ -276,16 +338,18 @@ has been bound to the command-line arguments which were passed."
name)))
#t)
(define* (build-image lisp image #:key inputs
(define* (build-image image outputs #:key
(dependency-prefixes (list (library-output outputs)))
(dependencies (list (basename image)))
#:allow-other-keys)
"Generate an image, possibly standalone, which contains all DEPENDENCIES,
placing the result in IMAGE.image."
(generate-executable lisp image
#:inputs inputs
placing the result in IMAGE.image. Link in any asd files from
DEPENDENCY-PREFIXES to ensure references to those libraries are retained."
(generate-executable image
#:dependencies dependencies
#:dependency-prefixes dependency-prefixes
#:entry-program '(nil)
#:type "image")
#:type 'asdf:image-op)
(let* ((name (basename image))
(bin-directory (dirname image)))
(with-directory-excursion bin-directory
@ -293,14 +357,16 @@ placing the result in IMAGE.image."
(string-append name ".image"))))
#t)
(define* (generate-executable lisp out-file #:key inputs
(define* (generate-executable out-file #:key
dependencies
dependency-prefixes
entry-program
type
#:allow-other-keys)
"Generate an executable by using asdf's TYPE-op, containing whithin the
"Generate an executable by using asdf operation TYPE, containing whithin the
image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an
executable."
executable. Link in any asd files from DEPENDENCY-PREFIXES to ensure
references to those libraries are retained."
(let* ((bin-directory (dirname out-file))
(name (basename out-file)))
(mkdir-p bin-directory)
@ -319,9 +385,25 @@ executable."
`(((,bin-directory :**/ :*.*.*)
(,bin-directory :**/ :*.*.*)))))))
(parameterize ((%lisp (string-append
(assoc-ref inputs lisp) "/bin/" lisp)))
(generate-executable-for-system type name lisp))
(generate-executable-for-system type name)
(let* ((after-store-prefix-index
(string-index out-file #\/
(1+ (string-length (%store-directory)))))
(output (string-take out-file after-store-prefix-index))
(hidden-asd-links (string-append output "/.asd-files")))
(mkdir-p hidden-asd-links)
(for-each
(lambda (path)
(for-each
(lambda (asd-file)
(symlink asd-file
(string-append hidden-asd-links
"/" (basename asd-file))))
(find-files (string-append path (%bundle-install-prefix))
"\\.asd$")))
dependency-prefixes))
(delete-file (string-append bin-directory "/" name "-exec.asd"))
(delete-file (string-append bin-directory "/" name "-exec.lisp"))))

43
guix/build/union.scm
View file

@ -47,31 +47,34 @@
(loop (cons file files)))))))
(define (file-is-directory? file)
(eq? 'directory (stat:type (stat file))))
(match (stat file #f)
(#f #f) ;maybe a dangling symlink
(st (eq? 'directory (stat:type st)))))
(define (file=? file1 file2)
"Return #t if FILE1 and FILE2 are regular files and their contents are
identical, #f otherwise."
(let ((st1 (stat file1))
(st2 (stat file2)))
(let ((st1 (stat file1 #f))
(st2 (stat file2 #f)))
;; When deduplication is enabled, identical files share the same inode.
(or (= (stat:ino st1) (stat:ino st2))
(and (eq? (stat:type st1) 'regular)
(eq? (stat:type st2) 'regular)
(= (stat:size st1) (stat:size st2))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop)))))))))))))
(and st1 st2
(or (= (stat:ino st1) (stat:ino st2))
(and (eq? (stat:type st1) 'regular)
(eq? (stat:type st2) 'regular)
(= (stat:size st1) (stat:size st2))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop))))))))))))))
(define* (union-build output inputs
#:key (log-port (current-error-port))

3
guix/download.scm
View file

@ -213,7 +213,6 @@
;; mirrors keeping old versions at the top level
"ftp://sunsite.icm.edu.pl/packages/ImageMagick/"
;; mirrors moving old versions to "legacy"
"http://mirrors-au.go-parts.com/mirrors/ImageMagick/"
"ftp://mirror.aarnet.edu.au/pub/imagemagick/"
"http://mirror.checkdomain.de/imagemagick/"
"ftp://ftp.kddlabs.co.jp/graphics/ImageMagick/"
@ -222,9 +221,7 @@
"http://ftp.surfnet.nl/pub/ImageMagick/"
"http://mirror.searchdaimon.com/ImageMagick"
"ftp://ftp.tpnet.pl/pub/graphics/ImageMagick/"
"http://mirrors-ru.go-parts.com/mirrors/ImageMagick/"
"http://mirror.is.co.za/pub/imagemagick/"
"http://mirrors-uk.go-parts.com/mirrors/ImageMagick/"
"http://mirrors-usa.go-parts.com/mirrors/ImageMagick/"
"ftp://ftp.fifi.org/pub/ImageMagick/"
"http://www.imagemagick.org/download/"

101
guix/import/cran.scm
View file

@ -45,7 +45,12 @@
bioconductor->guix-package
recursive-import
%cran-updater
%bioconductor-updater))
%bioconductor-updater
cran-package?
bioconductor-package?
bioconductor-data-package?
bioconductor-experiment-package?))
;;; Commentary:
;;;
@ -125,17 +130,19 @@ package definition."
;; The latest Bioconductor release is 3.5. Bioconductor packages should be
;; updated together.
(define %bioconductor-svn-url
(string-append "https://readonly:readonly@"
"hedgehog.fhcrc.org/bioconductor/branches/RELEASE_3_5/"
"madman/Rpacks/"))
(define (bioconductor-mirror-url name)
(string-append "https://raw.githubusercontent.com/Bioconductor-mirror/"
name "/release-3.5"))
(define (fetch-description base-url name)
(define (fetch-description repository name)
"Return an alist of the contents of the DESCRIPTION file for the R package
NAME, or #f in case of failure. NAME is case-sensitive."
NAME in the given REPOSITORY, or #f in case of failure. NAME is
case-sensitive."
;; This API always returns the latest release of the module.
(let ((url (string-append base-url name "/DESCRIPTION")))
(let ((url (string-append (case repository
((cran) (string-append %cran-url name))
((bioconductor) (bioconductor-mirror-url name)))
"/DESCRIPTION")))
(guard (c ((http-get-error? c)
(format (current-error-port)
"error: failed to retrieve package information \
@ -200,17 +207,16 @@ empty list when the FIELD cannot be found."
(check "*.f95")
(check "*.f")))
(define (needs-zlib? tarball)
"Return #T if any of the Makevars files in the src directory of the TARBALL
contain a zlib linker flag."
(define (tarball-files-match-pattern? tarball regexp . file-patterns)
"Return #T if any of the files represented by FILE-PATTERNS in the TARBALL
match the given REGEXP."
(call-with-temporary-directory
(lambda (dir)
(let ((pattern (make-regexp "-lz")))
(let ((pattern (make-regexp regexp)))
(parameterize ((current-error-port (%make-void-port "rw+")))
(system* "tar"
"xf" tarball "-C" dir
"--wildcards"
"*/src/Makevars*" "*/src/configure*" "*/configure*"))
(apply system* "tar"
"xf" tarball "-C" dir
`("--wildcards" ,@file-patterns)))
(any (lambda (file)
(call-with-input-file file
(lambda (port)
@ -219,10 +225,23 @@ contain a zlib linker flag."
(cond
((eof-object? line) #f)
((regexp-exec pattern line) #t)
(else (loop)))))))
#t)
(else (loop))))))))
(find-files dir))))))
(define (needs-zlib? tarball)
"Return #T if any of the Makevars files in the src directory of the TARBALL
contain a zlib linker flag."
(tarball-files-match-pattern?
tarball "-lz"
"*/src/Makevars*" "*/src/configure*" "*/configure*"))
(define (needs-pkg-config? tarball)
"Return #T if any of the Makevars files in the src directory of the TARBALL
reference the pkg-config tool."
(tarball-files-match-pattern?
tarball "pkg-config"
"*/src/Makevars*" "*/src/configure*" "*/configure*"))
(define (description->package repository meta)
"Return the `package' s-expression for an R package published on REPOSITORY
from the alist META, which was derived from the R package's DESCRIPTION file."
@ -272,11 +291,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(build-system r-build-system)
,@(maybe-inputs sysdepends)
,@(maybe-inputs (map guix-name propagate) 'propagated-inputs)
,@(if (needs-fortran? tarball)
`((native-inputs (,'quasiquote
,(list "gfortran"
(list 'unquote 'gfortran)))))
'())
,@(maybe-inputs
`(,@(if (needs-fortran? tarball)
'("gfortran") '())
,@(if (needs-pkg-config? tarball)
'("pkg-config") '()))
'native-inputs)
(home-page ,(if (string-null? home-page)
(string-append base-url name)
home-page))
@ -291,11 +311,8 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(lambda* (package-name #:optional (repo 'cran))
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
(let* ((url (case repo
((cran) %cran-url)
((bioconductor) %bioconductor-svn-url)))
(module-meta (fetch-description url package-name)))
(and=> module-meta (cut description->package repo <>))))))
(and=> (fetch-description repo package-name)
(cut description->package repo <>)))))
(define* (recursive-import package-name #:optional (repo 'cran))
"Generate a stream of package expressions for PACKAGE-NAME and all its
@ -386,7 +403,7 @@ dependencies."
(package->upstream-name package))
(define meta
(fetch-description %cran-url upstream-name))
(fetch-description 'cran upstream-name))
(and meta
(let ((version (assoc-ref meta "Version")))
@ -403,7 +420,7 @@ dependencies."
(package->upstream-name package))
(define meta
(fetch-description %bioconductor-svn-url upstream-name))
(fetch-description 'bioconductor upstream-name))
(and meta
(let ((version (assoc-ref meta "Version")))
@ -430,8 +447,13 @@ dependencies."
"Return true if PACKAGE is an R package from Bioconductor."
(let ((predicate (lambda (uri)
(and (string-prefix? "http://bioconductor.org" uri)
;; Data packages are not listed in SVN
(not (string-contains uri "/data/annotation/"))))))
;; Data packages are neither listed in SVN nor on
;; the Github mirror, so we have to exclude them
;; from the set of bioconductor packages that can be
;; updated automatically.
(not (string-contains uri "/data/annotation/"))
;; Experiment packages are in a separate repository.
(not (string-contains uri "/data/experiment/"))))))
(and (string-prefix? "r-" (package-name package))
(match (and=> (package-source package) origin-uri)
((? string? uri)
@ -453,6 +475,19 @@ dependencies."
(any predicate uris))
(_ #f)))))
(define (bioconductor-experiment-package? package)
"Return true if PACKAGE is an R experiment package from Bioconductor."
(let ((predicate (lambda (uri)
(and (string-prefix? "http://bioconductor.org" uri)
(string-contains uri "/data/experiment/")))))
(and (string-prefix? "r-" (package-name package))
(match (and=> (package-source package) origin-uri)
((? string? uri)
(predicate uri))
((? list? uris)
(any predicate uris))
(_ #f)))))
(define %cran-updater
(upstream-updater
(name 'cran)

6
guix/licenses.scm
View file

@ -43,6 +43,7 @@
artistic2.0 clarified-artistic
copyleft-next
cpl1.0
edl1.0
epl1.0
expat
freetype
@ -231,6 +232,11 @@ at URI, which may be a file:// URI pointing the package's tree."
"http://directory.fsf.org/wiki/License:CPLv1.0"
"https://www.gnu.org/licenses/license-list#CommonPublicLicense10"))
(define edl1.0
(license "EDL 1.0"
"http://directory.fsf.org/wiki/License:EDLv1.0"
"https://eclipse.org/org/documents/edl-v10.php"))
(define epl1.0
(license "EPL 1.0"
"http://directory.fsf.org/wiki/License:EPLv1.0"

11
guix/modules.scm
View file

@ -95,11 +95,16 @@ depends on."
(('gnu _ ...) #t)
(_ #f)))
(define %source-less-modules
;; These are modules that have no corresponding source files or a source
;; file different from what you'd expect.
'((system syntax) ;2.0, defined in boot-9
(ice-9 ports internal) ;2.2, defined in (ice-9 ports)
(system syntax internal))) ;2.2, defined in boot-9
(define* (source-module-dependencies module #:optional (load-path %load-path))
"Return the modules used by MODULE by looking at its source code."
;; The (system syntax) module is a special-case because it has no
;; corresponding source file (as of Guile 2.0.)
(if (equal? module '(system syntax))
(if (member module %source-less-modules)
'()
(module-file-dependencies
(search-path load-path

18
guix/profiles.scm
View file

@ -957,6 +957,7 @@ the entries in MANIFEST."
#~(begin
(use-modules (guix build utils)
(srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26))
(define entries
@ -1011,16 +1012,23 @@ the entries in MANIFEST."
(mkdir-p man-directory)
(setenv "MANPATH" (string-join entries ":"))
(format #t "creating manual page database for ~a packages...~%"
(format #t "Creating manual page database for ~a packages... "
(length entries))
(force-output)
(zero? (system* #+(file-append man-db "/bin/mandb")
"--quiet" "--create"
"-C" "man_db.conf"))))
(let* ((start-time (current-time))
(exit-status (system* #+(file-append man-db "/bin/mandb")
"--quiet" "--create"
"-C" "man_db.conf"))
(duration (time-difference (current-time) start-time)))
(format #t "done in ~,3f s~%"
(+ (time-second duration)
(* (time-nanosecond duration) (expt 10 -9))))
(force-output)
(zero? exit-status))))
(gexp->derivation "manual-database" build
#:modules '((guix build utils)
(srfi srfi-19)
(srfi srfi-26))
#:local-build? #t))

3
guix/scripts/lint.scm
View file

@ -255,7 +255,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
;; native inputs.
(let ((inputs (package-inputs package))
(input-names
'("pkg-config"
'("pkg-config"
"cmake"
"extra-cmake-modules"
"glib:bin"
"intltool"

11
guix/scripts/pack.scm
View file

@ -35,7 +35,7 @@
#:autoload (gnu packages base) (tar)
#:autoload (gnu packages package-management) (guix)
#:autoload (gnu packages gnupg) (libgcrypt)
#:autoload (gnu packages guile) (guile-json)
#:autoload (gnu packages guile) (guile2.0-json guile-json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-37)
@ -217,6 +217,13 @@ the image."
(define %libgcrypt
#+(file-append libgcrypt "/lib/libgcrypt"))))))
(define json
;; Pick the guile-json package that corresponds to the Guile used to build
;; derivations.
(if (string-prefix? "2.0" (package-version (default-guile)))
guile2.0-json
guile-json))
(define build
(with-imported-modules `(,@(source-module-closure '((guix docker))
#:select? not-config?)
@ -224,7 +231,7 @@ the image."
#~(begin
;; Guile-JSON is required by (guix docker).
(add-to-load-path
(string-append #$guile-json "/share/guile/site/"
(string-append #+json "/share/guile/site/"
(effective-version)))
(use-modules (guix docker) (srfi srfi-19))

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