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

Merge branch 'master' into core-updates

This commit is contained in:
Ludovic Courtès 2013-09-08 12:11:32 +02:00
parent 3409bc0188 6bf25b7b05
commit 8ce3104e0e
42 changed files with 1849 additions and 491 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
HACKING
View File

@ -78,68 +78,75 @@ addition to that, you must not miss [[http://www.emacswiki.org/emacs/ParEdit][Pa
directly operate on the syntax tree, such as raising an s-expression or
wrapping it, swallowing or rejecting the following s-expression, etc.
* Adding new packages
Package recipes in Guix look like this:
#+BEGIN_SRC scheme
(package
(name "nettle")
(version "2.5")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/nettle/nettle-"
version ".tar.gz"))
(sha256
(base32
"0wicr7amx01l03rm0pzgr1qvw3f9blaw17vjsy1301dh13ll58aa"))))
(build-system gnu-build-system)
(inputs `(("m4" ,m4)))
(propagated-inputs `(("gmp" ,gmp)))
(home-page
"http://www.lysator.liu.se/~nisse/nettle/")
(synopsis "GNU Nettle, a cryptographic library")
(description
"Nettle is a cryptographic library...")
(license gpl2+))
#+END_SRC
Such a recipe can be written by hand, and then tested by running
‘./pre-inst-env guix build nettle’.
When writing the recipe, the base32-encoded SHA256 hash of the source
code tarball, which can be seen in the example above, can be obtained by
running:
guix download http://ftp.gnu.org/gnu/nettle/nettle-2.5.tar.gz
Alternatively, it is possible to semi-automatically import recipes from
the [[http://nixos.org/nixpkgs/][Nixpkgs]] software distribution using this command:
guix import /path/to/nixpkgs/checkout nettle
The command automatically fetches and converts to Guix the “Nix
expression” of Nettle.
* Submitting Patches
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
bug-guix@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]].
As you become a regular contributor, you may find it convenient to have write
access to the repository (see below.)
* Coding Style
In general our code follows the [[info:standards][GNU Coding Standards]] (GCS). However, the GCS
do not say much about Scheme, so here are some additional rules.
** Programming Paradigm
Scheme code in Guix is written in a purely functional style. One exception is
code that involves input/output, and procedures that implement low-level
concepts, such as the ‘memoize’ procedure.
** Modules
Guile modules that are meant to be used on the builder side must live in the
(guix build …) name space. They must not refer to other Guix or GNU modules.
However, it is OK for a “host-side” module to use a build-side module.
Modules that deal with the broader GNU system should be in the (gnu …) name
space rather than (guix …).
** Data Types and Pattern Matching
The tendency in classical Lisp is to use lists to represent everything, and
then to browse them “by hand” using ‘car’, ‘cdr’, ‘cadr’, and co. There are
several problems with that style, notably the fact that it is hard to read,
error-prone, and a hindrance to proper type error reports.
Guix code should define appropriate data types (for instance, using
‘define-record-type*’) rather than abuse lists. In addition, it should use
pattern matching, via Guile’s (ice-9 match) module, especially when matching
lists.
** Formatting Code
When writing Scheme code, we follow common wisdom among Scheme programmers.
In general, we follow the [[http://mumble.net/~campbell/scheme/style.txt][Riastradh's Lisp Style Rules]]. This document happens
to describe the conventions mostly used in Guile’s code too. It is very
thoughtful and well written, so please do read it.
Some special forms introduced in Guix, such as the ‘substitute*’ macro, have
special indentation rules. These are defined in the .dir-locals.el file,
which Emacs automatically uses. If you do not use Emacs, please make sure to
let your editor know the rules.
We require all top-level procedures to carry a docstring. This requirement
can be relaxed for simple private procedures in the (guix build …) name space,
though.
Procedures should not have more than four positional parameters. Use keyword
parameters for procedures that take more than four parameters.
* Commit Access
For frequent contributors, having write access to the repository is
convenient. When you deem it necessary, feel free to ask for it on the
mailing list. When you get commit access, please make sure to follow the
policy below (discussions of the policy can take place on bug-guix@gnu.org.)
policy below (discussions of the policy can take place on guix-devel@gnu.org.)
Non-trivial patches should always be posted to bug-guix@gnu.org (trivial
Non-trivial patches should always be posted to guix-devel@gnu.org (trivial
patches include fixing typos, etc.)
For patches that just add a new package, and a simple one, it’s OK to commit,
@ -149,7 +156,7 @@ package upgrades. We have a mailing list for commit notifications
(guix-commits@gnu.org), so people can notice. Before pushing your changes,
make sure to run ‘git pull --rebase’.
For anything else, please post to bug-guix@gnu.org and leave time for a
For anything else, please post to guix-devel@gnu.org and leave time for a
review, without committing anything. If you didn’t receive any reply
after two weeks, and if you’re confident, it’s OK to commit.

28
Makefile.am
View File

@ -61,6 +61,7 @@ MODULES = \
guix/build/cmake-build-system.scm \
guix/build/gnu-build-system.scm \
guix/build/gnu-dist.scm \
guix/build/linux-initrd.scm \
guix/build/perl-build-system.scm \
guix/build/python-build-system.scm \
guix/build/utils.scm \
@ -187,32 +188,7 @@ $(guix_install_go_files): install-nobase_dist_guilemoduleDATA
SUBDIRS = po
info_TEXINFOS = doc/guix.texi
EXTRA_DIST += \
doc/fdl-1.3.texi \
doc/images/bootstrap-graph.dot \
doc/images/bootstrap-graph.eps
infoimagedir = $(infodir)/images
dist_infoimage_DATA = doc/images/bootstrap-graph.png
# Try hard to obtain an image size and aspect that's reasonable for inclusion
# in an Info or PDF document.
DOT_OPTIONS = \
-Tpng -Gratio=.9 -Gnodesep=.005 -Granksep=.00005 \
-Nfontsize=9 -Nheight=.1 -Nwidth=.1
.dot.png:
dot -Tpng $(DOT_OPTIONS) < "$<" > "$@.tmp"
mv "$@.tmp" "$@"
.dot.eps:
dot -Teps $(DOT_OPTIONS) < "$<" > "$@.tmp"
mv "$@.tmp" "$@"
doc/guix.pdf: doc/images/bootstrap-graph.png
doc/guix.info: doc/images/bootstrap-graph.png
doc/guix.ps: doc/images/bootstrap-graph.eps
include doc.am
if BUILD_DAEMON

36
build-aux/hydra/gnu-system.scm
View File

@ -79,7 +79,7 @@ SYSTEM."
,(cute package->alist store package system
(cut package-cross-derivation <> <> target <>))))
(define %packages-to-cross-build
(define %core-packages
(list gmp mpfr mpc coreutils findutils diffutils patch sed grep
gawk gettext hello guile-2.0
%bootstrap-binaries-tarball
@ -89,6 +89,9 @@ SYSTEM."
%guile-bootstrap-tarball
%bootstrap-tarballs))
(define %packages-to-cross-build
%core-packages)
(define %cross-targets
'("mips64el-linux-gnu"
"mips64el-linux-gnuabi64"))
@ -106,6 +109,11 @@ SYSTEM."
(_
(list (%current-system)))))
(define subset
(match (assoc-ref arguments 'subset)
("core" 'core) ; only build core packages
(_ 'all))) ; build everything
(define job-name
(compose string->symbol package-full-name))
@ -127,11 +135,23 @@ SYSTEM."
inputs))))
%final-inputs))))
(append-map (lambda (system)
(fold-packages (lambda (package result)
(if (member package base-packages)
result
(cons (package-job store (job-name package)
package system)
result)))
(cross-jobs system)))
(case subset
((all)
;; Build everything.
(fold-packages (lambda (package result)
(if (member package base-packages)
result
(cons (package-job store (job-name package)
package system)
result)))
(cross-jobs system)))
((core)
;; Build core packages only.
(append (map (lambda (package)
(package-job store (job-name package)
package system))
%core-packages)
(cross-jobs system)))
(else
(error "unknown subset" subset))))
systems)))

10
build-aux/hydra/guix.scm
View File

@ -41,7 +41,9 @@
(guix packages)
(guix utils)
(guix build-system gnu)
(gnu packages version-control)
(gnu packages package-management)
(gnu packages graphviz)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match))
@ -75,9 +77,11 @@ containing a Git checkout of Guix."
;; Comment out `git' invocations, since Hydra provides
;; us with a checkout that includes sub-modules.
(substitute* "bootstrap"
(("git submodule init")
"true\n")))
,p)))))))
(("git ") "true git ")))
,p))))
(native-inputs `(("git" ,git)
("graphviz" ,graphviz)
,@(package-native-inputs dist))))))
(define (hydra-jobs store arguments)
"Return Hydra jobs."

99
build-aux/list-packages.scm
View File

@ -156,50 +156,79 @@ exec guile -l "$0" \
"Return the CSS for the list-packages page."
(format #t
"<style>
a {transition: all 0.3s}
div#intro {margin-bottom: 5em}
div#intro div, div#intro p {padding:0.5em}
div#intro div {float:left}
table#packages, table#packages tr, table#packages tbody, table#packages td,
table#packages th {border: 0px solid black}
div.package-description {position: relative}
table#packages tr:nth-child(even) {background-color: #FFF}
table#packages tr:nth-child(odd) {background-color: #EEE}
table#packages tr:hover, table#packages tr:focus, table#packages tr:active {background-color: #DDD}
table#packages tr:first-child, table#packages tr:first-child:hover, table#packages tr:first-child:focus, table#packages tr:first-child:active {
background-color: #333;
color: #fff;
/* license: CC0 */
a {
transition: all 0.3s;
}
table#packages td
{
margin:0px;
padding:0.2em 0.5em;
div#intro {
margin-bottom: 2em;
}
div#intro div, div#intro p {
padding:0.5em;
}
div#intro div {
float:left;
}
div#intro img {
float:left;
padding:0.75em;
}
table#packages, table#packages tr, table#packages tbody, table#packages td, table#packages th {
border: 0px solid black;
clear: both;
}
table#packages tr:nth-child(even) {
background-color: #FFF;
}
table#packages tr:nth-child(odd) {
background-color: #EEE;
}
table#packages tr:hover, table#packages tr:focus, table#packages tr:active {
background-color: #DDD;
}
table#packages tr:first-child, table#packages tr:first-child:hover, table#packages tr:first-child:focus, table#packages tr:first-child:active {
background-color: #333;
color: #fff;
}
table#packages td {
margin:0px;
padding:0.2em 0.5em;
}
table#packages td:first-child {
width:10%;
text-align:center;
width:10%;
text-align:center;
}
table#packages td:nth-child(2) {
width:30%;
}
table#packages td:last-child {
width:60%;
}
table#packages td:nth-child(2){width:30%;}
table#packages td:last-child {width:60%}
img.package-logo {
float: left;
padding-right: 1em;
float: left;
padding: 0.75em;
}
table#packages span {
font-weight: 700;
}
table#packages span a {
float: right;
font-weight: 500;
}
table#packages span a {float: right}
a#top {
position:fixed;
right:2%;
bottom:2%;
font-size:150%;
background-color:#EEE;
padding:1.125% 0.75% 0% 0.75%;
text-decoration:none;
color:#000;
border-radius:5px;
position:fixed;
right:10px;
bottom:10px;
font-size:150%;
background-color:#EEE;
padding:10px 7.5px 0 7.5px;
text-decoration:none;
color:#000;
border-radius:5px;
}
a#top:hover, a#top:focus {
background-color:#333;
color:#fff;
background-color:#333;
color:#fff;
}
</style>"))

6
configure.ac
View File

@ -7,7 +7,7 @@ AC_INIT([GNU Guix], [0.4], [bug-guix@gnu.org], [guix],
AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects \
color-tests parallel-tests])
color-tests parallel-tests -Woverride])
AC_CONFIG_SRCDIR([guix.scm])
AC_CONFIG_MACRO_DIR([m4])
@ -121,6 +121,10 @@ AC_CACHE_SAVE
m4_include([config-daemon.ac])
dnl `dot' (from the Graphviz package) is only needed for maintainers.
dnl See `HACKING' for more info.
AM_MISSING_PROG([DOT], [dot])
AC_CONFIG_FILES([Makefile
po/Makefile.in
guix/config.scm])

52
doc.am Normal file
View File

@ -0,0 +1,52 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
#
# 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/>.
info_TEXINFOS = doc/guix.texi
EXTRA_DIST += \
doc/fdl-1.3.texi \
doc/images/bootstrap-graph.dot \
doc/images/bootstrap-graph.eps
infoimagedir = $(infodir)/images
dist_infoimage_DATA = doc/images/bootstrap-graph.png
# Try hard to obtain an image size and aspect that's reasonable for inclusion
# in an Info or PDF document.
DOT_OPTIONS = \
-Gratio=.9 -Gnodesep=.005 -Granksep=.00005 \
-Nfontsize=9 -Nheight=.1 -Nwidth=.1
.dot.png:
$(DOT) -Tpng $(DOT_OPTIONS) < "$<" > "$@.tmp"
mv "$@.tmp" "$@"
.dot.pdf:
$(DOT) -Tpdf $(DOT_OPTIONS) < "$<" > "$@.tmp"
mv "$@.tmp" "$@"
.dot.eps:
$(DOT) -Teps $(DOT_OPTIONS) < "$<" > "$@.tmp"
mv "$@.tmp" "$@"
# We cannot add new dependencies to `doc/guix.pdf' & co. (info "(automake)
# Extending"). Using the `-local' rules is imperfect, because they may be
# triggered after the main rule. Oh, well.
pdf-local: doc/images/bootstrap-graph.pdf
info-local: doc/images/bootstrap-graph.png
ps-local: doc/images/bootstrap-graph.eps

173
doc/guix.texi
View File

@ -23,6 +23,7 @@
@title GNU Guix Reference Manual
@subtitle Using the GNU Guix Functional Package Manager
@author Ludovic Courtès
@author Andreas Enge
@author Nikita Karetnikov
@page
@ -30,8 +31,9 @@
Edition @value{EDITION} @*
@value{UPDATED} @*
Copyright @copyright{} @value{YEARS} Ludovic Court@`es
Copyright @copyright{} @value{YEARS} Ludovic Court@`es, Andreas Enge, Nikita Karetnikov
@ifinfo
@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -40,6 +42,8 @@ Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A
copy of the license is included in the section entitled ``GNU Free
Documentation License''.
@end quotation
@end ifinfo
@end titlepage
@copying
@ -64,8 +68,9 @@ Documentation License.''
This document describes GNU Guix version @value{VERSION}, a functional
package management tool written for the GNU system.
@quotation
Copyright @copyright{} @value{YEARS} Ludovic Courtès
Copyright @copyright{} @value{YEARS} Ludovic Courtès, Andreas Enge, Nikita Karetnikov
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -1113,13 +1118,18 @@ derivations as Scheme objects, along with procedures to create and
otherwise manipulate derivations. The lowest-level primitive to create
a derivation is the @code{derivation} procedure:
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{system} @var{builder} @var{args} @var{env-vars} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f]
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] [#:system (%current-system)] [#:references-graphs #f]
Build a derivation with the given arguments. Return the resulting store
path and @code{<derivation>} object.
When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
@dfn{fixed-output derivation} is created---i.e., one whose result is
known in advance, such as a file download.
When @var{references-graphs} is true, it must be a list of file
name/store path pairs. In that case, the reference graph of each store
path is exported in the build environment in the corresponding file, in
a simple text format.
@end deffn
@noindent
@ -1137,9 +1147,9 @@ to a Bash executable in the store:
(let ((builder ; add the Bash script to the store
(add-text-to-store store "my-builder.sh"
"echo hello world > $out\n" '())))
(derivation store "foo" (%current-system)
(derivation store "foo"
bash `("-e" ,builder)
'(("HOME" . "/homeless")) '())))
#:env-vars '(("HOME" . "/homeless")))))
list)
@result{} ("/nix/store/@dots{}-foo.drv" #<<derivation> @dots{}>)
@end lisp
@ -1148,7 +1158,7 @@ As can be guessed, this primitive is cumbersome to use directly. An
improved variant is @code{build-expression->derivation}, which allows
the caller to directly pass a Guile expression as the build script:
@deffn {Scheme Procedure} build-expression->derivation @var{store} @var{name} @var{system} @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:env-vars '()] [#:modules '()] [#:guile-for-build #f]
@deffn {Scheme Procedure} build-expression->derivation @var{store} @var{name} @var{system} @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:env-vars '()] [#:modules '()] [#:references-graphs #f] [#:guile-for-build #f]
Return a derivation that executes Scheme expression @var{exp} as a
builder for derivation @var{name}. @var{inputs} must be a list of
@code{(name drv-path sub-drv)} tuples; when @var{sub-drv} is omitted,
@ -1169,6 +1179,8 @@ terminates by passing the result of @var{exp} to @code{exit}; thus, when
@var{exp} is built using @var{guile-for-build} (a derivation). When
@var{guile-for-build} is omitted or is @code{#f}, the value of the
@code{%guile-for-build} fluid is used instead.
See the @code{derivation} procedure for the meaning of @var{references-graphs}.
@end deffn
@noindent
@ -1495,7 +1507,7 @@ tools that help users exert that freedom.
@menu
* Installing Debugging Files:: Feeding the debugger.
* Package Modules:: Packages from the programmer's viewpoint.
* Adding New Packages:: Growing the distribution.
* Packaging Guidelines:: Growing the distribution.
* Bootstrapping:: GNU/Linux built from scratch.
* Porting:: Targeting another platform or kernel.
@end menu
@ -1580,41 +1592,14 @@ distribution. The root of this dependency graph is a small set of
bootstrap)} module. For more information on bootstrapping,
@ref{Bootstrapping}.
@node Adding New Packages
@section Adding New Packages
@node Packaging Guidelines
@section Packaging Guidelines
The GNU distribution is nascent and may well lack some of your favorite
packages. This section describes how you can help make the distribution
grow. @ref{Contributing}, for additional information on how you can
grow. @xref{Contributing}, for additional information on how you can
help.
@menu
* Packaging Guidelines:: What goes into the distribution.
* From the Source Tarball to the Package:: The story of a package.
@end menu
@node Packaging Guidelines
@subsection Packaging Guidelines
@c Adapted from http://www.gnu.org/philosophy/philosophy.html.
The GNU operating system has been developed so that users can have
freedom in their computing. GNU is @dfn{free software}, meaning that
users have the @url{http://www.gnu.org/philosophy/free-sw.html,four
essential freedoms}: to run the program, to study and change the program
in source code form, to redistribute exact copies, and to distribute
modified versions. Packages found in the GNU distribution provide only
software that conveys these four freedoms.
In addition, the GNU distribution follow the
@url{http://www.gnu.org/distros/free-system-distribution-guidelines.html,free
software distribution guidelines}. Among other things, these guidelines
reject non-free firmware, recommendations of non-free software, and
discuss ways to deal with trademarks and patents.
@node From the Source Tarball to the Package
@subsection From the Source Tarball, to the Package Definition, to the Binary Package
Free software packages are usually distributed in the form of
@dfn{source code tarballs}---typically @file{tar.gz} files that contain
all the source files. Adding a package to the distribution means
@ -1660,6 +1645,114 @@ package automatically downloads binaries from there (except when using
needed is to review and apply the patch.
@menu
* Software Freedom:: What may go into the distribution.
* Package Naming:: What's in a name?
* Version Numbers:: When the name is not enough.
* Python Modules:: Taming the snake.
@end menu
@node Software Freedom
@subsection Software Freedom
@c Adapted from http://www.gnu.org/philosophy/philosophy.html.
The GNU operating system has been developed so that users can have
freedom in their computing. GNU is @dfn{free software}, meaning that
users have the @url{http://www.gnu.org/philosophy/free-sw.html,four
essential freedoms}: to run the program, to study and change the program
in source code form, to redistribute exact copies, and to distribute
modified versions. Packages found in the GNU distribution provide only
software that conveys these four freedoms.
In addition, the GNU distribution follow the
@url{http://www.gnu.org/distros/free-system-distribution-guidelines.html,free
software distribution guidelines}. Among other things, these guidelines
reject non-free firmware, recommendations of non-free software, and
discuss ways to deal with trademarks and patents.
@node Package Naming
@subsection Package Naming
A package has actually two names associated with it:
First, there is the name of the @emph{Scheme variable}, the one following
@code{define-public}. By this name, the package can be made known in the
Scheme code, for instance as input to another package. Second, there is
the string in the @code{name} field of a package definition. This name
is used by package management commands such as
@command{guix package} and @command{guix build}.
Both are usually the same and correspond to the lowercase conversion of the
project name chosen upstream. For instance, the GNUnet project is packaged
as @code{gnunet}. We do not add @code{lib} prefixes for library packages,
unless these are already part of the official project name. But see
@ref{Python Modules} for special rules concerning modules for
the Python language.
@node Version Numbers
@subsection Version Numbers
We usually package only the latest version of a given free software
project. But sometimes, for instance for incompatible library versions,
two (or more) versions of the same package are needed. These require
different Scheme variable names. We use the name as defined
in @ref{Package Naming}
for the most recent version; previous versions use the same name, suffixed
by @code{-} and the smallest prefix of the version number that may
distinguish the two versions.
The name inside the package definition is the same for all versions of a
package and does not contain any version number.
For instance, the versions 2.24.20 and 3.9.12 of GTK+ may be packaged as follows:
@example
(define-public gtk+
(package
(name "gtk+")
(version "3.9.12")
...))
(define-public gtk+-2
(package
(name "gtk+")
(version "2.24.20")
...))
@end example
If we also wanted GTK+ 3.8.2, this would be packaged as
@example
(define-public gtk+-3.8
(package
(name "gtk+")
(version "3.8.2")
...))
@end example
@node Python Modules
@subsection Python Modules
We currently package Python 2 and Python 3, under the Scheme variable names
@code{python-2} and @code{python} as explained in @ref{Version Numbers}.
To avoid confusion and naming clashes with other programming languages, it
seems desirable that the name of a package for a Python module contains
the word @code{python}.
Some modules are compatible with only one version of Python, others with both.
If the package Foo compiles only with Python 3, we name it
@code{python-foo}; if it compiles only with Python 2, we name it
@code{python2-foo}. If it is compatible with both versions, we create two
packages with the corresponding names.
If a project already contains the word @code{python}, we drop this;
for instance, the module python-dateutil is packaged under the names
@code{python-dateutil} and @code{python2-dateutil}.
@node Bootstrapping
@section Bootstrapping
@ -1694,7 +1787,7 @@ re-create them if needed (more on that later.)
@c As of Emacs 24.3, Info-mode displays the image, but since it's a
@c large image, it's hard to scroll. Oh well.
@image{images/bootstrap-graph,,,Dependency graph of the early bootstrap derivations}
@image{images/bootstrap-graph,6in,,Dependency graph of the early bootstrap derivations}
The figure above shows the very beginning of the dependency graph of the
distribution, corresponding to the package definitions of the @code{(gnu
@ -1829,8 +1922,8 @@ reason.
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{Adding
New Packages}).
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,

2
gnu-system.am
View File

@ -176,6 +176,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/xml.scm \
gnu/packages/xnee.scm \
gnu/packages/xorg.scm \
gnu/packages/yasm.scm \
gnu/packages/zile.scm \
gnu/packages/zip.scm \
gnu/system/vm.scm
@ -207,6 +208,7 @@ dist_patch_DATA = \
gnu/packages/patches/guile-default-utf8.patch \
gnu/packages/patches/guile-linux-syscalls.patch \
gnu/packages/patches/guile-relocatable.patch \
gnu/packages/patches/hop-bigloo-4.0b.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libtool-skip-tests.patch \
gnu/packages/patches/m4-gets-undeclared.patch \

30
gnu/packages/algebra.scm
View File

@ -78,43 +78,17 @@ solve the shortest vector problem.")
(license lgpl2.1+)
(home-page "http://perso.ens-lyon.fr/damien.stehle/fplll/")))
(define-public gsl
(package
(name "gsl")
(version "1.15")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gsl/gsl-"
version ".tar.gz"))
(sha256
(base32
"18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/gsl/")
(synopsis "Numerical library for C and C++")
(description
"The GNU Scientific Library (GSL) is a numerical library for C
and C++ programmers. It is free software under the GNU General
Public License.
The library provides a wide range of mathematical routines such
as random number generators, special functions and least-squares
fitting. There are over 1000 functions in total with an
extensive test suite.")
(license gpl3+)))
(define-public pari-gp
(package
(name "pari-gp")
(version "2.5.3")
(version "2.5.4")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-"
version ".tar.gz"))
(sha256 (base32
"0zsjccnnv00kwj2gk3ww2v530kjin1rgj8p8hbl4pwcnwc7m68gl"))))
"0gpsj5n8d1gyl7nq2y915sscs3d334ryrv8qgjdwqf3cr95f2dwz"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("perl" ,perl)

7
gnu/packages/bootstrap.scm
View File

@ -184,9 +184,10 @@ cd $out
$out/bin/guile --version~%"
mkdir xz guile tar)
(list mkdir xz guile tar))))
(derivation store name system
bash `(,builder) '()
`((,bash) (,builder)))))))))
(derivation store name
bash `(,builder)
#:system system
#:inputs `((,bash) (,builder)))))))))
(package
(name "guile-bootstrap")
(version "2.0")

1
gnu/packages/compression.scm
View File

@ -189,6 +189,7 @@ than gzip and 15 % smaller output than bzip2.")
(base32
"0wryshs446s7cclrbjykyj766znhcpnr7s3cxy33ybfn6vwfcygz"))))
(build-system gnu-build-system)
(arguments '(#:configure-flags '("--enable-shared")))
(home-page "http://www.oberhumer.com/opensource/lzo")
(synopsis
"A data compresion library suitable for real-time data de-/compression")

59
gnu/packages/glib.scm
View File

@ -185,3 +185,62 @@ The intltool collection can be used to do these things:
Merge back the translations from .po files into .xml, .desktop and
oaf files. This merge step will happen at build resp. installation time.")
(license license:gpl2+)))
(define-public itstool
(package
(name "itstool")
(version "1.2.0")
(source (origin
(method url-fetch)
(uri (string-append "http://files.itstool.org/itstool/itstool-"
version ".tar.bz2"))
(sha256
(base32
"1akq75aflihm3y7js8biy7b5mw2g11vl8yq90gydnwlwp0zxdzj6"))))
(build-system gnu-build-system)
(home-page "http://www.itstool.org")
(synopsis "Tool to translate XML documents with PO files")
(description
"ITS Tool allows you to translate your XML documents with PO files, using
rules from the W3C Internationalization Tag Set (ITS) to determine what to
translate and how to separate it into PO file messages.
PO files are the standard translation format for GNU and other Unix-like
systems. They present translatable information as discrete messages, allowing
each message to be translated independently. In contrast to whole-page
translation, translating with a message-based format like PO means you can
easily track changes to the source document down to the paragraph. When new
strings are added or existing strings are modified, you only need to update the
corresponding messages.
ITS Tool is designed to make XML documents translatable through PO files by
applying standard ITS rules, as well as extension rules specific to ITS Tool.
ITS also provides an industry standard way for authors to override translation
information in their documents, such as whether a particular element should be
translated.")
(license license:gpl3+)))
(define-public dbus-glib
(package
(name "dbus-glib")
(version "0.100.2")
(source (origin
(method url-fetch)
(uri
(string-append "http://dbus.freedesktop.org/releases/dbus-glib/dbus-glib-"
version ".tar.gz"))
(sha256
(base32
"1ibav91yg70f2l3l18cr0hf4mna1h9d4mrg0c60w4l8zjbd45fx5"))))
(build-system gnu-build-system)
(inputs
`(("dbus" ,dbus)
("expat" ,expat)
("glib" ,glib)
("pkg-config" ,pkg-config)))
(home-page "http://dbus.freedesktop.org/doc/dbus-glib/")
(synopsis "D-Bus GLib bindings")
(description
"GLib bindings for D-Bus. The package is obsolete and superseded
by GDBus included in Glib.")
(license license:gpl2))) ; or Academic Free License 2.1

62
gnu/packages/grub.scm
View File

@ -19,6 +19,9 @@
(define-module (gnu packages grub)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module ((guix licenses) #:select (gpl3+))
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
@ -30,7 +33,11 @@
#:use-module (gnu packages qemu)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages cdrom)
#:use-module (srfi srfi-1))
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (menu-entry
menu-entry?
grub-configuration-file))
(define qemu-for-tests
;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
@ -110,3 +117,56 @@ computer starts. It is responsible for loading and transferring control to
the operating system kernel software (such as the Hurd or the Linux). The
kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
(license gpl3+)))
;;;
;;; Configuration.
;;;
(define-record-type* <menu-entry>
menu-entry make-menu-entry
menu-entry?
(label menu-entry-label)
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '()))
(initrd menu-entry-initrd))
(define* (grub-configuration-file store entries
#:key (default-entry 1) (timeout 5)
(system (%current-system)))
"Return the GRUB configuration file in STORE for ENTRIES, a list of
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
(define prologue
(format #f "
set default=~a
set timeout=~a
search.file ~a~%"
default-entry timeout
(any (match-lambda
(($ <menu-entry> _ linux)
(let* ((drv (package-derivation store linux system))
(out (derivation-path->output-path drv)))
(string-append out "/bzImage"))))
entries)))
(define entry->text
(match-lambda
(($ <menu-entry> label linux arguments initrd)
(let ((linux-drv (package-derivation store linux system))
(initrd-drv (package-derivation store initrd system)))
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
(format #f "menuentry ~s {
linux ~a/bzImage ~a
initrd ~a/initrd
}~%"
label
(derivation-path->output-path linux-drv)
(string-join arguments)
(derivation-path->output-path initrd-drv))))))
(add-text-to-store store "grub.cfg"
(string-append prologue
(string-concatenate
(map entry->text entries)))
'()))

8
gnu/packages/gtk.scm
View File

@ -60,14 +60,14 @@ tools have full access to view and control running applications.")
(define-public cairo
(package
(name "cairo")
(version "1.12.14")
(version "1.12.16")
(source (origin
(method url-fetch)
(uri (string-append "http://cairographics.org/releases/cairo-"
version ".tar.xz"))
(sha256
(base32
"04xcykglff58ygs0dkrmmnqljmpjwp2qgwcz8sijqkdpz7ix3l4n"))))
"0inqwsylqkrzcjivdirkjx5nhdgxbdc62fq284c3xppinfg9a195"))))
(build-system gnu-build-system)
(propagated-inputs
`(("fontconfig" ,fontconfig)
@ -110,14 +110,14 @@ affine transformation (scale, rotation, shear, etc.)")
(define-public harfbuzz
(package
(name "harfbuzz")
(version "0.9.19")
(version "0.9.20")
(source (origin
(method url-fetch)
(uri (string-append "http://www.freedesktop.org/software/harfbuzz/release/harfbuzz-"
version ".tar.bz2"))
(sha256
(base32
"0d9g02m5n28lp1bfkl8wxblfmfd43yr1ny68x2fsvxj71l30znnj"))))
"0rxwvd8j4vcadlhx4a7la33clzggxziblx1k43ccbw5w7yh4yf43"))))
(build-system gnu-build-system)
(inputs
`(("cairo" ,cairo)

34
gnu/packages/guile.scm
View File

@ -298,4 +298,38 @@ flexibility in specifying when jobs should be run. Mcron was written by Dale
Mellor.")
(license gpl3+)))
(define-public guile-lib
(package
(name "guile-lib")
(version "0.2.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/guile-lib/guile-lib-"
version ".tar.gz"))
(sha256
(base32
"1f9n2b5b5r75lzjinyk6zp6g20g60msa0jpfrk5hhg4j8cy0ih4b"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'configure 'patch-module-dir
(lambda _
(substitute* "src/Makefile.in"
(("^moddir[[:blank:]]*=[[:blank:]]*([[:graph:]]+)" _ rhs)
(string-append "moddir = " rhs "/2.0\n"))))
%standard-phases)))
(inputs `(("guile" ,guile-2.0)))
(home-page "http://www.nongnu.org/guile-lib/")
(synopsis "Collection of useful Guile Scheme modules")
(description
"guile-lib is intended as an accumulation place for pure-scheme Guile
modules, allowing for people to cooperate integrating their generic Guile
modules into a coherent library. Think \"a down-scaled, limited-scope CPAN
for Guile\".")
;; The whole is under GPLv3+, but some modules are under laxer
;; distribution terms such as LGPL and public domain. See `COPYING' for
;; details.
(license gpl3+)))
;;; guile.scm ends here

4
gnu/packages/imagemagick.scm
View File

@ -37,14 +37,14 @@
(define-public imagemagick
(package
(name "imagemagick")
(version "6.8.6-0")
(version "6.8.6-9")
(source (origin
(method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz"))
(sha256
(base32
"1qmwpnq2mcxjnp0rjyb2g7v87lhmll19imx3iys6kplh8amrmqnv"))))
"1bpj8676mph5cvyjsdgf27i6yg2iw9iskk5c69mvpxkyawgjw1vg"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-cons-before

273
gnu/packages/linux-initrd.scm
View File

@ -19,10 +19,14 @@
(define-module (gnu packages linux-initrd)
#:use-module (guix utils)
#:use-module (guix licenses)
#:use-module (guix build-system)
#:use-module ((guix derivations)
#:select (imported-modules compiled-modules %guile-for-build))
#:use-module (gnu packages)
#:use-module (gnu packages cpio)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (guix packages)
@ -38,6 +42,49 @@
;;; Code:
(define-syntax-rule (raw-build-system (store system name inputs) body ...)
"Lift BODY to a package build system."
;; TODO: Generalize.
(build-system
(name "raw")
(description "Raw build system")
(build (lambda* (store name source inputs #:key system #:allow-other-keys)
(parameterize ((%guile-for-build (package-derivation store
guile-2.0)))
body ...)))))
(define (module-package modules)
"Return a package that contains all of MODULES, a list of Guile module
names."
(package
(name "guile-modules")
(version "0")
(source #f)
(build-system (raw-build-system (store system name inputs)
(imported-modules store modules
#:name name
#:system system)))
(synopsis "Set of Guile modules")
(description synopsis)
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define (compiled-module-package modules)
"Return a package that contains the .go files corresponding to MODULES, a
list of Guile module names."
(package
(name "guile-compiled-modules")
(version "0")
(source #f)
(build-system (raw-build-system (store system name inputs)
(compiled-modules store modules
#:name name
#:system system)))
(synopsis "Set of compiled Guile modules")
(description synopsis)
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define* (expression->initrd exp
#:key
(guile %guile-static-stripped)
@ -45,12 +92,13 @@
(gzip gzip)
(name "guile-initrd")
(system (%current-system))
(modules '())
(linux #f)
(linux-modules '()))
"Return a package that contains a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list
of `.ko' file names to be copied from LINUX into the initrd."
;; TODO: Add a `modules' parameter.
of `.ko' file names to be copied from LINUX into the initrd. MODULES is a
list of Guile module names to be embedded in the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
@ -67,12 +115,22 @@ of `.ko' file names to be copied from LINUX into the initrd."
(rnrs bytevectors)
((system foreign) #:select (sizeof)))
(let ((guile (assoc-ref %build-inputs "guile"))
(cpio (string-append (assoc-ref %build-inputs "cpio")
"/bin/cpio"))
(gzip (string-append (assoc-ref %build-inputs "gzip")
"/bin/gzip"))
(out (assoc-ref %outputs "out")))
(let ((guile (assoc-ref %build-inputs "guile"))
(cpio (string-append (assoc-ref %build-inputs "cpio")
"/bin/cpio"))
(gzip (string-append (assoc-ref %build-inputs "gzip")
"/bin/gzip"))
(modules (assoc-ref %build-inputs "modules"))
(gos (assoc-ref %build-inputs "modules/compiled"))
(scm-dir (string-append "share/guile/" (effective-version)))
(go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
(effective-version)
(if (eq? (native-endianness) (endianness little))
"LE"
"BE")
(sizeof '*)
(effective-version)))
(out (assoc-ref %outputs "out")))
(mkdir out)
(mkdir "contents")
(with-directory-excursion "contents"
@ -84,19 +142,23 @@ of `.ko' file names to be copied from LINUX into the initrd."
(chmod "init" #o555)
(chmod "bin/guile" #o555)
;; Compile `init'.
(let ((go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
(effective-version)
(if (eq? (native-endianness) (endianness little))
"LE"
"BE")
(sizeof '*)
(effective-version))))
(mkdir-p go-dir)
(compile-file "init"
#:opts %auto-compilation-options
#:output-file (string-append go-dir "/init.go")))
;; Copy Guile modules.
(chmod scm-dir #o777)
(copy-recursively modules scm-dir
#:follow-symlinks? #t)
(copy-recursively gos (string-append "lib/guile/"
(effective-version) "/ccache")
#:follow-symlinks? #t)
;; Compile `init'.
(mkdir-p go-dir)
(set! %load-path (cons modules %load-path))
(set! %load-compiled-path (cons gos %load-compiled-path))
(compile-file "init"
#:opts %auto-compilation-options
#:output-file (string-append go-dir "/init.go"))
;; Copy Linux modules.
(let* ((linux (assoc-ref %build-inputs "linux"))
(module-dir (and linux
(string-append linux "/lib/modules"))))
@ -161,6 +223,8 @@ of `.ko' file names to be copied from LINUX into the initrd."
(inputs `(("guile" ,guile)
("cpio" ,cpio)
("gzip" ,gzip)
("modules" ,(module-package modules))
("modules/compiled" ,(compiled-module-package modules))
,@(if linux
`(("linux" ,linux))
'())))
@ -174,26 +238,18 @@ the Linux kernel.")
(define-public qemu-initrd
(expression->initrd
'(begin
(use-modules (rnrs io ports)
(srfi srfi-1)
(use-modules (srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
((system foreign) #:select (string->pointer))
((system base compile) #:select (compile-file)))
((system base compile) #:select (compile-file))
(guix build utils)
(guix build linux-initrd))
(display "Welcome, this is GNU/Guile!\n")
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
(mkdir "/proc")
(mount "none" "/proc" "proc")
(mkdir "/sys")
(mount "none" "/sys" "sysfs")
(let* ((command (string-trim-both
(call-with-input-file "/proc/cmdline"
get-string-all)))
(args (string-split command char-set:blank))
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(option (lambda (opt)
(let ((opt (string-append opt "=")))
(and=> (find (cut string-prefix? opt <>)
@ -206,34 +262,16 @@ the Linux kernel.")
(when (member "--repl" args)
((@ (system repl repl) start-repl)))
(let ((slurp (lambda (module)
(call-with-input-file
(string-append "/modules/" module)
get-bytevector-all))))
(display "loading CIFS and companion modules...\n")
(for-each (compose load-linux-module slurp)
(list "md4.ko" "ecb.ko" "cifs.ko")))
(display "loading CIFS and companion modules...\n")
(for-each (compose load-linux-module*
(cut string-append "/modules/" <>))
(list "md4.ko" "ecb.ko" "cifs.ko"))
;; See net/slirp.c for default QEMU networking values.
(display "configuring network...\n")
(let* ((sock (socket AF_INET SOCK_STREAM 0))
(address (make-socket-address AF_INET
(inet-pton AF_INET
"10.0.2.10")
0))
(flags (network-interface-flags sock "eth0")))
(set-network-interface-address sock "eth0" address)
(set-network-interface-flags sock "eth0"
(logior flags IFF_UP))
(if (logand (network-interface-flags sock "eth0") IFF_UP)
(display "network interface is up\n")
(display "network interface is DOWN\n"))
(unless (configure-qemu-networking)
(display "network interface is DOWN\n"))
(mkdir "/etc")
(call-with-output-file "/etc/resolv.conf"
(lambda (p)
(display "nameserver 10.0.2.3\n" p)))
(sleep 1))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
@ -241,27 +279,31 @@ the Linux kernel.")
(if root
(mount root "/root" "ext3")
(mount "none" "/root" "tmpfs"))
(mkdir "/root/proc")
(mount "none" "/root/proc" "proc")
(mkdir "/root/sys")
(mount "none" "/root/sys" "sysfs")
(mkdir "/root/xchg")
(mkdir "/root/nix")
(mkdir "/root/nix/store")
(mount-essential-file-systems #:root "/root")
(mkdir "/root/dev")
(let ((makedev (lambda (major minor)
(+ (* major 256) minor))))
(mknod "/root/dev/null" 'char-special #o666 (makedev 1 3))
(mknod "/root/dev/zero" 'char-special #o666 (makedev 1 5)))
(mkdir "/root/xchg")
(mkdir-p "/root/nix/store")
(unless (file-exists? "/root/dev")
(mkdir "/root/dev")
(make-essential-device-nodes #:root "/root"))
;; Mount the host's store and exchange directory.
(display "mounting QEMU's SMB shares...\n")
(let ((server "10.0.2.4"))
(mount (string-append "//" server "/store") "/root/nix/store" "cifs" 0
(string->pointer "guest,sec=none"))
(mount (string-append "//" server "/xchg") "/root/xchg" "cifs" 0
(string->pointer "guest,sec=none")))
(mount-qemu-smb-share "/store" "/root/nix/store")
(mount-qemu-smb-share "/xchg" "/root/xchg")
;; Copy the directories that contain .scm and .go files so that the
;; child process in the chroot can load modules (we would bind-mount
;; them but for some reason that fails with EINVAL -- XXX).
(mkdir "/root/share")
(mkdir "/root/lib")
(mount "none" "/root/share" "tmpfs")
(mount "none" "/root/lib" "tmpfs")
(copy-recursively "/share" "/root/share"
#:log (%make-void-port "w"))
(copy-recursively "/lib" "/root/lib"
#:log (%make-void-port "w"))
(if to-load
(begin
@ -272,7 +314,10 @@ the Linux kernel.")
(match (primitive-fork)
(0
(chroot "/root")
(load-compiled "/loader.go"))
(load-compiled "/loader.go")
;; TODO: Remove /lib, /share, and /loader.go.
)
(pid
(format #t "boot file loaded under PID ~a~%" pid)
(let ((status (waitpid pid)))
@ -282,7 +327,75 @@ the Linux kernel.")
(display "entering a warm and cozy REPL\n")
((@ (system repl repl) start-repl))))))
#:name "qemu-initrd"
#:modules '((guix build utils)
(guix build linux-initrd))
#:linux linux-libre
#:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
(define-public gnu-system-initrd
;; Initrd for the GNU system itself, with nothing QEMU-specific.
(expression->initrd
'(begin
(use-modules (srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(guix build utils)
(guix build linux-initrd))
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(option (lambda (opt)
(let ((opt (string-append opt "=")))
(and=> (find (cut string-prefix? opt <>)
args)
(lambda (arg)
(substring arg (+ 1 (string-index arg #\=))))))))
(to-load (option "--load"))
(root (option "--root")))
(when (member "--repl" args)
((@ (system repl repl) start-repl)))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
(mkdir "/root"))
(if root
;; Assume ROOT has a usable /dev tree.
(mount root "/root" "ext3")
(begin
(mount "none" "/root" "tmpfs")
(make-essential-device-nodes #:root "/root")))
(mount-essential-file-systems #:root "/root")
;; XXX: We don't copy our fellow Guile modules to /root (see
;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can
;; happen if it throws, to display the exception!), then we're
;; screwed. Hopefully TO-LOAD is a simple expression that just does
;; '(execlp ...)'.
(if to-load
(begin
(format #t "loading '~a'...\n" to-load)
(chroot "/root")
(primitive-load to-load)
(format (current-error-port)
"boot program '~a' terminated, rebooting~%")
(sleep 2)
(reboot))
(begin
(display "no init file passed via '--exec'\n")
(display "entering a warm and cozy REPL\n")
((@ (system repl repl) start-repl))))))
#:name "qemu-system-initrd"
#:modules '((guix build linux-initrd)
(guix build utils))
#:linux linux-libre))
;;; linux-initrd.scm ends here

6
gnu/packages/linux.scm
View File

@ -29,6 +29,7 @@
#:use-module (gnu packages bdb)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages algebra)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
@ -146,7 +147,7 @@
(license gpl2+)))
(define-public linux-libre
(let* ((version* "3.3.8")
(let* ((version* "3.11")
(build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-))))
@ -192,9 +193,10 @@
(uri (linux-libre-urls version))
(sha256
(base32
"0jkfh0z1s6izvdnc3njm39dhzp1cg8i06jv06izwqz9w9qsprvnl"))))
"1vlk04xkvyy1kc9zz556md173rn1qzlnvhz7c9sljv4bpk3mdspl"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)
("module-init-tools" ,module-init-tools)))
(arguments
`(#:modules ((guix build gnu-build-system)

5
gnu/packages/make-bootstrap.scm
View File

@ -127,7 +127,10 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
;; cross-compiling).
(inputs (match (assoc "perl" (package-inputs coreutils))
(#f '())
(x (list x))))))
(x (list x))))
;; Remove the `debug' output.
(outputs '("out"))))
(bzip2 (package (inherit bzip2)
(arguments
(substitute-keyword-arguments (package-arguments bzip2)

40
gnu/packages/maths.scm
View File

@ -23,7 +23,6 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages algebra)
#:use-module (gnu packages compression)
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'gnu:))
@ -67,6 +66,45 @@ the standard data file.")
(license license:gpl3+)
(home-page "http://www.gnu.org/software/units/")))
(define-public gsl
(package
(name "gsl")
(version "1.15")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gsl/gsl-"
version ".tar.gz"))
(sha256
(base32
"18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key target system outputs #:allow-other-keys #:rest args)
(let ((configure (assoc-ref %standard-phases 'configure)))
;; disable numerically unstable test on i686, see thread at
;; http://lists.gnu.org/archive/html/bug-gsl/2011-11/msg00019.html
(if (string=? (or target system) "i686-linux")
(substitute* "ode-initval2/Makefile.in"
(("TESTS = \\$\\(check_PROGRAMS\\)") "TESTS =")))
(apply configure args)))
%standard-phases)))
(home-page "http://www.gnu.org/software/gsl/")
(synopsis "Numerical library for C and C++")
(description
"The GNU Scientific Library (GSL) is a numerical library for C
and C++ programmers. It is free software under the GNU General
Public License.
The library provides a wide range of mathematical routines such
as random number generators, special functions and least-squares
fitting. There are over 1000 functions in total with an
extensive test suite.")
(license license:gpl3+)))
(define-public pspp
(package
(name "pspp")

122
gnu/packages/patches/hop-bigloo-4.0b.patch Normal file
View File

@ -0,0 +1,122 @@
Bigloo 4.0b removes `xml-attribute-encode', which leads to a build failure
in Hop.
This patch allows Hop to be compiled with Bigloo 4.0b.
changeset: 3327:3515f7f1aef2
branch: 2.4.x
user: Manuel Serrano <Manuel.Serrano@inria.fr>
date: Wed Jul 31 12:41:10 2013 +0200
summary: Fix serialization bug
diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/js_comp.scm
--- a/runtime/js_comp.scm Fri Jul 19 08:28:13 2013 +0200
+++ b/runtime/js_comp.scm Wed Jul 31 12:41:10 2013 +0200
@@ -143,10 +143,17 @@
(display "{ " op)
(display-seq fields op
(lambda (f op)
+ (let ((iv (class-field-info f)))
(display "'" op)
(display (class-field-name f) op)
(display "': " op)
- (compile ((class-field-accessor f) obj) op)))
+ (cond
+ ((and (pair? iv) (memq :client iv))
+ =>
+ (lambda (x)
+ (compile (when (pair? (cdr x)) (cadr x)) op)))
+ (else
+ (compile ((class-field-accessor f) obj) op))))))
(display "}" op))
(let ((klass (object-class obj)))
diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/xml.scm
--- a/runtime/xml.scm Fri Jul 19 08:28:13 2013 +0200
+++ b/runtime/xml.scm Wed Jul 31 12:41:10 2013 +0200
@@ -55,6 +55,7 @@
(generic xml-write-attribute ::obj ::obj ::output-port ::xml-backend)
(generic xml-write-expression ::obj ::output-port)
(xml-write-attributes ::pair-nil ::output-port ::xml-backend)
+ (xml-attribute-encode obj)
(xml->string ::obj ::xml-backend)
@@ -613,6 +614,52 @@
(display ">" p))))
;*---------------------------------------------------------------------*/
+;* xml-attribute-encode ... */
+;*---------------------------------------------------------------------*/
+(define (xml-attribute-encode obj)
+ (if (not (string? obj))
+ obj
+ (let ((ol (string-length obj)))
+ (define (count str ol)
+ (let loop ((i 0)
+ (j 0))
+ (if (=fx i ol)
+ j
+ (let ((c (string-ref str i)))
+ ;; attribute values should escape &#...
+ (if (or (char=? c #\') (char=? c #\&))
+ (loop (+fx i 1) (+fx j 5))
+ (loop (+fx i 1) (+fx j 1)))))))
+ (define (encode str ol nl)
+ (if (=fx nl ol)
+ obj
+ (let ((nstr (make-string nl)))
+ (let loop ((i 0)
+ (j 0))
+ (if (=fx j nl)
+ nstr
+ (let ((c (string-ref str i)))
+ (case c
+ ((#\')
+ (string-set! nstr j #\&)
+ (string-set! nstr (+fx j 1) #\#)
+ (string-set! nstr (+fx j 2) #\3)
+ (string-set! nstr (+fx j 3) #\9)
+ (string-set! nstr (+fx j 4) #\;)
+ (loop (+fx i 1) (+fx j 5)))
+ ((#\&)
+ (string-set! nstr j #\&)
+ (string-set! nstr (+fx j 1) #\#)
+ (string-set! nstr (+fx j 2) #\3)
+ (string-set! nstr (+fx j 3) #\8)
+ (string-set! nstr (+fx j 4) #\;)
+ (loop (+fx i 1) (+fx j 5)))
+ (else
+ (string-set! nstr j c)
+ (loop (+fx i 1) (+fx j 1))))))))))
+ (encode obj ol (count obj ol)))))
+
+;*---------------------------------------------------------------------*/
;* xml-write-attributes ... */
;*---------------------------------------------------------------------*/
(define (xml-write-attributes attr p backend)
diff -r 7244c4d30ad4 -r 3515f7f1aef2 share/hop-serialize.js
--- a/share/hop-serialize.js Fri Jul 19 08:28:13 2013 +0200
+++ b/share/hop-serialize.js Wed Jul 31 12:41:10 2013 +0200
@@ -942,7 +942,7 @@
case 0x2e /* . */: return null;
case 0x3c /* < */: return read_cnst();
case 0x22 /* " */: return read_string( s );
- case 0x25 /* " */: return decodeURIComponent( read_string( s ) );
+ case 0x25 /* % */: return decodeURIComponent( read_string( s ) );
case 0x55 /* U */: return read_string( s );
case 0x5b /* [ */: return read_vector( read_size( s ) );
case 0x28 /* ( */: return read_list( read_size( s ) );
diff -r 7244c4d30ad4 -r 3515f7f1aef2 src/main.scm
--- a/src/main.scm Fri Jul 19 08:28:13 2013 +0200
+++ b/src/main.scm Wed Jul 31 12:41:10 2013 +0200
@@ -59,8 +59,6 @@
(for-each register-srfi! (cons 'hop-server (hop-srfis)))
;; set the library load path
(bigloo-library-path-set! (hop-library-path))
- ;; define the Hop macros
- (hop-install-expanders!)
;; setup the hop readers
(bigloo-load-reader-set! hop-read)
(bigloo-load-module-set!

65
gnu/packages/python.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,7 +34,7 @@
(define-public python
(package
(name "python")
(version "2.7.4")
(version "2.7.5")
(source
(origin
(method url-fetch)
@ -41,10 +42,52 @@
version "/Python-" version ".tar.xz"))
(sha256
(base32
"0bdn4dylm92n2dsvqvjfyask9jbz88aan5hi4lgkawkxs2v6wqmn"))))
"1c8xan2dlsqfq8q82r3mhl72v3knq3qyn71fjq89xikx2smlqg7k"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; XXX: some tests fail
`(#:tests? #f
;; 258 tests OK.
;; 103 tests failed:
;; test_bz2 test_distutils test_file test_file2k test_popen2
;; test_shutil test_signal test_site test_slice test_smtplib
;; test_smtpnet test_socket test_socketserver test_softspace
;; test_sort test_sqlite test_ssl test_startfile test_str
;; test_strftime test_string test_stringprep test_strop test_strptime
;; test_strtod test_struct test_structmembers test_structseq
;; test_subprocess test_sunaudiodev test_sundry test_symtable
;; test_syntax test_sys test_sys_setprofile test_sys_settrace
;; test_sysconfig test_tarfile test_tcl test_telnetlib test_tempfile
;; test_textwrap test_thread test_threaded_import
;; test_threadedtempfile test_threading test_threading_local
;; test_threadsignals test_time test_timeout test_tk test_tokenize
;; test_tools test_trace test_traceback test_transformer
;; test_ttk_guionly test_ttk_textonly test_tuple test_typechecks
;; test_ucn test_unary test_undocumented_details test_unicode
;; test_unicode_file test_unicodedata test_univnewlines
;; test_univnewlines2k test_unpack test_urllib test_urllib2
;; test_urllib2_localnet test_urllib2net test_urllibnet test_urlparse
;; test_userdict test_userlist test_userstring test_uu test_uuid
;; test_wait3 test_wait4 test_warnings test_wave test_weakref
;; test_weakset test_whichdb test_winreg test_winsound test_with
;; test_wsgiref test_xdrlib test_xml_etree test_xml_etree_c
;; test_xmllib test_xmlrpc test_xpickle test_xrange test_zipfile
;; test_zipfile64 test_zipimport test_zipimport_support test_zlib
;; 31 tests skipped:
;; test_aepack test_al test_applesingle test_ascii_formatd test_bsddb
;; test_bsddb185 test_bsddb3 test_cd test_cl test_codecmaps_cn
;; test_codecmaps_hk test_codecmaps_jp test_codecmaps_kr
;; test_codecmaps_tw test_ctypes test_curses test_dl test_gdb test_gl
;; test_imageop test_imgfile test_ioctl test_kqueue
;; test_linuxaudiodev test_macos test_macostools test_msilib
;; test_multiprocessing test_ossaudiodev test_pep277
;; test_scriptpackages
;; 7 skips unexpected on linux2:
;; test_ascii_formatd test_bsddb test_bsddb3 test_ctypes test_gdb
;; test_ioctl test_multiprocessing
;; One of the typical errors:
;; test_unicode
;; test test_unicode crashed -- <type 'exceptions.OSError'>: [Errno 2] No such file or directory
#:test-target "test"
#:configure-flags
(let ((bz2 (assoc-ref %build-inputs "bzip2"))
(gdbm (assoc-ref %build-inputs "gdbm"))
@ -108,6 +151,22 @@ packages; exception-based error handling; and very high level dynamic
data types.")
(license psfl)))
(define-public python-3
(package (inherit python)
(version "3.3.2")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.python.org/ftp/python/"
version "/Python-" version ".tar.xz"))
(sha256
(base32
"0hsbwqjnhr85a2w252c8d3yj8d9i5sy8s6a6cfk6zqqhp3234nvl"))))
(native-search-paths
(list (search-path-specification
(variable "PYTHONPATH")
(directories '("lib/python3.3/site-packages")))))))
(define-public pytz
(package
(name "pytz")

6
gnu/packages/scheme.scm
View File

@ -251,6 +251,7 @@ between Scheme and C# programs.")
"\\.so$")))))
%standard-phases))
#:tests? #f ; no test suite
#:patches (list (assoc-ref %build-inputs "patch/bigloo-4.0b"))
#:modules ((guix build gnu-build-system)
(guix build utils)
(ice-9 popen)
@ -259,7 +260,10 @@ between Scheme and C# programs.")
(srfi srfi-1))))
(inputs `(("bigloo" ,bigloo)
("which" ,which)
("patchelf" ,patchelf)))
("patchelf" ,patchelf)
("patch/bigloo-4.0b"
,(search-patch "hop-bigloo-4.0b.patch"))))
(home-page "http://hop.inria.fr/")
(synopsis "A multi-tier programming language for the Web 2.0")
(description

95
gnu/packages/system.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,11 +21,55 @@
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages linux))
(define-public dfc
(package
(name "dfc")
(version "3.0.3")
(source
(origin
(method url-fetch)
(uri (string-append
"http://projects.gw-computing.net/attachments/download/78/dfc-"
version ".tar.gz"))
(sha256
(base32
"1b4hfqv23l87cb37fxwzfk2sgspkyxpr3ig2hsd23hr6mm982j7z"))))
(build-system cmake-build-system)
(arguments '(#:tests? #f)) ; There are no tests.
(home-page "http://projects.gw-computing.net/projects/dfc")
(synopsis "Display file system space usage using graphs and colors")
(description
"dfc (df color) is a modern version of df. It uses colors, draws pretty
graphs and can export its output to different formats.")
(license bsd-3)))
(define-public htop
(package
(name "htop")
(version "1.0.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/htop/"
version "/htop-" version ".tar.gz"))
(sha256
(base32
"18fqrhvnm7h4c3939av8lpiwrwxbyw6hcly0jvq0vkjf0ixnaq7f"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)))
(home-page "http://htop.sourceforge.net/")
(synopsis "Interactive process viewer")
(description
"This is htop, an interactive process viewer. It is a text-mode
application (for console or X terminals) and requires ncurses.")
(license gpl2)))
(define-public pies
(package
(name "pies")
@ -141,3 +186,53 @@ login, passwd, su, groupadd, and useradd.")
;; The `vipw' program is GPLv2+.
;; libmisc/salt.c is public domain.
(license bsd-3)))
(define-public mingetty
(package
(name "mingetty")
(version "1.08")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/mingetty/mingetty-"
version ".tar.gz"))
(sha256
(base32
"05yxrp44ky2kg6qknk1ih0kvwkgbn9fbz77r3vci7agslh5wjm8g"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-replace 'configure
(lambda* (#:key inputs outputs
#:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(man8 (string-append
out "/share/man/man8"))
(sbin (string-append out "/sbin"))
(shadow (assoc-ref inputs "shadow"))
(login (string-append shadow
"/bin/login")))
(substitute* "Makefile"
(("^SBINDIR.*")
(string-append "SBINDIR = " out
"/sbin\n"))
(("^MANDIR.*")
(string-append "MANDIR = " out
"/share/man/man8\n")))
;; Pick the right 'login' by default.
(substitute* "mingetty.c"
(("\"/bin/login\"")
(string-append "\"" login "\"")))
(mkdir-p sbin)
(mkdir-p man8)))
%standard-phases)
#:tests? #f)) ; no tests
(inputs `(("shadow" ,shadow)))
(home-page "http://sourceforge.net/projects/mingetty")
(synopsis "Getty for the text console")
(description
"Small console getty that is started on the Linux text console,
asks for a login name and then transfers over to 'login'. It is extended to
allow automatic login and starting any app.")
(license gpl2+)))

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

@ -2,6 +2,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages version-control)
#:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2+ gpl3+))
#:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2 gpl2+ gpl3+))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
@ -28,11 +29,14 @@
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (gnu packages apr)
#:use-module (gnu packages curl)
#:use-module (gnu packages nano)
#:use-module (gnu packages openssl)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages system)
#:use-module (gnu packages xml)
#:use-module (gnu packages emacs)
#:use-module (gnu packages compression))
@ -64,6 +68,48 @@ organize their workspace in whichever way they want. It is possible to work
from a command line or use a GUI application.")
(license gpl2+)))
(define-public git
(package
(name "git")
(version "1.8.4")
(source (origin
(method url-fetch)
(uri (string-append "http://git-core.googlecode.com/files/git-"
version ".tar.gz"))
(sha256
(base32
"156bwqqgaw65rsvbb4wih5jfg94bxyf6p16mdwf0ky3f4ln55s2i"))))
(build-system gnu-build-system)
(inputs
`(("curl" ,curl)
("expat" ,expat)
("gettext" ,guix:gettext)
("openssl" ,openssl)
("perl" ,perl)
("python" ,python) ; CAVEAT: incompatible with python-3 according to INSTALL
("zlib" ,zlib)))
(arguments
`(#:make-flags `("V=1") ; more verbose compilation
#:test-target "test"
#:tests? #f ; FIXME: Many tests are failing
#:phases
(alist-replace
'configure
(lambda* (#:key #:allow-other-keys #:rest args)
(let ((configure (assoc-ref %standard-phases 'configure)))
(and (apply configure args)
(substitute* "Makefile"
(("/bin/sh") (which "sh"))
(("/usr/bin/perl") (which "perl"))
(("/usr/bin/python") (which "python"))))))
%standard-phases)))
(synopsis "Distributed version control system")
(description
"Git is a free distributed version control system designed to handle
everything from small to very large projects with speed and efficiency.")
(license gpl2)
(home-page "http://git-scm.com/")))
(define-public subversion
(package
(name "subversion")

27
gnu/packages/xml.scm
View File

@ -28,7 +28,8 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system perl))
#:use-module (guix build-system perl)
#:use-module (gnu packages linux))
(define-public expat
(package
@ -138,3 +139,27 @@ then passed on to the Expat object on each parse call. They can also be given
as extra arguments to the parse methods, in which case they override options
given at XML::Parser creation time.")
(home-page "http://search.cpan.org/~toddr/XML-Parser-2.41/Parser.pm")))
(define-public xmlto
(package
(name "xmlto")
(version "0.0.25")
(source
(origin
(method url-fetch)
(uri (string-append
"https://fedorahosted.org/releases/x/m/xmlto/xmlto-"
version ".tar.bz2"))
(sha256
(base32
"0dp5nxq491gymq806za0dk4hngfmq65ysrqbn0ypajqbbl6vf71n"))))
(build-system gnu-build-system)
(inputs
`(("util-linux" ,util-linux)))
(home-page "http://cyberelk.net/tim/software/xmlto/")
(synopsis "Front-end to an XSL toolchain")
(description
"Xmlto is a front-end to an XSL toolchain. It chooses an appropriate
stylesheet for the conversion you want and applies it using an external
XSL-T processor. It also performs any necessary post-processing.")
(license license:gpl2+)))

8
gnu/packages/xorg.scm
View File

@ -100,7 +100,7 @@ rasterisation.")
(define-public libdrm
(package
(name "libdrm")
(version "2.4.42")
(version "2.4.46")
(source
(origin
(method url-fetch)
@ -110,7 +110,7 @@ rasterisation.")
".tar.bz2"))
(sha256
(base32
"1qbnpi64hyqzd650hj6jki1d50pzypdhj3rw9m3whwbqly110rz0"))))
"1wah4qmrrcv0gnx65lhrlxb6gprxch92wy8lhxv6102fml6k5krk"))))
(build-system gnu-build-system)
(inputs
`(("libpciaccess" ,libpciaccess)
@ -4139,9 +4139,9 @@ tracking.")
(define-public mesa
(package
(name "mesa")
;; In newer versions (9.0.5 and 9.1 tested), "make" results in an
;; In newer versions (9.0.5, 9.1 and 9.2 tested), "make" results in an
;; infinite configure loop, see
;; https://bugs.freedesktop.org/show_bug.cgi?id=61527
;; https://bugs.freedesktop.org/show_bug.cgi?id=58812
(version "8.0.5")
(source
(origin

55
gnu/packages/yasm.scm Normal file
View File

@ -0,0 +1,55 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; 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 yasm)
#:use-module (gnu packages)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages python)
#:use-module (gnu packages xml))
(define-public yasm
(package
(name "yasm")
(version "1.2.0")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.tortall.net/projects/yasm/releases/yasm-"
version ".tar.gz"))
(sha256
(base32
"0cfg7ji3ia2in628w42wrfvw2ixmmm4rghwmv2k202mraysgm3vn"))))
(build-system gnu-build-system)
(inputs
`(("python" ,python)
("xmlto" ,xmlto)))
(home-page "http://yasm.tortall.net/")
(synopsis "Rewrite of the NASM assembler")
(description
"Yasm is a complete rewrite of the NASM assembler.
Yasm currently supports the x86 and AMD64 instruction sets, accepts NASM
and GAS assembler syntaxes, outputs binary, ELF32, ELF64, 32 and 64-bit
Mach-O, RDOFF2, COFF, Win32, and Win64 object formats, and generates source
debugging information in STABS, DWARF 2, and CodeView 8 formats.")
(license (license:bsd-style "file://COPYING"
"See COPYING in the distribution."))))

347
gnu/system/vm.scm
View File

@ -17,10 +17,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system vm)
#:use-module (guix config)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module ((gnu packages base) #:select (%final-inputs guile-final))
#:use-module ((gnu packages base) #:select (%final-inputs
guile-final
coreutils))
#:use-module (gnu packages guile)
#:use-module (gnu packages bash)
#:use-module (gnu packages qemu)
#:use-module (gnu packages parted)
#:use-module (gnu packages grub)
@ -28,6 +33,9 @@
#:use-module (gnu packages linux-initrd)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module ((gnu packages system)
#:select (mingetty))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (expression->derivation-in-linux-vm
@ -40,8 +48,10 @@
;;;
;;; Code:
(define* (expression->derivation-in-linux-vm store name system exp inputs
(define* (expression->derivation-in-linux-vm store name exp
#:key
(system (%current-system))
(inputs '())
(linux linux-libre)
(initrd qemu-initrd)
(qemu qemu/smb-shares)
@ -51,6 +61,7 @@
(%guile-for-build))
(make-disk-image? #f)
(references-graphs #f)
(disk-image-size
(* 100 (expt 2 20))))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the
@ -59,13 +70,19 @@ its output files in the `/xchg' directory, which is copied to the derivation's
output when the VM terminates.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
DISK-IMAGE-SIZE bytes and return it."
DISK-IMAGE-SIZE bytes and return it.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs, as for `derivation'. The files containing the reference graphs are
made available under the /xchg CIFS share."
(define input-alist
(map (match-lambda
((input package)
((input (? package? package))
`(,input . ,(package-output store package "out" system)))
((input package sub-drv)
`(,input . ,(package-output store package sub-drv system))))
((input (? package? package) sub-drv)
`(,input . ,(package-output store package sub-drv system)))
((input (and (? string?) (? store-path?) file))
`(,input . ,file)))
inputs))
(define exp*
@ -75,8 +92,10 @@ DISK-IMAGE-SIZE bytes and return it."
(define builder
;; Code that launches the VM that evaluates EXP.
`(begin
(use-modules (guix build utils))
`(let ()
(use-modules (guix build utils)
(srfi srfi-1)
(ice-9 rdelim))
(let ((out (assoc-ref %outputs "out"))
(cu (string-append (assoc-ref %build-inputs "coreutils")
@ -102,6 +121,17 @@ DISK-IMAGE-SIZE bytes and return it."
'(begin))
(mkdir "xchg")
;; Copy the reference-graph files under xchg/ so EXP can access it.
(begin
,@(match references-graphs
(((graph-files . _) ...)
(map (lambda (file)
`(copy-file ,file
,(string-append "xchg/" file)))
graph-files))
(#f '())))
(and (zero?
(system* qemu "-nographic" "-no-reboot"
"-net" "nic,model=e1000"
@ -132,101 +162,168 @@ DISK-IMAGE-SIZE bytes and return it."
("coreutils" ,(->drv coreutils))
("builder" ,user-builder)
,@(map (match-lambda
((name package sub-drv ...)
((name (? package? package)
sub-drv ...)
`(,name ,(->drv package)
,@sub-drv)))
,@sub-drv))
((name (? string? file))
`(,name ,file)))
inputs))
#:env-vars env-vars
#:modules `((guix build utils)
,@modules)
#:guile-for-build guile-for-build)))
#:modules (delete-duplicates
`((guix build utils)
,@modules))
#:guile-for-build guile-for-build
#:references-graphs references-graphs)))
(define* (qemu-image store #:key
(name "qemu-image")
(system (%current-system))
(disk-image-size (* 100 (expt 2 20)))
(linux linux-libre)
(initrd qemu-initrd)
(inputs '()))
"Return a bootable, stand-alone QEMU image."
grub-configuration
(populate #f)
(inputs '())
(inputs-to-copy '()))
"Return a bootable, stand-alone QEMU image. The returned image is a full
disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its
configuration file.
INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
into the image being built.
When POPULATE is true, it must be the store file name of a Guile script to run
in the disk image partition once it has been populated with INPUTS-TO-COPY.
It can be used to provide additional files, such as /etc files."
(define input->name+derivation
(match-lambda
((name (? package? package))
`(,name . ,(derivation-path->output-path
(package-derivation store package system))))
((name (? package? package) sub-drv)
`(,name . ,(derivation-path->output-path
(package-derivation store package system)
sub-drv)))
((input (and (? string?) (? store-path?) file))
`(,input . ,file))))
(expression->derivation-in-linux-vm
store "qemu-image" system
`(let ((parted (string-append (assoc-ref %build-inputs "parted")
"/sbin/parted"))
(mkfs (string-append (assoc-ref %build-inputs "e2fsprogs")
"/sbin/mkfs.ext3"))
(grub (string-append (assoc-ref %build-inputs "grub")
"/sbin/grub-install"))
(umount (string-append (assoc-ref %build-inputs "util-linux")
"/bin/umount")) ; XXX: add to Guile
(initrd (string-append (assoc-ref %build-inputs "initrd")
"/initrd"))
(linux (string-append (assoc-ref %build-inputs "linux")
"/bzImage"))
(makedev (lambda (major minor)
(+ (* major 256) minor))))
store "qemu-image"
`(let ()
(use-modules (ice-9 rdelim)
(srfi srfi-1)
(guix build utils)
(guix build linux-initrd))
;; GRUB is full of shell scripts.
(setenv "PATH"
(string-append (dirname grub) ":"
(assoc-ref %build-inputs "coreutils") "/bin:"
(assoc-ref %build-inputs "findutils") "/bin:"
(assoc-ref %build-inputs "sed") "/bin:"
(assoc-ref %build-inputs "grep") "/bin:"
(assoc-ref %build-inputs "gawk") "/bin"))
(let ((parted (string-append (assoc-ref %build-inputs "parted")
"/sbin/parted"))
(mkfs (string-append (assoc-ref %build-inputs "e2fsprogs")
"/sbin/mkfs.ext3"))
(grub (string-append (assoc-ref %build-inputs "grub")
"/sbin/grub-install"))
(umount (string-append (assoc-ref %build-inputs "util-linux")
"/bin/umount")) ; XXX: add to Guile
(grub.cfg (assoc-ref %build-inputs "grub.cfg")))
(display "creating partition table...\n")
(mknod "/dev/vda" 'block-special #o644 (makedev 8 0))
(and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
"mkpart" "primary" "ext2" "1MiB"
,(format #f "~aB"
(- disk-image-size
(* 5 (expt 2 20))))))
(begin
(display "creating ext3 partition...\n")
(mknod "/dev/vda1" 'block-special #o644 (makedev 8 1))
(and (zero? (system* mkfs "-F" "/dev/vda1"))
(begin
(display "mounting partition...\n")
(mkdir "/fs")
(mount "/dev/vda1" "/fs" "ext3")
(mkdir "/fs/boot")
(mkdir "/fs/boot/grub")
(copy-file linux "/fs/boot/bzImage")
(copy-file initrd "/fs/boot/initrd")
(call-with-output-file "/fs/boot/grub/grub.cfg"
(lambda (p)
(display "
set default=1
set timeout=5
search.file /boot/bzImage
(define (read-reference-graph port)
;; Return a list of store paths from the reference graph at PORT.
;; The data at PORT is the format produced by #:references-graphs.
(let loop ((line (read-line port))
(result '()))
(cond ((eof-object? line)
(delete-duplicates result))
((string-prefix? "/" line)
(loop (read-line port)
(cons line result)))
(else
(loop (read-line port)
result)))))
menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
linux /boot/bzImage --repl
initrd /boot/initrd
}" p)))
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
"/dev/vda"))
(zero?
(system* umount "/fs"))
(reboot)))))))
`(("parted" ,parted)
("grub" ,grub)
("e2fsprogs" ,e2fsprogs)
("linux" ,linux-libre)
("initrd" ,qemu-initrd)
(define (things-to-copy)
;; Return the list of store files to copy to the image.
(define (graph-from-file file)
(call-with-input-file file
read-reference-graph))
;; For shell scripts.
("sed" ,(car (assoc-ref %final-inputs "sed")))
("grep" ,(car (assoc-ref %final-inputs "grep")))
("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
("findutils" ,(car (assoc-ref %final-inputs "findutils")))
("gawk" ,(car (assoc-ref %final-inputs "gawk")))
("util-linux" ,util-linux))
,(match inputs-to-copy
(((graph-files . _) ...)
`(let* ((graph-files ',(map (cut string-append "/xchg/" <>)
graph-files))
(paths (append-map graph-from-file graph-files)))
(delete-duplicates paths)))
(#f ''())))
;; GRUB is full of shell scripts.
(setenv "PATH"
(string-append (dirname grub) ":"
(assoc-ref %build-inputs "coreutils") "/bin:"
(assoc-ref %build-inputs "findutils") "/bin:"
(assoc-ref %build-inputs "sed") "/bin:"
(assoc-ref %build-inputs "grep") "/bin:"
(assoc-ref %build-inputs "gawk") "/bin"))
(display "creating partition table...\n")
(and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
"mkpart" "primary" "ext2" "1MiB"
,(format #f "~aB"
(- disk-image-size
(* 5 (expt 2 20))))))
(begin
(display "creating ext3 partition...\n")
(and (zero? (system* mkfs "-F" "/dev/vda1"))
(begin
(display "mounting partition...\n")
(mkdir "/fs")
(mount "/dev/vda1" "/fs" "ext3")
(mkdir-p "/fs/boot/grub")
(symlink grub.cfg "/fs/boot/grub/grub.cfg")
;; Populate the image's store.
(mkdir-p (string-append "/fs" ,%store-directory))
(for-each (lambda (thing)
(copy-recursively thing
(string-append "/fs"
thing)))
(cons grub.cfg (things-to-copy)))
;; Populate /dev.
(make-essential-device-nodes #:root "/fs")
(and=> (assoc-ref %build-inputs "populate")
(lambda (populate)
(chdir "/fs")
(primitive-load populate)
(chdir "/")))
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
"/dev/vda"))
(zero? (system* umount "/fs"))
(reboot))))))))
#:system system
#:inputs `(("parted" ,parted)
("grub" ,grub)
("e2fsprogs" ,e2fsprogs)
("grub.cfg" ,grub-configuration)
;; For shell scripts.
("sed" ,(car (assoc-ref %final-inputs "sed")))
("grep" ,(car (assoc-ref %final-inputs "grep")))
("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
("findutils" ,(car (assoc-ref %final-inputs "findutils")))
("gawk" ,(car (assoc-ref %final-inputs "gawk")))
("util-linux" ,util-linux)
,@(if populate
`(("populate" ,populate))
'())
,@inputs-to-copy)
#:make-disk-image? #t
#:disk-image-size disk-image-size))
#:disk-image-size disk-image-size
#:references-graphs (map input->name+derivation inputs-to-copy)
#:modules '((guix build utils)
(guix build linux-initrd))))
;;;
@ -241,16 +338,32 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(lambda ()
(parameterize ((%guile-for-build (package-derivation store guile-final)))
(expression->derivation-in-linux-vm
store "vm-test" (%current-system)
store "vm-test"
'(begin
(display "hello from boot!\n")
(call-with-output-file "/xchg/hello"
(lambda (p)
(display "world" p))))
'())))
(display "world" p)))))))
(lambda ()
(close-connection store)))))
(define (/etc/shadow store accounts)
"Return a /etc/shadow file for ACCOUNTS."
(define contents
(let loop ((accounts accounts)
(result '()))
(match accounts
(((name uid gid comment home-dir shell) rest ...)
(loop rest
(cons (string-append name "::" (number->string uid)
":" (number->string gid)
comment ":" home-dir ":" shell)
result)))
(()
(string-concatenate-reverse result)))))
(add-text-to-store store "shadow" contents '()))
(define (example2)
(let ((store #f))
(dynamic-wind
@ -258,7 +371,55 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(set! store (open-connection)))
(lambda ()
(parameterize ((%guile-for-build (package-derivation store guile-final)))
(qemu-image store #:disk-image-size (* 30 (expt 2 20)))))
(let* ((bash-drv (package-derivation store bash))
(bash-file (string-append (derivation-path->output-path bash-drv)
"/bin/bash"))
(passwd (/etc/shadow store
`(("root" 0 0 "System administrator" "/"
,bash-file))))
(populate
(add-text-to-store store "populate-qemu-image"
(object->string
`(begin
(mkdir-p "etc")
(symlink ,(substring passwd 1)
"etc/shadow")))
(list passwd)))
(out (derivation-path->output-path
(package-derivation store mingetty)))
(getty (string-append out "/sbin/mingetty"))
(boot (add-text-to-store store "boot"
(object->string
`(begin
;; Become the session leader,
;; so that mingetty can do
;; 'TIOCSCTTY'.
(setsid)
;; Directly into mingetty.
(execl ,getty "mingetty"
"--noclear" "tty1")))
(list out)))
(entries (list (menu-entry
(label "Boot-to-Guile! (GNU System technology preview)")
(linux linux-libre)
(linux-arguments `("--root=/dev/vda1"
,(string-append "--load=" boot)))
(initrd gnu-system-initrd))))
(grub.cfg (grub-configuration-file store entries)))
(qemu-image store
#:grub-configuration grub.cfg
#:populate populate
#:disk-image-size (* 400 (expt 2 20))
#:inputs-to-copy `(("boot" ,boot)
("linux" ,linux-libre)
("initrd" ,gnu-system-initrd)
("coreutils" ,coreutils)
("bash" ,bash)
("guile" ,guile-2.0)
("mingetty" ,mingetty)
("shadow" ,passwd))))))
(lambda ()
(close-connection store)))))

9
guix/build-system/cmake.scm
View File

@ -35,13 +35,20 @@
;;
;; Code:
(define (default-cmake)
"Return the default CMake package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages cmake))))
(module-ref module 'cmake)))
(define* (cmake-build store name source inputs
#:key (guile #f)
(outputs '("out")) (configure-flags ''())
(search-paths '())
(make-flags ''())
(patches ''()) (patch-flags ''("--batch" "-p1"))
(cmake (@ (gnu packages cmake) cmake))
(cmake (default-cmake))
(out-of-source? #f)
(tests? #t)
(test-target "test")

148
guix/build/linux-initrd.scm Normal file
View File

@ -0,0 +1,148 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.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 (guix build linux-initrd)
#:use-module (rnrs io ports)
#:use-module (system foreign)
#:export (mount-essential-file-systems
linux-command-line
make-essential-device-nodes
configure-qemu-networking
mount-qemu-smb-share
bind-mount
load-linux-module*
device-number))
;;; Commentary:
;;;
;;; Utility procedures useful in a Linux initial RAM disk (initrd). Note that
;;; many of these use procedures not yet available in vanilla Guile (`mount',
;;; `load-linux-module', etc.); these are provided by a Guile patch used in
;;; the GNU distribution.
;;;
;;; Code:
(define* (mount-essential-file-systems #:key (root "/"))
"Mount /proc and /sys under ROOT."
(define (scope dir)
(string-append root
(if (string-suffix? "/" root)
""
"/")
dir))
(unless (file-exists? (scope "proc"))
(mkdir (scope "proc")))
(mount "none" (scope "proc") "proc")
(unless (file-exists? (scope "sys"))
(mkdir (scope "sys")))
(mount "none" (scope "sys") "sysfs"))
(define (linux-command-line)
"Return the Linux kernel command line as a list of strings."
(string-tokenize
(call-with-input-file "/proc/cmdline"
get-string-all)))
(define* (make-essential-device-nodes #:key (root "/"))
"Make essential device nodes under ROOT/dev."
;; The hand-made udev!
(define (scope dir)
(string-append root
(if (string-suffix? "/" root)
""
"/")
dir))
(unless (file-exists? (scope "dev"))
(mkdir (scope "dev")))
;; Make the device nodes for QEMU's hard disk and partitions.
(mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0))
(mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1))
(mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2))
;; TTYs.
(mknod (scope "dev/tty") 'char-special #o600
(device-number 5 0))
(let loop ((n 0))
(and (< n 50)
(let ((name (format #f "dev/tty~a" n)))
(mknod (scope name) 'char-special #o600
(device-number 4 n))
(loop (+ 1 n)))))
;; Other useful nodes.
(mknod (scope "dev/null") 'char-special #o666 (device-number 1 3))
(mknod (scope "dev/zero") 'char-special #o666 (device-number 1 5)))
(define %host-qemu-ipv4-address
(inet-pton AF_INET "10.0.2.10"))
(define* (configure-qemu-networking #:optional (interface "eth0"))
"Setup the INTERFACE network interface and /etc/resolv.conf according to
QEMU's default networking settings (see net/slirp.c in QEMU for default
networking values.) Return #t if INTERFACE is up, #f otherwise."
(display "configuring QEMU networking...\n")
(let* ((sock (socket AF_INET SOCK_STREAM 0))
(address (make-socket-address AF_INET %host-qemu-ipv4-address 0))
(flags (network-interface-flags sock interface)))
(set-network-interface-address sock interface address)
(set-network-interface-flags sock interface (logior flags IFF_UP))
(unless (file-exists? "/etc")
(mkdir "/etc"))
(call-with-output-file "/etc/resolv.conf"
(lambda (p)
(display "nameserver 10.0.2.3\n" p)))
(logand (network-interface-flags sock interface) IFF_UP)))
(define (mount-qemu-smb-share share mount-point)
"Mount QEMU's CIFS/SMB SHARE at MOUNT-POINT.
Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
`qemu-with-multiple-smb-shares' package exports the /xchg and /store shares
(the latter allows the store to be shared between the host and guest.)"
(format #t "mounting QEMU's SMB share `~a'...\n" share)
(let ((server "10.0.2.4"))
(mount (string-append "//" server share) mount-point "cifs" 0
(string->pointer "guest,sec=none"))))
(define (bind-mount source target)
"Bind-mount SOURCE at TARGET."
(define MS_BIND 4096) ; from libc's <sys/mount.h>
(mount source target "" MS_BIND))
(define (load-linux-module* file)
"Load Linux module from FILE, the name of a `.ko' file."
(define (slurp module)
(call-with-input-file file get-bytevector-all))
(load-linux-module (slurp file)))
(define (device-number major minor)
"Return the device number for the device with MAJOR and MINOR, for use as
the last argument of `mknod'."
(+ (* major 256) minor))
;;; linux-initrd.scm ends here

29
guix/build/union.scm
View File

@ -105,7 +105,22 @@ single leaf."
the DIRECTORIES."
(define (file-tree dir)
;; Return the contents of DIR as a tree.
(match (file-system-fold (const #t)
(define (others-have-it? subdir)
;; Return #t if other elements of DIRECTORIES have SUBDIR.
(let ((subdir (substring subdir (string-length dir))))
(any (lambda (other)
(and (not (string=? other dir))
(file-exists? (string-append other "/" subdir))))
directories)))
(match (file-system-fold (lambda (subdir stat result) ; enter?
;; No need to traverse DIR since there's
;; nothing to union it with. Thus, we avoid
;; creating a gazillon symlinks (think
;; share/emacs/24.3, share/texmf, etc.)
(or (string=? subdir dir)
(others-have-it? subdir)))
(lambda (file stat result) ; leaf
(match result
(((siblings ...) rest ...)
@ -117,7 +132,12 @@ the DIRECTORIES."
(((leaves ...) (siblings ...) rest ...)
`(((,(basename dir) ,@leaves) ,@siblings)
,@rest))))
(const #f) ; skip
(lambda (dir stat result) ; skip
;; DIR is not available elsewhere, so treat it
;; as a leaf.
(match result
(((siblings ...) rest ...)
`((,dir ,@siblings) ,@rest))))
(lambda (file stat errno result)
(format (current-error-port) "union-build: ~a: ~a~%"
file (strerror errno)))
@ -158,8 +178,9 @@ the DIRECTORIES."
(mkdir output)
(let loop ((tree (delete-duplicate-leaves
(cons "."
(tree-union (append-map (compose tree-leaves file-tree)
directories)))
(tree-union
(append-map (compose tree-leaves file-tree)
(delete-duplicates directories))))
leaf=?
resolve-collision))
(dir '()))

72
guix/derivations.scm
View File

@ -61,6 +61,8 @@
derivation
%guile-for-build
imported-modules
compiled-modules
build-expression->derivation
imported-files))
@ -497,12 +499,20 @@ the derivation called NAME with hash HASH."
name
(string-append name "-" output))))
(define* (derivation store name system builder args env-vars inputs
#:key (outputs '("out")) hash hash-algo hash-mode)
(define* (derivation store name builder args
#:key
(system (%current-system)) (env-vars '())
(inputs '()) (outputs '("out"))
hash hash-algo hash-mode
references-graphs)
"Build a derivation with the given arguments. Return the resulting
store path and <derivation> object. When HASH, HASH-ALGO, and HASH-MODE
are given, a fixed-output derivation is created---i.e., one whose result is
known in advance, such as a file download."
known in advance, such as a file download.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs. In that case, the reference graph of each store path is exported in
the build environment in the corresponding file, in a simple text format."
(define direct-store-path?
(let ((len (+ 1 (string-length (%store-prefix)))))
(lambda (p)
@ -537,7 +547,22 @@ known in advance, such as a file download."
value))))
env-vars))))))
(define (env-vars-with-empty-outputs)
(define (user+system-env-vars)
;; Some options are passed to the build daemon via the env. vars of
;; derivations (urgh!). We hide that from our API, but here is the place
;; where we kludgify those options.
(match references-graphs
(((file . path) ...)
(let ((value (map (cut string-append <> " " <>)
file path)))
;; XXX: This all breaks down if an element of FILE or PATH contains
;; white space.
`(("exportReferencesGraph" . ,(string-join value " "))
,@env-vars)))
(#f
env-vars)))
(define (env-vars-with-empty-outputs env-vars)
;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
;; empty string, even outputs that do not appear in ENV-VARS.
(let ((e (map (match-lambda
@ -569,7 +594,7 @@ known in advance, such as a file download."
#t "sha256" input)))
(make-derivation-input path '()))))
(delete-duplicates inputs)))
(env-vars (env-vars-with-empty-outputs))
(env-vars (env-vars-with-empty-outputs (user+system-env-vars)))
(drv-masked (make-derivation outputs
(filter (compose derivation-path?
derivation-input-path)
@ -720,7 +745,8 @@ they can refer to each other."
hash hash-algo
(env-vars '())
(modules '())
guile-for-build)
guile-for-build
references-graphs)
"Return a derivation that executes Scheme expression EXP as a builder
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list
@ -737,7 +763,9 @@ builder terminates by passing the result of EXP to `exit'; thus, when
EXP returns #f, the build is considered to have failed.
EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
(define guile-drv
(or guile-for-build (%guile-for-build)))
@ -747,8 +775,8 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
(define module-form?
(match-lambda
(((or 'define-module 'use-modules) _ ...) #t)
(_ #f)))
(((or 'define-module 'use-modules) _ ...) #t)
(_ #f)))
(define source-path
;; When passed an input that is a source, return its path; otherwise
@ -833,22 +861,26 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
#:system system)))
(go-dir (and go-drv
(derivation-path->output-path go-drv))))
(derivation store name system guile
(derivation store name guile
`("--no-auto-compile"
,@(if mod-dir `("-L" ,mod-dir) '())
,builder)
#:system system
#:inputs `((,(or guile-for-build (%guile-for-build)))
(,builder)
,@(map cdr inputs)
,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
;; When MODULES is non-empty, shamelessly clobber
;; $GUILE_LOAD_COMPILED_PATH.
(if go-dir
`(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
env-vars))
env-vars)
#:env-vars (if go-dir
`(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
env-vars))
env-vars)
`((,(or guile-for-build (%guile-for-build)))
(,builder)
,@(map cdr inputs)
,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
#:hash hash #:hash-algo hash-algo
#:outputs outputs)))
#:outputs outputs
#:references-graphs references-graphs)))

4
guix/download.scm
View File

@ -99,7 +99,9 @@
"http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/"
"http://linux-kernel.uio.no/pub/"
"http://kernel.osuosl.org/pub/"
"ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/")
"ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/"
"http://ftp.be.debian.org/pub/"
"http://mirror.linux.org.au/")
(apache ; from http://www.apache.org/mirrors/dist.html
"http://www.eu.apache.org/dist/"
"http://www.us.apache.org/dist/"

6
guix/scripts/pull.scm
View File

@ -106,6 +106,8 @@ files."
(when (string-suffix? ".scm" file)
(let ((go (string-append (string-drop-right file 4)
".go")))
(format (current-error-port)
"compiling '~a'...~%" file)
(compile-file file
#:output-file go
#:opts %auto-compilation-options))))
@ -114,7 +116,9 @@ files."
;; download), we must build it first to avoid errors since
;; (gnutls) is unavailable.
(cons (string-append out "/guix/build/download.scm")
(find-files out "\\.scm")))
;; Sort the file names to get deterministic results.
(sort (find-files out "\\.scm") string<?)))
;; Remove the "fake" (guix config).
(delete-file (string-append out "/guix/config.scm"))

9
guix/scripts/substitute-binary.scm
View File

@ -508,8 +508,13 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
(format (current-error-port) "downloading `~a' from `~a'...~%"
store-path (uri->string uri))
(format (current-error-port) "downloading `~a' from `~a'~:[~*~; (~,1f MiB installed)~]...~%"
store-path (uri->string uri)
;; Use the Nar size as an estimate of the installed size.
(narinfo-size narinfo)
(and=> (narinfo-size narinfo)
(cute / <> (expt 2. 20))))
(let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so

9
guix/store.scm
View File

@ -25,6 +25,7 @@
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@ -242,6 +243,14 @@
(ats-cache nix-server-add-to-store-cache)
(atts-cache nix-server-add-text-to-store-cache))
(set-record-type-printer! <nix-server>
(lambda (obj port)
(format port "#<build-daemon ~a.~a ~a>"
(nix-server-major-version obj)
(nix-server-minor-version obj)
(number->string (object-address obj)
16))))
(define-condition-type &nix-error &error
nix-error?)

1
guix/ui.scm
View File

@ -242,6 +242,7 @@ available for download."
(substitutable-path-info store
download)))))
download)))
;; TODO: Show the installed size of DOWNLOAD.
(if dry-run?
(begin
(format (current-error-port)

217
tests/derivations.scm
View File

@ -50,19 +50,23 @@
(let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv)))
(define %bash
(let ((bash (search-bootstrap-binary "bash" (%current-system))))
(define (bootstrap-binary name)
(let ((bin (search-bootstrap-binary name (%current-system))))
(and %store
(add-to-store %store "bash" #t "sha256" bash))))
(add-to-store %store name #t "sha256" bin))))
(define (directory-contents dir)
(define %bash
(bootstrap-binary "bash"))
(define %mkdir
(bootstrap-binary "mkdir"))
(define* (directory-contents dir #:optional (slurp get-bytevector-all))
"Return an alist representing the contents of DIR."
(define prefix-len (string-length dir))
(sort (file-system-fold (const #t) ; enter?
(lambda (path stat result) ; leaf
(alist-cons (string-drop path prefix-len)
(call-with-input-file path
get-bytevector-all)
(call-with-input-file path slurp)
result))
(lambda (path stat result) result) ; down
(lambda (path stat result) result) ; up
@ -84,7 +88,7 @@
(and (equal? b1 b2)
(equal? d1 d2))))
(test-skip (if %store 0 11))
(test-skip (if %store 0 12))
(test-assert "add-to-store, flat"
(let* ((file (search-path %load-path "language/tree-il/spec.scm"))
@ -106,9 +110,9 @@
(let* ((builder (add-text-to-store %store "my-builder.sh"
"echo hello, world\n"
'()))
(drv-path (derivation %store "foo" (%current-system)
(drv-path (derivation %store "foo"
%bash `("-e" ,builder)
'(("HOME" . "/homeless")) '())))
#:env-vars '(("HOME" . "/homeless")))))
(and (store-path? drv-path)
(valid-path? %store drv-path))))
@ -118,12 +122,12 @@
"echo hello, world > \"$out\"\n"
'()))
((drv-path drv)
(derivation %store "foo" (%current-system)
(derivation %store "foo"
%bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
`((,builder))))
#:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
#:inputs `((,builder))))
((succeeded?)
(build-derivations %store (list drv-path))))
(and succeeded?
@ -139,18 +143,17 @@
"(while read line ; do echo \"$line\" ; done) < $in > $out"
'()))
(input (search-path %load-path "ice-9/boot-9.scm"))
(input* (add-to-store %store (basename input)
#t "sha256" input))
(drv-path (derivation %store "derivation-with-input-file"
(%current-system)
%bash `(,builder)
`(("in"
;; Cheat to pass the actual file
;; name to the builder.
. ,(add-to-store %store
(basename input)
#t "sha256"
input)))
`((,builder)
(,input))))) ; ← local file name
;; Cheat to pass the actual file name to the
;; builder.
#:env-vars `(("in" . ,input*))
#:inputs `((,builder)
(,input))))) ; ← local file name
(and (build-derivations %store (list drv-path))
;; Note: we can't compare the files because the above trick alters
;; the contents.
@ -160,10 +163,9 @@
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(drv-path (derivation %store "fixed" (%current-system)
(drv-path (derivation %store "fixed"
%bash `(,builder)
'()
`((,builder)) ; optional
#:inputs `((,builder)) ; optional
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store (list drv-path))))
(and succeeded?
@ -178,13 +180,11 @@
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(drv-path1 (derivation %store "fixed" (%current-system)
(drv-path1 (derivation %store "fixed"
%bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(drv-path2 (derivation %store "fixed" (%current-system)
(drv-path2 (derivation %store "fixed"
%bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store
(list drv-path1 drv-path2))))
@ -201,27 +201,25 @@
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed" (%current-system)
(fixed1 (derivation %store "fixed"
%bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed2 (derivation %store "fixed" (%current-system)
(fixed2 (derivation %store "fixed"
%bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed-out (derivation-path->output-path fixed1))
(builder3 (add-text-to-store
%store "final-builder.sh"
;; Use Bash hackery to avoid Coreutils.
"echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
(final1 (derivation %store "final" (%current-system)
(final1 (derivation %store "final"
%bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed1))))
(final2 (derivation %store "final" (%current-system)
#:env-vars `(("in" . ,fixed-out))
#:inputs `((,builder3) (,fixed1))))
(final2 (derivation %store "final"
%bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed2))))
#:env-vars `(("in" . ,fixed-out))
#:inputs `((,builder3) (,fixed2))))
(succeeded? (build-derivations %store
(list final1 final2))))
(and succeeded?
@ -232,12 +230,12 @@
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo one > $out ; echo two > $second"
'()))
(drv-path (derivation %store "fixed" (%current-system)
(drv-path (derivation %store "fixed"
%bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
`((,builder))
#:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
#:inputs `((,builder))
#:outputs '("out" "second")))
(succeeded? (build-derivations %store (list drv-path))))
(and succeeded?
@ -255,10 +253,9 @@
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo one > $out ; echo two > $AAA"
'()))
(drv-path (derivation %store "fixed" (%current-system)
(drv-path (derivation %store "fixed"
%bash `(,builder)
'()
`((,builder))
#:inputs `((,builder))
#:outputs '("out" "AAA")))
(succeeded? (build-derivations %store (list drv-path))))
(and succeeded?
@ -273,10 +270,9 @@
(let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
"echo one > $out ; echo two > $two"
'()))
(mdrv (derivation %store "multiple-output" (%current-system)
(mdrv (derivation %store "multiple-output"
%bash `(,builder1)
'()
`((,builder1))
#:inputs `((,builder1))
#:outputs '("out" "two")))
(builder2 (add-text-to-store %store "my-mo-user-builder.sh"
"read x < $one;
@ -284,21 +280,72 @@
echo \"($x $y)\" > $out"
'()))
(udrv (derivation %store "multiple-output-user"
(%current-system)
%bash `(,builder2)
`(("one" . ,(derivation-path->output-path
mdrv "out"))
("two" . ,(derivation-path->output-path
mdrv "two")))
`((,builder2)
;; two occurrences of MDRV:
(,mdrv)
(,mdrv "two")))))
#:env-vars `(("one"
. ,(derivation-path->output-path
mdrv "out"))
("two"
. ,(derivation-path->output-path
mdrv "two")))
#:inputs `((,builder2)
;; two occurrences of MDRV:
(,mdrv)
(,mdrv "two")))))
(and (build-derivations %store (list (pk 'udrv udrv)))
(let ((p (derivation-path->output-path udrv)))
(and (valid-path? %store p)
(equal? '(one two) (call-with-input-file p read)))))))
(test-assert "derivation with #:references-graphs"
(let* ((input1 (add-text-to-store %store "foo" "hello"
(list %bash)))
(input2 (add-text-to-store %store "bar"
(number->string (random 7777))
(list input1)))
(builder (add-text-to-store %store "build-graph"
(format #f "
~a $out
(while read l ; do echo $l ; done) < bash > $out/bash
(while read l ; do echo $l ; done) < input1 > $out/input1
(while read l ; do echo $l ; done) < input2 > $out/input2"
%mkdir)
(list %mkdir)))
(drv (derivation %store "closure-graphs"
%bash `(,builder)
#:references-graphs
`(("bash" . ,%bash)
("input1" . ,input1)
("input2" . ,input2))
#:inputs `((,%bash) (,builder))))
(out (derivation-path->output-path drv)))
(define (deps path . deps)
(let ((count (length deps)))
(string-append path "\n\n" (number->string count) "\n"
(string-join (sort deps string<?) "\n")
(if (zero? count) "" "\n"))))
(and (build-derivations %store (list drv))
(equal? (directory-contents out get-string-all)
`(("/bash" . ,(string-append %bash "\n\n0\n"))
("/input1" . ,(if (string>? input1 %bash)
(string-append (deps %bash)
(deps input1 %bash))
(string-append (deps input1 %bash)
(deps %bash))))
("/input2" . ,(string-concatenate
(map cdr
(sort
(map (lambda (p d)
(cons p (apply deps p d)))
(list %bash input1 input2)
(list '() (list %bash) (list input1)))
(lambda (x y)
(match x
((p1 . _)
(match y
((p2 . _)
(string<? p1 p2)))))))))))))))
(define %coreutils
(false-if-exception
@ -314,14 +361,14 @@
"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
'()))
(drv-path
(derivation %store "foo" (%current-system)
(derivation %store "foo"
%bash `(,builder)
`(("PATH" .
,(string-append
(derivation-path->output-path %coreutils)
"/bin")))
`((,builder)
(,%coreutils))))
#:env-vars `(("PATH" .
,(string-append
(derivation-path->output-path %coreutils)
"/bin")))
#:inputs `((,builder)
(,%coreutils))))
(succeeded?
(build-derivations %store (list drv-path))))
(and succeeded?
@ -329,7 +376,7 @@
(and (valid-path? %store p)
(file-exists? (string-append p "/good")))))))
(test-skip (if (%guile-for-build) 0 7))
(test-skip (if (%guile-for-build) 0 8))
(test-assert "build-expression->derivation and derivation-prerequisites"
(let-values (((drv-path drv)
@ -605,6 +652,38 @@ Deriver: ~a~%"
(derivation-path->output-path final2))
(build-derivations %store (list final1 final2)))))
(test-assert "build-expression->derivation with #:references-graphs"
(let* ((input (add-text-to-store %store "foo" "hello"
(list %bash %mkdir)))
(builder '(copy-file "input" %output))
(drv (build-expression->derivation %store "references-graphs"
(%current-system)
builder '()
#:references-graphs
`(("input" . ,input))))
(out (derivation-path->output-path drv)))
(define (deps path . deps)
(let ((count (length deps)))
(string-append path "\n\n" (number->string count) "\n"
(string-join (sort deps string<?) "\n")
(if (zero? count) "" "\n"))))
(and (build-derivations %store (list drv))
(equal? (call-with-input-file out get-string-all)
(string-concatenate
(map cdr
(sort (map (lambda (p d)
(cons p (apply deps p d)))
(list input %bash %mkdir)
(list (list %bash %mkdir)
'() '()))
(lambda (x y)
(match x
((p1 . _)
(match y
((p2 . _)
(string<? p1 p2)))))))))))))
(test-end)

13
tests/store.scm
View File

@ -80,9 +80,9 @@
;; (b (add-text-to-store %store "link-builder"
;; (format #f "echo ~a > $out" p1)
;; '()))
;; (d1 (derivation %store "link" (%current-system)
;; "/bin/sh" `("-e" ,b) '()
;; `((,b) (,p1))))
;; (d1 (derivation %store "link"
;; "/bin/sh" `("-e" ,b)
;; #:inputs `((,b) (,p1))))
;; (p2 (derivation-path->output-path d1)))
;; (and (add-temp-root %store p2)
;; (build-derivations %store (list d1))
@ -130,9 +130,10 @@
(s (add-to-store %store "bash" #t "sha256"
(search-bootstrap-binary "bash"
(%current-system))))
(d (derivation %store "the-thing" (%current-system)
s `("-e" ,b) `(("foo" . ,(random-text)))
`((,b) (,s))))
(d (derivation %store "the-thing"
s `("-e" ,b)
#:env-vars `(("foo" . ,(random-text)))
#:inputs `((,b) (,s))))
(o (derivation-path->output-path d)))
(and (build-derivations %store (list d))
(equal? (query-derivation-outputs %store d)

12
tests/union.scm
View File

@ -114,7 +114,17 @@
(file-exists? "bin/ld")
(file-exists? "lib/libc.so")
(directory-exists? "lib/gcc")
(file-exists? "include/unistd.h"))))))
(file-exists? "include/unistd.h")
;; The 'include' sub-directory is only found in
;; glibc-bootstrap, so it should be unified in a
;; straightforward way, without traversing it.
(eq? 'symlink (stat:type (lstat "include")))
;; Conversely, several inputs have a 'bin' sub-directory, so
;; unifying it requires traversing them all, and creating a
;; new 'bin' sub-directory in the profile.
(eq? 'directory (stat:type (lstat "bin"))))))))
(test-end)