summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-10 23:54:17 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-10 23:54:17 +0100
commite06f7865e2630494a522ac32b9c0a0311be3e1e2 (patch)
tree1a547ad3a2e4c1b98a67845a9de0dfc798227b5f
parentff3c0c1b805453990a42f690f148b41b9dff382a (diff)
parentc9c88118a12b0e22b7369b1dc6b0e2f9db894986 (diff)
Merge branch 'master' into core-updates
-rw-r--r--HACKING9
-rw-r--r--Makefile.am2
-rw-r--r--configure.ac8
-rw-r--r--daemon.am4
-rw-r--r--doc/guix.texi195
-rw-r--r--gnu-system.am8
-rw-r--r--gnu/packages/admin.scm53
-rw-r--r--gnu/packages/bdw-gc.scm19
-rw-r--r--gnu/packages/gnupg.scm26
-rw-r--r--gnu/packages/gnutls.scm10
-rw-r--r--gnu/packages/hurd.scm44
-rw-r--r--gnu/packages/linux.scm25
-rw-r--r--gnu/packages/lynx.scm86
-rw-r--r--gnu/packages/messaging.scm123
-rw-r--r--gnu/packages/mpd.scm28
-rw-r--r--gnu/packages/patches/bitlbee-fix-tests.patch33
-rw-r--r--gnu/packages/patches/bitlbee-memset-fix.patch15
-rw-r--r--gnu/packages/patches/source-highlight-regexrange-test.patch15
-rw-r--r--gnu/packages/pretty-print.scm224
-rw-r--r--gnu/packages/python.scm52
-rw-r--r--gnu/packages/rdf.scm11
-rw-r--r--gnu/packages/ssh.scm16
-rw-r--r--gnu/packages/version-control.scm76
-rw-r--r--gnu/system/vm.scm8
-rw-r--r--guix/build/linux-initrd.scm8
-rw-r--r--guix/config.scm.in2
-rw-r--r--guix/download.scm6
-rw-r--r--guix/git-download.scm3
-rw-r--r--guix/gnu-maintenance.scm9
-rw-r--r--guix/http-client.scm35
-rw-r--r--guix/scripts/archive.scm3
-rw-r--r--guix/scripts/build.scm58
-rw-r--r--guix/scripts/offload.scm365
-rw-r--r--guix/scripts/package.scm212
-rwxr-xr-xguix/scripts/substitute-binary.scm60
-rw-r--r--guix/serialization.scm12
-rw-r--r--guix/store.scm25
-rw-r--r--guix/utils.scm35
-rw-r--r--tests/derivations.scm14
-rw-r--r--tests/store.scm22
-rw-r--r--tests/utils.scm87
41 files changed, 1639 insertions, 407 deletions
diff --git a/HACKING b/HACKING
index 0dc2908318..6600397554 100644
--- a/HACKING
+++ b/HACKING
@@ -2,8 +2,9 @@
#+TITLE: Hacking GNU Guix and Its Incredible Distro
-Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+Copyright © 2014 Pierre-Antoine Rault <par@rigelk.eu>
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
@@ -85,7 +86,11 @@ wrapping it, swallowing or rejecting the following s-expression, etc.
Development is done using the Git distributed version control system. Thus,
access to the repository is not strictly necessary. We welcome contributions
in the form of patches as produced by ‘git format-patch’ sent to
-guix-devel@gnu.org. Please write commit logs in the [[http://www.gnu.org/prep/standards/html_node/Change-Logs.html#Change-Logs][GNU ChangeLog format]].
+guix-devel@gnu.org. Please write commit logs in the [[http://www.gnu.org/prep/standards/html_node/Change-Logs.html#Change-Logs][GNU ChangeLog
+format]]; you can check the commit history for examples.
+
+When posting a patch to the mailing list, use "[PATCH] ..." as a subject. You
+may use your email client or the ‘git send-mail’ command.
As you become a regular contributor, you may find it convenient to have write
access to the repository (see below.)
diff --git a/Makefile.am b/Makefile.am
index 56cb6d2354..764332a001 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -263,7 +263,7 @@ gen-ChangeLog:
mv $(distdir)/cl-t $(distdir)/ChangeLog; \
fi
-# Make sure we're not shipping a file that embeds a local /nix/store file name.
+# Make sure we're not shipping a file that embeds a local /gnu/store file name.
assert-no-store-file-names:
if grep -r --exclude=*.texi --exclude=*.info \
"$(storedir)/[a-z0-9]{32}-" $(distdir) ; \
diff --git a/configure.ac b/configure.ac
index 749672f15b..d5a89c915b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -26,11 +26,15 @@ GUIX_ASSERT_SUPPORTED_SYSTEM
AC_ARG_WITH(store-dir,
AC_HELP_STRING([--with-store-dir=PATH],
- [path of the store (defaults to /nix/store)]),
+ [file name of the store (defaults to /gnu/store)]),
[storedir="$withval"],
- [storedir="/nix/store"])
+ [storedir="/gnu/store"])
AC_SUBST(storedir)
+dnl Better be verbose.
+AC_MSG_CHECKING([for the store directory])
+AC_MSG_RESULT([$storedir])
+
AC_ARG_ENABLE([daemon],
[AS_HELP_STRING([--disable-daemon], [build the Nix daemon (C++)])],
[guix_build_daemon="$enableval"],
diff --git a/daemon.am b/daemon.am
index 1059e444ab..abb785592d 100644
--- a/daemon.am
+++ b/daemon.am
@@ -112,8 +112,8 @@ libstore_a_CPPFLAGS = \
-I$(top_builddir)/nix/libstore \
-DNIX_STORE_DIR=\"$(storedir)\" \
-DNIX_DATA_DIR=\"$(datadir)\" \
- -DNIX_STATE_DIR=\"$(localstatedir)/nix\" \
- -DNIX_LOG_DIR=\"$(localstatedir)/log/nix\" \
+ -DNIX_STATE_DIR=\"$(localstatedir)/guix\" \
+ -DNIX_LOG_DIR=\"$(localstatedir)/log/guix\" \
-DNIX_CONF_DIR=\"$(sysconfdir)/guix\" \
-DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \
-DNIX_BIN_DIR=\"$(bindir)\" \
diff --git a/doc/guix.texi b/doc/guix.texi
index 78736fadf2..701b5400f8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -102,7 +102,7 @@ explicit inputs are visible.
The result of package build functions is @dfn{cached} in the file
system, in a special directory called @dfn{the store} (@pxref{The
Store}). Each package is installed in a directory of its own, in the
-store---by default under @file{/nix/store}. The directory name contains
+store---by default under @file{/gnu/store}. The directory name contains
a hash of all the inputs used to build that package; thus, changing an
input yields a different directory name.
@@ -165,7 +165,7 @@ between both. To do so, you must pass @command{configure} not only the
same @code{--with-store-dir} value, but also the same
@code{--localstatedir} value. The latter is essential because it
specifies where the database that stores metadata about the store is
-located, among other things. The default values are
+located, among other things. The default values for Nix are
@code{--with-store-dir=/nix/store} and @code{--localstatedir=/nix/var}.
Note that @code{--disable-daemon} is not required if
your goal is to share the store with Nix.
@@ -195,7 +195,7 @@ environment.
In a standard multi-user setup, Guix and its daemon---the
@command{guix-daemon} program---are installed by the system
-administrator; @file{/nix/store} is owned by @code{root} and
+administrator; @file{/gnu/store} is owned by @code{root} and
@command{guix-daemon} runs as @code{root}. Unprivileged users may use
Guix tools to build packages or otherwise access the store, and the
daemon will do it on their behalf, ensuring that the store is kept in a
@@ -577,7 +577,7 @@ management tools it provides.
When using Guix, each package ends up in the @dfn{package store}, in its
own directory---something that resembles
-@file{/nix/store/xxx-package-1.2}, where @code{xxx} is a base32 string.
+@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string.
Instead of referring to these directories, users have their own
@dfn{profile}, which points to the packages that they actually want to
@@ -586,10 +586,10 @@ use. These profiles are stored within each user's home directory, at
For example, @code{alice} installs GCC 4.7.2. As a result,
@file{/home/alice/.guix-profile/bin/gcc} points to
-@file{/nix/store/@dots{}-gcc-4.7.2/bin/gcc}. Now, on the same machine,
+@file{/gnu/store/@dots{}-gcc-4.7.2/bin/gcc}. Now, on the same machine,
@code{bob} had already installed GCC 4.8.0. The profile of @code{bob}
simply continues to point to
-@file{/nix/store/@dots{}-gcc-4.8.0/bin/gcc}---i.e., both versions of GCC
+@file{/gnu/store/@dots{}-gcc-4.8.0/bin/gcc}---i.e., both versions of GCC
coexist on the same system without any interference.
The @command{guix package} command is the central tool to manage
@@ -621,7 +621,7 @@ collected.
@cindex reproducible builds
Finally, Guix takes a @dfn{purely functional} approach to package
management, as described in the introduction (@pxref{Introduction}).
-Each @file{/nix/store} package directory name contains a hash of all the
+Each @file{/gnu/store} package directory name contains a hash of all the
inputs that were used to build that package---compiler, libraries, build
scripts, etc. This direct correspondence allows users to make sure a
given package installation matches the current state of their
@@ -632,7 +632,7 @@ machines (@pxref{Invoking guix-daemon, container}).
@cindex substitute
This foundation allows Guix to support @dfn{transparent binary/source
-deployment}. When a pre-built binary for a @file{/nix/store} path is
+deployment}. When a pre-built binary for a @file{/gnu/store} path is
available from an external source---a @dfn{substitute}, Guix just
downloads it@footnote{@c XXX: Remove me when outdated.
As of version @value{VERSION}, substitutes are downloaded from
@@ -699,7 +699,9 @@ such as @code{guile-1.8.8}. If no version number is specified, the
newest available version will be selected. In addition, @var{package}
may contain a colon, followed by the name of one of the outputs of the
package, as in @code{gcc:doc} or @code{binutils-2.22:lib}
-(@pxref{Packages with Multiple Outputs}).
+(@pxref{Packages with Multiple Outputs}). Packages with a corresponding
+name (and optionally version) are searched for among the GNU
+distribution modules (@pxref{Package Modules}).
@cindex propagated inputs
Sometimes packages have @dfn{propagated inputs}: these are dependencies
@@ -789,21 +791,6 @@ suggest setting these variables to @code{@var{profile}/include} and
@itemx -p @var{profile}
Use @var{profile} instead of the user's default profile.
-@item --dry-run
-@itemx -n
-Show what would be done without actually doing it.
-
-@item --fallback
-When substituting a pre-built binary fails, fall back to building
-packages locally.
-
-@item --no-substitutes
-Do not use substitutes for build products. That is, always build things
-locally instead of allowing downloads of pre-built binaries.
-
-@item --max-silent-time=@var{seconds}
-Same as for @command{guix build} (@pxref{Invoking guix build}).
-
@item --verbose
Produce verbose output. In particular, emit the environment's build log
on the standard error port.
@@ -918,6 +905,10 @@ Consequently, this command must be used with care.
@end table
+Finally, since @command{guix package} may actually start build
+processes, it supports all the common build options that @command{guix
+build} supports (@pxref{Invoking guix build, common build options}).
+
@node Packages with Multiple Outputs
@section Packages with Multiple Outputs
@@ -974,10 +965,10 @@ guix package}).
@cindex garbage collector
Packages that are installed but not used may be @dfn{garbage-collected}.
The @command{guix gc} command allows users to explicitly run the garbage
-collector to reclaim space from the @file{/nix/store} directory.
+collector to reclaim space from the @file{/gnu/store} directory.
The garbage collector has a set of known @dfn{roots}: any file under
-@file{/nix/store} reachable from a root is considered @dfn{live} and
+@file{/gnu/store} reachable from a root is considered @dfn{live} and
cannot be deleted; any other file is considered @dfn{dead} and may be
deleted. The set of garbage collector roots includes default user
profiles, and may be augmented with @command{guix build --root}, for
@@ -997,7 +988,7 @@ information. The available options are listed below:
@table @code
@item --collect-garbage[=@var{min}]
@itemx -C [@var{min}]
-Collect garbage---i.e., unreachable @file{/nix/store} files and
+Collect garbage---i.e., unreachable @file{/gnu/store} files and
sub-directories. This is the default operation when no option is
specified.
@@ -1170,13 +1161,13 @@ containing the @code{gui} output of the @code{git} package and the main
output of @code{emacs}:
@example
-guix archive --export git:gui /nix/store/...-emacs-24.3 > great.nar
+guix archive --export git:gui /gnu/store/...-emacs-24.3 > great.nar
@end example
If the specified packages are not built yet, @command{guix archive}
automatically builds them. The build process may be controlled with the
same options that can be passed to the @command{guix build} command
-(@pxref{Invoking guix build}).
+(@pxref{Invoking guix build, common build options}).
@c *********************************************************************
@@ -1192,7 +1183,7 @@ turned into concrete build actions.
Build actions are performed by the Guix daemon, on behalf of users. In a
standard setup, the daemon has write access to the store---the
-@file{/nix/store} directory---whereas users do not. The recommended
+@file{/gnu/store} directory---whereas users do not. The recommended
setup also has the daemon perform builds in chroots, under a specific
build users, to minimize interference with the rest of the system.
@@ -1223,10 +1214,11 @@ example, the package definition, or @dfn{recipe}, for the GNU Hello
package looks like this:
@example
-(use-modules (guix packages)
- (guix download)
- (guix build-system gnu)
- (guix licenses))
+(define-module (gnu packages hello)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix licenses))
(define hello
(package
@@ -1248,13 +1240,19 @@ package looks like this:
@noindent
Without being a Scheme expert, the reader may have guessed the meaning
-of the various fields here. This expression binds variable @var{hello}
+of the various fields here. This expression binds variable @code{hello}
to a @code{<package>} object, which is essentially a record
(@pxref{SRFI-9, Scheme records,, guile, GNU Guile Reference Manual}).
This package object can be inspected using procedures found in the
@code{(guix packages)} module; for instance, @code{(package-name hello)}
returns---surprise!---@code{"hello"}.
+In the example above, @var{hello} is defined into a module of its own,
+@code{(gnu packages hello)}. Technically, this is not strictly
+necessary, but it is convenient to do so: all the packages defined in
+modules under @code{(gnu packages @dots{})} are automatically known to
+the command-line tools (@pxref{Package Modules}).
+
There are a few points worth noting in the above package definition:
@itemize
@@ -1342,7 +1340,7 @@ definition to a new upstream version can be partly automated by the
Behind the scenes, a derivation corresponding to the @code{<package>}
object is first computed by the @code{package-derivation} procedure.
-That derivation is stored in a @code{.drv} file under @file{/nix/store}.
+That derivation is stored in a @code{.drv} file under @file{/gnu/store}.
The build actions it prescribes may then be realized by using the
@code{build-derivations} procedure (@pxref{The Store}).
@@ -1381,7 +1379,7 @@ Configure and Build System}).
@cindex store paths
Conceptually, the @dfn{store} is where derivations that have been
-successfully built are stored---by default, under @file{/nix/store}.
+successfully built are stored---by default, under @file{/gnu/store}.
Sub-directories in the store are referred to as @dfn{store paths}. The
store has an associated database that contains information such has the
store paths referred to by each store path, and the list of @emph{valid}
@@ -1526,7 +1524,7 @@ to a Bash executable in the store:
(derivation store "foo"
bash `("-e" ,builder)
#:env-vars '(("HOME" . "/homeless"))))
-@result{} #<derivation /nix/store/@dots{}-foo.drv => /nix/store/@dots{}-foo>
+@result{} #<derivation /gnu/store/@dots{}-foo.drv => /gnu/store/@dots{}-foo>
@end lisp
As can be guessed, this primitive is cumbersome to use directly. An
@@ -1570,13 +1568,13 @@ containing one file:
@lisp
(let ((builder '(let ((out (assoc-ref %outputs "out")))
- (mkdir out) ; create /nix/store/@dots{}-goo
+ (mkdir out) ; create /gnu/store/@dots{}-goo
(call-with-output-file (string-append out "/test")
(lambda (p)
(display '(hello guix) p))))))
(build-expression->derivation store "goo" builder))
-@result{} #<derivation /nix/store/@dots{}-goo.drv => @dots{}>
+@result{} #<derivation /gnu/store/@dots{}-goo.drv => @dots{}>
@end lisp
@cindex strata of code
@@ -1654,7 +1652,7 @@ effect, one must use @code{run-with-store}:
@example
(run-with-store (open-connection) (profile.sh))
-@result{} /nix/store/...-profile.sh
+@result{} /gnu/store/...-profile.sh
@end example
The main syntactic forms to deal with monads in general are described
@@ -1729,7 +1727,7 @@ like this:
grep "/bin:" sed "/bin\n"))
@end example
-In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file
+In this example, the resulting @file{/gnu/store/@dots{}-profile.sh} file
will references @var{coreutils}, @var{grep}, and @var{sed}, thereby
preventing them from being garbage-collected during its lifetime.
@end deffn
@@ -1789,10 +1787,14 @@ guix build @var{options} @var{package-or-derivation}@dots{}
@var{package-or-derivation} may be either the name of a package found in
the software distribution such as @code{coreutils} or
@code{coreutils-8.20}, or a derivation such as
-@file{/nix/store/@dots{}-coreutils-8.19.drv}. Alternatively, the
-@code{--expression} option may be used to specify a Scheme expression
-that evaluates to a package; this is useful when disambiguation among
-several same-named packages or package variants is needed.
+@file{/gnu/store/@dots{}-coreutils-8.19.drv}. In the former case, a
+package with the corresponding name (and optionally version) is searched
+for among the GNU distribution modules (@pxref{Package Modules}).
+
+Alternatively, the @code{--expression} option may be used to specify a
+Scheme expression that evaluates to a package; this is useful when
+disambiguation among several same-named packages or package variants is
+needed.
The @var{options} may be zero or more of the following:
@@ -1816,7 +1818,7 @@ Build the packages' source derivations, rather than the packages
themselves.
For instance, @code{guix build -S gcc} returns something like
-@file{/nix/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball.
+@file{/gnu/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball.
The returned source tarball is the result of applying any patches and
code snippets specified in the package's @code{origin} (@pxref{Defining
@@ -1843,6 +1845,37 @@ configuration triplets,, configure, GNU Configure and Build System}).
Return the derivation paths, not the output paths, of the given
packages.
+@item --root=@var{file}
+@itemx -r @var{file}
+Make @var{file} a symlink to the result, and register it as a garbage
+collector root.
+
+@item --log-file
+Return the build log file names for the given
+@var{package-or-derivation}s, or raise an error if build logs are
+missing.
+
+This works regardless of how packages or derivations are specified. For
+instance, the following invocations are equivalent:
+
+@example
+guix build --log-file `guix build -d guile`
+guix build --log-file `guix build guile`
+guix build --log-file guile
+guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)'
+@end example
+
+
+@end table
+
+@cindex common build options
+In addition, a number of options that control the build process are
+common to @command{guix build} and other commands that can spawn builds,
+such as @command{guix package} or @command{guix archive}. These are the
+following:
+
+@table @code
+
@item --keep-failed
@itemx -K
Keep the build tree of failed builds. Thus, if a build fail, its build
@@ -1870,36 +1903,22 @@ instead of offloading builds to remote machines.
When the build or substitution process remains silent for more than
@var{seconds}, terminate it and report a build failure.
-@item --cores=@var{n}
-@itemx -c @var{n}
-Allow the use of up to @var{n} CPU cores for the build. The special
-value @code{0} means to use as many CPU cores as available.
+@item --timeout=@var{seconds}
+Likewise, when the build or substitution process lasts for more than
+@var{seconds}, terminate it and report a build failure.
-@item --root=@var{file}
-@itemx -r @var{file}
-Make @var{file} a symlink to the result, and register it as a garbage
-collector root.
+By default there is no timeout. This behavior can be restored with
+@code{--timeout=0}.
@item --verbosity=@var{level}
Use the given verbosity level. @var{level} must be an integer between 0
and 5; higher means more verbose output. Setting a level of 4 or more
may be helpful when debugging setup issues with the build daemon.
-@item --log-file
-Return the build log file names for the given
-@var{package-or-derivation}s, or raise an error if build logs are
-missing.
-
-This works regardless of how packages or derivations are specified. For
-instance, the following invocations are equivalent:
-
-@example
-guix build --log-file `guix build -d guile`
-guix build --log-file `guix build guile`
-guix build --log-file guile
-guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)'
-@end example
-
+@item --cores=@var{n}
+@itemx -c @var{n}
+Allow the use of up to @var{n} CPU cores for the build. The special
+value @code{0} means to use as many CPU cores as available.
@end table
@@ -2184,7 +2203,7 @@ the load. To check whether a package has a @code{debug} output, use
@section Package Modules
From a programming viewpoint, the package definitions of the
-distribution are provided by Guile modules in the @code{(gnu packages
+GNU distribution are provided by Guile modules in the @code{(gnu packages
@dots{})} name space@footnote{Note that packages under the @code{(gnu
packages @dots{})} module name space are not necessarily ``GNU
packages''. This module naming scheme follows the usual Guile module
@@ -2193,8 +2212,19 @@ as part of the GNU system, and @code{packages} identifies modules that
define packages.} (@pxref{Modules, Guile modules,, guile, GNU Guile
Reference Manual}). For instance, the @code{(gnu packages emacs)}
module exports a variable named @code{emacs}, which is bound to a
-@code{<package>} object (@pxref{Defining Packages}). The @code{(gnu
-packages)} module provides facilities for searching for packages.
+@code{<package>} object (@pxref{Defining Packages}).
+
+The @code{(gnu packages @dots{})} module name space is special: it is
+automatically scanned for packages by the command-line tools. For
+instance, when running @code{guix package -i emacs}, all the @code{(gnu
+packages @dots{})} modules are scanned until one that exports a package
+object whose name is @code{emacs} is found. This package search
+facility is implemented in the @code{(gnu packages)} module.
+
+Users can store package definitions in modules with different
+names---e.g., @code{(my-packages emacs)}. In that case, commands such
+as @command{guix package} and @command{guix build} have to be used with
+the @code{-e} option so that they know where to find the package.
The distribution is fully @dfn{bootstrapped} and @dfn{self-contained}:
each package is built based solely on other packages in the
@@ -2240,6 +2270,15 @@ called @code{gnew}, you may run this command from the Guix build tree:
Using @code{--keep-failed} makes it easier to debug build failures since
it provides access to the failed build tree.
+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{Contributing}). Well, if you need help, we will be happy to
help you too. Once the patch is committed in the Guix repository, the
@@ -2452,7 +2491,7 @@ etc., at which point we have a working C tool chain.
Bootstrapping is complete when we have a full tool chain that does not
depend on the pre-built bootstrap tools discussed above. This
no-dependency requirement is verified by checking whether the files of
-the final tool chain contain references to the @file{/nix/store}
+the final tool chain contain references to the @file{/gnu/store}
directories of the bootstrap inputs. The process that leads to this
``final'' tool chain is described by the package definitions found in
the @code{(gnu packages base)} module.
@@ -2754,10 +2793,10 @@ deco,,, dmd, GNU dmd Manual}).
@chapter Contributing
This project is a cooperative effort, and we need your help to make it
-grow! Please get in touch with us on @email{guix-devel@@gnu.org}. We
-welcome ideas, bug reports, patches, and anything that may be helpful to
-the project. We particularly welcome help on packaging
-(@pxref{Packaging Guidelines}).
+grow! Please get in touch with us on @email{guix-devel@@gnu.org} and
+@code{#guix} on the Freenode IRC network. We welcome ideas, bug
+reports, patches, and anything that may be helpful to the project. We
+particularly welcome help on packaging (@pxref{Packaging Guidelines}).
Please see the
@url{http://git.savannah.gnu.org/cgit/guix.git/tree/HACKING,
diff --git a/gnu-system.am b/gnu-system.am
index 97dc92cdfc..9f4f959d46 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -1,7 +1,7 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
-# Copyright © 2013 Mark H Weaver <mhw@netris.org>
+# Copyright © 2013, 2014 Mark H Weaver <mhw@netris.org>
#
# This file is part of GNU Guix.
#
@@ -139,10 +139,12 @@ GNU_SYSTEM_MODULES = \
gnu/packages/lsof.scm \
gnu/packages/lua.scm \
gnu/packages/lvm.scm \
+ gnu/packages/lynx.scm \
gnu/packages/m4.scm \
gnu/packages/mail.scm \
gnu/packages/make-bootstrap.scm \
gnu/packages/maths.scm \
+ gnu/packages/messaging.scm \
gnu/packages/mit-krb5.scm \
gnu/packages/moe.scm \
gnu/packages/mpd.scm \
@@ -174,6 +176,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/popt.scm \
gnu/packages/pth.scm \
gnu/packages/pulseaudio.scm \
+ gnu/packages/pretty-print.scm \
gnu/packages/python.scm \
gnu/packages/qemu.scm \
gnu/packages/qt.scm \
@@ -249,6 +252,8 @@ dist_patch_DATA = \
gnu/packages/patches/bigloo-gc-shebangs.patch \
gnu/packages/patches/binutils-ld-new-dtags.patch \
gnu/packages/patches/binutils-loongson-workaround.patch \
+ gnu/packages/patches/bitlbee-fix-tests.patch \
+ gnu/packages/patches/bitlbee-memset-fix.patch \
gnu/packages/patches/cdparanoia-fpic.patch \
gnu/packages/patches/cmake-fix-tests.patch \
gnu/packages/patches/coreutils-dummy-man.patch \
@@ -318,6 +323,7 @@ dist_patch_DATA = \
gnu/packages/patches/slim-session.patch \
gnu/packages/patches/slim-config.patch \
gnu/packages/patches/slim-sigusr1.patch \
+ gnu/packages/patches/source-highlight-regexrange-test.patch \
gnu/packages/patches/tcsh-fix-autotest.patch \
gnu/packages/patches/teckit-cstdio.patch \
gnu/packages/patches/valgrind-glibc.patch \
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 6998996523..ffedfd3f44 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -36,6 +36,9 @@
#:select (tar))
#:use-module ((gnu packages compression)
#:select (gzip))
+ #:use-module (gnu packages bison)
+ #:use-module (gnu packages flex)
+ #:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config))
(define-public dmd
@@ -429,3 +432,53 @@ connection alive.")
reference implementation of all aspects of DHCP, through a suite of DHCP
tools: server, client, and relay agent.")
(license isc)))
+
+(define-public libpcap
+ (package
+ (name "libpcap")
+ (version "1.5.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://www.tcpdump.org/release/libpcap-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "14wyjywrdi1ikaj6yc9c72m6m2r64z94lb0gm7k1a3q6q5cj3scs"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("bison" ,bison) ("flex" ,flex)))
+ (arguments '(#:tests? #f)) ; no 'check' target
+ (home-page "http://www.tcpdump.org")
+ (synopsis "Network packet capture library")
+ (description
+ "libpcap is an interface for user-level packet capture. It provides a
+portable framework for low-level network monitoring. Applications include
+network statistics collection, security monitoring, network debugging, etc.")
+
+ ;; fad-*.c and a couple other files are BSD-4, but the rest is BSD-3.
+ (license bsd-3)))
+
+(define-public jnettop
+ (package
+ (name "jnettop")
+ (version "0.13.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://jnettop.kubs.info/dist/jnettop-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1855np7c4b0bqzhf1l1dyzxb90fpnvrirdisajhci5am6als31z9"))))
+ (build-system gnu-build-system)
+ (native-inputs
+ `(("pkg-config" ,pkg-config)))
+ (inputs
+ `(("glib" ,glib)
+ ("ncurses" ,ncurses)
+ ("libpcap" ,libpcap)))
+ (home-page "http://jnettop.kubs.info/")
+ (synopsis "Visualize network traffic by bandwidth use")
+ (description
+ "Jnettop is a traffic visualiser, which captures traffic going
+through the host it is running from and displays streams sorted
+by bandwidth they use.")
+ (license gpl2+)))
diff --git a/gnu/packages/bdw-gc.scm b/gnu/packages/bdw-gc.scm
index b223721520..1955cd3ee1 100644
--- a/gnu/packages/bdw-gc.scm
+++ b/gnu/packages/bdw-gc.scm
@@ -29,9 +29,8 @@
(version "7.2d")
(source (origin
(method url-fetch)
- (uri (string-append
- "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc-"
- version ".tar.gz"))
+ (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
+ version ".tar.gz"))
(sha256
(base32
"0phwa5driahnpn79zqff14w9yc8sn3599cxz91m78hqdcpl0mznr"))))
@@ -58,10 +57,9 @@ simple collector interface.
Alternatively, the garbage collector may be used as a leak detector for
C or C++ programs, though that is not its primary goal.")
- (home-page "http://www.hpl.hp.com/personal/Hans_Boehm/gc/")
+ (home-page "http://www.hboehm.info/gc/")
- (license
- (x11-style "http://www.hpl.hp.com/personal/Hans_Boehm/gc/license.txt"))))
+ (license (x11-style (string-append home-page "license.txt")))))
(define-public libatomic-ops
(package
@@ -70,7 +68,7 @@ C or C++ programs, though that is not its primary goal.")
(source (origin
(method url-fetch)
(uri (string-append
- "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/libatomic_ops-"
+ "http://www.hboehm.info/gc/gc_source/libatomic_ops-"
version ".tar.gz"))
(sha256
(base32
@@ -83,7 +81,7 @@ C or C++ programs, though that is not its primary goal.")
memory update operations on a number architectures. These might allow you to
write code that does more interesting things in signal handlers, write
lock-free code, experiment with thread programming paradigms, etc.")
- (home-page "http://www.hpl.hp.com/research/linux/atomic_ops/")
+ (home-page "https://github.com/ivmai/libatomic_ops/")
;; Some source files are X11-style, others are GPLv2+.
(license gpl2+)))
@@ -93,9 +91,8 @@ lock-free code, experiment with thread programming paradigms, etc.")
(version "7.4.0")
(source (origin
(method url-fetch)
- (uri (string-append
- "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc-"
- version ".tar.gz"))
+ (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
+ version ".tar.gz"))
(sha256
(base32
"10z2nph62ilab063wygg2lv0jxlsbcf2az9w1lx01jzqj5lzry31"))))
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index e06865d196..16ca8ae661 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,6 +210,31 @@ components), libgpg-error (centralized GnuPG error values), and libskba
(working with X.509 certificates and CMS data).")
(license gpl3+)))
+(define-public gnupg-1
+ (package (inherit gnupg)
+ (version "1.4.16")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnupg/gnupg/gnupg-" version
+ ".tar.bz2"))
+ (sha256
+ (base32
+ "0bsa1yqa3ybhvmc4ys73amdpcmckrlq1fsxjl2980cxada778fvv"))))
+ (inputs
+ `(("zlib" ,guix:zlib)
+ ("bzip2" ,guix:bzip2)
+ ("curl" ,curl)
+ ("readline" ,readline)
+ ("libgpg-error" ,libgpg-error)))
+ (arguments
+ `(#:phases (alist-cons-after
+ 'unpack 'patch-check-sh
+ (lambda _
+ (substitute* "checks/Makefile.in"
+ (("/bin/sh") (which "bash"))))
+ %standard-phases)))))
+
(define-public gpgme
(package
(name "gpgme")
diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm
index 915f6f8c8f..0391f54126 100644
--- a/gnu/packages/gnutls.scm
+++ b/gnu/packages/gnutls.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -63,7 +63,7 @@ specifications.")
(define-public gnutls
(package
(name "gnutls")
- (version "3.2.11")
+ (version "3.2.12")
(source (origin
(method url-fetch)
(uri
@@ -75,8 +75,12 @@ specifications.")
"/gnutls-" version ".tar.xz"))
(sha256
(base32
- "1hgk3k8f6wqijca3bsjbfn8pzyfva509y4j2vaxhm4ynfa5cai5q"))))
+ "0195nliarszq5mginli6d2f5z7ljnd7mwa46iy9z8pkcgy56khbl"))))
(build-system gnu-build-system)
+ (arguments
+ ;; Work around build issue reported at
+ ;; <https://lists.gnu.org/archive/html/guix-devel/2014-03/msg00027.html>.
+ '(#:make-flags '("CPPFLAGS=-DENABLE_RSA_EXPORT")))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 3edccbdd1c..f1e7dbc9dc 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -22,7 +22,9 @@
#:use-module (guix packages)
#:use-module (guix build-system gnu)
#:use-module (gnu packages flex)
- #:use-module (gnu packages bison))
+ #:use-module (gnu packages bison)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages autotools))
(define-public gnumach-headers
(package
@@ -86,3 +88,43 @@ and to compile the GNU C library for the Hurd. Also,you will need it
for other software in the GNU system that uses Mach-based inter-process
communication.")
(license gpl2+)))
+
+(define-public hurd-headers
+ (package
+ (name "hurd-headers")
+ (version "0.5")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/hurd/hurd-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0lvkz3r0ngb4bsn2hzdc9vjpyrfa3ls36jivrvy1n7f7f55zan7q"))))
+ (build-system gnu-build-system)
+ (native-inputs
+ `(;; Autoconf shouldn't be necessary but there seems to be a bug in the
+ ;; build system triggering its use.
+ ("autoconf" ,autoconf)
+
+ ("mig" ,mig)))
+ (arguments
+ `(#:phases (alist-replace
+ 'install
+ (lambda _
+ (zero? (system* "make" "install-headers" "no_deps=t")))
+ (alist-delete 'build %standard-phases))
+
+ #:configure-flags '(;; Pretend we're on GNU/Hurd; 'configure' wants
+ ;; that.
+ "--host=i686-pc-gnu"
+
+ ;; Reduce set of dependencies.
+ "--without-parted")
+
+ #:tests? #f))
+ (home-page "http://www.gnu.org/software/hurd/hurd.html")
+ (synopsis "GNU Hurd headers")
+ (description
+ "This package provides C headers of the GNU Hurd, used to build the GNU C
+Library and other user programs.")
+ (license gpl2+)))
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 3fca5dfaf9..e1668b1d6b 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -40,6 +40,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system cmake)
#:use-module (guix build-system python))
(define-public (system->linux-architecture arch)
@@ -920,3 +921,27 @@ part of this problem by allowing users to run file system implementations as
user-space processes.")
(license (list lgpl2.1 ; library
gpl2+)))) ; command-line utilities
+
+(define-public unionfs-fuse
+ (package
+ (name "unionfs-fuse")
+ (version "0.26")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "http://podgorny.cz/unionfs-fuse/releases/unionfs-fuse-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "0qpnr4czgc62vsfnmv933w62nq3xwcbnvqch72qakfgca75rsp4d"))))
+ (build-system cmake-build-system)
+ (inputs `(("fuse" ,fuse)))
+ (arguments '(#:tests? #f)) ; no tests
+ (home-page "http://podgorny.cz/moin/UnionFsFuse")
+ (synopsis "User-space union file system")
+ (description
+ "UnionFS-FUSE is a flexible union file system implementation in user
+space, using the FUSE library. Mounting a union file system allows you to
+\"aggregate\" the contents of several directories into a single mount point.
+UnionFS-FUSE additionally supports copy-on-write.")
+ (license bsd-3)))
diff --git a/gnu/packages/lynx.scm b/gnu/packages/lynx.scm
new file mode 100644
index 0000000000..a87316643d
--- /dev/null
+++ b/gnu/packages/lynx.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages lynx)
+ #:use-module ((guix licenses) #:select (gpl2))
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages ncurses)
+ #:use-module (gnu packages libidn)
+ #:use-module (gnu packages gnutls)
+ #:use-module (gnu packages gnupg)
+ #:use-module (gnu packages zip)
+ #:use-module (gnu packages compression))
+
+(define-public lynx
+ (package
+ (name "lynx")
+ (version "2.8.8")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://lynx.isc.org/lynx" version
+ "/lynx" version ".tar.bz2"))
+ (sha256
+ (base32 "00jcfmx4bxnrzywzzlllz3z45a2mc4fl91ca5lrzz1pyr1s1qnm2"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("pkg-config" ,pkg-config)
+ ("perl" ,perl)))
+ (inputs `(("ncurses" ,ncurses)
+ ("libidn" ,libidn)
+ ("gnutls" ,gnutls)
+ ("libgcrypt" ,libgcrypt)
+ ("unzip" ,unzip)
+ ("zlib" ,zlib)
+ ("gzip" ,gzip)
+ ("bzip2" ,bzip2)))
+ (arguments
+ `(#:configure-flags '("--with-pkg-config"
+ "--with-screen=ncurses"
+ "--with-zlib"
+ "--with-bzlib"
+ "--with-gnutls"
+ ;; "--with-socks5" ; XXX TODO
+ "--enable-widec"
+ "--enable-ascii-ctypes"
+ "--enable-local-docs"
+ "--enable-htmlized-cfg"
+ "--enable-gzip-help"
+ "--enable-nls"
+ "--enable-ipv6")
+ #:tests? #f ; no check target
+ #:phases (alist-replace
+ 'install
+ (lambda* (#:key (make-flags '()) #:allow-other-keys)
+ (zero? (apply system* "make" "install-full" make-flags)))
+ %standard-phases)))
+ (synopsis "Text Web Browser")
+ (description
+ "Lynx is a fully-featured World Wide Web (WWW) client for users running
+cursor-addressable, character-cell display devices. It will display Hypertext
+Markup Language (HTML) documents containing links to files on the local
+system, as well as files on remote systems running http, gopher, ftp, wais,
+nntp, finger, or cso/ph/qi servers. Lynx can be used to access information on
+the WWW, or to build information systems intended primarily for local
+access.")
+ (home-page "http://lynx.isc.org/")
+ (license gpl2)))
+
+;;; lynx.scm ends here
diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm
new file mode 100644
index 0000000000..c1a755ef84
--- /dev/null
+++ b/gnu/packages/messaging.scm
@@ -0,0 +1,123 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages messaging)
+ #:use-module ((guix licenses)
+ #:select (gpl2+ gpl2 lgpl2.1 bsd-2))
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages gnupg)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu packages gnutls)
+ #:use-module (gnu packages python)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages compression)
+ #:use-module (gnu packages check))
+
+(define-public libotr
+ (package
+ (name "libotr")
+ (version "4.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "https://otr.cypherpunks.ca/libotr-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "1d4k0b7v4d3scwm858cmqr9c6xgd6ppla1vk4x2yg64q82a1k49z"))))
+ (build-system gnu-build-system)
+ (propagated-inputs
+ `(("libgcrypt" ,libgcrypt))) ; libotr headers include gcrypt.h
+ (inputs `(("libgpg-error" ,libgpg-error)))
+ (arguments
+ `(#:configure-flags '("--with-pic")))
+ (synopsis "Off-the-Record (OTR) Messaging Library and Toolkit")
+ (description
+ "OTR allows you to have private conversations over instant messaging by
+providing:
+* Encryption: No one else can read your instant messages.
+* Authentication: You are assured the correspondent is who you think it is.
+* Deniability: The messages you send do not have digital signatures that are
+ checkable by a third party. Anyone can forge messages after a conversation
+ to make them look like they came from you. However, during a conversation,
+ your correspondent is assured the messages he sees are authentic and
+ unmodified.
+* Perfect forward secrecy: If you lose control of your private keys, no
+ previous conversation is compromised.")
+ (home-page "https://otr.cypherpunks.ca/")
+ (license (list lgpl2.1 gpl2))))
+
+(define-public libotr-3
+ (package (inherit libotr)
+ (version "3.2.1")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "https://otr.cypherpunks.ca/libotr-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "1x6dd4rh499hdraiqfhz81igrj0a5rs0gjhc8l4sljwqhjjyla6l"))))))
+
+(define-public bitlbee
+ (package
+ (name "bitlbee")
+ (version "3.2.1")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://get.bitlbee.org/src/bitlbee-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "0n8g5452i5qap43zxb83gxp01d48psf6rr3k1q7z6a3dgpfi3x00"))
+ (patches (list (search-patch "bitlbee-memset-fix.patch")
+ (search-patch "bitlbee-fix-tests.patch")))))
+ (build-system gnu-build-system)
+ (native-inputs `(("pkg-config" ,pkg-config)
+ ("check" ,check)))
+ (inputs `(("glib" ,glib)
+ ("libotr" ,libotr-3)
+ ("gnutls" ,gnutls)
+ ("zlib" ,zlib) ; Needed to satisfy "pkg-config --exists gnutls"
+ ("python" ,python-2)
+ ("perl" ,perl)))
+ (arguments
+ `(#:phases (alist-cons-after
+ 'install 'install-etc
+ (lambda* (#:key (make-flags '()) #:allow-other-keys)
+ (zero? (apply system* "make" "install-etc" make-flags)))
+ (alist-replace
+ 'configure
+ ;; bitlbee's configure script does not tolerate many of the
+ ;; variable settings that Guix would pass to it.
+ (lambda* (#:key outputs #:allow-other-keys)
+ (zero? (system* "./configure"
+ (string-append "--prefix="
+ (assoc-ref outputs "out"))
+ "--otr=1")))
+ %standard-phases))))
+ (synopsis "IRC to instant messaging gateway")
+ (description "BitlBee brings IM (instant messaging) to IRC clients, for
+people who have an IRC client running all the time and don't want to run an
+additional IM client. BitlBee currently supports XMPP/Jabber (including
+Google Talk), MSN Messenger, Yahoo! Messenger, AIM and ICQ, and the Twitter
+microblogging network (plus all other Twitter API compatible services like
+identi.ca and status.net).")
+ (home-page "http://www.bitlbee.org/")
+ (license (list gpl2+ bsd-2))))
+
+;;; messaging.scm ends here
diff --git a/gnu/packages/mpd.scm b/gnu/packages/mpd.scm
index b2c5dec15b..04b34eaf87 100644
--- a/gnu/packages/mpd.scm
+++ b/gnu/packages/mpd.scm
@@ -29,13 +29,15 @@
#:use-module (gnu packages glib)
#:use-module (gnu packages linux)
#:use-module (gnu packages mp3)
+ #:use-module (gnu packages ncurses)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages video)
#:use-module (gnu packages xiph)
#:export (libmpdclient
- mpd))
+ mpd
+ ncmpc))
(define libmpdclient
(package
@@ -121,3 +123,27 @@ can play a variety of sound files while being controlled by its network
protocol.")
(home-page "http://www.musicpd.org/")
(license license:gpl2)))
+
+(define ncmpc
+ (package
+ (name "ncmpc")
+ (version "0.21")
+ (source (origin
+ (method url-fetch)
+ (uri
+ (string-append "http://musicpd.org/download/ncmpc/"
+ (car (string-split version #\.))
+ "/ncmpc-" version ".tar.gz"))
+ (sha256
+ (base32
+ "1gpy6rr0awl6xgkswmr8rdvqfkrz83rmwk441c00a9d4z3zb1a16"))))
+ (build-system gnu-build-system)
+ (inputs `(("glib" ,glib)
+ ("libmpdclient" ,libmpdclient)
+ ("ncurses" ,ncurses)))
+ (native-inputs `(("pkg-config" ,pkg-config)))
+ (synopsis "A curses Music Player Daemon client")
+ (description "ncmpc is a fully featured MPD client, which runs in a
+terminal using ncurses.")
+ (home-page "http://www.musicpd.org/clients/ncmpc/")
+ (license license:gpl2)))
diff --git a/gnu/packages/patches/bitlbee-fix-tests.patch b/gnu/packages/patches/bitlbee-fix-tests.patch
new file mode 100644
index 0000000000..52bb6c605d
--- /dev/null
+++ b/gnu/packages/patches/bitlbee-fix-tests.patch
@@ -0,0 +1,33 @@
+Pass the correct number of arguments to 'nick_strip' and 'nick_ok' in tests.
+
+Patch by Mark H Weaver <mhw@netris.org>.
+
+--- bitlbee/tests/check_nick.c.orig 2013-11-27 17:54:54.000000000 -0500
++++ bitlbee/tests/check_nick.c 2014-03-05 23:41:45.761230468 -0500
+@@ -30,7 +30,7 @@ START_TEST(test_nick_strip)
+ for (i = 0; get[i]; i++) {
+ char copy[60];
+ strcpy(copy, get[i]);
+- nick_strip(copy);
++ nick_strip(NULL, copy);
+ fail_unless (strcmp(copy, expected[i]) == 0,
+ "(%d) nick_strip broken: %s -> %s (expected: %s)",
+ i, get[i], copy, expected[i]);
+@@ -45,7 +45,7 @@ START_TEST(test_nick_ok_ok)
+ int i;
+
+ for (i = 0; nicks[i]; i++) {
+- fail_unless (nick_ok(nicks[i]) == 1,
++ fail_unless (nick_ok(NULL, nicks[i]) == 1,
+ "nick_ok() failed: %s", nicks[i]);
+ }
+ }
+@@ -58,7 +58,7 @@ START_TEST(test_nick_ok_notok)
+ int i;
+
+ for (i = 0; nicks[i]; i++) {
+- fail_unless (nick_ok(nicks[i]) == 0,
++ fail_unless (nick_ok(NULL, nicks[i]) == 0,
+ "nick_ok() succeeded for invalid: %s", nicks[i]);
+ }
+ }
diff --git a/gnu/packages/patches/bitlbee-memset-fix.patch b/gnu/packages/patches/bitlbee-memset-fix.patch
new file mode 100644
index 0000000000..1d801e0070
--- /dev/null
+++ b/gnu/packages/patches/bitlbee-memset-fix.patch
@@ -0,0 +1,15 @@
+Fix the size argument to 'memset'.
+
+Patch by Mark H Weaver <mhw@netris.org>.
+
+--- bitlbee/lib/md5.c.orig 2013-11-27 17:54:54.000000000 -0500
++++ bitlbee/lib/md5.c 2014-03-05 21:39:04.739746093 -0500
+@@ -159,7 +159,7 @@ void md5_finish(struct MD5Context *ctx,
+ ctx->buf[2] = cvt32(ctx->buf[2]);
+ ctx->buf[3] = cvt32(ctx->buf[3]);
+ memcpy(digest, ctx->buf, 16);
+- memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */
++ memset(ctx, 0, sizeof(*ctx)); /* In case it's sensitive */
+ }
+
+ void md5_finish_ascii(struct MD5Context *context, char *ascii)
diff --git a/gnu/packages/patches/source-highlight-regexrange-test.patch b/gnu/packages/patches/source-highlight-regexrange-test.patch
new file mode 100644
index 0000000000..298c831b35
--- /dev/null
+++ b/gnu/packages/patches/source-highlight-regexrange-test.patch
@@ -0,0 +1,15 @@
+Disable a single check. The failure is discussed at:
+
+ https://savannah.gnu.org/bugs/index.php?41786
+
+--- a/lib/tests/test_regexranges_main.cpp 2012-04-14 08:58:25.000000000 -0500
++++ b/lib/tests/test_regexranges_main.cpp 2014-03-05 23:49:23.520402043 -0600
+@@ -52,7 +52,7 @@
+ check_range_regex("simple regex");
+ check_range_regex("[[:alpha:]]+");
+ // test with a wrong regular expression
+- check_range_regex("{notclosed", false);
++ // check_range_regex("{notclosed", false);
+
+ // reset regular expressions
+ ranges.clear();
diff --git a/gnu/packages/pretty-print.scm b/gnu/packages/pretty-print.scm
new file mode 100644
index 0000000000..0bfbeb7229
--- /dev/null
+++ b/gnu/packages/pretty-print.scm
@@ -0,0 +1,224 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages pretty-print)
+ #:use-module (guix packages)
+ #:use-module (guix licenses)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages ghostscript)
+ #:use-module (gnu packages groff)
+ #:use-module (gnu packages imagemagick)
+ #:use-module (gnu packages gv)
+ #:use-module (gnu packages boost)
+ #:use-module (gnu packages bison)
+ #:use-module (gnu packages flex)
+ #:use-module (gnu packages gperf)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages file))
+
+(define-public a2ps
+ (package
+ (name "a2ps")
+ (version "4.14")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/a2ps/a2ps-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "195k78m1h03m961qn7jr120z815iyb93gwi159p1p9348lyqvbpk"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("psutils" ,psutils)
+ ("groff" ,groff)
+ ("gv" ,gv)
+ ("imagemagick" ,imagemagick)))
+ (native-inputs
+ `(("gperf" ,gperf)
+ ("perl" ,perl)
+ ("file" ,file)))
+ (arguments
+ '(#:phases (alist-replace
+ 'configure
+ (lambda* (#:key #:allow-other-keys #:rest args)
+ (let ((configure (assoc-ref %standard-phases 'configure)))
+ (substitute* "configure"
+ (("/usr/bin/file") (which "file")))
+ (apply configure args)))
+ (alist-cons-before
+ 'build 'patch-scripts
+ (lambda _
+ (substitute*
+ '("afm/make_fonts_map.sh"
+ "tests/defs"
+ "tests/backup.tst"
+ "tests/styles.tst")
+ (("/bin/rm") (which "rm"))))
+ (alist-cons-before
+ 'check 'patch-test-files
+ ;; Alternatively, we could unpatch the shebangs in tstfiles
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((perl (assoc-ref inputs "perl")))
+ (substitute* '("tests/ps-ref/includeres.ps"
+ "tests/gps-ref/includeres.ps")
+ (("/usr/local/bin/perl")
+ (string-append perl "/bin/perl"))))
+ ;; Some of the reference postscript contain a 'version 3'
+ ;; string that in inconsistent with the source text in the
+ ;; tstfiles directory. Erroneous search-and-replace?
+ (substitute* '("tests/ps-ref/InsertBlock.ps"
+ "tests/gps-ref/InsertBlock.ps"
+ "tests/ps-ref/bookie.ps"
+ "tests/gps-ref/bookie.ps")
+ (("version 3") "version 2"))
+ (substitute* '("tests/ps-ref/psmandup.ps"
+ "tests/gps-ref/psmandup.ps")
+ (("#! */bin/sh") (string-append
+ "#!" (which "sh")))))
+ %standard-phases)))))
+ (home-page "http://www.gnu.org/software/a2ps")
+ (synopsis "Any file to PostScript, including pretty-printing")
+ (description
+ "GNU a2ps converts almost anything to a PostScript file, ready for
+printing. It accomplishes this by being able to delegate files to external
+handlers, such as Groff and Gzip. It handles as many steps as is necessary to
+produce a pretty-printed file. It also includes some extra abilities for
+special cases, such as pretty-printing \"--help\" output.")
+ (license gpl3+)))
+
+(define-public trueprint
+ (package
+ (name "trueprint")
+ (version "5.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/trueprint/trueprint-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "13rkc0fga10xyf56yy9dnq95zndnfadkhxflnp24skszj21y8jqh"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("file" ,file)))
+ (arguments
+ ;; Must define DIFF_CMD for tests to pass
+ '(#:configure-flags '("CPPFLAGS=-DDIFF_CMD=\\\"diff\\\"")
+ #:phases (alist-replace
+ 'configure
+ (lambda* (#:key #:allow-other-keys #:rest args)
+ (let ((configure (assoc-ref %standard-phases 'configure)))
+ (substitute* "configure"
+ (("/usr/bin/file") (which "file")))
+ (apply configure args)))
+ %standard-phases)))
+ (home-page "http://www.gnu.org/software/trueprint")
+ (synopsis "Pretty-print C sources and other plain text to PostScript")
+ (description
+ "GNU Trueprint translates C source code files as PostScript files.
+In addition to the basic source code output, it can also perform diff-marking,
+indentation counting, function and file indices and more.")
+ (license gpl2)))
+
+(define-public enscript
+ (package
+ (name "enscript")
+ (version "1.6.6")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/enscript/enscript-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1fy0ymvzrrvs889zanxcaxjfcxarm2d3k43c9frmbl1ld7dblmkd"))))
+ (build-system gnu-build-system)
+ (home-page "http://www.gnu.org/software/enscript")
+ (synopsis "Generating PostScript, including pretty-printing")
+ (description
+ "GNU Enscript is a program to convert ASCII text files to PostScript,
+HTML or RTF formats, to be stored in files or sent immediately to a printer.
+It also includes the capability to perform syntax highlighting for several
+different programming languages.")
+ (license gpl3+)))
+
+(define-public source-highlight
+ (package
+ (name "source-highlight")
+ (version "3.1.7")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/src-highlite/source-highlight-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1s49ld8cnpzhhwq0r7s0sfm3cg3nhhm0wla27lwraifrrl3y1cp1"))
+ (patches
+ (list (search-patch
+ ;; Patch submitted as Savannah item #41786
+ "source-highlight-regexrange-test.patch")))))
+ (build-system gnu-build-system)
+ ;; The ctags that comes with emacs does not support the --excmd options,
+ ;; so can't be used
+ (inputs
+ `(("boost" ,boost)))
+ (native-inputs
+ `(("bison" ,bison)
+ ("flex" ,flex)
+ ("file" ,file)))
+ (arguments
+ `(#:configure-flags
+ (list (string-append "--with-boost="
+ (assoc-ref %build-inputs "boost")))
+ #:parallel-tests? #f ;There appear to be race conditions
+ #:phases (alist-replace
+ 'configure
+ (lambda* (#:key #:allow-other-keys #:rest args)
+ (let ((configure (assoc-ref %standard-phases 'configure)))
+ (substitute* "configure"
+ (("/usr/bin/file") (which "file")))
+ (apply configure args)))
+ (alist-cons-before
+ 'check 'patch-test-files
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Unpatch shebangs in test input so that source-highlight
+ ;; is still able to infer input language
+ (substitute* '("tests/test.sh"
+ "tests/test2.sh"
+ "tests/test.tcl")
+ (((string-append "#! *" (which "sh"))) "#!/bin/sh"))
+ ;; Initial patching unrecoverably removes whitespace, so
+ ;; remove it also in the comparison output.
+ (substitute* '("tests/test.sh.html"
+ "tests/test2.sh.html"
+ "tests/test.tcl.html")
+ (("#! */bin/sh") "#!/bin/sh")))
+ %standard-phases))))
+ (home-page "http://www.gnu.org/software/src-highlite")
+ (synopsis "Produce a document with syntax highlighting from a source file")
+ (description
+ "GNU source-highlight reads in a source code file and produces an output
+file in which the keywords are highlighted in different colors to designate
+their syntactic role. It supports over 150 different languages and it can
+output to 8 different formats, including HTML, LaTeX and ODF. It can also
+output to ANSI color escape sequences, so that highlighted source code can be
+seen in a terminal.")
+ (license gpl3+)))
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index 44e3c14aa2..ad1ac5c8f7 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -20,7 +20,8 @@
(define-module (gnu packages python)
#:use-module ((guix licenses)
- #:select (bsd-3 bsd-style psfl x11 gpl2+ lgpl2.1+))
+ #:select (bsd-3 bsd-style psfl x11 x11-style
+ gpl2 gpl2+ lgpl2.1+))
#:use-module ((guix licenses) #:select (zlib)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (gnu packages)
@@ -505,6 +506,55 @@ system is highly configurable via command line options and embedded
commands.")
(license lgpl2.1+)))
+(define-public python2-element-tree
+ (package
+ (name "python2-element-tree")
+ (version "1.2.6")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "http://effbot.org/media/downloads/elementtree-"
+ version "-20050316.tar.gz"))
+ (sha256
+ (base32
+ "016bphqnlg0l4vslahhw4r0aanw95bpypy65r1i1acyb2wj5z7dj"))))
+ (build-system python-build-system)
+ (arguments
+ `(#:python ,python-2 ; seems to be part of Python 3
+ #:tests? #f)) ; no 'test' sub-command
+ (synopsis "Toolkit for XML processing in Python")
+ (description
+ "ElementTree is a Python library supporting lightweight XML processing.")
+ (home-page "http://effbot.org/zone/element-index.htm")
+ (license (x11-style "http://docs.python.org/2/license.html"
+ "Like \"CWI LICENSE AGREEMENT FOR PYTHON \
+0.9.0 THROUGH 1.2\"."))))
+
+(define-public python2-pybugz
+ (package
+ (name "python2-pybugz")
+ (version "0.6.11")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "http://bits.liquidx.net/projects/pybugz/pybugz-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "17ni00p08gp5lkxlrrcnvi3x09fmajnlbz4da03qcgl9q21ym4jd"))))
+ (build-system python-build-system)
+ (arguments
+ `(#:python ,python-2 ; SyntaxError with Python 3
+ #:tests? #f)) ; no 'test' sub-command
+ (inputs `(("element-tree" ,python2-element-tree)))
+ (synopsis "Python and command-line interface to Bugzilla")
+ (description
+ "PyBugz is a Python library and command-line tool to query the Bugzilla
+bug tracking system. It is meant as an aid to speed up interaction with the
+bug tracker.")
+ (home-page "http://www.liquidx.net/pybugz/")
+ (license gpl2)))
+
(define-public scons
(package
(name "scons")
diff --git a/gnu/packages/rdf.scm b/gnu/packages/rdf.scm
index 1f2bc7932d..22cfc2e257 100644
--- a/gnu/packages/rdf.scm
+++ b/gnu/packages/rdf.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,6 +45,8 @@
("libxml2" ,libxml2)
("libxslt" ,libxslt)
("zlib" ,zlib)))
+ (arguments
+ `(#:parallel-tests? #f))
(home-page "http://librdf.org/raptor/")
(synopsis "RDF syntax library")
(description "Raptor is a C library providing a set of parsers and
@@ -76,11 +78,12 @@ HTML and JSON.")
(base32
"08gb5d8bgy7vc6qd6r1kkmmc5rli67dlglpjqjlahpnvs26r1cwl"))))
(build-system cmake-build-system)
- ;; FIXME: Add optional dependencies: Raptor, Redland, odbci, clucene; doxygen
- (inputs
- `(("qt" ,qt-4)))
+ ;; FIXME: Add optional dependencies: Redland, odbci, clucene; doxygen
(native-inputs
`(("pkg-config" ,pkg-config)))
+ (inputs
+ `(("qt" ,qt-4)
+ ("raptor2" ,raptor2)))
(home-page "http://soprano.sourceforge.net/")
(synopsis "RDF data library for Qt")
(description "Soprano (formerly known as QRDF) is a library which
diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm
index 41ceeb6cef..6bf68a916e 100644
--- a/gnu/packages/ssh.scm
+++ b/gnu/packages/ssh.scm
@@ -27,6 +27,7 @@
#:use-module (gnu packages guile)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages autotools)
+ #:use-module (gnu packages texinfo)
#:use-module (gnu packages which)
#:use-module (guix packages)
#:use-module (guix download)
@@ -185,7 +186,7 @@ Additionally, various channel-specific options can be negotiated.")
(define-public guile-ssh
(package
(name "guile-ssh")
- (version "0.4.0")
+ (version "0.5.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -193,13 +194,13 @@ Additionally, various channel-specific options can be negotiated.")
version ".tar.gz"))
(sha256
(base32
- "0vw02r261amkp6238cflww2y9y1v6vfx9ias6hvn8dlx0ghrd5dw"))))
+ "13wk2fj08b8zjylvf78l3d9pf8y3zqcd7h75jf15a46iprk00n7q"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'configure 'autoreconf
(lambda* (#:key inputs #:allow-other-keys)
- (substitute* "src/Makefile.am"
+ (substitute* "ssh/Makefile.am"
(("-lssh_threads" match)
(string-append "-L" (assoc-ref inputs "libssh")
"/lib " match)))
@@ -223,10 +224,17 @@ Additionally, various channel-specific options can be negotiated.")
%standard-phases))
#:configure-flags (list (string-append "--with-guilesitedir="
(assoc-ref %outputs "out")
- "/share/guile/site/2.0"))))
+ "/share/guile/site/2.0"))
+
+ ;; Two client/server tests use the same port.
+ #:parallel-tests? #f
+
+ ;; XXX: There are test failures reported and being fixed.
+ #:tests? #f))
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool "bin")
+ ("texinfo" ,texinfo)
("pkg-config" ,pkg-config)
("which" ,which)))
(inputs `(("guile" ,guile-2.0)
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 3d69eee5cd..41df90b8a7 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -2,7 +2,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,13 +26,15 @@
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix build utils)
- #:use-module (gnu packages gettext)
#:use-module (gnu packages apr)
#:use-module (gnu packages curl)
#:use-module (gnu packages ed)
+ #:use-module (gnu packages gettext)
+;; #:use-module (gnu packages gnutls)
#:use-module (gnu packages nano)
#:use-module (gnu packages openssl)
#:use-module (gnu packages perl)
+ #:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages admin)
@@ -216,17 +218,77 @@ It efficiently handles projects of any size
and offers an easy and intuitive interface.")
(license gpl2+)))
+(define-public neon
+ (package
+ (name "neon")
+ (version "0.30.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://www.webdav.org/neon/neon-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1hlhg5w505jxdvaf7bq17057f6a48dry981g7lp2gwrhbp5wyqi9"))))
+ (build-system gnu-build-system)
+ (native-inputs
+ `(("perl" ,perl)
+ ("pkg-config" ,pkg-config)))
+ (inputs
+ `(("libxml2" ,libxml2)
+ ("openssl" ,openssl)
+ ("zlib" ,zlib)))
+ (arguments
+ `(;; FIXME: Add tests once reverse address lookup is fixed in glibc, see
+ ;; https://sourceware.org/bugzilla/show_bug.cgi?id=16475
+ #:tests? #f
+ #:configure-flags '("--enable-shared"
+ ;; requires libgnutils-config, deprecated
+ ;; in gnutls 2.8.
+ ; "--with-ssl=gnutls")))
+ "--with-ssl=openssl")))
+ (home-page "http://www.webdav.org/neon/")
+ (synopsis "HTTP and WebDAV client library")
+ (description "Neon is an HTTP and WebDAV client library, with a
+C interface. Features:
+High-level wrappers for common HTTP and WebDAV operations (GET, MOVE,
+DELETE, etc.);
+low-level interface to the HTTP request/response engine, allowing the use
+of arbitrary HTTP methods, headers, etc.;
+authentication support including Basic and Digest support, along with
+GSSAPI-based Negotiate on Unix, and SSPI-based Negotiate/NTLM on Win32;
+SSL/TLS support using OpenSSL or GnuTLS, exposing an abstraction layer for
+verifying server certificates, handling client certificates, and examining
+certificate properties, smartcard-based client certificates are also
+supported via a PKCS#11 wrapper interface;
+abstract interface to parsing XML using libxml2 or expat, and wrappers for
+simplifying handling XML HTTP response bodies;
+WebDAV metadata support, wrappers for PROPFIND and PROPPATCH to simplify
+property manipulation.")
+ (license gpl2+))) ; for documentation and tests; source under lgpl2.0+
+
+(define-public neon-0.29.6
+ (package (inherit neon)
+ (name "neon")
+ (version "0.29.6")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://www.webdav.org/neon/neon-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0hzbjqdx1z8zw0vmbknf159wjsxbcq8ii0wgwkqhxj3dimr0nr4w"))))))
+
(define-public subversion
(package
(name "subversion")
- (version "1.7.8")
+ (version "1.7.14")
(source (origin
(method url-fetch)
(uri (string-append "http://archive.apache.org/dist/subversion/subversion-"
version ".tar.bz2"))
(sha256
(base32
- "11inl9n1riahfnbk1fax0dysm2swakzhzhpmm2zvga6fikcx90zw"))))
+ "038jbcpwm083abp0rvk0fhnx65kp9mz1qvzs3f83ig8fxcvqzb64"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
@@ -250,11 +312,13 @@ and offers an easy and intuitive interface.")
(system* "make" "install")))))))
%standard-phases)))
(native-inputs
- ;; For the Perl bindings.
- `(("swig" ,swig)))
+ `(("pkg-config" ,pkg-config)
+ ;; For the Perl bindings.
+ ("swig" ,swig)))
(inputs
`(("apr" ,apr)
("apr-util" ,apr-util)
+ ("neon" ,neon-0.29.6)
("perl" ,perl)
("python" ,python-2) ; incompatible with Python 3 (print syntax)
("sqlite" ,sqlite)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b8b0274f1f..b6a777353f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -383,7 +383,13 @@ such as /etc files."
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
"/dev/sda"))
- (zero? (system* umount "/fs"))
+ (begin
+ (when (file-exists? "/fs/dev/pts")
+ ;; Unmount devpts so /fs itself can be
+ ;; unmounted (failing to do that leads to
+ ;; EBUSY.)
+ (system* umount "/fs/dev/pts"))
+ (zero? (system* umount "/fs")))
(reboot))))))))
#:system system
#:inputs `(("parted" ,parted)
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 80ce679496..9a8ea0ed4f 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -114,6 +114,14 @@
(device-number 4 n))
(loop (+ 1 n)))))
+ ;; Pseudo ttys.
+ (mknod (scope "dev/ptmx") 'char-special #o666
+ (device-number 5 2))
+
+ (unless (file-exists? (scope "dev/pts"))
+ (mkdir (scope "dev/pts")))
+ (mount "none" (scope "dev/pts") "devpts")
+
;; Rendez-vous point for syslogd.
(mknod (scope "dev/log") 'socket #o666 0)
(mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11))
diff --git a/guix/config.scm.in b/guix/config.scm.in
index 5edb4ced30..eaadae9618 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -57,7 +57,7 @@
(define %state-directory
;; This must match `NIX_STATE_DIR' as defined in `daemon.am'.
- (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/nix"))
+ (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
(define %config-directory
;; This must match `NIX_CONF_DIR' as defined in `daemon.am'.
diff --git a/guix/download.scm b/guix/download.scm
index 2cc8a4a5b8..0889928d3a 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -242,7 +242,11 @@ must be a list of symbol/URL-list pairs."
(guix build utils)
(guix ftp-client))
#:guile-for-build guile-for-build
- #:env-vars env-vars)))
+ #:env-vars env-vars
+
+ ;; In general, offloading downloads is not a
+ ;; good idea.
+ #:local-build? #t)))
(define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port)))
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 472bf756ce..5e0a6a21dc 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -84,6 +84,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if
#:recursive? #t
#:modules '((guix build git)
(guix build utils))
- #:guile-for-build guile-for-build)))
+ #:guile-for-build guile-for-build
+ #:local-build? #t)))
;;; git-download.scm ends here
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 98432a69ce..14195da7ba 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
@@ -275,6 +275,10 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(define contains-digit?
(cut string-any char-set:digit <>))
+ (define patch-directory-name?
+ ;; Return #t for patch directory names such as 'bash-4.2-patches'.
+ (cut string-suffix? "patches" <>))
+
(let-values (((server directory) (ftp-server/directory project)))
(define conn (ftp-open server))
@@ -284,6 +288,9 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
;; Filter out sub-directories that do not contain digits---e.g.,
;; /gnuzilla/lang and /gnupg/patches.
(subdirs (filter-map (match-lambda
+ (((? patch-directory-name? dir)
+ 'directory . _)
+ #f)
(((? contains-digit? dir) 'directory . _)
dir)
(_ #f))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 11231cbc1e..1f05df4b05 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Guix.
@@ -23,19 +23,36 @@
#:use-module (web client)
#:use-module (web response)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (guix ui)
#:use-module (guix utils)
- #:export (open-socket-for-uri
+ #:export (&http-get-error
+ http-get-error?
+ http-get-error-uri
+ http-get-error-code
+ http-get-error-reason
+
+ open-socket-for-uri
http-fetch))
;;; Commentary:
;;;
-;;; HTTP client portable among Guile versions.
+;;; HTTP client portable among Guile versions, and with proper error condition
+;;; reporting.
;;;
;;; Code:
+;; HTTP GET error.
+(define-condition-type &http-get-error &error
+ http-get-error?
+ (uri http-get-error-uri) ; URI
+ (code http-get-error-code) ; integer
+ (reason http-get-error-reason)) ; string
+
+
(define-syntax when-guile<=2.0.5
(lambda (s)
(syntax-case s ()
@@ -154,7 +171,9 @@ unbuffered."
"Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be
textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
-unbuffered port, suitable for use in `filtered-port'."
+unbuffered port, suitable for use in `filtered-port'.
+
+Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri uri))
(let ((port (or port
(open-socket-for-uri uri
@@ -202,7 +221,11 @@ unbuffered port, suitable for use in `filtered-port'."
(uri->string uri))
(loop uri)))
(else
- (error "download failed" uri code
- (response-reason-phrase resp))))))))
+ (raise (condition (&http-get-error
+ (uri uri)
+ (code code)
+ (reason (response-reason-phrase resp)))
+ (&message
+ (message "download failed"))))))))))
;;; http-client.scm ends here
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 4788468584..8280a821c5 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -64,6 +64,9 @@ Export/import one or more packages from/to the store.\n"))
--generate-key[=PARAMETERS]
generate a key pair with the given parameters"))
(display (_ "
+ --authorize authorize imports signed by the public key on stdin"))
+ (newline)
+ (display (_ "
-e, --expression=EXPR build the package or derivation EXPR evaluates to"))
(display (_ "
-S, --source build the packages' source derivations"))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 4a00505022..618015e9ba 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -127,6 +127,8 @@ options handled by 'set-build-options-from-command-line', and listed in
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
(display (_ "
+ --timeout=SECONDS mark the build as failed after SECONDS of activity"))
+ (display (_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
(display (_ "
-c, --cores=N allow the use of up to N CPU cores for the build")))
@@ -142,39 +144,57 @@ options handled by 'set-build-options-from-command-line', and listed in
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:use-build-hook? (assoc-ref opts 'build-hook?)
#:max-silent-time (assoc-ref opts 'max-silent-time)
+ #:timeout (assoc-ref opts 'timeout)
#:verbosity (assoc-ref opts 'verbosity)))
(define %standard-build-options
;; List of standard command-line options for tools that build something.
(list (option '(#\K "keep-failed") #f #f
- (lambda (opt name arg result)
- (alist-cons 'keep-failed? #t result)))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'keep-failed? #t result)
+ rest)))
(option '("fallback") #f #f
- (lambda (opt name arg result)
- (alist-cons 'fallback? #t
- (alist-delete 'fallback? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'fallback? #t
+ (alist-delete 'fallback? result))
+ rest)))
(option '("no-substitutes") #f #f
- (lambda (opt name arg result)
- (alist-cons 'substitutes? #f
- (alist-delete 'substitutes? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'substitutes? #f
+ (alist-delete 'substitutes? result))
+ rest)))
(option '("no-build-hook") #f #f
- (lambda (opt name arg result)
- (alist-cons 'build-hook? #f
- (alist-delete 'build-hook? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'build-hook? #f
+ (alist-delete 'build-hook? result))
+ rest)))
(option '("max-silent-time") #t #f
- (lambda (opt name arg result)
- (alist-cons 'max-silent-time (string->number* arg)
- result)))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'max-silent-time (string->number* arg)
+ result)
+ rest)))
+ (option '("timeout") #t #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'timeout (string->number* arg) result)
+ rest)))
(option '("verbosity") #t #f
- (lambda (opt name arg result)
+ (lambda (opt name arg result . rest)
(let ((level (string->number arg)))
- (alist-cons 'verbosity level
- (alist-delete 'verbosity result)))))
+ (apply values
+ (alist-cons 'verbosity level
+ (alist-delete 'verbosity result))
+ rest))))
(option '(#\c "cores") #t #f
- (lambda (opt name arg result)
+ (lambda (opt name arg result . rest)
(let ((c (false-if-exception (string->number arg))))
(if c
- (alist-cons 'cores c result)
+ (apply values (alist-cons 'cores c result) rest)
(leave (_ "~a: not a number~%") arg)))))))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 00a145e5e9..4d2f78f711 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -23,7 +23,7 @@
#:use-module (guix derivations)
#:use-module (guix nar)
#:use-module (guix utils)
- #:use-module ((guix build utils) #:select (which))
+ #:use-module ((guix build utils) #:select (which mkdir-p))
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -122,38 +122,40 @@ determined."
(leave (_ "failed to load machine file '~a': ~s~%")
file args))))))
-(define (open-ssh-gateway machine)
- "Initiate an SSH connection gateway to MACHINE, and return the PID of the
-running lsh gateway upon success, or #f on failure."
- (catch 'system-error
- (lambda ()
- (let* ((port (open-pipe* OPEN_READ %lsh-command
- "-l" (build-machine-user machine)
- "-i" (build-machine-private-key machine)
- ;; XXX: With lsh 2.1, passing '--write-pid'
- ;; last causes the PID not to be printed.
- "--write-pid" "--gateway" "--background" "-z"
- (build-machine-name machine)))
- (line (read-line port))
- (status (close-pipe port)))
- (if (zero? status)
- (let ((pid (string->number line)))
- (if (integer? pid)
- pid
- (begin
- (warning (_ "'~a' did not write its PID on stdout: ~s~%")
- %lsh-command line)
- #f)))
- (begin
- (warning (_ "failed to initiate SSH connection to '~a':\
- '~a' exited with ~a~%")
- (build-machine-name machine)
- %lsh-command
- (status:exit-val status))
- #f))))
- (lambda args
- (leave (_ "failed to execute '~a': ~a~%")
- %lsh-command (strerror (system-error-errno args))))))
+;;; FIXME: The idea was to open the connection to MACHINE once for all, but
+;;; lshg is currently non-functional.
+;; (define (open-ssh-gateway machine)
+;; "Initiate an SSH connection gateway to MACHINE, and return the PID of the
+;; running lsh gateway upon success, or #f on failure."
+;; (catch 'system-error
+;; (lambda ()
+;; (let* ((port (open-pipe* OPEN_READ %lsh-command
+;; "-l" (build-machine-user machine)
+;; "-i" (build-machine-private-key machine)
+;; ;; XXX: With lsh 2.1, passing '--write-pid'
+;; ;; last causes the PID not to be printed.
+;; "--write-pid" "--gateway" "--background" "-z"
+;; (build-machine-name machine)))
+;; (line (read-line port))
+;; (status (close-pipe port)))
+;; (if (zero? status)
+;; (let ((pid (string->number line)))
+;; (if (integer? pid)
+;; pid
+;; (begin
+;; (warning (_ "'~a' did not write its PID on stdout: ~s~%")
+;; %lsh-command line)
+;; #f)))
+;; (begin
+;; (warning (_ "failed to initiate SSH connection to '~a':\
+;; '~a' exited with ~a~%")
+;; (build-machine-name machine)
+;; %lsh-command
+;; (status:exit-val status))
+;; #f))))
+;; (lambda args
+;; (leave (_ "failed to execute '~a': ~a~%")
+;; %lsh-command (strerror (system-error-errno args))))))
(define (remote-pipe machine mode command)
"Run COMMAND on MACHINE, assuming an lsh gateway has been set up."
@@ -161,6 +163,10 @@ running lsh gateway upon success, or #f on failure."
(lambda ()
(apply open-pipe* mode %lshg-command
"-l" (build-machine-user machine) "-z"
+
+ ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg.
+ "-i" (build-machine-private-key machine)
+
(build-machine-name machine)
command))
(lambda args
@@ -168,9 +174,89 @@ running lsh gateway upon success, or #f on failure."
%lshg-command (strerror (system-error-errno args)))
#f)))
+
+;;;
+;;; Synchronization.
+;;;
+
+(define (lock-file file)
+ "Wait and acquire an exclusive lock on FILE. Return an open port."
+ (mkdir-p (dirname file))
+ (let ((port (open-file file "w0")))
+ (fcntl-flock port 'write-lock)
+ port))
+
+(define (unlock-file lock)
+ "Unlock LOCK."
+ (fcntl-flock lock 'unlock)
+ (close-port lock)
+ #t)
+
+(define-syntax-rule (with-file-lock file exp ...)
+ "Wait to acquire a lock on FILE and evaluate EXP in that context."
+ (let ((port (lock-file file)))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ exp ...)
+ (lambda ()
+ (unlock-file port)))))
+
+(define-syntax-rule (with-machine-lock machine hint exp ...)
+ "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that
+context."
+ (with-file-lock (machine-lock-file machine hint)
+ exp ...))
+
+
+(define (machine-slot-file machine slot)
+ "Return the file name of MACHINE's file for SLOT."
+ ;; For each machine we have a bunch of files representing each build slot.
+ ;; When choosing a build machine, we attempt to get an exclusive lock on one
+ ;; of these; if we fail, that means all the build slots are already taken.
+ ;; Inspired by Nix's build-remote.pl.
+ (string-append (string-append %state-directory "/offload/"
+ (build-machine-name machine)
+ "/" (number->string slot))))
+
+(define (acquire-build-slot machine)
+ "Attempt to acquire a build slot on MACHINE. Return the port representing
+the slot, or #f if none is available.
+
+This mechanism allows us to set a hard limit on the number of simultaneous
+connections allowed to MACHINE."
+ (mkdir-p (dirname (machine-slot-file machine 0)))
+ (with-machine-lock machine 'slots
+ (any (lambda (slot)
+ (let ((port (open-file (machine-slot-file machine slot)
+ "w0")))
+ (catch 'flock-error
+ (lambda ()
+ (fcntl-flock port 'write-lock #:wait? #f)
+ ;; Got it!
+ (format (current-error-port)
+ "process ~a acquired build slot '~a'~%"
+ (getpid) (port-filename port))
+ port)
+ (lambda args
+ ;; PORT is already locked by another process.
+ (close-port port)
+ #f))))
+ (iota (build-machine-parallel-builds machine)))))
+
+(define (release-build-slot slot)
+ "Release SLOT, a build slot as returned as by 'acquire-build-slot'."
+ (close-port slot))
+
+
+;;;
+;;; Offloading.
+;;;
+
(define* (offload drv machine
#:key print-build-trace? (max-silent-time 3600)
- (build-timeout 7200) (log-port (current-output-port)))
+ build-timeout (log-port (current-output-port)))
"Perform DRV on MACHINE, assuming DRV and its prerequisites are available
there, and write the build log to LOG-PORT. Return the exit status."
(format (current-error-port) "offloading '~a' to '~a'...~%"
@@ -181,9 +267,12 @@ there, and write the build log to LOG-PORT. Return the exit status."
;; FIXME: Protect DRV from garbage collection on MACHINE.
(let ((pipe (remote-pipe machine OPEN_READ
`("guix" "build"
- ;; FIXME: more options
,(format #f "--max-silent-time=~a"
max-silent-time)
+ ,@(if build-timeout
+ (list (format #f "--timeout=~a"
+ build-timeout))
+ '())
,(derivation-file-name drv)))))
(let loop ((line (read-line pipe)))
(unless (eof-object? line)
@@ -193,6 +282,43 @@ there, and write the build log to LOG-PORT. Return the exit status."
(close-pipe pipe)))
+(define* (transfer-and-offload drv machine
+ #:key
+ (inputs '())
+ (outputs '())
+ (max-silent-time 3600)
+ build-timeout
+ print-build-trace?)
+ "Offload DRV to MACHINE. Prior to the actual offloading, transfer all of
+INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from
+MACHINE."
+ ;; Acquire MACHINE's exclusive lock to serialize file transfers
+ ;; to/from MACHINE in the presence of several 'offload' hook
+ ;; instance.
+ (when (with-machine-lock machine 'bandwidth
+ (send-files (cons (derivation-file-name drv) inputs)
+ machine))
+ (let ((status (offload drv machine
+ #:print-build-trace? print-build-trace?
+ #:max-silent-time max-silent-time
+ #:build-timeout build-timeout)))
+ (if (zero? status)
+ (begin
+ ;; Likewise (see above.)
+ (with-machine-lock machine 'bandwidth
+ (retrieve-files outputs machine))
+ (format (current-error-port)
+ "done with offloaded '~a'~%"
+ (derivation-file-name drv)))
+ (begin
+ (format (current-error-port)
+ "derivation '~a' offloaded to '~a' failed \
+with exit code ~a~%"
+ (derivation-file-name drv)
+ (build-machine-name machine)
+ (status:exit-val status))
+ (primitive-exit (status:exit-val status)))))))
+
(define (send-files files machine)
"Send the subset of FILES that's missing to MACHINE's store. Return #t on
success, #f otherwise."
@@ -256,6 +382,11 @@ success, #f otherwise."
(zero? (close-pipe pipe)))))))
+
+;;;
+;;; Scheduling.
+;;;
+
(define (machine-matches? machine requirements)
"Return #t if MACHINE matches REQUIREMENTS."
(and (string=? (build-requirements-system requirements)
@@ -268,57 +399,124 @@ success, #f otherwise."
"Return #t if M1 is faster than M2."
(> (build-machine-speed m1) (build-machine-speed m2)))
-(define (choose-build-machine requirements machines)
- "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
- ;; FIXME: Take machine load into account, and/or shuffle MACHINES.
- (let ((machines (sort (filter (cut machine-matches? <> requirements)
- machines)
- machine-faster?)))
- (match machines
- ((head . _)
- head)
- (_ #f))))
+(define (machine-load machine)
+ "Return the load of MACHINE, divided by the number of parallel builds
+allowed on MACHINE."
+ (let* ((pipe (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
+ (line (read-line pipe)))
+ (close-pipe pipe)
+ (if (eof-object? line)
+ 1.
+ (match (string-tokenize line)
+ ((one five fifteen . _)
+ (let* ((raw (string->number five))
+ (jobs (build-machine-parallel-builds machine))
+ (normalized (/ raw jobs)))
+ (format (current-error-port) "load on machine '~a' is ~s\
+ (normalized: ~s)~%"
+ (build-machine-name machine) raw normalized)
+ normalized))
+ (_
+ 1.)))))
+
+(define (machine-less-loaded? m1 m2)
+ "Return #t if the load on M1 is lower than that on M2."
+ (< (machine-load m1) (machine-load m2)))
+
+(define (machine-less-loaded-or-faster? m1 m2)
+ "Return #t if M1 is either less loaded or faster than M2."
+ (or (machine-less-loaded? m1 m2)
+ (machine-faster? m1 m2)))
+
+(define (machine-lock-file machine hint)
+ "Return the name of MACHINE's lock file for HINT."
+ (string-append %state-directory "/offload/"
+ (build-machine-name machine)
+ "." (symbol->string hint) ".lock"))
+
+(define (machine-choice-lock-file)
+ "Return the name of the file used as a lock when choosing a build machine."
+ (string-append %state-directory "/offload/machine-choice.lock"))
+
+
+(define %slots
+ ;; List of acquired build slots (open ports).
+ '())
+
+(define (choose-build-machine machines)
+ "Return the best machine among MACHINES, or #f."
+
+ ;; Proceed like this:
+ ;; 1. Acquire the global machine-choice lock.
+ ;; 2. For all MACHINES, attempt to acquire a build slot, and filter out
+ ;; those machines for which we failed.
+ ;; 3. Choose the best machine among those that are left.
+ ;; 4. Release the previously-acquired build slots of the other machines.
+ ;; 5. Release the global machine-choice lock.
+
+ (with-file-lock (machine-choice-lock-file)
+ (define machines+slots
+ (filter-map (lambda (machine)
+ (let ((slot (acquire-build-slot machine)))
+ (and slot (list machine slot))))
+ machines))
+
+ (define (undecorate pred)
+ (match-lambda
+ ((machine slot)
+ (and (pred machine)
+ (list machine slot)))))
+
+ (let ((machines+slots (sort machines+slots
+ (undecorate machine-less-loaded-or-faster?))))
+ (match machines+slots
+ (((best slot) (others slots) ...)
+ ;; Release slots from the uninteresting machines.
+ (for-each release-build-slot slots)
+
+ ;; Return the best machine unless it's already overloaded.
+ (if (< (machine-load best) 2.)
+ (begin
+ ;; Prevent SLOT from being GC'd.
+ (set! %slots (cons slot %slots))
+ best)
+ (begin
+ (release-build-slot slot)
+ #f)))
+ (() #f)))))
(define* (process-request wants-local? system drv features
#:key
print-build-trace? (max-silent-time 3600)
- (build-timeout 7200))
+ build-timeout)
"Process a request to build DRV."
- (let* ((local? (and wants-local? (string=? system (%current-system))))
- (reqs (build-requirements
- (system system)
- (features features)))
- (machine (choose-build-machine reqs (build-machines))))
- (if machine
- (match (open-ssh-gateway machine)
- ((? integer? pid)
- (display "# accept\n")
- (let ((inputs (string-tokenize (read-line)))
- (outputs (string-tokenize (read-line))))
- (when (send-files (cons (derivation-file-name drv) inputs)
- machine)
- (let ((status (offload drv machine
- #:print-build-trace? print-build-trace?
- #:max-silent-time max-silent-time
- #:build-timeout build-timeout)))
- (kill pid SIGTERM)
- (if (zero? status)
- (begin
- (retrieve-files outputs machine)
- (format (current-error-port)
- "done with offloaded '~a'~%"
- (derivation-file-name drv)))
- (begin
- (format (current-error-port)
- "derivation '~a' offloaded to '~a' failed \
-with exit code ~a~%"
- (derivation-file-name drv)
- (build-machine-name machine)
- (status:exit-val status))
- (primitive-exit (status:exit-val status))))))))
- (#f
- (display "# decline\n")))
- (display "# decline\n"))))
+ (let* ((local? (and wants-local? (string=? system (%current-system))))
+ (reqs (build-requirements
+ (system system)
+ (features features)))
+ (candidates (filter (cut machine-matches? <> reqs)
+ (build-machines))))
+ (match candidates
+ (()
+ ;; We'll never be able to match REQS.
+ (display "# decline\n"))
+ ((_ ...)
+ (let ((machine (choose-build-machine candidates)))
+ (if machine
+ (begin
+ ;; Offload DRV to MACHINE.
+ (display "# accept\n")
+ (let ((inputs (string-tokenize (read-line)))
+ (outputs (string-tokenize (read-line))))
+ (transfer-and-offload drv machine
+ #:inputs inputs
+ #:outputs outputs
+ #:max-silent-time max-silent-time
+ #:build-timeout build-timeout
+ #:print-build-trace? print-build-trace?)))
+
+ ;; Not now, all the machines are busy.
+ (display "# postpone\n")))))))
(define-syntax-rule (with-nar-error-handling body ...)
"Execute BODY with any &nar-error suitably reported to the user."
@@ -388,4 +586,9 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
(x
(leave (_ "invalid arguments: ~{~s ~}~%") x))))
+;;; Local Variables:
+;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
+;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
+;;; End:
+
;;; offload.scm ends here
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d41a83de8a..6069b203de 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
#:use-module (guix profiles)
#:use-module (guix utils)
#:use-module (guix config)
+ #:use-module (guix scripts build)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
#:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 format)
@@ -460,6 +461,7 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
;; Alist of default option values.
`((profile . ,%current-profile)
(max-silent-time . 3600)
+ (verbosity . 0)
(substitutes? . #t)))
(define (show-help)
@@ -484,18 +486,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(display (_ "
-d, --delete-generations[=PATTERN]
delete generations matching PATTERN"))
- (newline)
(display (_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
- (display (_ "
- -n, --dry-run show what would be done without actually doing it"))
- (display (_ "
- --fallback fall back to building when the substituter fails"))
- (display (_ "
- --no-substitutes build instead of resorting to pre-built substitutes"))
- (display (_ "
- --max-silent-time=SECONDS
- mark the build as failed after SECONDS of silence"))
+ (newline)
(display (_ "
--bootstrap use the bootstrap Guile to build the profile"))
(display (_ "
@@ -510,6 +503,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
-A, --list-available[=REGEXP]
list available packages matching REGEXP"))
(newline)
+ (show-build-options-help)
+ (newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
@@ -519,107 +514,94 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define %options
;; Specification of the command-line options.
- (list (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix package")))
-
- (option '(#\i "install") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (if arg
- (alist-cons 'install arg result)
- result)
- arg-handler))))
- (option '(#\e "install-from-expression") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'install (read/eval-package-expression arg)
- result)
- #f)))
- (option '(#\r "remove") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (if arg
- (alist-cons 'remove arg result)
- result)
- arg-handler))))
- (option '(#\u "upgrade") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (alist-cons 'upgrade arg
- ;; Delete any prior "upgrade all"
- ;; command, or else "--upgrade gcc"
- ;; would upgrade everything.
- (delete '(upgrade . #f) result))
- arg-handler))))
- (option '("roll-back") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'roll-back? #t result)
- #f)))
- (option '(#\l "list-generations") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-generations ,(or arg ""))
- result)
- #f)))
- (option '(#\d "delete-generations") #f #t
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'delete-generations (or arg "")
- result)
- #f)))
- (option '("search-paths") #f #f
- (lambda (opt name arg result arg-handler)
- (values (cons `(query search-paths) result)
- #f)))
- (option '(#\p "profile") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'profile arg
- (alist-delete 'profile result))
- #f)))
- (option '(#\n "dry-run") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'dry-run? #t result)
- #f)))
- (option '("fallback") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'fallback? #t
- (alist-delete 'fallback? result))
- #f)))
- (option '("no-substitutes") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'substitutes? #f
- (alist-delete 'substitutes? result))
- #f)))
- (option '("max-silent-time") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'max-silent-time (string->number* arg)
- result)
- #f)))
- (option '("bootstrap") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'bootstrap? #t result)
- #f)))
- (option '("verbose") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'verbose? #t result)
- #f)))
- (option '(#\s "search") #t #f
- (lambda (opt name arg result arg-handler)
- (values (cons `(query search ,(or arg ""))
- result)
- #f)))
- (option '(#\I "list-installed") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-installed ,(or arg ""))
- result)
- #f)))
- (option '(#\A "list-available") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-available ,(or arg ""))
- result)
- #f)))))
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix package")))
+
+ (option '(#\i "install") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (if arg
+ (alist-cons 'install arg result)
+ result)
+ arg-handler))))
+ (option '(#\e "install-from-expression") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'install (read/eval-package-expression arg)
+ result)
+ #f)))
+ (option '(#\r "remove") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (if arg
+ (alist-cons 'remove arg result)
+ result)
+ arg-handler))))
+ (option '(#\u "upgrade") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (alist-cons 'upgrade arg
+ ;; Delete any prior "upgrade all"
+ ;; command, or else "--upgrade gcc"
+ ;; would upgrade everything.
+ (delete '(upgrade . #f) result))
+ arg-handler))))
+ (option '("roll-back") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'roll-back? #t result)
+ #f)))
+ (option '(#\l "list-generations") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-generations ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\d "delete-generations") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'delete-generations (or arg "")
+ result)
+ #f)))
+ (option '("search-paths") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query search-paths) result)
+ #f)))
+ (option '(#\p "profile") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'profile arg
+ (alist-delete 'profile result))
+ #f)))
+ (option '(#\n "dry-run") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'dry-run? #t result)
+ #f)))
+ (option '("bootstrap") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'bootstrap? #t result)
+ #f)))
+ (option '("verbose") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'verbose? #t result)
+ #f)))
+ (option '(#\s "search") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query search ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\I "list-installed") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-installed ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\A "list-available") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-available ,(or arg ""))
+ result)
+ #f)))
+
+ %standard-build-options))
(define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
@@ -1052,13 +1034,7 @@ more information.~%"))
(or (process-query opts)
(with-error-handling
(parameterize ((%store (open-connection)))
- (set-build-options (%store)
- #:print-build-trace #f
- #:fallback? (assoc-ref opts 'fallback?)
- #:use-substitutes?
- (assoc-ref opts 'substitutes?)
- #:max-silent-time
- (assoc-ref opts 'max-silent-time))
+ (set-build-options-from-command-line (%store) opts)
(parameterize ((%guile-for-build
(package-derivation (%store)
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 3aaa1c4284..54f4aaa6c0 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -38,6 +38,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (web uri)
#:use-module (guix http-client)
#:export (guix-substitute-binary))
@@ -133,33 +134,38 @@ provide."
(if buffered? "rb" "r0b"))))
(values port (stat:size (stat port)))))
((http)
- ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So
- ;; honor TIMEOUT? to disable the timeout when fetching a nar.
- ;;
- ;; Test this with:
- ;; sudo tc qdisc add dev eth0 root netem delay 1500ms
- ;; and then cancel with:
- ;; sudo tc qdisc del dev eth0 root
- (let ((port #f))
- (with-timeout (if (or timeout? (guile-version>? "2.0.5"))
- %fetch-timeout
- 0)
- (begin
- (warning (_ "while fetching ~a: server is unresponsive~%")
- (uri->string uri))
- (warning (_ "try `--no-substitutes' if the problem persists~%"))
-
- ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user,
- ;; and thus PORT had to be closed and re-opened. This is not the
- ;; case afterward.
- (unless (or (guile-version>? "2.0.9")
- (version>? (version) "2.0.9.39"))
- (when port
- (close-port port))))
- (begin
- (when (or (not port) (port-closed? port))
- (set! port (open-socket-for-uri uri #:buffered? buffered?)))
- (http-fetch uri #:text? #f #:port port)))))))
+ (guard (c ((http-get-error? c)
+ (leave (_ "download from '~a' failed: ~a, ~s~%")
+ (uri->string (http-get-error-uri c))
+ (http-get-error-code c)
+ (http-get-error-reason c))))
+ ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So
+ ;; honor TIMEOUT? to disable the timeout when fetching a nar.
+ ;;
+ ;; Test this with:
+ ;; sudo tc qdisc add dev eth0 root netem delay 1500ms
+ ;; and then cancel with:
+ ;; sudo tc qdisc del dev eth0 root
+ (let ((port #f))
+ (with-timeout (if (or timeout? (guile-version>? "2.0.5"))
+ %fetch-timeout
+ 0)
+ (begin
+ (warning (_ "while fetching ~a: server is unresponsive~%")
+ (uri->string uri))
+ (warning (_ "try `--no-substitutes' if the problem persists~%"))
+
+ ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user,
+ ;; and thus PORT had to be closed and re-opened. This is not the
+ ;; case afterward.
+ (unless (or (guile-version>? "2.0.9")
+ (version>? (version) "2.0.9.39"))
+ (when port
+ (close-port port))))
+ (begin
+ (when (or (not port) (port-closed? port))
+ (set! port (open-socket-for-uri uri #:buffered? buffered?)))
+ (http-fetch uri #:text? #f #:port port))))))))
(define-record-type <cache>
(%make-cache url store-directory wants-mass-query?)
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 474dc69de5..284b174794 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,11 +22,13 @@
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
#:export (write-int read-int
write-long-long read-long-long
write-padding
write-string read-string read-latin1-string
write-string-list read-string-list
+ write-string-pairs
write-store-path read-store-path
write-store-path-list read-store-path-list))
@@ -94,6 +96,14 @@
(write-int (length l) p)
(for-each (cut write-string <> p) l))
+(define (write-string-pairs l p)
+ (write-int (length l) p)
+ (for-each (match-lambda
+ ((first . second)
+ (write-string first p)
+ (write-string second p)))
+ l))
+
(define (read-string-list p)
(let ((len (read-int p)))
(unfold (cut >= <> len)
diff --git a/guix/store.scm b/guix/store.scm
index 54ed31cbbc..909ef195de 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -197,7 +197,7 @@
result))))))
(define-syntax write-arg
- (syntax-rules (integer boolean file string string-list
+ (syntax-rules (integer boolean file string string-list string-pairs
store-path store-path-list base16)
((_ integer arg p)
(write-int arg p))
@@ -209,6 +209,8 @@
(write-string arg p))
((_ string-list arg p)
(write-string-list arg p))
+ ((_ string-pairs arg p)
+ (write-string-pairs arg p))
((_ store-path arg p)
(write-store-path arg p))
((_ store-path-list arg p)
@@ -430,6 +432,7 @@ encoding conversion errors."
#:key keep-failed? keep-going? fallback?
(verbosity 0)
(max-build-jobs (current-processor-count))
+ timeout
(max-silent-time 3600)
(use-build-hook? #t)
(build-verbosity 0)
@@ -462,12 +465,11 @@ encoding conversion errors."
(when (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12)
- (send (string-list (fold-right (lambda (pair result)
- (match pair
- ((h . t)
- (cons* h t result))))
- '()
- binary-caches))))
+ (let ((pairs (if timeout
+ `(("build-timeout" . ,(number->string timeout))
+ ,@binary-caches)
+ binary-caches)))
+ (send (string-pairs pairs))))
(let loop ((done? (process-stderr server)))
(or done? (process-stderr server)))))
@@ -734,8 +736,13 @@ is raised if the set of paths read from PORT is not signed (as per
(define* (export-paths server paths port #:key (sign? #t))
"Export the store paths listed in PATHS to PORT, in topological order,
signing them if SIGN? is true."
+ (define ordered
+ ;; Sort PATHS, but don't include their references.
+ (filter (cut member <> paths)
+ (topologically-sorted server paths)))
+
(let ((s (nix-server-socket server)))
- (let loop ((paths (topologically-sorted server paths)))
+ (let loop ((paths ordered))
(match paths
(()
(write-int 0 port))
@@ -822,7 +829,7 @@ must be an absolute store file name, or a derivation file name."
(cond ((derivation-path? file)
(let* ((base (basename file))
(log (string-append (dirname %state-directory) ; XXX
- "/log/nix/drvs/"
+ "/log/guix/drvs/"
(string-take base 2) "/"
(string-drop base 2)))
(log.bz2 (string-append log ".bz2")))
diff --git a/guix/utils.scm b/guix/utils.scm
index 5fda2116de..68329ec915 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -244,6 +244,13 @@ buffered data is lost."
((string-contains %host-type "linux") 7) ; *-linux-gnu
(else 9)))) ; *-gnu*
+(define F_SETLK
+ ;; Likewise: GNU/Hurd and SPARC use 8, while the others typically use 6.
+ (compile-time-value
+ (cond ((string-contains %host-type "sparc") 8) ; sparc-*-linux-gnu
+ ((string-contains %host-type "linux") 6) ; *-linux-gnu
+ (else 8)))) ; *-gnu*
+
(define F_xxLCK
;; The F_RDLCK, F_WRLCK, and F_UNLCK constants.
(compile-time-value
@@ -252,12 +259,30 @@ buffered data is lost."
((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu
(else #(1 2 3))))) ; *-gnu*
+(define %libc-errno-pointer
+ ;; Glibc's 'errno' pointer.
+ (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link))))
+ (and errno-loc
+ (let ((proc (pointer->procedure '* errno-loc '())))
+ (proc)))))
+
+(define (errno)
+ "Return the current errno."
+ ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
+ ;; In particular, that means that no async must be running here.
+ (if %libc-errno-pointer
+ (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
+ (bytevector-sint-ref bv 0 (native-endianness) (sizeof int)))
+ 0))
+
(define fcntl-flock
(let* ((ptr (dynamic-func "fcntl" (dynamic-link)))
(proc (pointer->procedure int ptr `(,int ,int *))))
- (lambda (fd-or-port operation)
+ (lambda* (fd-or-port operation #:key (wait? #t))
"Perform locking OPERATION on the file beneath FD-OR-PORT. OPERATION
-must be a symbol, one of 'read-lock, 'write-lock, or 'unlock."
+must be a symbol, one of 'read-lock, 'write-lock, or 'unlock. When WAIT? is
+true, block until the lock is acquired; otherwise, thrown an 'flock-error'
+exception if it's already taken."
(define (operation->int op)
(case op
((read-lock) (vector-ref F_xxLCK 0))
@@ -273,7 +298,9 @@ must be a symbol, one of 'read-lock, 'write-lock, or 'unlock."
;; XXX: 'fcntl' is a vararg function, but here we happily use the
;; standard ABI; crossing fingers.
(let ((err (proc fd
- F_SETLKW ; lock & wait
+ (if wait?
+ F_SETLKW ; lock & wait
+ F_SETLK) ; non-blocking attempt
(make-c-struct %struct-flock
(list (operation->int operation)
SEEK_SET
@@ -282,7 +309,7 @@ must be a symbol, one of 'read-lock, 'write-lock, or 'unlock."
(or (zero? err)
;; Presumably we got EAGAIN or so.
- (throw 'flock-error fd))))))
+ (throw 'flock-error (errno)))))))
;;;
diff --git a/tests/derivations.scm b/tests/derivations.scm
index f31b00b8a2..e87662a198 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -446,6 +446,20 @@
(build-derivations store (list drv))
#f)))
+(test-assert "build-expression->derivation and timeout"
+ (let* ((store (let ((s (open-connection)))
+ (set-build-options s #:timeout 1)
+ s))
+ (builder '(begin (sleep 100) (mkdir %output) #t))
+ (drv (build-expression->derivation store "slow" builder))
+ (out-path (derivation->output-path drv)))
+ (guard (c ((nix-protocol-error? c)
+ (and (string-contains (nix-protocol-error-message c)
+ "failed")
+ (not (valid-path? store out-path)))))
+ (build-derivations store (list drv))
+ #f)))
+
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already
diff --git a/tests/store.scm b/tests/store.scm
index 7b0f3249d2..8a25c7353b 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -190,9 +190,18 @@
(s1 (topologically-sorted %store (list y)))
(s2 (topologically-sorted %store (list c y)))
(s3 (topologically-sorted %store (cons y (references %store y)))))
- (and (equal? s1 (list w x a b c d y))
- (equal? s2 (list a b c w x d y))
- (lset= string=? s1 s3))))
+ ;; The order in which 'references' returns the references of Y is
+ ;; unspecified, so accommodate.
+ (let* ((x-then-d? (equal? (references %store y) (list x d))))
+ (and (equal? s1
+ (if x-then-d?
+ (list w x a b c d y)
+ (list a b c d w x y)))
+ (equal? s2
+ (if x-then-d?
+ (list a b c w x d y)
+ (list a b c d w x y)))
+ (lset= string=? s1 s3)))))
(test-assert "log-file, derivation"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
@@ -399,7 +408,9 @@ Deriver: ~a~%"
files)))))))
(test-assert "export/import paths, ensure topological order"
- (let* ((file1 (add-text-to-store %store "foo" (random-text)))
+ (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+ (file1 (add-text-to-store %store "foo" (random-text)
+ (list file0)))
(file2 (add-text-to-store %store "bar" (random-text)
(list file1)))
(files (list file1 file2))
@@ -412,9 +423,10 @@ Deriver: ~a~%"
(bytevector=? dump1 dump2)
(let* ((source (open-bytevector-input-port dump1))
(imported (import-paths %store source)))
+ ;; DUMP1 should contain exactly FILE1 and FILE2, not FILE0.
(and (equal? imported (list file1 file2))
(every file-exists? files)
- (null? (references %store file1))
+ (equal? (list file0) (references %store file1))
(equal? (list file1) (references %store file2)))))))
(test-assert "import corrupt path"
diff --git a/tests/utils.scm b/tests/utils.scm
index b5706aa792..adac5d4381 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -27,6 +27,9 @@
#:use-module (rnrs io ports)
#:use-module (ice-9 match))
+(define temp-file
+ (string-append "t-utils-" (number->string (getpid))))
+
(test-begin "utils")
(test-assert "bytevector->base16-string->bytevector"
@@ -139,36 +142,88 @@
(append pids1 pids2)))
(equal? (get-bytevector-all decompressed) data)))))
-(test-equal "fcntl-flock"
- 0 ; the child's exit status
- (let ((file (open-input-file (search-path %load-path "guix.scm"))))
- (fcntl-flock file 'read-lock)
+(false-if-exception (delete-file temp-file))
+(test-equal "fcntl-flock wait"
+ 42 ; the child's exit status
+ (let ((file (open-file temp-file "w0")))
+ ;; Acquire an exclusive lock.
+ (fcntl-flock file 'write-lock)
(match (primitive-fork)
(0
(dynamic-wind
(const #t)
(lambda ()
- ;; Taking a read lock should be OK.
- (fcntl-flock file 'read-lock)
- (fcntl-flock file 'unlock)
-
- (catch 'flock-error
- (lambda ()
- ;; Taking an exclusive lock should raise an exception.
- (fcntl-flock file 'write-lock))
- (lambda args
- (primitive-exit 0)))
+ ;; Reopen FILE read-only so we can have a read lock.
+ (let ((file (open-file temp-file "r")))
+ ;; Wait until we can acquire the lock.
+ (fcntl-flock file 'read-lock)
+ (primitive-exit (read file)))
(primitive-exit 1))
(lambda ()
(primitive-exit 2))))
(pid
+ ;; Write garbage and wait.
+ (display "hello, world!" file)
+ (force-output file)
+ (sleep 1)
+
+ ;; Write the real answer.
+ (seek file 0 SEEK_SET)
+ (truncate-file file 0)
+ (write 42 file)
+ (force-output file)
+
+ ;; Unlock, which should let the child continue.
+ (fcntl-flock file 'unlock)
+
(match (waitpid pid)
((_ . status)
(let ((result (status:exit-val status)))
- (fcntl-flock file 'unlock)
(close-port file)
result)))))))
+(test-equal "fcntl-flock non-blocking"
+ EAGAIN ; the child's exit status
+ (match (pipe)
+ ((input . output)
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (close-port output)
+
+ ;; Wait for the green light.
+ (read-char input)
+
+ ;; Open FILE read-only so we can have a read lock.
+ (let ((file (open-file temp-file "w")))
+ (catch 'flock-error
+ (lambda ()
+ ;; This attempt should throw EAGAIN.
+ (fcntl-flock file 'write-lock #:wait? #f))
+ (lambda (key errno)
+ (primitive-exit errno))))
+ (primitive-exit -1))
+ (lambda ()
+ (primitive-exit -2))))
+ (pid
+ (close-port input)
+ (let ((file (open-file temp-file "w")))
+ ;; Acquire an exclusive lock.
+ (fcntl-flock file 'write-lock)
+
+ ;; Tell the child to continue.
+ (write 'green-light output)
+ (force-output output)
+
+ (match (waitpid pid)
+ ((_ . status)
+ (let ((result (status:exit-val status)))
+ (fcntl-flock file 'unlock)
+ (close-port file)
+ result)))))))))
+
;; This is actually in (guix store).
(test-equal "store-path-package-name"
"bash-4.2-p24"
@@ -178,5 +233,7 @@
(test-end)
+(false-if-exception (delete-file temp-file))
+
(exit (= (test-runner-fail-count (test-runner-current)) 0))