ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into core-updates

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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:
- Install the dependencies (see 'Requirements' above) and build tools using
Guix. You should have the following packages installed in your user
profile:
Guix:
- autoconf
- automake
- bzip2
- gcc
- gettext
- glibc
- guile
- ld-wrapper
- libgcrypt
- pkg-config
- sqlite
guix package --install={autoconf,automake,bzip2,gcc,binutils,ld-wrapper,glibc,gettext,guile,libgcrypt,pkg-config,sqlite}
- set the environment variables that Guix recommends you to set during the
package installation process:
ACLOCAL, CPATH, LIBRARY_PATH, PATH, PKG_CONFIG_PATH
In addition, set
GUIX_LD_WRAPPER_ALLOW_IMPURITIES=yes
ACLOCAL_PATH, CPATH, LIBRARY_PATH, PKG_CONFIG_PATH
- 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
`--with-libgcrypt-prefix=$HOME/.guix-profile/'

61
build-aux/list-packages.scm
View file

@ -71,12 +71,14 @@ (define (package->sxml package previous description-ids remaining)
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,
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)
(let ((loc (package-location package)))
(and loc
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n"
(number->string (location-line loc))))))
(and loc (location-url loc))))
(define (license package)
(define ->sxml
@ -103,26 +105,37 @@ (define (patch-url patch)
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
(basename patch)))
(match (and (origin? (package-source package))
(origin-patches (package-source package)))
((patches ..1)
`(div "patches: "
,(let loop ((patches patches)
(number 1)
(links '()))
(match patches
(()
(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)))))))
(_ #f)))
(define (snippet-link snippet)
(let ((loc (package-field-location package 'source)))
`(a (@ (href ,(location-url loc))
(title "Link to patch snippet"))
"snippet")))
(and (origin? (package-source package))
(let ((patches (origin-patches (package-source package)))
(snippet (origin-snippet (package-source package))))
(and (or (pair? patches) snippet)
`(div "patches: "
,(let loop ((patches patches)
(number 1)
(links '()))
(match patches
(()
(let* ((additional (and snippet
(snippet-link snippet)))
(links (if additional
(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 (url system)

46
doc/guix.texi
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
any way; for instance, it cannot create, modify, or delete files outside
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.
@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
@end example
@cindex chroot
@noindent
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
@ -271,6 +272,10 @@ is normally run as @code{root} like this:
@noindent
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
different UIDs, taken from the build group specified with
@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
(@pxref{Programming Interface, derivation}), plus a set of specific
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:
@ -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
collected.
@cindex reproducibility
@cindex reproducible builds
Finally, Guix takes a @dfn{purely functional} approach to package
management, as described in the introduction (@pxref{Introduction}).
Each @file{/nix/store} package directory name contains a hash of all the
inputs that were used to build that package---compiler, libraries, build
scripts, etc. This direct correspondence allows users to make sure a
given package installation matches the current state of their
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
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}
@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)
guile-1.8)}, which unambiguously designates this specific variant of
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
@itemx -S
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
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
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
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
packages can be seen by running @command{guix package} (@pxref{Invoking
guix package}):
packages can be browsed
@url{http://www.gnu.org/software/guix/package-list.html,on-line} or by
running @command{guix package} (@pxref{Invoking guix package}):
@example
guix package --list-available

5
gnu-system.am
View file

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

4
gnu/packages/autogen.scm
View file

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

9
gnu/packages/base.scm
View file

@ -49,19 +49,14 @@ (define-module (gnu packages base)
(define-public hello
(package
(name "hello")
(version "2.8")
(version "2.9")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32 "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))))
(base32 "19qy37gkasc4csb1d3bdiz9snn8mir2p3aj0jgzmfv0r2hi7mfzc"))))
(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")
(description
"GNU Hello prints the message \"Hello, world!\" and then exits. It

4
gnu/packages/bison.scm
View file

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

4
gnu/packages/cflow.scm
View file

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

49
gnu/packages/complexity.scm Normal file
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+)))

4
gnu/packages/freeipmi.scm
View file

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

4
gnu/packages/gnunet.scm
View file

@ -38,14 +38,14 @@ (define-module (gnu packages gnunet)
(define-public libextractor
(package
(name "libextractor")
(version "1.1")
(version "1.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libextractor/libextractor-"
version ".tar.gz"))
(sha256
(base32
"1zvj64ig456c9ya3r8ib48ms42cnli9y7ig5p04xqm16z7vw5dyb"))))
"1n7z6s5ils6xmf6b0z1xda41maxj94c1n6wlyyxmacs5lrkh2a96"))))
(build-system gnu-build-system)
;; WARNING: Checks require /dev/shm to be in the build chroot, especially
;; 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+)))

37
gnu/packages/kde.scm
View file

@ -17,11 +17,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(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 download)
#: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
(package
@ -44,3 +48,32 @@ (define-public automoc4
(synopsis "build tool for KDE")
(description "KDE desktop environment")
(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+)))

4
gnu/packages/lightning.scm
View file

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

4
gnu/packages/linux.scm
View file

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

72
gnu/packages/qt.scm
View file

@ -118,22 +118,28 @@ (define-public qt
(("/bin/pwd") (which "pwd")))
;; do not pass "--enable-fast-install", which makes the
;; configure process fail
(zero? (system* "./configure"
"-verbose"
"-prefix" out
"-opensource"
"-confirm-license"
;; drop all special machine instructions
"-no-sse2"
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-avx2"
"-no-neon"
"-no-mips_dsp"
"-no-mips_dspr2"))))
(zero? (system*
"./configure"
"-verbose"
"-prefix" out
"-opensource"
"-confirm-license"
;; drop special machine instructions not supported
;; on all instances of the target
,@(if (string-prefix? "x86_64"
(or (%current-target-system)
(%current-system)))
'()
'("-no-sse2"))
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-avx2"
"-no-neon"
"-no-mips_dsp"
"-no-mips_dspr2"))))
%standard-phases)))
(home-page "http://qt-project.org/")
(synopsis "Cross-platform GUI library")
@ -165,20 +171,26 @@ (define-public qt-4
(("/bin/pwd") (which "pwd")))
;; do not pass "--enable-fast-install", which makes the
;; configure process fail
(zero? (system* "./configure"
"-verbose"
"-prefix" out
"-opensource"
"-confirm-license"
;; drop all special machine instructions
"-no-mmx"
(zero? (system*
"./configure"
"-verbose"
"-prefix" out
"-opensource"
"-confirm-license"
;; 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-sse"
"-no-sse2"
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-neon"))))
"-no-sse2"))
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-neon"))))
%standard-phases)))))

47
gnu/packages/sdl.scm
View file

@ -23,8 +23,53 @@ (define-module (gnu packages sdl)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#: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
(package

6
gnu/packages/version-control.scm
View file

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

2
gnu/system/vm.scm
View file

@ -134,7 +134,7 @@ (define builder
(setenv "PATH" cu)
,(if make-disk-image?
`(zero? (system* img "create" "image.qcow2"
`(zero? (system* img "create" "-f" "qcow2" "image.qcow2"
,(number->string disk-image-size)))
'(begin))

3
guix/build-system/python.scm
View file

@ -96,6 +96,7 @@ (define* (python-build store name source inputs
#:key
(python (default-python))
(tests? #t)
(test-target "test")
(configure-flags ''())
(phases '(@ (guix build python-build-system)
%standard-phases))
@ -124,7 +125,7 @@ (define builder
source)
#:configure-flags ,configure-flags
#:system ,system
#:test-target "test"
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs

118
guix/derivations.scm
View file

@ -25,6 +25,7 @@ (define-module (guix derivations)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix hash)
@ -63,6 +64,7 @@ (define-module (guix derivations)
derivation-path->output-path
derivation-path->output-paths
derivation
map-derivation
%guile-for-build
imported-modules
@ -539,15 +541,6 @@ (define* (derivation store name builder args
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)
;; 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)
;; Return DRV with an actual store path for each of its output and the
;; corresponding environment variable.
@ -655,6 +648,113 @@ (define (set-file-name drv file)
inputs))))
(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.

40
guix/packages.scm
View file

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

181
guix/scripts/build.scm
View file

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

32
guix/scripts/substitute-binary.scm
View file

@ -123,7 +123,8 @@ (define-syntax-rule (with-timeout duration handler body ...)
(lambda ()
body ...)
(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>.
;; When that happens, try again. Note: SA_RESTART cannot be
;; used because of <http://bugs.gnu.org/14640>.
@ -162,10 +163,17 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t))
(warning (_ "while fetching ~a: server is unresponsive~%")
(uri->string uri))
(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
(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)))))))
(define-record-type <cache>
@ -290,6 +298,12 @@ (define (obsolete? date now ttl)
(time>? (subtract-duration now (make-time time-duration 0 ttl))
(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)
"Check locally if we have valid info about PATH, otherwise go to CACHE and
check what it has."
@ -489,8 +503,9 @@ (define (guix-substitute-binary . args)
;; Return the subset of PATHS available in CACHE.
(let ((substitutable
(if cache
(par-map (cut lookup-narinfo cache <>)
paths)
(n-par-map %lookup-threads
(cut lookup-narinfo cache <>)
paths)
'())))
(for-each (lambda (narinfo)
(when narinfo
@ -501,8 +516,9 @@ (define (guix-substitute-binary . args)
;; Reply info about PATHS if it's in CACHE.
(let ((substitutable
(if cache
(par-map (cut lookup-narinfo cache <>)
paths)
(n-par-map %lookup-threads
(cut lookup-narinfo cache <>)
paths)
'())))
(for-each (lambda (narinfo)
(format #t "~a\n~a\n~a\n"

32
guix/store.scm
View file

@ -85,9 +85,11 @@ (define-module (guix store)
%store-prefix
store-path?
direct-store-path?
derivation-path?
store-path-package-name
store-path-hash-part))
store-path-hash-part
log-file))
(define %protocol-version #x10c)
@ -639,6 +641,14 @@ (define (store-path? path)
;; `isStorePath' in Nix does something similar.
(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)
"Return #t if PATH is a derivation path."
(and (store-path? path) (string-suffix? ".drv" path)))
@ -660,3 +670,23 @@ (define (store-path-hash-part path)
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
(and=> (regexp-exec path-rx path)
(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)))))

31
guix/ui.scm
View file

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

24
guix/utils.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -62,6 +63,7 @@ (define-module (guix utils)
guile-version>?
package-name->name+version
string-tokenize*
string-replace-substring
file-extension
file-sans-extension
call-with-temporary-output-file
@ -387,6 +389,28 @@ (define len
(else
(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)
"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

1
po/LINGUAS
View file

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

1304
po/sr.po Normal file
View file

File diff suppressed because it is too large Load diff

52
tests/derivations.scm
View file

@ -26,6 +26,7 @@ (define-module (test-derivations)
#:use-module ((guix packages) #:select (package-derivation))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-1.8))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@ -690,6 +691,57 @@ (define (deps path . deps)
((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)

19
tests/guix-build.sh
View file

@ -36,6 +36,17 @@ guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \
guix build hello -d | \
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.
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
if guix build -n something-that-will-never-exist; # FAIL
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

17
tests/packages.scm
View file

@ -81,6 +81,12 @@ (define read-at
(list version `(version ,version))))
(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"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
@ -122,6 +128,17 @@ (define read-at
(package-source package))))
(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"
"OK"
(let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz"

36
tests/store.scm
View file

@ -65,6 +65,15 @@ (define (random-text)
(string-append (%store-prefix)
"/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-assert "dead-paths"
@ -140,6 +149,33 @@ (define (same? x y)
(equal? (valid-derivers %store o)
(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"
(let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system)))

8
tests/utils.scm
View file

@ -82,6 +82,14 @@ (define-module (test-utils)
(string-tokenize* "foo!bar!" "!")
(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"
(list (reverse (iota 5))
(map - (reverse (iota 5))))