Merge branch 'master' into core-updates
This commit is contained in:
commit
e06f7865e2
9
HACKING
9
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.)
|
||||
|
|
|
@ -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) ; \
|
||||
|
|
|
@ -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"],
|
||||
|
|
|
@ -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)\" \
|
||||
|
|
195
doc/guix.texi
195
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,
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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+)))
|
||||
|
|
|
@ -29,8 +29,7 @@
|
|||
(version "7.2d")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc-"
|
||||
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
|
@ -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,8 +91,7 @@ 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-"
|
||||
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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+)))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
|
@ -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
|
|
@ -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)))
|
||||
|
|
|
@ -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]);
|
||||
}
|
||||
}
|
|
@ -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)
|
|
@ -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();
|
|
@ -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+)))
|
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
`(("pkg-config" ,pkg-config)
|
||||
;; For the Perl bindings.
|
||||
`(("swig" ,swig)))
|
||||
("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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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'.
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -63,6 +63,9 @@ Export/import one or more packages from/to the store.\n"))
|
|||
(display (_ "
|
||||
--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 (_ "
|
||||
|
|
|
@ -126,6 +126,8 @@ options handled by 'set-build-options-from-command-line', and listed in
|
|||
(display (_ "
|
||||
--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 (_ "
|
||||
|
@ -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)
|
||||
(lambda (opt name arg result . rest)
|
||||
(apply values
|
||||
(alist-cons 'fallback? #t
|
||||
(alist-delete 'fallback? result))))
|
||||
(alist-delete 'fallback? result))
|
||||
rest)))
|
||||
(option '("no-substitutes") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(lambda (opt name arg result . rest)
|
||||
(apply values
|
||||
(alist-cons 'substitutes? #f
|
||||
(alist-delete 'substitutes? result))))
|
||||
(alist-delete 'substitutes? result))
|
||||
rest)))
|
||||
(option '("no-build-hook") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(lambda (opt name arg result . rest)
|
||||
(apply values
|
||||
(alist-cons 'build-hook? #f
|
||||
(alist-delete 'build-hook? result))))
|
||||
(alist-delete 'build-hook? result))
|
||||
rest)))
|
||||
(option '("max-silent-time") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(lambda (opt name arg result . rest)
|
||||
(apply values
|
||||
(alist-cons 'max-silent-time (string->number* arg)
|
||||
result)))
|
||||
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)))
|
||||
(apply values
|
||||
(alist-cons 'verbosity level
|
||||
(alist-delete 'verbosity result)))))
|
||||
(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)))))))
|
||||
|
||||
|
||||
|
|
|
@ -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))))
|
||||
(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
|
||||
(match (open-ssh-gateway machine)
|
||||
((? integer? pid)
|
||||
(begin
|
||||
;; Offload DRV to MACHINE.
|
||||
(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?
|
||||
(transfer-and-offload drv machine
|
||||
#:inputs inputs
|
||||
#:outputs outputs
|
||||
#: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"))))
|
||||
#: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
|
||||
|
|
|
@ -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,7 +514,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
|
||||
(define %options
|
||||
;; Specification of the command-line options.
|
||||
(list (option '(#\h "help") #f #f
|
||||
(cons* (option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(show-help)
|
||||
(exit 0)))
|
||||
|
@ -582,21 +577,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(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)
|
||||
|
@ -619,7 +599,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(lambda (opt name arg result arg-handler)
|
||||
(values (cons `(query list-available ,(or arg ""))
|
||||
result)
|
||||
#f)))))
|
||||
#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)
|
||||
|
|
|
@ -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,6 +134,11 @@ provide."
|
|||
(if buffered? "rb" "r0b"))))
|
||||
(values port (stat:size (stat port)))))
|
||||
((http)
|
||||
(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.
|
||||
;;
|
||||
|
@ -159,7 +165,7 @@ provide."
|
|||
(begin
|
||||
(when (or (not port) (port-closed? port))
|
||||
(set! port (open-socket-for-uri uri #:buffered? buffered?)))
|
||||
(http-fetch uri #:text? #f #:port port)))))))
|
||||
(http-fetch uri #:text? #f #:port port))))))))
|
||||
|
||||
(define-record-type <cache>
|
||||
(%make-cache url store-directory wants-mass-query?)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")))
|
||||
|
|
|
@ -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
|
||||
(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)))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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,35 +142,87 @@
|
|||
(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.
|
||||
;; 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)
|
||||
(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)))
|
||||
(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)))
|
||||
(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)))))))
|
||||
result)))))))))
|
||||
|
||||
;; This is actually in (guix store).
|
||||
(test-equal "store-path-package-name"
|
||||
|
@ -178,5 +233,7 @@
|
|||
|
||||
(test-end)
|
||||
|
||||
(false-if-exception (delete-file temp-file))
|
||||
|
||||
|
||||
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
||||
|
|
Loading…
Reference in New Issue