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

Merge branch 'master' into security-updates

This commit is contained in:
Mark H Weaver 2016-03-15 12:40:53 -04:00
parent 2c9f0b0770 20095cc513
commit a3b84f70d8
38 changed files with 18342 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile.am
View File

@ -56,6 +56,7 @@ MODULES = \
guix/graph.scm \
guix/cve.scm \
guix/build-system.scm \
guix/build-system/ant.scm \
guix/build-system/cmake.scm \
guix/build-system/emacs.scm \
guix/build-system/glib-or-gtk.scm \
@ -75,6 +76,7 @@ MODULES = \
guix/cvs-download.scm \
guix/svn-download.scm \
guix/ui.scm \
guix/build/ant-build-system.scm \
guix/build/download.scm \
guix/build/cmake-build-system.scm \
guix/build/emacs-build-system.scm \
@ -171,8 +173,10 @@ dist_noinst_DATA = guix/tests.scm
# Linux-Libre configurations.
KCONFIGS = \
gnu/packages/linux-libre-i686.conf \
gnu/packages/linux-libre-x86_64.conf \
gnu/packages/linux-libre-4.5-i686.conf \
gnu/packages/linux-libre-4.5-x86_64.conf \
gnu/packages/linux-libre-4.4-i686.conf \
gnu/packages/linux-libre-4.4-x86_64.conf \
gnu/packages/linux-libre-4.1-i686.conf \
gnu/packages/linux-libre-4.1-x86_64.conf

175
doc/guix.texi
View File

@ -16,8 +16,9 @@ Copyright @copyright{} 2013 Nikita Karetnikov@*
Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
Copyright @copyright{} 2014 Pierre-Antoine Rault@*
Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
Copyright @copyright{} 2015, 2016 Leo Famulari
Copyright @copyright{} 2016 Ben Woodcroft
Copyright @copyright{} 2015, 2016 Leo Famulari@*
Copyright @copyright{} 2016 Ben Woodcroft@*
Copyright @copyright{} 2016 Chris Marusich
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -154,6 +155,12 @@ Utilities
* Invoking guix challenge:: Challenging substitute servers.
* Invoking guix container:: Process isolation.
Invoking @command{guix build}
* Common Build Options:: Build options for most commands.
* Package Transformation Options:: Creating variants of packages.
* Additional Build Options:: Options specific to 'guix build'.
GNU Distribution
* System Installation:: Installing the whole operating system.
@ -165,6 +172,15 @@ GNU Distribution
* Bootstrapping:: GNU/Linux built from scratch.
* Porting:: Targeting another platform or kernel.
System Installation
* Limitations:: What you can expect.
* Hardware Considerations:: Supported hardware.
* USB Stick Installation:: Preparing the installation medium.
* Preparing for Installation:: Networking, partitioning, etc.
* Proceeding with the Installation:: The real thing.
* Building the Installation Image:: How this comes to be.
System Configuration
* Using the Configuration System:: Customizing your GNU system.
@ -2720,6 +2736,27 @@ of @var{gnu-build-system}, and differ mainly in the set of inputs
implicitly added to the build process, and in the list of phases
executed. Some of these build systems are listed below.
@defvr {Scheme Variable} ant-build-system
This variable is exported by @code{(guix build-system ant)}. It
implements the build procedure for Java packages that can be built with
@url{http://ant.apache.org/, Ant build tool}.
It adds both @code{ant} and the @dfn{Java Development Kit} (JDK) as
provided by the @code{icedtea} package to the set of inputs. Different
packages can be specified with the @code{#:ant} and @code{#:jdk}
parameters, respectively.
When the original package does not provide a suitable Ant build file,
the parameter @code{#:jar-name} can be used to generate a minimal Ant
build file @file{build.xml} with tasks to build the specified jar
archive.
The parameter @code{#:build-target} can be used to specify the Ant task
that should be run during the @code{build} phase. By default the
``jar'' task will be run.
@end defvr
@defvr {Scheme Variable} cmake-build-system
This variable is exported by @code{(guix build-system cmake)}. It
implements the build procedure for packages using the
@ -5636,11 +5673,12 @@ link that follows: @pxref{Help,,, info, Info: An Introduction}. Hit
@end ifinfo
@menu
* Limitations:: What you can expect.
* USB Stick Installation:: Preparing the installation medium.
* Preparing for Installation:: Networking, partitioning, etc.
* Proceeding with the Installation:: The real thing.
* Building the Installation Image:: How this comes to be.
* Limitations:: What you can expect.
* Hardware Considerations:: Supported hardware.
* USB Stick Installation:: Preparing the installation medium.
* Preparing for Installation:: Networking, partitioning, etc.
* Proceeding with the Installation:: The real thing.
* Building the Installation Image:: How this comes to be.
@end menu
@node Limitations
@ -5686,6 +5724,40 @@ You have been warned! But more than a disclaimer, this is an invitation
to report issues (and success stories!), and to join us in improving it.
@xref{Contributing}, for more info.
@node Hardware Considerations
@subsection Hardware Considerations
@cindex hardware support on GuixSD
GNU@tie{}GuixSD focuses on respecting the user's computing freedom. It
builds around the kernel Linux-libre, which means that only hardware for
which free software drivers and firmware exists is supported. Nowadays,
a wide range of off-the-shelf hardware is supported on
GNU/Linux-libre---from keyboards to graphics cards to scanners and
Ethernet controllers. Unfortunately, there are still areas where
hardware vendors deny users control over their own computing, and such
hardware is not supported on GuixSD.
@cindex WiFi, hardware support
One of the main areas where free drivers or firmware is lacking is WiFi
devices. WiFi devices known to work include those using Atheros chips
(AR9271 and AR7010), which corresponds to the @code{ath9k} Linux-libre
driver, and for which free firmware exists and is available
out-of-the-box on GuixSD, as part of @var{%base-firmware}
(@pxref{operating-system Reference, @code{firmware}}).
@cindex RYF, Respects Your Freedom
The @uref{https://www.fsf.org/, Free Software Foundation} runs
@uref{https://www.fsf.org/ryf, @dfn{Respect Your Freedom}} (RYF), a
certification program for hardware products that respect your freedom
and your privacy and ensure that you have control over your device. We
encourage you to check the list of RYF-certified hardware.
Another useful resource is the @uref{https://www.h-node.org/, H-Node}
web site. It contains a catalog of hardware devices with information
about their support in GNU/Linux.
@node USB Stick Installation
@subsection USB Stick Installation
@ -5967,8 +6039,8 @@ system} command, specifically:
guix system disk-image --image-size=850MiB gnu/system/install.scm
@end example
@xref{Invoking guix system} and
@file{gnu/system/install.scm} in the source tree for more information
Have a look at @file{gnu/system/install.scm} in the source tree,
and see also @ref{Invoking guix system} for more information
about the installation image.
@node System Configuration
@ -6087,28 +6159,42 @@ generated as needed (@pxref{Defining Services}).
@cindex customization, of services
@findex modify-services
Occasionally, instead of using the base services as is, you will want to
customize them. For instance, to change the configuration of
@code{guix-daemon} and Mingetty (the console log-in), you may write the
following instead of @var{%base-services}:
customize them. To do this, use @code{modify-services} (@pxref{Service
Reference, @code{modify-services}}) to modify the list.
For example, suppose you want to modify @code{guix-daemon} and Mingetty
(the console log-in) in the @var{%base-services} list (@pxref{Base
Services, @code{%base-services}}). To do that, you can write the
following in your operating system declaration:
@lisp
(modify-services %base-services
(guix-service-type config =>
(guix-configuration
(inherit config)
(use-substitutes? #f)
(extra-options '("--gc-keep-outputs"))))
(mingetty-service-type config =>
(mingetty-configuration
(inherit config)
(motd (plain-file "motd" "Hi there!")))))
(define %my-services
;; My very own list of services.
(modify-services %base-services
(guix-service-type config =>
(guix-configuration
(inherit config)
(use-substitutes? #f)
(extra-options '("--gc-keep-derivations"))))
(mingetty-service-type config =>
(mingetty-configuration
(inherit config)
(motd (plain-file "motd" "Howdy!"))))))
(operating-system
;; @dots{}
(services %my-services))
@end lisp
@noindent
The effect here is to change the options passed to @command{guix-daemon}
when it is started, as well as the ``message of the day'' that appears
when logging in at the console. @xref{Service Reference,
@code{modify-services}}, for more on that.
This changes the configuration---i.e., the service parameters---of the
@code{guix-service-type} instance, and that of all the
@code{mingetty-service-type} instances in the @var{%base-services} list.
Observe how this is accomplished: first, we arrange for the original
configuration to be bound to the identifier @code{config} in the
@var{body}, and then we write the @var{body} so that it evaluates to the
desired configuration. In particular, notice how we use @code{inherit}
to create a new configuration which has the same values as the old
configuration, but with a few modifications.
The configuration for a typical ``desktop'' usage, with the X11 display
server, a desktop environment, network management, power management, and
@ -6214,7 +6300,8 @@ the Linux kernel. @xref{Initial RAM Disk}.
List of firmware packages loadable by the operating system kernel.
The default includes firmware needed for Atheros-based WiFi devices
(Linux-libre module @code{ath9k}.)
(Linux-libre module @code{ath9k}). @xref{Hardware Considerations}, for
more info on supported hardware.
@item @code{host-name}
The host name.
@ -9963,11 +10050,12 @@ Here is an example of how a service is created and manipulated:
The @code{modify-services} form provides a handy way to change the
parameters of some of the services of a list such as
@var{%base-services} (@pxref{Base Services, @code{%base-services}}). Of
course, you could always use standard list combinators such as
@code{map} and @code{fold} to do that (@pxref{SRFI-1, List Library,,
guile, GNU Guile Reference Manual}); @code{modify-services} simply
provides a more concise form for this common pattern.
@var{%base-services} (@pxref{Base Services, @code{%base-services}}). It
evalutes to a list of services. Of course, you could always use
standard list combinators such as @code{map} and @code{fold} to do that
(@pxref{SRFI-1, List Library,, guile, GNU Guile Reference Manual});
@code{modify-services} simply provides a more concise form for this
common pattern.
@deffn {Scheme Syntax} modify-services @var{services} @
(@var{type} @var{variable} => @var{body}) @dots{}
@ -9979,16 +10067,21 @@ clauses. Each clause has the form:
(@var{type} @var{variable} => @var{body})
@end example
where @var{type} is a service type, such as @var{guix-service-type}, and
@var{variable} is an identifier that is bound within @var{body} to the
value of the service of that @var{type}. @xref{Using the Configuration
System}, for an example.
where @var{type} is a service type---e.g.,
@code{guix-service-type}---and @var{variable} is an identifier that is
bound within the @var{body} to the service parameters---e.g., a
@code{guix-configuration} instance---of the original service of that
@var{type}.
This is a shorthand for:
The @var{body} should evaluate to the new service parameters, which will
be used to configure the new service. This new service will replace the
original in the resulting list. Because a service's service parameters
are created using @code{define-record-type*}, you can write a succint
@var{body} that evaluates to the new service parameters by using the
@code{inherit} feature that @code{define-record-type*} provides.
@xref{Using the Configuration System} for example usage.
@example
(map (lambda (service) @dots{}) @var{services})
@end example
@end deffn
Next comes the programming interface for service types. This is

1
gnu-system.am
View File

@ -484,7 +484,6 @@ dist_patch_DATA = \
gnu/packages/patches/geoclue-config.patch \
gnu/packages/patches/ghostscript-CVE-2015-3228.patch \
gnu/packages/patches/ghostscript-runpath.patch \
gnu/packages/patches/gitolite-openssh-6.8-compat.patch \
gnu/packages/patches/glib-networking-ssl-cert-file.patch \
gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \

2
gnu/build/install.scm
View File

@ -159,7 +159,7 @@ as created and modified at the Epoch."
;; read-only store.
(unless (eq? (stat:type s) 'symlink)
(utime file 0 0 0 0))))
(find-files directory "")))
(find-files directory #:directories? #t)))
(define* (register-closure store closure
#:key (deduplicate? #t))

8
gnu/packages/aspell.scm
View File

@ -139,3 +139,11 @@ dictionaries, including personal ones.")
#:sha256
(base32
"1gdf7bc1a0kmxsmphdqq8pl01h667mjsj6hihy6kqy14k5qdq69v")))
(define-public aspell-dict-nl
(aspell-dictionary "nl" "Dutch"
#:version "0.50-2"
#:prefix "aspell-"
#:sha256
(base32
"0ffb87yjsh211hllpc4b9khqqrblial4pzi1h9r3v465z1yhn3j4")))

35
gnu/packages/audio.scm
View File

@ -2073,3 +2073,38 @@ module to handle that particular file type.")
(home-page "http://etree.org/shnutils/shntool/")
;; 'install-sh' bears the x11 license
(license (list license:gpl2+ license:x11))))
(define-public dcadec
(package
(name "dcadec")
(version "0.2.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/foo86/dcadec/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0i0dpypgqkhhi4v1fmsp2way6w9kbcix3c7q79pmg39yvrzj17gd"))))
(build-system gnu-build-system)
(arguments
;; Test files are missing: https://github.com/foo86/dcadec/issues/53
'(#:tests? #f
#:make-flags
(list "CC=gcc"
;; Build shared library.
"CONFIG_SHARED=1"
(string-append "PREFIX=" (assoc-ref %outputs "out"))
;; Set proper runpath.
(string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out")
"/lib"))
#:phases
(modify-phases %standard-phases
;; No configure script, just a hand-written Makefile.
(delete 'configure))))
(synopsis "DTS Coherent Acoustics decoder")
(description "Dcadec is a DTS Coherent Acoustics surround sound decoder
with support for HD extensions.")
(home-page "https://github.com/foo86/dcadec")
(license license:lgpl2.1+)))

66
gnu/packages/bioinformatics.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix utils)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system ant)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix build-system perl)
@ -2002,24 +2003,17 @@ from high-throughput sequencing assays.")
(snippet '(substitute* "build.xml"
(("failifexecutionfails=\"true\"")
"failifexecutionfails=\"false\"")))))
(build-system gnu-build-system)
(build-system ant-build-system)
(arguments
`(#:modules ((srfi srfi-1)
(guix build gnu-build-system)
(guix build utils))
#:phases (alist-replace
'build
(lambda _
(setenv "JAVA_HOME" (assoc-ref %build-inputs "jdk"))
(zero? (system* "ant" "all"
(string-append "-Ddist="
(assoc-ref %outputs "out")
"/share/java/htsjdk/"))))
(fold alist-delete %standard-phases
'(configure install check)))))
(native-inputs
`(("ant" ,ant)
("jdk" ,icedtea "jdk")))
`(#:tests? #f ; test require Internet access
#:make-flags
(list (string-append "-Ddist=" (assoc-ref %outputs "out")
"/share/java/htsjdk/"))
#:build-target "all"
#:phases
(modify-phases %standard-phases
;; The build phase also installs the jars
(delete 'install))))
(home-page "http://samtools.github.io/htsjdk/")
(synopsis "Java API for high-throughput sequencing data (HTS) formats")
(description
@ -2556,6 +2550,44 @@ the phenotype as it models the data.")
generated using the PacBio Iso-Seq protocol.")
(license license:bsd-3))))
(define-public pyicoteo
(package
(name "pyicoteo")
(version "2.0.7")
(source
(origin
(method url-fetch)
(uri (string-append "https://bitbucket.org/regulatorygenomicsupf/"
"pyicoteo/get/v" version ".tar.bz2"))
(file-name (string-append name "-" version ".tar.bz2"))
(sha256
(base32
"0d6087f29xp8wxwlj111c3sylli98n0l8ry58c51ixzq0zfm50wa"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2 ; does not work with Python 3
#:tests? #f)) ; there are no tests
(inputs
`(("python2-matplotlib" ,python2-matplotlib)))
(home-page "https://bitbucket.org/regulatorygenomicsupf/pyicoteo")
(synopsis "Analyze high-throughput genetic sequencing data")
(description
"Pyicoteo is a suite of tools for the analysis of high-throughput genetic
sequencing data. It works with genomic coordinates. There are currently six
different command-line tools:
@enumerate
@item pyicoregion: for generating exploratory regions automatically;
@item pyicoenrich: for differential enrichment between two conditions;
@item pyicoclip: for calling CLIP-Seq peaks without a control;
@item pyicos: for genomic coordinates manipulation;
@item pyicoller: for peak calling on punctuated ChIP-Seq;
@item pyicount: to count how many reads from N experiment files overlap in a
region file;
@item pyicotrocol: to combine operations from pyicoteo.
@end enumerate\n")
(license license:gpl3+)))
(define-public prodigal
(package
(name "prodigal")

89
gnu/packages/cdrom.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -44,14 +44,14 @@
(define-public libcddb
(package
(name "libcddb")
(version "1.3.0")
(version "1.3.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/libcddb/libcddb-"
version ".tar.bz2"))
(sha256
(base32
"1y8bfy12dwm41m1jahayn3v47dm34fmz7m9cjxyh7xcw6fp3lzaf"))))
"0fr21a7vprdyy1bq6s99m0x420c9jm5fipsd63pqv8qyfkhhxkim"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; tests rely on access to external servers
(home-page "http://libcddb.sourceforge.net/")
@ -189,14 +189,14 @@ reconstruction capability.")
(define-public dvdisaster
(package
(name "dvdisaster")
(version "0.72.6")
(version "0.79.5")
(source (origin
(method url-fetch)
(uri (string-append "http://dvdisaster.net/downloads/dvdisaster-"
version ".tar.bz2"))
(sha256
(base32
"0sqrprc5rh3shnfli25m2wy0i5f83db54iv04s5s7bxf77m7sy79"))))
"0f8gjnia2fxcbmhl8b3qkr5b7idl8m855dw7xw2fnmbqwvcm6k4w"))))
(build-system gnu-build-system)
(inputs
`(("gtk+" ,gtk+-2)))
@ -208,14 +208,7 @@ reconstruction capability.")
`(;; Parallel builds appear to be unsafe, see
;; <http://hydra.gnu.org/build/49331/nixlog/1/raw>.
#:parallel-build? #f
#:tests? #f ; no check target
#:phases
(alist-cons-before
'patch-source-shebangs 'sanitise
(lambda _
;; delete dangling symlink
(delete-file ".#GNUmakefile"))
%standard-phases)))
#:tests? #f)) ; no check target
(home-page "http://dvdisaster.net/en/index.html")
(synopsis "Error correcting codes for optical media images")
(description "Optical media (CD,DVD,BD) keep their data only for a
@ -240,9 +233,8 @@ capacity is user-selectable.")
(version "1.4.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/lipnitsk/libcue/releases"
"/download/v" version
"/libcue-" version ".tar.bz2"))
(uri (string-append "https://github.com/lipnitsk/libcue/archive/v"
version ".tar.bz2"))
(sha256
(base32
"17kjd7rjz1bvfn44n3n2bjb7a1ywd0yc0g4sqp5ihf9b5bn7cwlb"))))
@ -287,15 +279,15 @@ from an audio CD.")
(define-public abcde
(package
(name "abcde")
(version "2.7")
(home-page "http://abcde.einval.com/")
(version "2.7.1")
(home-page "https://abcde.einval.com/")
(source (origin
(method url-fetch)
(uri (string-append home-page "/download/abcde-"
version ".tar.gz"))
(sha256
(base32
"0ikpffzvacadh6vj9qlary8126j1zrd2knp9gvivmp7y1656jj01"))
"0l7j0nk8p30s97285i418rv9ym9bgns7bn6l8gldw3mjhnby609l"))
(modules '((guix build utils)))
(snippet
'(substitute* "Makefile"
@ -305,37 +297,36 @@ from an audio CD.")
(string-append "etcdir = $(prefix)/etc\n"))))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace
'configure
(lambda* (#:key outputs inputs #:allow-other-keys)
(substitute* "Makefile"
(("^prefix = .*$")
(string-append "prefix = "
(assoc-ref outputs "out")
"\n"))))
(alist-cons-after
'install 'wrap
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((wget (assoc-ref inputs "wget"))
(vorbis (assoc-ref inputs "vorbis-tools"))
(parano (assoc-ref inputs "cdparanoia"))
(which (assoc-ref inputs "which"))
(discid (assoc-ref inputs "cd-discid"))
(out (assoc-ref outputs "out")))
(define (wrap file)
(wrap-program file
`("PATH" ":" prefix
(,(string-append out "/bin:"
wget "/bin:"
which "/bin:"
vorbis "/bin:"
discid "/bin:"
parano "/bin")))))
'(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs inputs #:allow-other-keys)
(substitute* "Makefile"
(("^prefix = .*$")
(string-append "prefix = "
(assoc-ref outputs "out")
"\n")))))
(add-after 'install 'wrap
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((wget (assoc-ref inputs "wget"))
(vorbis (assoc-ref inputs "vorbis-tools"))
(parano (assoc-ref inputs "cdparanoia"))
(which (assoc-ref inputs "which"))
(discid (assoc-ref inputs "cd-discid"))
(out (assoc-ref outputs "out")))
(define (wrap file)
(wrap-program file
`("PATH" ":" prefix
(,(string-append out "/bin:"
wget "/bin:"
which "/bin:"
vorbis "/bin:"
discid "/bin:"
parano "/bin")))))
(for-each wrap
(find-files (string-append out "/bin")
".*"))))
%standard-phases))
(for-each wrap
(find-files (string-append out "/bin")
".*"))))))
#:tests? #f))
(inputs `(("wget" ,wget)

26
gnu/packages/dav.scm
View File

@ -52,21 +52,16 @@ clients.")
(define-public vdirsyncer
(package
(name "vdirsyncer")
(version "0.9.0")
(version "0.9.2")
(source (origin
(method url-fetch)
(uri (pypi-uri "vdirsyncer" version))
(sha256
(base32
"0s9awjr9v60rr80xcpwmdhkf4v1yqnydahjmxwvxmh64565is465"))))
"1g1107cz4sk41d2z6k6pn9n2fzd26m72j8aj33zn483vfvmyrc4q"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(replace 'check
(lambda _
(setenv "DAV_SERVER" "radicale")
(setenv "REMOTESTORAGE_SERVER" "skip")
(zero? (system* "py.test"))))
;; vdirsyncer requires itself to be installed in order to build
;; the manpage.
(add-after 'install 'manpage
@ -80,17 +75,24 @@ clients.")
"docs/_build/man/vdirsyncer.1"
(string-append
(assoc-ref outputs "out")
"/share/man/man1")))))))
"/share/man/man1"))))
;; vdirsyncer requires itself to be installed in order to run the test
;; suite.
(delete 'check)
(add-after 'install 'check-later
(lambda _
(setenv "DETERMINISTIC_TESTS" "true")
(setenv "DAV_SERVER" "radicale")
(setenv "REMOTESTORAGE_SERVER" "skip")
(zero? (system* "make" "test")))))))
(native-inputs
`(("python-oauthlib" ,python-oauthlib)
("python-setuptools-scm" ,python-setuptools-scm)
`(("python-setuptools-scm" ,python-setuptools-scm)
("python-sphinx" ,python-sphinx)
;; Required for testing
("python-hypothesis" ,python-hypothesis)
("python-pytest" ,python-pytest)
("python-pytest-localserver" ,python-pytest-localserver)
("python-pytest-subtesthack" ,python-pytest-subtesthack)
("python-pytest-xprocess" ,python-pytest-xprocess)
("python-wsgi-intercept" ,python-wsgi-intercept)
("radicale" ,radicale)))
(propagated-inputs
@ -98,7 +100,7 @@ clients.")
("python-click" ,python-click)
("python-click-log" ,python-click-log)
("python-click-threading" ,python-click-threading)
("python-lxml" ,python-lxml) ; which one?
("python-lxml" ,python-lxml)
("python-requests-toolbelt" ,python-requests-toolbelt)))
(synopsis "Synchronize calendars and contacts")
(description "Vdirsyncer synchronizes your calendars and addressbooks

4
gnu/packages/emacs.scm
View File

@ -308,7 +308,7 @@ when typing parentheses directly or commenting out code line by line.")
(define-public git-modes
(package
(name "git-modes")
(version "1.2.0")
(version "1.2.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -317,7 +317,7 @@ when typing parentheses directly or commenting out code line by line.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"09dv7ikbj2bi4y3lmvjfzqpdmx2f9bd4w7jkp10bkap62d05iqhk"))))
"088wyddh8y0yw77i0hx449n9zg4wzyc90h63wlmxba1ijg4dzm0p"))))
(build-system gnu-build-system)
(arguments
`(#:modules ((guix build gnu-build-system)

4
gnu/packages/enlightenment.scm
View File

@ -273,7 +273,7 @@ Libraries with some extra bells and whistles.")
(define-public enlightenment
(package
(name "enlightenment")
(version "0.20.5")
(version "0.20.6")
(source (origin
(method url-fetch)
(uri
@ -281,7 +281,7 @@ Libraries with some extra bells and whistles.")
name "/" name "-" version ".tar.xz"))
(sha256
(base32
"1l02m2d7d5r0vnfgn44glhvqhc8ygbjxjkf6cdd2vxpxsa29ax12"))))
"11ahll68nlci214ka05whp5l32hy9lznmcdfqx3hxsmq2p7bl7zj"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--enable-mount-eeze")))

120
gnu/packages/fonts.scm
View File

@ -7,6 +7,7 @@
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Nils Gillmann <niasterisk@grrlz.net>
;;; Copyright © 2016 Jookia <166291@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -67,14 +68,15 @@ in print. With attention to detail for high resolution rendering.")
(define-public font-ubuntu
(package
(name "font-ubuntu")
(version "0.80")
(version "0.83")
(source (origin
(method url-fetch)
(uri (string-append "http://font.ubuntu.com/download/ubuntu-font-family-"
version ".zip"))
(uri (string-append
"http://font.ubuntu.com/download/ubuntu-font-family-"
version ".zip"))
(sha256
(base32
"0k4f548riq23gmw4zhn30qqkcpaj4g2ab5rbc3lflfxwkc4p0w8h"))))
"0hjvq2x758dx0sfwqhzflns0ns035qm7h6ygskbx1svzg517sva5"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
@ -628,3 +630,113 @@ Unicode's Basic Multilingual Plane. The package also includes
utilities to ease adding new glyphs to the font.")
(home-page "http://unifoundry.com/unifont.html")
(license license:gpl2+)))
(define-public font-google-noto
(package
(name "font-google-noto")
(version "20150929")
(source (origin
(method url-fetch)
(uri (string-append "https://noto-website-2.storage.googleapis.com/"
"pkgs/Noto-hinted.zip"))
(sha256
(base32
"13jhpqzhsqhyby8n0ksqg155a3jyaif3nzj9anzbq8s2gn1xjyd9"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder (begin
(use-modules (guix build utils)
(srfi srfi-26))
(let ((PATH (string-append (assoc-ref %build-inputs
"unzip")
"/bin"))
(font-dir (string-append %output
"/share/fonts/truetype")))
(setenv "PATH" PATH)
(system* "unzip" (assoc-ref %build-inputs "source"))
(mkdir-p font-dir)
(for-each (lambda (ttf)
(copy-file ttf
(string-append font-dir "/" ttf)))
(find-files "." "\\.ttf$"))
(for-each (lambda (otf)
(copy-file otf
(string-append font-dir "/" otf)))
(find-files "." "\\.otf$"))))))
(native-inputs `(("unzip" ,unzip)))
(home-page "https://www.google.com/get/noto/")
(synopsis "Fonts aimed to cover all languages")
(description "Googe Noto Fonts is a family of fonts aimed to support all
languages with a consistent look and aesthetic. It's goal is to have no Unicode
symbols unable to be displayed properly.")
(license license:silofl1.1)))
(define-public font-un
(package
(name "font-un")
(version "1.0.2-080608")
;; The upstream server at kldp.net is serving us broken MIME.
;; See <http://bugs.gnu.org/22908>.
(source (origin
(method url-fetch)
(uri (list
(string-append
"http://krosos.sdf.org/static/unix/"
"un-fonts-core-" version ".tar.gz")
;; XXX: The upstream server at kldp.net
(string-append
"https://kldp.net/projects/unfonts/download/4695?filename="
"un-fonts-core-" version ".tar.gz")))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"13liaz2pmww3aqabm55la5npd08m1skh334ky7qfidxaz5s742iv"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
(let ((tar (string-append (assoc-ref %build-inputs "tar")
"/bin/tar"))
(PATH (string-append (assoc-ref %build-inputs "gzip")
"/bin"))
(font-dir (string-append %output "/share/fonts/truetype"))
(doc-dir (string-append %output "/share/doc/" ,name)))
(setenv "PATH" PATH)
(system* tar "xvf" (assoc-ref %build-inputs "source"))
(mkdir-p font-dir)
(mkdir-p doc-dir)
(chdir (string-append "un-fonts"))
(for-each (lambda (ttf)
(copy-file ttf
(string-append font-dir "/"
(basename ttf))))
(find-files "." "\\.ttf$"))
(for-each (lambda (doc)
(copy-file doc
(string-append doc-dir "/"
(basename doc))))
'("COPYING" "README"))))))
(native-inputs
`(("tar" ,tar)
("gzip" ,gzip)))
(home-page "https://kldp.net/projects/unfonts/")
(synopsis "Collection of Korean fonts")
(description
"Un-fonts is a family of mainly Korean fonts.
It contains the following fonts and styles:
@enumerate
@item UnBatang, UnBatangBold: serif;
@item UnDotum, UnDotumBold: sans-serif;
@item UnGraphic, UnGraphicBold: sans-serif style;
@item UnDinaru, UnDinaruBold, UnDinaruLight;
@item UnPilgi, UnPilgiBold: script;
@item UnGungseo: cursive, brush-stroke.
@end enumerate\n")
(license license:gpl2+)))

5
gnu/packages/fontutils.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -305,7 +306,7 @@ smooth contours with constant curvature at the spline joins.")
(define-public libuninameslist
(package
(name "libuninameslist")
(version "0.4.20140731")
(version "0.5.20150701")
(source
(origin
(method url-fetch)
@ -314,7 +315,7 @@ smooth contours with constant curvature at the spline joins.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"016zxffpc8iwpxxmnjkdirn6dsbcvdb2wjdrp123sf79f4nsynyj"))))
"1j6147l100rppw7axlrkdx0p35fax6bz2zh1xgpg7a3b4pmqaj3v"))))
(build-system gnu-build-system)
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)

2
gnu/packages/freedesktop.scm
View File

@ -451,7 +451,7 @@ interfaces, based on the useradd, usermod and userdel commands.")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.freedesktop.org/software/" name "/"
"https://www.freedesktop.org/software/" name "/"
name "-" version ".tar.xz"))
(sha256
(base32

4
gnu/packages/games.scm
View File

@ -1185,7 +1185,7 @@ is programmed in Haskell.")
(define-public manaplus
(package
(name "manaplus")
(version "1.6.1.16")
(version "1.6.3.12")
(source (origin
(method url-fetch)
(uri (string-append
@ -1193,7 +1193,7 @@ is programmed in Haskell.")
version "/manaplus-" version ".tar.xz"))
(sha256
(base32
"1vrsjvdbdzbnqmr8sp110b2d93kp5yfnifsn6zjm60kdvvbphdir"))))
"02bnd4nk1qzrfqckqkwb6sbjzsmacv968ih74cdgcykslpsr684d"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags

5
gnu/packages/java.scm
View File

@ -139,9 +139,8 @@ is implemented.")
(version "1.9.6")
(source (origin
(method url-fetch)
(uri (string-append
"https://www.apache.org/dist/ant/source/apache-ant-"
version "-src.tar.gz"))
(uri (string-append "mirror://apache/ant/source/apache-ant-"
version "-src.tar.gz"))
(sha256
(base32
"1396wflczyxjxl603dhxjvd559f289lha9y2f04f71c7hapjl3am"))))

8
gnu/packages/jrnl.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <address@hidden>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,7 +28,7 @@
(define-public jrnl
(package
(name "jrnl")
(version "1.8.4")
(version "1.9.7")
(source
(origin
(method url-fetch)
@ -36,11 +37,10 @@
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"019ky09sj5i7frmca0imv4jm46mn3f4lzah2wmiwxh22cisj7ksn"))))
"0mfq7hhw5np2dj9jlxpyyk2cg9i0xgz2brb894d928hczszy97bq"))))
(build-system python-build-system)
(native-inputs
`(("python-setuptools" ,python-setuptools)
("behave" ,behave)))
`(("behave" ,behave)))
(inputs
`(("python" ,python)
("python-keyring" ,python-keyring)

59
gnu/packages/kodi.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages algebra)
#:use-module (gnu packages audio)
@ -68,18 +69,67 @@
#:use-module (gnu packages yasm)
#:use-module (gnu packages zip))
(define-public crossguid
(let ((commit "8f399e8bd4252be9952f3dfa8199924cc8487ca4"))
(package
(name "crossguid")
(version (string-append "0.0-1." (string-take commit 7)))
;; There's no official release. Just a Git repository.
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/graeme-hill/crossguid.git")
(commit commit)))
(sha256
(base32
"1i29y207qqddvaxbn39pk2fbh3gx8zvdprfp35wasj9rw2wjk3s9"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure script
;; There's no build system here, so we have to do it ourselves.
(replace 'build
(lambda _
(and (zero? (system* "g++" "-c" "guid.cpp" "-o" "guid.o"
"-std=c++11" "-DGUID_LIBUUID"))
(zero? (system* "ar" "rvs" "libcrossguid.a" "guid.o")))))
(replace 'check
(lambda _
(and (zero? (system* "g++" "-c" "test.cpp" "-o" "test.o"
"-std=c++11"))
(zero? (system* "g++" "-c" "testmain.cpp" "-o" "testmain.o"
"-std=c++11"))
(zero? (system* "g++" "test.o" "guid.o" "testmain.o"
"-o" "test" "-luuid"))
(zero? (system* (string-append (getcwd) "/test"))))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(install-file "guid.h" (string-append out "/include"))
(install-file "libcrossguid.a"
(string-append out "/lib"))
#t))))))
(inputs
`(("util-linux" ,util-linux)))
(synopsis "Lightweight universal identifier library")
(description "CrossGuid is a minimal @acronym{GUID}/@acronym{UUID}
generator library for C++.")
(home-page "https://github.com/graeme-hill/crossguid")
(license license:expat))))
(define-public kodi
(package
(name "kodi")
(version "15.2")
(version "16.0")
(source (origin
(method url-fetch)
(uri (string-append "http://mirrors.kodi.tv/releases/source/"
version "-Isengard.tar.gz"))
version "-Jarvis.tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"043i0f1crx9glwxil4xm45z5kxpkrx316gi4ir4d3rbd5safp2nx"))
"0iirspvv7czf785l2lqf232dvdaj87srbn9ni97ngvnd6w9yl884"))
(snippet
;; Delete bundled ffmpeg.
;; TODO: Delete every other bundled library.
@ -161,7 +211,9 @@
("bluez" ,bluez)
("boost" ,boost)
("bzip2" ,bzip2)
("crossguid" ,crossguid)
("curl" ,curl)
("dcadec" ,dcadec)
("dbus" ,dbus)
("enca" ,enca)
("eudev" ,eudev)
@ -213,6 +265,7 @@
("taglib" ,taglib)
("tinyxml" ,tinyxml)
("unzip" ,unzip)
("util-linux" ,util-linux)
("zip" ,zip)
("zlib" ,zlib)))
(synopsis "Media center for home theater computers")

0
gnu/packages/linux-libre-i686.conf → gnu/packages/linux-libre-4.4-i686.conf
View File

0
gnu/packages/linux-libre-x86_64.conf → gnu/packages/linux-libre-4.4-x86_64.conf
View File

8729
gnu/packages/linux-libre-4.5-i686.conf Normal file
View File

File diff suppressed because it is too large Load Diff

8541
gnu/packages/linux-libre-4.5-x86_64.conf Normal file
View File

File diff suppressed because it is too large Load Diff

27
gnu/packages/linux.scm
View File

@ -220,7 +220,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration."
(search-path %load-path file)))
(define-public linux-libre
(let* ((version "4.4.5")
(let* ((version "4.5")
(build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch.
@ -294,7 +294,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration."
(uri (linux-libre-urls version))
(sha256
(base32
"19yyw6yssyxr9k5y3whgz2p731mb1pnq3xajpv8g01m13cxs32dd"))))
"0km863vwy557flpygkr869yshpjs1v11ni78p8k9p9nm31ai6yn3"))))
(build-system gnu-build-system)
(supported-systems '("x86_64-linux" "i686-linux"))
(native-inputs `(("perl" ,perl)
@ -303,8 +303,10 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration."
("module-init-tools" ,module-init-tools)
("patch/freedo+gnu" ,%boot-logo-patch)
,@(let ((conf (kernel-config (or (%current-target-system)
(%current-system)))))
,@(let ((conf (kernel-config
(or (%current-target-system)
(%current-system))
#:variant (version-major+minor version))))
(if conf
`(("kconfig" ,conf))
'()))))
@ -326,6 +328,23 @@ It has been modified to remove all non-free binary blobs.")
(license license:gpl2)
(home-page "http://www.gnu.org/software/linux-libre/"))))
(define-public linux-libre-4.4
(package
(inherit linux-libre)
(version "4.4.5")
(source (origin
(method url-fetch)
(uri (linux-libre-urls version))
(sha256
(base32
"19yyw6yssyxr9k5y3whgz2p731mb1pnq3xajpv8g01m13cxs32dd"))))
(native-inputs
(let ((conf (kernel-config (or (%current-target-system)
(%current-system))
#:variant "4.4")))
`(,@(alist-delete "kconfig" (package-native-inputs linux-libre))
("kconfig" ,conf))))))
(define-public linux-libre-4.1
(package
(inherit linux-libre)

47
gnu/packages/mail.scm
View File

@ -71,8 +71,8 @@
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module ((guix licenses)
#:select (gpl2 gpl2+ gpl3+ lgpl2.1 lgpl2.1+ lgpl3+ non-copyleft
(expat . license:expat)))
#:select (gpl2 gpl2+ gpl3 gpl3+ lgpl2.1 lgpl2.1+ lgpl3+
non-copyleft (expat . license:expat)))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
@ -1150,5 +1150,46 @@ maintained.")
;; nonfree Artistic License 1.0
;; as alternative to the GPL2+.
;; This option is not listed here.
;;; mail.scm ends here
(define-public khard
(package
(name "khard")
(version "0.8.1")
(source (origin
(method url-fetch)
(uri (pypi-uri name version))
(sha256
(base32
"098gs94qmnspdfn6ar8lycx7dbsz9bcff90aps0cmn47mw7llch0"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2 ; only python-2 is supported.
#:phases
(modify-phases %standard-phases
(add-before 'build 'disable-egg-compression
;; Do not compress the egg.
(lambda _
(let ((port (open-file "setup.cfg" "a")))
(display "\n[easy_install]\nzip_ok = 0\n"
port)
(close-port port)
#t)))
(add-after 'install 'install-doc
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(doc (string-append out "/share/doc/khard")))
(copy-recursively "misc/khard" doc)))))))
(native-inputs
`(("python2-setuptools" ,python2-setuptools)))
(propagated-inputs
`(("python2-vobject" ,python2-vobject)
("python2-pyyaml" ,python2-pyyaml)
("python2-atomicwrites" ,python2-atomicwrites)
("python2-configobj" ,python2-configobj)))
(synopsis "Console address book using CardDAV")
(description "Khard is an address book for the console. It creates, reads,
modifies and removes CardDAV address book entries at your local machine. For
synchronizing with a remote address book, @command{vdirsyncer} is recommended.
Khard can also be used from within the email client @command{mutt}.")
(home-page "https://github.com/scheibler/khard")
(license gpl3+)))

4
gnu/packages/maths.scm
View File

@ -177,7 +177,7 @@ numbers.")
(define-public glpk
(package
(name "glpk")
(version "4.58")
(version "4.59")
(source
(origin
(method url-fetch)
@ -185,7 +185,7 @@ numbers.")
version ".tar.gz"))
(sha256
(base32
"1jmrya04hgwnrxrqqs40i6m9cqka3q601cx3nh9ijyvlg90zlq24"))))
"1bpbp5z0378kaj5bqmc5m2j5h9c7553p0s2j6a28badqghpbx673"))))
(build-system gnu-build-system)
(inputs
`(("gmp" ,gmp)))

4
gnu/packages/music.scm
View File

@ -817,7 +817,7 @@ projects.")
(define-public frescobaldi
(package
(name "frescobaldi")
(version "2.18.1")
(version "2.18.2")
(source (origin
(method url-fetch)
(uri (string-append
@ -825,7 +825,7 @@ projects.")
version "/frescobaldi-" version ".tar.gz"))
(sha256
(base32
"1hflc6gck6dn17czc2ldai5j0ynfg3df8lqcggdry06qxsdbnns7"))))
"1yns7nq2a2hz5rv4xjp21bgcdi1xj6fq48lqjrld7ypqqi5nfjp5"))))
(build-system python-build-system)
(inputs
`(("lilypond" ,lilypond)

25
gnu/packages/patches/gitolite-openssh-6.8-compat.patch
View File

@ -1,25 +0,0 @@
From ed807a40c6683960e357bc995b3acf721ec088b4 Mon Sep 17 00:00:00 2001
From: Sitaram Chamarty <sitaram@atc.tcs.com>
Date: Thu, 19 Mar 2015 05:17:59 +0530
Subject: [PATCH] openssh 6.8 compat
---
src/triggers/post-compile/ssh-authkeys | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/triggers/post-compile/ssh-authkeys b/src/triggers/post-compile/ssh-authkeys
index 84dda73..d5f5d8b 100755
--- a/src/triggers/post-compile/ssh-authkeys
+++ b/src/triggers/post-compile/ssh-authkeys
@@ -115,7 +115,7 @@ sub fp_file {
my $f = shift;
my $fp = `ssh-keygen -l -f '$f'`;
chomp($fp);
- _die "fingerprinting failed for '$f'" unless $fp =~ /([0-9a-f][0-9a-f](:[0-9a-f][0-9a-f])+)/;
+ _die "fingerprinting failed for '$f'" unless $fp =~ /([0-9a-f][0-9a-f](:[0-9a-f][0-9a-f])+)/ or $fp =~ m(SHA256:([A-ZA-z0-9+/]+));
$fp = $1;
return $fp;
}
--
2.2.1

64
gnu/packages/python.scm
View File

@ -1133,10 +1133,10 @@ Python 3.3+.")
(package-with-python2 python-simplejson))
(define-public python2-pyicu
(define-public python-pyicu
(package
(name "python2-pyicu")
(version "1.8")
(name "python-pyicu")
(version "1.9.2")
(source
(origin
(method url-fetch)
@ -1144,19 +1144,22 @@ Python 3.3+.")
version ".tar.gz"))
(sha256
(base32
"1y361x82lnh9k9srmdx3q92z5iag112z7r5fxm0n1sfwb349yjdw"))))
"1diba0g8md614fvm9yf50paiwdkhj6rd7xwf1rg9mc0pxc0hhn4v"))))
(build-system python-build-system)
(inputs
`(("icu4c" ,icu4c)))
(arguments
`(#:python ,python-2 ; Python 3 works also, but needs special care for
; linking with libpython3.3m
#:tests? #f)) ; no check target
(home-page "http://pyicu.osafoundation.org/")
(synopsis "Python extension wrapping the ICU C++ API")
(description
"PyICU is a python extension wrapping the ICU C++ API.")
(license x11)))
(license x11)
(properties `((python2-variant . ,(delay python2-pyicu))))))
(define-public python2-pyicu
(package
(inherit (package-with-python2
(strip-python2-variant python-pyicu)))
(native-inputs `(("python2-setuptools" ,python2-setuptools)))))
(define-public python2-dogtail
;; Python 2 only, as it leads to "TabError: inconsistent use of tabs and
@ -6756,7 +6759,14 @@ WebSocket usage in Python programs.")
(description "Library for atomic file writes using platform dependent tools
for atomic filesystem operations.")
(home-page "https://github.com/untitaker/python-atomicwrites")
(license license:expat)))
(license license:expat)
(properties `((python2-variant . ,(delay python2-atomicwrites))))))
(define-public python2-atomicwrites
(package (inherit (package-with-python2
(strip-python2-variant python-atomicwrites)))
(native-inputs
`(("python2-setuptools" ,python2-setuptools)))))
(define-public python-requests-toolbelt
(package
@ -7457,13 +7467,13 @@ Amazon Web Services (AWS) API.")
(define-public python-hypothesis
(package
(name "python-hypothesis")
(version "3.0.4")
(version "3.1.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "hypothesis" version))
(sha256
(base32
"0bh6pqyc56cqlbpg0ffzjs6466blyylix4nsw11qrqwf01cg9gdq"))))
"0qyqq9akm4vshhn8cngjc1qykcvsn7cz6dlm6njfsgpbraqrmbbw"))))
(build-system python-build-system)
(propagated-inputs
`(("python-flake8" ,python-flake8)
@ -8193,3 +8203,33 @@ introspection of @code{zope.interface} instances in code.")
(inherit (package-with-python2
(strip-python2-variant python-psycopg2)))
(native-inputs `(("python2-setuptools" ,python2-setuptools)))))
(define-public python-vobject
(package
(name "python-vobject")
(version "0.9.1")
(source (origin
(method url-fetch)
(uri (pypi-uri "vobject" version))
(sha256
(base32
"1cwzjnrdr9yg2x21wbf3kf59ibnchvj33mygd69yzi178a9gs9gz"))))
(build-system python-build-system)
(inputs
`(("python-dateutil-2" ,python-dateutil-2)
("python-pyicu" ,python-pyicu)))
(synopsis "Parse and generate vCard and vCalendar files")
(description "Vobject is intended to be a full featured Python package for
parsing and generating vCard and vCalendar files. Currently, iCalendar files
are supported and well tested. vCard 3.0 files are supported, and all data
should be imported, but only a few components are understood in a sophisticated
way.")
(home-page "http://eventable.github.io/vobject/")
(license asl2.0)
(properties `((python2-variant . ,(delay python2-vobject))))))
(define-public python2-vobject
(package
(inherit (package-with-python2
(strip-python2-variant python-vobject)))
(native-inputs `(("python2-setuptools" ,python2-setuptools)))))

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

@ -324,7 +324,7 @@ command.")))
(define-public libgit2
(package
(name "libgit2")
(version "0.23.4")
(version "0.24.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/libgit2/libgit2/"
@ -332,7 +332,7 @@ command.")))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0aa0i5bvmzrrirqk5w13pm0qmblkk57x24w0hxz4vg0x73by5xf7"))))
"1c5jx0pcpz83x7s36jimfz5bj0vy7vwpchq9p4sgdqxy8gwr6rhw"))))
(build-system cmake-build-system)
(arguments
`(#:phases
@ -351,7 +351,7 @@ command.")))
(inputs
`(("libssh2" ,libssh2)
("libcurl" ,curl)
("python" ,python)
("python" ,python-wrapper)
("openssl" ,openssl)))
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -367,14 +367,14 @@ write native speed custom Git applications in any language with bindings.")
(define-public shflags
(package
(name "shflags")
(version "1.0.3")
(version "1.2.0")
(source (origin
(method url-fetch)
(uri (string-append "https://shflags.googlecode.com/files/"
"shflags-" version ".tgz"))
(uri (string-append "https://github.com/kward/shflags/archive/v"
version ".tar.gz"))
(sha256
(base32
"08laxhf1hifh3w4j0hri5ppcklaqz0mnkmbaz8j0wxih29vi8slm"))))
"0zxw12haylaq60a335xlqcs4afw2zrgwqymmpw0m21r51w6irdmr"))))
(build-system trivial-build-system)
(native-inputs `(("tar" ,tar)
("gzip" ,gzip)))
@ -396,7 +396,7 @@ write native speed custom Git applications in any language with bindings.")
(copy-file "src/shflags"
(string-append srcdir "/shflags"))
#t)))))
(home-page "https://code.google.com/p/shflags/")
(home-page "https://github.com/kward/shflags")
(synopsis "Command-line flags library for shell scripts")
(description
"Shell Flags (shFlags) is a library written to greatly simplify the
@ -489,19 +489,16 @@ also walk each side of a merge and test those changes individually.")
(define-public gitolite
(package
(name "gitolite")
(version "3.6.2")
(version "3.6.5")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/sitaramc/gitolite/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
;; Commit ed807a4 upstream
(patches
(list (search-patch "gitolite-openssh-6.8-compat.patch")))
(sha256
(base32
"1gsgzi9ayb4rablki3mqr11b0h8db4xg43df660marfpacmkfb01"))))
"0xpqg04gyr4dhdhxx5lbk61lwwd5ml32530bigg2qy663icngwqm"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; no tests

36
gnu/packages/xfce.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Florian Paul Schmidt <mista.tapas@gmx.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -704,6 +705,7 @@ on your desktop.")
("tumlber" ,tumbler)
("xfce4-appfinder" ,xfce4-appfinder)
("xfce4-panel" ,xfce4-panel)
("xfce4-power-manager" ,xfce4-power-manager)
("xfce4-session" ,xfce4-session)
("xfce4-settings" ,xfce4-settings)
("xfce4-terminal" ,xfce4-terminal)
@ -721,3 +723,37 @@ on your desktop.")
"Xfce is a lightweight desktop environment. It aims to be fast and low on
system resources, while still being visually appealing and user friendly.")
(license gpl2+)))
(define-public xfce4-power-manager
(package
(name "xfce4-power-manager")
(version "1.4.3")
(source (origin
(method url-fetch)
(uri (string-append "http://archive.xfce.org/xfce/4.12"
"/src/" name "-" version ".tar.bz2"))
(sha256
(base32
"04909sfc2nrj2wg9cw6y9y2r9yrp3l3vc201sy1gaiap67fi33h1"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--enable-gtk3")))
(native-inputs
`(("pkg-config" ,pkg-config)
("intltool" ,intltool)))
(inputs
`(("lbxrandr" ,libxrandr)
("upower" ,upower)
("libnotify" ,libnotify)
("libxfce4ui" ,libxfce4ui)))
(home-page "http://www.xfce.org/")
(synopsis "Xfce Power Manager")
(description
"This is a power manager for the Xfce desktop. It manages the power
sources on the computer and the devices that can be controlled to reduce their
power consumption (such as LCD brightness level, monitor sleep, CPU frequency
scaling, etc). In addition, xfce4-power-manager provides a set of
freedesktop-compliant DBus interfaces to inform other applications about current
power level so that they can adjust their power consumption, and it provides the
inhibit interface which allows applications to prevent automatic sleep.")
(license gpl2+)))

5
gnu/services.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -153,8 +154,8 @@
(define-syntax modify-services
(syntax-rules ()
"Modify the services listed in SERVICES according to CLAUSES. Each clause
must have the form:
"Modify the services listed in SERVICES according to CLAUSES and return
the resulting list of services. Each clause must have the form:
(TYPE VARIABLE => BODY)

149
guix/build-system/ant.scm Normal file
View File

@ -0,0 +1,149 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system ant)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
#:export (%ant-build-system-modules
ant-build
ant-build-system))
;; Commentary:
;;
;; Standard build procedure for Java packages using Ant.
;;
;; Code:
(define %ant-build-system-modules
;; Build-side modules imported by default.
`((guix build ant-build-system)
(guix build syscalls)
,@%gnu-build-system-modules))
(define (default-jdk)
"Return the default JDK package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((jdk-mod (resolve-interface '(gnu packages java))))
(module-ref jdk-mod 'icedtea)))
(define (default-ant)
"Return the default Ant package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((jdk-mod (resolve-interface '(gnu packages java))))
(module-ref jdk-mod 'ant)))
(define* (lower name
#:key source inputs native-inputs outputs system target
(jdk (default-jdk))
(ant (default-ant))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:jdk #:ant #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
(name name)
(system system)
(host-inputs `(,@(if source
`(("source" ,source))
'())
,@inputs
;; Keep the standard inputs of 'gnu-build-system'.
,@(standard-packages)))
(build-inputs `(("jdk" ,jdk "jdk")
("ant" ,ant)
,@native-inputs))
(outputs outputs)
(build ant-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (ant-build store name inputs
#:key
(tests? #t)
(test-target "tests")
(configure-flags ''())
(make-flags ''())
(build-target "jar")
(jar-name #f)
(phases '(@ (guix build ant-build-system)
%standard-phases))
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)p
(imported-modules %ant-build-system-modules)
(modules '((guix build ant-build-system)
(guix build utils))))
"Build SOURCE with INPUTS."
(define builder
`(begin
(use-modules ,@modules)
(ant-build #:name ,name
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:make-flags ,make-flags
#:configure-flags ,configure-flags
#:system ,system
#:tests? ,tests?
#:test-target ,test-target
#:build-target ,build-target
#:jar-name ,jar-name
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define ant-build-system
(build-system
(name 'ant)
(description "The standard Ant build system")
(lower lower)))
;;; ant.scm ends here

160
guix/build/ant-build-system.scm Normal file
View File

@ -0,0 +1,160 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build ant-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (sxml simple)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
ant-build))
;; Commentary:
;;
;; Builder-side code of the standard build procedure for Java packages using
;; Ant.
;;
;; Code:
(define (default-build.xml jar-name prefix)
"Create a simple build.xml with standard targets for Ant."
(call-with-output-file "build.xml"
(lambda (port)
(sxml->xml
`(project (@ (basedir "."))
(property (@ (name "classes.dir")
(value "${basedir}/build/classes")))
(property (@ (name "jar.dir")
(value "${basedir}/build/jar")))
(property (@ (name "dist.dir")
(value ,prefix)))
;; respect the CLASSPATH environment variable
(property (@ (name "build.sysclasspath")
(value "first")))
(property (@ (environment "env")))
(path (@ (id "classpath"))
(pathelement (@ (location "${env.CLASSPATH}"))))
(target (@ (name "compile"))
(mkdir (@ (dir "${classes.dir}")))
(javac (@ (includeantruntime "false")
(srcdir "src")
(destdir "${classes.dir}")
(classpath (@ (refid "classpath"))))))
(target (@ (name "jar")
(depends "compile"))
(mkdir (@ (dir "${jar.dir}")))
;; We cannot use the simpler "jar" task here, because
;; there is no way to disable generation of a
;; manifest. We do not include a generated manifest
;; to ensure determinism, because we cannot easily
;; reset the ctime/mtime before creating the archive.
(exec (@ (executable "jar"))
(arg (@ (line ,(string-append "-Mcf ${jar.dir}/" jar-name
" -C ${classes.dir} ."))))))
(target (@ (name "install"))
(copy (@ (todir "${dist.dir}"))
(fileset (@ (dir "${jar.dir}"))
(include (@ (name "**/*.jar")))))))
port)))
(utime "build.xml" 0 0)
#t)
(define (generate-classpath inputs)
"Return a colon-separated string of full paths to jar files found among the
INPUTS."
(string-join
(apply append (map (match-lambda
((_ . dir)
(find-files dir "\\.*jar$")))
inputs)) ":"))
(define* (configure #:key inputs outputs (jar-name #f)
#:allow-other-keys)
(when jar-name
(default-build.xml jar-name
(string-append (assoc-ref outputs "out")
"/share/java")))
(setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
(setenv "CLASSPATH" (generate-classpath inputs)))
(define* (build #:key (make-flags '()) (build-target "jar")
#:allow-other-keys)
(zero? (apply system* `("ant" ,build-target ,@make-flags))))
(define* (strip-jar-timestamps #:key outputs
#:allow-other-keys)
"Unpack all jar archives, reset the timestamp of all contained files, and
repack them. This is necessary to ensure that archives are reproducible."
(define (repack-archive jar)
(format #t "repacking ~a\n" jar)
(let ((dir (mkdtemp! "jar-contents.XXXXXX")))
(and (with-directory-excursion dir
(zero? (system* "jar" "xf" jar)))
;; The manifest file contains timestamps
(for-each delete-file (find-files dir "MANIFEST.MF"))
(delete-file jar)
;; XXX: copied from (gnu build install)
(for-each (lambda (file)
(let ((s (lstat file)))
(unless (eq? (stat:type s) 'symlink)
(utime file 0 0 0 0))))
(find-files dir #:directories? #t))
(unless (zero? (system* "jar" "-Mcf" jar "-C" dir "."))
(error "'jar' failed"))
(utime jar 0 0)
#t)))
(every (match-lambda
((output . directory)
(every repack-archive (find-files directory "\\.jar$"))))
outputs))
(define* (check #:key target (make-flags '()) (tests? (not target))
(test-target "check")
#:allow-other-keys)
(if tests?
(zero? (apply system* `("ant" ,test-target ,@make-flags)))
(begin
(format #t "test suite not run~%")
#t)))
(define* (install #:key (make-flags '()) #:allow-other-keys)
(zero? (apply system* `("ant" "install" ,@make-flags))))
(define %standard-phases
(modify-phases gnu:%standard-phases
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)
(add-after 'install 'strip-jar-timestamps strip-jar-timestamps)))
(define* (ant-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given Java package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))
;;; ant-build-system.scm ends here

6
guix/grafts.scm
View File

@ -189,6 +189,12 @@ available."
(guard (c ((nix-protocol-error? c)
;; As a last resort, build DRV and query the references of the
;; build result.
;; Warm up the narinfo cache, otherwise each derivation build
;; will result in one HTTP request to get one narinfo, which is
;; much less efficient than fetching them all upfront.
(substitution-oracle store (list drv))
(and (build-derivations store (list drv))
(map (cut references store <>) items))))
(references/substitutes store items)))

9
guix/http-client.scm
View File

@ -222,11 +222,14 @@ or if EOF is reached."
(module-define! (resolve-module '(web client))
'shutdown (const #f))
(define* (http-fetch uri #:key port (text? #f) (buffered? #t))
(define* (http-fetch uri #:key port (text? #f) (buffered? #t)
keep-alive?)
"Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be
textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
unbuffered port, suitable for use in `filtered-port'.
unbuffered port, suitable for use in `filtered-port'. When KEEP-ALIVE? is
true, send a 'Connection: keep-alive' HTTP header, in which case PORT may be
reused for future HTTP requests.
Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri (if (string? uri)
@ -246,8 +249,10 @@ Raise an '&http-get-error' condition if downloading fails."
;; Try hard to use the API du jour to get an input port.
(if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port
#:keep-alive? #t
#:headers auth-header) ; 2.0.9+
(http-get* uri #:decode-body? text? ; 2.0.7
#:keep-alive? #t
#:port port #:headers auth-header)))
((code)
(response-code resp)))

33
guix/scripts/size.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +22,7 @@
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages)
@ -274,19 +275,23 @@ Report the size of PACKAGE and its dependencies.\n"))
(leave (_ "missing store item argument\n")))
((file)
(leave-on-EPIPE
(with-store store
(set-build-options store
#:use-substitutes? #t
#:substitute-urls urls)
;; Turn off grafts because (1) hydra.gnu.org does not serve grafted
;; packages, and (2) they do not make any difference on the
;; resulting size.
(parameterize ((%graft? #f))
(with-store store
(set-build-options store
#:use-substitutes? #t
#:substitute-urls urls)
(run-with-store store
(mlet* %store-monad ((item (ensure-store-item file))
(profile (store-profile item)))
(if map-file
(begin
(profile->page-map profile map-file)
(return #t))
(display-profile* profile)))
#:system system))))
(run-with-store store
(mlet* %store-monad ((item (ensure-store-item file))
(profile (store-profile item)))
(if map-file
(begin
(profile->page-map profile map-file)
(return #t))
(display-profile* profile)))
#:system system)))))
((files ...)
(leave (_ "too many arguments\n")))))))

108
guix/scripts/substitute.scm
View File

@ -164,10 +164,9 @@ again."
(sigaction SIGALRM SIG_DFL)
(apply values result)))))
(define* (fetch uri #:key (buffered? #t) (timeout? #t) (quiet-404? #f))
(define* (fetch uri #:key (buffered? #t) (timeout? #t))
"Return a binary input port to URI and the number of bytes it's expected to
provide. If QUIET-404? is true, HTTP 404 error conditions are passed through
to the caller without emitting an error message."
provide."
(case (uri-scheme uri)
((file)
(let ((port (open-file (uri-path uri)
@ -175,12 +174,10 @@ to the caller without emitting an error message."
(values port (stat:size (stat port)))))
((http https)
(guard (c ((http-get-error? c)
(let ((code (http-get-error-code c)))
(if (and (= code 404) quiet-404?)
(raise c)
(leave (_ "download from '~a' failed: ~a, ~s~%")
(uri->string (http-get-error-uri c))
code (http-get-error-reason c))))))
(leave (_ "download from '~a' failed: ~a, ~s~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))))
;; Test this with:
;; sudo tc qdisc add dev eth0 root netem delay 1500ms
;; and then cancel with:
@ -219,19 +216,46 @@ to the caller without emitting an error message."
(wants-mass-query? cache-info-wants-mass-query?))
(define (download-cache-info url)
"Download the information for the cache at URL. Return a <cache-info>
object on success, or #f on failure."
(define (download url)
;; Download the `nix-cache-info' from URL, and return its contents as an
;; list of key/value pairs.
(and=> (false-if-exception (fetch (string->uri url)))
fields->alist))
"Download the information for the cache at URL. On success, return a
<cache-info> object and a port on which to send further HTTP requests. On
failure, return #f and #f."
(define uri
(string->uri (string-append url "/nix-cache-info")))
(and=> (download (string-append url "/nix-cache-info"))
(lambda (properties)
(alist->record properties
(cut %make-cache-info url <...>)
'("StoreDir" "WantMassQuery")))))
(define (read-cache-info port)
(alist->record (fields->alist port)
(cut %make-cache-info url <...>)
'("StoreDir" "WantMassQuery")))
(catch #t
(lambda ()
(case (uri-scheme uri)
((file)
(values (call-with-input-file (uri-path uri)
read-cache-info)
#f))
((http https)
(let ((port (open-connection-for-uri uri
#:timeout %fetch-timeout)))
(guard (c ((http-get-error? c)
(warning (_ "while fetching '~a': ~a (~s)~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))
(close-port port)
(warning (_ "ignoring substitute server at '~s'~%") url)
(values #f #f)))
(values (read-cache-info (http-fetch uri
#:port port
#:keep-alive? #t))
port))))))
(lambda (key . args)
(case key
((getaddrinfo-error system-error)
;; Silently ignore the error: probably due to lack of network access.
(values #f #f))
(else
(apply throw key args))))))
(define-record-type <narinfo>
@ -480,16 +504,19 @@ may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
".narinfo")))
(build-request (string->uri url) #:method 'GET)))
(define (http-multiple-get base-uri proc seed requests)
(define* (http-multiple-get base-uri proc seed requests
#:key port)
"Send all of REQUESTS to the server at BASE-URI. Call PROC for each
response, passing it the request object, the response, a port from which to
read the response body, and the previous result, starting with SEED, à la
'fold'. Return the final result."
(let connect ((requests requests)
'fold'. Return the final result. When PORT is specified, use it as the
initial connection on which HTTP requests are sent."
(let connect ((port port)
(requests requests)
(result seed))
;; (format (current-error-port) "connecting (~a requests left)..."
;; (length requests))
(let ((p (open-connection-for-uri base-uri)))
(let ((p (or port (open-connection-for-uri base-uri))))
;; For HTTPS, P is not a file port and does not support 'setvbuf'.
(when (file-port? p)
(setvbuf p _IOFBF (expt 2 16)))
@ -523,7 +550,7 @@ read the response body, and the previous result, starting with SEED, à la
(match (assq 'connection (response-headers resp))
(('connection 'close)
(close-port p)
(connect tail result)) ;try again
(connect #f tail result)) ;try again
(_
(loop tail result)))))))))) ;keep going
@ -582,14 +609,17 @@ if file doesn't exist, and the narinfo otherwise."
(read-to-eof port))
result))))
(define (do-fetch uri)
(define (do-fetch uri port)
(case (and=> uri uri-scheme)
((http https)
(let ((requests (map (cut narinfo-request url <>) paths)))
(update-progress!)
(let ((result (http-multiple-get uri
handle-narinfo-response '()
requests)))
requests
#:port port)))
(unless (port-closed? port)
(close-port port))
(newline (current-error-port))
result)))
((file #f)
@ -602,17 +632,17 @@ if file doesn't exist, and the narinfo otherwise."
(leave (_ "~s: unsupported server URI scheme~%")
(if uri (uri-scheme uri) url)))))
(define cache-info
(download-cache-info url))
(and cache-info
(if (string=? (cache-info-store-directory cache-info)
(%store-prefix))
(do-fetch (string->uri url))
(begin
(warning (_ "'~a' uses different store '~a'; ignoring it~%")
url (cache-info-store-directory cache-info))
#f))))
(let-values (((cache-info port)
(download-cache-info url)))
(and cache-info
(if (string=? (cache-info-store-directory cache-info)
(%store-prefix))
(do-fetch (string->uri url) port) ;reuse PORT
(begin
(warning (_ "'~a' uses different store '~a'; ignoring it~%")
url (cache-info-store-directory cache-info))
(close-port port)
#f)))))
(define (lookup-narinfos cache paths)
"Return the narinfos for PATHS, invoking the server at CACHE when no

18
guix/store.scm
View File

@ -726,14 +726,23 @@ error if there is no such root."
"Return the list of references of PATH."
store-path-list))
(define %reference-cache
;; Brute-force cache mapping store items to their list of references.
;; Caching matters because when building a profile in the presence of
;; grafts, we keep calling 'graft-derivation', which in turn calls
;; 'references/substitutes' many times with the same arguments. Ideally we
;; would use a cache associated with the daemon connection instead (XXX).
(make-hash-table 100))
(define (references/substitutes store items)
"Return the list of list of references of ITEMS; the result has the same
length as ITEMS. Query substitute information for any item missing from the
store at once. Raise a '&nix-protocol-error' exception if reference
information for one of ITEMS is missing."
(let* ((local-refs (map (lambda (item)
(guard (c ((nix-protocol-error? c) #f))
(references store item)))
(or (hash-ref %reference-cache item)
(guard (c ((nix-protocol-error? c) #f))
(references store item))))
items))
(missing (fold-right (lambda (item local-ref result)
(if local-ref
@ -757,7 +766,10 @@ the list of references")
(result '()))
(match items
(()
(reverse result))
(let ((result (reverse result)))
(for-each (cut hash-set! %reference-cache <> <>)
items result)
result))
((item items ...)
(match local-refs
((#f tail ...)