Merge branch 'master' into core-updates

Conflicts:
	guix/packages.scm
This commit is contained in:
Ludovic Courtès 2013-11-20 23:51:26 +01:00
commit edae5b3d50
37 changed files with 2297 additions and 227 deletions

22
README
View File

@ -50,26 +50,16 @@ You can re-build and re-install Guix using a system that already runs Guix.
To do so: To do so:
- Install the dependencies (see 'Requirements' above) and build tools using - Install the dependencies (see 'Requirements' above) and build tools using
Guix. You should have the following packages installed in your user Guix:
profile:
- autoconf guix package --install={autoconf,automake,bzip2,gcc,binutils,ld-wrapper,glibc,gettext,guile,libgcrypt,pkg-config,sqlite}
- automake
- bzip2
- gcc
- gettext
- glibc
- guile
- ld-wrapper
- libgcrypt
- pkg-config
- sqlite
- set the environment variables that Guix recommends you to set during the - set the environment variables that Guix recommends you to set during the
package installation process: package installation process:
ACLOCAL, CPATH, LIBRARY_PATH, PATH, PKG_CONFIG_PATH ACLOCAL_PATH, CPATH, LIBRARY_PATH, PKG_CONFIG_PATH
In addition, set
GUIX_LD_WRAPPER_ALLOW_IMPURITIES=yes - set the PATH environment variable to refer to the profile:
PATH=$HOME/.guix-profile/bin:$PATH
- re-run the configure script passing it the option - re-run the configure script passing it the option
`--with-libgcrypt-prefix=$HOME/.guix-profile/' `--with-libgcrypt-prefix=$HOME/.guix-profile/'

View File

@ -71,12 +71,14 @@ of packages still to be processed in REMAINING. Also Introduces a call to the
JavaScript prep_pkg_descs function as part of the output of PACKAGE, every JavaScript prep_pkg_descs function as part of the output of PACKAGE, every
time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING, time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING,
decreasing, is 1." decreasing, is 1."
(define (location-url loc)
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n"
(number->string (location-line loc))))
(define (source-url package) (define (source-url package)
(let ((loc (package-location package))) (let ((loc (package-location package)))
(and loc (and loc (location-url loc))))
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n"
(number->string (location-line loc))))))
(define (license package) (define (license package)
(define ->sxml (define ->sxml
@ -103,26 +105,37 @@ decreasing, is 1."
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/" "http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
(basename patch))) (basename patch)))
(match (and (origin? (package-source package)) (define (snippet-link snippet)
(origin-patches (package-source package))) (let ((loc (package-field-location package 'source)))
((patches ..1) `(a (@ (href ,(location-url loc))
`(div "patches: " (title "Link to patch snippet"))
,(let loop ((patches patches) "snippet")))
(number 1)
(links '())) (and (origin? (package-source package))
(match patches (let ((patches (origin-patches (package-source package)))
(() (snippet (origin-snippet (package-source package))))
(list-join (reverse links) ", ")) (and (or (pair? patches) snippet)
((patch rest ...) `(div "patches: "
(loop rest ,(let loop ((patches patches)
(+ 1 number) (number 1)
(cons `(a (@ (href ,(patch-url patch)) (links '()))
(title ,(string-append (match patches
"Link to " (()
(basename patch)))) (let* ((additional (and snippet
,(number->string number)) (snippet-link snippet)))
links))))))) (links (if additional
(_ #f))) (cons additional links)
links)))
(list-join (reverse links) ", ")))
((patch rest ...)
(loop rest
(+ 1 number)
(cons `(a (@ (href ,(patch-url patch))
(title ,(string-append
"Link to "
(basename patch))))
,(number->string number))
links))))))))))
(define (status package) (define (status package)
(define (url system) (define (url system)

View File

@ -95,7 +95,7 @@ always produces the same result when passed a given set of inputs. It
cannot alter the system's environment in cannot alter the system's environment in
any way; for instance, it cannot create, modify, or delete files outside any way; for instance, it cannot create, modify, or delete files outside
of its build and installation directories. This is achieved by running of its build and installation directories. This is achieved by running
build processes in isolated environments (or @dfn{chroots}), where only their build processes in isolated environments (or @dfn{containers}), where only their
explicit inputs are visible. explicit inputs are visible.
@cindex store @cindex store
@ -224,6 +224,7 @@ The @code{guix-daemon} program may then be run as @code{root} with:
# guix-daemon --build-users-group=guix-builder # guix-daemon --build-users-group=guix-builder
@end example @end example
@cindex chroot
@noindent @noindent
This way, the daemon starts build processes in a chroot, under one of This way, the daemon starts build processes in a chroot, under one of
the @code{guix-builder} users. On GNU/Linux, by default, the chroot the @code{guix-builder} users. On GNU/Linux, by default, the chroot
@ -271,6 +272,10 @@ is normally run as @code{root} like this:
@noindent @noindent
For details on how to set it up, @ref{Setting Up the Daemon}. For details on how to set it up, @ref{Setting Up the Daemon}.
@cindex chroot
@cindex container, build environment
@cindex build environment
@cindex reproducible builds
By default, @command{guix-daemon} launches build processes under By default, @command{guix-daemon} launches build processes under
different UIDs, taken from the build group specified with different UIDs, taken from the build group specified with
@code{--build-users-group}. In addition, each build process is run in a @code{--build-users-group}. In addition, each build process is run in a
@ -278,7 +283,10 @@ chroot environment that only contains the subset of the store that the
build process depends on, as specified by its derivation build process depends on, as specified by its derivation
(@pxref{Programming Interface, derivation}), plus a set of specific (@pxref{Programming Interface, derivation}), plus a set of specific
system directories. By default, the latter contains @file{/dev} and system directories. By default, the latter contains @file{/dev} and
@file{/dev/pts}. @file{/dev/pts}. Furthermore, on GNU/Linux, the build environment is a
@dfn{container}: in addition to having its own file system tree, it has
a separate mount name space, its own PID name space, network name space,
etc. This helps achieve reproducible builds (@pxref{Features}).
The following command-line options are supported: The following command-line options are supported:
@ -447,13 +455,18 @@ profiles, and remove those that are provably no longer referenced
generations of their profile so that the packages they refer to can be generations of their profile so that the packages they refer to can be
collected. collected.
@cindex reproducibility
@cindex reproducible builds
Finally, Guix takes a @dfn{purely functional} approach to package Finally, Guix takes a @dfn{purely functional} approach to package
management, as described in the introduction (@pxref{Introduction}). management, as described in the introduction (@pxref{Introduction}).
Each @file{/nix/store} package directory name contains a hash of all the Each @file{/nix/store} package directory name contains a hash of all the
inputs that were used to build that package---compiler, libraries, build inputs that were used to build that package---compiler, libraries, build
scripts, etc. This direct correspondence allows users to make sure a scripts, etc. This direct correspondence allows users to make sure a
given package installation matches the current state of their given package installation matches the current state of their
distribution, and helps maximize @dfn{reproducibility}. distribution. It also helps maximize @dfn{build reproducibility}:
thanks to the isolated build environments that are used, a given build
is likely to yield bit-identical files when performed on different
machines (@pxref{Invoking guix-daemon, container}).
@cindex substitute @cindex substitute
This foundation allows Guix to support @dfn{transparent binary/source This foundation allows Guix to support @dfn{transparent binary/source
@ -1470,12 +1483,16 @@ The @var{options} may be zero or more of the following:
@item --expression=@var{expr} @item --expression=@var{expr}
@itemx -e @var{expr} @itemx -e @var{expr}
Build the package @var{expr} evaluates to. Build the package or derivation @var{expr} evaluates to.
For example, @var{expr} may be @code{(@@ (gnu packages guile) For example, @var{expr} may be @code{(@@ (gnu packages guile)
guile-1.8)}, which unambiguously designates this specific variant of guile-1.8)}, which unambiguously designates this specific variant of
version 1.8 of Guile. version 1.8 of Guile.
Alternately, @var{expr} may refer to a zero-argument monadic procedure
(@pxref{The Store Monad}). The procedure must return a derivation as a
monadic value, which is then passed through @code{run-with-store}.
@item --source @item --source
@itemx -S @itemx -S
Build the packages' source derivations, rather than the packages Build the packages' source derivations, rather than the packages
@ -1546,6 +1563,22 @@ Use the given verbosity level. @var{level} must be an integer between 0
and 5; higher means more verbose output. Setting a level of 4 or more and 5; higher means more verbose output. Setting a level of 4 or more
may be helpful when debugging setup issues with the build daemon. may be helpful when debugging setup issues with the build daemon.
@item --log-file
Return the build log file names for the given
@var{package-or-derivation}s, or raise an error if build logs are
missing.
This works regardless of how packages or derivations are specified. For
instance, the following invocations are equivalent:
@example
guix build --log-file `guix build -d guile`
guix build --log-file `guix build guile`
guix build --log-file guile
guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)'
@end example
@end table @end table
Behind the scenes, @command{guix build} is essentially an interface to Behind the scenes, @command{guix build} is essentially an interface to
@ -1708,8 +1741,9 @@ Guix comes with a distribution of free software@footnote{The term
users of that software}.} that form the basis of the GNU system. This users of that software}.} that form the basis of the GNU system. This
includes core GNU packages such as GNU libc, GCC, and Binutils, as well includes core GNU packages such as GNU libc, GCC, and Binutils, as well
as many GNU and non-GNU applications. The complete list of available as many GNU and non-GNU applications. The complete list of available
packages can be seen by running @command{guix package} (@pxref{Invoking packages can be browsed
guix package}): @url{http://www.gnu.org/software/guix/package-list.html,on-line} or by
running @command{guix package} (@pxref{Invoking guix package}):
@example @example
guix package --list-available guix package --list-available

View File

@ -26,6 +26,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/acct.scm \ gnu/packages/acct.scm \
gnu/packages/acl.scm \ gnu/packages/acl.scm \
gnu/packages/algebra.scm \ gnu/packages/algebra.scm \
gnu/packages/apl.scm \
gnu/packages/apr.scm \ gnu/packages/apr.scm \
gnu/packages/aspell.scm \ gnu/packages/aspell.scm \
gnu/packages/attr.scm \ gnu/packages/attr.scm \
@ -43,6 +44,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/check.scm \ gnu/packages/check.scm \
gnu/packages/cmake.scm \ gnu/packages/cmake.scm \
gnu/packages/compression.scm \ gnu/packages/compression.scm \
gnu/packages/complexity.scm \
gnu/packages/cpio.scm \ gnu/packages/cpio.scm \
gnu/packages/cppi.scm \ gnu/packages/cppi.scm \
gnu/packages/cross-base.scm \ gnu/packages/cross-base.scm \
@ -77,6 +79,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/gnunet.scm \ gnu/packages/gnunet.scm \
gnu/packages/gnupg.scm \ gnu/packages/gnupg.scm \
gnu/packages/gnutls.scm \ gnu/packages/gnutls.scm \
gnu/packages/gnuzilla.scm \
gnu/packages/gperf.scm \ gnu/packages/gperf.scm \
gnu/packages/gprolog.scm \ gnu/packages/gprolog.scm \
gnu/packages/graphviz.scm \ gnu/packages/graphviz.scm \
@ -88,6 +91,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/gtk.scm \ gnu/packages/gtk.scm \
gnu/packages/guile.scm \ gnu/packages/guile.scm \
gnu/packages/gv.scm \ gnu/packages/gv.scm \
gnu/packages/gvpe.scm \
gnu/packages/help2man.scm \ gnu/packages/help2man.scm \
gnu/packages/hugs.scm \ gnu/packages/hugs.scm \
gnu/packages/icu4c.scm \ gnu/packages/icu4c.scm \
@ -139,6 +143,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/openldap.scm \ gnu/packages/openldap.scm \
gnu/packages/openssl.scm \ gnu/packages/openssl.scm \
gnu/packages/package-management.scm \ gnu/packages/package-management.scm \
gnu/packages/parallel.scm \
gnu/packages/parted.scm \ gnu/packages/parted.scm \
gnu/packages/patchelf.scm \ gnu/packages/patchelf.scm \
gnu/packages/pcre.scm \ gnu/packages/pcre.scm \

50
gnu/packages/apl.scm Normal file
View File

@ -0,0 +1,50 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages apl)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (gnu packages maths)
#:use-module (gnu packages readline))
(define-public apl
(package
(name "apl")
(version "1.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
(sha256
(base32
"1myinxa0m3y4fanpxflfakfk3m1s8641wdlbwbs0vg5yp10xm0m3"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/apl/")
(inputs
`(("gettext" ,guix:gettext)
("lapack" ,lapack)
("readline" ,readline)))
(synopsis "APL interpreter")
(description
"GNU APL is a free interpreter for the programming language APL. It is
an implementation of the ISO standard 13751.")
(license gpl3+)))

View File

@ -28,7 +28,7 @@
(define-public autogen (define-public autogen
(package (package
(name "autogen") (name "autogen")
(version "5.18.1") (version "5.18.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -37,7 +37,7 @@
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0k0gkr5inr9wb3ws30q6bbiqg3qm3ryvl9cznym2xis4lm216d53")))) "0s2021bwpq6h199cbbranz96hhm5s7v66lc68h8v198vqbg049yc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("which" ,which) (inputs `(("which" ,which)
("guile" ,guile-2.0))) ("guile" ,guile-2.0)))

View File

@ -49,19 +49,14 @@
(define-public hello (define-public hello
(package (package
(name "hello") (name "hello")
(version "2.8") (version "2.9")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version (uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")))) (base32 "19qy37gkasc4csb1d3bdiz9snn8mir2p3aj0jgzmfv0r2hi7mfzc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments '(#:configure-flags
`("--disable-dependency-tracking"
,(string-append "--with-gawk=" ; for illustration purposes
(assoc-ref %build-inputs "gawk")))))
(inputs `(("gawk" ,gawk)))
(synopsis "Hello, GNU world: An example GNU package") (synopsis "Hello, GNU world: An example GNU package")
(description (description
"GNU Hello prints the message \"Hello, world!\" and then exits. It "GNU Hello prints the message \"Hello, world!\" and then exits. It

View File

@ -30,7 +30,7 @@
(define bison (define bison
(package (package
(name "bison") (name "bison")
(version "3.0") (version "3.0.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -38,7 +38,7 @@
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1j14fqgi9wzqgsy4fhkcdrv4hv6rrvhvn84axs520w9b022mbb79")))) "1jx2ymvhl6h2jq6sf0lrk7ggfc2v1ri49yib8ppir0vdnh1znkll"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl))) (native-inputs `(("perl" ,perl)))
(inputs `(("flex" ,flex))) (inputs `(("flex" ,flex)))

View File

@ -35,6 +35,10 @@
(base32 (base32
"1jkbq97ajcf834z68hbn3xfhiz921zhn39gklml1racf0kb3jzh3")))) "1jkbq97ajcf834z68hbn3xfhiz921zhn39gklml1racf0kb3jzh3"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; Needed to have cflow-mode.el installed.
(native-inputs `(("emacs" ,emacs)))
(home-page "http://www.gnu.org/software/cflow/") (home-page "http://www.gnu.org/software/cflow/")
(synopsis "Create a graph of control flow within a program") (synopsis "Create a graph of control flow within a program")
(description (description

View File

@ -0,0 +1,49 @@
;;; 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 (gnu packages complexity)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix licenses)
#:use-module (guix build-system gnu)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages autogen))
(define-public complexity
(package
(name "complexity")
(version "1.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/complexity/complexity-"
version ".tar.gz"))
(sha256
(base32
"1aad7n35ymxbj5dlpvm64dcd71b6i7hbmps0g7nkf47vj53l6y2j"))))
(build-system gnu-build-system)
(native-inputs
`(("texinfo" ,texinfo)
("autogen" ,autogen)))
(home-page "http://www.gnu.org/software/complexity/")
(synopsis "Analyze complexity of C functions")
(description
"GNU complexity provides tools for finding procedures that are
convoluted, overly long or otherwise difficult to understand. This
may help in learning or reviewing unfamiliar code or perhaps
highlighting your own code that seemed comprehensible when you wrote it.")
(license gpl3+)))

View File

@ -27,14 +27,14 @@
(define-public freeipmi (define-public freeipmi
(package (package
(name "freeipmi") (name "freeipmi")
(version "1.3.2") (version "1.3.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/freeipmi/freeipmi-" (uri (string-append "mirror://gnu/freeipmi/freeipmi-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1gz2r3zp8ag4cd5cflh4fy8mpvwcx1wdr37mkqkph3m5lx2w48qb")))) "0pmgr66k4cx0gdwzfby6643m15bb4q2yx2g5r2jr3qidrfyxhi3j"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("readline" ,readline) ("libgcrypt" ,libgcrypt))) `(("readline" ,readline) ("libgcrypt" ,libgcrypt)))

View File

@ -38,14 +38,14 @@
(define-public libextractor (define-public libextractor
(package (package
(name "libextractor") (name "libextractor")
(version "1.1") (version "1.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/libextractor/libextractor-" (uri (string-append "mirror://gnu/libextractor/libextractor-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1zvj64ig456c9ya3r8ib48ms42cnli9y7ig5p04xqm16z7vw5dyb")))) "1n7z6s5ils6xmf6b0z1xda41maxj94c1n6wlyyxmacs5lrkh2a96"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; WARNING: Checks require /dev/shm to be in the build chroot, especially ;; WARNING: Checks require /dev/shm to be in the build chroot, especially
;; not to be a symbolic link to /run/shm. ;; not to be a symbolic link to /run/shm.

97
gnu/packages/gnuzilla.scm Normal file
View File

@ -0,0 +1,97 @@
;;; 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 gnuzilla)
#: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 glib)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages linux)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages xorg)
#:use-module (gnu packages yasm)
#:use-module (gnu packages zip))
(define-public icecat
(package
(name "icecat")
(version "24.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gnuzilla/"
(substring version 0 (string-index version #\.))
"/icecat-" version ".tar.gz"))
(sha256
(base32
"1vxzjwmhad6yxx4sk9zvapjgv5salcv10id061q0991ii3dycy9a"))))
(build-system gnu-build-system)
(inputs
`(("alsa-lib" ,alsa-lib)
("dbus" ,dbus)
("dbus-glib" ,dbus-glib)
("glib" ,glib)
("gstreamer" ,gstreamer-0.10)
("gst-plugins-base" ,gst-plugins-base-0.10)
("gtk+" ,gtk+-2)
("libxt" ,libxt)
("mesa" ,mesa)
("perl" ,perl)
("pkg-config" ,pkg-config)
("python" ,python-2) ; Python 3 not supported
("python2-pysqlite" ,python2-pysqlite)
("unzip" ,unzip)
("yasm" ,yasm)
("zip" ,zip)))
(arguments
`(#:tests? #f ; no check target
#:phases
(alist-cons-before
'patch-source-shebangs 'sanitise
(lambda _
;; delete dangling symlinks
(delete-file "browser/base/content/.#aboutDialog.xul")
(delete-file "browser/base/content/abouthome/.#aboutHome.xhtml")
(delete-file "browser/branding/unofficial/content/.#aboutHome.xhtml")
(delete-file "toolkit/crashreporter/google-breakpad/autotools/compile"))
(alist-replace
'configure
;; configure does not work followed by both "SHELL=..." and
;; "CONFIG_SHELL=..."; set environment variables instead
(lambda* (#:key outputs configure-flags #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(setenv "SHELL" (which "bash"))
(setenv "CONFIG_SHELL" (which "bash"))
(zero? (system* "./configure"
(string-append "--prefix=" out)
"--disable-webrtc")))) ; webrtc creates an error
%standard-phases))))
(home-page "http://www.gnu.org/software/gnuzilla/")
(synopsis "Entirely free browser derived from Mozilla Firefox")
(description
"IceCat is the GNU version of the Firefox browser. It is entirely free
software, which does not recommend non-free plugins and addons. It also
features extra privacy-protecting features built in.")
(license license:mpl2.0))) ; and others, see toolkit/content/license.html

48
gnu/packages/gvpe.scm Normal file
View File

@ -0,0 +1,48 @@
;;; 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 (gnu packages gvpe)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module ((guix licenses) #:select (gpl3+))
#:use-module (guix build-system gnu)
#:use-module (gnu packages openssl)
#:use-module ((gnu packages compression) #:select (zlib)))
(define-public gvpe
(package
(name "gvpe")
(version "2.25")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gvpe/gvpe-"
version ".tar.gz"))
(sha256
(base32
"1gsipcysvsk80gvyn9jnk9g0xg4ng9yd5zp066jnmpgs52d2vhvk"))))
(build-system gnu-build-system)
(home-page "http://software.schmorp.de/pkg/gvpe.html")
(inputs `(("openssl" ,openssl)
("zlib" ,zlib)))
(synopsis "Secure VPN among multiple nodes over an untrusted network")
(description
"The GNU Virtual Private Ethernet creates a virtual network
with multiple nodes using a variety of transport protocols. It works
by creating encrypted host-to-host tunnels between multiple
endpoints.")
(license gpl3+)))

View File

@ -17,11 +17,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages kde) (define-module (gnu packages kde)
#:use-module ((guix licenses) #:select (bsd-2)) #:use-module ((guix licenses) #:select (bsd-2 lgpl2.1+))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system cmake) #:use-module (guix build-system cmake)
#:use-module (gnu packages qt)) #:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages qt)
#:use-module (gnu packages xorg))
(define-public automoc4 (define-public automoc4
(package (package
@ -44,3 +48,32 @@
(synopsis "build tool for KDE") (synopsis "build tool for KDE")
(description "KDE desktop environment") (description "KDE desktop environment")
(license bsd-2))) (license bsd-2)))
(define-public phonon
(package
(name "phonon")
(version "4.7.0")
(source (origin
(method url-fetch)
(uri (string-append "http://download.kde.org/stable/" name
"/" version "/"
name "-" version ".tar.xz"))
(sha256
(base32
"1sxrnwm16dxy32xmrqf26762wmbqing1zx8i4vlvzgzvd9xy39ac"))))
(build-system cmake-build-system)
;; FIXME: Add interpreter ruby once available.
;; Add optional input libqtzeitgeist.
(inputs
`(("automoc4" ,automoc4)
("glib" ,glib)
("libx11" ,libx11)
("pkg-config" ,pkg-config)
("pulseaudio" ,pulseaudio)
("qt" ,qt-4)))
(arguments
`(#:tests? #f)) ; no test target
(home-page "http://phonon.kde.org/")
(synopsis "Qt 4 multimedia API")
(description "KDE desktop environment")
(license lgpl2.1+)))

View File

@ -25,14 +25,14 @@
(define-public lightning (define-public lightning
(package (package
(name "lightning") (name "lightning")
(version "2.0.1") (version "2.0.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/lightning/lightning-" (uri (string-append "mirror://gnu/lightning/lightning-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1cc19rpgrqvpkzb19ffsxw3k254m46npbkx8cbgv3dbxjf9sf4v5")))) "100ya7dx12403gimif7p2q7ahd8vxqrxpxqzqr1zqci825nb0b43"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "Library for generating assembly code at runtime") (synopsis "Library for generating assembly code at runtime")
(description (description

View File

@ -145,7 +145,7 @@
(license gpl2+))) (license gpl2+)))
(define-public linux-libre (define-public linux-libre
(let* ((version "3.11") (let* ((version "3.12")
(build-phase (build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args) '(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-)))) (let ((arch (car (string-split system #\-))))
@ -191,7 +191,7 @@
(uri (linux-libre-urls version)) (uri (linux-libre-urls version))
(sha256 (sha256
(base32 (base32
"1vlk04xkvyy1kc9zz556md173rn1qzlnvhz7c9sljv4bpk3mdspl")))) "0drjxm9h2k9bik2mhrqqqi6cm5rn2db647wf0zvb58xldj0zmhb6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl) (native-inputs `(("perl" ,perl)
("bc" ,bc) ("bc" ,bc)

47
gnu/packages/parallel.scm Normal file
View File

@ -0,0 +1,47 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages parallel)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages perl))
(define-public parallel
(package
(name "parallel")
(version "20131022")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/parallel/parallel-"
version ".tar.bz2"))
(sha256
(base32
"1ydn8aj72wfjdvldzjwah9cvqay8vzr3dbspa5l0g2y10dx0qa4k"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.gnu.org/software/parallel/")
(synopsis "Build and execute command lines in parallel")
(description
"GNU Parallel is a tool for executing shell jobs in parallel using one
or more computers. Jobs can consist of single commands or of scripts
and they are executed on lists of files, hosts, users or other items.")
(license gpl3+)))

View File

@ -118,22 +118,28 @@ X11 (yet).")
(("/bin/pwd") (which "pwd"))) (("/bin/pwd") (which "pwd")))
;; do not pass "--enable-fast-install", which makes the ;; do not pass "--enable-fast-install", which makes the
;; configure process fail ;; configure process fail
(zero? (system* "./configure" (zero? (system*
"-verbose" "./configure"
"-prefix" out "-verbose"
"-opensource" "-prefix" out
"-confirm-license" "-opensource"
;; drop all special machine instructions "-confirm-license"
"-no-sse2" ;; drop special machine instructions not supported
"-no-sse3" ;; on all instances of the target
"-no-ssse3" ,@(if (string-prefix? "x86_64"
"-no-sse4.1" (or (%current-target-system)
"-no-sse4.2" (%current-system)))
"-no-avx" '()
"-no-avx2" '("-no-sse2"))
"-no-neon" "-no-sse3"
"-no-mips_dsp" "-no-ssse3"
"-no-mips_dspr2")))) "-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-avx2"
"-no-neon"
"-no-mips_dsp"
"-no-mips_dspr2"))))
%standard-phases))) %standard-phases)))
(home-page "http://qt-project.org/") (home-page "http://qt-project.org/")
(synopsis "Cross-platform GUI library") (synopsis "Cross-platform GUI library")
@ -165,20 +171,26 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(("/bin/pwd") (which "pwd"))) (("/bin/pwd") (which "pwd")))
;; do not pass "--enable-fast-install", which makes the ;; do not pass "--enable-fast-install", which makes the
;; configure process fail ;; configure process fail
(zero? (system* "./configure" (zero? (system*
"-verbose" "./configure"
"-prefix" out "-verbose"
"-opensource" "-prefix" out
"-confirm-license" "-opensource"
;; drop all special machine instructions "-confirm-license"
"-no-mmx" ;; drop special machine instructions not supported
;; on all instances of the target
,@(if (string-prefix? "x86_64"
(or (%current-target-system)
(%current-system)))
'()
'("-no-mmx"
"-no-3dnow" "-no-3dnow"
"-no-sse" "-no-sse"
"-no-sse2" "-no-sse2"))
"-no-sse3" "-no-sse3"
"-no-ssse3" "-no-ssse3"
"-no-sse4.1" "-no-sse4.1"
"-no-sse4.2" "-no-sse4.2"
"-no-avx" "-no-avx"
"-no-neon")))) "-no-neon"))))
%standard-phases))))) %standard-phases)))))

View File

@ -23,8 +23,53 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:export (libmikmod)) #:export (sdl
sdl2
libmikmod))
(define sdl
(package
(name "sdl")
(version "1.2.15")
(source (origin
(method url-fetch)
(uri
(string-append "http://libsdl.org/release/SDL-"
version ".tar.gz"))
(sha256
(base32
"005d993xcac8236fpvd1iawkz4wqjybkpn8dbwaliqz5jfkidlyn"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; no check target
(inputs `(("libx11" ,libx11)
("libxrandr" ,libxrandr)
("mesa" ,mesa)
("alsa-lib" ,alsa-lib)
("pkg-config" ,pkg-config)
("pulseaudio" ,pulseaudio)))
(synopsis "Cross platform game development library")
(description "Simple DirectMedia Layer is a cross-platform development
library designed to provide low level access to audio, keyboard, mouse,
joystick, and graphics hardware.")
(home-page "http://libsdl.org/")
(license lgpl2.1)))
(define sdl2
(package (inherit sdl)
(name "sdl2")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri
(string-append "http://libsdl.org/release/SDL2-"
version ".tar.gz"))
(sha256
(base32
"0y3in99brki7vc2mb4c0w39v70mf4h341mblhh8nmq4h7lawhskg"))))
(license bsd-3)))
(define libmikmod (define libmikmod
(package (package

View File

@ -29,6 +29,7 @@
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages apr) #:use-module (gnu packages apr)
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages ed)
#:use-module (gnu packages nano) #:use-module (gnu packages nano)
#:use-module (gnu packages openssl) #:use-module (gnu packages openssl)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
@ -262,15 +263,16 @@ projects, from individuals to large-scale enterprise operations.")
(define-public rcs (define-public rcs
(package (package
(name "rcs") (name "rcs")
(version "5.9.0") (version "5.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/rcs/rcs-" (uri (string-append "mirror://gnu/rcs/rcs-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0w26vsx732dcmb5qfhlkkzvrk1sx6d74qibrn914n14j0ci90jcq")))) "1376amzaj7x6ar3xi1dldc0hgfa3n7412c46wqk2h2f2lf67jsk0"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("ed" ,ed)))
(home-page "http://www.gnu.org/software/rcs/") (home-page "http://www.gnu.org/software/rcs/")
(synopsis "Per-file local revision control system") (synopsis "Per-file local revision control system")
(description (description

View File

@ -134,7 +134,7 @@ made available under the /xchg CIFS share."
(setenv "PATH" cu) (setenv "PATH" cu)
,(if make-disk-image? ,(if make-disk-image?
`(zero? (system* img "create" "image.qcow2" `(zero? (system* img "create" "-f" "qcow2" "image.qcow2"
,(number->string disk-image-size))) ,(number->string disk-image-size)))
'(begin)) '(begin))

View File

@ -96,6 +96,7 @@ prepended to the name."
#:key #:key
(python (default-python)) (python (default-python))
(tests? #t) (tests? #t)
(test-target "test")
(configure-flags ''()) (configure-flags ''())
(phases '(@ (guix build python-build-system) (phases '(@ (guix build python-build-system)
%standard-phases)) %standard-phases))
@ -124,7 +125,7 @@ provides a 'setup.py' file as its build system."
source) source)
#:configure-flags ,configure-flags #:configure-flags ,configure-flags
#:system ,system #:system ,system
#:test-target "test" #:test-target ,test-target
#:tests? ,tests? #:tests? ,tests?
#:phases ,phases #:phases ,phases
#:outputs %outputs #:outputs %outputs

View File

@ -25,6 +25,7 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix hash) #:use-module (guix hash)
@ -63,6 +64,7 @@
derivation-path->output-path derivation-path->output-path
derivation-path->output-paths derivation-path->output-paths
derivation derivation
map-derivation
%guile-for-build %guile-for-build
imported-modules imported-modules
@ -539,15 +541,6 @@ advance, such as a file download.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path 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 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." 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)
;; Return #t if P is a store path, and not a sub-directory of a
;; store path. This predicate is needed because files *under* a
;; store path are not valid inputs.
(and (store-path? p)
(not (string-index (substring p len) #\/))))))
(define (add-output-paths drv) (define (add-output-paths drv)
;; Return DRV with an actual store path for each of its output and the ;; Return DRV with an actual store path for each of its output and the
;; corresponding environment variable. ;; corresponding environment variable.
@ -655,6 +648,113 @@ the build environment in the corresponding file, in a simple text format."
inputs)))) inputs))))
(set-file-name drv file)))) (set-file-name drv file))))
(define* (map-derivation store drv mapping
#:key (system (%current-system)))
"Given MAPPING, a list of pairs of derivations, return a derivation based on
DRV where all the 'car's of MAPPING have been replaced by its 'cdr's,
recursively."
(define (substitute str initial replacements)
(fold (lambda (path replacement result)
(string-replace-substring result path
replacement))
str
initial replacements))
(define (substitute-file file initial replacements)
(define contents
(with-fluids ((%default-port-encoding #f))
(call-with-input-file file get-string-all)))
(let ((updated (substitute contents initial replacements)))
(if (string=? updated contents)
file
;; XXX: permissions aren't preserved.
(add-text-to-store store (store-path-package-name file)
updated))))
(define input->output-paths
(match-lambda
(((? derivation? drv))
(list (derivation->output-path drv)))
(((? derivation? drv) sub-drvs ...)
(map (cut derivation->output-path drv <>)
sub-drvs))
((file)
(list file))))
(let ((mapping (fold (lambda (pair result)
(match pair
(((? derivation? orig) . replacement)
(vhash-cons (derivation-file-name orig)
replacement result))
((file . replacement)
(vhash-cons file replacement result))))
vlist-null
mapping)))
(define rewritten-input
;; Rewrite the given input according to MAPPING, and return an input
;; in the format used in 'derivation' calls.
(memoize
(lambda (input loop)
(match input
(($ <derivation-input> path (sub-drvs ...))
(match (vhash-assoc path mapping)
((_ . (? derivation? replacement))
(cons replacement sub-drvs))
((_ . replacement)
(list replacement))
(#f
(let* ((drv (loop (call-with-input-file path read-derivation))))
(cons drv sub-drvs)))))))))
(let loop ((drv drv))
(let* ((inputs (map (cut rewritten-input <> loop)
(derivation-inputs drv)))
(initial (append-map derivation-input-output-paths
(derivation-inputs drv)))
(replacements (append-map input->output-paths inputs))
;; Sources typically refer to the output directories of the
;; original inputs, INITIAL. Rewrite them by substituting
;; REPLACEMENTS.
(sources (map (lambda (source)
(match (vhash-assoc source mapping)
((_ . replacement)
replacement)
(#f
(substitute-file source
initial replacements))))
(derivation-sources drv)))
;; Now augment the lists of initials and replacements.
(initial (append (derivation-sources drv) initial))
(replacements (append sources replacements))
(name (store-path-package-name
(string-drop-right (derivation-file-name drv)
4))))
(derivation store name
(substitute (derivation-builder drv)
initial replacements)
(map (cut substitute <> initial replacements)
(derivation-builder-arguments drv))
#:system system
#:env-vars (map (match-lambda
((var . value)
`(,var
. ,(substitute value initial
replacements))))
(derivation-builder-environment-vars drv))
#:inputs (append (map list sources) inputs)
#:outputs (map car (derivation-outputs drv))
#:hash (match (derivation-outputs drv)
((($ <derivation-output> _ algo hash))
hash)
(_ #f))
#:hash-algo (match (derivation-outputs drv)
((($ <derivation-output> _ algo hash))
algo)
(_ #f)))))))
;;; ;;;
;;; Store compatibility layer. ;;; Store compatibility layer.

View File

@ -224,24 +224,26 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(($ <location> file line column) (($ <location> file line column)
(catch 'system (catch 'system
(lambda () (lambda ()
(call-with-input-file (search-path %load-path file) ;; In general we want to keep relative file names for modules.
(lambda (port) (with-fluids ((%file-port-name-canonicalization 'relative))
(goto port line column) (call-with-input-file (search-path %load-path file)
(match (read port) (lambda (port)
(('package inits ...) (goto port line column)
(let ((field (assoc field inits))) (match (read port)
(match field (('package inits ...)
((_ value) (let ((field (assoc field inits)))
;; Put the `or' here, and not in the first argument of (match field
;; `and=>', to work around a compiler bug in 2.0.5. ((_ value)
(or (and=> (source-properties value) ;; Put the `or' here, and not in the first argument of
source-properties->location) ;; `and=>', to work around a compiler bug in 2.0.5.
(and=> (source-properties field) (or (and=> (source-properties value)
source-properties->location))) source-properties->location)
(_ (and=> (source-properties field)
#f)))) source-properties->location)))
(_ (_
#f))))) #f))))
(_
#f))))))
(lambda _ (lambda _
#f))) #f)))
(_ #f))) (_ #f)))
@ -419,7 +421,7 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
#:modules modules #:modules modules
#:imported-modules modules #:imported-modules modules
#:guile-for-build guile))) #:guile-for-build guile)))
((and (? string?) (? store-path?) file) ((and (? string?) (? direct-store-path?) file)
file) file)
((? string? file) ((? string? file)
(add-to-store store (basename file) #t "sha256" file)))) (add-to-store store (basename file) #t "sha256" file))))

View File

@ -23,6 +23,7 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
@ -38,19 +39,23 @@
(define %store (define %store
(make-parameter #f)) (make-parameter #f))
(define (derivations-from-package-expressions str package-derivation (define (derivation-from-expression str package-derivation
system source?) system source?)
"Read/eval STR and return the corresponding derivation path for SYSTEM. "Read/eval STR and return the corresponding derivation path for SYSTEM.
When SOURCE? is true, return the derivations of the package sources; When SOURCE? is true and STR evaluates to a package, return the derivation of
otherwise, use PACKAGE-DERIVATION to compute the derivation of a package." the package source; otherwise, use PACKAGE-DERIVATION to compute the
(let ((p (read/eval-package-expression str))) derivation of a package."
(if source? (match (read/eval str)
(let ((source (package-source p))) ((? package? p)
(if source (if source?
(package-source-derivation (%store) source) (let ((source (package-source p)))
(leave (_ "package `~a' has no source~%") (if source
(package-name p)))) (package-source-derivation (%store) source)
(package-derivation (%store) p system)))) (leave (_ "package `~a' has no source~%")
(package-name p))))
(package-derivation (%store) p system)))
((? procedure? proc)
(run-with-store (%store) (proc) #:system system))))
;;; ;;;
@ -68,7 +73,7 @@ otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
(display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ " (display (_ "
-e, --expression=EXPR build the package EXPR evaluates to")) -e, --expression=EXPR build the package or derivation EXPR evaluates to"))
(display (_ " (display (_ "
-S, --source build the packages' source derivations")) -S, --source build the packages' source derivations"))
(display (_ " (display (_ "
@ -95,6 +100,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
as a garbage collector root")) as a garbage collector root"))
(display (_ " (display (_ "
--verbosity=LEVEL use the given verbosity LEVEL")) --verbosity=LEVEL use the given verbosity LEVEL"))
(display (_ "
--log-file return the log file names for the given derivations"))
(newline) (newline)
(display (_ " (display (_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
@ -161,7 +168,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(lambda (opt name arg result) (lambda (opt name arg result)
(let ((level (string->number arg))) (let ((level (string->number arg)))
(alist-cons 'verbosity level (alist-cons 'verbosity level
(alist-delete 'verbosity result))))))) (alist-delete 'verbosity result)))))
(option '("log-file") #f #f
(lambda (opt name arg result)
(alist-cons 'log-file? #t result)))))
;;; ;;;
@ -235,68 +245,89 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(leave (_ "~A: unknown package~%") name)))))) (leave (_ "~A: unknown package~%") name))))))
(with-error-handling (with-error-handling
(let ((opts (parse-options))) ;; Ask for absolute file names so that .drv file names passed from the
(define package->derivation ;; user to 'read-derivation' are absolute when it returns.
(match (assoc-ref opts 'target) (with-fluids ((%file-port-name-canonicalization 'absolute))
(#f package-derivation) (let ((opts (parse-options)))
(triplet (define package->derivation
(cut package-cross-derivation <> <> triplet <>)))) (match (assoc-ref opts 'target)
(#f package-derivation)
(triplet
(cut package-cross-derivation <> <> triplet <>))))
(parameterize ((%store (open-connection))) (parameterize ((%store (open-connection)))
(let* ((src? (assoc-ref opts 'source?)) (let* ((src? (assoc-ref opts 'source?))
(sys (assoc-ref opts 'system)) (sys (assoc-ref opts 'system))
(drv (filter-map (match-lambda (drv (filter-map (match-lambda
(('expression . str) (('expression . str)
(derivations-from-package-expressions (derivation-from-expression
str package->derivation sys src?)) str package->derivation sys src?))
(('argument . (? derivation-path? drv)) (('argument . (? derivation-path? drv))
(call-with-input-file drv read-derivation)) (call-with-input-file drv read-derivation))
(('argument . (? string? x)) (('argument . (? store-path?))
(let ((p (find-package x))) ;; Nothing to do; maybe for --log-file.
(if src? #f)
(let ((s (package-source p))) (('argument . (? string? x))
(package-source-derivation (let ((p (find-package x)))
(%store) s)) (if src?
(package->derivation (%store) p sys)))) (let ((s (package-source p)))
(_ #f)) (package-source-derivation
opts)) (%store) s))
(roots (filter-map (match-lambda (package->derivation (%store) p sys))))
(('gc-root . root) root) (_ #f))
(_ #f)) opts))
opts))) (roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(show-what-to-build (%store) drv (unless (assoc-ref opts 'log-file?)
#:use-substitutes? (assoc-ref opts 'substitutes?) (show-what-to-build (%store) drv
#:dry-run? (assoc-ref opts 'dry-run?)) #:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?)))
;; TODO: Add more options. ;; TODO: Add more options.
(set-build-options (%store) (set-build-options (%store)
#:keep-failed? (assoc-ref opts 'keep-failed?) #:keep-failed? (assoc-ref opts 'keep-failed?)
#:build-cores (or (assoc-ref opts 'cores) 0) #:build-cores (or (assoc-ref opts 'cores) 0)
#:fallback? (assoc-ref opts 'fallback?) #:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? (assoc-ref opts 'substitutes?) #:use-substitutes? (assoc-ref opts 'substitutes?)
#:max-silent-time (assoc-ref opts 'max-silent-time) #:max-silent-time (assoc-ref opts 'max-silent-time)
#:verbosity (assoc-ref opts 'verbosity)) #:verbosity (assoc-ref opts 'verbosity))
(if (assoc-ref opts 'derivations-only?) (cond ((assoc-ref opts 'log-file?)
(begin (for-each (lambda (file)
(format #t "~{~a~%~}" (map derivation-file-name drv)) (let ((log (log-file (%store) file)))
(for-each (cut register-root <> <>) (if log
(map (compose list derivation-file-name) drv) (format #t "~a~%" log)
roots)) (leave (_ "no build log for '~a'~%")
(or (assoc-ref opts 'dry-run?) file))))
(and (build-derivations (%store) drv) (delete-duplicates
(for-each (lambda (d) (append (map derivation-file-name drv)
(format #t "~{~a~%~}" (filter-map (match-lambda
(map (match-lambda (('argument
((out-name . out) . (? store-path? file))
(derivation->output-path file)
d out-name))) (_ #f))
(derivation-outputs d)))) opts)))))
drv) ((assoc-ref opts 'derivations-only?)
(for-each (cut register-root <> <>) (format #t "~{~a~%~}" (map derivation-file-name drv))
(map (lambda (drv) (for-each (cut register-root <> <>)
(map cdr (map (compose list derivation-file-name) drv)
(derivation->output-paths drv))) roots))
drv) ((not (assoc-ref opts 'dry-run?))
roots))))))))) (and (build-derivations (%store) drv)
(for-each (lambda (d)
(format #t "~{~a~%~}"
(map (match-lambda
((out-name . out)
(derivation->output-path
d out-name)))
(derivation-outputs d))))
drv)
(for-each (cut register-root <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots))))))))))

View File

@ -123,7 +123,8 @@ again."
(lambda () (lambda ()
body ...) body ...)
(lambda args (lambda args
;; The SIGALRM triggers EINTR, because of the bug at ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR
;; because of the bug at
;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>.
;; When that happens, try again. Note: SA_RESTART cannot be ;; When that happens, try again. Note: SA_RESTART cannot be
;; used because of <http://bugs.gnu.org/14640>. ;; used because of <http://bugs.gnu.org/14640>.
@ -162,10 +163,17 @@ provide."
(warning (_ "while fetching ~a: server is unresponsive~%") (warning (_ "while fetching ~a: server is unresponsive~%")
(uri->string uri)) (uri->string uri))
(warning (_ "try `--no-substitutes' if the problem persists~%")) (warning (_ "try `--no-substitutes' if the problem persists~%"))
(when port
(close-port port))) ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user,
;; and thus PORT had to be closed and re-opened. This is not the
;; case afterward.
(unless (or (guile-version>? "2.0.9")
(version>? (version) "2.0.9.39"))
(when port
(close-port port))))
(begin (begin
(set! port (open-socket-for-uri uri #:buffered? buffered?)) (when (or (not port) (port-closed? port))
(set! port (open-socket-for-uri uri #:buffered? buffered?)))
(http-fetch uri #:text? #f #:port port))))))) (http-fetch uri #:text? #f #:port port)))))))
(define-record-type <cache> (define-record-type <cache>
@ -290,6 +298,12 @@ reading PORT."
(time>? (subtract-duration now (make-time time-duration 0 ttl)) (time>? (subtract-duration now (make-time time-duration 0 ttl))
(make-time time-monotonic 0 date))) (make-time time-monotonic 0 date)))
(define %lookup-threads
;; Number of threads spawned to perform lookup operations. This means we
;; can have this many simultaneous HTTP GET requests to the server, which
;; limits the impact of connection latency.
20)
(define (lookup-narinfo cache path) (define (lookup-narinfo cache path)
"Check locally if we have valid info about PATH, otherwise go to CACHE and "Check locally if we have valid info about PATH, otherwise go to CACHE and
check what it has." check what it has."
@ -489,8 +503,9 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
;; Return the subset of PATHS available in CACHE. ;; Return the subset of PATHS available in CACHE.
(let ((substitutable (let ((substitutable
(if cache (if cache
(par-map (cut lookup-narinfo cache <>) (n-par-map %lookup-threads
paths) (cut lookup-narinfo cache <>)
paths)
'()))) '())))
(for-each (lambda (narinfo) (for-each (lambda (narinfo)
(when narinfo (when narinfo
@ -501,8 +516,9 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
;; Reply info about PATHS if it's in CACHE. ;; Reply info about PATHS if it's in CACHE.
(let ((substitutable (let ((substitutable
(if cache (if cache
(par-map (cut lookup-narinfo cache <>) (n-par-map %lookup-threads
paths) (cut lookup-narinfo cache <>)
paths)
'()))) '())))
(for-each (lambda (narinfo) (for-each (lambda (narinfo)
(format #t "~a\n~a\n~a\n" (format #t "~a\n~a\n~a\n"

View File

@ -85,9 +85,11 @@
%store-prefix %store-prefix
store-path? store-path?
direct-store-path?
derivation-path? derivation-path?
store-path-package-name store-path-package-name
store-path-hash-part)) store-path-hash-part
log-file))
(define %protocol-version #x10c) (define %protocol-version #x10c)
@ -639,6 +641,14 @@ collected, and the number of bytes freed."
;; `isStorePath' in Nix does something similar. ;; `isStorePath' in Nix does something similar.
(string-prefix? (%store-prefix) path)) (string-prefix? (%store-prefix) path))
(define (direct-store-path? path)
"Return #t if PATH is a store path, and not a sub-directory of a store path.
This predicate is sometimes needed because files *under* a store path are not
valid inputs."
(and (store-path? path)
(let ((len (+ 1 (string-length (%store-prefix)))))
(not (string-index (substring path len) #\/)))))
(define (derivation-path? path) (define (derivation-path? path)
"Return #t if PATH is a derivation path." "Return #t if PATH is a derivation path."
(and (store-path? path) (string-suffix? ".drv" path))) (and (store-path? path) (string-suffix? ".drv" path)))
@ -660,3 +670,23 @@ syntactically valid store path."
"/([0-9a-df-np-sv-z]{32})-[^/]+$")))) "/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
(and=> (regexp-exec path-rx path) (and=> (regexp-exec path-rx path)
(cut match:substring <> 1)))) (cut match:substring <> 1))))
(define (log-file store file)
"Return the build log file for FILE, or #f if none could be found. FILE
must be an absolute store file name, or a derivation file name."
(define state-dir ; XXX: factorize
(or (getenv "NIX_STATE_DIR") %state-directory))
(cond ((derivation-path? file)
(let* ((base (basename file))
(log (string-append (dirname state-dir) ; XXX: ditto
"/log/nix/drvs/"
(string-take base 2) "/"
(string-drop base 2) ".bz2")))
(and (file-exists? log) log)))
(else
(match (valid-derivers store file)
((derivers ...)
;; Return the first that works.
(any (cut log-file store <>) derivers))
(_ #f)))))

View File

@ -45,6 +45,7 @@
show-what-to-build show-what-to-build
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
read/eval
read/eval-package-expression read/eval-package-expression
location->string location->string
switch-symlinks switch-symlinks
@ -193,25 +194,29 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(leave (_ "~a~%") (leave (_ "~a~%")
(strerror (system-error-errno args))))))) (strerror (system-error-errno args)))))))
(define (read/eval-package-expression str) (define (read/eval str)
"Read and evaluate STR and return the package it refers to, or exit an "Read and evaluate STR, raising an error if something goes wrong."
error."
(let ((exp (catch #t (let ((exp (catch #t
(lambda () (lambda ()
(call-with-input-string str read)) (call-with-input-string str read))
(lambda args (lambda args
(leave (_ "failed to read expression ~s: ~s~%") (leave (_ "failed to read expression ~s: ~s~%")
str args))))) str args)))))
(let ((p (catch #t (catch #t
(lambda () (lambda ()
(eval exp the-scm-module)) (eval exp the-scm-module))
(lambda args (lambda args
(leave (_ "failed to evaluate expression `~a': ~s~%") (leave (_ "failed to evaluate expression `~a': ~s~%")
exp args))))) exp args)))))
(if (package? p)
p (define (read/eval-package-expression str)
(leave (_ "expression `~s' does not evaluate to a package~%") "Read and evaluate STR and return the package it refers to, or exit an
exp))))) error."
(match (read/eval str)
((? package? p) p)
(_
(leave (_ "expression ~s does not evaluate to a package~%")
str))))
(define* (show-what-to-build store drv (define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t)) #:key dry-run? (use-substitutes? #t))

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -62,6 +63,7 @@
guile-version>? guile-version>?
package-name->name+version package-name->name+version
string-tokenize* string-tokenize*
string-replace-substring
file-extension file-extension
file-sans-extension file-sans-extension
call-with-temporary-output-file call-with-temporary-output-file
@ -387,6 +389,28 @@ like `string-tokenize', but SEPARATOR is a string."
(else (else
(reverse (cons string result)))))) (reverse (cons string result))))))
(define* (string-replace-substring str substr replacement
#:optional
(start 0)
(end (string-length str)))
"Replace all occurrences of SUBSTR in the START--END range of STR by
REPLACEMENT."
(match (string-length substr)
(0
(error "string-replace-substring: empty substring"))
(substr-length
(let loop ((start start)
(pieces (list (substring str 0 start))))
(match (string-contains str substr start end)
(#f
(string-concatenate-reverse
(cons (substring str start) pieces)))
(index
(loop (+ index substr-length)
(cons* replacement
(substring str start index)
pieces))))))))
(define (call-with-temporary-output-file proc) (define (call-with-temporary-output-file proc)
"Call PROC with a name of a temporary file and open output port to that "Call PROC with a name of a temporary file and open output port to that
file; close the file and delete it when leaving the dynamic extent of this file; close the file and delete it when leaving the dynamic extent of this

View File

@ -4,3 +4,4 @@ en@boldquot
en@quot en@quot
eo eo
pt_BR pt_BR
sr

1304
po/sr.po Normal file

File diff suppressed because it is too large Load Diff

View File

@ -26,6 +26,7 @@
#:use-module ((guix packages) #:select (package-derivation)) #:use-module ((guix packages) #:select (package-derivation))
#:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-1.8))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -690,6 +691,57 @@ Deriver: ~a~%"
((p2 . _) ((p2 . _)
(string<? p1 p2))))))))))))) (string<? p1 p2)))))))))))))
(test-equal "map-derivation"
"hello"
(let* ((joke (package-derivation %store guile-1.8))
(good (package-derivation %store %bootstrap-guile))
(drv1 (build-expression->derivation %store "original-drv1"
(%current-system)
#f ; systematically fail
'()
#:guile-for-build joke))
(drv2 (build-expression->derivation %store "original-drv2"
(%current-system)
'(call-with-output-file %output
(lambda (p)
(display "hello" p)))
'()))
(drv3 (build-expression->derivation %store "drv-to-remap"
(%current-system)
'(let ((in (assoc-ref
%build-inputs "in")))
(copy-file in %output))
`(("in" ,drv1))
#:guile-for-build joke))
(drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
(,joke . ,good))))
(out (derivation->output-path drv4)))
(and (build-derivations %store (list (pk 'remapped drv4)))
(call-with-input-file out get-string-all))))
(test-equal "map-derivation, sources"
"hello"
(let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
(script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
(bash-full (package-derivation %store (@ (gnu packages bash) bash)))
(drv1 (derivation %store "drv-to-remap"
;; XXX: This wouldn't work in practice, but if
;; we append "/bin/bash" then we can't replace
;; it with the bootstrap bash, which is a
;; single file.
(derivation->output-path bash-full)
`("-e" ,script1)
#:inputs `((,bash-full) (,script1))))
(drv2 (map-derivation %store drv1
`((,bash-full . ,%bash)
(,script1 . ,script2))))
(out (derivation->output-path drv2)))
(and (build-derivations %store (list (pk 'remapped* drv2)))
(call-with-input-file out get-string-all))))
(test-end) (test-end)

View File

@ -36,6 +36,17 @@ guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \
guix build hello -d | \ guix build hello -d | \
grep -e '-hello-[0-9\.]\+\.drv$' grep -e '-hello-[0-9\.]\+\.drv$'
# Should all return valid log files.
drv="`guix build -d -e '(@@ (gnu packages base) %bootstrap-guile)'`"
out="`guix build -e '(@@ (gnu packages base) %bootstrap-guile)'`"
log="`guix build --log-file $drv`"
echo "$log" | grep log/.*guile.*drv
test -f "$log"
test "`guix build -e '(@@ (gnu packages base) %bootstrap-guile)' --log-file`" \
= "$log"
test "`guix build --log-file guile-bootstrap`" = "$log"
test "`guix build --log-file $out`" = "$log"
# Should fail because the name/version combination could not be found. # Should fail because the name/version combination could not be found.
if guix build hello-0.0.1 -n; then false; else true; fi if guix build hello-0.0.1 -n; then false; else true; fi
@ -61,3 +72,11 @@ if guix build -n time-3.2; # FAIL, version not found
then false; else true; fi then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL if guix build -n something-that-will-never-exist; # FAIL
then false; else true; fi then false; else true; fi
# Invoking a monadic procedure.
guix build -e "(begin
(use-modules (guix monads) (guix utils))
(lambda ()
(derivation-expression \"test\" (%current-system)
'(mkdir %output) '())))" \
--dry-run

View File

@ -81,6 +81,12 @@
(list version `(version ,version)))) (list version `(version ,version))))
(not (package-field-location %bootstrap-guile 'does-not-exist))))) (not (package-field-location %bootstrap-guile 'does-not-exist)))))
;; Make sure we don't change the file name to an absolute file name.
(test-equal "package-field-location, relative file name"
(location-file (package-location %bootstrap-guile))
(with-fluids ((%file-port-name-canonicalization 'absolute))
(location-file (package-field-location %bootstrap-guile 'version))))
(test-assert "package-transitive-inputs" (test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a")) (let* ((a (dummy-package "a"))
(b (dummy-package "b" (b (dummy-package "b"
@ -122,6 +128,17 @@
(package-source package)))) (package-source package))))
(string=? file source))) (string=? file source)))
(test-assert "package-source-derivation, indirect store path"
(let* ((dir (add-to-store %store "guix-build" #t "sha256"
(dirname (search-path %load-path
"guix/build/utils.scm"))))
(package (package (inherit (dummy-package "p"))
(source (string-append dir "/utils.scm"))))
(source (package-source-derivation %store
(package-source package))))
(and (direct-store-path? source)
(string-suffix? "utils.scm" source))))
(test-equal "package-source-derivation, snippet" (test-equal "package-source-derivation, snippet"
"OK" "OK"
(let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz"

View File

@ -65,6 +65,15 @@
(string-append (%store-prefix) (string-append (%store-prefix)
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
(test-assert "direct-store-path?"
(and (direct-store-path?
(string-append (%store-prefix)
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
(not (direct-store-path?
(string-append
(%store-prefix)
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))))
(test-skip (if %store 0 10)) (test-skip (if %store 0 10))
(test-assert "dead-paths" (test-assert "dead-paths"
@ -140,6 +149,33 @@
(equal? (valid-derivers %store o) (equal? (valid-derivers %store o)
(list (derivation-file-name d)))))) (list (derivation-file-name d))))))
(test-assert "log-file, derivation"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
(s (add-to-store %store "bash" #t "sha256"
(search-bootstrap-binary "bash"
(%current-system))))
(d (derivation %store "the-thing"
s `("-e" ,b)
#:env-vars `(("foo" . ,(random-text)))
#:inputs `((,b) (,s)))))
(and (build-derivations %store (list d))
(file-exists? (pk (log-file %store (derivation-file-name d)))))))
(test-assert "log-file, output file name"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
(s (add-to-store %store "bash" #t "sha256"
(search-bootstrap-binary "bash"
(%current-system))))
(d (derivation %store "the-thing"
s `("-e" ,b)
#:env-vars `(("foo" . ,(random-text)))
#:inputs `((,b) (,s))))
(o (derivation->output-path d)))
(and (build-derivations %store (list d))
(file-exists? (pk (log-file %store o)))
(string=? (log-file %store (derivation-file-name d))
(log-file %store o)))))
(test-assert "no substitutes" (test-assert "no substitutes"
(let* ((s (open-connection)) (let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system))) (d1 (package-derivation s %bootstrap-guile (%current-system)))

View File

@ -82,6 +82,14 @@
(string-tokenize* "foo!bar!" "!") (string-tokenize* "foo!bar!" "!")
(string-tokenize* "foo+-+bar+-+baz" "+-+"))) (string-tokenize* "foo+-+bar+-+baz" "+-+")))
(test-equal "string-replace-substring"
'("foo BAR! baz"
"/gnu/store/chbouib"
"")
(list (string-replace-substring "foo bar baz" "bar" "BAR!")
(string-replace-substring "/nix/store/chbouib" "/nix/" "/gnu/")
(string-replace-substring "" "foo" "bar")))
(test-equal "fold2, 1 list" (test-equal "fold2, 1 list"
(list (reverse (iota 5)) (list (reverse (iota 5))
(map - (reverse (iota 5)))) (map - (reverse (iota 5))))