diff options
42 files changed, 1853 insertions, 495 deletions
@@ -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. diff --git a/Makefile.am b/Makefile.am index 6eb4c0fb9c..bf9c1d0e91 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index d7bdb2d7e4..8206be22ff 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -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))) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index f2107479e0..dbc935d897 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -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." diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm index 9cb07c19f7..3e798fc6d1 100755 --- a/build-aux/list-packages.scm +++ b/build-aux/list-packages.scm @@ -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} +/* license: CC0 */ +a { + transition: all 0.3s; +} +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; + background-color: #333; + color: #fff; } -table#packages td -{ -margin:0px; -padding:0.2em 0.5em; +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>")) diff --git a/configure.ac b/configure.ac index fc6a14b13b..934ced5d72 100644 --- a/configure.ac +++ b/configure.ac @@ -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]) diff --git a/doc.am b/doc.am new file mode 100644 index 0000000000..226860b5a4 --- /dev/null +++ b/doc.am @@ -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 diff --git a/doc/guix.texi b/doc/guix.texi index 57b6412939..5b91bc2982 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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, diff --git a/gnu-system.am b/gnu-system.am index 920e1383f7..a5000bcdfe 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -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 \ diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index 3a447d8591..6c294c814a 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -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) diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index 86723a9591..a1d4c7fc67 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -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") diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index 9528cf3199..83ef7a86d8 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -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") diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 15031179ff..fee834f9f9 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -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 diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm index 8c981bf88d..71c4fad781 100644 --- a/gnu/packages/grub.scm +++ b/gnu/packages/grub.scm @@ -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))) + '())) diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 102cb8ea2f..742cbf172e 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -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) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 7d97adbe99..c580e0c324 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -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 diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index e408b13fa3..98cd51fee3 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -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 diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 348e411d07..6dd2a10e53 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -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) + ;; 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'. - (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"))) + (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"))) - - ;; 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")) - - (mkdir "/etc") - (call-with-output-file "/etc/resolv.conf" - (lambda (p) - (display "nameserver 10.0.2.3\n" p))) - (sleep 1)) + (display "loading CIFS and companion modules...\n") + (for-each (compose load-linux-module* + (cut string-append "/modules/" <>)) + (list "md4.ko" "ecb.ko" "cifs.ko")) + + (unless (configure-qemu-networking) + (display "network interface is DOWN\n")) + + ;; 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") + (mount-essential-file-systems #:root "/root") + (mkdir "/root/xchg") - (mkdir "/root/nix") - (mkdir "/root/nix/store") + (mkdir-p "/root/nix/store") - (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))) + (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 diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e434de477e..b5ed92e198 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -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) diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 6f33c07e58..ce270bd5c1 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -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) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 7b900225b5..75354122b5 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -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") diff --git a/gnu/packages/patches/hop-bigloo-4.0b.patch b/gnu/packages/patches/hop-bigloo-4.0b.patch new file mode 100644 index 0000000000..312bfdd117 --- /dev/null +++ b/gnu/packages/patches/hop-bigloo-4.0b.patch @@ -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! diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index c9893d9385..493068adde 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -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") diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index eb339d7236..43853fa08c 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -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 diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm index e326e498c5..7c733f9575 100644 --- a/gnu/packages/system.scm +++ b/gnu/packages/system.scm @@ -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+))) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 5059dcd5e1..14404f0bfe 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -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") diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 6edff473da..2f9d64b81a 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -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+))) diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 5f07401e98..98f104b0b6 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -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 diff --git a/gnu/packages/yasm.scm b/gnu/packages/yasm.scm new file mode 100644 index 0000000000..51cd3ed0a5 --- /dev/null +++ b/gnu/packages/yasm.scm @@ -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.")))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index bc5677963d..73543896ef 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -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)))) - - ;; 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") - (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 - -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) - - ;; 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)) + store "qemu-image" + `(let () + (use-modules (ice-9 rdelim) + (srfi srfi-1) + (guix build utils) + (guix build linux-initrd)) + + (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"))) + + (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))))) + + (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)) + + ,(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))))) diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 3347dc502c..76a9a3befe 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -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") diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm new file mode 100644 index 0000000000..b5404da7f0 --- /dev/null +++ b/guix/build/linux-initrd.scm @@ -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 diff --git a/guix/build/union.scm b/guix/build/union.scm index 275746d83e..077b7fe530 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -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 '())) diff --git a/guix/derivations.scm b/guix/derivations.scm index 8ddef117d4..c05644add2 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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) - - `((,(or guile-for-build (%guile-for-build))) - (,builder) - ,@(map cdr inputs) - ,@(if mod-drv `((,mod-drv) (,go-drv)) '())) + #:env-vars (if go-dir + `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir) + ,@(alist-delete "GUILE_LOAD_COMPILED_PATH" + env-vars)) + env-vars) + #:hash hash #:hash-algo hash-algo - #:outputs outputs))) + #:outputs outputs + #:references-graphs references-graphs))) diff --git a/guix/download.scm b/guix/download.scm index b12659f683..fa76615ef2 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -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/" diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index f4135efc99..f3d87a63c0 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -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")) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 97bbfcbce8..63f0c4f8d2 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -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 diff --git a/guix/store.scm b/guix/store.scm index 343da91506..541c7c848f 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -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?) diff --git a/guix/ui.scm b/guix/ui.scm index 9251d73f18..720d01be02 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -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) diff --git a/tests/derivations.scm b/tests/derivations.scm index 788cffd7ad..9092e3acd6 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -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 %bash + (bootstrap-binary "bash")) +(define %mkdir + (bootstrap-binary "mkdir")) -(define (directory-contents dir) +(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) diff --git a/tests/store.scm b/tests/store.scm index 3d5d59b991..9625a6b308 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -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) diff --git a/tests/union.scm b/tests/union.scm index 9816882101..6287cffc38 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -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) |