ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into staging

Browse source
This commit is contained in:
Ricardo Wurmus 2019-01-23 12:08:27 +01:00
commit 5aaef5c5de
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
55 changed files with 2336 additions and 1840 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.mailmap
View file

@ -41,6 +41,7 @@ Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk>
Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
Mathieu Othacehe <m.othacehe@gmail.com>
Mathieu Othacehe <mathieu.othacehe@parrot.com>
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
Nils Gillmann <ng0@n0.is> ng0 <ng0@n0.is>
Nils Gillmann <ng0@n0.is> Nils Gillmann <gillmann@infotropique.org>

5
TODO
View file

@ -103,7 +103,7 @@ Running mkfs.ext4 on /dev/sda2 ...
[ 40% ]
Running mkfs.ext4 on /dev/sda3 ...
*** Add a confirmation page before formating/partitioning
** Desktop environments
*** Allow for no desktop environments
Propose to choose between "headless server" and "lightweight X11" in a new
@ -119,3 +119,6 @@ Under the form:
(UTC + 1) Europe/Paris
(UTC + 2) Africa/Cairo
...
** Display issue
*** Investigate display issue described here:
https://lists.gnu.org/archive/html/guix-devel/2019-01/msg00305.html

51
build-aux/build-self.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -293,9 +293,6 @@ (define fake-git
(use-modules (ice-9 match))
(eval-when (expand load eval)
;; Don't augment '%load-path'.
(unsetenv "GUIX_PACKAGE_PATH")
;; (gnu packages …) modules are going to be looked up
;; under SOURCE. (guix config) is looked up in FRONT.
(match (command-line)
@ -312,15 +309,11 @@ (define fake-git
;; Only load Guile-Gcrypt, our own modules, or those
;; of Guile.
(match %load-compiled-path
((front _ ... sys1 sys2)
(unless (string-prefix? #$guile-gcrypt front)
(set! %load-compiled-path
(list (string-append #$guile-gcrypt
"/lib/guile/"
(effective-version)
"/site-ccache")
front sys1 sys2))))))
(set! %load-compiled-path
(cons (string-append #$guile-gcrypt "/lib/guile/"
(effective-version)
"/site-ccache")
%load-compiled-path)))
(use-modules (guix store)
(guix self)
@ -372,6 +365,19 @@ (define spin
derivation-file-name))))))
#:module-path (list source))))
(define (call-with-clean-environment thunk)
(let ((env (environ)))
(dynamic-wind
(lambda ()
(environ '()))
thunk
(lambda ()
(environ env)))))
(define-syntax-rule (with-clean-environment exp ...)
"Evaluate EXP in a context where zero environment variables are defined."
(call-with-clean-environment (lambda () exp ...)))
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string)) system
@ -406,14 +412,17 @@ (define* (build source
;; stdin will actually be /dev/null.
(let* ((pipe (with-input-from-port port
(lambda ()
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
(open-pipe* OPEN_READ
(derivation->output-path build)
source system version
(if (file-port? port)
(number->string
(logior major minor))
"none")))))
;; Make sure BUILD is not influenced by
;; $GUILE_LOAD_PATH & co.
(with-clean-environment
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
(open-pipe* OPEN_READ
(derivation->output-path build)
source system version
(if (file-port? port)
(number->string
(logior major minor))
"none"))))))
(str (get-string-all pipe))
(status (close-pipe pipe)))
(match str

2
build-aux/run-system-tests.scm
View file

@ -30,7 +30,7 @@ (define-module (run-system-tests)
(define (built-derivations* drv)
(lambda (store)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(values #f store)))
(values (build-derivations store drv) store))))

450
doc/contributing.texi
View file

@ -23,6 +23,7 @@ choice.
* Building from Git:: The latest and greatest.
* Running Guix Before It Is Installed:: Hacker tricks.
* The Perfect Setup:: The right tools.
* Packaging Guidelines:: Growing the distribution.
* Coding Style:: Hygiene of the contributor.
* Submitting Patches:: Share your work.
@end menu
@ -223,6 +224,455 @@ trigger string @code{origin...}, which can be expanded further. The
@code{...}, which also can be expanded further.
@node Packaging Guidelines
@section Packaging Guidelines
@cindex packages, creating
The GNU distribution is nascent and may well lack some of your favorite
packages. This section describes how you can help make the distribution
grow.
Free software packages are usually distributed in the form of
@dfn{source code tarballs}---typically @file{tar.gz} files that contain
all the source files. Adding a package to the distribution means
essentially two things: adding a @dfn{recipe} that describes how to
build the package, including a list of other packages required to build
it, and adding @dfn{package metadata} along with that recipe, such as a
description and licensing information.
In Guix all this information is embodied in @dfn{package definitions}.
Package definitions provide a high-level view of the package. They are
written using the syntax of the Scheme programming language; in fact,
for each package we define a variable bound to the package definition,
and export that variable from a module (@pxref{Package Modules}).
However, in-depth Scheme knowledge is @emph{not} a prerequisite for
creating packages. For more information on package definitions,
@pxref{Defining Packages}.
Once a package definition is in place, stored in a file in the Guix
source tree, it can be tested using the @command{guix build} command
(@pxref{Invoking guix build}). For example, assuming the new package is
called @code{gnew}, you may run this command from the Guix build tree
(@pxref{Running Guix Before It Is Installed}):
@example
./pre-inst-env guix build gnew --keep-failed
@end example
Using @code{--keep-failed} makes it easier to debug build failures since
it provides access to the failed build tree. Another useful
command-line option when debugging is @code{--log-file}, to access the
build log.
If the package is unknown to the @command{guix} command, it may be that
the source file contains a syntax error, or lacks a @code{define-public}
clause to export the package variable. To figure it out, you may load
the module from Guile to get more information about the actual error:
@example
./pre-inst-env guile -c '(use-modules (gnu packages gnew))'
@end example
Once your package builds correctly, please send us a patch
(@pxref{Submitting Patches}). Well, if you need help, we will be happy to
help you too. Once the patch is committed in the Guix repository, the
new package automatically gets built on the supported platforms by
@url{http://hydra.gnu.org/jobset/gnu/master, our continuous integration
system}.
@cindex substituter
Users can obtain the new package definition simply by running
@command{guix pull} (@pxref{Invoking guix pull}). When
@code{@value{SUBSTITUTE-SERVER}} is done building the package, installing the
package automatically downloads binaries from there
(@pxref{Substitutes}). The only place where human intervention is
needed is to review and apply the patch.
@menu
* Software Freedom:: What may go into the distribution.
* Package Naming:: What's in a name?
* Version Numbers:: When the name is not enough.
* Synopses and Descriptions:: Helping users find the right package.
* Python Modules:: A touch of British comedy.
* Perl Modules:: Little pearls.
* Java Packages:: Coffee break.
* Fonts:: Fond of fonts.
@end menu
@node Software Freedom
@subsection Software Freedom
@c Adapted from http://www.gnu.org/philosophy/philosophy.html.
@cindex free software
The GNU operating system has been developed so that users can have
freedom in their computing. GNU is @dfn{free software}, meaning that
users have the @url{http://www.gnu.org/philosophy/free-sw.html,four
essential freedoms}: to run the program, to study and change the program
in source code form, to redistribute exact copies, and to distribute
modified versions. Packages found in the GNU distribution provide only
software that conveys these four freedoms.
In addition, the GNU distribution follow the
@url{http://www.gnu.org/distros/free-system-distribution-guidelines.html,free
software distribution guidelines}. Among other things, these guidelines
reject non-free firmware, recommendations of non-free software, and
discuss ways to deal with trademarks and patents.
Some otherwise free upstream package sources contain a small and optional
subset that violates the above guidelines, for instance because this subset
is itself non-free code. When that happens, the offending items are removed
with appropriate patches or code snippets in the @code{origin} form of the
package (@pxref{Defining Packages}). This way, @code{guix
build --source} returns the ``freed'' source rather than the unmodified
upstream source.
@node Package Naming
@subsection Package Naming
@cindex package name
A package has actually two names associated with it:
First, there is the name of the @emph{Scheme variable}, the one following
@code{define-public}. By this name, the package can be made known in the
Scheme code, for instance as input to another package. Second, there is
the string in the @code{name} field of a package definition. This name
is used by package management commands such as
@command{guix package} and @command{guix build}.
Both are usually the same and correspond to the lowercase conversion of
the project name chosen upstream, with underscores replaced with
hyphens. For instance, GNUnet is available as @code{gnunet}, and
SDL_net as @code{sdl-net}.
We do not add @code{lib} prefixes for library packages, unless these are
already part of the official project name. But @pxref{Python
Modules} and @ref{Perl Modules} for special rules concerning modules for
the Python and Perl languages.
Font package names are handled differently, @pxref{Fonts}.
@node Version Numbers
@subsection Version Numbers
@cindex package version
We usually package only the latest version of a given free software
project. But sometimes, for instance for incompatible library versions,
two (or more) versions of the same package are needed. These require
different Scheme variable names. We use the name as defined
in @ref{Package Naming}
for the most recent version; previous versions use the same name, suffixed
by @code{-} and the smallest prefix of the version number that may
distinguish the two versions.
The name inside the package definition is the same for all versions of a
package and does not contain any version number.
For instance, the versions 2.24.20 and 3.9.12 of GTK+ may be packaged as follows:
@example
(define-public gtk+
(package
(name "gtk+")
(version "3.9.12")
...))
(define-public gtk+-2
(package
(name "gtk+")
(version "2.24.20")
...))
@end example
If we also wanted GTK+ 3.8.2, this would be packaged as
@example
(define-public gtk+-3.8
(package
(name "gtk+")
(version "3.8.2")
...))
@end example
@c See <https://lists.gnu.org/archive/html/guix-devel/2016-01/msg00425.html>,
@c for a discussion of what follows.
@cindex version number, for VCS snapshots
Occasionally, we package snapshots of upstream's version control system
(VCS) instead of formal releases. This should remain exceptional,
because it is up to upstream developers to clarify what the stable
release is. Yet, it is sometimes necessary. So, what should we put in
the @code{version} field?
Clearly, we need to make the commit identifier of the VCS snapshot
visible in the version string, but we also need to make sure that the
version string is monotonically increasing so that @command{guix package
--upgrade} can determine which version is newer. Since commit
identifiers, notably with Git, are not monotonically increasing, we add
a revision number that we increase each time we upgrade to a newer
snapshot. The resulting version string looks like this:
@example
2.0.11-3.cabba9e
^ ^ ^
| | `-- upstream commit ID
| |
| `--- Guix package revision
|
latest upstream version
@end example
It is a good idea to strip commit identifiers in the @code{version}
field to, say, 7 digits. It avoids an aesthetic annoyance (assuming
aesthetics have a role to play here) as well as problems related to OS
limits such as the maximum shebang length (127 bytes for the Linux
kernel.) It is best to use the full commit identifiers in
@code{origin}s, though, to avoid ambiguities. A typical package
definition may look like this:
@example
(define my-package
(let ((commit "c3f29bc928d5900971f65965feaae59e1272a3f7")
(revision "1")) ;Guix package revision
(package
(version (git-version "0.9" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "git://example.org/my-package.git")
(commit commit)))
(sha256 (base32 "1mbikn@dots{}"))
(file-name (git-file-name name version))))
;; @dots{}
)))
@end example
@node Synopses and Descriptions
@subsection Synopses and Descriptions
@cindex package description
@cindex package synopsis
As we have seen before, each package in GNU@tie{}Guix includes a
synopsis and a description (@pxref{Defining Packages}). Synopses and
descriptions are important: They are what @command{guix package
--search} searches, and a crucial piece of information to help users
determine whether a given package suits their needs. Consequently,
packagers should pay attention to what goes into them.
Synopses must start with a capital letter and must not end with a
period. They must not start with ``a'' or ``the'', which usually does
not bring anything; for instance, prefer ``File-frobbing tool'' over ``A
tool that frobs files''. The synopsis should say what the package
is---e.g., ``Core GNU utilities (file, text, shell)''---or what it is
used for---e.g., the synopsis for GNU@tie{}grep is ``Print lines
matching a pattern''.
Keep in mind that the synopsis must be meaningful for a very wide
audience. For example, ``Manipulate alignments in the SAM format''
might make sense for a seasoned bioinformatics researcher, but might be
fairly unhelpful or even misleading to a non-specialized audience. It
is a good idea to come up with a synopsis that gives an idea of the
application domain of the package. In this example, this might give
something like ``Manipulate nucleotide sequence alignments'', which
hopefully gives the user a better idea of whether this is what they are
looking for.
Descriptions should take between five and ten lines. Use full
sentences, and avoid using acronyms without first introducing them.
Please avoid marketing phrases such as ``world-leading'',
``industrial-strength'', and ``next-generation'', and avoid superlatives
like ``the most advanced''---they are not helpful to users looking for a
package and may even sound suspicious. Instead, try to be factual,
mentioning use cases and features.
@cindex Texinfo markup, in package descriptions
Descriptions can include Texinfo markup, which is useful to introduce
ornaments such as @code{@@code} or @code{@@dfn}, bullet lists, or
hyperlinks (@pxref{Overview,,, texinfo, GNU Texinfo}). However you
should be careful when using some characters for example @samp{@@} and
curly braces which are the basic special characters in Texinfo
(@pxref{Special Characters,,, texinfo, GNU Texinfo}). User interfaces
such as @command{guix package --show} take care of rendering it
appropriately.
Synopses and descriptions are translated by volunteers
@uref{http://translationproject.org/domain/guix-packages.html, at the
Translation Project} so that as many users as possible can read them in
their native language. User interfaces search them and display them in
the language specified by the current locale.
To allow @command{xgettext} to extract them as translatable strings,
synopses and descriptions @emph{must be literal strings}. This means
that you cannot use @code{string-append} or @code{format} to construct
these strings:
@lisp
(package
;; @dots{}
(synopsis "This is translatable")
(description (string-append "This is " "*not*" " translatable.")))
@end lisp
Translation is a lot of work so, as a packager, please pay even more
attention to your synopses and descriptions as every change may entail
additional work for translators. In order to help them, it is possible
to make recommendations or instructions visible to them by inserting
special comments like this (@pxref{xgettext Invocation,,, gettext, GNU
Gettext}):
@example
;; TRANSLATORS: "X11 resize-and-rotate" should not be translated.
(description "ARandR is designed to provide a simple visual front end
for the X11 resize-and-rotate (RandR) extension. @dots{}")
@end example
@node Python Modules
@subsection Python Modules
@cindex python
We currently package Python 2 and Python 3, under the Scheme variable names
@code{python-2} and @code{python} as explained in @ref{Version Numbers}.
To avoid confusion and naming clashes with other programming languages, it
seems desirable that the name of a package for a Python module contains
the word @code{python}.
Some modules are compatible with only one version of Python, others with both.
If the package Foo compiles only with Python 3, we name it
@code{python-foo}; if it compiles only with Python 2, we name it
@code{python2-foo}. If it is compatible with both versions, we create two
packages with the corresponding names.
If a project already contains the word @code{python}, we drop this;
for instance, the module python-dateutil is packaged under the names
@code{python-dateutil} and @code{python2-dateutil}. If the project name
starts with @code{py} (e.g.@: @code{pytz}), we keep it and prefix it as
described above.
@subsubsection Specifying Dependencies
@cindex inputs, for Python packages
Dependency information for Python packages is usually available in the
package source tree, with varying degrees of accuracy: in the
@file{setup.py} file, in @file{requirements.txt}, or in @file{tox.ini}.
Your mission, when writing a recipe for a Python package, is to map
these dependencies to the appropriate type of ``input'' (@pxref{package
Reference, inputs}). Although the @code{pypi} importer normally does a
good job (@pxref{Invoking guix import}), you may want to check the
following check list to determine which dependency goes where.
@itemize
@item
We currently package Python 2 with @code{setuptools} and @code{pip}
installed like Python 3.4 has per default. Thus you don't need to
specify either of these as an input. @command{guix lint} will warn you
if you do.
@item
Python dependencies required at run time go into
@code{propagated-inputs}. They are typically defined with the
@code{install_requires} keyword in @file{setup.py}, or in the
@file{requirements.txt} file.
@item
Python packages required only at build time---e.g., those listed with
the @code{setup_requires} keyword in @file{setup.py}---or only for
testing---e.g., those in @code{tests_require}---go into
@code{native-inputs}. The rationale is that (1) they do not need to be
propagated because they are not needed at run time, and (2) in a
cross-compilation context, it's the ``native'' input that we'd want.
Examples are the @code{pytest}, @code{mock}, and @code{nose} test
frameworks. Of course if any of these packages is also required at
run-time, it needs to go to @code{propagated-inputs}.
@item
Anything that does not fall in the previous categories goes to
@code{inputs}, for example programs or C libraries required for building
Python packages containing C extensions.
@item
If a Python package has optional dependencies (@code{extras_require}),
it is up to you to decide whether to add them or not, based on their
usefulness/overhead ratio (@pxref{Submitting Patches, @command{guix
size}}).
@end itemize
@node Perl Modules
@subsection Perl Modules
@cindex perl
Perl programs standing for themselves are named as any other package,
using the lowercase upstream name.
For Perl packages containing a single class, we use the lowercase class name,
replace all occurrences of @code{::} by dashes and prepend the prefix
@code{perl-}.
So the class @code{XML::Parser} becomes @code{perl-xml-parser}.
Modules containing several classes keep their lowercase upstream name and
are also prepended by @code{perl-}. Such modules tend to have the word
@code{perl} somewhere in their name, which gets dropped in favor of the
prefix. For instance, @code{libwww-perl} becomes @code{perl-libwww}.
@node Java Packages
@subsection Java Packages
@cindex java
Java programs standing for themselves are named as any other package,
using the lowercase upstream name.
To avoid confusion and naming clashes with other programming languages,
it is desirable that the name of a package for a Java package is
prefixed with @code{java-}. If a project already contains the word
@code{java}, we drop this; for instance, the package @code{ngsjava} is
packaged under the name @code{java-ngs}.
For Java packages containing a single class or a small class hierarchy,
we use the lowercase class name, replace all occurrences of @code{.} by
dashes and prepend the prefix @code{java-}. So the class
@code{apache.commons.cli} becomes package
@code{java-apache-commons-cli}.
@node Fonts
@subsection Fonts
@cindex fonts
For fonts that are in general not installed by a user for typesetting
purposes, or that are distributed as part of a larger software package,
we rely on the general packaging rules for software; for instance, this
applies to the fonts delivered as part of the X.Org system or fonts that
are part of TeX Live.
To make it easier for a user to search for fonts, names for other packages
containing only fonts are constructed as follows, independently of the
upstream package name.
The name of a package containing only one font family starts with
@code{font-}; it is followed by the foundry name and a dash @code{-}
if the foundry is known, and the font family name, in which spaces are
replaced by dashes (and as usual, all upper case letters are transformed
to lower case).
For example, the Gentium font family by SIL is packaged under the name
@code{font-sil-gentium}.
For a package containing several font families, the name of the collection
is used in the place of the font family name.
For instance, the Liberation fonts consist of three families,
Liberation Sans, Liberation Serif and Liberation Mono.
These could be packaged separately under the names
@code{font-liberation-sans} and so on; but as they are distributed together
under a common name, we prefer to package them together as
@code{font-liberation}.
In the case where several formats of the same font family or font collection
are packaged separately, a short form of the format, prepended by a dash,
is added to the package name. We use @code{-ttf} for TrueType fonts,
@code{-otf} for OpenType fonts and @code{-type1} for PostScript Type 1
fonts.
@node Coding Style
@section Coding Style

2256
doc/guix.texi
View file

File diff suppressed because it is too large Load diff

6
gnu/ci.scm
View file

@ -250,7 +250,11 @@ (define (->job test)
"." system))))
(cons name (test->thunk test))))
(if (member system %guixsd-supported-systems)
(if (and (member system %guixsd-supported-systems)
;; XXX: Our build farm has too few ARMv7 machines and they are very
;; slow, so skip system tests there.
(not (string=? system "armhf-linux")))
;; Override the value of 'current-guix' used by system tests. Using a
;; channel instance makes tests that rely on 'current-guix' less
;; expensive. It also makes sure we get a valid Guix package when this

18
gnu/packages/base.scm
View file

@ -13,7 +13,7 @@
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -975,7 +975,7 @@ (define-public glibc-2.22
(("/bin/pwd") "pwd"))
#t))))))))
(define-public glibc-locales
(define-public (make-glibc-locales glibc)
(package
(inherit glibc)
(name "glibc-locales")
@ -1010,7 +1010,7 @@ (define-public glibc-locales
,(version-major+minor
(package-version glibc)))))))))))
(define-public glibc-utf8-locales
(define-public (make-glibc-utf8-locales glibc)
(package
(name "glibc-utf8-locales")
(version (package-version glibc))
@ -1060,6 +1060,18 @@ (define file
(home-page (package-home-page glibc))
(license (package-license glibc))))
(define-public glibc-locales
(make-glibc-locales glibc))
(define-public glibc-utf8-locales
(make-glibc-utf8-locales glibc))
(define-public glibc-locales-2.27
(package (inherit (make-glibc-locales glibc-2.27))
(name "glibc-locales-2.27")))
(define-public glibc-utf8-locales-2.27
(package (inherit (make-glibc-utf8-locales glibc-2.27))
(name "glibc-utf8-locales-2.27")))
(define-public which
(package
(name "which")

11
gnu/packages/cpp.scm
View file

@ -41,12 +41,15 @@ (define-public libzen
(version "0.4.37")
(source (origin
(method url-fetch)
;; Warning: This source has proved unreliable 1 time at least.
;; Consider an alternate source or report upstream if this
;; happens again.
(uri (string-append "https://mediaarea.net/download/source/"
name "/" version "/"
name "_" version ".tar.bz2"))
(sha256
(base32
"1hcsrmn85b0xp0mp33aazk7g071q1v3f163nnhv8b0mv9c4bgsfn"))))
"1dkqbgabzpa6bd7dkqrvd35sdxrhr6qxalb88f3dw0afk65xqb0k"))))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
@ -58,10 +61,8 @@ (define-public libzen
(modify-phases %standard-phases
(add-after 'unpack 'pre-configure
(lambda _
(chdir "Project/GNU/Library")))
(add-after 'pre-configure 'autogen
(lambda _
(zero? (system* "sh" "autogen.sh")))))))
(chdir "Project/GNU/Library")
#t)))))
(home-page "https://github.com/MediaArea/ZenLib")
(synopsis "C++ utility library")
(description "ZenLib is a C++ utility library. It includes classes for handling

4
gnu/packages/ebook.scm
View file

@ -178,6 +178,10 @@ (define-public calibre
(pyqt (assoc-ref inputs "python2-pyqt")))
(substitute* "setup/build_environment.py"
(("sys.prefix") (string-append "'" pyqt "'")))
(substitute* "src/calibre/ebooks/pdf/pdftohtml.py"
(("PDFTOHTML = 'pdftohtml'")
(string-append "PDFTOHTML = \"" (assoc-ref inputs "poppler")
"/bin/pdftohtml\"")))
(setenv "PODOFO_INC_DIR" (string-append podofo "/include/podofo"))
(setenv "PODOFO_LIB_DIR" (string-append podofo "/lib"))
#t)))

112
gnu/packages/emacs-xyz.scm
View file

@ -31,7 +31,7 @@
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2017, 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017, 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018 Sohom Bhattacharjee <soham.bhattacharjee15@gmail.com>
;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
@ -6906,49 +6906,53 @@ (define-public emacs-commander
;; Tests for ert-runner have a circular dependency with ecukes, and therefore
;; cannot be run
(define-public emacs-ert-runner
(package
(name "emacs-ert-runner")
(version "0.7.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/rejeep/ert-runner.el/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1657nck9i96a4xgl8crfqq0s8gflzp21pkkzwg6m3z5npjxklgwp"))))
(build-system emacs-build-system)
(inputs
`(("emacs-ansi" ,emacs-ansi)
("emacs-commander" ,emacs-commander)
("emacs-dash" ,emacs-dash)
("emacs-f" ,emacs-f)
("emacs-s" ,emacs-s)
("emacs-shut-up" ,emacs-shut-up)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'install 'install-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* "bin/ert-runner"
(("ERT_RUNNER=\"\\$\\(dirname \\$\\(dirname \\$0\\)\\)")
(string-append "ERT_RUNNER=\"" out
"/share/emacs/site-lisp/guix.d/ert-runner-"
,version)))
(install-file "bin/ert-runner" (string-append out "/bin"))
(wrap-program (string-append out "/bin/ert-runner")
(list "EMACSLOADPATH" ":" 'prefix
(string-split (getenv "EMACSLOADPATH") #\:)))
#t))))
#:include (cons* "^reporters/.*\\.el$" %default-include)))
(home-page "https://github.com/rejeep/ert-runner.el")
(synopsis "Opinionated Ert testing workflow")
(description "@code{ert-runner} is a tool for Emacs projects tested
(let ((version "0.7.0")
(revision "1")
(commit "90b8fdd5970ef76a4649be60003b37f82cdc1a65"))
(package
(name "emacs-ert-runner")
(version (git-version "0.7.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rejeep/ert-runner.el.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"04nxmyzncacj2wmzd84vv9wkkr2dk9lcb10dvygqmg3p1gadnwzz"))))
(build-system emacs-build-system)
(inputs
`(("emacs-ansi" ,emacs-ansi)
("emacs-commander" ,emacs-commander)
("emacs-dash" ,emacs-dash)
("emacs-f" ,emacs-f)
("emacs-s" ,emacs-s)
("emacs-shut-up" ,emacs-shut-up)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'install 'install-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* "bin/ert-runner"
(("ERT_RUNNER=\"\\$\\(dirname \\$\\(dirname \\$0\\)\\)")
(string-append "ERT_RUNNER=\"" out
"/share/emacs/site-lisp/guix.d/ert-runner-"
,version)))
(install-file "bin/ert-runner" (string-append out "/bin"))
(wrap-program (string-append out "/bin/ert-runner")
(list "EMACSLOADPATH" ":" 'prefix
(string-split (getenv "EMACSLOADPATH") #\:)))
#t))))
#:include (cons* "^reporters/.*\\.el$" %default-include)))
(home-page "https://github.com/rejeep/ert-runner.el")
(synopsis "Opinionated Ert testing workflow")
(description "@code{ert-runner} is a tool for Emacs projects tested
using ERT. It assumes a certain test structure setup and can therefore make
running tests easier.")
(license license:gpl3+)))
(license license:gpl3+))))
(define-public ert-runner
(deprecated-package "ert-runner" emacs-ert-runner))
@ -12867,3 +12871,27 @@ (define-public emacs-edbi-sqlite
(description "This package is a convenience wrapper for @command{edbi}
to open SQLite databases.")
(license license:gpl3+))))
(define-public emacs-nix-mode
(package
(name "emacs-nix-mode")
(version "1.2.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/NixOS/nix-mode/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"06aqz0czznsj8835jqnk794sy2p6pa8kxfqwh0nl5d5vxivria6z"))))
(build-system emacs-build-system)
(inputs
`(("emacs-company" ,emacs-company)
("emacs-mmm-mode" ,emacs-mmm-mode)))
(home-page "https://github.com/NixOS/nix-mode")
(synopsis "Emacs major mode for editing Nix expressions")
(description "@code{nixos-mode} provides an Emacs major mode for editing
Nix expressions. It supports syntax highlighting, indenting and refilling of
comments.")
(license license:lgpl2.1+)))

14
gnu/packages/finance.scm
View file

@ -73,15 +73,15 @@ (define-module (gnu packages finance)
(define-public bitcoin-core
(package
(name "bitcoin-core")
(version "0.16.1")
(version "0.17.1")
(source (origin
(method url-fetch)
(uri
(string-append "https://bitcoin.org/bin/bitcoin-core-"
(string-append "https://bitcoincore.org/bin/bitcoin-core-"
version "/bitcoin-" version ".tar.gz"))
(sha256
(base32
"1zkqp93yircd3pbxczxfnibkpq0sgcv5r7wg6d196b9pwgr9zd39"))))
"0am4pnaf2cisv172jqx6jdpzx770agm8777163lkjbw3ryslymiy"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
@ -115,9 +115,15 @@ (define-public bitcoin-core
"/bin/lupdate"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'make-qt-deterministic
(lambda _
;; Make Qt deterministic.
(setenv "QT_RCC_SOURCE_DATE_OVERRIDE" "1")
#t))
(add-before 'check 'set-home
(lambda _
(setenv "HOME" (getenv "TMPDIR"))))))) ; Tests write to $HOME.
(setenv "HOME" (getenv "TMPDIR")) ; Tests write to $HOME.
#t)))))
(home-page "https://bitcoin.org/en/")
(synopsis "Bitcoin peer-to-peer client")
(description

14
gnu/packages/games.scm
View file

@ -1418,6 +1418,8 @@ (define freedink-engine
("sdl-gfx" ,sdl-gfx)
("fontconfig" ,fontconfig)
("check" ,check)))
(properties '((ftp-directory . "/freedink")
(upstream-name . "freedink")))
(home-page "https://www.gnu.org/software/freedink/")
(synopsis "Twisted adventures of young pig farmer Dink Smallwood")
(description
@ -1430,14 +1432,14 @@ (define freedink-engine
(define freedink-data
(package
(name "freedink-data")
(version "1.08.20170401")
(version "1.08.20190120")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/freedink/freedink-data-"
version ".tar.xz"))
version ".tar.gz"))
(sha256
(base32
"1zx7qywibhznj7bnz217404scr8dfh0xj24xjihnda5iapzz7lz8"))))
"17gvryadlxk172mblbsil7hina1z5wahwaxnr6g3mdq57dvl8pvi"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@ -1445,6 +1447,7 @@ (define freedink-data
(delete 'configure) ; no configure script
(delete 'check)) ; no tests
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(properties '((ftp-directory . "/freedink")))
(home-page "https://www.gnu.org/software/freedink/")
(synopsis "Game data for GNU Freedink")
(description
@ -1468,6 +1471,8 @@ (define-public freedink-dfarc
(inputs
`(("bzip2" ,bzip2)
("wxwidgets" ,wxwidgets)))
(properties '((ftp-directory . "/freedink")
(upstream-name . "dfarc")))
(home-page "https://www.gnu.org/software/freedink/")
(synopsis "Front-end for managing and playing Dink Modules")
(description "DFArc makes it easy to play and manage the GNU FreeDink game
@ -5453,6 +5458,9 @@ (define-public fortune-mod
(string-append "fortune-mod/cmake/"
(strip-store-file-name cmake-rules)))
(chdir "fortune-mod")
;; TODO: Valgrind tests fail for some reason.
;; Similar issue: https://github.com/shlomif/fortune-mod/issues/21 (?)
(delete-file "tests/t/valgrind.t")
#t)))
(add-after 'install 'fix-install-directory
(lambda* (#:key outputs #:allow-other-keys)

4
gnu/packages/guile.scm
View file

@ -1672,7 +1672,7 @@ (define-public guile2.2-commonmark
(define-public guile-bytestructures
(package
(name "guile-bytestructures")
(version "1.0.3")
(version "1.0.5")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/TaylanUB/scheme-bytestructures"
@ -1680,7 +1680,7 @@ (define-public guile-bytestructures
"/bytestructures-" version ".tar.gz"))
(sha256
(base32
"0xf6s8gd3656j8k2ar6y7i62r68azawyzxhsagsk8nvldnrs1r18"))))
"0ibk7fjwpb450lnrva4bx45sgln3pbyb645az4ansvh1spgani43"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

4
gnu/packages/haskell.scm
View file

@ -3,7 +3,7 @@
;;; Copyright © 2015 Siniša Biđin <sinisa@bidin.eu>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
@ -3790,8 +3790,6 @@ (define-public ghc-case-insensitive
(base32
"1qrpxfirsxckg7jv28f5ah2qc8lh95hp7rnqkbqs1ahcwlbnvkm7"))))
(build-system haskell-build-system)
(inputs
`(("ghc-hunit" ,ghc-hunit)))
;; these inputs are necessary to use this library
(inputs
`(("ghc-text" ,ghc-text)

95
gnu/packages/linux.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
@ -413,8 +413,8 @@ (define* (make-linux-libre version hash supported-systems
It has been modified to remove all non-free binary blobs.")
(license license:gpl2)))
(define %linux-libre-version "4.20.3")
(define %linux-libre-hash "0mk996fb4bd9548xnv2as4lxm3gyj1kvn6ra03xxpb0wf8cqdazz")
(define %linux-libre-version "4.20.4")
(define %linux-libre-hash "1p7ixkqvnr0mzyivyby8hfix44np7w1nvyxghz8wa1h2nhsszvzv")
(define %linux-libre-4.20-patches
(list %boot-logo-patch
@ -427,8 +427,8 @@ (define-public linux-libre
#:patches %linux-libre-4.20-patches
#:configuration-file kernel-config))
(define %linux-libre-4.19-version "4.19.16")
(define %linux-libre-4.19-hash "1dpfllfzksrr6iqhvbh2905gkvycsv5zcmgq6wmwqiry1swzdfyk")
(define %linux-libre-4.19-version "4.19.17")
(define %linux-libre-4.19-hash "0friqd9wyhddjli4m41wd994ygnwng40a95ry14478rkadfv7iwh")
(define %linux-libre-4.19-patches
(list %boot-logo-patch
@ -5039,3 +5039,88 @@ (define-public xfsprogs
;; The library "libhandle" and the headers in "xfslibs-dev" are
;; licensed under lgpl2.1. the other stuff is licensed under gpl2.
(license (list license:gpl2 license:lgpl2.1))))
(define-public genext2fs
(package
(name "genext2fs")
(version "1.4.1")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/jeremie-koenig/genext2fs.git")
(commit (string-append "genext2fs-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1r0n74pyypv63qfqqpvx75dwijcsvcrvqrlv8sldbhv0nwr1gk53"))))
(build-system gnu-build-system)
(home-page "https://github.com/jeremie-koenig/genext2fs")
(synopsis "Generate ext2 filesystem as a normal user")
(description "This package provides a program to general an ext2
filesystem as a normal (non-root) user. It does not require you to mount
the image file to copy files on it, nor does it require that you become
the superuser to make device nodes.")
(license license:gpl2)))
(define-public fakeroot
(package
(name "fakeroot")
(version "1.23")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.debian.org/debian/pool/main/f/"
"fakeroot/fakeroot_" version ".orig.tar.xz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1xpl0s2yjyjwlf832b6kbkaa5921liybaar13k7n45ckd9lxd700"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'configure 'patch-Makefile
(lambda _
;; Note: The root of the problem is already in "Makefile.am".
(substitute* "Makefile"
(("/bin/sh") (which "sh")))
#t))
(add-after 'unpack 'patch-getopt
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "scripts/fakeroot.in"
(("getopt")
(string-append (assoc-ref inputs "util-linux")
"/bin/getopt")))
#t))
(add-before 'check 'prepare-check
(lambda _
(setenv "SHELL" (which "bash"))
(setenv "VERBOSE" "1")
(substitute* "test/t.touchinstall"
;; We don't have the name of the root user, so use ID=0.
(("grep root") "grep \"\\<0\\>\""))
(substitute* "test/tartest"
;; We don't have the name of the root group, so use ID=0.
(("ROOTGROUP=root") "ROOTGROUP=0")
;; We don't have the name of the daemon user, so use IDs.
(("daemon:sys") "1:3")
(("daemon:") "1:"))
;; We don't have an /etc/passwd entry for "root" - use numeric IDs.
(substitute* "test/compare-tar"
(("tar -tvf") "tar --numeric-owner -tvf"))
#t)))))
(native-inputs
`(("sharutils" ,sharutils) ; for the tests
("xz" ,xz))) ; for the tests
(inputs
`(("libcap" ,libcap)
("util-linux" ,util-linux)))
(synopsis "Provides a fake root environment")
(description "@command{fakeroot} runs a command in an environment where
it appears to have root privileges for file manipulation. This is useful
for allowing users to create archives (tar, ar, .deb etc.) with files in
them with root permissions/ownership. Without fakeroot one would have to
have root privileges to create the constituent files of the archives with
the correct permissions and ownership, and then pack them up, or one would
have to construct the archives directly, without using the archiver.")
(home-page "http://freshmeat.sourceforge.net/projects/fakeroot")
(license license:gpl3+)))

8
gnu/packages/messaging.scm
View file

@ -553,14 +553,14 @@ (define-public znc
(define-public python-nbxmpp
(package
(name "python-nbxmpp")
(version "0.6.8")
(version "0.6.9")
(source
(origin
(method url-fetch)
(uri (pypi-uri "nbxmpp" version))
(sha256
(base32
"1iip8ijxp86fx4bl1h67p2lp02p2zm1ga2p3q43nv30smj54nawc"))))
"03f8dk4kb7ya0pg7v0a0kqms4c7f2bqan5wl4ig0mcwpdmppj3b6"))))
(build-system python-build-system)
(arguments
`(#:tests? #f)) ; no tests
@ -578,7 +578,7 @@ (define-public python2-nbxmpp
(define-public gajim
(package
(name "gajim")
(version "1.1.1")
(version "1.1.2")
(source (origin
(method url-fetch)
(uri (string-append "https://gajim.org/downloads/"
@ -586,7 +586,7 @@ (define-public gajim
"/gajim-" version ".tar.bz2"))
(sha256
(base32
"09n4445hclqwfnk2h9cxvsxaixza4cpgb5rp4najdfc2jgg2msb3"))))
"1lx03cgi58z54xb7mhs6bc715lc00w5mpysf9n3q8zgn759fm0rj"))))
(build-system python-build-system)
(arguments
`(#:phases

9
gnu/packages/moreutils.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@ -30,7 +30,7 @@ (define-module (gnu packages moreutils)
(define-public moreutils
(package
(name "moreutils")
(version "0.62")
(version "0.63")
(source
(origin
(method url-fetch)
@ -43,7 +43,7 @@ (define-public moreutils
name "-" version ".tar.gz")))
(sha256
(base32
"1gc3rswr0jl0z42pbrmw2zc4gxsyp60hq8cnvrlsig1vk1s9vpwx"))))
"07c3wqf1sx3nhj4cs71a9ajcfl6arjjvvnhwqz7a0xm2m1b6vj2g"))))
(build-system gnu-build-system)
;; For building the manual pages.
(native-inputs
@ -63,7 +63,8 @@ (define-public moreutils
(let* ((out (assoc-ref outputs "out")))
(wrap-program
(string-append out "/bin/ts")
`("PERL5LIB" ":" prefix (,(getenv "PERL5LIB")))))))
`("PERL5LIB" ":" prefix (,(getenv "PERL5LIB")))))
#t))
(delete 'configure)) ; no configure script
#:make-flags
(list (string-append "PREFIX=" (assoc-ref %outputs "out"))

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

@ -43,7 +43,6 @@ (define-module (gnu packages package-management)
#:use-module (gnu packages curl)
#:use-module (gnu packages dbm)
#:use-module (gnu packages docbook)
#:use-module (gnu packages emacs-xyz)
#:use-module (gnu packages file)
#:use-module (gnu packages gettext)
#:use-module (gnu packages glib)
@ -76,7 +75,6 @@ (define-module (gnu packages package-management)
#:use-module (gnu packages web)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (guix build-system emacs)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system python)
@ -460,30 +458,6 @@ (define-public nix
sub-directory.")
(license license:lgpl2.1+)))
(define-public emacs-nix-mode
(package
(name "emacs-nix-mode")
(version "1.2.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/NixOS/nix-mode/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"06aqz0czznsj8835jqnk794sy2p6pa8kxfqwh0nl5d5vxivria6z"))))
(build-system emacs-build-system)
(inputs
`(("emacs-company" ,emacs-company)
("emacs-mmm-mode" ,emacs-mmm-mode)))
(home-page "https://github.com/NixOS/nix-mode")
(synopsis "Emacs major mode for editing Nix expressions")
(description "@code{nixos-mode} provides an Emacs major mode for editing
Nix expressions. It supports syntax highlighting, indenting and refilling of
comments.")
(license license:lgpl2.1+)))
(define-public stow
(package
(name "stow")

61
gnu/packages/pdf.scm
View file

@ -1067,26 +1067,45 @@ (define-public pdfpc
(license license:gpl2+)))
(define-public paps
(package
(name "paps")
(version "0.6.8")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/paps/paps/" version "/"
"paps-" version ".tar.gz"))
(sha256
(base32
"080ahnyvq918m8ahq8bg9qvgzlv4k0jgcsdqhrwjzppclx74q8fv"))))
(build-system gnu-build-system)
(inputs
`(("pango" ,pango)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://paps.sourceforge.net/")
(synopsis "Pango to PostScript converter")
(description
"Paps reads a UTF-8 encoded file and generates a PostScript language
(let ((commit "37e6ca1cd96d751bbbff5539d795c90d657289a5")
(revision "1"))
(package
(name "paps")
;; The last release was in 2015, but since then there have been security
;; bug fixes.
(version (git-version "0.7.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/dov/paps.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"1ilcyjqdynxsd2p8dnn8h4592dwf531x9pbkxa1w09hkcdn7hgwc"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'do-not-run-configure-script-during-bootstrap
(lambda _
(substitute* "autogen.sh"
(("^./configure") "#"))
#t)))))
(inputs
`(("pango" ,pango)))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("gettext" ,gettext-minimal)
("glib" ,glib "bin")
("intltool" ,intltool)
("pkg-config" ,pkg-config)))
(home-page "https://github.com/dov/paps")
(synopsis "Pango to PostScript converter")
(description
"Paps reads a UTF-8 encoded file and generates a PostScript language
rendering of the file. The rendering is done by creating outline curves
through the Pango @code{ft2} backend.")
(license license:lgpl2.0+)))
(license license:lgpl2.0+))))

22
gnu/packages/perl-check.scm
View file

@ -788,6 +788,28 @@ (define-public perl-test-mocktime
to gmtime,time or localtime.")
(license perl-license)))
(define-public perl-test-more-utf8
(package
(name "perl-test-more-utf8")
(version "0.05")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://cpan/authors/id/M/MO/MONS/Test-More-UTF8-"
version ".tar.gz"))
(sha256
(base32
"016fs77lmw8xxrcnapvp6wq4hjwgsdfi3l9ylpxgxkcpdarw9wdr"))))
(build-system perl-build-system)
(home-page "https://metacpan.org/release/Test-More-UTF8")
(synopsis "Enhance Test::More for UTF8-based projects")
(description "@code{Test::More::UTF8} is a simple extension for the widely
used @code{Test::More} module. By default, it will do a @code{binmode ':utf8'}
on all of @code{Test::Builder}'s output handles thus enabling the easy use
flagged strings without warnings like \"Wide character in print @dots{}\"")
(license perl-license)))
(define-public perl-test-most
(package
(name "perl-test-most")

55
gnu/packages/perl.scm
View file

@ -3431,7 +3431,7 @@ (define-public perl-file-grep
(define-public perl-file-homedir
(package
(name "perl-file-homedir")
(version "1.002")
(version "1.004")
(source
(origin
(method url-fetch)
@ -3439,7 +3439,7 @@ (define-public perl-file-homedir
"File-HomeDir-" version ".tar.gz"))
(sha256
(base32
"0x62hn8rc7ninf9nlp69h61yh21g4cbq2g81sh64cf2ify2hqk7b"))))
"1bciyzwv7gwsnaykqz0czj6mlbkkg4hg1s40s1q7j2p6nlmpxxj5"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-file-which" ,perl-file-which)))
@ -3559,7 +3559,7 @@ (define-public perl-file-readbackwards
(define-public perl-file-remove
(package
(name "perl-file-remove")
(version "1.57")
(version "1.58")
(source
(origin
(method url-fetch)
@ -3567,14 +3567,16 @@ (define-public perl-file-remove
"File-Remove-" version ".tar.gz"))
(sha256
(base32
"1b814lw181kkqh6c1n4p2zlzzsq6ic5pfpr831nphf2w2rhcvgmk"))))
"1n6h5w3sp2bs4cfrifdx2z15cfpb4r536179mx1a12xbmj1yrxl1"))))
(build-system perl-build-system)
(native-inputs
`(("perl-module-build" ,perl-module-build)))
(home-page "https://metacpan.org/release/File-Remove")
(synopsis "Remove files and directories in Perl")
(description "File::Remove::remove removes files and directories. It acts
like /bin/rm, for the most part. Although \"unlink\" can be given a list of
files, it will not remove directories; this module remedies that. It also
accepts wildcards, * and ?, as arguments for file names.")
(description "@code{File::Remove::remove} removes files and directories.
It acts like @code{/bin/rm}, for the most part. Although @code{unlink} can be
given a list of files, it will not remove directories; this module remedies
that. It also accepts wildcards, * and ?, as arguments for file names.")
(license (package-license perl))))
(define-public perl-file-sharedir
@ -3648,15 +3650,15 @@ (define-public perl-file-sharedir-install
(define-public perl-file-slurp
(package
(name "perl-file-slurp")
(version "9999.19")
(version "9999.25")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/U/UR/URI/"
(uri (string-append "mirror://cpan/authors/id/C/CA/CAPOEIRAB/"
"File-Slurp-" version ".tar.gz"))
(sha256
(base32
"0hrn4nipwx40d6ji8ssgr5nw986z9iqq8cn0kdpbszh9jplynaff"))))
"1hg3bhf5m78d77p4174cnldd75ppyrvr5rkc8w289ihvwsx9gsn7"))))
(build-system perl-build-system)
(home-page "https://metacpan.org/release/File-Slurp")
(synopsis "Reading/Writing/Modifying of complete files")
@ -3732,14 +3734,14 @@ (define-public perl-file-temp
(define-public perl-file-which
(package
(name "perl-file-which")
(version "1.09")
(version "1.23")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/A/AD/ADAMK/"
(uri (string-append "mirror://cpan/authors/id/P/PL/PLICEASE/"
"File-Which-" version ".tar.gz"))
(sha256
(base32
"1hxjyh9yrv32f3g8vrnr8iylzprajsac14vjm75kf1qnj1jyqbxp"))))
"0y70qh5kn2hyrrvbsfhg0iws2qggk5vkpz37f7rbd5rd9cjc57dp"))))
(build-system perl-build-system)
(native-inputs `(("test-script" ,perl-test-script)))
(synopsis "Portable implementation of the `which' utility")
@ -3747,7 +3749,7 @@ (define-public perl-file-which
"File::Which was created to be able to get the paths to executable
programs on systems under which the `which' program wasn't implemented in the
shell.")
(home-page "https://metacpan.org/release/ADAMK/File-Which-1.09")
(home-page "https://metacpan.org/release/File-Which")
(license (package-license perl))))
(define-public perl-file-zglob
@ -4361,15 +4363,15 @@ (define-public perl-ipc-system-simple
(define-public perl-json
(package
(name "perl-json")
(version "2.90")
(version "4.01")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MAKAMAKA/"
(uri (string-append "mirror://cpan/authors/id/I/IS/ISHIGAKI/"
"JSON-" version ".tar.gz"))
(sha256
(base32
"127yppvr17qik9pkd1vy901hs4l13kg6rhp76jdgcyask35v7nsd"))))
"1vdiw095g5rf51q8d0ipf8020jx371pma0k4sxp0wlfl76lr65b3"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-json-xs" ,perl-json-xs))) ;recommended
@ -4436,7 +4438,7 @@ (define-public perl-json-maybexs
(define-public perl-json-xs
(package
(name "perl-json-xs")
(version "3.01")
(version "4.0")
(source
(origin
(method url-fetch)
@ -4444,8 +4446,10 @@ (define-public perl-json-xs
"JSON-XS-" version ".tar.gz"))
(sha256
(base32
"1aviik480m61ykwvyix83grywzbk828wvfz19hqfvaasd8jz73af"))))
"0118yrzagwlcfj5yldn3h23zzqs2rx282jlm068nf7fjlvy4m7s7"))))
(build-system perl-build-system)
(native-inputs
`(("perl-canary-stability" ,perl-canary-stability)))
(propagated-inputs
`(("perl-common-sense" ,perl-common-sense)
("perl-types-serialiser" ,perl-types-serialiser)))
@ -5299,7 +5303,7 @@ (define-public perl-module-runtime-conflicts
(define-public perl-module-scandeps
(package
(name "perl-module-scandeps")
(version "1.25")
(version "1.27")
(source
(origin
(method url-fetch)
@ -5307,7 +5311,7 @@ (define-public perl-module-scandeps
"Module-ScanDeps-" version ".tar.gz"))
(sha256
(base32
"13280nq0d6zc58mcz3kvs2m85a741czq0fabk69ks1nr4j1w2nl4"))))
"0j6r9r99x5p0i6fv06i44wpsvjxj32amjkiqf6pmqpj80jff2k7f"))))
(build-system perl-build-system)
(native-inputs
`(("perl-test-requires" ,perl-test-requires)))
@ -8389,7 +8393,7 @@ (define-public perl-text-table
(define-public perl-text-template
(package
(name "perl-text-template")
(version "1.47")
(version "1.54")
(source
(origin
(method url-fetch)
@ -8399,8 +8403,11 @@ (define-public perl-text-template
".tar.gz"))
(sha256
(base32
"1z781cgz7wbn80lf3kqr2ad0pg6g1wlnim0822h8liw28k3l5msh"))))
"0s56jgak9ccbbbybf5v8hvvhyplbfhzl6p6v1751inly80rlj1kv"))))
(build-system perl-build-system)
(native-inputs
`(("perl-test-more-utf8" ,perl-test-more-utf8)
("perl-test-warnings" ,perl-test-warnings)))
(home-page
"https://metacpan.org/release/Text-Template")
(synopsis

16
gnu/packages/python-web.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
;;; Copyright © 2015, 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym+a@scratchpost.org>
;;; Copyright © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
@ -1218,14 +1218,14 @@ (define-public python2-ndg-httpsclient
(define-public python-websocket-client
(package
(name "python-websocket-client")
(version "0.37.0")
(version "0.54.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "websocket_client" version))
(sha256
(base32
"0h9glp1jll3z76ly3kg08aqgxqk0a68p4zi9yn50353bh5nj92v7"))))
"0j88zmikaypf38lvpkf4aaxrjp9j07dmy5ghj7kli0fv3p4n45g5"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)))
@ -1233,10 +1233,18 @@ (define-public python-websocket-client
(synopsis "WebSocket client for Python")
(description "The Websocket-client module provides the low level APIs for
WebSocket usage in Python programs.")
(properties `((python2-variant . ,(delay python2-websocket-client))))
(license license:lgpl2.1+)))
(define-public python2-websocket-client
(package-with-python2 python-websocket-client))
(let ((base (package-with-python2
(strip-python2-variant python-websocket-client))))
(package
(inherit base)
(native-inputs
`(("python2-backport-ssl-match-hostname"
,python2-backport-ssl-match-hostname)
,@(package-native-inputs base))))))
(define-public python-requests
(package

47
gnu/packages/python-xyz.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2017 Eric Bavier <bavier@member.fsf.org>
@ -1997,25 +1997,25 @@ (define-public python-vine
(define-public python-virtualenv
(package
(name "python-virtualenv")
(version "15.0.3")
(version "16.1.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "virtualenv" version))
(sha256
(base32
"07cbajzk8l05k5zhlw0b9wbf2is65bl9v6zrn2a0iyn57w6pd73d"))))
"0242cg3hdq3qdvx5flyrki8lpwlgwf5k45c21ks5049fv7ygm6gq"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(add-before 'check 'disable-failing-test
(lambda _
;; Disable failing test. See upstream bug report
;; https://github.com/pypa/virtualenv/issues/957
(substitute* "tests/test_virtualenv.py"
(("skipif.*") "skipif(True, reason=\"Guix\")\n"))
(zero? (system* "py.test")))))))
#t)))))
(native-inputs
`(("python-mock" ,python-mock)
("python-pytest" ,python-pytest)))
@ -3391,8 +3391,6 @@ (define-public python2-pysnptools
`(("python2-numpy" ,python2-numpy)
("python2-scipy" ,python2-scipy)
("python2-pandas" ,python2-pandas)))
(native-inputs
`(("python2-cython" ,python2-cython)))
(native-inputs
`(("unzip" ,unzip)))
(home-page "http://research.microsoft.com/en-us/um/redmond/projects/mscompbio/")
@ -6052,14 +6050,14 @@ (define-public python2-netaddr
(define-public python-wrapt
(package
(name "python-wrapt")
(version "1.10.11")
(version "1.11.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "wrapt" version))
(sha256
(base32
"1ip3dwib39xhp79kblskgvz3fjzcwxgx3fs3ahdixhpjg7a61mfl"))))
"0cqmysny1pz01jw26q48q5zasvns6507rwhgm6wcw743f0r01sja"))))
(build-system python-build-system)
(arguments
;; Tests are not included in the tarball, they are only available in the
@ -8705,14 +8703,14 @@ (define-public python2-future
(define-public python-cysignals
(package
(name "python-cysignals")
(version "1.1.0")
(version "1.9.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "cysignals" version ".tar.bz2"))
(uri (pypi-uri "cysignals" version))
(sha256
(base32
"14cbyd9znlz6cxy1s3g6v6dv5jj45hn27pywkidd9b1zanaysqc6"))))
"15ix8crpad26cfl1skyg7qajqqfdrm8q5ahhmlfmqi1aw0jqj2g2"))))
(build-system python-build-system)
(native-inputs
`(("python-cython" ,python-cython)
@ -11396,17 +11394,18 @@ (define-public python2-astroid
(define-public python-isort
(package
(name "python-isort")
(version "4.2.5")
(version "4.3.4")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/timothycrosley/isort/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
;; Tests pass only from the Github sources
(url "https://github.com/timothycrosley/isort")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0zsrgkb0krn5476yncy5dd56k7dk34zqb4bnlvwy44ixgilyjmfh"))))
"1q0mlrpki5vjbgwxag5rghljjcfg7mvb0pbkwid80p0sqrxlm2p6"))))
(build-system python-build-system)
(native-inputs
`(("python-mock" ,python-mock)
@ -11417,10 +11416,16 @@ (define-public python-isort
imports alphabetically, and automatically separated into sections. It
provides a command line utility, a python library and plugins for various
editors.")
(license license:expat)))
(license license:expat)
(properties `((python2-variant . ,(delay python2-isort))))))
(define-public python2-isort
(package-with-python2 python-isort))
(let ((base (package-with-python2
(strip-python2-variant python-isort))))
(package (inherit base)
(native-inputs
`(("python2-futures" ,python2-futures)
,@(package-native-inputs base))))))
(define-public python2-backports-functools-lru-cache
(package

18
gnu/packages/video.scm
View file

@ -15,7 +15,7 @@
;;; Copyright © 2016, 2018, 2019 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
@ -905,7 +905,7 @@ (define-public ffmpegthumbnailer
(define-public vlc
(package
(name "vlc")
(version "3.0.5")
(version "3.0.6")
(source (origin
(method url-fetch)
(uri (string-append
@ -914,7 +914,7 @@ (define-public vlc
"/vlc-" version ".tar.xz"))
(sha256
(base32
"1nvj00khy08sing0mdnw6virmiq579mrk5rvpx9710nlxggqgh7m"))))
"1lvyyahv6g9zv7m5g5qinyrwmw47zdsd5ysimb862j7kw15nvh8q"))))
(build-system gnu-build-system)
(native-inputs
`(("flex" ,flex)
@ -2667,15 +2667,18 @@ (define-public libmediainfo
(define-public mediainfo
(package
(name "mediainfo")
(version "0.7.95")
(version "18.12")
(source (origin
(method url-fetch)
;; Warning: This source has proved unreliable 1 time at least.
;; Consider an alternate source or report upstream if this
;; happens again.
(uri (string-append "https://mediaarea.net/download/source/"
name "/" version "/"
name "_" version ".tar.bz2"))
(sha256
(base32
"0dy51a3i79jppmg1gi4f6h7jx4hcgnkmfim4d7d3gmnlbkjh8anv"))))
"1ix95ilcjlawcq6phh25cgplm3riqa2ii7ql82g8yagqs4ldqp6a"))))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
@ -2693,10 +2696,7 @@ (define-public mediainfo
(add-after 'unpack 'change-to-build-dir
(lambda _
(chdir "Project/GNU/CLI")
#t))
(add-after 'change-to-build-dir 'autogen
(lambda _
(invoke "sh" "autogen.sh"))))))
#t)))))
(home-page "https://mediaarea.net/en/MediaInfo")
(synopsis "Utility for reading media metadata")
(description "MediaInfo is a utility used for retrieving technical

215
gnu/packages/virtualization.scm
View file

@ -6,7 +6,7 @@
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2017, 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
@ -30,17 +30,22 @@
(define-module (gnu packages virtualization)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages assembly)
#:use-module (gnu packages attr)
#:use-module (gnu packages autotools)
#:use-module (gnu packages bison)
#:use-module (gnu packages check)
#:use-module (gnu packages cmake)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages disk)
#:use-module (gnu packages dns)
#:use-module (gnu packages docbook)
#:use-module (gnu packages documentation)
#:use-module (gnu packages figlet)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext)
@ -72,6 +77,7 @@ (define-module (gnu packages virtualization)
#:use-module (gnu packages textutils)
#:use-module (gnu packages tls)
#:use-module (gnu packages web)
#:use-module (gnu packages wget)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
@ -896,7 +902,7 @@ (define-public runc
(define-public umoci
(package
(name "umoci")
(version "0.4.2")
(version "0.4.3")
(source (origin
(method url-fetch)
(uri (string-append
@ -905,7 +911,7 @@ (define-public umoci
(file-name (string-append "umoci-" version ".tar.xz"))
(sha256
(base32
"1rq5jxcss9cmy05x9b2kh9ld57ribi8hgnx2w67jpmf343b83m4q"))))
"1hy3gcs8z25153qpw4rk2lispfaf2c90hv1q64xwyjxn22j9ayy9"))))
(build-system go-build-system)
(arguments
'(#:import-path "github.com/openSUSE/umoci"
@ -1103,3 +1109,206 @@ (define-public bochs
Bochs can run most Operating Systems inside the emulation including Linux,
DOS or Microsoft Windows.")
(license license:lgpl2.0+)))
(define-public xen
(package
(name "xen")
(version "4.11.1")
(source (origin
(method git-fetch)
(uri (git-reference
(url "git://xenbits.xenproject.org/xen.git")
(commit (string-append "RELEASE-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1wv1hyfii14vi9lfjmnv07h2gpm3b7kvh2p55f4yy2b40simksgk"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
(list "--enable-rpath"
"--disable-qemu-traditional" ; It tries to do "git clone"
"--disable-rombios" ; would try to "git clone" via etherboot.
;; TODO: Re-enable stubdom (it's "more secure" to use it).
"--disable-stubdom" ; tries to "git clone" old patched newlib.
(string-append "--with-initddir="
(assoc-ref %outputs "out")
"/etc/init.d")
(string-append "--with-system-qemu="
(assoc-ref %build-inputs "qemu")
"/bin/qemu-system-i386")
(string-append "--with-system-seabios="
(assoc-ref %build-inputs "seabios")
"/share/firmware/bios.bin")
(string-append "--with-system-ovmf="
(assoc-ref %build-inputs "ovmf")
"/share/firmware/ovmf_ia32.bin"))
#:make-flags (list "-j" "1"
"XEN_BUILD_DATE=Thu Jan 1 01:00:01 CET 1970"
"XEN_BUILD_TIME=01:00:01"
"XEN_BUILD_HOST="
"ETHERBOOT_NICS="
"SMBIOS_REL_DATE=01/01/1970"
"VGABIOS_REL_DATE=01 Jan 1970"
; QEMU_TRADITIONAL_LOC
; QEMU_UPSTREAM_LOC
"SYSCONFIG_DIR=/tmp/etc/default"
(string-append "BASH_COMPLETION_DIR="
(assoc-ref %outputs "out")
"/etc/bash_completion.d")
(string-append "BOOT_DIR="
(assoc-ref %outputs "out")
"/boot")
(string-append "DEBUG_DIR="
(assoc-ref %outputs "out")
"/lib/debug")
(string-append "EFI_DIR="
(assoc-ref %outputs "out")
"/lib/efi") ; TODO lib64 ?
"MINIOS_UPSTREAM_URL="
;(string-append "DISTDIR="
; (assoc-ref %outputs "out"))
)
#:test-target "test"
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'unpack-mini-os
(lambda* (#:key inputs #:allow-other-keys)
(copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
#t))
(add-after 'unpack-mini-os 'patch
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "tools/firmware/Rules.mk"
(("override XEN_TARGET_ARCH = x86_32")
(string-append "override XEN_TARGET_ARCH = x86_32
override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
(("^CFLAGS =$")
(string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
"/include\n")))
(substitute* "config/x86_32.mk"
(("CFLAGS += -m32 -march=i686")
(string-append "CFLAGS += -march=i686 -I"
(assoc-ref inputs "cross-libc")
"/include")))
;; /var is not in /gnu/store , so don't try to create it.
(substitute* '("tools/Makefile"
"tools/xenstore/Makefile"
"tools/xenpaging/Makefile")
(("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
"\n")
(("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
"\n"))
;; Prevent xen from creating /etc .
(substitute* "tools/examples/Makefile"
((" install-readmes") "")
((" install-configs") ""))
;; Set rpath.
(substitute* "tools/pygrub/setup.py"
(("library_dirs =")
; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
(string-append "runtime_library_dirs = ['"
(assoc-ref outputs "out")
"/lib'],\nlibrary_dirs =")))
#t))
(add-before 'configure 'patch-xen-script-directory
(lambda* (#:key outputs #:allow-other-keys)
(substitute* '("configure"
"tools/configure"
"docs/configure")
(("XEN_SCRIPT_DIR=.*")
(string-append "XEN_SCRIPT_DIR="
(assoc-ref outputs "out")
"/etc/xen/scripts")))
#t))
(add-before 'configure 'set-environment-up
(lambda* (#:key make-flags #:allow-other-keys)
(define (cross? x)
(string-contains x "cross-i686-linux"))
(define (filter-environment! filter-predicate
environment-variable-names)
(for-each
(lambda (env-name)
(let* ((env-value (getenv env-name))
(search-path (search-path-as-string->list env-value))
(new-search-path (filter filter-predicate
search-path))
(new-env-value (list->search-path-as-string
new-search-path ":")))
(setenv env-name new-env-value)))
environment-variable-names))
(setenv "CROSS_C_INCLUDE_PATH" (getenv "C_INCLUDE_PATH"))
(setenv "CROSS_CPLUS_INCLUDE_PATH" (getenv "CPLUS_INCLUDE_PATH"))
(setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
(filter-environment! cross?
'("CROSS_C_INCLUDE_PATH" "CROSS_CPLUS_INCLUDE_PATH"
"CROSS_LIBRARY_PATH"))
(filter-environment! (lambda (e) (not (cross? e)))
'("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
"LIBRARY_PATH"))
;; Guix tries to be helpful and automatically adds
;; mini-os-git-checkout/include to the include path,
;; but actually we don't want it to be there (yet).
(filter-environment! (lambda (e)
(not
(string-contains e
"mini-os-git-checkout")))
'("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
"LIBRARY_PATH"))
(setenv "EFI_VENDOR" "guix")
#t))
(replace 'build
(lambda* (#:key make-flags #:allow-other-keys)
(apply invoke "make" "world" make-flags))))))
(inputs
`(("acpica" ,acpica) ; TODO: patch iasl invocation.
("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
("glib" ,glib)
("iproute" ,iproute) ; TODO: patch invocations.
("libaio" ,libaio)
("libx11" ,libx11)
("libyajl" ,libyajl)
("ncurses" ,ncurses)
("openssl" ,openssl)
("ovmf" ,ovmf)
("pixman" ,pixman)
("qemu" ,qemu-minimal)
("seabios" ,seabios)
("util-linux" ,util-linux) ; uuid
; TODO: ocaml-findlib, ocaml-nox.
("xz" ,xz) ; for liblzma
("zlib" ,zlib)))
(native-inputs
`(("dev86" ,dev86)
("bison" ,bison)
("cmake" ,cmake)
("figlet" ,figlet)
("flex" ,flex)
("gettext" ,gettext-minimal)
("libnl" ,libnl)
("mini-os"
,(origin
(method git-fetch)
(uri (git-reference
(url "http://xenbits.xen.org/git-http/mini-os.git")
(commit (string-append "xen-RELEASE-" version))))
(sha256
(base32
"1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
(file-name "mini-os-git-checkout")))
("perl" ,perl)
; TODO: markdown
("pkg-config" ,pkg-config)
("python" ,python-2)
("wget" ,wget)
("cross-gcc" ,(cross-gcc "i686-linux-gnu"
#:xbinutils (cross-binutils "i686-linux-gnu")
#:libc (cross-libc "i686-linux-gnu")))
("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
(home-page "https://xenproject.org/")
(synopsis "Xen Virtual Machine Monitor")
(description "This package provides the Xen Virtual Machine Monitor
which is a hypervisor.")
;; TODO: Some files are licensed differently. List those.
(license license:gpl2)
(supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))

6
gnu/packages/xml.scm
View file

@ -12,7 +12,7 @@
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016, 2017 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Adriano Peluso <catonano@gmail.com>
;;; Copyright © 2017 Gregor Giesen <giesen@zaehlwerk.net>
@ -686,14 +686,14 @@ (define-public perl-xml-compile-tester
(define-public perl-xml-compile
(package
(name "perl-xml-compile")
(version "1.60")
(version "1.61")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-" version ".tar.gz"))
(sha256
(base32
"04vv7wy5v1l38xsfdbacvyd90qircvnrs2f3ysljm1nhq8mycmwm"))))
"13dvsaj8simivj867rkjlf7hhvvcwlahnhk70zf8cq2xbg8wmf7x"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-carp" ,perl-carp)

6
gnu/packages/xorg.scm
View file

@ -14,7 +14,7 @@
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net>
@ -2236,7 +2236,7 @@ (define-public xcursor-themes
(define-public xcursorgen
(package
(name "xcursorgen")
(version "1.0.6")
(version "1.0.7")
(source
(origin
(method url-fetch)
@ -2246,7 +2246,7 @@ (define-public xcursorgen
".tar.bz2"))
(sha256
(base32
"0v7nncj3kaa8c0524j7ricdf4rvld5i7c3m6fj55l5zbah7r3j1i"))))
"0ggbv084cavp52hjgcz3vdj0g018axs0m23c03lpc5sgn92gidim"))))
(build-system gnu-build-system)
(inputs
`(("libxcursor" ,libxcursor)

1
gnu/system/vm.scm
View file

@ -30,7 +30,6 @@ (define-module (gnu system vm)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix scripts pack)
#:use-module (guix utils)
#:use-module (gcrypt hash)
#:use-module (guix base32)

3
gnu/tests/install.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@ -430,7 +430,6 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(type "ext4"))
(file-system
(device "none")
(type "tmpfs")
(mount-point "/home")
(type "tmpfs"))
%base-file-systems))

50
guix/build/compile.scm
View file

@ -97,8 +97,7 @@ (define total
(report-load file total completed)
(format debug-port "~%loading '~a'...~%" file)
(parameterize ((current-warning-port debug-port))
(resolve-interface (file-name->module-name file)))
(resolve-interface (file-name->module-name file))
(loop files (+ 1 completed)))))))
@ -158,37 +157,38 @@ (define (build file)
;; Exit as soon as something goes wrong.
(exit-on-exception
(with-fluids ((*current-warning-prefix* ""))
(with-target host
(lambda ()
(let ((relative (relative-file source-directory file)))
(compile-file file
#:output-file (string-append build-directory "/"
(scm->go relative))
#:opts (append warning-options
(optimization-options relative))))))))
(with-target host
(lambda ()
(let ((relative (relative-file source-directory file)))
(compile-file file
#:output-file (string-append build-directory "/"
(scm->go relative))
#:opts (append warning-options
(optimization-options relative)))))))
(with-mutex progress-lock
(set! completed (+ 1 completed))))
(with-augmented-search-path %load-path source-directory
(with-augmented-search-path %load-compiled-path build-directory
;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
;; of FILES.
(load-files source-directory files
#:report-load report-load
#:debug-port debug-port)
(with-fluids ((*current-warning-prefix* ""))
;; Make sure compilation related modules are loaded before starting to
;; compile files in parallel.
(compile #f)
;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
;; of FILES.
(load-files source-directory files
#:report-load report-load
#:debug-port debug-port)
;; XXX: Don't use too many workers to work around the insane memory
;; requirements of the compiler in Guile 2.2.2:
;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
(n-par-for-each (min workers 8) build files)
;; Make sure compilation related modules are loaded before starting to
;; compile files in parallel.
(compile #f)
(unless (zero? total)
(report-compilation #f total total)))))
;; XXX: Don't use too many workers to work around the insane memory
;; requirements of the compiler in Guile 2.2.2:
;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
(n-par-for-each (min workers 8) build files)
(unless (zero? total)
(report-compilation #f total total))))))
(eval-when (eval load)
(when (and (string=? "2" (major-version))

24
guix/deprecation.scm
View file

@ -20,7 +20,7 @@ (define-module (guix deprecation)
#:use-module (guix i18n)
#:use-module (ice-9 format)
#:export (define-deprecated
without-deprecation-warnings
define-deprecated/alias
deprecation-warning-port))
;;; Commentary:
@ -33,7 +33,7 @@ (define-module (guix deprecation)
(define deprecation-warning-port
;; Port where deprecation warnings go.
(make-parameter (current-warning-port)))
(make-parameter (current-error-port)))
(define (source-properties->location-string properties)
"Return a human-friendly, GNU-standard representation of PROPERTIES, a
@ -87,3 +87,23 @@ (define-syntax variable
(id
(identifier? #'id)
#'real))))))))))
(define-syntax-rule (define-deprecated/alias deprecated replacement)
"Define as an alias a deprecated variable, procedure, or macro, along
these lines:
(define-deprecated/alias nix-server? store-connection?)
where 'nix-server?' is the deprecated name for 'store-connection?'.
This will write a deprecation warning to DEPRECATION-WARNING-PORT."
(define-syntax deprecated
(lambda (s)
(warn-about-deprecation 'deprecated (syntax-source s)
#:replacement 'replacement)
(syntax-case s ()
((_ args (... ...))
#'(replacement args (... ...)))
(id
(identifier? #'id)
#'replacement)))))

2
guix/derivations.scm
View file

@ -113,7 +113,7 @@ (define-module (guix derivations)
;;; Error conditions.
;;;
(define-condition-type &derivation-error &nix-error
(define-condition-type &derivation-error &store-error
derivation-error?
(derivation derivation-error-derivation))

2
guix/grafts.scm
View file

@ -189,7 +189,7 @@ (define (output-paths drv)
items)))
(define (references* items)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; As a last resort, build DRV and query the references of the
;; build result.

67
guix/import/github.scm
View file

@ -98,7 +98,9 @@ (define (updated-url url)
(updated-url source-uri))
((source-uri ...)
(find updated-url source-uri))))
((eq? fetch-method download:git-fetch)
((and (eq? fetch-method download:git-fetch)
(string-prefix? "https://github.com/"
(download:git-reference-url source-uri)))
(download:git-reference-url source-uri))
(else #f))))
@ -169,6 +171,9 @@ (define (latest-released-version url package-name)
"Return a string of the newest released version name given a string URL like
'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
the package e.g. 'bedtools2'. Return #f if there is no releases"
(define (pre-release? x)
(hash-ref x "prerelease"))
(let* ((json (fetch-releases-or-tags url)))
(if (eq? json #f)
(if (%github-token)
@ -178,40 +183,32 @@ (define (latest-released-version url package-name)
API. This may be fixed by using an access token and setting the environment
variable GUIX_GITHUB_TOKEN, for instance one procured from
https://github.com/settings/tokens"))
(let loop ((releases
(filter
(lambda (x)
;; example pre-release:
;; https://github.com/wwood/OrfM/releases/tag/v0.5.1
;; or an all-prerelease set
;; https://github.com/powertab/powertabeditor/releases
(not (hash-ref x "prerelease")))
json)))
(match releases
(() ;empty release list
#f)
((release . rest) ;one or more releases
(let ((tag (or (hash-ref release "tag_name") ;a "release"
(hash-ref release "name"))) ;a tag
(name-length (string-length package-name)))
;; some tags include the name of the package e.g. "fdupes-1.51"
;; so remove these
(if (and (< name-length (string-length tag))
(string=? (string-append package-name "-")
(substring tag 0 (+ name-length 1))))
(substring tag (+ name-length 1))
;; some tags start with a "v" e.g. "v0.25.0"
;; where some are just the version number
(if (string-prefix? "v" tag)
(substring tag 1)
;; Finally, reject tags that don't start with a digit:
;; they may not represent a release.
(if (and (not (string-null? tag))
(char-set-contains? char-set:digit
(string-ref tag 0)))
tag
(loop rest)))))))))))
(any
(lambda (release)
(let ((tag (or (hash-ref release "tag_name") ;a "release"
(hash-ref release "name"))) ;a tag
(name-length (string-length package-name)))
(cond
;; some tags include the name of the package e.g. "fdupes-1.51"
;; so remove these
((and (< name-length (string-length tag))
(string=? (string-append package-name "-")
(substring tag 0 (+ name-length 1))))
(substring tag (+ name-length 1)))
;; some tags start with a "v" e.g. "v0.25.0"
;; where some are just the version number
((string-prefix? "v" tag)
(substring tag 1))
;; Finally, reject tags that don't start with a digit:
;; they may not represent a release.
((and (not (string-null? tag))
(char-set-contains? char-set:digit
(string-ref tag 0)))
tag)
(else #f))))
(match (remove pre-release? json)
(() json) ; keep everything
(releases releases))))))
(define (latest-release pkg)
"Return an <upstream-source> for the latest release of PKG."

12
guix/inferior.scm
View file

@ -26,9 +26,9 @@ (define-module (guix inferior)
version>? version-prefix?
cache-directory))
#:use-module ((guix store)
#:select (nix-server-socket
nix-server-major-version
nix-server-minor-version
#:select (store-connection-socket
store-connection-major-version
store-connection-minor-version
store-lift))
#:use-module ((guix derivations)
#:select (read-derivation-from-file))
@ -424,8 +424,8 @@ (define (inferior-eval-with-store inferior store code)
(chmod directory #o700)
(let* ((name (string-append directory "/inferior"))
(socket (socket AF_UNIX SOCK_STREAM 0))
(major (nix-server-major-version store))
(minor (nix-server-minor-version store))
(major (store-connection-major-version store))
(minor (store-connection-minor-version store))
(proto (logior major minor)))
(bind socket AF_UNIX name)
(listen socket 1024)
@ -451,7 +451,7 @@ (define (inferior-eval-with-store inferior store code)
inferior)
(match (accept socket)
((client . address)
(proxy client (nix-server-socket store))))
(proxy client (store-connection-socket store))))
(close-port socket)
(read-inferior-response inferior)))))

20
guix/records.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -52,6 +53,22 @@ (define (report-invalid-field-specifier name bindings)
((weird _ ...) ;weird!
(syntax-violation name "invalid field specifier" #'weird)))))
(define (report-duplicate-field-specifier name ctor)
"Report the first duplicate identifier among the bindings in CTOR."
(syntax-case ctor ()
((_ bindings ...)
(let loop ((bindings #'(bindings ...))
(seen '()))
(syntax-case bindings ()
(((field value) rest ...)
(not (memq (syntax->datum #'field) seen))
(loop #'(rest ...) (cons (syntax->datum #'field) seen)))
((duplicate rest ...)
(syntax-violation name "duplicate field initializer"
#'duplicate))
(()
#t))))))
(eval-when (expand load eval)
;; The procedures below are needed both at run time and at expansion time.
@ -169,6 +186,9 @@ (define (field-value f)
#'(field (... ...)))
(wrap-field-value f (field-default-value f))))
;; Pass S to make sure source location info is preserved.
(report-duplicate-field-specifier 'name s)
(let ((fields (append fields (map car default-values))))
(cond ((lset= eq? fields '(expected ...))
#`(let* #,(field-bindings

2
guix/scripts/challenge.scm
View file

@ -109,7 +109,7 @@ (define (query-locally-built-hash item)
"Return the hash of ITEM, a store item, if ITEM was built locally.
Otherwise return #f."
(lambda (store)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(values #f store)))
(if (locally-built? store item)
(values (query-path-hash store item) store)

2
guix/scripts/graph.scm
View file

@ -299,7 +299,7 @@ (define (references* item)
information available in the local store or using information about
substitutes."
(lambda (store)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(match (substitutable-path-info store (list item))
((info)
(values (substitutable-references info) store))

4
guix/scripts/lint.scm
View file

@ -833,11 +833,11 @@ (define (check-derivation package)
(define (try system)
(catch #t
(lambda ()
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(emit-warning package
(format #f (G_ "failed to create ~a derivation: ~a")
system
(nix-protocol-error-message c))))
(store-protocol-error-message c))))
((message-condition? c)
(emit-warning package
(format #f (G_ "failed to create ~a derivation: ~a")

43
guix/scripts/offload.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@ -358,12 +358,12 @@ (define store
(format (current-error-port) "@ build-remote ~a ~a~%"
(derivation-file-name drv) (build-machine-name machine))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(format (current-error-port)
(G_ "derivation '~a' offloaded to '~a' failed: ~a~%")
(derivation-file-name drv)
(build-machine-name machine)
(nix-protocol-error-message c))
(store-protocol-error-message c))
(let* ((inferior (false-if-exception (remote-inferior session)))
(space (false-if-exception
(node-free-disk-space inferior))))
@ -712,18 +712,31 @@ (define session
(warning (G_ "failed to run 'guix repl' on machine '~a'~%")
(build-machine-name machine)))
((? inferior? inferior)
(let ((uts (inferior-eval '(uname) inferior))
(load (node-load inferior))
(free (node-free-disk-space inferior)))
(close-inferior inferior)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%"
(build-machine-name machine)
(utsname:sysname uts) (utsname:release uts)
(utsname:machine uts)
(utsname:nodename uts)
(normalized-load machine load)
(/ free (expt 2 20) 1.)))))
(let ((now (car (gettimeofday))))
(match (inferior-eval '(list (uname)
(car (gettimeofday)))
inferior)
((uts time)
(when (< time now)
;; Build machine clocks must not be behind as this
;; could cause timestamp issues.
(warning (G_ "machine '~a' is ~a seconds behind~%")
(build-machine-name machine)
(- now time)))
(let ((load (node-load inferior))
(free (node-free-disk-space inferior)))
(close-inferior inferior)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%\
time difference: ~a s~%"
(build-machine-name machine)
(utsname:sysname uts) (utsname:release uts)
(utsname:machine uts)
(utsname:nodename uts)
(normalized-load machine load)
(/ free (expt 2 20) 1.)
(- time now))))))))
(disconnect! session))
machines)))

1
guix/scripts/pull.scm
View file

@ -46,6 +46,7 @@ (define-module (guix scripts pull)
#:use-module ((gnu packages certs) #:select (le-certs))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)

19
guix/self.scm
View file

@ -36,8 +36,7 @@ (define-module (guix self)
#:export (make-config.scm
whole-package ;for internal use in 'guix pull'
compiled-guix
guix-derivation
reload-guix))
guix-derivation))
;;;
@ -613,10 +612,6 @@ (define *system-modules*
(append (file-imports source "gnu/system/examples"
(const #t))
;; Need so we get access system tests from an
;; inferior.
(file-imports source "gnu/tests" (const #t))
;; All the installer code is on the build-side.
(file-imports source "gnu/installer/"
(const #t))
@ -636,6 +631,17 @@ (define *cli-modules*
#:extensions dependencies
#:guile-for-build guile-for-build))
(define *system-test-modules*
;; Ship these modules mostly so (gnu ci) can discover them.
(scheme-node "guix-system-tests"
`((gnu tests)
,@(scheme-modules* source "gnu/tests"))
(list *core-package-modules* *package-modules*
*extra-modules* *system-modules* *core-modules*
*cli-modules*) ;for (guix scripts pack), etc.
#:extensions dependencies
#:guile-for-build guile-for-build))
(define *config*
(scheme-node "guix-config"
'()
@ -664,6 +670,7 @@ (define (built-modules node-subset)
;; comes with *CORE-MODULES*.
(list *config*
*cli-modules*
*system-test-modules*
*system-modules*
*package-modules*
*core-package-modules*

2
guix/serialization.scm
View file

@ -59,7 +59,7 @@ (define-module (guix serialization)
;; Similar to serialize.cc in Nix.
(define-condition-type &nar-error &error ; XXX: inherit from &nix-error ?
(define-condition-type &nar-error &error ; XXX: inherit from &store-error ?
nar-error?
(file nar-error-file) ; file we were restoring, or #f
(port nar-error-port)) ; port from which we read

12
guix/ssh.scm
View file

@ -180,7 +180,7 @@ (define* (connect-to-remote-daemon session
(socket-name
"/var/guix/daemon-socket/socket"))
"Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
an SSH session. Return a <nix-server> object."
an SSH session. Return a <store-connection> object."
(open-connection #:port (remote-daemon-channel session socket-name)))
@ -288,7 +288,7 @@ (define* (send-files local files remote
Return the list of store items actually sent."
;; Compute the subset of FILES missing on SESSION and send them.
(let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (nix-server-socket remote)))
(session (channel-get-session (store-connection-socket remote)))
(missing (inferior-remote-eval
`(begin
(use-modules (guix)
@ -328,24 +328,24 @@ (define* (send-files local files remote
missing)
(('protocol-error message)
(raise (condition
(&nix-protocol-error (message message) (status 42)))))
(&store-protocol-error (message message) (status 42)))))
(('error key args ...)
(raise (condition
(&nix-protocol-error
(&store-protocol-error
(message (call-with-output-string
(lambda (port)
(print-exception port #f key args))))
(status 43)))))
(_
(raise (condition
(&nix-protocol-error
(&store-protocol-error
(message "unknown error while sending files over SSH")
(status 44)))))))))
(define (remote-store-session remote)
"Return the SSH channel beneath REMOTE, a remote store as returned by
'connect-to-remote-daemon', or #f."
(channel-get-session (nix-server-socket remote)))
(channel-get-session (store-connection-socket remote)))
(define (remote-store-host remote)
"Return the name of the host REMOTE is connected to, where REMOTE is a

228
guix/store.scm
View file

@ -20,6 +20,7 @@
(define-module (guix store)
#:use-module (guix utils)
#:use-module (guix config)
#:use-module (guix deprecation)
#:use-module (guix memoization)
#:use-module (guix serialization)
#:use-module (guix monads)
@ -51,14 +52,31 @@ (define-module (guix store)
%gc-roots-directory
%default-substitute-urls
store-connection?
store-connection-version
store-connection-major-version
store-connection-minor-version
store-connection-socket
;; Deprecated forms for 'store-connection'.
nix-server?
nix-server-version
nix-server-major-version
nix-server-minor-version
nix-server-socket
current-store-protocol-version ;for internal use
mcached
&store-error store-error?
&store-connection-error store-connection-error?
store-connection-error-file
store-connection-error-code
&store-protocol-error store-protocol-error?
store-protocol-error-message
store-protocol-error-status
;; Deprecated forms for '&store-error' et al.
&nix-error nix-error?
&nix-connection-error nix-connection-error?
nix-connection-error-file
@ -335,59 +353,83 @@ (define-syntax read-arg
;; remote-store.cc
(define-record-type* <nix-server> nix-server %make-nix-server
nix-server?
(socket nix-server-socket)
(major nix-server-major-version)
(minor nix-server-minor-version)
(define-record-type* <store-connection> store-connection %make-store-connection
store-connection?
(socket store-connection-socket)
(major store-connection-major-version)
(minor store-connection-minor-version)
(buffer nix-server-output-port) ;output port
(flush nix-server-flush-output) ;thunk
(buffer store-connection-output-port) ;output port
(flush store-connection-flush-output) ;thunk
;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of
;; the session.
(ats-cache nix-server-add-to-store-cache)
(atts-cache nix-server-add-text-to-store-cache)
(object-cache nix-server-object-cache
(ats-cache store-connection-add-to-store-cache)
(atts-cache store-connection-add-text-to-store-cache)
(object-cache store-connection-object-cache
(default vlist-null))) ;vhash
(set-record-type-printer! <nix-server>
(set-record-type-printer! <store-connection>
(lambda (obj port)
(format port "#<build-daemon ~a.~a ~a>"
(nix-server-major-version obj)
(nix-server-minor-version obj)
(format port "#<store-connection ~a.~a ~a>"
(store-connection-major-version obj)
(store-connection-minor-version obj)
(number->string (object-address obj)
16))))
(define-condition-type &nix-error &error
nix-error?)
(define-deprecated/alias nix-server? store-connection?)
(define-deprecated/alias nix-server-major-version
store-connection-major-version)
(define-deprecated/alias nix-server-minor-version
store-connection-minor-version)
(define-deprecated/alias nix-server-socket store-connection-socket)
(define-condition-type &nix-connection-error &nix-error
nix-connection-error?
(file nix-connection-error-file)
(errno nix-connection-error-code))
(define-condition-type &nix-protocol-error &nix-error
nix-protocol-error?
(message nix-protocol-error-message)
(status nix-protocol-error-status))
(define-condition-type &store-error &error
store-error?)
(define-condition-type &store-connection-error &store-error
store-connection-error?
(file store-connection-error-file)
(errno store-connection-error-code))
(define-condition-type &store-protocol-error &store-error
store-protocol-error?
(message store-protocol-error-message)
(status store-protocol-error-status))
(define-deprecated/alias &nix-error &store-error)
(define-deprecated/alias nix-error? store-error?)
(define-deprecated/alias &nix-connection-error &store-connection-error)
(define-deprecated/alias nix-connection-error? store-connection-error?)
(define-deprecated/alias nix-connection-error-file
store-connection-error-file)
(define-deprecated/alias nix-connection-error-code
store-connection-error-code)
(define-deprecated/alias &nix-protocol-error &store-protocol-error)
(define-deprecated/alias nix-protocol-error? store-protocol-error?)
(define-deprecated/alias nix-protocol-error-message
store-protocol-error-message)
(define-deprecated/alias nix-protocol-error-status
store-protocol-error-status)
(define-syntax-rule (system-error-to-connection-error file exp ...)
"Catch 'system-error' exceptions and translate them to
'&nix-connection-error'."
'&store-connection-error'."
(catch 'system-error
(lambda ()
exp ...)
(lambda args
(let ((errno (system-error-errno args)))
(raise (condition (&nix-connection-error
(raise (condition (&store-connection-error
(file file)
(errno errno))))))))
(define (open-unix-domain-socket file)
"Connect to the Unix-domain socket at FILE and return it. Raise a
'&nix-connection-error' upon error."
'&store-connection-error' upon error."
(let ((s (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0)))
@ -403,7 +445,7 @@ (define %default-guix-port
(define (open-inet-socket host port)
"Connect to the Unix-domain socket at HOST:PORT and return it. Raise a
'&nix-connection-error' upon error."
'&store-connection-error' upon error."
(let ((sock (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0))))
@ -435,7 +477,7 @@ (define addresses
;; Connection failed, so try one of the other addresses.
(close s)
(if (null? rest)
(raise (condition (&nix-connection-error
(raise (condition (&store-connection-error
(file host)
(errno (system-error-errno args)))))
(loop rest))))))))))
@ -444,7 +486,7 @@ (define (connect-to-daemon uri)
"Connect to the daemon at URI, a string that may be an actual URI or a file
name."
(define (not-supported)
(raise (condition (&nix-connection-error
(raise (condition (&store-connection-error
(file uri)
(errno ENOTSUP)))))
@ -493,8 +535,8 @@ (define* (open-connection #:optional (uri (%daemon-socket-uri))
;; One of the 'write-' or 'read-' calls below failed, but this is
;; really a connection error.
(raise (condition
(&nix-connection-error (file (or port uri))
(errno EPROTO))
(&store-connection-error (file (or port uri))
(errno EPROTO))
(&message (message "build daemon handshake failed"))))))
(let*-values (((port)
(or port (connect-to-daemon uri)))
@ -515,13 +557,13 @@ (define* (open-connection #:optional (uri (%daemon-socket-uri))
(write-int cpu-affinity port)))
(when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) port))
(let ((conn (%make-nix-server port
(protocol-major v)
(protocol-minor v)
output flush
(make-hash-table 100)
(make-hash-table 100)
vlist-null)))
(let ((conn (%make-store-connection port
(protocol-major v)
(protocol-minor v)
output flush
(make-hash-table 100)
(make-hash-table 100)
vlist-null)))
(let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn)))
conn)))))))))
@ -536,27 +578,29 @@ (define* (port->connection port
connection. Use with care."
(let-values (((output flush)
(buffering-output-port port (make-bytevector 8192))))
(%make-nix-server port
(protocol-major version)
(protocol-minor version)
output flush
(make-hash-table 100)
(make-hash-table 100)
vlist-null)))
(%make-store-connection port
(protocol-major version)
(protocol-minor version)
output flush
(make-hash-table 100)
(make-hash-table 100)
vlist-null)))
(define (nix-server-version store)
(define (store-connection-version store)
"Return the protocol version of STORE as an integer."
(protocol-version (nix-server-major-version store)
(nix-server-minor-version store)))
(protocol-version (store-connection-major-version store)
(store-connection-minor-version store)))
(define-deprecated/alias nix-server-version store-connection-version)
(define (write-buffered-output server)
"Flush SERVER's output port."
(force-output (nix-server-output-port server))
((nix-server-flush-output server)))
(force-output (store-connection-output-port server))
((store-connection-flush-output server)))
(define (close-connection server)
"Close the connection to SERVER."
(close (nix-server-socket server)))
(close (store-connection-socket server)))
(define-syntax-rule (with-store store exp ...)
"Bind STORE to an open connection to the store and evaluate EXPs;
@ -566,7 +610,7 @@ (define-syntax-rule (with-store store exp ...)
(const #f)
(lambda ()
(parameterize ((current-store-protocol-version
(nix-server-version store)))
(store-connection-version store)))
exp) ...)
(lambda ()
(false-if-exception (close-connection store))))))
@ -622,7 +666,7 @@ (define* (process-stderr server #:optional user-port)
conservatively consider it to be Latin-1, thereby avoiding possible
encoding conversion errors."
(define p
(nix-server-socket server))
(store-connection-socket server))
;; magic cookies from worker-protocol.hh
(define %stderr-next #x6f6c6d67) ; "olmg", build log
@ -666,18 +710,18 @@ (define %stderr-error #x63787470) ; "cxtp", error reporting
(let ((error (read-maybe-utf8-string p))
;; Currently the daemon fails to send a status code for early
;; errors like DB schema version mismatches, so check for EOF.
(status (if (and (>= (nix-server-minor-version server) 8)
(status (if (and (>= (store-connection-minor-version server) 8)
(not (eof-object? (lookahead-u8 p))))
(read-int p)
1)))
(raise (condition (&nix-protocol-error
(raise (condition (&store-protocol-error
(message error)
(status status))))))
((= k %stderr-last)
;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
#t)
(else
(raise (condition (&nix-protocol-error
(raise (condition (&store-protocol-error
(message "invalid error code")
(status k))))))))
@ -734,7 +778,7 @@ (define* (set-build-options server
;; Must be called after `open-connection'.
(define socket
(nix-server-socket server))
(store-connection-socket server))
(let-syntax ((send (syntax-rules ()
((_ (type option) ...)
@ -744,22 +788,22 @@ (define socket
(write-int (operation-id set-options) socket)
(send (boolean keep-failed?) (boolean keep-going?)
(boolean fallback?) (integer verbosity))
(when (< (nix-server-minor-version server) #x61)
(when (< (store-connection-minor-version server) #x61)
(let ((max-build-jobs (or max-build-jobs 1))
(max-silent-time (or max-silent-time 3600)))
(send (integer max-build-jobs) (integer max-silent-time))))
(when (>= (nix-server-minor-version server) 2)
(when (>= (store-connection-minor-version server) 2)
(send (boolean use-build-hook?)))
(when (>= (nix-server-minor-version server) 4)
(when (>= (store-connection-minor-version server) 4)
(send (integer build-verbosity) (integer log-type)
(boolean print-build-trace)))
(when (and (>= (nix-server-minor-version server) 6)
(< (nix-server-minor-version server) #x61))
(when (and (>= (store-connection-minor-version server) 6)
(< (store-connection-minor-version server) #x61))
(let ((build-cores (or build-cores (current-processor-count))))
(send (integer build-cores))))
(when (>= (nix-server-minor-version server) 10)
(when (>= (store-connection-minor-version server) 10)
(send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12)
(when (>= (store-connection-minor-version server) 12)
(let ((pairs `(;; This option is honored by 'guix substitute' et al.
,@(if print-build-trace
`(("print-extended-build-trace"
@ -884,8 +928,8 @@ (define-syntax operation
((_ (name (type arg) ...) docstring return ...)
(lambda (server arg ...)
docstring
(let* ((s (nix-server-socket server))
(buffered (nix-server-output-port server)))
(let* ((s (store-connection-socket server))
(buffered (store-connection-output-port server)))
(record-operation 'name)
(write-int (operation-id name) buffered)
(write-arg type arg buffered)
@ -907,7 +951,7 @@ (define-operation (valid-path? (string path))
invalid item may exist on disk but still be invalid, for instance because it
is the result of an aborted or failed build.)
A '&nix-protocol-error' condition is raised if PATH is not prefixed by the
A '&store-protocol-error' condition is raised if PATH is not prefixed by the
store directory (/gnu/store)."
boolean)
@ -944,7 +988,7 @@ (define add-data-to-store
REFERENCES is the list of store paths referred to by the resulting store
path."
(let* ((args `(,bytes ,name ,references))
(cache (nix-server-add-text-to-store-cache server)))
(cache (store-connection-add-text-to-store-cache server)))
(or (hash-ref cache args)
(let ((path (add-text-to-store server name bytes references)))
(hash-set! cache args path)
@ -973,7 +1017,7 @@ (define add-to-store
;; We don't use the 'operation' macro so we can pass SELECT? to
;; 'write-file'.
(record-operation 'add-to-store)
(let ((port (nix-server-socket server)))
(let ((port (store-connection-socket server)))
(write-int (operation-id add-to-store) port)
(write-string basename port)
(write-int 1 port) ;obsolete, must be #t
@ -999,7 +1043,7 @@ (define add-to-store
;; Note: We don't stat FILE-NAME at each call, and thus we assume that
;; the file remains unchanged for the lifetime of SERVER.
(let* ((args `(,file-name ,basename ,recursive? ,hash-algo ,select?))
(cache (nix-server-add-to-store-cache server)))
(cache (store-connection-add-to-store-cache server)))
(or (hash-ref cache args)
(let ((path (add-to-store server basename recursive?
hash-algo file-name
@ -1078,14 +1122,14 @@ (define (directory-entries directory)
((_ 'directory (names . _) ...) names)))
(define cache
(nix-server-add-to-store-cache server))
(store-connection-add-to-store-cache server))
(or (hash-ref cache tree)
(begin
;; We don't use the 'operation' macro so we can use 'write-file-tree'
;; instead of 'write-file'.
(record-operation 'add-to-store/tree)
(let ((port (nix-server-socket server)))
(let ((port (store-connection-socket server)))
(write-int (operation-id add-to-store) port)
(write-string basename port)
(write-int 1 port) ;obsolete, must be #t
@ -1117,12 +1161,12 @@ (define build-things
that are not derivations can only be substituted and not built locally.
Return #t on success."
(parameterize ((current-store-protocol-version
(nix-server-version store)))
(if (>= (nix-server-minor-version store) 15)
(store-connection-version store)))
(if (>= (store-connection-minor-version store) 15)
(build store things mode)
(if (= mode (build-mode normal))
(build/old store things)
(raise (condition (&nix-protocol-error
(raise (condition (&store-protocol-error
(message "unsupported build mode")
(status 1))))))))))
@ -1182,12 +1226,12 @@ (define %reference-cache
(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
store at once. Raise a '&store-protocol-error' exception if reference
information for one of ITEMS is missing."
(let* ((requested items)
(local-refs (map (lambda (item)
(or (hash-ref %reference-cache item)
(guard (c ((nix-protocol-error? c) #f))
(guard (c ((store-protocol-error? c) #f))
(references store item))))
items))
(missing (fold-right (lambda (item local-ref result)
@ -1203,7 +1247,7 @@ (define (references/substitutes store items)
'()
(substitutable-path-info store missing))))
(when (< (length substs) (length missing))
(raise (condition (&nix-protocol-error
(raise (condition (&store-protocol-error
(message "cannot determine \
the list of references")
(status 1)))))
@ -1334,9 +1378,9 @@ (define built-in-builders
;; derivation builders in general, which appeared in Guix > 0.11.0.
;; Return the empty list if it doesn't. Note that this RPC does not
;; exist in 'nix-daemon'.
(if (or (> (nix-server-major-version store) #x100)
(and (= (nix-server-major-version store) #x100)
(>= (nix-server-minor-version store) #x60)))
(if (or (> (store-connection-major-version store) #x100)
(and (= (store-connection-major-version store) #x100)
(>= (store-connection-minor-version store) #x60)))
(builders store)
'()))))
@ -1366,14 +1410,14 @@ (define (run-gc server action to-delete min-freed)
#f. MIN-FREED is the minimum amount of disk space to be freed, in
bytes, before the GC can stop. Return the list of store paths delete,
and the number of bytes freed."
(let ((s (nix-server-socket server)))
(let ((s (store-connection-socket server)))
(write-int (operation-id collect-garbage) s)
(write-int action s)
(write-store-path-list to-delete s)
(write-arg boolean #f s) ; ignore-liveness?
(write-long-long min-freed s)
(write-int 0 s) ; obsolete
(when (>= (nix-server-minor-version server) 5)
(when (>= (store-connection-minor-version server) 5)
;; Obsolete `use-atime' and `max-atime' parameters.
(write-int 0 s)
(write-int 0 s))
@ -1389,8 +1433,8 @@ (define (run-gc server action to-delete min-freed)
;; To be on the safe side, completely invalidate both caches.
;; Otherwise we could end up returning store paths that are no longer
;; valid.
(hash-clear! (nix-server-add-to-store-cache server))
(hash-clear! (nix-server-add-text-to-store-cache server)))
(hash-clear! (store-connection-add-to-store-cache server))
(hash-clear! (store-connection-add-text-to-store-cache server)))
(values paths freed))))
@ -1425,7 +1469,7 @@ (define (import-paths server port)
"Import the set of store paths read from PORT into SERVER's store. An error
is raised if the set of paths read from PORT is not signed (as per
'export-path #:sign? #t'.) Return the list of store paths imported."
(let ((s (nix-server-socket server)))
(let ((s (store-connection-socket server)))
(write-int (operation-id import-paths) s)
(let loop ((done? (process-stderr server port)))
(or done? (loop (process-stderr server port))))
@ -1433,7 +1477,7 @@ (define (import-paths server port)
(define* (export-path server path port #:key (sign? #t))
"Export PATH to PORT. When SIGN? is true, sign it."
(let ((s (nix-server-socket server)))
(let ((s (store-connection-socket server)))
(write-int (operation-id export-path) s)
(write-store-path path s)
(write-arg boolean sign? s)
@ -1502,10 +1546,10 @@ (define* (cache-object-mapping object keys result)
and RESULT is typically its derivation."
(lambda (store)
(values result
(nix-server
(store-connection
(inherit store)
(object-cache (vhash-consq object (cons result keys)
(nix-server-object-cache store)))))))
(store-connection-object-cache store)))))))
(define record-cache-lookup!
(if (profiled? "object-cache")
@ -1540,7 +1584,7 @@ (define* (lookup-cached-object object #:optional (keys '()))
compared with 'equal?'. Return #f on failure and the cached result
otherwise."
(lambda (store)
(let* ((cache (nix-server-object-cache store))
(let* ((cache (store-connection-object-cache store))
;; Escape as soon as we find the result. This avoids traversing
;; the whole vlist chain and significantly reduces the number of
@ -1654,7 +1698,7 @@ (define (query-path-info* item)
"Monadic version of 'query-path-info' that returns #f when ITEM is not in
the store."
(lambda (store)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; ITEM is not in the store; return #f.
(values #f store)))
(values (query-path-info store item) store))))

2
guix/tests.scm
View file

@ -64,7 +64,7 @@ (define %test-substitute-urls
(define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
"Open a connection to the build daemon for tests purposes and return it."
(guard (c ((nix-error? c)
(guard (c ((store-error? c)
(format (current-error-port)
"warning: build daemon error: ~s~%" c)
#f))

10
guix/ui.scm
View file

@ -684,14 +684,14 @@ (define (manifest-entry-output* entry)
file (or (port-filename* port) port))
(leave (G_ "corrupt input while restoring archive from ~s~%")
(or (port-filename* port) port)))))
((nix-connection-error? c)
((store-connection-error? c)
(leave (G_ "failed to connect to `~a': ~a~%")
(nix-connection-error-file c)
(strerror (nix-connection-error-code c))))
((nix-protocol-error? c)
(store-connection-error-file c)
(strerror (store-connection-error-code c))))
((store-protocol-error? c)
;; FIXME: Server-provided error messages aren't i18n'd.
(leave (G_ "build failed: ~a~%")
(nix-protocol-error-message c)))
(store-protocol-error-message c)))
((derivation-missing-output-error? c)
(leave (G_ "reference to invalid output '~a' of derivation '~a'~%")
(derivation-missing-output c)

42
tests/derivations.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -185,9 +185,9 @@ (define prefix-len (string-length dir))
(set-build-options %store
#:use-substitutes? #f
#:keep-going? #t)
(guard (c ((nix-protocol-error? c)
(and (= 100 (nix-protocol-error-status c))
(string-contains (nix-protocol-error-message c)
(guard (c ((store-protocol-error? c)
(and (= 100 (store-protocol-error-status c))
(string-contains (store-protocol-error-message c)
(derivation-file-name d1))
(not (valid-path? %store (derivation->output-path d1)))
(valid-path? %store (derivation->output-path d2)))))
@ -222,8 +222,8 @@ (define prefix-len (string-length dir))
(test-assert "unknown built-in builder"
(let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
(guard (c ((nix-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed")))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f)))
@ -253,8 +253,8 @@ (define prefix-len (string-length dir))
. ,(object->string (%local-url))))
#:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100))))) ;wrong
(guard (c ((nix-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed")))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f))))
@ -268,8 +268,8 @@ (define prefix-len (string-length dir))
. ,(object->string (%local-url))))
#:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100)))))
(guard (c ((nix-protocol-error? c)
(string-contains (nix-protocol-error-message (pk c)) "failed")))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message (pk c)) "failed")))
(build-derivations %store (list drv))
#f))))
@ -279,8 +279,8 @@ (define prefix-len (string-length dir))
(drv (derivation %store "world"
"builtin:download" '()
#:env-vars `(("url" . ,(object->string url))))))
(guard (c ((nix-protocol-error? c)
(string-contains (nix-protocol-error-message c) "failed")))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f)))
@ -607,7 +607,7 @@ (define (deps path . deps)
`("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt))
#:allowed-references '())))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
@ -625,7 +625,7 @@ (define (deps path . deps)
`("-c" ,"echo $out > $out")
#:inputs `((,%bash))
#:allowed-references '())))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
@ -644,7 +644,7 @@ (define (deps path . deps)
`("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt))
#:disallowed-references (list txt))))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
@ -765,8 +765,8 @@ (define %coreutils
(builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "silent" builder))
(out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c)
(and (string-contains (nix-protocol-error-message c)
(guard (c ((store-protocol-error? c)
(and (string-contains (store-protocol-error-message c)
"failed")
(not (valid-path? store out-path)))))
(build-derivations store (list drv))
@ -779,8 +779,8 @@ (define %coreutils
(builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "slow" builder))
(out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c)
(and (string-contains (nix-protocol-error-message c)
(guard (c ((store-protocol-error? c)
(and (string-contains (store-protocol-error-message c)
"failed")
(not (valid-path? store out-path)))))
(build-derivations store (list drv))
@ -942,11 +942,11 @@ (define (record-substitutable-path-query store paths)
#f)) ; fail!
(drv (build-expression->derivation %store "fail" builder))
(out-path (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; Note that the output path may exist at this point, but it
;; is invalid.
(and (string-match "build .* failed"
(nix-protocol-error-message c))
(store-protocol-error-message c))
(not (valid-path? %store out-path)))))
(build-derivations %store (list drv))
#f)))

4
tests/gexp.scm
View file

@ -919,7 +919,7 @@ (define (multiply x)
(chdir #$output)
(symlink #$%bootstrap-guile "guile"))
#:allowed-references '()))))
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list drv))
#f)))
@ -943,7 +943,7 @@ (define (multiply x)
(chdir #$output)
(symlink #$%bootstrap-guile "guile"))
#:disallowed-references (list %bootstrap-guile)))))
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list drv))
#f)))

8
tests/guix-daemon.sh
View file

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@ -109,7 +109,7 @@ guile -c "
(define (build-without-failing drv)
(lambda (store)
(guard (c ((nix-protocol-error? c) (values #t store)))
(guard (c ((store-protocol-error? c) (values #t store)))
(build-derivations store (list drv))
(values #f store))))
@ -177,9 +177,9 @@ client_code='
`("-e" ,build)
#:inputs `((,bash) (,build))
#:env-vars `(("x" . ,(random-text))))))
(exit (guard (c ((nix-protocol-error? c)
(exit (guard (c ((store-protocol-error? c)
(->bool
(string-contains (pk (nix-protocol-error-message c))
(string-contains (pk (store-protocol-error-message c))
"failed"))))
(build-derivations store (list drv))
#f))))'

6
tests/guix-system.sh
View file

@ -109,7 +109,7 @@ cat > "$tmpfile" <<EOF
(timezone "Europe/Paris") ; 6
(locale "en_US.UTF-8") ; 7
(bootloader (GRUB-config (device "/dev/sdX"))) ; 9
(bootloader (GRUB-config (target "/dev/sdX"))) ; 9
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")
@ -137,7 +137,7 @@ OS_BASE='
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(device "/dev/sdX")))
(target "/dev/sdX")))
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")
@ -209,7 +209,7 @@ make_user_config ()
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(device "/dev/sdX")))
(target "/dev/sdX")))
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")

2
tests/packages.scm
View file

@ -570,7 +570,7 @@ (define read-at
(symlink %output (string-append %output "/self"))
#t)))))
(d (package-derivation %store p)))
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d))
#f)))

26
tests/records.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -288,6 +288,30 @@ (define-record-type* <foo> foo make-foo
(and (string-match "extra.*initializer.*baz" message)
(eq? proc 'foo)))))
(test-assert "define-record-type* & duplicate initializers"
(let ((exp '(begin
(define-record-type* <foo> foo make-foo
foo?
(bar foo-bar (default 42)))
(foo (bar 1)
(bar 2))))
(loc (current-source-location))) ;keep this alignment!
(catch 'syntax-error
(lambda ()
(eval exp (test-module))
#f)
(lambda (key proc message location form . args)
(and (string-match "duplicate.*initializer" message)
(eq? proc 'foo)
;; Make sure the location is that of the field specifier.
(lset= equal?
(pk 'expected-loc
`((line . ,(- (assq-ref loc 'line) 1))
,@(alist-delete 'line loc)))
(pk 'actual-loc location)))))))
(test-assert "ABI checks"
(let ((module (test-module)))
(eval '(begin

46
tests/store.scm
View file

@ -63,9 +63,9 @@ (define %shell
(test-equal "connection handshake error"
EPROTO
(let ((port (%make-void-port "rw")))
(guard (c ((nix-connection-error? c)
(and (eq? port (nix-connection-error-file c))
(nix-connection-error-code c))))
(guard (c ((store-connection-error? c)
(and (eq? port (store-connection-error-file c))
(store-connection-error-code c))))
(open-connection #f #:port port)
'broken)))
@ -120,7 +120,7 @@ (define %shell
(test-assert "valid-path? error"
(with-store s
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(valid-path? s "foo")
#f)))
@ -133,7 +133,7 @@ (define %shell
(with-store s
(let-syntax ((true-if-error (syntax-rules ()
((_ exp)
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
exp #f)))))
(and (true-if-error (valid-path? s "foo"))
(true-if-error (valid-path? s "bar"))
@ -274,7 +274,7 @@ (define %shell
(test-assert "references/substitutes missing reference info"
(with-store s
(set-build-options s #:use-substitutes? #f)
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(let* ((b (add-to-store s "bash" #t "sha256"
(search-bootstrap-binary "bash"
(%current-system))))
@ -422,7 +422,7 @@ (define (same? x y)
%store "foo" `(display ,s)
#:guile-for-build
(package-derivation s %bootstrap-guile (%current-system)))))
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d))))))))
"Here’s a Greek letter: λ."))
@ -442,7 +442,7 @@ (define (same? x y)
(display "lambda: λ\n"))
#:guile-for-build
(package-derivation %store %bootstrap-guile))))
(guard (c ((nix-protocol-error? c) #t))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d))))))))
"garbage: <20>lambda: λ"))
@ -620,12 +620,12 @@ (define (same? x y)
#:fallback? #f
#:substitute-urls (%test-substitute-urls))
(and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; XXX: the daemon writes "hash mismatch in downloaded
;; path", but the actual error returned to the client
;; doesn't mention that.
(pk 'corrupt c)
(not (zero? (nix-protocol-error-status c)))))
(not (zero? (store-protocol-error-status c)))))
(build-derivations s (list d))
#f))))))
@ -646,7 +646,7 @@ (define (same? x y)
(set-build-options s #:use-substitutes? #t
#:substitute-urls (%test-substitute-urls))
(and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
;; The substituter failed as expected. Now make
;; sure that #:fallback? #t works correctly.
(set-build-options s
@ -712,9 +712,9 @@ (define (same? x y)
(dump (call-with-bytevector-output-port
(cute export-paths %store (list file2) <>))))
(delete-paths %store (list file0 file1 file2))
(guard (c ((nix-protocol-error? c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
(guard (c ((store-protocol-error? c)
(and (not (zero? (store-protocol-error-status c)))
(string-contains (store-protocol-error-message c)
"not valid"))))
;; Here we get an exception because DUMP does not include FILE0 and
;; FILE1, which are dependencies of FILE2.
@ -816,10 +816,10 @@ (define ref-hash
(bytevector-u8-set! dump index (logxor #xff byte)))
(and (not (file-exists? file))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(pk 'c c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
(and (not (zero? (store-protocol-error-status c)))
(string-contains (store-protocol-error-message c)
"corrupt"))))
(let* ((source (open-bytevector-input-port dump))
(imported (import-paths %store source)))
@ -906,10 +906,10 @@ (define ref-hash
(begin
(write (random-text) entropy-port)
(force-output entropy-port)
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(pk 'determinism-exception c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
(and (not (zero? (store-protocol-error-status c)))
(string-contains (store-protocol-error-message c)
"deterministic"))))
;; This one will produce a different result. Since we're in
;; 'check' mode, this must fail.
@ -945,10 +945,10 @@ (define ref-hash
#:guile-for-build
(package-derivation store %bootstrap-guile (%current-system))))
(file (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c)
(guard (c ((store-protocol-error? c)
(pk 'multiple-build c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
(and (not (zero? (store-protocol-error-status c)))
(string-contains (store-protocol-error-message c)
"deterministic"))))
;; This one will produce a different result on the second run.
(current-build-output-port (current-error-port))