Merge branch 'master' into staging

master
Marius Bakke 2017-04-18 18:30:13 +02:00
commit 8c4b4b6562
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
77 changed files with 1185 additions and 790 deletions

View File

@ -7413,7 +7413,7 @@ guix system init /mnt/etc/config.scm /mnt
@noindent @noindent
This copies all the necessary files and installs GRUB on This copies all the necessary files and installs GRUB on
@file{/dev/sdX}, unless you pass the @option{--no-grub} option. For @file{/dev/sdX}, unless you pass the @option{--no-bootloader} option. For
more information, @pxref{Invoking guix system}. This command may trigger more information, @pxref{Invoking guix system}. This command may trigger
downloads or builds of missing packages, which can take some time. downloads or builds of missing packages, which can take some time.
@ -9066,9 +9066,9 @@ This service is not part of @var{%base-services}.
@end deffn @end deffn
@anchor{guix-publish-service-type} @anchor{guix-publish-service-type}
@deffn {Scheme Variable} guix-publish-service-type @var{config} @deffn {Scheme Variable} guix-publish-service-type
This is the service type for @command{guix publish} (@pxref{Invoking This is the service type for @command{guix publish} (@pxref{Invoking
guix publish}). @var{config} must be a @code{guix-configuration} guix publish}). Its value must be a @code{guix-configuration}
object, as described below. object, as described below.
This assumes that @file{/etc/guix} already contains a signing key pair as This assumes that @file{/etc/guix} already contains a signing key pair as
@ -9256,7 +9256,7 @@ with the default settings.
(operating-system (operating-system
;; @dots{} ;; @dots{}
(services (cons* (mcron-service) (services (cons* (mcron-service)
(service rottlog-service-type (rottlog-configuration)) (service rottlog-service-type)
%base-services))) %base-services)))
@end lisp @end lisp
@ -9433,10 +9433,9 @@ The value of this service is the @code{wpa-supplicant} package to use.
Thus, it can be instantiated like this: Thus, it can be instantiated like this:
@lisp @lisp
(use-modules (gnu services networking) (use-modules (gnu services networking))
(gnu packages admin))
(service wpa-supplicant-service-type wpa-supplicant) (service wpa-supplicant-service-type)
@end lisp @end lisp
@end defvr @end defvr
@ -10044,9 +10043,10 @@ system, add a @code{cups-service} to the operating system definition:
@deffn {Scheme Variable} cups-service-type @deffn {Scheme Variable} cups-service-type
The service type for the CUPS print server. Its value should be a valid The service type for the CUPS print server. Its value should be a valid
CUPS configuration (see below). For example: CUPS configuration (see below). To use the default settings, simply
write:
@example @example
(service cups-service-type (cups-configuration)) (service cups-service-type)
@end example @end example
@end deffn @end deffn
@ -13874,9 +13874,10 @@ source is detected. More information can be found at
@deffn {Scheme Variable} tlp-service-type @deffn {Scheme Variable} tlp-service-type
The service type for the TLP tool. Its value should be a valid The service type for the TLP tool. Its value should be a valid
TLP configuration (see below). For example: TLP configuration (see below). To use the default settings, simply
write:
@example @example
(service tlp-service-type (tlp-configuration)) (service tlp-service-type)
@end example @end example
@end deffn @end deffn
@ -15093,7 +15094,7 @@ overwritten. This behavior mirrors that of @command{guix package}
It also adds a GRUB menu entry for the new OS configuration, and moves It also adds a GRUB menu entry for the new OS configuration, and moves
entries for older configurations to a submenu---unless entries for older configurations to a submenu---unless
@option{--no-grub} is passed. @option{--no-bootloader} is passed.
@quotation Note @quotation Note
@c The paragraph below refers to the problem discussed at @c The paragraph below refers to the problem discussed at
@ -15173,7 +15174,7 @@ needed for the system to operate correctly---e.g., the @file{/etc},
@file{/var}, and @file{/run} directories, and the @file{/bin/sh} file. @file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
This command also installs GRUB on the device specified in This command also installs GRUB on the device specified in
@file{my-os-config}, unless the @option{--no-grub} option was passed. @file{my-os-config}, unless the @option{--no-bootloader} option was passed.
@item vm @item vm
@cindex virtual machine @cindex virtual machine
@ -15555,11 +15556,12 @@ with a simple example, the service type for the Guix build daemon
(extensions (extensions
(list (service-extension shepherd-root-service-type guix-shepherd-service) (list (service-extension shepherd-root-service-type guix-shepherd-service)
(service-extension account-service-type guix-accounts) (service-extension account-service-type guix-accounts)
(service-extension activation-service-type guix-activation))))) (service-extension activation-service-type guix-activation)))
(default-value (guix-configuration))))
@end example @end example
@noindent @noindent
It defines two things: It defines three things:
@enumerate @enumerate
@item @item
@ -15572,6 +15574,9 @@ service, returns a list of objects to extend the service of that type.
Every service type has at least one service extension. The only Every service type has at least one service extension. The only
exception is the @dfn{boot service type}, which is the ultimate service. exception is the @dfn{boot service type}, which is the ultimate service.
@item
Optionally, a default value for instances of this type.
@end enumerate @end enumerate
In this example, @var{guix-service-type} extends three services: In this example, @var{guix-service-type} extends three services:
@ -15607,7 +15612,13 @@ A service of this type is instantiated like this:
The second argument to the @code{service} form is a value representing The second argument to the @code{service} form is a value representing
the parameters of this specific service instance. the parameters of this specific service instance.
@xref{guix-configuration-type, @code{guix-configuration}}, for @xref{guix-configuration-type, @code{guix-configuration}}, for
information about the @code{guix-configuration} data type. information about the @code{guix-configuration} data type. When the
value is omitted, the default value specified by
@code{guix-service-type} is used:
@example
(service guix-service-type)
@end example
@var{guix-service-type} is quite simple because it extends other @var{guix-service-type} is quite simple because it extends other
services but is not extensible itself. services but is not extensible itself.
@ -15670,10 +15681,31 @@ Services}). This section provides a reference on how to manipulate
services and service types. This interface is provided by the services and service types. This interface is provided by the
@code{(gnu services)} module. @code{(gnu services)} module.
@deffn {Scheme Procedure} service @var{type} @var{value} @deffn {Scheme Procedure} service @var{type} [@var{value}]
Return a new service of @var{type}, a @code{<service-type>} object (see Return a new service of @var{type}, a @code{<service-type>} object (see
below.) @var{value} can be any object; it represents the parameters of below.) @var{value} can be any object; it represents the parameters of
this particular service instance. this particular service instance.
When @var{value} is omitted, the default value specified by @var{type}
is used; if @var{type} does not specify a default value, an error is
raised.
For instance, this:
@example
(service openssh-service-type)
@end example
@noindent
is equivalent to this:
@example
(service openssh-service-type
(openssh-configuration))
@end example
In both cases the result is an instance of @code{openssh-service-type}
with the default configuration.
@end deffn @end deffn
@deffn {Scheme Procedure} service? @var{obj} @deffn {Scheme Procedure} service? @var{obj}
@ -15684,7 +15716,7 @@ Return true if @var{obj} is a service.
Return the type of @var{service}---i.e., a @code{<service-type>} object. Return the type of @var{service}---i.e., a @code{<service-type>} object.
@end deffn @end deffn
@deffn {Scheme Procedure} service-parameters @var{service} @deffn {Scheme Procedure} service-value @var{service}
Return the value associated with @var{service}. It represents its Return the value associated with @var{service}. It represents its
parameters. parameters.
@end deffn @end deffn

View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -284,18 +285,18 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(unless register-closures? (unless register-closures?
(reset-timestamps target)))) (reset-timestamps target))))
(define (register-grub.cfg-root target grub.cfg) (define (register-grub.cfg-root target bootcfg)
"On file system TARGET, register GRUB.CFG as a GC root." "On file system TARGET, register BOOTCFG as a GC root."
(let ((directory (string-append target "/var/guix/gcroots"))) (let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory) (mkdir-p directory)
(symlink grub.cfg (string-append directory "/grub.cfg")))) (symlink bootcfg (string-append directory "/grub.cfg"))))
(define* (initialize-hard-disk device (define* (initialize-hard-disk device
#:key #:key
grub.cfg grub.cfg
(partitions '())) (partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed "Initialize DEVICE as a disk containing all the <partition> objects listed
in PARTITIONS, and using GRUB.CFG as its bootloader configuration file. in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
Each partition is initialized by calling its 'initializer' procedure, Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted." passing it a directory name where it is mounted."

View File

@ -512,6 +512,7 @@ dist_patch_DATA = \
%D%/packages/patches/calibre-no-updates-dialog.patch \ %D%/packages/patches/calibre-no-updates-dialog.patch \
%D%/packages/patches/cdparanoia-fpic.patch \ %D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/ceph-disable-cpu-optimizations.patch \ %D%/packages/patches/ceph-disable-cpu-optimizations.patch \
%D%/packages/patches/ceph-disable-unittest-throttle.patch \
%D%/packages/patches/ceph-skip-collect-sys-info-test.patch \ %D%/packages/patches/ceph-skip-collect-sys-info-test.patch \
%D%/packages/patches/ceph-skip-unittest_blockdev.patch \ %D%/packages/patches/ceph-skip-unittest_blockdev.patch \
%D%/packages/patches/chicken-CVE-2017-6949.patch \ %D%/packages/patches/chicken-CVE-2017-6949.patch \
@ -657,6 +658,7 @@ dist_patch_DATA = \
%D%/packages/patches/icu4c-CVE-2014-6585.patch \ %D%/packages/patches/icu4c-CVE-2014-6585.patch \
%D%/packages/patches/icu4c-CVE-2015-1270.patch \ %D%/packages/patches/icu4c-CVE-2015-1270.patch \
%D%/packages/patches/icu4c-CVE-2015-4760.patch \ %D%/packages/patches/icu4c-CVE-2015-4760.patch \
%D%/packages/patches/icu4c-reset-keyword-list-iterator.patch \
%D%/packages/patches/id3lib-CVE-2007-4460.patch \ %D%/packages/patches/id3lib-CVE-2007-4460.patch \
%D%/packages/patches/ilmbase-fix-tests.patch \ %D%/packages/patches/ilmbase-fix-tests.patch \
%D%/packages/patches/isl-0.11.1-aarch64-support.patch \ %D%/packages/patches/isl-0.11.1-aarch64-support.patch \
@ -786,10 +788,6 @@ dist_patch_DATA = \
%D%/packages/patches/multiqc-fix-git-subprocess-error.patch \ %D%/packages/patches/multiqc-fix-git-subprocess-error.patch \
%D%/packages/patches/mumps-build-parallelism.patch \ %D%/packages/patches/mumps-build-parallelism.patch \
%D%/packages/patches/mupdf-build-with-openjpeg-2.1.patch \ %D%/packages/patches/mupdf-build-with-openjpeg-2.1.patch \
%D%/packages/patches/mupdf-mujs-CVE-2016-10132.patch \
%D%/packages/patches/mupdf-mujs-CVE-2016-10133.patch \
%D%/packages/patches/mupdf-CVE-2017-5896.patch \
%D%/packages/patches/mupdf-CVE-2017-5991.patch \
%D%/packages/patches/mupen64plus-ui-console-notice.patch \ %D%/packages/patches/mupen64plus-ui-console-notice.patch \
%D%/packages/patches/musl-CVE-2016-8859.patch \ %D%/packages/patches/musl-CVE-2016-8859.patch \
%D%/packages/patches/mutt-store-references.patch \ %D%/packages/patches/mutt-store-references.patch \

View File

@ -1694,7 +1694,7 @@ throughput (in the same interval).")
(define-public thefuck (define-public thefuck
(package (package
(name "thefuck") (name "thefuck")
(version "3.15") (version "3.16")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/nvbn/thefuck/archive/" (uri (string-append "https://github.com/nvbn/thefuck/archive/"
@ -1702,7 +1702,7 @@ throughput (in the same interval).")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1vxas21h5mf41cb6y7f7x07858ags7qg45lkf74rc0slqbic3l1h")) "0jrhfxmj2asx4jdix9ks3fpl364ph8w9prhwpk4488aj1a0q4rak"))
(patches (search-patches "thefuck-test-environ.patch")))) (patches (search-patches "thefuck-test-environ.patch"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
@ -1763,7 +1763,7 @@ a new command using the matched rule, and runs it.")
"'di' is a disk information utility, displaying everything "'di' is a disk information utility, displaying everything
(and more) that your @code{df} command does. It features the ability to (and more) that your @code{df} command does. It features the ability to
display your disk usage in whatever format you prefer. It is designed to be display your disk usage in whatever format you prefer. It is designed to be
highly portable. Great for heterogenous networks.") highly portable. Great for heterogeneous networks.")
(license license:zlib))) (license license:zlib)))
(define-public cbatticon (define-public cbatticon

View File

@ -1,10 +1,11 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2016, 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages ed)
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages fltk) #:use-module (gnu packages fltk)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
@ -39,6 +41,7 @@
#:use-module (gnu packages readline) #:use-module (gnu packages readline)
#:use-module (gnu packages shells) #:use-module (gnu packages shells)
#:use-module (gnu packages tex) #:use-module (gnu packages tex)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages xiph) #:use-module (gnu packages xiph)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
@ -203,7 +206,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(define-public giac-xcas (define-public giac-xcas
(package (package
(name "giac-xcas") (name "giac-xcas")
(version "1.2.3-25") (version "1.2.3-37")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
;; "~parisse/giac" is not used because the maintainer regularly ;; "~parisse/giac" is not used because the maintainer regularly
@ -215,7 +218,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
"source/giac_" version ".tar.gz")) "source/giac_" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0d6a42p8111raf7k16yvjajnpj22abiqndy3yzkrb4b8l071r24d")))) "180146rm8fxlbd6x25x81yscf6q8qjpzr35k203r25c2xkcb7h2x"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -468,35 +471,21 @@ binary.")
(define-public bc (define-public bc
(package (package
(name "bc") (name "bc")
(version "1.06") (version "1.07.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/bc/bc-" version ".tar.gz")) (uri (string-append "mirror://gnu/bc/bc-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0cqf5jkwx6awgd2xc2a0mkpxilzcfmhncdcfg7c9439wgkqxkxjf")))) "0amh9ik44jfg66csyvf4zz1l878c4755kjndq9j0270akflgrbb2"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("readline" ,readline))) (inputs `(("readline" ,readline)))
(native-inputs `(("flex" ,flex))) (native-inputs
`(("ed" ,ed)
("flex" ,flex)
("texinfo" ,texinfo)))
(arguments (arguments
'(#:phases '(#:configure-flags
(alist-replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
;; This old `configure' script doesn't support
;; variables passed as arguments.
(let ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system*
"./configure"
(string-append "--prefix=" out)
;; By default, man and info pages are put in
;; PREFIX/{man,info}, but we want them in
;; PREFIX/share/{man,info}.
(string-append "--mandir=" out "/share/man")
(string-append "--infodir=" out "/share/info")))))
%standard-phases)
#:configure-flags
(list "--with-readline"))) (list "--with-readline")))
(home-page "https://www.gnu.org/software/bc/") (home-page "https://www.gnu.org/software/bc/")
(synopsis "Arbitrary precision numeric processing language") (synopsis "Arbitrary precision numeric processing language")

View File

@ -30,7 +30,7 @@
(define-public fio (define-public fio
(package (package
(name "fio") (name "fio")
(version "2.18") (version "2.19")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -38,7 +38,7 @@
"fio-" version ".tar.bz2")) "fio-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"08kx2mh556xby9saayrbynwrkmh4v8wwrw759nbv025ch3xbw79n")))) "0dwx2dpbsg3xyd8jzm64gazy6ij4zirlfdrbgcxr1a0z5smcmcw1"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:test-target "test" '(#:test-target "test"

View File

@ -5406,7 +5406,7 @@ data types as well.")
(home-page (home-page
"http://bioconductor.org/packages/annotate") "http://bioconductor.org/packages/annotate")
(synopsis "Annotation for microarrays") (synopsis "Annotation for microarrays")
(description "This package provides R enviroments for the annotation of (description "This package provides R environments for the annotation of
microarrays.") microarrays.")
(license license:artistic2.0))) (license license:artistic2.0)))

View File

@ -74,7 +74,7 @@
(define-public nss-certs (define-public nss-certs
(package (package
(name "nss-certs") (name "nss-certs")
(version "3.30.1") (version "3.30")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (let ((version-with-underscores (uri (let ((version-with-underscores
@ -85,7 +85,7 @@
"nss-" version ".tar.gz"))) "nss-" version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"1djypq081m22iw0wg0q7gnpndam5f8qjhqfd5v9by4c6l6lp78hz")))) "1agkkwb51si4raw46p44vl3d0l7wzvdjcblpcdjjz6aymq6h1h58"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out")) (outputs '("out"))
(native-inputs (native-inputs

View File

@ -576,9 +576,6 @@ types are supported, as is encryption.")
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:make-flags (list "CC=gcc" '(#:make-flags (list "CC=gcc"
;; Make the resulting library position-independent so the
;; static version can be included in shared objects.
"EXTRA_CXXFLAGS=-fPIC"
(string-append "INSTALL_PATH=" (string-append "INSTALL_PATH="
(assoc-ref %outputs "out"))) (assoc-ref %outputs "out")))
#:phases #:phases
@ -587,36 +584,31 @@ types are supported, as is encryption.")
(lambda _ (lambda _
(substitute* "Makefile" (substitute* "Makefile"
(("build_tools/gnu_parallel") "parallel") (("build_tools/gnu_parallel") "parallel")
;; Don't depend on the static library when installing.
(("install: install-static")
"install: install-shared")
(("#!/bin/sh") (string-append "#!" (which "sh")))) (("#!/bin/sh") (string-append "#!" (which "sh"))))
#t)) #t))
(delete 'configure) (delete 'configure)
(add-before 'check 'disable-failing-tests (add-before 'check 'disable-failing-tests
(lambda _ (lambda _
(substitute* "Makefile" (substitute* "Makefile"
;; This test fails with GCC-5 and is unmaintained.
;; https://github.com/facebook/rocksdb/issues/2148
(("^[[:blank:]]+spatial_db_test[[:blank:]]+\\\\") "\\")
;; These tests reliably fail due to "Too many open files". ;; These tests reliably fail due to "Too many open files".
(("^[[:blank:]]+env_test[[:blank:]]+\\\\") "\\") (("^[[:blank:]]+env_test[[:blank:]]+\\\\") "\\")
(("^[[:blank:]]+persistent_cache_test[[:blank:]]+\\\\") "\\")) (("^[[:blank:]]+persistent_cache_test[[:blank:]]+\\\\") "\\"))
#t)) #t))
(add-after (add-after 'check 'build-release-libraries
'check 'build-release-libraries ;; The default build target is a debug build for tests. The
;; The 'check' target depends on the default target which is compiled ;; install target depends on "shared_lib" and "static_lib"
;; with debug symbols. The 'install' target depends on shared and ;; targets for release builds so we build them here for clarity.
;; static release targets so we build them here for clarity. ;; TODO: Add debug output.
;; TODO: Add debug output. (lambda* (#:key (make-flags '()) #:allow-other-keys)
(lambda* (#:key (make-flags '()) #:allow-other-keys) ;; Prevent the build from adding machine-specific optimizations.
;; Prevent the build from adding machine-specific optimizations. (setenv "PORTABLE" "1")
;; This does not work if passed as a make flag... (zero? (apply system* "make" "shared_lib" make-flags)))))))
(setenv "PORTABLE" "1")
(and (zero? (apply system* "make" "static_lib" make-flags))
(zero? (apply system* "make" "shared_lib" make-flags)))))
(add-after 'install 'delete-static-library
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")))
(for-each (lambda (file)
(delete-file file))
(find-files lib "\\.l?a$"))
#t))))))
(native-inputs (native-inputs
`(("parallel" ,parallel) `(("parallel" ,parallel)
("perl" ,perl) ("perl" ,perl)

View File

@ -65,7 +65,7 @@ and heaps.")
"This library contains several hash-map implementations, similar in API "This library contains several hash-map implementations, similar in API
to SGI's @code{hash_map} class, but with different performance to SGI's @code{hash_map} class, but with different performance
characteristics. @code{sparse_hash_map} uses very little space overhead, 1-2 characteristics. @code{sparse_hash_map} uses very little space overhead, 1-2
bits per entry. @code{dense_hash_map} is very fast, particulary on lookup. bits per entry. @code{dense_hash_map} is very fast, particularly on lookup.
@code{sparse_hash_set} and @code{dense_hash_set} are the set versions of these @code{sparse_hash_set} and @code{dense_hash_set} are the set versions of these
routines. All these implementation use a hashtable with internal quadratic routines. All these implementation use a hashtable with internal quadratic
probing. This method is space-efficient -- there is no pointer overhead -- probing. This method is space-efficient -- there is no pointer overhead --

View File

@ -275,9 +275,9 @@ asynchronous fashion.")
(define-public yadifa (define-public yadifa
(package (package
(name "yadifa") (name "yadifa")
(version "2.2.3") (version "2.2.4")
(source (source
(let ((revision "6711")) (let ((revision "6924"))
(origin (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -285,7 +285,7 @@ asynchronous fashion.")
name "-" version "-" revision ".tar.gz")) name "-" version "-" revision ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0ikfm40gx0zjw3gnxsw3rn1k4wb8jacgklja3ygcj1knq6hy2zaa"))))) "060ydcfn9876bs6p5xi3p1k20ca547f4jck25r5x1hnxjlv7ss03")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("which" ,which))) `(("which" ,which)))
@ -377,7 +377,7 @@ Extensions} (DNSSEC).")
"/etc/bash_completion.d")))) "/etc/bash_completion.d"))))
(home-page "https://www.knot-dns.cz/") (home-page "https://www.knot-dns.cz/")
(synopsis "Authoritative DNS name server") (synopsis "Authoritative DNS name server")
(description "Knot DNS is an authorative name server for the @dfn{Domain (description "Knot DNS is an authoritative name server for the @dfn{Domain
Name System} (DNS), designed to meet the needs of root and @dfn{top-level Name System} (DNS), designed to meet the needs of root and @dfn{top-level
domain} (TLD) name servers. It is implemented as a threaded daemon and uses a domain} (TLD) name servers. It is implemented as a threaded daemon and uses a
number of programming techniques to improve speed. For example, the responder number of programming techniques to improve speed. For example, the responder

View File

@ -24,6 +24,7 @@
;;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2017 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2017 Kei Kebreau <kei@openmailbox.org>
;;; Copyright © 2017 George Clemmer <myglc2@gmail.com> ;;; Copyright © 2017 George Clemmer <myglc2@gmail.com>
;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -1207,6 +1208,28 @@ writing input files for TeX, LaTeX, ConTeXt, Texinfo, and docTeX using Emacs
or XEmacs.") or XEmacs.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-calfw
(package
(name "emacs-calfw")
(version "1.5")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/kiwanami/emacs-calfw/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"17ssg8gx66yp63nhygjq2r6kgl4h45cacmrxsxs9f0lrfcx37k0l"))))
(build-system emacs-build-system)
(home-page "https://github.com/kiwanami/emacs-calfw/")
(synopsis "Calendar framework for Emacs")
(description
"This package displays a calendar view with various shedule data in
the Emacs buffer.")
(license license:gpl3+)))
(define-public emacs-mmm-mode (define-public emacs-mmm-mode
(package (package
(name "emacs-mmm-mode") (name "emacs-mmm-mode")
@ -4037,10 +4060,10 @@ number on the left margin in Emacs.")
"0kdv10hrgqpskjh0zvpnzwlkn5bccnqxas62gkws6njln57bf8nl")))) "0kdv10hrgqpskjh0zvpnzwlkn5bccnqxas62gkws6njln57bf8nl"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://www.emacswiki.org/emacs/IdleHighlight") (home-page "https://www.emacswiki.org/emacs/IdleHighlight")
(synopsis "Highlights all occurences of the word the point is on") (synopsis "Highlights all occurrences of the word the point is on")
(description (description
"This Emacs package provides @code{idle-highlight-mode} that sets "This Emacs package provides @code{idle-highlight-mode} that sets
an idle timer to highlight all occurences in the buffer of the word under an idle timer to highlight all occurrences in the buffer of the word under
the point.") the point.")
(license license:gpl3+))) (license license:gpl3+)))
@ -4360,3 +4383,114 @@ commands are also offered as part of the AUCTeX package, but it is not
the same - CDLaTeX focuses on speediness for inserting LaTeX the same - CDLaTeX focuses on speediness for inserting LaTeX
constructs.") constructs.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-xelb
(package
(name "emacs-xelb")
(version "0.12")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/xelb-"
version ".tar"))
(sha256
(base32
"0i9n0f3ibj4a5pwcsvwrah9m0fz32m0x6a9wsmjn3li20v8pcb81"))))
(build-system emacs-build-system)
;; The following functions and variables needed by emacs-xelb are
;; not included in emacs-minimal:
;; x-display-screens, x-keysym-table, x-alt-keysym, x-meta-keysym
;; x-hyper-keysym, x-super-keysym, libxml-parse-xml-region
;; x-display-pixel-width, x-display-pixel-height
(arguments
`(#:emacs ,emacs
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'regenerate-el-files
(lambda* (#:key inputs #:allow-other-keys)
(zero? (system* "make"
(string-append "PROTO_PATH="
(assoc-ref inputs "xcb-proto")
"/share/xcb")
(string-append "EMACS_BIN="
(assoc-ref inputs "emacs")
"/bin/emacs -Q"))))))))
(native-inputs `(("xcb-proto" ,xcb-proto)))
(home-page "https://github.com/ch11ng/xelb")
(synopsis "X protocol Emacs Lisp binding")
(description "@code{emacs-xelb} is a pure Emacs Lisp implementation of the
X11 protocol based on the XML description files from the XCB project. It
features an object-oriented API and permits a certain degree of concurrency.
It should enable you to implement low-level X11 applications.")
(license license:gpl3+)))
(define-public emacs-exwm
(package
(name "emacs-exwm")
(version "0.13")
(synopsis "Emacs X window manager")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/exwm-"
version ".tar"))
(sha256
(base32
"0n1wzy6chh024r0yaywjbf7mdsrxs6hrfycv5v0ps0drf6q3zldc"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-xelb" ,emacs-xelb)))
(inputs
`(("xhost" ,xhost)
("dbus" ,dbus)))
;; The following functions and variables needed by emacs-exwm are
;; not included in emacs-minimal:
;; scroll-bar-mode, fringe-mode
;; x-display-pixel-width, x-display-pixel-height
(arguments
`(#:emacs ,emacs
#:phases
(modify-phases %standard-phases
(add-after 'build 'install-xsession
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(xsessions (string-append out "/share/xsessions"))
(bin (string-append out "/bin"))
(exwm-executable (string-append bin "/exwm")))
;; Add a .desktop file to xsessions
(mkdir-p xsessions)
(mkdir-p bin)
(with-output-to-file
(string-append xsessions "/exwm.desktop")
(lambda _
(format #t "[Desktop Entry]~@
Name=~a~@
Comment=~a~@
Exec=~a~@
TryExec=~@*~a~@
Type=Application~%" ,name ,synopsis exwm-executable)))
;; Add a shell wrapper to bin
;; Set DISPLAY variable to work around
;; https://github.com/ch11ng/exwm/issues/213
(with-output-to-file exwm-executable
(lambda _
(format #t "#!~a ~@
export DISPLAY=:0 ~@
~a +SI:localuser:$USER ~@
exec ~a --exit-with-session ~a --eval '~s' ~%"
(string-append (assoc-ref inputs "bash") "/bin/sh")
(string-append (assoc-ref inputs "xhost") "/bin/xhost")
(string-append (assoc-ref inputs "dbus") "/bin/dbus-launch")
(string-append (assoc-ref inputs "emacs") "/bin/emacs")
'(cond
((file-exists-p "~/.exwm")
(load-file "~/.exwm"))
((not (featurep 'exwm))
(require 'exwm)
(require 'exwm-config)
(exwm-config-default)
(message "exwm configuration not found. Falling back to default configuration..."))))))
(chmod exwm-executable #o555)
#t))))))
(home-page "https://github.com/ch11ng/exwm")
(description "EXWM is a full-featured tiling X window manager for Emacs
built on top of XELB.")
(license license:gpl3+)))

View File

@ -8,6 +8,7 @@
;;; Copyright © 2016, 2017 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2016, 2017 Kei Kebreau <kei@openmailbox.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Julian Graham <joolean@gmail.com> ;;; Copyright © 2016 Julian Graham <joolean@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -69,7 +70,7 @@
(define-public bullet (define-public bullet
(package (package
(name "bullet") (name "bullet")
(version "2.85.1") (version "2.86.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/bulletphysics/bullet3/" (uri (string-append "https://github.com/bulletphysics/bullet3/"
@ -77,7 +78,7 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0qpd37ws0xlxwy55dg058a5b4yw2jxiz09yyc3lc0frpa05pq5bf")))) "0nghzcl84p8di215p7xj0gy1hyy072hw2xk9cnmav9hv6bjb4n60"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:configure-flags (list (string-append '(#:configure-flags (list (string-append
@ -253,7 +254,7 @@ clone.")
("libjpeg" ,libjpeg) ("libjpeg" ,libjpeg)
("libsndfile" ,libsndfile) ("libsndfile" ,libsndfile)
("openal" ,openal))) ("openal" ,openal)))
(home-page "http://www.sfml-dev.org") (home-page "https://www.sfml-dev.org")
(synopsis "Simple and Fast Multimedia Library") (synopsis "Simple and Fast Multimedia Library")
(description (description
"SFML provides a simple interface to the various computer components, "SFML provides a simple interface to the various computer components,
@ -305,7 +306,7 @@ sounds from presets such as \"explosion\" or \"powerup\".")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://icculus.org/physfs/downloads/physfs-" "https://icculus.org/physfs/downloads/physfs-"
version ".tar.bz2")) version ".tar.bz2"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
@ -318,7 +319,7 @@ sounds from presets such as \"explosion\" or \"powerup\".")
`(("zlib" ,zlib))) `(("zlib" ,zlib)))
(native-inputs (native-inputs
`(("doxygen" ,doxygen))) `(("doxygen" ,doxygen)))
(home-page "http://icculus.org/physfs") (home-page "https://icculus.org/physfs")
(synopsis "File system abstraction library") (synopsis "File system abstraction library")
(description (description
"PhysicsFS is a library to provide abstract access to various archives. "PhysicsFS is a library to provide abstract access to various archives.
@ -510,7 +511,7 @@ etc.")
(description "Aseprite is a tool for creating 2D pixel art for video (description "Aseprite is a tool for creating 2D pixel art for video
games. In addition to basic pixel editing features, Aseprite can assist in games. In addition to basic pixel editing features, Aseprite can assist in
the creation of animations, tiled graphics, texture atlases, and more.") the creation of animations, tiled graphics, texture atlases, and more.")
(home-page "http://www.aseprite.org/") (home-page "https://www.aseprite.org/")
(license license:gpl2+))) (license license:gpl2+)))
(define-public qqwing (define-public qqwing
@ -655,7 +656,7 @@ interface (API).")
("libsmpeg" ,libsmpeg) ("libsmpeg" ,libsmpeg)
("portmidi" ,portmidi) ("portmidi" ,portmidi)
("v4l-utils" ,v4l-utils))) ("v4l-utils" ,v4l-utils)))
(home-page "http://www.pygame.org") (home-page "https://www.pygame.org")
(synopsis "SDL wrapper for Python") (synopsis "SDL wrapper for Python")
(description "Pygame is a set of Python modules designed for writing games. (description "Pygame is a set of Python modules designed for writing games.
Pygame adds functionality on top of the excellent SDL library. This allows you Pygame adds functionality on top of the excellent SDL library. This allows you

View File

@ -433,7 +433,7 @@ that beneath its ruins lay buried an ancient evil.")
(lambda _ (lambda _
(substitute* "acinclude.m4" (substitute* "acinclude.m4"
(("ncursesw5-config") "ncursesw6-config")) (("ncursesw5-config") "ncursesw6-config"))
(zero? (system* "sh" "autogen.sh"))))))) (zero? (system* "sh" "autogen.sh")))))))
(native-inputs (native-inputs
`(("autoconf" ,autoconf) `(("autoconf" ,autoconf)
("automake" ,automake))) ("automake" ,automake)))
@ -598,14 +598,14 @@ To that extent, it also includes a front-end for managing all of your D-Mods.")
(define freedink-data (define freedink-data
(package (package
(name "freedink-data") (name "freedink-data")
(version "1.08.20140901") (version "1.08.20170401")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/freedink/freedink-data-" (uri (string-append "mirror://gnu/freedink/freedink-data-"
version ".tar.gz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"04f1aa8gfz30qkgv7chjz5n1s8v5hbqs01h2113cq1ylm3isd5sp")))) "1zx7qywibhznj7bnz217404scr8dfh0xj24xjihnda5iapzz7lz8"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -1084,7 +1084,7 @@ either by Infocom or created using the Inform compiler.")
(define-public retroarch (define-public retroarch
(package (package
(name "retroarch") (name "retroarch")
(version "1.3.6") (version "1.5.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1092,7 +1092,7 @@ either by Infocom or created using the Inform compiler.")
version ".tar.gz")) version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 "1xar0wagcz50clwwkvjg4zq9m1sjqw47vw3xx44pisdj94g21m5y")))) (base32 "1rbdax3i33myg1v938pxy28117ihff2lml1ky6g70c8099fkirjx"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:tests? #f ; no tests '(#:tests? #f ; no tests

View File

@ -21,7 +21,7 @@
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; ;;;
@ -127,6 +127,7 @@
#:use-module (gnu packages fonts) #:use-module (gnu packages fonts)
#:use-module (gnu packages qemu) #:use-module (gnu packages qemu)
#:use-module (gnu packages zip) #:use-module (gnu packages zip)
#:use-module (gnu packages speech)
#:use-module (srfi srfi-1)) #:use-module (srfi srfi-1))
(define-public brasero (define-public brasero
@ -862,11 +863,11 @@ some form of information without getting in the user's way.")
(home-page "https://wiki.gnome.org/Libpeas") (home-page "https://wiki.gnome.org/Libpeas")
(synopsis "GObject plugin system") (synopsis "GObject plugin system")
(description (description
"Libpeas is a gobject-based plugins engine, and is targetted at giving "Libpeas is a gobject-based plugin engine, targeted at giving every
every application the chance to assume its own extensibility. It also has a application the chance to assume its own extensibility. It also has a set of
set of features including, but not limited to: multiple extension points; on features including, but not limited to: multiple extension points; on-demand
demand (lazy) programming language support for C, Python and JS; simplicity of (lazy) programming language support for C, Python and JS; simplicity of the
the API.") API.")
(license license:lgpl2.0+))) (license license:lgpl2.0+)))
(define-public gtkglext (define-public gtkglext
@ -6029,3 +6030,93 @@ for process dependencies, icons for processes, the ability to hide processes,
graphical time histories of CPU/memory/swap usage and the ability to graphical time histories of CPU/memory/swap usage and the ability to
kill/reinice processes.") kill/reinice processes.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public python-pyatspi
(package
(name "python-pyatspi")
(version "2.24.0")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnome/sources/pyatspi/"
(version-major+minor version)
"/pyatspi-" version ".tar.xz"))
(sha256
(base32
"14m6y27ziqc9f6339gjz49mlsk6mrsyg4bkj055cdzc7sfjlgvz7"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("python" ,python)
("python-pygobject" ,python-pygobject)))
(synopsis "Python client bindings for D-Bus AT-SPI")
(home-page "https://wiki.linuxfoundation.org/accessibility\
/atk/at-spi/at-spi_on_d-bus")
(description
"This package includes a python client library for the AT-SPI D-Bus
accessibility infrastructure.")
(license license:lgpl2.0)
(properties '((upstream-name . "pyatspi")))))
(define-public orca
(package
(name "orca")
(version "3.24.0")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"1la6f815drykrgqf791jx1dda6716cfv6052frqp7nhjxr75xg97"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-before 'configure 'qualify-xkbcomp
(lambda* (#:key inputs #:allow-other-keys)
(let ((xkbcomp (string-append
(assoc-ref inputs "xkbcomp") "/bin/xkbcomp")))
(substitute* "src/orca/orca.py"
(("'xkbcomp'") (format #f "'~a'" xkbcomp))))
#t))
(add-after 'install 'wrap-orca
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(prog (string-append out "/bin/orca")))
(wrap-program prog
`("GI_TYPELIB_PATH" ":" prefix
(,(getenv "GI_TYPELIB_PATH")))
`("GST_PLUGIN_SYSTEM_PATH" ":" prefix
(,(getenv "GST_PLUGIN_SYSTEM_PATH")))
`("PYTHONPATH" ":" prefix
(,(getenv "PYTHONPATH")))))
#t)))))
(native-inputs
`(("intltool" ,intltool)
("itstool" ,itstool)
("pkg-config" ,pkg-config)
("xmllint" ,libxml2)))
(inputs
`(("at-spi2-atk" ,at-spi2-atk)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("gstreamer" ,gstreamer)
("gst-plugins-base" ,gst-plugins-base)
("gst-plugins-good" ,gst-plugins-good)
("gtk+" ,gtk+)
("python" ,python)
("python-pygobject" ,python-pygobject)
("python-pyatspi" ,python-pyatspi)
("python-speechd" ,speech-dispatcher)
("xkbcomp" ,xkbcomp)))
(synopsis
"Screen reader for individuals who are blind or visually impaired")
(home-page "https://wiki.gnome.org/Projects/Orca")
(description
"Orca is a screen reader that provides access to the graphical desktop
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+)))

View File

@ -194,7 +194,7 @@ in the Mozilla clients.")
(define-public nss (define-public nss
(package (package
(name "nss") (name "nss")
(version "3.30.1") (version "3.30")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (let ((version-with-underscores (uri (let ((version-with-underscores
@ -205,7 +205,7 @@ in the Mozilla clients.")
"nss-" version ".tar.gz"))) "nss-" version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"1djypq081m22iw0wg0q7gnpndam5f8qjhqfd5v9by4c6l6lp78hz")) "1agkkwb51si4raw46p44vl3d0l7wzvdjcblpcdjjz6aymq6h1h58"))
;; Create nss.pc and nss-config. ;; Create nss.pc and nss-config.
(patches (search-patches "nss-pkgconfig.patch" (patches (search-patches "nss-pkgconfig.patch"
"nss-increase-test-timeout.patch")))) "nss-increase-test-timeout.patch"))))
@ -524,11 +524,7 @@ standards.")
"--with-system-jpeg" ; must be libjpeg-turbo "--with-system-jpeg" ; must be libjpeg-turbo
"--with-system-libevent" "--with-system-libevent"
"--with-system-libvpx" "--with-system-libvpx"
"--with-system-icu"
;; FIXME: It is preferable to build with system
;; libraries, but this fixes crashes.
;; "--with-system-icu"
"--with-system-nspr" "--with-system-nspr"
"--with-system-nss" "--with-system-nss"
"--enable-system-pixman" "--enable-system-pixman"

View File

@ -3,8 +3,9 @@
;;; Copyright © 2016 Matthew Jordan <matthewjordandevops@yandex.com> ;;; Copyright © 2016 Matthew Jordan <matthewjordandevops@yandex.com>
;;; Copyright © 2016 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2016 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Petter <petter@mykolab.ch> ;;; Copyright © 2016, 2017 Petter <petter@mykolab.ch>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Sergei Trofimovich <slyfox@inbox.ru>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -197,11 +198,11 @@ garbage collection, various safety features and in the style of communicating
sequential processes (CSP) concurrent programming features added.") sequential processes (CSP) concurrent programming features added.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public go-1.7 (define-public go-1.8
(package (package
(inherit go-1.4) (inherit go-1.4)
(name "go") (name "go")
(version "1.7.5") (version "1.8.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -209,7 +210,7 @@ sequential processes (CSP) concurrent programming features added.")
name version ".src.tar.gz")) name version ".src.tar.gz"))
(sha256 (sha256
(base32 (base32
"058q57zmi23rflingzhy1b87yl69mb62ql2psfxqr7q7l89lb0sf")))) "0mqf8ydxdx1pwmrs8p8wl5y1qrplzxmxzgb6vkghy4l67z0g9nik"))))
(arguments (arguments
(substitute-keyword-arguments (package-arguments go-1.4) (substitute-keyword-arguments (package-arguments go-1.4)
((#:phases phases) ((#:phases phases)
@ -300,8 +301,8 @@ sequential processes (CSP) concurrent programming features added.")
(("/etc/services") (string-append net-base "/etc/services"))) (("/etc/services") (string-append net-base "/etc/services")))
(substitute* "time/zoneinfo_unix.go" (substitute* "time/zoneinfo_unix.go"
(("/usr/share/zoneinfo/") tzdata-path)) (("/usr/share/zoneinfo/") tzdata-path))
(substitute* (find-files "cmd" "asm.c") (substitute* (find-files "cmd" "\\.go")
(("/lib/ld-linux.*\\.so\\.[0-9]") loader)) (("/lib(64)?/ld-linux.*\\.so\\.[0-9]") loader))
#t))) #t)))
(add-before 'build 'set-bootstrap-variables (add-before 'build 'set-bootstrap-variables
(lambda* (#:key outputs inputs #:allow-other-keys) (lambda* (#:key outputs inputs #:allow-other-keys)
@ -364,4 +365,4 @@ sequential processes (CSP) concurrent programming features added.")
`(("go" ,go-1.4) `(("go" ,go-1.4)
,@(package-native-inputs go-1.4))))) ,@(package-native-inputs go-1.4)))))
(define-public go go-1.7) (define-public go go-1.8)

View File

@ -14,6 +14,7 @@
;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org>
;;; Copyright © 2016 Patrick Hetu <patrick.hetu@auf.org> ;;; Copyright © 2016 Patrick Hetu <patrick.hetu@auf.org>
;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Coypright © 2017 Roel Janssen <roel@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -42,6 +43,7 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages algebra) #:use-module (gnu packages algebra)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
@ -1208,7 +1210,7 @@ extensive documentation, including API reference and a tutorial.")
(synopsis "Python bindings for GTK+") (synopsis "Python bindings for GTK+")
(description (description
"PyGTK allows you to write full featured GTK programs in Python. It is "PyGTK allows you to write full featured GTK programs in Python. It is
targetted at GTK 2.x, and can be used in conjunction with gnome-python to targeted at GTK 2.x, and can be used in conjunction with gnome-python to
write GNOME applications.") write GNOME applications.")
(license license:lgpl2.1+))) (license license:lgpl2.1+)))
@ -1419,3 +1421,41 @@ misspelled words in a GtkTextView widget.")
thereof, global hotkeys and clipboard item actions. It was forked from thereof, global hotkeys and clipboard item actions. It was forked from
Parcellite and adds bugfixes and features.") Parcellite and adds bugfixes and features.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public graphene
(package
(name "graphene")
(version "1.6.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/ebassi/graphene/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1zd2daj7y590wnzn4jw0niyc4fnzgxrcl9i7nwhy8b25ks2hz5wq"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--enable-introspection=yes")
#:phases
(modify-phases %standard-phases
(add-before 'configure 'autogen
(lambda _
(zero? (system* "./autogen.sh")))))))
(native-inputs
`(("autoconf" ,autoconf)
("which" ,which)
("pkg-config" ,pkg-config)
("automake" ,automake)
("libtool" ,libtool)))
(inputs
`(("python" ,python)
("python-2" ,python-2)
("glib" ,glib)
("gobject-introspection" ,gobject-introspection)))
(home-page "http://ebassi.github.io/graphene")
(synopsis "Thin layer of graphic data types")
(description "This library provides graphic types and their relative API;
it does not deal with windowing system surfaces, drawing, scene graphs, or
input.")
(license license:expat)))

View File

@ -6,7 +6,7 @@
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com> ;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2016 Eraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Eraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org> ;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2016 Amirouche <amirouche@hypermove.net> ;;; Copyright © 2016 Amirouche <amirouche@hypermove.net>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
@ -1359,7 +1359,7 @@ SQL databases. This package implements the interface for SQLite.")
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
(inputs (inputs
`(("guile" ,guile-2.0) `(("guile" ,guile-2.2)
("libx11" ,libx11) ("libx11" ,libx11)
("libxext" ,libxext) ("libxext" ,libxext)
("libxinerama" ,libxinerama) ("libxinerama" ,libxinerama)
@ -1375,7 +1375,7 @@ library}.")
(define-public guile-daemon (define-public guile-daemon
(package (package
(name "guile-daemon") (name "guile-daemon")
(version "0.1.1") (version "0.1.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/alezost/" name (uri (string-append "https://github.com/alezost/" name
@ -1383,12 +1383,12 @@ library}.")
"/" name "-" version ".tar.gz")) "/" name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0wsq9l6a4sijq4i1r3kcddfaznsak2jc5k59gzkhs5il5d2kn5yi")))) "0hh6gq6b6phpxm0b1dkxyzj3f4sxdf7dji63609lzypa5v1ad2gv"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
(inputs (inputs
`(("guile" ,guile-2.0))) `(("guile" ,guile-2.2)))
(home-page "https://github.com/alezost/guile-daemon") (home-page "https://github.com/alezost/guile-daemon")
(synopsis "Evaluate code in a running Guile process") (synopsis "Evaluate code in a running Guile process")
(description (description

View File

@ -2,6 +2,7 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -30,6 +31,7 @@
(package (package
(name "icu4c") (name "icu4c")
(version "58.2") (version "58.2")
(replacement icu4c/fixed)
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -63,3 +65,12 @@ globalisation support for software applications. This package contains the
C/C++ part.") C/C++ part.")
(license x11) (license x11)
(home-page "http://site.icu-project.org/"))) (home-page "http://site.icu-project.org/")))
(define icu4c/fixed
(package
(inherit icu4c)
(replacement #f)
(source (origin
(inherit (package-source icu4c))
(patches
(search-patches "icu4c-reset-keyword-list-iterator.patch"))))))

View File

@ -31,7 +31,7 @@
(define-public idris (define-public idris
(package (package
(name "idris") (name "idris")
(version "0.99.1") (version "1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -39,7 +39,7 @@
"idris-" version "/idris-" version ".tar.gz")) "idris-" version "/idris-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"12kw452arnl5ldip2x749j5np3l40bv7asqdv9w0f60j45hii40r")))) "1srbz0cyvd0k1yqgbrwnfj94yg5y3z533q1kzac96z1h7v454s5h"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (inputs
`(("gmp" ,gmp) `(("gmp" ,gmp)
@ -146,12 +146,14 @@ Epigram and Agda.")
idris-path-files)) idris-path-files))
(install-cmd (cons* idris-bin (install-cmd (cons* idris-bin
"--ibcsubdir" ibcsubdir "--ibcsubdir" ibcsubdir
"--install" ipkg "--build" ipkg
;; only trigger a build, as --ibcsubdir
;; already installs .ibc files.
(apply append (map (lambda (path) (apply append (map (lambda (path)
(list "--idrispath" (list "--idrispath"
path)) path))
idris-path-subdirs))))) idris-path-subdirs)))))
(setenv "IDRIS_LIBRARY_PATH" idris-libs)
;; FIXME: Seems to be a bug in idris that causes a dubious failure. ;; FIXME: Seems to be a bug in idris that causes a dubious failure.
(apply system* install-cmd) (apply system* install-cmd)
#t)))))) #t))))))

View File

@ -1426,7 +1426,7 @@ from DocBook files.")
(synopsis "Extract metadata from different fileformats") (synopsis "Extract metadata from different fileformats")
(description "KFileMetaData provides a simple library for extracting the (description "KFileMetaData provides a simple library for extracting the
text and metadata from a number of different files. This library is typically text and metadata from a number of different files. This library is typically
used by file indexers to retreive the metadata. This library can also be used used by file indexers to retrieve the metadata. This library can also be used
by applications to write metadata.") by applications to write metadata.")
(license (list license:lgpl2.0 license:lgpl2.1 license:lgpl3)))) (license (list license:lgpl2.0 license:lgpl2.1 license:lgpl3))))
@ -1750,7 +1750,7 @@ maintaining an index of the contents of your files.")
(home-page "https://community.kde.org/Frameworks") (home-page "https://community.kde.org/Frameworks")
(synopsis "Core components for the KDE Activity concept") (synopsis "Core components for the KDE Activity concept")
(description "KActivities provides the infrastructure needed to manage a (description "KActivities provides the infrastructure needed to manage a
user's activites, allowing them to switch between tasks, and for applications user's activities, allowing them to switch between tasks, and for applications
to update their state to match the user's current activity. This includes a to update their state to match the user's current activity. This includes a
daemon, a library for interacting with that daemon, and plugins for integration daemon, a library for interacting with that daemon, and plugins for integration
with other frameworks.") with other frameworks.")

View File

@ -239,8 +239,8 @@ generator library for C++.")
(define-public kodi (define-public kodi
;; We package the git version because the current released ;; We package the git version because the current released
;; version was cut while the cmake transition was in turmoil. ;; version was cut while the cmake transition was in turmoil.
(let ((commit "ec5d53da72868ad37df8bc005452a6daaa20f20b") (let ((commit "478d3064a8c3d395e8afac314143561c7468ad87")
(revision "1")) (revision "2"))
(package (package
(name "kodi") (name "kodi")
(version (string-append "18.0_alpha-" revision "-" (string-take commit 7))) (version (string-append "18.0_alpha-" revision "-" (string-take commit 7)))
@ -252,7 +252,7 @@ generator library for C++.")
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version "-checkout"))
(sha256 (sha256
(base32 (base32
"05f0bip0w784ya72plw3p2bism5m501q07si2xbmg03vhqsagjl5")) "19vb1qkk0ffh0b03x6whwl598bylsby3813i79vgrq5cvr4pigfy"))
(snippet (snippet
'(begin '(begin
(use-modules (guix build utils)) (use-modules (guix build utils))
@ -263,7 +263,6 @@ generator library for C++.")
;; And these sources: ;; And these sources:
;; "tools/depend/native/JsonSchemaBuilder" ;; "tools/depend/native/JsonSchemaBuilder"
;; "tools/depend/native/TexturePacker" ;; "tools/depend/native/TexturePacker"
;; "lib/UnrarXlib"
;; "lib/gtest" ;; "lib/gtest"
;; "lib/cpluff" ;; "lib/cpluff"
;; "lib/libexif" ;; "lib/libexif"
@ -287,8 +286,7 @@ generator library for C++.")
(string-append "-Dlibdvdcss_URL=" (string-append "-Dlibdvdcss_URL="
(assoc-ref %build-inputs "libdvdcss-bootstrapped")) (assoc-ref %build-inputs "libdvdcss-bootstrapped"))
(string-append "-DSYSTEM_LDFLAGS=-Wl,-rpath=" (string-append "-DSYSTEM_LDFLAGS=-Wl,-rpath="
(assoc-ref %build-inputs "curl") "/lib") (assoc-ref %build-inputs "curl") "/lib"))
"-DENABLE_NONFREE=OFF")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
;; The build system tries to bootstrap these bundled components ;; The build system tries to bootstrap these bundled components

View File

@ -182,7 +182,7 @@ resolution, asynchronous file system operations, and threading primitives.")
"API for I/O, timer, signal, child process and completion events") "API for I/O, timer, signal, child process and completion events")
(description (description
"This module allows using a variety of events without forcing module "This module allows using a variety of events without forcing module
authors to pick a specific event loop, and without noticable overhead. authors to pick a specific event loop, and without noticeable overhead.
Currently supported event loops are EV, Event, Glib/Gtk2, Tk, Qt, Currently supported event loops are EV, Event, Glib/Gtk2, Tk, Qt,
@code{Event::Lib}, Irssi, @code{IO::Async} and POE (and thus also WxWidgets @code{Event::Lib}, Irssi, @code{IO::Async} and POE (and thus also WxWidgets
and Prima). It also comes with a very fast Pure Perl event loop that does and Prima). It also comes with a very fast Pure Perl event loop that does

View File

@ -86,6 +86,7 @@
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages valgrind) #:use-module (gnu packages valgrind)
#:use-module (gnu packages video) #:use-module (gnu packages video)
#:use-module (gnu packages web)
#:use-module (gnu packages xiph) #:use-module (gnu packages xiph)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
@ -1016,21 +1017,28 @@ external rate conversion.")
(define-public iptables (define-public iptables
(package (package
(name "iptables") (name "iptables")
(version "1.4.21") (version "1.6.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://www.netfilter.org/projects/iptables/files/iptables-" "mirror://netfilter.org/iptables/iptables-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1q6kg7sf0pgpq0qhab6sywl23cngxxfzc9zdzscsba8x09l4q02j")))) "1x8c9y340x79djsq54bc1674ryv59jfphrk4f88i7qbvbnyxghhg"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("flex" ,flex)
("bison" ,bison)))
(inputs
`(("libmnl" ,libmnl)
("libnftnl" ,libnftnl)))
(arguments (arguments
'(#:tests? #f ; no test suite '(#:tests? #f ; no test suite
#:configure-flags ; add $libdir to the RUNPATH of executables #:configure-flags ; add $libdir to the RUNPATH of executables
(list (string-append "LDFLAGS=-Wl,-rpath=" %output "/lib")))) (list (string-append "LDFLAGS=-Wl,-rpath=" %output "/lib"))))
(home-page "http://www.netfilter.org/projects/iptables/index.html") (home-page "https://www.netfilter.org/projects/iptables/index.html")
(synopsis "Program to configure the Linux IP packet filtering rules") (synopsis "Program to configure the Linux IP packet filtering rules")
(description (description
"iptables is the userspace command line program used to configure the "iptables is the userspace command line program used to configure the
@ -1569,22 +1577,22 @@ UnionFS-FUSE additionally supports copy-on-write.")
(define-public sshfs-fuse (define-public sshfs-fuse
(package (package
(name "sshfs-fuse") (name "sshfs-fuse")
(version "2.8") (version "2.9")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/libfuse/sshfs/releases/" (uri (string-append "https://github.com/libfuse/sshfs/releases/"
"download/sshfs_" version "download/sshfs-" version "/sshfs-" version
"/sshfs-" version ".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"08mdd4rs7yys7hmyig6i08qlid76p17xlvrh64k7wsrfs1s92s3z")))) "1pp5wsl1jx11apkv2fpp559miifqhi8ka400npy5awp9ghlf3la6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("fuse" ,fuse) `(("fuse" ,fuse)
("glib" ,glib))) ("glib" ,glib)))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
(home-page "http://fuse.sourceforge.net/sshfs.html") (home-page "https://github.com/libfuse/sshfs")
(synopsis "Mount remote file systems over SSH") (synopsis "Mount remote file systems over SSH")
(description (description
"This is a file system client based on the SSH File Transfer Protocol. "This is a file system client based on the SSH File Transfer Protocol.
@ -2599,7 +2607,7 @@ arrays when needed.")
(define-public multipath-tools (define-public multipath-tools
(package (package
(name "multipath-tools") (name "multipath-tools")
(version "0.6.4") (version "0.7.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://git.opensvc.com/?p=multipath-tools/" (uri (string-append "http://git.opensvc.com/?p=multipath-tools/"
@ -2607,7 +2615,7 @@ arrays when needed.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"12smwmljrkl2afc06dghd2253rqnfawvzr818a2xpxr06f44f9qy")) "0w0rgi3lqksaki30yvd4l5rgjqb0d7js1sh7masl8aw6xbrsm26p"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
@ -2623,20 +2631,36 @@ arrays when needed.")
'(#:tests? #f ; No tests. '(#:tests? #f ; No tests.
#:make-flags (list (string-append "DESTDIR=" #:make-flags (list (string-append "DESTDIR="
(assoc-ref %outputs "out")) (assoc-ref %outputs "out"))
"SYSTEMDPATH=lib"
(string-append "LDFLAGS=-Wl,-rpath=" (string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out") (assoc-ref %outputs "out")
"/lib")) "/lib"))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'patch-source
(lambda* (#:key inputs #:allow-other-keys)
(let ((lvm2 (assoc-ref inputs "lvm2"))
(udev (assoc-ref inputs "udev")))
(substitute* "Makefile.inc"
(("\\$\\(prefix\\)/usr") "$(prefix)"))
(substitute* '("kpartx/Makefile" "libmultipath/Makefile")
(("/usr/include/libdevmapper.h")
(string-append lvm2 "/include/libdevmapper.h"))
(("/usr/include/libudev.h")
(string-append udev "/include/libudev.h")))
#t)))
(delete 'configure) (delete 'configure)
(add-before 'build 'set-CC (add-before 'build 'set-CC
(lambda _ (lambda _
(setenv "CC" "gcc") (setenv "CC" "gcc")
#t))))) #t)))))
(native-inputs (native-inputs
`(("valgrind" ,valgrind))) `(("perl" ,perl)
("pkg-config" ,pkg-config)
("valgrind" ,valgrind)))
(inputs (inputs
`(("ceph:lib" ,ceph "lib") `(("ceph:lib" ,ceph "lib")
("json-c" ,json-c)
("libaio" ,libaio) ("libaio" ,libaio)
("liburcu" ,liburcu) ("liburcu" ,liburcu)
("lvm2" ,lvm2) ("lvm2" ,lvm2)
@ -3711,3 +3735,50 @@ and more on DMI-capable x86 or EFI (IA-64) systems and on some PowerPC
machines (PowerMac G4 is known to work).") machines (PowerMac G4 is known to work).")
(home-page "https://www.ezix.org/project/wiki/HardwareLiSter") (home-page "https://www.ezix.org/project/wiki/HardwareLiSter")
(license license:gpl2+))) (license license:gpl2+)))
(define-public libmnl
(package
(name "libmnl")
(version "1.0.4")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://netfilter.org/libmnl/"
"libmnl-" version ".tar.bz2"))
(sha256
(base32
"108zampspaalv44zn0ar9h386dlfixpd149bnxa5hsi8kxlqj7qp"))))
(build-system gnu-build-system)
(home-page "https://www.netfilter.org/projects/libmnl/")
(synopsis "Netlink utility library")
(description "Libmnl is a minimalistic user-space library oriented to
Netlink developers. There are a lot of common tasks in parsing, validating,
constructing of both the Netlink header and TLVs that are repetitive and easy to
get wrong. This library aims to provide simple helpers that allows you to
re-use code and to avoid re-inventing the wheel.")
(license license:lgpl2.1+)))
(define-public libnftnl
(package
(name "libnftnl")
(version "1.0.7")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://netfilter.org/libnftnl/"
"libnftnl-" version ".tar.bz2"))
(sha256
(base32
"10irjrylcfkbp11617yr19vpfhgl54w0kw02jhj0i1abqv5nxdlv"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("libmnl" ,libmnl)))
(home-page "https://www.netfilter.org/projects/libnftnl/index.html")
(synopsis "Netlink programming interface to the Linux nf_tables subsystem")
(description "Libnftnl is a userspace library providing a low-level netlink
programming interface to the in-kernel nf_tables subsystem. The library
libnftnl has been previously known as libnftables. This library is currently
used by nftables.")
(license license:gpl2+)))

View File

@ -207,7 +207,7 @@ classification.")
(description (description
"The General Hidden Markov Model library (GHMM) is a C library with "The General Hidden Markov Model library (GHMM) is a C library with
additional Python bindings implementing a wide range of types of @dfn{Hidden additional Python bindings implementing a wide range of types of @dfn{Hidden
Markov Models} (HMM) and algorithms: discrete, continous emissions, basic Markov Models} (HMM) and algorithms: discrete, continuous emissions, basic
training, HMM clustering, HMM mixtures.") training, HMM clustering, HMM mixtures.")
(license license:lgpl2.0+)))) (license license:lgpl2.0+))))

View File

@ -22,6 +22,7 @@
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -221,14 +222,14 @@ aliasing facilities to work just as they would on normal mail.")
(define-public mutt (define-public mutt
(package (package
(name "mutt") (name "mutt")
(version "1.8.0") (version "1.8.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "ftp://ftp.mutt.org/pub/mutt/mutt-" (uri (string-append "https://bitbucket.org/mutt/mutt/downloads/"
version ".tar.gz")) "mutt-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1axdcylyv0p194y6lj1jx127g5yc74zqzzxdc014cjw02bd1x125")) "1b8dggq5x1b77a9i9250b3jhv2iddfzhr9rix1yfzckdms65mr8b"))
(patches (search-patches "mutt-store-references.patch")))) (patches (search-patches "mutt-store-references.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
@ -418,7 +419,7 @@ and corrections. It is based on a Bayesian filter.")
(define-public offlineimap (define-public offlineimap
(package (package
(name "offlineimap") (name "offlineimap")
(version "7.0.14") (version "7.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/OfflineIMAP/offlineimap/" (uri (string-append "https://github.com/OfflineIMAP/offlineimap/"
@ -426,7 +427,7 @@ and corrections. It is based on a Bayesian filter.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0i5dvygps1ai2qwgamab8kngrp0c5m3bgaw0jk34l8ypsk54wj8r")))) "1r0sbgwyirpbks82ri9g88raf3mp8shq9rg0r92gkr7h6888v6fw"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("asciidoc" ,asciidoc))) `(("asciidoc" ,asciidoc)))
@ -2052,7 +2053,7 @@ the GNU Mailman 3 REST API.")
(description (description
"Mlmmj is a simple and slim mailing list manager (MLM) inspired by ezmlm. "Mlmmj is a simple and slim mailing list manager (MLM) inspired by ezmlm.
It works with many different Mail Transport Agents (MTAs) and is simple for a It works with many different Mail Transport Agents (MTAs) and is simple for a
system adminstrator to install, configure and integrate with other software. system administrator to install, configure and integrate with other software.
As it uses very few resources, and requires no daemons, it is ideal for As it uses very few resources, and requires no daemons, it is ideal for
installation on systems where resources are limited. Its features include: installation on systems where resources are limited. Its features include:
@enumerate @enumerate

View File

@ -61,16 +61,15 @@
(define-public mate-themes (define-public mate-themes
(package (package
(name "mate-themes") (name "mate-themes")
(version (package-version gtk+)) (version "3.22.10")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://pub.mate-desktop.org/releases/themes/" (uri (string-append "http://pub.mate-desktop.org/releases/themes/"
(version-major+minor (package-version gtk+)) (version-major+minor version) "/mate-themes-"
"/mate-themes-" (package-version gtk+) version ".tar.xz"))
".tar.xz"))
(sha256 (sha256
(base32 (base32
"1gsfzrcbwp7835pbilk7cvda8hjsf9g3gl4llbm61y9j7a4x2kn6")))) "03ficjfxa4qpx4vcshhk2zxryivckxpw7wcjgbn8xqnjk3lgzjcb"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)

View File

@ -3003,7 +3003,7 @@ compilers and compiler versions as well as portability between different vector
instruction sets. Thus, an application written with Vc can be compiled for: instruction sets. Thus, an application written with Vc can be compiled for:
@enumerate @enumerate
@item AVX and AVX2 @item AVX and AVX2
@item SSE2 upto SSE4.2 or SSE4a @item SSE2 up to SSE4.2 or SSE4a
@item Scalar @item Scalar
@item MIC @item MIC
@item NEON (in development) @item NEON (in development)

View File

@ -2526,7 +2526,7 @@ parallel with a DarkBooster, followed by a volume control.")))
(synopsis "Fuzz effect modelled after the UniVox SuperFuzz") (synopsis "Fuzz effect modelled after the UniVox SuperFuzz")
(description "This package provides the LV2 plugin \"GxSuperFuzz\", an (description "This package provides the LV2 plugin \"GxSuperFuzz\", an
analog simulation of the UniVox SuperFuzz pedal. In this simulation the trim analog simulation of the UniVox SuperFuzz pedal. In this simulation the trim
pot, which is usualy in the housing, is exposed as a control parameter. It pot, which is usually in the housing, is exposed as a control parameter. It
adjusts the amount of harmonics."))) adjusts the amount of harmonics.")))
(define-public gx-vintage-fuzz-master-lv2 (define-public gx-vintage-fuzz-master-lv2

View File

@ -12,6 +12,7 @@
;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch> ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;; Copyright © 2016, 2017 Pjotr Prins <pjotr.guix@thebird.nl> ;;; Copyright © 2016, 2017 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -379,7 +380,7 @@ intended as a substitute for the PPPStatus and EthStatus projects.")
(description (description
"Nload is a console application which monitors network traffic and "Nload is a console application which monitors network traffic and
bandwidth usage in real time. It visualizes the in- and outgoing traffic using bandwidth usage in real time. It visualizes the in- and outgoing traffic using
two graphs and provides additional info like total amount of transfered data two graphs, and provides additional info like total amount of transferred data
and min/max network usage.") and min/max network usage.")
(license license:gpl2+))) (license license:gpl2+)))
@ -470,7 +471,7 @@ which can be used to encrypt a password with @code{crypt(3)}.")
(define-public wireshark (define-public wireshark
(package (package
(name "wireshark") (name "wireshark")
(version "2.2.5") (version "2.2.6")
(synopsis "Network traffic analyzer") (synopsis "Network traffic analyzer")
(source (source
(origin (origin
@ -479,7 +480,7 @@ which can be used to encrypt a password with @code{crypt(3)}.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1j4sc3pmy8l6k41007spglcqiabjlzc7f85pn3jmjr9ksv9qipbm")))) "0jd89i9si43lyv3hsl6p1lkjmz4zagvc37wcbigsxxc5v8gda9zn"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(inputs `(("bison" ,bison) (inputs `(("bison" ,bison)
("c-ares" ,c-ares) ("c-ares" ,c-ares)
@ -1124,7 +1125,7 @@ IPFIX, RSPAN, CLI, LACP, 802.1ag).")
(define-public speedtest-cli (define-public speedtest-cli
(package (package
(name "speedtest-cli") (name "speedtest-cli")
(version "1.0.2") (version "1.0.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1133,7 +1134,7 @@ IPFIX, RSPAN, CLI, LACP, 802.1ag).")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1ir9fqwr7cl9kfq7dgh9vkydkwf59wsx0cwbzbffw8i313xhzxa1")))) "1v4xd03303mlzmv43qaz3fmskp2prhs1678a5522ia2yqwv98adz"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://github.com/sivel/speedtest-cli") (home-page "https://github.com/sivel/speedtest-cli")
(synopsis "Internet bandwidth tester") (synopsis "Internet bandwidth tester")

View File

@ -38,14 +38,14 @@
(define-public node (define-public node
(package (package
(name "node") (name "node")
(version "6.8.0") (version "7.8.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://nodejs.org/dist/v" version (uri (string-append "http://nodejs.org/dist/v" version
"/node-v" version ".tar.gz")) "/node-v" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0lj3250hglz4w5ic4svd7wlg2r3qc49hnasvbva1v69l8yvx98m8")) "1nkngdjbsm81nn3v0w0c2aqx9nb7mwy3z49ynq4wwcrzfr9ap8ka"))
;; https://github.com/nodejs/node/pull/9077 ;; https://github.com/nodejs/node/pull/9077
(patches (search-patches "node-9077.patch")))) (patches (search-patches "node-9077.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
@ -62,6 +62,7 @@
;; Fix hardcoded /bin/sh references. ;; Fix hardcoded /bin/sh references.
(substitute* '("lib/child_process.js" (substitute* '("lib/child_process.js"
"lib/internal/v8_prof_polyfill.js" "lib/internal/v8_prof_polyfill.js"
"test/parallel/test-child-process-spawnsync-shell.js"
"test/parallel/test-stdio-closed.js") "test/parallel/test-stdio-closed.js")
(("'/bin/sh'") (("'/bin/sh'")
(string-append "'" (which "sh") "'"))) (string-append "'" (which "sh") "'")))
@ -130,4 +131,5 @@ event-driven, non-blocking I/O model that makes it lightweight and efficient,
perfect for data-intensive real-time applications that run across distributed perfect for data-intensive real-time applications that run across distributed
devices.") devices.")
(home-page "http://nodejs.org/") (home-page "http://nodejs.org/")
(license expat))) (license expat)
(properties '((timeout . 3600))))) ; 1 h

View File

@ -450,16 +450,17 @@ transactions from C or Python.")
(define-public diffoscope (define-public diffoscope
(package (package
(name "diffoscope") (name "diffoscope")
(version "78") (version "81")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri name version)) (uri (pypi-uri name version))
(sha256 (sha256
(base32 (base32
"1bx8i6sx2mcvm166nhw0i5442ld6wigkwav8dsnv22y7gnsl9d7n")))) "093lxy6zj69i19fxdkj3jnai3b1ajqbksyqcvy8wqj3plaaxjna5"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:phases (modify-phases %standard-phases `(#:phases (modify-phases %standard-phases
(add-before 'unpack 'n (lambda _ #t))
;; setup.py mistakenly requires python-magic from PyPi, even ;; setup.py mistakenly requires python-magic from PyPi, even
;; though the Python bindings of `file` are sufficient. ;; though the Python bindings of `file` are sufficient.
;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=815844 ;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=815844

View File

@ -0,0 +1,52 @@
FIXME: This test broke after the gcc-5/glibc-2.25 core-updates merge.
Not sure what's going on here, it hangs after spawning the first thread.
diff --git a/src/test/common/Throttle.cc b/src/test/common/Throttle.cc
index 5b6d73217d..40a477b2a3 100644
--- a/src/test/common/Throttle.cc
+++ b/src/test/common/Throttle.cc
@@ -216,44 +216,6 @@ TEST_F(ThrottleTest, wait) {
} while(!waited);
}
-TEST_F(ThrottleTest, destructor) {
- Thread_get *t;
- {
- int64_t throttle_max = 10;
- Throttle *throttle = new Throttle(g_ceph_context, "throttle", throttle_max);
-
- ASSERT_FALSE(throttle->get(5));
-
- t = new Thread_get(*throttle, 7);
- t->create("t_throttle");
- bool blocked;
- useconds_t delay = 1;
- do {
- usleep(delay);
- if (throttle->get_or_fail(1)) {
- throttle->put(1);
- blocked = false;
- } else {
- blocked = true;
- }
- delay *= 2;
- } while(!blocked);
- delete throttle;
- }
-
- { //
- // The thread is left hanging, otherwise it will abort().
- // Deleting the Throttle on which it is waiting creates a
- // inconsistency that will be detected: the Throttle object that
- // it references no longer exists.
- //
- pthread_t id = t->get_thread_id();
- ASSERT_EQ(pthread_kill(id, 0), 0);
- delete t;
- ASSERT_EQ(pthread_kill(id, 0), 0);
- }
-}
-
std::pair<double, std::chrono::duration<double> > test_backoff(
double low_threshhold,
double high_threshhold,

View File

@ -0,0 +1,130 @@
Copied from upstream: http://bugs.icu-project.org/trac/changeset/39484/.
Fixes <http://bugs.gnu.org/26462> (crashes).
Paths and line endings have been adapted.
Index: icu/source/common/ulist.c
===================================================================
--- icu/source/common/ulist.c (revision 39483)
+++ icu/source/common/ulist.c (revision 39484)
@@ -30,5 +30,4 @@
int32_t size;
- int32_t currentIndex;
};
@@ -52,5 +51,4 @@
newList->tail = NULL;
newList->size = 0;
- newList->currentIndex = -1;
return newList;
@@ -81,6 +79,7 @@
p->next->previous = p->previous;
}
- list->curr = NULL;
- list->currentIndex = 0;
+ if (p == list->curr) {
+ list->curr = p->next;
+ }
--list->size;
if (p->forceDelete) {
@@ -151,5 +150,4 @@
list->head->previous = newItem;
list->head = newItem;
- list->currentIndex++;
}
@@ -194,5 +192,4 @@
curr = list->curr;
list->curr = curr->next;
- list->currentIndex++;
return curr->data;
@@ -210,5 +207,4 @@
if (list != NULL) {
list->curr = list->head;
- list->currentIndex = 0;
}
}
@@ -273,3 +269,2 @@
return (UList *)(en->context);
}
-
Index: icu/source/i18n/ucol_res.cpp
===================================================================
--- icu/source/i18n/ucol_res.cpp (revision 39483)
+++ icu/source/i18n/ucol_res.cpp (revision 39484)
@@ -681,4 +681,5 @@
}
memcpy(en, &defaultKeywordValues, sizeof(UEnumeration));
+ ulist_resetList(sink.values); // Initialize the iterator.
en->context = sink.values;
sink.values = NULL; // Avoid deletion in the sink destructor.
Index: icu/source/test/intltest/apicoll.cpp
===================================================================
--- icu/source/test/intltest/apicoll.cpp (revision 39483)
+++ icu/source/test/intltest/apicoll.cpp (revision 39484)
@@ -82,14 +82,7 @@
col = Collator::createInstance(Locale::getEnglish(), success);
if (U_FAILURE(success)){
- errcheckln(success, "Default Collator creation failed. - %s", u_errorName(success));
- return;
- }
-
- StringEnumeration* kwEnum = col->getKeywordValuesForLocale("", Locale::getEnglish(),true,success);
- if (U_FAILURE(success)){
- errcheckln(success, "Get Keyword Values for Locale failed. - %s", u_errorName(success));
- return;
- }
- delete kwEnum;
+ errcheckln(success, "English Collator creation failed. - %s", u_errorName(success));
+ return;
+ }
col->getVersion(versionArray);
@@ -230,4 +223,27 @@
delete aFrCol;
delete junk;
+}
+
+void CollationAPITest::TestKeywordValues() {
+ IcuTestErrorCode errorCode(*this, "TestKeywordValues");
+ LocalPointer<Collator> col(Collator::createInstance(Locale::getEnglish(), errorCode));
+ if (errorCode.logIfFailureAndReset("English Collator creation failed")) {
+ return;
+ }
+
+ LocalPointer<StringEnumeration> kwEnum(
+ col->getKeywordValuesForLocale("collation", Locale::getEnglish(), TRUE, errorCode));
+ if (errorCode.logIfFailureAndReset("Get Keyword Values for English Collator failed")) {
+ return;
+ }
+ assertTrue("expect at least one collation tailoring for English", kwEnum->count(errorCode) > 0);
+ const char *kw;
+ UBool hasStandard = FALSE;
+ while ((kw = kwEnum->next(NULL, errorCode)) != NULL) {
+ if (strcmp(kw, "standard") == 0) {
+ hasStandard = TRUE;
+ }
+ }
+ assertTrue("expect at least the 'standard' collation tailoring for English", hasStandard);
}
@@ -2467,4 +2483,5 @@
TESTCASE_AUTO_BEGIN;
TESTCASE_AUTO(TestProperty);
+ TESTCASE_AUTO(TestKeywordValues);
TESTCASE_AUTO(TestOperators);
TESTCASE_AUTO(TestDuplicate);
Index: icu/source/test/intltest/apicoll.h
===================================================================
--- icu/source/test/intltest/apicoll.h (revision 39483)
+++ icu/source/test/intltest/apicoll.h (revision 39484)
@@ -36,4 +36,5 @@
*/
void TestProperty(/* char* par */);
+ void TestKeywordValues();
/**

View File

@ -1,63 +0,0 @@
Fix CVE-2017-5896:
https://bugs.ghostscript.com/show_bug.cgi?id=697515
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-5896
http://www.openwall.com/lists/oss-security/2017/02/10/1
https://security-tracker.debian.org/tracker/CVE-2017-5896
https://blogs.gentoo.org/ago/2017/02/09/mupdf-use-after-free-in-fz_subsample_pixmap-pixmap-c/
Patch lifted from upstream source repository:
http://git.ghostscript.com/?p=mupdf.git;h=2c4e5867ee699b1081527bc6c6ea0e99a35a5c27
From 2c4e5867ee699b1081527bc6c6ea0e99a35a5c27 Mon Sep 17 00:00:00 2001
From: Robin Watts <Robin.Watts@artifex.com>
Date: Thu, 9 Feb 2017 07:12:16 -0800
Subject: [PATCH] bug 697515: Fix out of bounds read in fz_subsample_pixmap
Pointer arithmetic for final special case was going wrong.
---
source/fitz/pixmap.c | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/source/fitz/pixmap.c b/source/fitz/pixmap.c
index a8317127..f1291dc2 100644
--- a/source/fitz/pixmap.c
+++ b/source/fitz/pixmap.c
@@ -1104,6 +1104,7 @@ fz_subsample_pixmap_ARM(unsigned char *ptr, int w, int h, int f, int factor,
"@STACK:r1,<9>,factor,n,fwd,back,back2,fwd2,divX,back4,fwd4,fwd3,divY,back5,divXY\n"
"ldr r4, [r13,#4*22] @ r4 = divXY \n"
"ldr r5, [r13,#4*11] @ for (nn = n; nn > 0; n--) { \n"
+ "ldr r8, [r13,#4*17] @ r8 = back4 \n"
"18: @ \n"
"mov r14,#0 @ r14= v = 0 \n"
"sub r5, r5, r1, LSL #8 @ for (xx = x; xx > 0; x--) { \n"
@@ -1120,7 +1121,7 @@ fz_subsample_pixmap_ARM(unsigned char *ptr, int w, int h, int f, int factor,
"mul r14,r4, r14 @ r14= v *= divX \n"
"mov r14,r14,LSR #16 @ r14= v >>= 16 \n"
"strb r14,[r9], #1 @ *d++ = r14 \n"
- "sub r0, r0, r8 @ s -= back2 \n"
+ "sub r0, r0, r8 @ s -= back4 \n"
"subs r5, r5, #1 @ n-- \n"
"bgt 18b @ } \n"
"21: @ \n"
@@ -1249,6 +1250,7 @@ fz_subsample_pixmap(fz_context *ctx, fz_pixmap *tile, int factor)
x += f;
if (x > 0)
{
+ int back4 = x * n - 1;
div = x * y;
for (nn = n; nn > 0; nn--)
{
@@ -1263,7 +1265,7 @@ fz_subsample_pixmap(fz_context *ctx, fz_pixmap *tile, int factor)
s -= back5;
}
*d++ = v / div;
- s -= back2;
+ s -= back4;
}
}
}
--
2.12.0

View File

@ -1,101 +0,0 @@
Fix CVE-2017-5991:
https://bugs.ghostscript.com/show_bug.cgi?id=697500
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-5991
https://security-tracker.debian.org/tracker/CVE-2017-5991
Patch lifted from upstream source repository:
http://git.ghostscript.com/?p=mupdf.git;h=1912de5f08e90af1d9d0a9791f58ba3afdb9d465
From 1912de5f08e90af1d9d0a9791f58ba3afdb9d465 Mon Sep 17 00:00:00 2001
From: Robin Watts <robin.watts@artifex.com>
Date: Thu, 9 Feb 2017 15:49:15 +0000
Subject: [PATCH] Bug 697500: Fix NULL ptr access.
Cope better with errors during rendering - avoid letting the
gstate stack get out of sync.
This avoids us ever getting into the situation of popping
a clip when we should be popping a mask or a group. This was
causing an unexpected case in the painting.
---
source/pdf/pdf-op-run.c | 26 ++++++++++++++++++--------
1 file changed, 18 insertions(+), 8 deletions(-)
diff --git a/source/pdf/pdf-op-run.c b/source/pdf/pdf-op-run.c
index a3ea895d..f1eac8d3 100644
--- a/source/pdf/pdf-op-run.c
+++ b/source/pdf/pdf-op-run.c
@@ -1213,6 +1213,7 @@ pdf_run_xobject(fz_context *ctx, pdf_run_processor *proc, pdf_xobject *xobj, pdf
pdf_run_processor *pr = (pdf_run_processor *)proc;
pdf_gstate *gstate = NULL;
int oldtop = 0;
+ int oldbot = -1;
fz_matrix local_transform = *transform;
softmask_save softmask = { NULL };
int gparent_save;
@@ -1232,16 +1233,17 @@ pdf_run_xobject(fz_context *ctx, pdf_run_processor *proc, pdf_xobject *xobj, pdf
fz_var(cleanup_state);
fz_var(gstate);
fz_var(oldtop);
+ fz_var(oldbot);
gparent_save = pr->gparent;
pr->gparent = pr->gtop;
+ oldtop = pr->gtop;
fz_try(ctx)
{
pdf_gsave(ctx, pr);
gstate = pr->gstate + pr->gtop;
- oldtop = pr->gtop;
pdf_xobject_bbox(ctx, xobj, &xobj_bbox);
pdf_xobject_matrix(ctx, xobj, &xobj_matrix);
@@ -1302,12 +1304,25 @@ pdf_run_xobject(fz_context *ctx, pdf_run_processor *proc, pdf_xobject *xobj, pdf
doc = pdf_get_bound_document(ctx, xobj->obj);
+ oldbot = pr->gbot;
+ pr->gbot = pr->gtop;
+
pdf_process_contents(ctx, (pdf_processor*)pr, doc, resources, xobj->obj, NULL);
}
fz_always(ctx)
{
+ /* Undo any gstate mismatches due to the pdf_process_contents call */
+ if (oldbot != -1)
+ {
+ while (pr->gtop > pr->gbot)
+ {
+ pdf_grestore(ctx, pr);
+ }
+ pr->gbot = oldbot;
+ }
+
if (cleanup_state >= 3)
- pdf_grestore(ctx, pr); /* Remove the clippath */
+ pdf_grestore(ctx, pr); /* Remove the state we pushed for the clippath */
/* wrap up transparency stacks */
if (transparency)
@@ -1341,13 +1356,8 @@ pdf_run_xobject(fz_context *ctx, pdf_run_processor *proc, pdf_xobject *xobj, pdf
pr->gstate[pr->gparent].ctm = gparent_save_ctm;
pr->gparent = gparent_save;
- if (gstate)
- {
- while (oldtop < pr->gtop)
- pdf_grestore(ctx, pr);
-
+ while (oldtop < pr->gtop)
pdf_grestore(ctx, pr);
- }
pdf_unmark_obj(ctx, xobj->obj);
}
--
2.12.0

View File

@ -13,17 +13,15 @@ diff --git a/source/fitz/load-jpx.c b/source/fitz/load-jpx.c
index 6b92e5c..72dea50 100644 index 6b92e5c..72dea50 100644
--- a/source/fitz/load-jpx.c --- a/source/fitz/load-jpx.c
+++ b/source/fitz/load-jpx.c +++ b/source/fitz/load-jpx.c
@@ -1,13 +1,5 @@ @@ -444,11 +444,6 @@
#include "mupdf/fitz.h"
#else /* HAVE_LURATECH */
-/* Without the definition of OPJ_STATIC, compilation fails on windows
- * due to the use of __stdcall. We believe it is required on some
- * linux toolchains too. */
-#define OPJ_STATIC -#define OPJ_STATIC
-#ifndef _MSC_VER -#define OPJ_HAVE_INTTYPES_H
-#if !defined(_WIN32) && !defined(_WIN64)
-#define OPJ_HAVE_STDINT_H -#define OPJ_HAVE_STDINT_H
-#endif -#endif
- #define USE_JPIP
#include <openjpeg.h>
static void fz_opj_error_callback(const char *msg, void *client_data) #include <openjpeg.h>

View File

@ -1,188 +0,0 @@
Fix CVE-2016-10132:
https://bugs.ghostscript.com/show_bug.cgi?id=697381
http://seclists.org/oss-sec/2017/q1/74
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-10132
Patch lifted from upstream source repository:
http://git.ghostscript.com/?p=mujs.git;h=fd003eceda531e13fbdd1aeb6e9c73156496e569
From fd003eceda531e13fbdd1aeb6e9c73156496e569 Mon Sep 17 00:00:00 2001
From: Tor Andersson <tor@ccxvii.net>
Date: Fri, 2 Dec 2016 14:56:20 -0500
Subject: [PATCH] Fix 697381: check allocation when compiling regular
expressions.
Also use allocator callback function.
---
thirdparty/mujs/jsgc.c | 2 +-
thirdparty/mujs/jsregexp.c | 2 +-
thirdparty/mujs/jsstate.c | 6 ------
thirdparty/mujs/regexp.c | 45 +++++++++++++++++++++++++++++++++++----------
thirdparty/mujs/regexp.h | 7 +++++++
5 files changed, 44 insertions(+), 18 deletions(-)
diff --git a/thirdparty/mujs/jsgc.c b/thirdparty/mujs/jsgc.c
index 4f7e7dc..f80111e 100644
--- a/thirdparty/mujs/jsgc.c
+++ b/thirdparty/mujs/jsgc.c
@@ -46,7 +46,7 @@ static void jsG_freeobject(js_State *J, js_Object *obj)
jsG_freeproperty(J, obj->head);
if (obj->type == JS_CREGEXP) {
js_free(J, obj->u.r.source);
- js_regfree(obj->u.r.prog);
+ js_regfreex(J->alloc, J->actx, obj->u.r.prog);
}
if (obj->type == JS_CITERATOR)
jsG_freeiterator(J, obj->u.iter.head);
diff --git a/thirdparty/mujs/jsregexp.c b/thirdparty/mujs/jsregexp.c
index a2d5156..7b09c06 100644
--- a/thirdparty/mujs/jsregexp.c
+++ b/thirdparty/mujs/jsregexp.c
@@ -16,7 +16,7 @@ void js_newregexp(js_State *J, const char *pattern, int flags)
if (flags & JS_REGEXP_I) opts |= REG_ICASE;
if (flags & JS_REGEXP_M) opts |= REG_NEWLINE;
- prog = js_regcomp(pattern, opts, &error);
+ prog = js_regcompx(J->alloc, J->actx, pattern, opts, &error);
if (!prog)
js_syntaxerror(J, "regular expression: %s", error);
diff --git a/thirdparty/mujs/jsstate.c b/thirdparty/mujs/jsstate.c
index 638cab3..fd5bcf6 100644
--- a/thirdparty/mujs/jsstate.c
+++ b/thirdparty/mujs/jsstate.c
@@ -9,12 +9,6 @@
static void *js_defaultalloc(void *actx, void *ptr, int size)
{
- if (size == 0) {
- free(ptr);
- return NULL;
- }
- if (!ptr)
- return malloc((size_t)size);
return realloc(ptr, (size_t)size);
}
diff --git a/thirdparty/mujs/regexp.c b/thirdparty/mujs/regexp.c
index 9852be2..01c18a3 100644
--- a/thirdparty/mujs/regexp.c
+++ b/thirdparty/mujs/regexp.c
@@ -807,23 +807,31 @@ static void dumpprog(Reprog *prog)
}
#endif
-Reprog *regcomp(const char *pattern, int cflags, const char **errorp)
+Reprog *regcompx(void *(*alloc)(void *ctx, void *p, int n), void *ctx,
+ const char *pattern, int cflags, const char **errorp)
{
struct cstate g;
Renode *node;
Reinst *split, *jump;
int i;
- g.prog = malloc(sizeof (Reprog));
- g.pstart = g.pend = malloc(sizeof (Renode) * strlen(pattern) * 2);
+ g.pstart = NULL;
+ g.prog = NULL;
if (setjmp(g.kaboom)) {
if (errorp) *errorp = g.error;
- free(g.pstart);
- free(g.prog);
+ alloc(ctx, g.pstart, 0);
+ alloc(ctx, g.prog, 0);
return NULL;
}
+ g.prog = alloc(ctx, NULL, sizeof (Reprog));
+ if (!g.prog)
+ die(&g, "cannot allocate regular expression");
+ g.pstart = g.pend = alloc(ctx, NULL, sizeof (Renode) * strlen(pattern) * 2);
+ if (!g.pstart)
+ die(&g, "cannot allocate regular expression parse list");
+
g.source = pattern;
g.ncclass = 0;
g.nsub = 1;
@@ -840,7 +848,9 @@ Reprog *regcomp(const char *pattern, int cflags, const char **errorp)
die(&g, "syntax error");
g.prog->nsub = g.nsub;
- g.prog->start = g.prog->end = malloc((count(node) + 6) * sizeof (Reinst));
+ g.prog->start = g.prog->end = alloc(ctx, NULL, (count(node) + 6) * sizeof (Reinst));
+ if (!g.prog->start)
+ die(&g, "cannot allocate regular expression instruction list");
split = emit(g.prog, I_SPLIT);
split->x = split + 3;
@@ -859,20 +869,35 @@ Reprog *regcomp(const char *pattern, int cflags, const char **errorp)
dumpprog(g.prog);
#endif
- free(g.pstart);
+ alloc(ctx, g.pstart, 0);
if (errorp) *errorp = NULL;
return g.prog;
}
-void regfree(Reprog *prog)
+void regfreex(void *(*alloc)(void *ctx, void *p, int n), void *ctx, Reprog *prog)
{
if (prog) {
- free(prog->start);
- free(prog);
+ alloc(ctx, prog->start, 0);
+ alloc(ctx, prog, 0);
}
}
+static void *default_alloc(void *ctx, void *p, int n)
+{
+ return realloc(p, (size_t)n);
+}
+
+Reprog *regcomp(const char *pattern, int cflags, const char **errorp)
+{
+ return regcompx(default_alloc, NULL, pattern, cflags, errorp);
+}
+
+void regfree(Reprog *prog)
+{
+ regfreex(default_alloc, NULL, prog);
+}
+
/* Match */
static int isnewline(int c)
diff --git a/thirdparty/mujs/regexp.h b/thirdparty/mujs/regexp.h
index 4bb4615..6bb73e8 100644
--- a/thirdparty/mujs/regexp.h
+++ b/thirdparty/mujs/regexp.h
@@ -1,6 +1,8 @@
#ifndef regexp_h
#define regexp_h
+#define regcompx js_regcompx
+#define regfreex js_regfreex
#define regcomp js_regcomp
#define regexec js_regexec
#define regfree js_regfree
@@ -8,6 +10,11 @@
typedef struct Reprog Reprog;
typedef struct Resub Resub;
+Reprog *regcompx(void *(*alloc)(void *ctx, void *p, int n), void *ctx,
+ const char *pattern, int cflags, const char **errorp);
+void regfreex(void *(*alloc)(void *ctx, void *p, int n), void *ctx,
+ Reprog *prog);
+
Reprog *regcomp(const char *pattern, int cflags, const char **errorp);
int regexec(Reprog *prog, const char *string, Resub *sub, int eflags);
void regfree(Reprog *prog);
--
2.9.1

View File

@ -1,36 +0,0 @@
Fix CVE-2016-10133:
https://bugs.ghostscript.com/show_bug.cgi?id=697401
http://seclists.org/oss-sec/2017/q1/74
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-10133
Patch lifted from upstream source repository:
https://git.ghostscript.com/?p=mujs.git;h=77ab465f1c394bb77f00966cd950650f3f53cb24
From 77ab465f1c394bb77f00966cd950650f3f53cb24 Mon Sep 17 00:00:00 2001
From: Tor Andersson <tor.andersson@gmail.com>
Date: Thu, 12 Jan 2017 14:47:01 +0100
Subject: [PATCH] Fix 697401: Error when dropping extra arguments to
lightweight functions.
---
thirdparty/mujs/jsrun.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/thirdparty/mujs/jsrun.c b/thirdparty/mujs/jsrun.c
index ee80845..782a6f9 100644
--- a/thirdparty/mujs/jsrun.c
+++ b/thirdparty/mujs/jsrun.c
@@ -937,7 +937,7 @@ static void jsR_calllwfunction(js_State *J, int n, js_Function *F, js_Environmen
jsR_savescope(J, scope);
if (n > F->numparams) {
- js_pop(J, F->numparams - n);
+ js_pop(J, n - F->numparams);
n = F->numparams;
}
for (i = n; i < F->varlen; ++i)
--
2.9.1

View File

@ -531,7 +531,7 @@ extracting content or merging files.")
(define-public mupdf (define-public mupdf
(package (package
(name "mupdf") (name "mupdf")
(version "1.10a") (version "1.11")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -539,10 +539,8 @@ extracting content or merging files.")
name "-" version "-source.tar.gz")) name "-" version "-source.tar.gz"))
(sha256 (sha256
(base32 (base32
"0dm8wcs8i29aibzkqkrn8kcnk4q0kd1v66pg48h5c3qqp4v1zk5a")) "02phamcchgsmvjnb3ir7r5sssvx9fcrscn297z73b82n1jl79510"))
(patches (search-patches "mupdf-build-with-openjpeg-2.1.patch" (patches (search-patches "mupdf-build-with-openjpeg-2.1.patch"))
"mupdf-mujs-CVE-2016-10132.patch"
"mupdf-mujs-CVE-2016-10133.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Delete all the bundled libraries except for mujs, which is ;; Delete all the bundled libraries except for mujs, which is
@ -554,7 +552,7 @@ extracting content or merging files.")
"thirdparty/glfw" "thirdparty/glfw"
"thirdparty/harfbuzz" "thirdparty/harfbuzz"
"thirdparty/jbig2dec" "thirdparty/jbig2dec"
"thirdparty/jpeg" "thirdparty/libjpeg"
"thirdparty/openjpeg" "thirdparty/openjpeg"
"thirdparty/zlib"))))) "thirdparty/zlib")))))
(build-system gnu-build-system) (build-system gnu-build-system)

View File

@ -15,6 +15,7 @@
;;; Copyright © 2017 Raoul J.P. Bonnal <ilpuccio.febo@gmail.com> ;;; Copyright © 2017 Raoul J.P. Bonnal <ilpuccio.febo@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 humanitiesNerd <catonano@gmail.com> ;;; Copyright © 2017 humanitiesNerd <catonano@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -6122,9 +6123,8 @@ statements: @code{switch} and @code{case}.")
(build-system perl-build-system) (build-system perl-build-system)
(synopsis "Perl extension for getting CPU information") (synopsis "Perl extension for getting CPU information")
(description (description
"In responce to a post on perlmonks.org, a module for counting the number "Sys::CPU is a module for counting the number of CPUs on a system, and
of CPU's on a system. Support has now also been added for type of CPU and determining their type and clock speed.")
clock speed.")
(home-page (string-append "http://search.cpan.org/~mzsanford/" (home-page (string-append "http://search.cpan.org/~mzsanford/"
"Sys-CPU-" version)) "Sys-CPU-" version))
(license (package-license perl)))) (license (package-license perl))))

View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2016, 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -173,14 +173,14 @@ colors, styles, options and details.")
(define-public asymptote (define-public asymptote
(package (package
(name "asymptote") (name "asymptote")
(version "2.40") (version "2.41")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/asymptote/" (uri (string-append "mirror://sourceforge/asymptote/"
version "/asymptote-" version ".src.tgz")) version "/asymptote-" version ".src.tgz"))
(sha256 (sha256
(base32 (base32
"08hy8hgh217df9kwznr22mg8vxxh3rbmbxgx3nqhxyggc9xqy544")))) "1w7fbq6gy65g0mxg6wdxi7v178c5yxvh9yrnv3bzm4sjzf4pwvhx"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; Note: The 'asy' binary retains a reference to docdir for use with its ;; Note: The 'asy' binary retains a reference to docdir for use with its
;; "help" command in interactive mode, so adding a "doc" output is not ;; "help" command in interactive mode, so adding a "doc" output is not

View File

@ -5,6 +5,7 @@
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -220,3 +221,38 @@ sound server.")
graphical user interface to connect to a PulseAudio server and graphical user interface to connect to a PulseAudio server and
easily control the volume of all clients, sinks, etc.") easily control the volume of all clients, sinks, etc.")
(license l:gpl2+))) (license l:gpl2+)))
(define-public ponymix
(package
(name "ponymix")
(version "5")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/falconindy/ponymix/"
"archive/" version ".tar.gz"))
(sha256
(base32
"1c0ch98zry3c4ixywwynjid1n1nh4xl4l1p548giq2w3zwflaghn"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; There is no test suite.
#:make-flags (let ((out (assoc-ref %outputs "out")))
(list (string-append "DESTDIR=" out)))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-paths
(lambda _
(substitute* "Makefile"
(("/usr") ""))))
(delete 'configure)))) ; There's no configure phase.
(inputs
`(("pulseaudio" ,pulseaudio)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "https://github.com/falconindy/ponymix")
(synopsis "Console-based PulseAudio mixer")
(description "Ponymix is a PulseAudio mixer and volume controller with a
command-line interface. In addition, it is possible to use named sources and
sinks.")
(license l:expat)))

View File

@ -7089,7 +7089,7 @@ printing of sub-tables by specifying a row range.")
(home-page "http://www.pytables.org/") (home-page "http://www.pytables.org/")
(synopsis "Hierarchical datasets for Python") (synopsis "Hierarchical datasets for Python")
(description "PyTables is a package for managing hierarchical datasets and (description "PyTables is a package for managing hierarchical datasets and
designed to efficently cope with extremely large amounts of data.") designed to efficiently cope with extremely large amounts of data.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public python2-tables (define-public python2-tables
@ -8691,7 +8691,7 @@ pure Python module that works on virtually all Python versions.")
(description "Execnet provides a share-nothing model with (description "Execnet provides a share-nothing model with
channel-send/receive communication for distributing execution across many channel-send/receive communication for distributing execution across many
Python interpreters across version, platform and network barriers. It has a Python interpreters across version, platform and network barriers. It has a
minimal and fast API targetting the following uses: minimal and fast API targeting the following uses:
@enumerate @enumerate
@item distribute tasks to (many) local or remote CPUs @item distribute tasks to (many) local or remote CPUs
@item write and deploy hybrid multi-process applications @item write and deploy hybrid multi-process applications
@ -10790,7 +10790,7 @@ Python. It generates C++ code and a Makefile."))
(description "Rope is a refactoring library for Python. It facilitates (description "Rope is a refactoring library for Python. It facilitates
the renaming, moving and extracting of attributes, functions, modules, fields the renaming, moving and extracting of attributes, functions, modules, fields
and parameters in Python 2 source code. These refactorings can also be applied and parameters in Python 2 source code. These refactorings can also be applied
to occurences in strings and comments.") to occurrences in strings and comments.")
(license license:gpl2))) (license license:gpl2)))
(define-public python-py3status (define-public python-py3status
@ -13832,7 +13832,7 @@ in other versions.")
(home-page "https://liw.fi/coverage-test-runner/") (home-page "https://liw.fi/coverage-test-runner/")
(synopsis "Python module for running unit tests") (synopsis "Python module for running unit tests")
(description "@code{CoverageTestRunner} is a python module for running (description "@code{CoverageTestRunner} is a python module for running
unit tests and failing them if the unit test module does not excercise all unit tests and failing them if the unit test module does not exercise all
statements in the module it tests.") statements in the module it tests.")
(license license:gpl3+))) (license license:gpl3+)))

View File

@ -146,14 +146,14 @@ anywhere.")
(define-public samba (define-public samba
(package (package
(name "samba") (name "samba")
(version "4.5.7") (version "4.5.8")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download.samba.org/pub/samba/stable/" (uri (string-append "https://download.samba.org/pub/samba/stable/"
"samba-" version ".tar.gz")) "samba-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"004lzl059bc2wvkmivxiy96y87l4ajjw16qvkqcdhf86z2dg0w5c")))) "1w41pxszv5z6gjclg6zymn47mk8n51lnpgcx1k2q18i3i1nnafzn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases '(#:phases

View File

@ -392,7 +392,7 @@ implementation techniques and as an expository tool.")
(define-public racket (define-public racket
(package (package
(name "racket") (name "racket")
(version "6.6") (version "6.8")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (list (string-append "http://mirror.racket-lang.org/installers/" (uri (list (string-append "http://mirror.racket-lang.org/installers/"
@ -402,7 +402,7 @@ implementation techniques and as an expository tool.")
version "/racket/racket-" version "-src-unix.tgz"))) version "/racket/racket-" version "-src-unix.tgz")))
(sha256 (sha256
(base32 (base32
"1kzdi1n6h6hmz8zd9k8r5a5yp2ryi4w3c2fjm1k6cqicn18cwaxz")))) "1l9z1a0r5zydr50cklx9xjw3l0pwnf64i10xq7112fl1r89q3qgv"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases '(#:phases

View File

@ -262,7 +262,7 @@ it a convenient format to store user input files.")
(define-public capnproto (define-public capnproto
(package (package
(name "capnproto") (name "capnproto")
(version "0.5.3") (version "0.5.3.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -270,7 +270,7 @@ it a convenient format to store user input files.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1yvaadhgakskqq5wpv53hd6fc3pp17mrdldw4i5cvgck4iwprcfd")))) "06wi4fcxx58nc7pr2xga20hn11psk56b0yhna5bx2pw90mlcbd84"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

View File

@ -24,11 +24,13 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages audio)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio) #:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages textutils)) #:use-module (gnu packages textutils))
(define-public mitlm (define-public mitlm
@ -75,9 +77,12 @@ efficiency through the use of a compact vector representation of n-grams.")
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(inputs (inputs
`(("dotconf" ,dotconf) `(("dotconf" ,dotconf)
("espeak" ,espeak)
("glib" ,glib) ("glib" ,glib)
("libltdl" ,libltdl) ("libltdl" ,libltdl)
("libsndfile" ,libsndfile))) ("libsndfile" ,libsndfile)
("pulseaudio" ,pulseaudio)
("python" ,python)))
(synopsis "Common interface to speech synthesizers") (synopsis "Common interface to speech synthesizers")
(description "The Speech Dispatcher project provides a high-level (description "The Speech Dispatcher project provides a high-level
device independent layer for access to speech synthesis through a simple, device independent layer for access to speech synthesis through a simple,

View File

@ -59,6 +59,7 @@
(patches (patches
(search-patches "ceph-skip-unittest_blockdev.patch" (search-patches "ceph-skip-unittest_blockdev.patch"
"ceph-skip-collect-sys-info-test.patch" "ceph-skip-collect-sys-info-test.patch"
"ceph-disable-unittest-throttle.patch"
"ceph-disable-cpu-optimizations.patch")) "ceph-disable-cpu-optimizations.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet

View File

@ -85,7 +85,7 @@
gnome-terminal (GNOME) or Konsole (KDE), with the difference that it drops down gnome-terminal (GNOME) or Konsole (KDE), with the difference that it drops down
from the edge of a screen when a certain configurable hotkey is pressed. This from the edge of a screen when a certain configurable hotkey is pressed. This
is similar to the built-in consoles in some applications. Tilda is highly is similar to the built-in consoles in some applications. Tilda is highly
configureable through a graphical wizard.") configurable through a graphical wizard.")
(home-page "https://github.com/lanoxx/tilda") (home-page "https://github.com/lanoxx/tilda")
(license license:gpl2+))) (license license:gpl2+)))

View File

@ -42,18 +42,17 @@
(define-public vis (define-public vis
(package (package
(name "vis") (name "vis")
(version "0.2") (version "0.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/martanne/" (uri (string-append "https://github.com/martanne/"
name "/archive/v" version ".tar.gz")) name "/archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 "0bbmkblpndc53pvr8xcfywdn8g351yxfj8c46zp5d744c3bq2nry")))) (base32 "0xvhkj4j8pcmpnsx7f93d6n2f068xnl7wacfs97vr0agxwrfvn5y"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:make-flags '("CFLAGS=-pie") `(#:tests? #f ; No tests.
#:tests? #f ; No tests.
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'install 'wrap-binary (add-after 'install 'wrap-binary

View File

@ -15,6 +15,8 @@
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Feng Shu <tumashu@163.com> ;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -95,6 +97,7 @@
#:use-module (gnu packages version-control) #:use-module (gnu packages version-control)
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages webkit) #:use-module (gnu packages webkit)
#:use-module (gnu packages wxwidgets)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
#:use-module (gnu packages xiph) #:use-module (gnu packages xiph)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
@ -365,13 +368,13 @@ canvas operations.")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://download.videolan.org/pub/videolan/libdca/" "https://download.videolan.org/pub/videolan/libdca/"
version "/libdca-" version ".tar.bz2")) version "/libdca-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0hh6a7l8vvccsd5i1fkv9av2gzv9fy8m0b8jpsn5p6hh4bh2586v")))) "0hh6a7l8vvccsd5i1fkv9av2gzv9fy8m0b8jpsn5p6hh4bh2586v"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://www.videolan.org/developers/libdca.html") (home-page "https://www.videolan.org/developers/libdca.html")
(synopsis "DTS Coherent Acoustics decoder") (synopsis "DTS Coherent Acoustics decoder")
(description "libdca is a library for decoding DTS Coherent Acoustics (description "libdca is a library for decoding DTS Coherent Acoustics
streams.") streams.")
@ -985,7 +988,7 @@ access to mpv's powerful playback capabilities.")
(define-public youtube-dl (define-public youtube-dl
(package (package
(name "youtube-dl") (name "youtube-dl")
(version "2017.04.14") (version "2017.04.16")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://yt-dl.org/downloads/" (uri (string-append "https://yt-dl.org/downloads/"
@ -993,7 +996,7 @@ access to mpv's powerful playback capabilities.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1rjc4ilafzrig02znrlxwjyzk5rpcc3li55n8rw2c4dmjmvjppkh")))) "1pgdfspzv15772q7kakfq5qx1r70lcviwzk6sz9z1cddxzffxgdd"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; The problem here is that the directory for the man page and completion ;; The problem here is that the directory for the man page and completion
@ -1024,10 +1027,85 @@ YouTube.com and a few more sites.")
(home-page "https://yt-dl.org") (home-page "https://yt-dl.org")
(license license:public-domain))) (license license:public-domain)))
(define-public youtube-dl-gui
(package
(name "youtube-dl-gui")
(version "0.3.8")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Youtube-DLG" version))
(sha256
(base32
"0napxwzgls5ik1bxbp99vly32l23xpc4ng5kr24hfhf21ypjyadb"))))
(build-system python-build-system)
(arguments
;; In Guix, wxpython has not yet been packaged for Python 3.
`(#:python ,python-2
;; This package has no tests.
#:tests? #f
#:phases
(modify-phases %standard-phases
(add-before 'build 'patch-source
(lambda* (#:key inputs #:allow-other-keys)
;; The youtube-dl-gui program lets you configure options. Some of
;; them are problematic, so we change their defaults.
(substitute* "youtube_dl_gui/optionsmanager.py"
;; When this is true, the builder process will try (and fail) to
;; write logs to the builder user's home directory.
(("'enable_log': True") "'enable_log': False")
;; This determines which youtube-dl program youtube-dl-gui will
;; run. If we don't set this, then youtube-dl-gui might download
;; an arbitrary copy from the Internet into the user's home
;; directory and run it, so let's make sure youtube-dl-gui uses
;; the youtube-dl from the inputs by default.
(("'youtubedl_path': self.config_path")
(string-append "'youtubedl_path': '"
(assoc-ref inputs "youtube-dl")
"/bin'"))
;; When this is True, when youtube-dl-gui is finished downloading
;; a file, it will try (and possibly fail) to open the directory
;; containing the downloaded file. This can fail because it
;; assumes that xdg-open is in PATH. Unfortunately, simply
;; adding xdg-utils to the propagated inputs is not enough to
;; make this work, so for now we set the default to False.
(("'open_dl_dir': True") "'open_dl_dir': False"))
;; The youtube-dl program from the inputs is actually a wrapper
;; script written in bash, so attempting to invoke it as a python
;; script will fail.
(substitute* "youtube_dl_gui/downloaders.py"
(("cmd = \\['python', self\\.youtubedl_path\\]")
"cmd = [self.youtubedl_path]"))
;; Use relative paths for installing data files so youtube-dl-gui
;; installs the files relative to its prefix in the store, rather
;; than relative to /. Also, instead of installing data files into
;; $prefix/usr/share, install them into $prefix/share for
;; consistency (see: (standards) Directory Variables).
(substitute* "setup.py"
(("= '/usr/share") "= 'share"))
;; Update get_locale_file() so it finds the installed localization
;; files.
(substitute* "youtube_dl_gui/utils.py"
(("os\\.path\\.join\\('/usr', 'share'")
(string-append "os.path.join('"
(assoc-ref %outputs "out")
"', 'share'"))))))))
(inputs
`(("python2-wxpython" ,python2-wxpython)
("youtube-dl" ,youtube-dl)))
(home-page "https://github.com/MrS0m30n3/youtube-dl-gui")
(synopsis
"GUI (Graphical User Interface) for @command{youtube-dl}")
(description
"Youtube-dlG is a GUI (Graphical User Interface) for
@command{youtube-dl}. You can use it to download videos from YouTube and any
other site that youtube-dl supports.")
(license license:unlicense)))
(define-public you-get (define-public you-get
(package (package
(name "you-get") (name "you-get")
(version "0.4.652") (version "0.4.715")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1035,7 +1113,7 @@ YouTube.com and a few more sites.")
version "/you-get-" version ".tar.gz")) version "/you-get-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0brkz98lycx8mmxjwmn7jlhqfdbvl0hy070n7skwr1k75kh99q30")))) "043122hfh56fbbszp1kwd1f65asgyn60j1ijday93hf2dkhvbrnh"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; no tests ;; no tests
@ -1097,7 +1175,7 @@ players, like VLC or MPlayer.")
(version "5.0.3") (version "5.0.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://download.videolan.org/videolan/" (uri (string-append "https://download.videolan.org/videolan/"
name "/" version "/" name "/" version "/"
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
@ -1120,7 +1198,7 @@ installed).")
(version "5.0.3") (version "5.0.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://download.videolan.org/videolan/" (uri (string-append "https://download.videolan.org/videolan/"
name "/" version "/" name "/" version "/"
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
@ -1154,7 +1232,7 @@ encapsulated.")
(method url-fetch) (method url-fetch)
(uri (uri
(string-append (string-append
"http://download.videolan.org/videolan/libdvdnav/libdvdnav-" "https://download.videolan.org/videolan/libdvdnav/libdvdnav-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -1178,14 +1256,14 @@ encapsulated.")
(version "1.4.0") (version "1.4.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://download.videolan.org/pub/" (uri (string-append "https://download.videolan.org/pub/"
name "/" version "/" name "/" version "/"
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0nl45ifc4xcb196snv9d6hinfw614cqpzcqp92dg43c0hickg290")))) "0nl45ifc4xcb196snv9d6hinfw614cqpzcqp92dg43c0hickg290"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://www.videolan.org/developers/libdvdcss.html") (home-page "https://www.videolan.org/developers/libdvdcss.html")
(synopsis "Library for accessing DVDs as block devices") (synopsis "Library for accessing DVDs as block devices")
(description (description
"libdvdcss is a simple library designed for accessing DVDs like a block "libdvdcss is a simple library designed for accessing DVDs like a block
@ -1491,14 +1569,14 @@ tools, XML authoring components, and an extensible plug-in based API.")
(define-public v4l-utils (define-public v4l-utils
(package (package
(name "v4l-utils") (name "v4l-utils")
(version "1.10.1") (version "1.12.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://linuxtv.org/downloads/v4l-utils" (uri (string-append "https://linuxtv.org/downloads/v4l-utils"
"/v4l-utils-" version ".tar.bz2")) "/v4l-utils-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1h1nhg5cmmzlbipak526nk4bm6d0yb217mll75f3rpg7kz1cqiv1")))) "0vpl3jl0x441y7b5cn7zhdsyi954hp9h2p30jhnr1zkx1rpxsiss"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags
@ -1507,7 +1585,8 @@ tools, XML authoring components, and an extensible plug-in based API.")
"/lib/udev") "/lib/udev")
"CXXFLAGS=-std=gnu++11"))) "CXXFLAGS=-std=gnu++11")))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("perl" ,perl)
("pkg-config" ,pkg-config)))
(inputs (inputs
`(("alsa-lib" ,alsa-lib) `(("alsa-lib" ,alsa-lib)
("glu" ,glu) ("glu" ,glu)
@ -1709,7 +1788,7 @@ and MPEG system streams.")
(inputs (inputs
`(("libgcrypt" ,libgcrypt))) `(("libgcrypt" ,libgcrypt)))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://www.videolan.org/developers/libbdplus.html") (home-page "https://www.videolan.org/developers/libbdplus.html")
(synopsis "Library for decrypting certain Blu-Ray discs") (synopsis "Library for decrypting certain Blu-Ray discs")
(description "libbdplus is a library which implements the BD+ System (description "libbdplus is a library which implements the BD+ System
specifications.") specifications.")
@ -1732,7 +1811,7 @@ specifications.")
`(("bison" ,bison) `(("bison" ,bison)
("flex" ,flex))) ("flex" ,flex)))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://www.videolan.org/developers/libaacs.html") (home-page "https://www.videolan.org/developers/libaacs.html")
(synopsis "Library for decrypting certain Blu-Ray discs") (synopsis "Library for decrypting certain Blu-Ray discs")
(description "libaacs is a library which implements the Advanced Access (description "libaacs is a library which implements the Advanced Access
Content System specification.") Content System specification.")

View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net> ;;; Copyright © 2016, 2017 ng0 <ng0@no-reply.pragmatique.xyz>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
@ -60,7 +60,7 @@
(define-public vim (define-public vim
(package (package
(name "vim") (name "vim")
(version "8.0.0494") (version "8.0.0566")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v" (uri (string-append "https://github.com/vim/vim/archive/v"
@ -68,7 +68,7 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"08kzimdyla35ndrbn68jf8pmzm7nd2qrydnvk57j089m6ajic62r")))) "0qq9pj8391sikzaahlqi289l5wdkbvsdhz8qb6np268yqizpg4p2"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:test-target "test" `(#:test-target "test"

View File

@ -2812,10 +2812,10 @@ X server.")
(define-public xf86-video-intel (define-public xf86-video-intel
(let ((commit "7e9e92c86b0fc4c848d164fe571798add5e1e36e")) (let ((commit "b57abe20e81f4b8e4dd203b6a9eda7ff441bc8ce"))
(package (package
(name "xf86-video-intel") (name "xf86-video-intel")
(version (string-append "2.99.917-4-" (string-take commit 7))) (version (string-append "2.99.917-5-" (string-take commit 7)))
(source (source
(origin (origin
;; there's no current tarball ;; there's no current tarball
@ -2825,7 +2825,7 @@ X server.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0igfw8vpz1q0a2526j81fl65z6avfh6lzzrijcs72gwihqqhb1sv")) "1l08jdrqrpaj2168hlz0hwlx27bm7n7lnv82jjyvy884v47gn2ay"))
(file-name (string-append name "-" version)))) (file-name (string-append name "-" version))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("mesa" ,mesa) (inputs `(("mesa" ,mesa)

View File

@ -25,6 +25,7 @@
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix utils) #:select (source-properties->location))
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
@ -47,11 +48,13 @@
service-type-extensions service-type-extensions
service-type-compose service-type-compose
service-type-extend service-type-extend
service-type-default-value
service service
service? service?
service-kind service-kind
service-parameters service-value
service-parameters ;deprecated
simple-service simple-service
modify-services modify-services
@ -59,6 +62,9 @@
fold-services fold-services
service-error? service-error?
missing-value-service-error?
missing-value-service-error-type
missing-value-service-error-location
missing-target-service-error? missing-target-service-error?
missing-target-service-error-service missing-target-service-error-service
missing-target-service-error-target-type missing-target-service-error-target-type
@ -118,6 +124,10 @@
(target service-extension-target) ;<service-type> (target service-extension-target) ;<service-type>
(compute service-extension-compute)) ;params -> params (compute service-extension-compute)) ;params -> params
(define &no-default-value
;; Value used to denote service types that have no associated default value.
'(no default value))
(define-record-type* <service-type> service-type make-service-type (define-record-type* <service-type> service-type make-service-type
service-type? service-type?
(name service-type-name) ;symbol (for debugging) (name service-type-name) ;symbol (for debugging)
@ -131,7 +141,11 @@
;; Extend the services' own parameters with the extension composition. ;; Extend the services' own parameters with the extension composition.
(extend service-type-extend ;list of Any -> parameters (extend service-type-extend ;list of Any -> parameters
(default #f))) (default #f))
;; Optional default value for instances of this type.
(default-value service-type-default-value ;Any
(default &no-default-value)))
(define (write-service-type type port) (define (write-service-type type port)
(format port "#<service-type ~a ~a>" (format port "#<service-type ~a ~a>"
@ -142,10 +156,56 @@
;; Services of a given type. ;; Services of a given type.
(define-record-type <service> (define-record-type <service>
(service type parameters) (make-service type value)
service? service?
(type service-kind) (type service-kind)
(parameters service-parameters)) (value service-value))
(define-syntax service
(syntax-rules ()
"Return a service instance of TYPE. The service value is VALUE or, if
omitted, TYPE's default value."
((_ type value)
(make-service type value))
((_ type)
(%service-with-default-value (current-source-location)
type))))
(define (%service-with-default-value location type)
"Return a instance of service type TYPE with its default value, if any. If
TYPE does not have a default value, an error is raised."
;; TODO: Currently this is a run-time error but with a little bit macrology
;; we could turn it into an expansion-time error.
(let ((default (service-type-default-value type)))
(if (eq? default &no-default-value)
(let ((location (source-properties->location location)))
(raise
(condition
(&missing-value-service-error (type type) (location location))
(&message
(message (format #f (_ "~a: no value specified \
for service of type '~a'")
(location->string location)
(service-type-name type)))))))
(service type default))))
(define-condition-type &service-error &error
service-error?)
(define-condition-type &missing-value-service-error &service-error
missing-value-service-error?
(type missing-value-service-error-type)
(location missing-value-service-error-location))
;;;
;;; Helpers.
;;;
(define service-parameters
;; Deprecated alias.
service-value)
(define (simple-service name target value) (define (simple-service name target value)
"Return a service that extends TARGET with VALUE. This works by creating a "Return a service that extends TARGET with VALUE. This works by creating a
@ -161,7 +221,7 @@ singleton service type NAME, of which the returned service is an instance."
service) service)
((_ svc (kind param => exp ...) clauses ...) ((_ svc (kind param => exp ...) clauses ...)
(if (eq? (service-kind svc) kind) (if (eq? (service-kind svc) kind)
(let ((param (service-parameters svc))) (let ((param (service-value svc)))
(service (service-kind svc) (service (service-kind svc)
(begin exp ...))) (begin exp ...)))
(%modify-service svc clauses ...))))) (%modify-service svc clauses ...)))))
@ -321,7 +381,7 @@ file."
(define* (activation-service->script service) (define* (activation-service->script service)
"Return as a monadic value the activation script for SERVICE, a service of "Return as a monadic value the activation script for SERVICE, a service of
ACTIVATION-SCRIPT-TYPE." ACTIVATION-SCRIPT-TYPE."
(activation-script (service-parameters service))) (activation-script (service-value service)))
(define (activation-script gexps) (define (activation-script gexps)
"Return the system's activation script, which evaluates GEXPS." "Return the system's activation script, which evaluates GEXPS."
@ -432,7 +492,7 @@ and FILE could be \"/usr/bin/env\"."
(define (etc-directory service) (define (etc-directory service)
"Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE."
(files->etc-directory (service-parameters service))) (files->etc-directory (service-value service)))
(define (files->etc-directory files) (define (files->etc-directory files)
(file-union "etc" files)) (file-union "etc" files))
@ -536,9 +596,6 @@ kernel."
;;; Service folding. ;;; Service folding.
;;; ;;;
(define-condition-type &service-error &error
service-error?)
(define-condition-type &missing-target-service-error &service-error (define-condition-type &missing-target-service-error &service-error
missing-target-service-error? missing-target-service-error?
(service missing-target-service-error-service) (service missing-target-service-error-service)
@ -605,7 +662,7 @@ TARGET-TYPE; return the root service adjusted accordingly."
(match (find (matching-extension target) (match (find (matching-extension target)
(service-type-extensions (service-kind service))) (service-type-extensions (service-kind service)))
(($ <service-extension> _ compute) (($ <service-extension> _ compute)
(compute (service-parameters service)))))) (compute (service-value service))))))
(match (filter (lambda (service) (match (filter (lambda (service)
(eq? (service-kind service) target-type)) (eq? (service-kind service) target-type))
@ -616,7 +673,7 @@ TARGET-TYPE; return the root service adjusted accordingly."
(extensions (map (apply-extension sink) dependents)) (extensions (map (apply-extension sink) dependents))
(extend (service-type-extend (service-kind sink))) (extend (service-type-extend (service-kind sink)))
(compose (service-type-compose (service-kind sink))) (compose (service-type-compose (service-kind sink)))
(params (service-parameters sink))) (params (service-value sink)))
;; We distinguish COMPOSE and EXTEND because PARAMS typically has a ;; We distinguish COMPOSE and EXTEND because PARAMS typically has a
;; different type than the elements of EXTENSIONS. ;; different type than the elements of EXTENSIONS.
(if extend (if extend

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -115,6 +115,7 @@
;; Add Rottlog to the global profile so users can access ;; Add Rottlog to the global profile so users can access
;; the documentation. ;; the documentation.
(service-extension profile-service-type (service-extension profile-service-type
(compose list rottlog-rottlog)))))) (compose list rottlog-rottlog))))
(default-value (rottlog-configuration))))
;;; admin.scm ends here ;;; admin.scm ends here

View File

@ -1424,7 +1424,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(service-extension account-service-type guix-accounts) (service-extension account-service-type guix-accounts)
(service-extension activation-service-type guix-activation) (service-extension activation-service-type guix-activation)
(service-extension profile-service-type (service-extension profile-service-type
(compose list guix-configuration-guix)))))) (compose list guix-configuration-guix))))
(default-value (guix-configuration))))
(define* (guix-service #:optional (config %default-guix-configuration)) (define* (guix-service #:optional (config %default-guix-configuration))
"Return a service that runs the Guix build daemon according to "Return a service that runs the Guix build daemon according to
@ -1477,7 +1478,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(list (service-extension shepherd-root-service-type (list (service-extension shepherd-root-service-type
guix-publish-shepherd-service) guix-publish-shepherd-service)
(service-extension account-service-type (service-extension account-service-type
(const %guix-publish-accounts)))))) (const %guix-publish-accounts))))
(default-value (guix-publish-configuration))))
(define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost")) (define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost"))
"Return a service that runs @command{guix publish} listening on @var{host} "Return a service that runs @command{guix publish} listening on @var{host}

View File

@ -1022,7 +1022,9 @@ extensions that it uses."
(inherit config) (inherit config)
(extensions (extensions
(append (opaque-cups-configuration-extensions config) (append (opaque-cups-configuration-extensions config)
extensions))))))))) extensions)))))))
(default-value (cups-configuration))))
;; A little helper to make it easier to document all those fields. ;; A little helper to make it easier to document all those fields.
(define (generate-cups-documentation) (define (generate-cups-documentation)

View File

@ -162,7 +162,8 @@ database {
(service-extension activation-service-type (service-extension activation-service-type
(const %dicod-activation)) (const %dicod-activation))
(service-extension shepherd-root-service-type (service-extension shepherd-root-service-type
dicod-shepherd-service))))) dicod-shepherd-service)))
(default-value (dicod-configuration))))
(define* (dicod-service #:key (config (dicod-configuration))) (define* (dicod-service #:key (config (dicod-configuration)))
"Return a service that runs the @command{dicod} daemon, an implementation "Return a service that runs the @command{dicod} daemon, an implementation

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -97,7 +97,8 @@
(mcron-configuration (mcron-configuration
(inherit config) (inherit config)
(jobs (append (mcron-configuration-jobs config) (jobs (append (mcron-configuration-jobs config)
jobs))))))) jobs)))))
(default-value (mcron-configuration)))) ;empty job list
(define* (mcron-service jobs #:optional (mcron mcron2)) (define* (mcron-service jobs #:optional (mcron mcron2))
"Return an mcron service running @var{mcron} that schedules @var{jobs}, a "Return an mcron service running @var{mcron} that schedules @var{jobs}, a

View File

@ -529,7 +529,8 @@ make an initial adjustment of more than 1,000 seconds."
tor-configuration? tor-configuration?
(tor tor-configuration-tor (tor tor-configuration-tor
(default tor)) (default tor))
(config-file tor-configuration-config-file) (config-file tor-configuration-config-file
(default (plain-file "empty" "")))
(hidden-services tor-configuration-hidden-services (hidden-services tor-configuration-hidden-services
(default '()))) (default '())))
@ -666,7 +667,8 @@ HiddenServicePort ~a ~a~%"
(inherit config) (inherit config)
(hidden-services (hidden-services
(append (tor-configuration-hidden-services config) (append (tor-configuration-hidden-services config)
services))))))) services)))))
(default-value (tor-configuration))))
(define* (tor-service #:optional (define* (tor-service #:optional
(config-file (plain-file "empty" "")) (config-file (plain-file "empty" ""))
@ -719,9 +721,12 @@ project's documentation} for more information."
bitlbee-configuration? bitlbee-configuration?
(bitlbee bitlbee-configuration-bitlbee (bitlbee bitlbee-configuration-bitlbee
(default bitlbee)) (default bitlbee))
(interface bitlbee-configuration-interface) (interface bitlbee-configuration-interface
(port bitlbee-configuration-port) (default "127.0.0.1"))
(extra-settings bitlbee-configuration-extra-settings)) (port bitlbee-configuration-port
(default 6667))
(extra-settings bitlbee-configuration-extra-settings
(default "")))
(define bitlbee-shepherd-service (define bitlbee-shepherd-service
(match-lambda (match-lambda
@ -789,7 +794,8 @@ project's documentation} for more information."
(service-extension account-service-type (service-extension account-service-type
(const %bitlbee-accounts)) (const %bitlbee-accounts))
(service-extension activation-service-type (service-extension activation-service-type
(const %bitlbee-activation)))))) (const %bitlbee-activation))))
(default-value (bitlbee-configuration))))
(define* (bitlbee-service #:key (bitlbee bitlbee) (define* (bitlbee-service #:key (bitlbee bitlbee)
(interface "127.0.0.1") (port 6667) (interface "127.0.0.1") (port 6667)
@ -1002,7 +1008,8 @@ dns=" dns "
(list (service-extension shepherd-root-service-type (list (service-extension shepherd-root-service-type
wpa-supplicant-shepherd-service) wpa-supplicant-shepherd-service)
(service-extension dbus-root-service-type list) (service-extension dbus-root-service-type list)
(service-extension profile-service-type list))))) (service-extension profile-service-type list)))
(default-value wpa-supplicant)))
;;; ;;;

View File

@ -396,7 +396,8 @@ shutdown on system startup."))
(service-extension udev-service-type (service-extension udev-service-type
(compose list tlp-configuration-tlp)) (compose list tlp-configuration-tlp))
(service-extension activation-service-type (service-extension activation-service-type
tlp-activation))))) tlp-activation)))
(default-value (tlp-configuration))))
(define (generate-tlp-documentation) (define (generate-tlp-documentation)
(generate-documentation (generate-documentation

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
@ -408,7 +408,8 @@ The other options should be self-descriptive."
(service-extension activation-service-type (service-extension activation-service-type
openssh-activation) openssh-activation)
(service-extension account-service-type (service-extension account-service-type
(const %openssh-accounts)))))) (const %openssh-accounts))))
(default-value (openssh-configuration))))
;;; ;;;

View File

@ -3,6 +3,7 @@
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -92,7 +93,7 @@
operating-system-derivation operating-system-derivation
operating-system-profile operating-system-profile
operating-system-grub.cfg operating-system-bootcfg
operating-system-etc-directory operating-system-etc-directory
operating-system-locale-directory operating-system-locale-directory
operating-system-boot-script operating-system-boot-script
@ -614,7 +615,7 @@ hardware-related operations as necessary when booting a Linux container."
(let* ((services (operating-system-services os #:container? container?)) (let* ((services (operating-system-services os #:container? container?))
(boot (fold-services services #:target-type boot-service-type))) (boot (fold-services services #:target-type boot-service-type)))
;; BOOT is the script as a monadic value. ;; BOOT is the script as a monadic value.
(service-parameters boot))) (service-value boot)))
(define (operating-system-user-accounts os) (define (operating-system-user-accounts os)
"Return the list of user accounts of OS." "Return the list of user accounts of OS."
@ -622,12 +623,12 @@ hardware-related operations as necessary when booting a Linux container."
(account (fold-services services (account (fold-services services
#:target-type account-service-type))) #:target-type account-service-type)))
(filter user-account? (filter user-account?
(service-parameters account)))) (service-value account))))
(define (operating-system-shepherd-service-names os) (define (operating-system-shepherd-service-names os)
"Return the list of Shepherd service names for OS." "Return the list of Shepherd service names for OS."
(append-map shepherd-service-provision (append-map shepherd-service-provision
(service-parameters (service-value
(fold-services (operating-system-services os) (fold-services (operating-system-services os)
#:target-type #:target-type
shepherd-root-service-type)))) shepherd-root-service-type))))
@ -637,7 +638,7 @@ hardware-related operations as necessary when booting a Linux container."
(let* ((services (operating-system-services os #:container? container?)) (let* ((services (operating-system-services os #:container? container?))
(system (fold-services services))) (system (fold-services services)))
;; SYSTEM contains the derivation as a monadic value. ;; SYSTEM contains the derivation as a monadic value.
(service-parameters system))) (service-value system)))
(define* (operating-system-profile os #:key container?) (define* (operating-system-profile os #:key container?)
"Return a derivation that builds the system profile of OS." "Return a derivation that builds the system profile of OS."
@ -700,8 +701,8 @@ listed in OS. The C library expects to find it under
(locale-directory definitions (locale-directory definitions
#:libcs (operating-system-locale-libcs os))) #:libcs (operating-system-locale-libcs os)))
(define (kernel->grub-label kernel) (define (kernel->boot-label kernel)
"Return a label for the GRUB menu entry that boots KERNEL." "Return a label for the bootloader menu entry that boots KERNEL."
(string-append "GNU with " (string-append "GNU with "
(string-titlecase (package-name kernel)) " " (string-titlecase (package-name kernel)) " "
(package-version kernel) (package-version kernel)
@ -728,14 +729,14 @@ listed in OS. The C library expects to find it under
"Return the file system that contains the store of OS." "Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os))) (store-file-system (operating-system-file-systems os)))
(define* (operating-system-grub.cfg os #:optional (old-entries '())) (define* (operating-system-bootcfg os #:optional (old-entries '()))
"Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the "Return the bootloader configuration file for OS. Use OLD-ENTRIES to
\"old entries\" menu." populate the \"old entries\" menu."
(mlet* %store-monad (mlet* %store-monad
((system (operating-system-derivation os)) ((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os)) (root-fs -> (operating-system-root-file-system os))
(store-fs -> (operating-system-store-file-system os)) (store-fs -> (operating-system-store-file-system os))
(label -> (kernel->grub-label (operating-system-kernel os))) (label -> (kernel->boot-label (operating-system-kernel os)))
(kernel -> (operating-system-kernel-file os)) (kernel -> (operating-system-kernel-file os))
(initrd (operating-system-initrd-file os)) (initrd (operating-system-initrd-file os))
(root-device -> (if (eq? 'uuid (file-system-title root-fs)) (root-device -> (if (eq? 'uuid (file-system-title root-fs))
@ -745,7 +746,7 @@ listed in OS. The C library expects to find it under
(label label) (label label)
;; The device where the kernel and initrd live. ;; The device where the kernel and initrd live.
(device (grub-device store-fs)) (device (fs->boot-device store-fs))
(device-mount-point (device-mount-point
(file-system-mount-point store-fs)) (file-system-mount-point store-fs))
@ -760,7 +761,7 @@ listed in OS. The C library expects to find it under
(grub-configuration-file (operating-system-bootloader os) entries (grub-configuration-file (operating-system-bootloader os) entries
#:old-entries old-entries))) #:old-entries old-entries)))
(define (grub-device fs) (define (fs->boot-device fs)
"Given FS, a <file-system> object, return a value suitable for use as the "Given FS, a <file-system> object, return a value suitable for use as the
device in a <menu-entry>." device in a <menu-entry>."
(case (file-system-title fs) (case (file-system-title fs)
@ -774,7 +775,7 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(mlet %store-monad ((initrd (operating-system-initrd-file os)) (mlet %store-monad ((initrd (operating-system-initrd-file os))
(root -> (operating-system-root-file-system os)) (root -> (operating-system-root-file-system os))
(store -> (operating-system-store-file-system os)) (store -> (operating-system-store-file-system os))
(label -> (kernel->grub-label (label -> (kernel->boot-label
(operating-system-kernel os)))) (operating-system-kernel os))))
(gexp->file "parameters" (gexp->file "parameters"
#~(boot-parameters #~(boot-parameters
@ -786,7 +787,7 @@ this file is the reconstruction of GRUB menu entries for old configurations."
#$(operating-system-kernel-arguments os)) #$(operating-system-kernel-arguments os))
(initrd #$initrd) (initrd #$initrd)
(store (store
(device #$(grub-device store)) (device #$(fs->boot-device store))
(mount-point #$(file-system-mount-point store)))) (mount-point #$(file-system-mount-point store))))
#:set-load-path? #f))) #:set-load-path? #f)))

View File

@ -26,6 +26,7 @@
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix download) #:use-module (guix download)
#:use-module (gnu artwork) #:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub) #:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip) #:autoload (gnu packages compression) (gzip)
@ -275,7 +276,8 @@ code."
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries <file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system." corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (grub-configuration-menu-entries config))) (append entries
(grub-configuration-menu-entries config)))
(define entry->gexp (define entry->gexp
(match-lambda (match-lambda
@ -298,9 +300,9 @@ corresponding to old generations of the system."
#$initrd))))) #$initrd)))))
(mlet %store-monad ((sugar (eye-candy config (mlet %store-monad ((sugar (eye-candy config
(menu-entry-device (first entries)) (menu-entry-device (first all-entries))
(menu-entry-device-mount-point (menu-entry-device-mount-point
(first entries)) (first all-entries))
#:system system #:system system
#:port #~port))) #:port #~port)))
(define builder (define builder

View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -284,10 +285,10 @@ to USB sticks meant to be read-only."
file-systems-to-keep))))) file-systems-to-keep)))))
(mlet* %store-monad ((os-drv (operating-system-derivation os)) (mlet* %store-monad ((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os))) (bootcfg (operating-system-bootcfg os)))
(qemu-image #:name name (qemu-image #:name name
#:os-derivation os-drv #:os-derivation os-drv
#:grub-configuration grub.cfg #:grub-configuration bootcfg
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:disk-image-format "raw" #:disk-image-format "raw"
#:file-system-type file-system-type #:file-system-type file-system-type
@ -295,7 +296,7 @@ to USB sticks meant to be read-only."
#:copy-inputs? #t #:copy-inputs? #t
#:register-closures? #t #:register-closures? #t
#:inputs `(("system" ,os-drv) #:inputs `(("system" ,os-drv)
("grub.cfg" ,grub.cfg)))))) ("bootcfg" ,bootcfg))))))
(define* (system-qemu-image os (define* (system-qemu-image os
#:key #:key
@ -328,13 +329,13 @@ of the GNU system as described by OS."
file-systems-to-keep))))) file-systems-to-keep)))))
(mlet* %store-monad (mlet* %store-monad
((os-drv (operating-system-derivation os)) ((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os))) (bootcfg (operating-system-bootcfg os)))
(qemu-image #:os-derivation os-drv (qemu-image #:os-derivation os-drv
#:grub-configuration grub.cfg #:grub-configuration bootcfg
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:file-system-type file-system-type #:file-system-type file-system-type
#:inputs `(("system" ,os-drv) #:inputs `(("system" ,os-drv)
("grub.cfg" ,grub.cfg)) ("bootcfg" ,bootcfg))
#:copy-inputs? #t)))) #:copy-inputs? #t))))
@ -423,16 +424,16 @@ When FULL-BOOT? is true, return an image that does a complete boot sequence,
bootloaded included; thus, make a disk image that contains everything the bootloaded included; thus, make a disk image that contains everything the
bootloader refers to: OS kernel, initrd, bootloader data, etc." bootloader refers to: OS kernel, initrd, bootloader data, etc."
(mlet* %store-monad ((os-drv (operating-system-derivation os)) (mlet* %store-monad ((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os))) (bootcfg (operating-system-bootcfg os)))
;; XXX: When FULL-BOOT? is true, we end up creating an image that contains ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
;; GRUB.CFG and all its dependencies, including the output of OS-DRV. ;; 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 ;; 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. ;; font, and the background image), but it's hard to filter that.
(qemu-image #:os-derivation os-drv (qemu-image #:os-derivation os-drv
#:grub-configuration grub.cfg #:grub-configuration bootcfg
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:inputs (if full-boot? #:inputs (if full-boot?
`(("grub.cfg" ,grub.cfg)) `(("bootcfg" ,bootcfg))
'()) '())
;; XXX: Passing #t here is too slow, so let it off by default. ;; XXX: Passing #t here is too slow, so let it off by default.

View File

@ -56,7 +56,7 @@ passed a gexp denoting the marionette, and it must return gexp that is
inserted before the first test. This is used to introduce an extra inserted before the first test. This is used to introduce an extra
initialization step, such as entering a LUKS passphrase." initialization step, such as entering a LUKS passphrase."
(define special-files (define special-files
(service-parameters (service-value
(fold-services (operating-system-services os) (fold-services (operating-system-services os)
#:target-type special-files-service-type))) #:target-type special-files-service-type)))

View File

@ -97,15 +97,16 @@
'(begin '(begin
(use-modules (ice-9 rdelim)) (use-modules (ice-9 rdelim))
(let ((sock (socket PF_INET SOCK_STREAM 0))) (let ((sock (socket PF_INET SOCK_STREAM 0)))
(let loop () (let loop ((i 0))
(pk 'try) (pk 'try i)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock AF_INET INADDR_LOOPBACK 2628)) (connect sock AF_INET INADDR_LOOPBACK 2628))
(lambda args (lambda args
(pk 'connection-error args) (pk 'connection-error args)
(sleep 1) (when (< i 20)
(loop)))) (sleep 1)
(loop (+ 1 i))))))
(read-line sock 'concat))) (read-line sock 'concat)))
marionette)) marionette))

View File

@ -19,7 +19,6 @@
(define-module (gnu tests web) (define-module (gnu tests web)
#:use-module (gnu tests) #:use-module (gnu tests)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system vm) #:use-module (gnu system vm)

View File

@ -124,6 +124,11 @@
"http://tenet.dl.sourceforge.net/project/" "http://tenet.dl.sourceforge.net/project/"
"http://vorboss.dl.sourceforge.net/project/" "http://vorboss.dl.sourceforge.net/project/"
"http://netassist.dl.sourceforge.net/project/") "http://netassist.dl.sourceforge.net/project/")
(netfilter.org ; https://www.netfilter.org/mirrors.html
"http://ftp.netfilter.org/pub/"
"ftp://ftp.es.netfilter.org/mirrors/netfilter/"
"ftp://ftp.hu.netfilter.org/"
"ftp://www.lt.netfilter.org/pub/")
(kernel.org (kernel.org
"http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/" "http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/"
"http://linux-kernel.uio.no/pub/" "http://linux-kernel.uio.no/pub/"

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -134,10 +134,9 @@ fields, and DELAYED is the list of identifiers of delayed fields."
((_ (field value) (... ...)) ((_ (field value) (... ...))
(let ((fields (map syntax->datum #'(field (... ...))))) (let ((fields (map syntax->datum #'(field (... ...)))))
(define (field-value f) (define (field-value f)
(or (and=> (find (lambda (x) (or (find (lambda (x)
(eq? f (car (syntax->datum x)))) (eq? f (syntax->datum x)))
#'((field value) (... ...))) #'(field (... ...)))
car)
(wrap-field-value f (field-default-value f)))) (wrap-field-value f (field-default-value f))))
(let ((fields (append fields (map car default-values)))) (let ((fields (append fields (map car default-values))))

View File

@ -233,30 +233,27 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
(format #f (_ "invalid description: ~s") description) (format #f (_ "invalid description: ~s") description)
'description)))) 'description))))
(define (warn-if-package-has-input linted inputs-to-check input-names message) (define (package-input-intersection inputs-to-check input-names)
;; Emit a warning MESSAGE if some of the inputs named in INPUT-NAMES are "Return the intersection between INPUTS-TO-CHECK, the list of input tuples
;; contained in INPUTS-TO-CHECK, which are assumed to be inputs of package of a package, and INPUT-NAMES, a list of package specifications such as
;; LINTED. \"glib:bin\"."
(match inputs-to-check (match inputs-to-check
(((labels packages . outputs) ...) (((labels packages . outputs) ...)
(for-each (lambda (package output) (filter-map (lambda (package output)
(when (package? package) (and (package? package)
(let ((input (string-append (let ((input (string-append
(package-name package) (package-name package)
(if (> (length output) 0) (if (> (length output) 0)
(string-append ":" (car output)) (string-append ":" (car output))
"")))) ""))))
(when (member input input-names) (and (member input input-names)
(emit-warning linted input))))
(format #f (_ message) input) packages outputs))))
'inputs-to-check)))))
packages outputs))))
(define (check-inputs-should-be-native package) (define (check-inputs-should-be-native package)
;; Emit a warning if some inputs of PACKAGE are likely to belong to its ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
;; native inputs. ;; native inputs.
(let ((message "'~a' should probably be a native input") (let ((inputs (package-inputs package))
(inputs (package-inputs package))
(input-names (input-names
'("pkg-config" '("pkg-config"
"extra-cmake-modules" "extra-cmake-modules"
@ -274,24 +271,29 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
"python-pytest-cov" "python2-pytest-cov" "python-pytest-cov" "python2-pytest-cov"
"python-setuptools-scm" "python2-setuptools-scm" "python-setuptools-scm" "python2-setuptools-scm"
"python-sphinx" "python2-sphinx"))) "python-sphinx" "python2-sphinx")))
(warn-if-package-has-input package inputs input-names message))) (for-each (lambda (input)
(emit-warning
package
(format #f (_ "'~a' should probably be a native input")
input)
'inputs-to-check))
(package-input-intersection inputs input-names))))
(define (check-inputs-should-not-be-an-input-at-all package) (define (check-inputs-should-not-be-an-input-at-all package)
;; Emit a warning if some inputs of PACKAGE are likely to should not be ;; Emit a warning if some inputs of PACKAGE are likely to should not be
;; an input at all. ;; an input at all.
(let ((message "'~a' should probably not be an input at all") (let ((input-names '("python-setuptools"
(inputs (package-inputs package)) "python2-setuptools"
(input-names "python-pip"
'("python-setuptools" "python2-pip")))
"python2-setuptools" (for-each (lambda (input)
"python-pip" (emit-warning
"python2-pip"))) package
(warn-if-package-has-input package (package-inputs package) (format #f
input-names message) (_ "'~a' should probably not be an input at all")
(warn-if-package-has-input package (package-native-inputs package) input)))
input-names message) (package-input-intersection (package-direct-inputs package)
(warn-if-package-has-input package (package-propagated-inputs package) input-names))))
input-names message)))
(define (package-name-regexp package) (define (package-name-regexp package)
"Return a regexp that matches PACKAGE's name as a word at the beginning of a "Return a regexp that matches PACKAGE's name as a word at the beginning of a

View File

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -77,6 +78,29 @@
;;; Installation. ;;; Installation.
;;; ;;;
(define-syntax-rule (save-load-path-excursion body ...)
"Save the current values of '%load-path' and '%load-compiled-path', run
BODY..., and restore them."
(let ((path %load-path)
(cpath %load-compiled-path))
(dynamic-wind
(const #t)
(lambda ()
body ...)
(lambda ()
(set! %load-path path)
(set! %load-compiled-path cpath)))))
(define-syntax-rule (save-environment-excursion body ...)
"Save the current environment variables, run BODY..., and restore them."
(let ((env (environ)))
(dynamic-wind
(const #t)
(lambda ()
body ...)
(lambda ()
(environ env)))))
(define topologically-sorted* (define topologically-sorted*
(store-lift topologically-sorted)) (store-lift topologically-sorted))
@ -201,29 +225,6 @@ the ownership of '~a' may be incorrect!~%")
;; The system profile. ;; The system profile.
(string-append %state-directory "/profiles/system")) (string-append %state-directory "/profiles/system"))
(define-syntax-rule (save-environment-excursion body ...)
"Save the current environment variables, run BODY..., and restore them."
(let ((env (environ)))
(dynamic-wind
(const #t)
(lambda ()
body ...)
(lambda ()
(environ env)))))
(define-syntax-rule (save-load-path-excursion body ...)
"Save the current values of '%load-path' and '%load-compiled-path', run
BODY..., and restore them."
(let ((path %load-path)
(cpath %load-compiled-path))
(dynamic-wind
(const #t)
(lambda ()
body ...)
(lambda ()
(set! %load-path path)
(set! %load-compiled-path cpath)))))
(define-syntax-rule (with-shepherd-error-handling mbody ...) (define-syntax-rule (with-shepherd-error-handling mbody ...)
"Catch and report Shepherd errors that arise when binding MBODY, a monadic "Catch and report Shepherd errors that arise when binding MBODY, a monadic
expression in %STORE-MONAD." expression in %STORE-MONAD."
@ -288,7 +289,7 @@ This is currently very conservative in that it does not stop or unload any
running service. Unloading or stopping the wrong service ('udev', say) could running service. Unloading or stopping the wrong service ('udev', say) could
bring the system down." bring the system down."
(define new-services (define new-services
(service-parameters (service-value
(fold-services (operating-system-services os) (fold-services (operating-system-services os)
#:target-type shepherd-root-service-type))) #:target-type shepherd-root-service-type)))
@ -362,6 +363,24 @@ it atomically, and then run OS's activation script."
(date->string (time-utc->date time) (date->string (time-utc->date time)
"~Y-~m-~d ~H:~M"))) "~Y-~m-~d ~H:~M")))
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers (generation-numbers profile)))
"Return a list of 'menu-entry' for the generations of PROFILE specified by
NUMBERS, which is a list of generation numbers."
(define (system->boot-parameters system number time)
(unless-file-not-found
(let* ((file (string-append system "/parameters"))
(params (call-with-input-file file
read-boot-parameters)))
params)))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
(unless-file-not-found
(stat:mtime (lstat system))))
systems)))
(filter-map system->boot-parameters systems numbers times)))
(define* (profile-grub-entries #:optional (profile %system-profile) (define* (profile-grub-entries #:optional (profile %system-profile)
(numbers (generation-numbers profile))) (numbers (generation-numbers profile)))
"Return a list of 'menu-entry' for the generations of PROFILE specified by "Return a list of 'menu-entry' for the generations of PROFILE specified by
@ -468,7 +487,7 @@ open connection to the store."
(define (service-node-label service) (define (service-node-label service)
"Return a label to represent SERVICE." "Return a label to represent SERVICE."
(let ((type (service-kind service)) (let ((type (service-kind service))
(value (service-parameters service))) (value (service-value service)))
(string-append (symbol->string (service-type-name type)) (string-append (symbol->string (service-type-name type))
(cond ((or (number? value) (symbol? value)) (cond ((or (number? value) (symbol? value))
(string-append " " (object->string value))) (string-append " " (object->string value)))
@ -590,7 +609,7 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
(warning (_ "Failing to do that may downgrade your system!~%")))) (warning (_ "Failing to do that may downgrade your system!~%"))))
(define* (perform-action action os (define* (perform-action action os
#:key grub? dry-run? derivations-only? #:key bootloader? dry-run? derivations-only?
use-substitutes? device target use-substitutes? device target
image-size full-boot? image-size full-boot?
(mappings '()) (mappings '())
@ -621,16 +640,16 @@ output when building a system derivation, such as a disk image."
(operating-system-bootloader os)))) (operating-system-bootloader os))))
(grub.cfg (if (eq? 'container action) (grub.cfg (if (eq? 'container action)
(return #f) (return #f)
(operating-system-grub.cfg os (operating-system-bootcfg os
(if (eq? 'init action) (if (eq? 'init action)
'() '()
(profile-grub-entries))))) (profile-grub-entries)))))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
;; root. See <http://bugs.gnu.org/21068>. ;; root. See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure)) (drvs -> (if (memq action '(init reconfigure))
(if grub? (if bootloader?
(list sys grub.cfg grub) (list sys grub.cfg grub)
(list sys grub.cfg)) (list sys grub.cfg))
(list sys))) (list sys)))
@ -647,7 +666,7 @@ output when building a system derivation, such as a disk image."
drvs) drvs)
;; Make sure GRUB is accessible. ;; Make sure GRUB is accessible.
(when grub? (when bootloader?
(let ((prefix (derivation->output-path grub))) (let ((prefix (derivation->output-path grub)))
(setenv "PATH" (setenv "PATH"
(string-append prefix "/bin:" prefix "/sbin:" (string-append prefix "/bin:" prefix "/sbin:"
@ -657,7 +676,7 @@ output when building a system derivation, such as a disk image."
((reconfigure) ((reconfigure)
(mbegin %store-monad (mbegin %store-monad
(switch-to-system os) (switch-to-system os)
(mwhen grub? (mwhen bootloader?
(install-grub* (derivation->output-path grub.cfg) (install-grub* (derivation->output-path grub.cfg)
device "/")))) device "/"))))
((init) ((init)
@ -665,7 +684,7 @@ output when building a system derivation, such as a disk image."
(format #t (_ "initializing operating system under '~a'...~%") (format #t (_ "initializing operating system under '~a'...~%")
target) target)
(install sys (canonicalize-path target) (install sys (canonicalize-path target)
#:grub? grub? #:grub? bootloader?
#:grub.cfg (derivation->output-path grub.cfg) #:grub.cfg (derivation->output-path grub.cfg)
#:device device)) #:device device))
(else (else
@ -692,7 +711,7 @@ output when building a system derivation, such as a disk image."
(let* ((services (operating-system-services os)) (let* ((services (operating-system-services os))
(pid1 (fold-services services (pid1 (fold-services services
#:target-type shepherd-root-service-type)) #:target-type shepherd-root-service-type))
(shepherds (service-parameters pid1)) ;list of <shepherd-service> (shepherds (service-value pid1)) ;list of <shepherd-service>
(sinks (filter (lambda (service) (sinks (filter (lambda (service)
(null? (shepherd-service-requirement service))) (null? (shepherd-service-requirement service)))
shepherds))) shepherds)))
@ -746,7 +765,7 @@ Some ACTIONS support additional ARGS.\n"))
(display (_ " (display (_ "
--image-size=SIZE for 'vm-image', produce an image of SIZE")) --image-size=SIZE for 'vm-image', produce an image of SIZE"))
(display (_ " (display (_ "
--no-grub for 'init', do not install GRUB")) --no-bootloader for 'init', do not install a bootloader"))
(display (_ " (display (_ "
--share=SPEC for 'vm', share host file system according to SPEC")) --share=SPEC for 'vm', share host file system according to SPEC"))
(display (_ " (display (_ "
@ -785,9 +804,9 @@ Some ACTIONS support additional ARGS.\n"))
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'image-size (size->number arg) (alist-cons 'image-size (size->number arg)
result))) result)))
(option '("no-grub") #f #f (option '("no-bootloader" "no-grub") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'install-grub? #f result))) (alist-cons 'install-bootloader? #f result)))
(option '("full-boot") #f #f (option '("full-boot") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'full-boot? #t result))) (alist-cons 'full-boot? #t result)))
@ -824,7 +843,7 @@ Some ACTIONS support additional ARGS.\n"))
(max-silent-time . 3600) (max-silent-time . 3600)
(verbosity . 0) (verbosity . 0)
(image-size . ,(* 900 (expt 2 20))) (image-size . ,(* 900 (expt 2 20)))
(install-grub? . #t))) (install-bootloader? . #t)))
;;; ;;;
@ -836,23 +855,23 @@ Some ACTIONS support additional ARGS.\n"))
ACTION must be one of the sub-commands that takes an operating system ACTION must be one of the sub-commands that takes an operating system
declaration as an argument (a file name.) OPTS is the raw alist of options declaration as an argument (a file name.) OPTS is the raw alist of options
resulting from command-line parsing." resulting from command-line parsing."
(let* ((file (match args (let* ((file (match args
(() #f) (() #f)
((x . _) x))) ((x . _) x)))
(system (assoc-ref opts 'system)) (system (assoc-ref opts 'system))
(os (if file (os (if file
(load* file %user-module (load* file %user-module
#:on-error (assoc-ref opts 'on-error)) #:on-error (assoc-ref opts 'on-error))
(leave (_ "no configuration file specified~%")))) (leave (_ "no configuration file specified~%"))))
(dry? (assoc-ref opts 'dry-run?)) (dry? (assoc-ref opts 'dry-run?))
(grub? (assoc-ref opts 'install-grub?)) (bootloader? (assoc-ref opts 'install-bootloader?))
(target (match args (target (match args
((first second) second) ((first second) second)
(_ #f))) (_ #f)))
(device (and grub? (device (and bootloader?
(grub-configuration-device (grub-configuration-device
(operating-system-bootloader os))))) (operating-system-bootloader os)))))
(with-store store (with-store store
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
@ -878,7 +897,7 @@ resulting from command-line parsing."
m) m)
(_ #f)) (_ #f))
opts) opts)
#:grub? grub? #:bootloader? bootloader?
#:target target #:device device #:target target #:device device
#:gc-root (assoc-ref opts 'gc-root))))) #:gc-root (assoc-ref opts 'gc-root)))))
#:system system)))) #:system system))))

View File

@ -214,9 +214,8 @@ substitute invalid byte sequences with question marks. This is a
(write-string "contents" p) (write-string "contents" p)
(write-long-long size p) (write-long-long size p)
(call-with-binary-input-file file (call-with-binary-input-file file
;; Use `sendfile' when available (Guile 2.0.8+). ;; Use 'sendfile' when P is a file port.
(if (and (compile-time-value (defined? 'sendfile)) (if (file-port? p)
(file-port? p))
(cut sendfile p <> size 0) (cut sendfile p <> size 0)
(cut dump <> p size))) (cut dump <> p size)))
(write-padding size p)) (write-padding size p))

View File

@ -260,7 +260,11 @@ ARGS is the list of arguments received by the 'throw' handler."
(format (current-error-port) (_ "~a: error: ~a~%") (format (current-error-port) (_ "~a: error: ~a~%")
(location->string loc) message))) (location->string loc) message)))
(('srfi-34 obj) (('srfi-34 obj)
(report-error (_ "exception thrown: ~s~%") obj)) (if (message-condition? obj)
(report-error (_ "~a~%")
(gettext (condition-message obj)
%gettext-domain))
(report-error (_ "exception thrown: ~s~%") obj)))
((error args ...) ((error args ...)
(report-error (_ "failed to load '~a':~%") file) (report-error (_ "failed to load '~a':~%") file)
(apply display-error frame (current-error-port) args)))) (apply display-error frame (current-error-port) args))))
@ -277,8 +281,12 @@ exiting. ARGS is the list of arguments received by the 'throw' handler."
(format (current-error-port) (_ "~a: warning: ~a~%") (format (current-error-port) (_ "~a: warning: ~a~%")
(location->string loc) message))) (location->string loc) message)))
(('srfi-34 obj) (('srfi-34 obj)
(warning (_ "failed to load '~a': exception thrown: ~s~%") (if (message-condition? obj)
file obj)) (warning (_ "failed to load '~a': ~a~%")
file
(gettext (condition-message obj) %gettext-domain))
(warning (_ "failed to load '~a': exception thrown: ~s~%")
file obj)))
((error args ...) ((error args ...)
(warning (_ "failed to load '~a':~%") file) (warning (_ "failed to load '~a':~%") file)
(apply display-error #f (current-error-port) args)))) (apply display-error #f (current-error-port) args))))
@ -539,7 +547,11 @@ similar."
(('syntax-error proc message properties form . rest) (('syntax-error proc message properties form . rest)
(report-error (_ "syntax error: ~a~%") message)) (report-error (_ "syntax error: ~a~%") message))
(('srfi-34 obj) (('srfi-34 obj)
(report-error (_ "exception thrown: ~s~%") obj)) (if (message-condition? obj)
(report-error (_ "~a~%")
(gettext (condition-message obj)
%gettext-domain))
(report-error (_ "exception thrown: ~s~%") obj)))
((error args ...) ((error args ...)
(apply display-error #f (current-error-port) args)) (apply display-error #f (current-error-port) args))
(what? #f)) (what? #f))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -31,6 +31,17 @@
(test-begin "services") (test-begin "services")
(test-equal "services, default value"
'(42 123 234 error)
(let* ((t1 (service-type (name 't1) (extensions '())))
(t2 (service-type (name 't2) (extensions '())
(default-value 42))))
(list (service-value (service t2))
(service-value (service t2 123))
(service-value (service t1 234))
(guard (c ((missing-value-service-error? c) 'error))
(service t1)))))
(test-assert "service-back-edges" (test-assert "service-back-edges"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '())
(compose +) (extend *))) (compose +) (extend *)))
@ -75,7 +86,7 @@
(iota 5 1))) (iota 5 1)))
#:target-type t1))) #:target-type t1)))
(and (eq? (service-kind r) t1) (and (eq? (service-kind r) t1)
(service-parameters r)))) (service-value r))))
(test-assert "fold-services, ambiguity" (test-assert "fold-services, ambiguity"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '())