Merge branch 'master' into staging

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

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> <mthl@openmailbox.org>
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org> Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
Mathieu Othacehe <m.othacehe@gmail.com> Mathieu Othacehe <m.othacehe@gmail.com>
Mathieu Othacehe <mathieu.othacehe@parrot.com>
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com> Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
Nils Gillmann <ng0@n0.is> ng0 <ng0@n0.is> Nils Gillmann <ng0@n0.is> ng0 <ng0@n0.is>
Nils Gillmann <ng0@n0.is> Nils Gillmann <gillmann@infotropique.org> 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% ] [ 40% ]
Running mkfs.ext4 on /dev/sda3 ... Running mkfs.ext4 on /dev/sda3 ...
*** Add a confirmation page before formating/partitioning
** Desktop environments ** Desktop environments
*** Allow for no desktop environments *** Allow for no desktop environments
Propose to choose between "headless server" and "lightweight X11" in a new Propose to choose between "headless server" and "lightweight X11" in a new
@ -119,3 +119,6 @@ Under the form:
(UTC + 1) Europe/Paris (UTC + 1) Europe/Paris
(UTC + 2) Africa/Cairo (UTC + 2) Africa/Cairo
... ...
** Display issue
*** Investigate display issue described here:
https://lists.gnu.org/archive/html/guix-devel/2019-01/msg00305.html

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -293,9 +293,6 @@ interface (FFI) of Guile.")
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(eval-when (expand load eval) (eval-when (expand load eval)
;; Don't augment '%load-path'.
(unsetenv "GUIX_PACKAGE_PATH")
;; (gnu packages …) modules are going to be looked up ;; (gnu packages …) modules are going to be looked up
;; under SOURCE. (guix config) is looked up in FRONT. ;; under SOURCE. (guix config) is looked up in FRONT.
(match (command-line) (match (command-line)
@ -312,15 +309,11 @@ interface (FFI) of Guile.")
;; Only load Guile-Gcrypt, our own modules, or those ;; Only load Guile-Gcrypt, our own modules, or those
;; of Guile. ;; of Guile.
(match %load-compiled-path
((front _ ... sys1 sys2)
(unless (string-prefix? #$guile-gcrypt front)
(set! %load-compiled-path (set! %load-compiled-path
(list (string-append #$guile-gcrypt (cons (string-append #$guile-gcrypt "/lib/guile/"
"/lib/guile/"
(effective-version) (effective-version)
"/site-ccache") "/site-ccache")
front sys1 sys2)))))) %load-compiled-path)))
(use-modules (guix store) (use-modules (guix store)
(guix self) (guix self)
@ -372,6 +365,19 @@ interface (FFI) of Guile.")
derivation-file-name)))))) derivation-file-name))))))
#:module-path (list source)))) #: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. ;; The procedure below is our return value.
(define* (build source (define* (build source
#:key verbose? (version (date-version-string)) system #:key verbose? (version (date-version-string)) system
@ -406,6 +412,9 @@ files."
;; stdin will actually be /dev/null. ;; stdin will actually be /dev/null.
(let* ((pipe (with-input-from-port port (let* ((pipe (with-input-from-port port
(lambda () (lambda ()
;; Make sure BUILD is not influenced by
;; $GUILE_LOAD_PATH & co.
(with-clean-environment
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
(open-pipe* OPEN_READ (open-pipe* OPEN_READ
(derivation->output-path build) (derivation->output-path build)
@ -413,7 +422,7 @@ files."
(if (file-port? port) (if (file-port? port)
(number->string (number->string
(logior major minor)) (logior major minor))
"none"))))) "none"))))))
(str (get-string-all pipe)) (str (get-string-all pipe))
(status (close-pipe pipe))) (status (close-pipe pipe)))
(match str (match str

View File

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

View File

@ -23,6 +23,7 @@ choice.
* Building from Git:: The latest and greatest. * Building from Git:: The latest and greatest.
* Running Guix Before It Is Installed:: Hacker tricks. * Running Guix Before It Is Installed:: Hacker tricks.
* The Perfect Setup:: The right tools. * The Perfect Setup:: The right tools.
* Packaging Guidelines:: Growing the distribution.
* Coding Style:: Hygiene of the contributor. * Coding Style:: Hygiene of the contributor.
* Submitting Patches:: Share your work. * Submitting Patches:: Share your work.
@end menu @end menu
@ -223,6 +224,455 @@ trigger string @code{origin...}, which can be expanded further. The
@code{...}, which also can be expanded further. @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 @node Coding Style
@section Coding Style @section Coding Style

File diff suppressed because it is too large Load Diff

View File

@ -250,7 +250,11 @@ system.")
"." system)))) "." system))))
(cons name (test->thunk test)))) (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 ;; Override the value of 'current-guix' used by system tests. Using a
;; channel instance makes tests that rely on 'current-guix' less ;; channel instance makes tests that rely on 'current-guix' less
;; expensive. It also makes sure we get a valid Guix package when this ;; expensive. It also makes sure we get a valid Guix package when this

View File

@ -13,7 +13,7 @@
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -975,7 +975,7 @@ with the Linux kernel.")
(("/bin/pwd") "pwd")) (("/bin/pwd") "pwd"))
#t)))))))) #t))))))))
(define-public glibc-locales (define-public (make-glibc-locales glibc)
(package (package
(inherit glibc) (inherit glibc)
(name "glibc-locales") (name "glibc-locales")
@ -1010,7 +1010,7 @@ the 'share/locale' sub-directory of this package.")
,(version-major+minor ,(version-major+minor
(package-version glibc))))))))))) (package-version glibc)))))))))))
(define-public glibc-utf8-locales (define-public (make-glibc-utf8-locales glibc)
(package (package
(name "glibc-utf8-locales") (name "glibc-utf8-locales")
(version (package-version glibc)) (version (package-version glibc))
@ -1060,6 +1060,18 @@ test environments.")
(home-page (package-home-page glibc)) (home-page (package-home-page glibc))
(license (package-license 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 (define-public which
(package (package
(name "which") (name "which")

View File

@ -41,12 +41,15 @@
(version "0.4.37") (version "0.4.37")
(source (origin (source (origin
(method url-fetch) (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/" (uri (string-append "https://mediaarea.net/download/source/"
name "/" version "/" name "/" version "/"
name "_" version ".tar.bz2")) name "_" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1hcsrmn85b0xp0mp33aazk7g071q1v3f163nnhv8b0mv9c4bgsfn")))) "1dkqbgabzpa6bd7dkqrvd35sdxrhr6qxalb88f3dw0afk65xqb0k"))))
(native-inputs (native-inputs
`(("autoconf" ,autoconf) `(("autoconf" ,autoconf)
("automake" ,automake) ("automake" ,automake)
@ -58,10 +61,8 @@
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'pre-configure (add-after 'unpack 'pre-configure
(lambda _ (lambda _
(chdir "Project/GNU/Library"))) (chdir "Project/GNU/Library")
(add-after 'pre-configure 'autogen #t)))))
(lambda _
(zero? (system* "sh" "autogen.sh")))))))
(home-page "https://github.com/MediaArea/ZenLib") (home-page "https://github.com/MediaArea/ZenLib")
(synopsis "C++ utility library") (synopsis "C++ utility library")
(description "ZenLib is a C++ utility library. It includes classes for handling (description "ZenLib is a C++ utility library. It includes classes for handling

View File

@ -178,6 +178,10 @@
(pyqt (assoc-ref inputs "python2-pyqt"))) (pyqt (assoc-ref inputs "python2-pyqt")))
(substitute* "setup/build_environment.py" (substitute* "setup/build_environment.py"
(("sys.prefix") (string-append "'" pyqt "'"))) (("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_INC_DIR" (string-append podofo "/include/podofo"))
(setenv "PODOFO_LIB_DIR" (string-append podofo "/lib")) (setenv "PODOFO_LIB_DIR" (string-append podofo "/lib"))
#t))) #t)))

View File

@ -31,7 +31,7 @@
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Mike Gerwitz <mtg@gnu.org> ;;; 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 Sohom Bhattacharjee <soham.bhattacharjee15@gmail.com>
;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
@ -6906,18 +6906,22 @@ Emacs.")
;; Tests for ert-runner have a circular dependency with ecukes, and therefore ;; Tests for ert-runner have a circular dependency with ecukes, and therefore
;; cannot be run ;; cannot be run
(define-public emacs-ert-runner (define-public emacs-ert-runner
(let ((version "0.7.0")
(revision "1")
(commit "90b8fdd5970ef76a4649be60003b37f82cdc1a65"))
(package (package
(name "emacs-ert-runner") (name "emacs-ert-runner")
(version "0.7.0") (version (git-version "0.7.0" revision commit))
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://github.com/rejeep/ert-runner.el/archive/v" (uri (git-reference
version ".tar.gz")) (url "https://github.com/rejeep/ert-runner.el.git")
(file-name (string-append name "-" version ".tar.gz")) (commit commit)))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1657nck9i96a4xgl8crfqq0s8gflzp21pkkzwg6m3z5npjxklgwp")))) "04nxmyzncacj2wmzd84vv9wkkr2dk9lcb10dvygqmg3p1gadnwzz"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(inputs (inputs
`(("emacs-ansi" ,emacs-ansi) `(("emacs-ansi" ,emacs-ansi)
@ -6948,7 +6952,7 @@ Emacs.")
(description "@code{ert-runner} is a tool for Emacs projects tested (description "@code{ert-runner} is a tool for Emacs projects tested
using ERT. It assumes a certain test structure setup and can therefore make using ERT. It assumes a certain test structure setup and can therefore make
running tests easier.") running tests easier.")
(license license:gpl3+))) (license license:gpl3+))))
(define-public ert-runner (define-public ert-runner
(deprecated-package "ert-runner" emacs-ert-runner)) (deprecated-package "ert-runner" emacs-ert-runner))
@ -12867,3 +12871,27 @@ DBI, and provides DB-accessing API and the simple management UI.")
(description "This package is a convenience wrapper for @command{edbi} (description "This package is a convenience wrapper for @command{edbi}
to open SQLite databases.") to open SQLite databases.")
(license license:gpl3+)))) (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+)))

View File

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

View File

@ -1418,6 +1418,8 @@ interface or via an external visual interface such as GNU XBoard.")
("sdl-gfx" ,sdl-gfx) ("sdl-gfx" ,sdl-gfx)
("fontconfig" ,fontconfig) ("fontconfig" ,fontconfig)
("check" ,check))) ("check" ,check)))
(properties '((ftp-directory . "/freedink")
(upstream-name . "freedink")))
(home-page "https://www.gnu.org/software/freedink/") (home-page "https://www.gnu.org/software/freedink/")
(synopsis "Twisted adventures of young pig farmer Dink Smallwood") (synopsis "Twisted adventures of young pig farmer Dink Smallwood")
(description (description
@ -1430,14 +1432,14 @@ To that extent, it also includes a front-end for managing all of your D-Mods.")
(define freedink-data (define freedink-data
(package (package
(name "freedink-data") (name "freedink-data")
(version "1.08.20170401") (version "1.08.20190120")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/freedink/freedink-data-" (uri (string-append "mirror://gnu/freedink/freedink-data-"
version ".tar.xz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1zx7qywibhznj7bnz217404scr8dfh0xj24xjihnda5iapzz7lz8")))) "17gvryadlxk172mblbsil7hina1z5wahwaxnr6g3mdq57dvl8pvi"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -1445,6 +1447,7 @@ To that extent, it also includes a front-end for managing all of your D-Mods.")
(delete 'configure) ; no configure script (delete 'configure) ; no configure script
(delete 'check)) ; no tests (delete 'check)) ; no tests
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))))) #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(properties '((ftp-directory . "/freedink")))
(home-page "https://www.gnu.org/software/freedink/") (home-page "https://www.gnu.org/software/freedink/")
(synopsis "Game data for GNU Freedink") (synopsis "Game data for GNU Freedink")
(description (description
@ -1468,6 +1471,8 @@ To that extent, it also includes a front-end for managing all of your D-Mods.")
(inputs (inputs
`(("bzip2" ,bzip2) `(("bzip2" ,bzip2)
("wxwidgets" ,wxwidgets))) ("wxwidgets" ,wxwidgets)))
(properties '((ftp-directory . "/freedink")
(upstream-name . "dfarc")))
(home-page "https://www.gnu.org/software/freedink/") (home-page "https://www.gnu.org/software/freedink/")
(synopsis "Front-end for managing and playing Dink Modules") (synopsis "Front-end for managing and playing Dink Modules")
(description "DFArc makes it easy to play and manage the GNU FreeDink game (description "DFArc makes it easy to play and manage the GNU FreeDink game
@ -5453,6 +5458,9 @@ Strife, Chex Quest, and fan-created games like Harmony, Hacx and Freedoom.")
(string-append "fortune-mod/cmake/" (string-append "fortune-mod/cmake/"
(strip-store-file-name cmake-rules))) (strip-store-file-name cmake-rules)))
(chdir "fortune-mod") (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))) #t)))
(add-after 'install 'fix-install-directory (add-after 'install 'fix-install-directory
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)

View File

@ -1672,7 +1672,7 @@ is no support for parsing block and inline level HTML.")
(define-public guile-bytestructures (define-public guile-bytestructures
(package (package
(name "guile-bytestructures") (name "guile-bytestructures")
(version "1.0.3") (version "1.0.5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/TaylanUB/scheme-bytestructures" (uri (string-append "https://github.com/TaylanUB/scheme-bytestructures"
@ -1680,7 +1680,7 @@ is no support for parsing block and inline level HTML.")
"/bytestructures-" version ".tar.gz")) "/bytestructures-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0xf6s8gd3656j8k2ar6y7i62r68azawyzxhsagsk8nvldnrs1r18")))) "0ibk7fjwpb450lnrva4bx45sgln3pbyb645az4ansvh1spgani43"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))

View File

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

View File

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; 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 © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; 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 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015, 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
@ -413,8 +413,8 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
It has been modified to remove all non-free binary blobs.") It has been modified to remove all non-free binary blobs.")
(license license:gpl2))) (license license:gpl2)))
(define %linux-libre-version "4.20.3") (define %linux-libre-version "4.20.4")
(define %linux-libre-hash "0mk996fb4bd9548xnv2as4lxm3gyj1kvn6ra03xxpb0wf8cqdazz") (define %linux-libre-hash "1p7ixkqvnr0mzyivyby8hfix44np7w1nvyxghz8wa1h2nhsszvzv")
(define %linux-libre-4.20-patches (define %linux-libre-4.20-patches
(list %boot-logo-patch (list %boot-logo-patch
@ -427,8 +427,8 @@ It has been modified to remove all non-free binary blobs.")
#:patches %linux-libre-4.20-patches #:patches %linux-libre-4.20-patches
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define %linux-libre-4.19-version "4.19.16") (define %linux-libre-4.19-version "4.19.17")
(define %linux-libre-4.19-hash "1dpfllfzksrr6iqhvbh2905gkvycsv5zcmgq6wmwqiry1swzdfyk") (define %linux-libre-4.19-hash "0friqd9wyhddjli4m41wd994ygnwng40a95ry14478rkadfv7iwh")
(define %linux-libre-4.19-patches (define %linux-libre-4.19-patches
(list %boot-logo-patch (list %boot-logo-patch
@ -5039,3 +5039,88 @@ file systems.")
;; The library "libhandle" and the headers in "xfslibs-dev" are ;; The library "libhandle" and the headers in "xfslibs-dev" are
;; licensed under lgpl2.1. the other stuff is licensed under gpl2. ;; licensed under lgpl2.1. the other stuff is licensed under gpl2.
(license (list license:gpl2 license:lgpl2.1)))) (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+)))

View File

@ -553,14 +553,14 @@ simultaneously and therefore appear under the same nickname on IRC.")
(define-public python-nbxmpp (define-public python-nbxmpp
(package (package
(name "python-nbxmpp") (name "python-nbxmpp")
(version "0.6.8") (version "0.6.9")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "nbxmpp" version)) (uri (pypi-uri "nbxmpp" version))
(sha256 (sha256
(base32 (base32
"1iip8ijxp86fx4bl1h67p2lp02p2zm1ga2p3q43nv30smj54nawc")))) "03f8dk4kb7ya0pg7v0a0kqms4c7f2bqan5wl4ig0mcwpdmppj3b6"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:tests? #f)) ; no tests `(#:tests? #f)) ; no tests
@ -578,7 +578,7 @@ was initially a fork of xmpppy, but uses non-blocking sockets.")
(define-public gajim (define-public gajim
(package (package
(name "gajim") (name "gajim")
(version "1.1.1") (version "1.1.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gajim.org/downloads/" (uri (string-append "https://gajim.org/downloads/"
@ -586,7 +586,7 @@ was initially a fork of xmpppy, but uses non-blocking sockets.")
"/gajim-" version ".tar.bz2")) "/gajim-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"09n4445hclqwfnk2h9cxvsxaixza4cpgb5rp4najdfc2jgg2msb3")))) "1lx03cgi58z54xb7mhs6bc715lc00w5mpysf9n3q8zgn759fm0rj"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:phases `(#:phases

View File

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

View File

@ -43,7 +43,6 @@
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages dbm) #:use-module (gnu packages dbm)
#:use-module (gnu packages docbook) #:use-module (gnu packages docbook)
#:use-module (gnu packages emacs-xyz)
#:use-module (gnu packages file) #:use-module (gnu packages file)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
@ -76,7 +75,6 @@
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (guix build-system emacs)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system meson) #:use-module (guix build-system meson)
#:use-module (guix build-system python) #:use-module (guix build-system python)
@ -460,30 +458,6 @@ store, usually the directory /nix/store, where each package has its own unique
sub-directory.") sub-directory.")
(license license:lgpl2.1+))) (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 (define-public stow
(package (package
(name "stow") (name "stow")

View File

@ -1067,26 +1067,45 @@ presentation. The input files processed by pdfpc are PDF documents.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public paps (define-public paps
(let ((commit "37e6ca1cd96d751bbbff5539d795c90d657289a5")
(revision "1"))
(package (package
(name "paps") (name "paps")
(version "0.6.8") ;; The last release was in 2015, but since then there have been security
;; bug fixes.
(version (git-version "0.7.0" revision commit))
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "mirror://sourceforge/paps/paps/" version "/" (uri (git-reference
"paps-" version ".tar.gz")) (url "https://github.com/dov/paps.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"080ahnyvq918m8ahq8bg9qvgzlv4k0jgcsdqhrwjzppclx74q8fv")))) "1ilcyjqdynxsd2p8dnn8h4592dwf531x9pbkxa1w09hkcdn7hgwc"))))
(build-system gnu-build-system) (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 (inputs
`(("pango" ,pango))) `(("pango" ,pango)))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("autoconf" ,autoconf)
(home-page "http://paps.sourceforge.net/") ("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") (synopsis "Pango to PostScript converter")
(description (description
"Paps reads a UTF-8 encoded file and generates a PostScript language "Paps reads a UTF-8 encoded file and generates a PostScript language
rendering of the file. The rendering is done by creating outline curves rendering of the file. The rendering is done by creating outline curves
through the Pango @code{ft2} backend.") through the Pango @code{ft2} backend.")
(license license:lgpl2.0+))) (license license:lgpl2.0+))))

View File

@ -788,6 +788,28 @@ set_relative_time, set_absolute_time or set_fixed_time to alter future calls
to gmtime,time or localtime.") to gmtime,time or localtime.")
(license perl-license))) (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 (define-public perl-test-most
(package (package
(name "perl-test-most") (name "perl-test-most")

View File

@ -3431,7 +3431,7 @@ provide a quick dropin when such functionality is needed.")
(define-public perl-file-homedir (define-public perl-file-homedir
(package (package
(name "perl-file-homedir") (name "perl-file-homedir")
(version "1.002") (version "1.004")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -3439,7 +3439,7 @@ provide a quick dropin when such functionality is needed.")
"File-HomeDir-" version ".tar.gz")) "File-HomeDir-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0x62hn8rc7ninf9nlp69h61yh21g4cbq2g81sh64cf2ify2hqk7b")))) "1bciyzwv7gwsnaykqz0czj6mlbkkg4hg1s40s1q7j2p6nlmpxxj5"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-file-which" ,perl-file-which))) `(("perl-file-which" ,perl-file-which)))
@ -3559,7 +3559,7 @@ the input record separator string on a per file basis.")
(define-public perl-file-remove (define-public perl-file-remove
(package (package
(name "perl-file-remove") (name "perl-file-remove")
(version "1.57") (version "1.58")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -3567,14 +3567,16 @@ the input record separator string on a per file basis.")
"File-Remove-" version ".tar.gz")) "File-Remove-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1b814lw181kkqh6c1n4p2zlzzsq6ic5pfpr831nphf2w2rhcvgmk")))) "1n6h5w3sp2bs4cfrifdx2z15cfpb4r536179mx1a12xbmj1yrxl1"))))
(build-system perl-build-system) (build-system perl-build-system)
(native-inputs
`(("perl-module-build" ,perl-module-build)))
(home-page "https://metacpan.org/release/File-Remove") (home-page "https://metacpan.org/release/File-Remove")
(synopsis "Remove files and directories in Perl") (synopsis "Remove files and directories in Perl")
(description "File::Remove::remove removes files and directories. It acts (description "@code{File::Remove::remove} removes files and directories.
like /bin/rm, for the most part. Although \"unlink\" can be given a list of It acts like @code{/bin/rm}, for the most part. Although @code{unlink} can be
files, it will not remove directories; this module remedies that. It also given a list of files, it will not remove directories; this module remedies
accepts wildcards, * and ?, as arguments for file names.") that. It also accepts wildcards, * and ?, as arguments for file names.")
(license (package-license perl)))) (license (package-license perl))))
(define-public perl-file-sharedir (define-public perl-file-sharedir
@ -3648,15 +3650,15 @@ allows you to locate these files after installation.")
(define-public perl-file-slurp (define-public perl-file-slurp
(package (package
(name "perl-file-slurp") (name "perl-file-slurp")
(version "9999.19") (version "9999.25")
(source (source
(origin (origin
(method url-fetch) (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")) "File-Slurp-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0hrn4nipwx40d6ji8ssgr5nw986z9iqq8cn0kdpbszh9jplynaff")))) "1hg3bhf5m78d77p4174cnldd75ppyrvr5rkc8w289ihvwsx9gsn7"))))
(build-system perl-build-system) (build-system perl-build-system)
(home-page "https://metacpan.org/release/File-Slurp") (home-page "https://metacpan.org/release/File-Slurp")
(synopsis "Reading/Writing/Modifying of complete files") (synopsis "Reading/Writing/Modifying of complete files")
@ -3732,14 +3734,14 @@ a safe way.")
(define-public perl-file-which (define-public perl-file-which
(package (package
(name "perl-file-which") (name "perl-file-which")
(version "1.09") (version "1.23")
(source (origin (source (origin
(method url-fetch) (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")) "File-Which-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1hxjyh9yrv32f3g8vrnr8iylzprajsac14vjm75kf1qnj1jyqbxp")))) "0y70qh5kn2hyrrvbsfhg0iws2qggk5vkpz37f7rbd5rd9cjc57dp"))))
(build-system perl-build-system) (build-system perl-build-system)
(native-inputs `(("test-script" ,perl-test-script))) (native-inputs `(("test-script" ,perl-test-script)))
(synopsis "Portable implementation of the `which' utility") (synopsis "Portable implementation of the `which' utility")
@ -3747,7 +3749,7 @@ a safe way.")
"File::Which was created to be able to get the paths to executable "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 programs on systems under which the `which' program wasn't implemented in the
shell.") shell.")
(home-page "https://metacpan.org/release/ADAMK/File-Which-1.09") (home-page "https://metacpan.org/release/File-Which")
(license (package-license perl)))) (license (package-license perl))))
(define-public perl-file-zglob (define-public perl-file-zglob
@ -4361,15 +4363,15 @@ commands.")
(define-public perl-json (define-public perl-json
(package (package
(name "perl-json") (name "perl-json")
(version "2.90") (version "4.01")
(source (source
(origin (origin
(method url-fetch) (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")) "JSON-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"127yppvr17qik9pkd1vy901hs4l13kg6rhp76jdgcyask35v7nsd")))) "1vdiw095g5rf51q8d0ipf8020jx371pma0k4sxp0wlfl76lr65b3"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-json-xs" ,perl-json-xs))) ;recommended `(("perl-json-xs" ,perl-json-xs))) ;recommended
@ -4436,7 +4438,7 @@ either uses the first module it finds or throws an error.")
(define-public perl-json-xs (define-public perl-json-xs
(package (package
(name "perl-json-xs") (name "perl-json-xs")
(version "3.01") (version "4.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -4444,8 +4446,10 @@ either uses the first module it finds or throws an error.")
"JSON-XS-" version ".tar.gz")) "JSON-XS-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1aviik480m61ykwvyix83grywzbk828wvfz19hqfvaasd8jz73af")))) "0118yrzagwlcfj5yldn3h23zzqs2rx282jlm068nf7fjlvy4m7s7"))))
(build-system perl-build-system) (build-system perl-build-system)
(native-inputs
`(("perl-canary-stability" ,perl-canary-stability)))
(propagated-inputs (propagated-inputs
`(("perl-common-sense" ,perl-common-sense) `(("perl-common-sense" ,perl-common-sense)
("perl-types-serialiser" ,perl-types-serialiser))) ("perl-types-serialiser" ,perl-types-serialiser)))
@ -5299,7 +5303,7 @@ from Moose::Conflicts and moose-outdated.")
(define-public perl-module-scandeps (define-public perl-module-scandeps
(package (package
(name "perl-module-scandeps") (name "perl-module-scandeps")
(version "1.25") (version "1.27")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -5307,7 +5311,7 @@ from Moose::Conflicts and moose-outdated.")
"Module-ScanDeps-" version ".tar.gz")) "Module-ScanDeps-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"13280nq0d6zc58mcz3kvs2m85a741czq0fabk69ks1nr4j1w2nl4")))) "0j6r9r99x5p0i6fv06i44wpsvjxj32amjkiqf6pmqpj80jff2k7f"))))
(build-system perl-build-system) (build-system perl-build-system)
(native-inputs (native-inputs
`(("perl-test-requires" ,perl-test-requires))) `(("perl-test-requires" ,perl-test-requires)))
@ -8389,7 +8393,7 @@ algorism to indicate multiplication by 1000.")
(define-public perl-text-template (define-public perl-text-template
(package (package
(name "perl-text-template") (name "perl-text-template")
(version "1.47") (version "1.54")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -8399,8 +8403,11 @@ algorism to indicate multiplication by 1000.")
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1z781cgz7wbn80lf3kqr2ad0pg6g1wlnim0822h8liw28k3l5msh")))) "0s56jgak9ccbbbybf5v8hvvhyplbfhzl6p6v1751inly80rlj1kv"))))
(build-system perl-build-system) (build-system perl-build-system)
(native-inputs
`(("perl-test-more-utf8" ,perl-test-more-utf8)
("perl-test-warnings" ,perl-test-warnings)))
(home-page (home-page
"https://metacpan.org/release/Text-Template") "https://metacpan.org/release/Text-Template")
(synopsis (synopsis

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr> ;;; 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 © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym+a@scratchpost.org> ;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym+a@scratchpost.org>
;;; Copyright © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
@ -1218,14 +1218,14 @@ verification of the SSL peer.")
(define-public python-websocket-client (define-public python-websocket-client
(package (package
(name "python-websocket-client") (name "python-websocket-client")
(version "0.37.0") (version "0.54.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "websocket_client" version)) (uri (pypi-uri "websocket_client" version))
(sha256 (sha256
(base32 (base32
"0h9glp1jll3z76ly3kg08aqgxqk0a68p4zi9yn50353bh5nj92v7")))) "0j88zmikaypf38lvpkf4aaxrjp9j07dmy5ghj7kli0fv3p4n45g5"))))
(build-system python-build-system) (build-system python-build-system)
(propagated-inputs (propagated-inputs
`(("python-six" ,python-six))) `(("python-six" ,python-six)))
@ -1233,10 +1233,18 @@ verification of the SSL peer.")
(synopsis "WebSocket client for Python") (synopsis "WebSocket client for Python")
(description "The Websocket-client module provides the low level APIs for (description "The Websocket-client module provides the low level APIs for
WebSocket usage in Python programs.") WebSocket usage in Python programs.")
(properties `((python2-variant . ,(delay python2-websocket-client))))
(license license:lgpl2.1+))) (license license:lgpl2.1+)))
(define-public python2-websocket-client (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 (define-public python-requests
(package (package

View File

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

View File

@ -15,7 +15,7 @@
;;; Copyright © 2016, 2018, 2019 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016, 2018, 2019 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Feng Shu <tumashu@163.com> ;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017, 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 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com> ;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
@ -905,7 +905,7 @@ videoformats depend on the configuration flags of ffmpeg.")
(define-public vlc (define-public vlc
(package (package
(name "vlc") (name "vlc")
(version "3.0.5") (version "3.0.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -914,7 +914,7 @@ videoformats depend on the configuration flags of ffmpeg.")
"/vlc-" version ".tar.xz")) "/vlc-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1nvj00khy08sing0mdnw6virmiq579mrk5rvpx9710nlxggqgh7m")))) "1lvyyahv6g9zv7m5g5qinyrwmw47zdsd5ysimb862j7kw15nvh8q"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("flex" ,flex) `(("flex" ,flex)
@ -2667,15 +2667,18 @@ MPEG-2, MPEG-4, DVD (VOB)...
(define-public mediainfo (define-public mediainfo
(package (package
(name "mediainfo") (name "mediainfo")
(version "0.7.95") (version "18.12")
(source (origin (source (origin
(method url-fetch) (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/" (uri (string-append "https://mediaarea.net/download/source/"
name "/" version "/" name "/" version "/"
name "_" version ".tar.bz2")) name "_" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0dy51a3i79jppmg1gi4f6h7jx4hcgnkmfim4d7d3gmnlbkjh8anv")))) "1ix95ilcjlawcq6phh25cgplm3riqa2ii7ql82g8yagqs4ldqp6a"))))
(native-inputs (native-inputs
`(("autoconf" ,autoconf) `(("autoconf" ,autoconf)
("automake" ,automake) ("automake" ,automake)
@ -2693,10 +2696,7 @@ MPEG-2, MPEG-4, DVD (VOB)...
(add-after 'unpack 'change-to-build-dir (add-after 'unpack 'change-to-build-dir
(lambda _ (lambda _
(chdir "Project/GNU/CLI") (chdir "Project/GNU/CLI")
#t)) #t)))))
(add-after 'change-to-build-dir 'autogen
(lambda _
(invoke "sh" "autogen.sh"))))))
(home-page "https://mediaarea.net/en/MediaInfo") (home-page "https://mediaarea.net/en/MediaInfo")
(synopsis "Utility for reading media metadata") (synopsis "Utility for reading media metadata")
(description "MediaInfo is a utility used for retrieving technical (description "MediaInfo is a utility used for retrieving technical

View File

@ -6,7 +6,7 @@
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com> ;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017 Andy Patterson <ajpatter@uwaterloo.ca> ;;; Copyright © 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2017, 2018 Rutger Helling <rhelling@mykolab.com> ;;; 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 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
@ -30,17 +30,22 @@
(define-module (gnu packages virtualization) (define-module (gnu packages virtualization)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages assembly)
#:use-module (gnu packages attr) #:use-module (gnu packages attr)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages cmake)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl) #:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages disk) #:use-module (gnu packages disk)
#:use-module (gnu packages dns) #:use-module (gnu packages dns)
#:use-module (gnu packages docbook) #:use-module (gnu packages docbook)
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages figlet)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
@ -72,6 +77,7 @@
#:use-module (gnu packages textutils) #:use-module (gnu packages textutils)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages wget)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
@ -896,7 +902,7 @@ Open Container Initiative specification.")
(define-public umoci (define-public umoci
(package (package
(name "umoci") (name "umoci")
(version "0.4.2") (version "0.4.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -905,7 +911,7 @@ Open Container Initiative specification.")
(file-name (string-append "umoci-" version ".tar.xz")) (file-name (string-append "umoci-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1rq5jxcss9cmy05x9b2kh9ld57ribi8hgnx2w67jpmf343b83m4q")))) "1hy3gcs8z25153qpw4rk2lispfaf2c90hv1q64xwyjxn22j9ayy9"))))
(build-system go-build-system) (build-system go-build-system)
(arguments (arguments
'(#:import-path "github.com/openSUSE/umoci" '(#:import-path "github.com/openSUSE/umoci"
@ -1103,3 +1109,206 @@ x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
Bochs can run most Operating Systems inside the emulation including Linux, Bochs can run most Operating Systems inside the emulation including Linux,
DOS or Microsoft Windows.") DOS or Microsoft Windows.")
(license license:lgpl2.0+))) (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"))))

View File

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

View File

@ -14,7 +14,7 @@
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com> ;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> ;;; 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 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net> ;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net>
@ -2236,7 +2236,7 @@ X server: 'handhelds', 'redglass' and 'whiteglass'.")
(define-public xcursorgen (define-public xcursorgen
(package (package
(name "xcursorgen") (name "xcursorgen")
(version "1.0.6") (version "1.0.7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -2246,7 +2246,7 @@ X server: 'handhelds', 'redglass' and 'whiteglass'.")
".tar.bz2")) ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0v7nncj3kaa8c0524j7ricdf4rvld5i7c3m6fj55l5zbah7r3j1i")))) "0ggbv084cavp52hjgcz3vdj0g018axs0m23c03lpc5sgn92gidim"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("libxcursor" ,libxcursor) `(("libxcursor" ,libxcursor)

View File

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

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -430,7 +430,6 @@ reboot\n")
(type "ext4")) (type "ext4"))
(file-system (file-system
(device "none") (device "none")
(type "tmpfs")
(mount-point "/home") (mount-point "/home")
(type "tmpfs")) (type "tmpfs"))
%base-file-systems)) %base-file-systems))

View File

@ -97,8 +97,7 @@
(report-load file total completed) (report-load file total completed)
(format debug-port "~%loading '~a'...~%" file) (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))))))) (loop files (+ 1 completed)))))))
@ -158,7 +157,6 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
;; Exit as soon as something goes wrong. ;; Exit as soon as something goes wrong.
(exit-on-exception (exit-on-exception
(with-fluids ((*current-warning-prefix* ""))
(with-target host (with-target host
(lambda () (lambda ()
(let ((relative (relative-file source-directory file))) (let ((relative (relative-file source-directory file)))
@ -166,12 +164,14 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
#:output-file (string-append build-directory "/" #:output-file (string-append build-directory "/"
(scm->go relative)) (scm->go relative))
#:opts (append warning-options #:opts (append warning-options
(optimization-options relative)))))))) (optimization-options relative)))))))
(with-mutex progress-lock (with-mutex progress-lock
(set! completed (+ 1 completed)))) (set! completed (+ 1 completed))))
(with-augmented-search-path %load-path source-directory (with-augmented-search-path %load-path source-directory
(with-augmented-search-path %load-compiled-path build-directory (with-augmented-search-path %load-compiled-path build-directory
(with-fluids ((*current-warning-prefix* ""))
;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
;; of FILES. ;; of FILES.
(load-files source-directory files (load-files source-directory files
@ -188,7 +188,7 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
(n-par-for-each (min workers 8) build files) (n-par-for-each (min workers 8) build files)
(unless (zero? total) (unless (zero? total)
(report-compilation #f total total))))) (report-compilation #f total total))))))
(eval-when (eval load) (eval-when (eval load)
(when (and (string=? "2" (major-version)) (when (and (string=? "2" (major-version))

View File

@ -20,7 +20,7 @@
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (define-deprecated #:export (define-deprecated
without-deprecation-warnings define-deprecated/alias
deprecation-warning-port)) deprecation-warning-port))
;;; Commentary: ;;; Commentary:
@ -33,7 +33,7 @@
(define deprecation-warning-port (define deprecation-warning-port
;; Port where deprecation warnings go. ;; Port where deprecation warnings go.
(make-parameter (current-warning-port))) (make-parameter (current-error-port)))
(define (source-properties->location-string properties) (define (source-properties->location-string properties)
"Return a human-friendly, GNU-standard representation of PROPERTIES, a "Return a human-friendly, GNU-standard representation of PROPERTIES, a
@ -87,3 +87,23 @@ This will write a deprecation warning to DEPRECATION-WARNING-PORT."
(id (id
(identifier? #'id) (identifier? #'id)
#'real)))))))))) #'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)))))

View File

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

View File

@ -189,7 +189,7 @@ available."
items))) items)))
(define (references* 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 ;; As a last resort, build DRV and query the references of the
;; build result. ;; build result.

View File

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

View File

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

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -52,6 +53,22 @@
((weird _ ...) ;weird! ((weird _ ...) ;weird!
(syntax-violation name "invalid field specifier" #'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) (eval-when (expand load eval)
;; The procedures below are needed both at run time and at expansion time. ;; The procedures below are needed both at run time and at expansion time.
@ -169,6 +186,9 @@ of TYPE matches the expansion-time ABI."
#'(field (... ...))) #'(field (... ...)))
(wrap-field-value f (field-default-value f)))) (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)))) (let ((fields (append fields (map car default-values))))
(cond ((lset= eq? fields '(expected ...)) (cond ((lset= eq? fields '(expected ...))
#`(let* #,(field-bindings #`(let* #,(field-bindings

View File

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

View File

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

View File

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

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -358,12 +358,12 @@ MACHINE."
(format (current-error-port) "@ build-remote ~a ~a~%" (format (current-error-port) "@ build-remote ~a ~a~%"
(derivation-file-name drv) (build-machine-name machine)) (derivation-file-name drv) (build-machine-name machine))
(guard (c ((nix-protocol-error? c) (guard (c ((store-protocol-error? c)
(format (current-error-port) (format (current-error-port)
(G_ "derivation '~a' offloaded to '~a' failed: ~a~%") (G_ "derivation '~a' offloaded to '~a' failed: ~a~%")
(derivation-file-name drv) (derivation-file-name drv)
(build-machine-name machine) (build-machine-name machine)
(nix-protocol-error-message c)) (store-protocol-error-message c))
(let* ((inferior (false-if-exception (remote-inferior session))) (let* ((inferior (false-if-exception (remote-inferior session)))
(space (false-if-exception (space (false-if-exception
(node-free-disk-space inferior)))) (node-free-disk-space inferior))))
@ -712,18 +712,31 @@ machine."
(warning (G_ "failed to run 'guix repl' on machine '~a'~%") (warning (G_ "failed to run 'guix repl' on machine '~a'~%")
(build-machine-name machine))) (build-machine-name machine)))
((? inferior? inferior) ((? inferior? inferior)
(let ((uts (inferior-eval '(uname) inferior)) (let ((now (car (gettimeofday))))
(load (node-load inferior)) (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))) (free (node-free-disk-space inferior)))
(close-inferior inferior) (close-inferior inferior)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\ (format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%" host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%\
time difference: ~a s~%"
(build-machine-name machine) (build-machine-name machine)
(utsname:sysname uts) (utsname:release uts) (utsname:sysname uts) (utsname:release uts)
(utsname:machine uts) (utsname:machine uts)
(utsname:nodename uts) (utsname:nodename uts)
(normalized-load machine load) (normalized-load machine load)
(/ free (expt 2 20) 1.))))) (/ free (expt 2 20) 1.)
(- time now))))))))
(disconnect! session)) (disconnect! session))
machines))) machines)))

View File

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

View File

@ -36,8 +36,7 @@
#:export (make-config.scm #:export (make-config.scm
whole-package ;for internal use in 'guix pull' whole-package ;for internal use in 'guix pull'
compiled-guix compiled-guix
guix-derivation guix-derivation))
reload-guix))
;;; ;;;
@ -613,10 +612,6 @@ Info manual."
(append (file-imports source "gnu/system/examples" (append (file-imports source "gnu/system/examples"
(const #t)) (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. ;; All the installer code is on the build-side.
(file-imports source "gnu/installer/" (file-imports source "gnu/installer/"
(const #t)) (const #t))
@ -636,6 +631,17 @@ Info manual."
#:extensions dependencies #:extensions dependencies
#:guile-for-build guile-for-build)) #: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* (define *config*
(scheme-node "guix-config" (scheme-node "guix-config"
'() '()
@ -664,6 +670,7 @@ Info manual."
;; comes with *CORE-MODULES*. ;; comes with *CORE-MODULES*.
(list *config* (list *config*
*cli-modules* *cli-modules*
*system-test-modules*
*system-modules* *system-modules*
*package-modules* *package-modules*
*core-package-modules* *core-package-modules*

View File

@ -59,7 +59,7 @@
;; Similar to serialize.cc in Nix. ;; 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? nar-error?
(file nar-error-file) ; file we were restoring, or #f (file nar-error-file) ; file we were restoring, or #f
(port nar-error-port)) ; port from which we read (port nar-error-port)) ; port from which we read

View File

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

View File

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

View File

@ -64,7 +64,7 @@
(define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri))) (define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
"Open a connection to the build daemon for tests purposes and return it." "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) (format (current-error-port)
"warning: build daemon error: ~s~%" c) "warning: build daemon error: ~s~%" c)
#f)) #f))

View File

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

View File

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

View File

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

View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # 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. # This file is part of GNU Guix.
# #
@ -109,7 +109,7 @@ guile -c "
(define (build-without-failing drv) (define (build-without-failing drv)
(lambda (store) (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)) (build-derivations store (list drv))
(values #f store)))) (values #f store))))
@ -177,9 +177,9 @@ client_code='
`("-e" ,build) `("-e" ,build)
#:inputs `((,bash) (,build)) #:inputs `((,bash) (,build))
#:env-vars `(("x" . ,(random-text)))))) #:env-vars `(("x" . ,(random-text))))))
(exit (guard (c ((nix-protocol-error? c) (exit (guard (c ((store-protocol-error? c)
(->bool (->bool
(string-contains (pk (nix-protocol-error-message c)) (string-contains (pk (store-protocol-error-message c))
"failed")))) "failed"))))
(build-derivations store (list drv)) (build-derivations store (list drv))
#f))))' #f))))'

View File

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

View File

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

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -288,6 +288,30 @@
(and (string-match "extra.*initializer.*baz" message) (and (string-match "extra.*initializer.*baz" message)
(eq? proc 'foo))))) (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" (test-assert "ABI checks"
(let ((module (test-module))) (let ((module (test-module)))
(eval '(begin (eval '(begin

View File

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