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

Merge branch 'master' into core-updates

This commit is contained in:
Ludovic Courtès 2013-11-01 12:59:31 +01:00
parent e50805251a b645425f71
commit ff8061b591
59 changed files with 1627 additions and 555 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.dir-locals.el
View File

@ -13,7 +13,7 @@
(eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
(eval . (put 'with-error-handling 'scheme-indent-function 0))
(eval . (put 'with-mutex 'scheme-indent-function 1))

2
AUTHORS
View File

@ -8,6 +8,7 @@ contributing to it. See `nix/AUTHORS' for details.
The fine people listed below have contributed code to GNU Guix (in
alphabetical order):
Eric Bavier <bavier@member.fsf.org>
Ludovic Courtès <ludo@gnu.org>
Andreas Enge <andreas@enge.fr>
Joshua S. Grant <youlysses@riseup.net>
@ -15,4 +16,5 @@ alphabetical order):
Aljosha Papsch <misc@rpapsch.de>
Cyril Roelandt <tipecaml@gmail.com>
Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
David Thompson <dthompson2@worcester.edu>
Mark H. Weaver <mhw@netris.org>

6
Makefile.am
View File

@ -95,6 +95,10 @@ srfi/srfi-37.scm: srfi/srfi-37.scm.in
endif INSTALL_SRFI_37
# Handy way to remove the .go files without removing all the rest.
clean-go:
-$(RM) -f $(GOBJECTS)
SCM_TESTS = \
tests/base32.scm \
@ -240,5 +244,5 @@ assert-binaries-available:
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/check-available-binaries.scm"
.PHONY: sync-descriptions gen-ChangeLog
.PHONY: sync-descriptions gen-ChangeLog clean-go
.PHONY: assert-no-store-file-names assert-binaries-available

1
THANKS
View File

@ -14,6 +14,7 @@ infrastructure help:
John Darrington <john@cellform.com>
Rafael Ferreira <rafael.f.f1@gmail.com>
Christian Grothoff <christian@grothoff.org>
Jeffrin Jose <ahiliation@yahoo.co.in>
Matthew Lien <bluet@bluet.org>
Yutaka Niibe <gniibe@fsij.org>
Cyrill Schenkel <cyrill.schenkel@gmail.com>

9
doc.am
View File

@ -21,7 +21,8 @@ info_TEXINFOS = doc/guix.texi
EXTRA_DIST += \
doc/fdl-1.3.texi \
doc/images/bootstrap-graph.dot \
doc/images/bootstrap-graph.eps
doc/images/bootstrap-graph.eps \
doc/images/bootstrap-graph.pdf
infoimagedir = $(infodir)/images
dist_infoimage_DATA = doc/images/bootstrap-graph.png
@ -47,6 +48,6 @@ DOT_OPTIONS = \
# We cannot add new dependencies to `doc/guix.pdf' & co. (info "(automake)
# Extending"). Using the `-local' rules is imperfect, because they may be
# triggered after the main rule. Oh, well.
pdf-local: doc/images/bootstrap-graph.pdf
info-local: doc/images/bootstrap-graph.png
ps-local: doc/images/bootstrap-graph.eps
pdf-local: $(top_srcdir)/doc/images/bootstrap-graph.pdf
info-local: $(top_srcdir)/doc/images/bootstrap-graph.png
ps-local: $(top_srcdir)/doc/images/bootstrap-graph.eps

66
doc/guix.texi
View File

@ -8,7 +8,19 @@
@c %**end of header
@include version.texi
@set YEARS 2012, 2013
@copying
Copyright @copyright{} 2012, 2013 Ludovic Courtès@*
Copyright @copyright{} 2013 Andreas Enge@*
Copyright @copyright{} 2013 Nikita Karetnikov
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A
copy of the license is included in the section entitled ``GNU Free
Documentation License''.
@end copying
@dircategory Package management
@direntry
@ -31,34 +43,9 @@
Edition @value{EDITION} @*
@value{UPDATED} @*
Copyright @copyright{} @value{YEARS} Ludovic Court@`es, Andreas Enge, Nikita Karetnikov
@ifinfo
@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A
copy of the license is included in the section entitled ``GNU Free
Documentation License''.
@end quotation
@end ifinfo
@insertcopying
@end titlepage
@copying
This manual documents GNU Guix version @value{VERSION}.
Copyright @copyright{} @value{YEARS} Ludovic Courtès
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A
copy of the license is included in the section entitled ``GNU Free
Documentation License.''
@end copying
@contents
@c *********************************************************************
@ -68,18 +55,6 @@ Documentation License.''
This document describes GNU Guix version @value{VERSION}, a functional
package management tool written for the GNU system.
@quotation
Copyright @copyright{} @value{YEARS} Ludovic Courtès, Andreas Enge, Nikita Karetnikov
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A
copy of the license is included in the section entitled ``GNU Free
Documentation License.''
@end quotation
@menu
* Introduction:: What is Guix about?
* Installation:: Installing Guix.
@ -880,6 +855,12 @@ but it supports the following options:
@item --verbose
Produce verbose output, writing build logs to the standard error output.
@item --url=@var{url}
Download the source tarball of Guix from @var{url}.
By default, the tarball is taken from its canonical address at
@code{gnu.org}, for the stable branch of Guix.
@item --bootstrap
Use the bootstrap Guile to build the latest Guix. This option is only
useful to Guix developers.
@ -2105,6 +2086,13 @@ one:
guix build --target=armv5tel-linux-gnueabi bootstrap-tarballs
@end example
Once these are built, the @code{(gnu packages bootstrap)} module needs
to be updated to refer to these binaries on the target platform. In
addition, the @code{glibc-dynamic-linker} procedure in that module must
be augmented to return the right file name for libc's dynamic linker on
that platform; likewise, @code{system->linux-architecture} in @code{(gnu
packages linux)} must be taught about the new platform.
In practice, there may be some complications. First, it may be that the
extended GNU triplet that specifies an ABI (like the @code{eabi} suffix
above) is not recognized by all the GNU tools. Typically, glibc

10
gnu-system.am
View File

@ -22,11 +22,13 @@
GNU_SYSTEM_MODULES = \
gnu/packages.scm \
gnu/packages/acct.scm \
gnu/packages/acl.scm \
gnu/packages/algebra.scm \
gnu/packages/apr.scm \
gnu/packages/aspell.scm \
gnu/packages/attr.scm \
gnu/packages/autogen.scm \
gnu/packages/autotools.scm \
gnu/packages/avahi.scm \
gnu/packages/base.scm \
@ -92,6 +94,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/imagemagick.scm \
gnu/packages/indent.scm \
gnu/packages/irssi.scm \
gnu/packages/kde.scm \
gnu/packages/ld-wrapper.scm \
gnu/packages/less.scm \
gnu/packages/lesstif.scm \
@ -139,6 +142,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/patchelf.scm \
gnu/packages/pcre.scm \
gnu/packages/pdf.scm \
gnu/packages/pem.scm \
gnu/packages/perl.scm \
gnu/packages/pkg-config.scm \
gnu/packages/plotutils.scm \
@ -156,6 +160,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/samba.scm \
gnu/packages/scheme.scm \
gnu/packages/screen.scm \
gnu/packages/sdl.scm \
gnu/packages/shishi.scm \
gnu/packages/skribilo.scm \
gnu/packages/smalltalk.scm \
@ -215,12 +220,15 @@ dist_patch_DATA = \
gnu/packages/patches/gcc-cross-environment-variables.patch \
gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \
gnu/packages/patches/glib-tests-newnet.patch \
gnu/packages/patches/glib-tests-prlimit.patch \
gnu/packages/patches/glibc-bootstrap-system.patch \
gnu/packages/patches/glibc-ldd-x86_64.patch \
gnu/packages/patches/glibc-make-4.0.patch \
gnu/packages/patches/glibc-no-ld-so-cache.patch \
gnu/packages/patches/grub-gets-undeclared.patch \
gnu/packages/patches/gstreamer-0.10-bison3.patch \
gnu/packages/patches/gstreamer-0.10-silly-test.patch \
gnu/packages/patches/guile-1.8-cpp-4.5.patch \
gnu/packages/patches/guile-default-utf8.patch \
gnu/packages/patches/guile-linux-syscalls.patch \
@ -235,8 +243,10 @@ dist_patch_DATA = \
gnu/packages/patches/perl-no-sys-dirs.patch \
gnu/packages/patches/plotutils-libpng-jmpbuf.patch \
gnu/packages/patches/procps-make-3.82.patch \
gnu/packages/patches/pulseaudio-test-timeouts.patch \
gnu/packages/patches/python-fix-dbm.patch \
gnu/packages/patches/qemu-multiple-smb-shares.patch \
gnu/packages/patches/qt4-tests.patch \
gnu/packages/patches/readline-link-ncurses.patch \
gnu/packages/patches/ripperx-libm.patch \
gnu/packages/patches/scheme48-tests.patch \

44
gnu/packages/acct.scm Normal file
View File

@ -0,0 +1,44 @@
;;; 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 acct)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public acct
(package
(name "acct")
(version "6.6.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/acct/acct-"
version ".tar.gz"))
(sha256
(base32
"1jzz601cavml7894fjalw661gz28ia35002inw990agr3rhiaiam"))))
(build-system gnu-build-system)
(home-page "https://gnu.org/software/acct/")
(synopsis "Standard login and process accounting utilities")
(description
"GNU acct provides a means for system administrators to determine
system usage patterns. It provides information on, for example, connections,
programs executed, and system resources used.")
(license gpl3+)))

32
gnu/packages/algebra.scm
View File

@ -125,6 +125,38 @@ PARI is also available as a C library to allow for faster computations.")
(license gpl2+)
(home-page "http://pari.math.u-bordeaux.fr/")))
(define-public gp2c
(package
(name "gp2c")
(version "0.0.8")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/GP2C/gp2c-"
version ".tar.gz"))
(sha256 (base32
"03fgiwy2si264g3zfgw2yi6i2l8szl5m106zgwk77sddshk20b34"))))
(build-system gnu-build-system)
(inputs `(("pari-gp" ,pari-gp)))
(arguments
'(#:configure-flags
(list (string-append "--with-paricfg="
(assoc-ref %build-inputs "pari-gp")
"/lib/pari/pari.cfg"))))
(synopsis "PARI/GP, a computer algebra system for number theory")
(description
"PARI/GP is a widely used computer algebra system designed for fast
computations in number theory (factorisations, algebraic number theory,
elliptic curves...), but it also contains a large number of other useful
functions to compute with mathematical entities such as matrices,
polynomials, power series, algebraic numbers, etc., and a lot of
transcendental functions.
PARI is also available as a C library to allow for faster computations.
GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(license gpl2)
(home-page "http://pari.math.u-bordeaux.fr/")))
(define-public bc
(package
(name "bc")

63
gnu/packages/autogen.scm Normal file
View File

@ -0,0 +1,63 @@
;;; 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 autogen)
#: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 which)
#:use-module (gnu packages guile))
(define-public autogen
(package
(name "autogen")
(version "5.18.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/autogen/rel"
version "/autogen-"
version ".tar.gz"))
(sha256
(base32
"0k0gkr5inr9wb3ws30q6bbiqg3qm3ryvl9cznym2xis4lm216d53"))))
(build-system gnu-build-system)
(inputs `(("which" ,which)
("guile" ,guile-2.0)))
(arguments
'(#:phases (alist-cons-before
'patch-source-shebangs 'patch-test-scripts
(lambda _
(let ((sh (which "sh")))
(substitute*
(append (find-files "agen5/test" "\\.test$")
(find-files "autoopts/test" "\\.(test|in)$"))
(("/bin/sh") sh)
(("/usr/bin/tr") "tr"))))
%standard-phases)))
(home-page "http://www.gnu.org/software/autogen/")
(synopsis "Automated program generator")
(description
"AutoGen is a program to ease the maintenance of programs that contain
large amounts of repetitive text. It automates the construction of these
sections of the code, simplifying the task of keeping the text in sync. It
also includes an add-on package called AutoOpts, which is specialized for the
maintenance and documentation of program options.")
(license gpl3+)))

14
gnu/packages/bootstrap.scm
View File

@ -80,14 +80,13 @@
(patch-guile %bootstrap-guile)
(patch-inputs %bootstrap-patch-inputs))))
(define (package-from-tarball name* source* program-to-test description*)
"Return a package that correspond to the extraction of SOURCE*.
PROGRAM-TO-TEST is a program to run after extraction of SOURCE*, to
(define (package-from-tarball name source program-to-test description)
"Return a package that correspond to the extraction of SOURCE.
PROGRAM-TO-TEST is a program to run after extraction of SOURCE, to
check whether everything is alright."
(package
(name name*)
(name name)
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
@ -111,8 +110,9 @@ check whether everything is alright."
(inputs
`(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
("xz" ,(search-bootstrap-binary "xz" (%current-system)))
("tarball" ,(bootstrap-origin (source* (%current-system))))))
(synopsis description*)
("tarball" ,(bootstrap-origin (source (%current-system))))))
(source #f)
(synopsis description)
(description #f)
(home-page #f)
(license #f)))

3
gnu/packages/cmake.scm
View File

@ -41,7 +41,6 @@
(build-system gnu-build-system)
(arguments
'(#:test-target "test"
#:patch-flags '("-p0")
#:phases (alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
@ -68,7 +67,7 @@
(inputs
`(("file" ,file)))
(home-page "http://www.cmake.org/")
(synopsis "A cross-platform, open-source build system")
(synopsis "Cross-platform build system")
(description
"CMake is a family of tools designed to build, test and package software.
CMake is used to control the software compilation process using simple platform

43
gnu/packages/compression.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 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,7 +22,8 @@
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
#:use-module (guix build-system gnu)
#:use-module (gnu packages which))
(define-public zlib
(package
@ -230,14 +232,14 @@ format are designed to be portable across platforms.")
(define-public lzip
(package
(name "lzip")
(version "1.14")
(version "1.15")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/lzip/lzip-"
version ".tar.gz"))
(sha256
(base32
"1rybhk2pxpfh2789ck9mrkdv3bpx7b7miwndlshb5vb02m9crxbz"))))
"1dh5vmj5apizfawnsm50y7z064yx7cz3313przph16gwd3dgrlvw"))))
(build-system gnu-build-system)
(home-page "http://www.nongnu.org/lzip/lzip.html")
(synopsis "Lossless data compressor based on the LZMA algorithm")
@ -247,3 +249,38 @@ one of gzip or bzip2. Lzip decompresses almost as fast as gzip and compresses
more than bzip2, which makes it well suited for software distribution and data
archiving. Lzip is a clean implementation of the LZMA algorithm.")
(license license:gpl3+)))
(define-public sharutils
(package
(name "sharutils")
(version "4.14")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/sharutils/sharutils-"
version ".tar.xz"))
(sha256
(base32
"033sq1v0cp0bi1mp320xaqwd4fhakqc5747hh6qa1asjrzpqiqza"))))
(build-system gnu-build-system)
(inputs
`(("which" ,which)))
(arguments
`(#:phases
(alist-cons-after
'patch-source-shebangs 'unpatch-source-shebang
;; revert the patch-shebang phase on a script which is
;; in fact test data
(lambda* (#:key #:allow-other-keys)
(substitute* "tests/shar-1.ok"
(((which "sh")) "/bin/sh")))
%standard-phases)))
(home-page "http://www.gnu.org/software/sharutils/")
(synopsis "Archives in shell scripts, uuencode/uudecode")
(description
"GNU sharutils is a package for manipulating shell archives. Shell
archives are collections of files that can be unpacked using only the shell;
an archive is a self-extracting shell script. The tools in the Sharutils
package make working with shell archives more robust, offering compression,
file-splitting and simple checksums.")
(license license:gpl3+)))

4
gnu/packages/gcc.scm
View File

@ -202,14 +202,14 @@ Go. It also includes standard libraries for these languages.")
(define-public gcc-4.8
(package (inherit gcc-4.7)
(version "4.8.1")
(version "4.8.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"04sqn0ds17ys8l6zn7vyyvjz1a7hsk4zb0381vlw9wnr7az48nsl"))))))
"1j6dwgby4g3p3lz7zkss32ghr45zpdidrg8xvazvn91lqxv25p09"))))))
(define-public isl
(package

3
gnu/packages/glib.scm
View File

@ -117,7 +117,8 @@ shared NFS home directories.")
(base32 "0cpzqadqk6z6bmb79p04pykxc8x57rvshh33414cnk41bvgaf4vm"))
(patches (list (search-patch "glib-tests-homedir.patch")
(search-patch "glib-tests-desktop.patch")
(search-patch "glib-tests-prlimit.patch")))))
(search-patch "glib-tests-prlimit.patch")
(search-patch "glib-tests-newnet.patch")))))
(build-system gnu-build-system)
(outputs '("out" ; everything
"doc")) ; 20 MiB of GTK-Doc reference

133
gnu/packages/gnome.scm
View File

@ -17,14 +17,16 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages gnome)
#:use-module ((guix licenses) #:select (gpl2 gpl2+ lgpl2.1+ lgpl3))
#:use-module ((guix licenses) #:select (gpl2 gpl2+ lgpl2.0+ lgpl2.1+ lgpl3))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages pdf)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages libcanberra)
#:use-module (gnu packages libpng)
#:use-module (gnu packages perl)
@ -98,6 +100,102 @@ Gnome project. It includes xml2po tool which makes it easier to translate
and keep up to date translations of documentation.")
(license gpl2+))) ; xslt under lgpl
(define-public libgnome-keyring
(package
(name "libgnome-keyring")
(version "3.6.0")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnome/sources/libgnome-keyring/3.6/libgnome-keyring-"
version
".tar.xz"))
(sha256
(base32
"0c4qrjpmv1hqga3xv6wsq2z10x2n78qgw7q3k3s01y1pggxkgjkd"))))
(build-system gnu-build-system)
(native-inputs
`(("intltool" ,intltool)))
(inputs
`(("pkg-config" ,pkg-config)
("libgcrypt" ,libgcrypt)
("dbus" ,dbus)))
(propagated-inputs
;; Referred to in .h files and .pc.
`(("glib" ,glib)))
(home-page "http://www.gnome.org")
(synopsis "Accessing passwords from the GNOME keyring")
(description
"Client library to access passwords from the GNOME keyring.")
;; Though a couple of files are LGPLv2.1+.
(license lgpl2.0+)))
(define-public evince
(package
(name "evince")
(version "3.6.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/evince/3.6/evince-"
version ".tar.xz"))
(sha256
(base32
"1da1pij030dh8mb0pr0jnyszgsbjnh8lc17rj5ii52j3kmbv51qv"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--disable-nautilus")
;; FIXME: Tests fail with:
;; ImportError: No module named gi.repository
;; Where should that module come from?
#:tests? #f
#:phases (alist-cons-after
'install 'set-mime-search-path
(lambda* (#:key inputs outputs #:allow-other-keys)
;; Wrap 'evince' so that it knows where MIME info is.
(let ((out (assoc-ref outputs "out"))
(mime (assoc-ref inputs "shared-mime-info")))
(wrap-program (string-append out "/bin/evince")
`("XDG_DATA_DIRS" ":" prefix
,(list (string-append mime "/share")
(string-append out "/share"))))))
%standard-phases)))
(inputs
`(("libspectre" ,libspectre)
;; ("djvulibre" ,djvulibre)
("ghostscript" ,ghostscript)
("poppler" ,poppler)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("libgnome-keyring" ,libgnome-keyring)
("gnome-icon-theme" ,gnome-icon-theme)
("itstool" ,itstool)
("gdk-pixbuf" ,gdk-pixbuf)
("atk" ,atk)
("pango" ,pango)
("gtk+" ,gtk+)
("glib" ,glib)
("libxml2" ,libxml2)
("pkg-config" ,pkg-config)
("libsm" ,libsm)
("libice" ,libice)
("shared-mime-info" ,shared-mime-info)
;; For tests.
("dogtail" ,python2-dogtail)))
(native-inputs
`(("intltool" ,intltool)))
(home-page
"http://www.gnome.org/projects/evince/")
(synopsis "GNOME's document viewer")
(description
"Evince is a document viewer for multiple document formats. It
currently supports PDF, PostScript, DjVu, TIFF and DVI. The goal
of Evince is to replace the multiple document viewers that exist
on the GNOME Desktop with a single simple application.")
(license gpl2+)))
(define-public gsettings-desktop-schemas
(package
(name "gsettings-desktop-schemas")
@ -175,6 +273,37 @@ GNOME and KDE desktops to the icon names proposed in the specification.")
"Icons for the GNOME desktop.")
(license lgpl3))) ; or Creative Commons BY-SA 3.0
(define-public shared-mime-info
(package
(name "shared-mime-info")
(version "1.2")
(source (origin
(method url-fetch)
(uri (string-append "http://freedesktop.org/~hadess/shared-mime-info-"
version ".tar.xz"))
(sha256
(base32
"0y5vi0vr6rbhvfzcfg57cfskn362bpvcpca9cy598nmr87i6lld5"))))
(build-system gnu-build-system)
(arguments
;; The build system appears not to be parallel-safe.
'(#:parallel-build? #f))
(inputs
`(("glib" ,glib)
("libxml2" ,libxml2)
("pkg-config" ,pkg-config)))
(native-inputs
`(("intltool" ,intltool)))
(home-page "http://freedesktop.org/wiki/Software/shared-mime-info")
(synopsis "Database of common MIME types")
(description
"The shared-mime-info package contains the core database of common types
and the update-mime-database command used to extend it. It requires glib2 to
be installed for building the update command. Additionally, it uses intltool
for translations, though this is only a dependency for the maintainers. This
database is translated at Transifex.")
(license gpl2+)))
(define-public hicolor-icon-theme
(package
(name "hicolor-icon-theme")

15
gnu/packages/gnunet.scm
View File

@ -91,14 +91,14 @@ tool to extract metadata from a file and print the results.")
(define-public libmicrohttpd
(package
(name "libmicrohttpd")
(version "0.9.30")
(version "0.9.31")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-"
version ".tar.gz"))
(sha256
(base32
"0v30w90qx8wpg5ksy97f5r4acpwd4q7q2v508mcss00vzj18rx40"))))
"06sxxial1794589k0ahi7nhhyfp14jf4jwirf6bkxqhs138pghfa"))))
(build-system gnu-build-system)
(inputs
`(("curl" ,curl)
@ -106,13 +106,16 @@ tool to extract metadata from a file and print the results.")
("libgcrypt" ,libgcrypt)
("openssl" ,openssl)
("zlib" ,zlib)))
(arguments
`(#:parallel-tests? #f))
(synopsis "C library implementing an HTTP 1.1 server")
(description
"Libmicrohttpd is a small, embeddable HTTP server implemented as a C
library. It makes it easy to run an HTTP server as part of another
"GNU libmicrohttpd is a small, embeddable HTTP server implemented as a
C library. It makes it easy to run an HTTP server as part of another
application. The library is fully HTTP 1.1 compliant. It can listen on
multiple ports, supports four different threading models, and supports IPv6.
It also features security features such as basic and digest authentication
multiple ports, supports four different threading models, and supports
IPv6. It
also features security features such as basic and digest authentication
and support for SSL3 and TLS.")
(license license:lgpl2.1+)
(home-page "http://www.gnu.org/software/libmicrohttpd/")))

45
gnu/packages/gstreamer.scm
View File

@ -21,12 +21,14 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages bison)
#:use-module (gnu packages flex)
#:use-module (gnu packages glib)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python))
#:use-module (gnu packages python)
#:use-module (gnu packages xml))
(define-public gstreamer
(package
@ -64,6 +66,30 @@ simple plugin with a clean, generic interface.
This package provides the core library and elements.")
(license lgpl2.0+)))
(define-public gstreamer-0.10
(package (inherit gstreamer)
(version "0.10.36")
(source
(origin
(method url-fetch)
(uri (string-append "http://gstreamer.freedesktop.org/src/gstreamer/gstreamer-"
version ".tar.xz"))
(sha256
(base32
"1nkid1n2l3rrlmq5qrf5yy06grrkwjh3yxl5g0w58w0pih8allci"))
(patches
(list (search-patch "gstreamer-0.10-bison3.patch")
(search-patch "gstreamer-0.10-silly-test.patch")))))
(propagated-inputs
`(("libxml2" ,libxml2)))
(inputs
`(("bison" ,bison)
("flex" ,flex)
("glib" ,glib)
("perl" ,perl)
("pkg-config" ,pkg-config)
("python" ,python-2)))))
(define-public gst-plugins-base
(package
(name "gst-plugins-base")
@ -107,3 +133,20 @@ simple plugin with a clean, generic interface.
This package provides an essential exemplary set of elements.")
(license lgpl2.0+)))
(define-public gst-plugins-base-0.10
(package (inherit gst-plugins-base)
(version "0.10.36")
(source
(origin
(method url-fetch)
(uri (string-append "http://gstreamer.freedesktop.org/src/gst-plugins-base/gst-plugins-base-"
version ".tar.xz"))
(sha256
(base32
"0jp6hjlra98cnkal4n6bdmr577q8mcyp3c08s3a02c4hjhw5rr0z"))))
(inputs
`(("glib" ,glib)
("gstreamer" ,gstreamer-0.10)
("pkg-config" ,pkg-config)
("python" ,python-2)))))

11
gnu/packages/gtk.scm
View File

@ -115,14 +115,14 @@ affine transformation (scale, rotation, shear, etc.)")
(define-public harfbuzz
(package
(name "harfbuzz")
(version "0.9.21")
(version "0.9.22")
(source (origin
(method url-fetch)
(uri (string-append "http://www.freedesktop.org/software/harfbuzz/release/harfbuzz-"
version ".tar.bz2"))
(sha256
(base32
"1s6sffgf6ndy12fyln2bdnkn3cb1qfkch0rakdgkgwlq7n46zlx0"))))
"1nkimwadri6v2kzrmz8y0crmy59gw0kg4i4f6cc786bngs0815lq"))))
(build-system gnu-build-system)
(inputs
`(("cairo" ,cairo)
@ -287,7 +287,7 @@ application suites.")
(define-public gtk+
(package (inherit gtk+-2)
(version "3.10.0")
(version "3.10.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/gtk+/"
@ -295,7 +295,7 @@ application suites.")
version ".tar.xz"))
(sha256
(base32
"1zjkbjvp6ay08107r6zfsrp39x7qfadbd86p3hs5v4ydc2rzwnb5"))))
"1f3a7r3z7i9xh5imlfpfcgyydzkj2fnd0v6ylvqxij0yzfbnhbn1"))))
(propagated-inputs
`(("at-spi2-atk" ,at-spi2-atk)
("atk" ,atk)
@ -310,8 +310,7 @@ application suites.")
("python-wrapper" ,python-wrapper)
("xorg-server" ,xorg-server)))
(arguments
`(#:configure-flags '("--enable-x11-backend") ; should not be needed in > 3.10.0
#:phases
`(#:phases
(alist-replace
'configure
(lambda* (#:key #:allow-other-keys #:rest args)

46
gnu/packages/kde.scm Normal file
View File

@ -0,0 +1,46 @@
;;; 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 kde)
#:use-module ((guix licenses) #:select (bsd-2))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (gnu packages qt))
(define-public automoc4
(package
(name "automoc4")
(version "0.9.88")
(source (origin
(method url-fetch)
(uri (string-append "http://download.kde.org/stable/" name
"/" version "/" name "-"
version ".tar.bz2"))
(sha256
(base32
"0jackvg0bdjg797qlbbyf9syylm0qjs55mllhn11vqjsq3s1ch93"))))
(build-system cmake-build-system)
(inputs
`(("qt" ,qt-4)))
(arguments
`(#:tests? #f)) ; no check target
(home-page "http://techbase.kde.org/Development/Tools/Automoc4")
(synopsis "build tool for KDE")
(description "KDE desktop environment")
(license bsd-2)))

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

@ -212,9 +212,8 @@ list of Guile module names to be embedded in the initrd."
(and (zero? (system* gzip "--best" "initrd"))
(rename-file "initrd.gz" "initrd")))))))))
(let ((name* name))
(package
(name name*)
(name name)
(version "0")
(source #f)
(build-system trivial-build-system)
@ -233,7 +232,7 @@ list of Guile module names to be embedded in the initrd."
"An initial RAM disk (initrd), really a gzipped cpio archive, for use by
the Linux kernel.")
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/"))))
(home-page "http://www.gnu.org/software/guix/")))
(define-public qemu-initrd
(expression->initrd

46
gnu/packages/linux.scm
View File

@ -35,6 +35,7 @@
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages attr)
#:use-module (gnu packages xml)
#:use-module (gnu packages autotools)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
@ -65,7 +66,7 @@
version "-gnu.tar.xz")))
(define-public linux-libre-headers
(let* ((version* "3.3.8")
(let* ((version "3.3.8")
(build-phase
(lambda (arch)
`(lambda _
@ -85,10 +86,10 @@
(string-append out
"/include/config/kernel.release")
(lambda (p)
(format p "~a-default~%" ,version*))))))))
(format p "~a-default~%" ,version))))))))
(package
(name "linux-libre-headers")
(version version*)
(version version)
(source (origin
(method url-fetch)
(uri (linux-libre-urls version))
@ -145,7 +146,7 @@
(license gpl2+)))
(define-public linux-libre
(let* ((version* "3.11")
(let* ((version "3.11")
(build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-))))
@ -185,7 +186,7 @@
"modules_install"))))))
(package
(name "linux-libre")
(version version*)
(version version)
(source (origin
(method url-fetch)
(uri (linux-libre-urls version))
@ -719,3 +720,38 @@ Linux-based operating systems.")
;; License is BSD-3 or GPLv2, at the user's choice.
(license gpl2)))
(define-public bridge-utils
(package
(name "bridge-utils")
(version "1.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/bridge/bridge-utils-"
version ".tar.gz"))
(sha256
(base32
"12367cwqmi0yqphi6j8rkx97q8hw52yq2fx4k0xfclkcizxybya2"))))
(build-system gnu-build-system)
;; The tarball lacks all the generated files.
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)))
(arguments
'(#:phases (alist-cons-before
'configure 'bootstrap
(lambda _
(zero? (system* "autoreconf" "-vf")))
%standard-phases)
#:tests? #f)) ; no 'check' target
(home-page
"http://www.linuxfoundation.org/collaborate/workgroups/networking/bridge")
(synopsis "Manipulate Ethernet bridges")
(description
"Utilities for Linux's Ethernet bridging facilities. A bridge is a way
to connect two Ethernet segments together in a protocol independent way.
Packets are forwarded based on Ethernet address, rather than IP address (like
a router). Since forwarding is done at Layer 2, all protocols can go
transparently through a bridge.")
(license gpl2+)))

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

@ -451,15 +451,15 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
;; A statically-linked Guile that is relocatable--i.e., it can search
;; .scm and .go files relative to its installation directory, rather
;; than in hard-coded configure-time paths.
(let* ((patches* (cons* (search-patch "guile-relocatable.patch")
(let* ((patches (cons* (search-patch "guile-relocatable.patch")
(search-patch "guile-default-utf8.patch")
(search-patch "guile-linux-syscalls.patch")
(origin-patches (package-source guile-2.0))))
(source* (origin (inherit (package-source guile-2.0))
(patches patches*)))
(source (origin (inherit (package-source guile-2.0))
(patches patches)))
(guile (package (inherit guile-2.0)
(name (string-append (package-name guile-2.0) "-static"))
(source source*)
(source source)
(synopsis "Statically-linked and relocatable Guile")
(propagated-inputs
`(("bdw-gc" ,libgc)

35
gnu/packages/maths.scm
View File

@ -26,6 +26,7 @@
#:use-module (gnu packages compression)
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'gnu:))
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages readline)
@ -55,7 +56,7 @@ enough to be used effectively as a scientific calculator.")
(define-public gsl
(package
(name "gsl")
(version "1.15")
(version "1.16")
(source
(origin
(method url-fetch)
@ -63,10 +64,11 @@ enough to be used effectively as a scientific calculator.")
version ".tar.gz"))
(sha256
(base32
"18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
"0lrgipi0z6559jqh82yx8n4xgnxkhzj46v96dl77hahdp58jzg3k"))))
(build-system gnu-build-system)
(arguments
`(#:phases
`(#:parallel-tests? #f
#:phases
(alist-replace
'configure
(lambda* (#:key target system outputs #:allow-other-keys #:rest args)
@ -88,6 +90,33 @@ differential equations, linear algebra, Fast Fourier Transforms and random
numbers.")
(license license:gpl3+)))
(define-public glpk
(package
(name "glpk")
(version "4.52.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/glpk/glpk-"
version ".tar.gz"))
(sha256
(base32
"0nz9ngmx23c8gbjr8l8ygnfaanxj2mwbl8awpg630bgrkxdnhc9j"))))
(build-system gnu-build-system)
(inputs
`(("gmp" ,gmp)))
(arguments
`(#:configure-flags '("--with-gmp")))
(home-page "http://www.gnu.org/software/glpk/")
(synopsis "NU Linear Programming Kit, supporting the MathProg language")
(description
"GLPK is a C library for solving large-scale linear programming (LP),
mixed integer programming (MIP), and other related problems. It supports the
GNU MathProg modeling language, a subset of the AMPL language, and features a
translator for the language. In addition to the C library, a stand-alone
LP/MIP solver is included in the package.")
(license license:gpl3+)))
(define-public pspp
(package
(name "pspp")

12
gnu/packages/mit-krb5.scm
View File

@ -28,19 +28,17 @@
(define-public mit-krb5
(package
(name "mit-krb5")
(version "1.11")
(version "1.11.3")
(source (origin
(method url-fetch)
(uri (string-append "http://web.mit.edu/kerberos/www/dist/krb5/"
version
"/krb5-" version
"-signed.tar"))
(string-copy version 0 (string-rindex version #\.))
"/krb5-" version "-signed.tar"))
(sha256 (base32
"0lc6lxb98qzg4x01lppq700vkr1ax9rld09znahrinwqnf9zndzy"))))
"1daiaxgkxcryqs37w28v4x1vajqmay4l144d1zd9c2d7jjxr9gcs"))))
(build-system gnu-build-system)
(inputs `(("bison" ,bison)
("perl" ,perl)
))
("perl" ,perl)))
(arguments
'(#:phases
(alist-replace

25
gnu/packages/oggvorbis.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
;;;
;;; This file is part of GNU Guix.
;;;
@ -34,6 +35,7 @@
#:use-module (guix build-system gnu)
#:export (libogg
libvorbis
libtheora
speex
ao
flac
@ -88,6 +90,29 @@ polyphonic) audio and music at fixed and variable bitrates from 16 to
"See COPYING in the distribution."))
(home-page "http://xiph.org/vorbis/")))
(define libtheora
(package
(name "libtheora")
(version "1.1.1")
(source (origin
(method url-fetch)
(uri (string-append "http://downloads.xiph.org/releases/theora/libtheora-"
version ".tar.xz"))
(sha256
(base32
"0q8wark9ribij57dciym5vdikg2464p8q2mgqvfb78ksjh4s8vgk"))))
(build-system gnu-build-system)
(inputs `(("libvorbis" ,libvorbis)))
;; The .pc files refer to libogg.
(propagated-inputs `(("libogg" ,libogg)))
(synopsis "Library implementing the Theora video format")
(description
"The libtheora library implements the ogg theora video format,
a fully open, non-proprietary, patent-and-royalty-free, general-purpose
compressed video format.")
(license license:bsd-3)
(home-page "http://xiph.org/theora/")))
(define speex
(package
(name "speex")

8
gnu/packages/patches/cmake-fix-tests.patch
View File

@ -1,5 +1,5 @@
--- Tests/CMakeLists.txt 2013-03-20 22:57:13.000000000 +0100
+++ Tests/CMakeLists.txt 2013-03-20 22:58:02.000000000 +0100
--- a/Tests/CMakeLists.txt 2013-03-20 22:57:13.000000000 +0100
+++ b/Tests/CMakeLists.txt 2013-03-20 22:58:02.000000000 +0100
@@ -1706,16 +1706,17 @@
PASS_REGULAR_EXPRESSION "Could not find executable"
FAIL_REGULAR_EXPRESSION "SegFault")
@ -28,8 +28,8 @@
configure_file(
"${CMake_SOURCE_DIR}/Tests/CTestTestConfigFileInBuildDir/test1.cmake.in"
--- Utilities/cmcurl/CMakeLists.txt 2013-03-20 22:57:13.000000000 +0100
+++ Utilities/cmcurl/CMakeLists.txt 2013-03-20 23:08:41.000000000 +0100
--- a/Utilities/cmcurl/CMakeLists.txt 2013-03-20 22:57:13.000000000 +0100
+++ b/Utilities/cmcurl/CMakeLists.txt 2013-03-20 23:08:41.000000000 +0100
@@ -729,8 +729,9 @@
ADD_EXECUTABLE(LIBCURL Testing/curltest.c)
TARGET_LINK_LIBRARIES(LIBCURL cmcurl ${CMAKE_DL_LIBS})

30
gnu/packages/patches/glib-tests-newnet.patch Normal file
View File

@ -0,0 +1,30 @@
Since guix-daemon runs in a separate networking name space, the only
interface available is "lo". However its index is incremented by one
at each build, so it can end up being greater than 255, leading to an
assertion failure in 'find_ifname_and_index'.
Work around that by directly querying the index of "lo".
--- glib-2.38.0/gio/tests/network-address.c 2013-09-17 20:47:14.000000000 +0200
+++ glib-2.38.0/gio/tests/network-address.c 2013-10-16 21:52:42.000000000 +0200
@@ -117,7 +117,7 @@ test_parse_host (gconstpointer d)
#define SCOPE_ID_TEST_PORT 99
#ifdef HAVE_IF_INDEXTONAME
-static char SCOPE_ID_TEST_IFNAME[IF_NAMESIZE];
+static char SCOPE_ID_TEST_IFNAME[] = "lo";
static int SCOPE_ID_TEST_INDEX;
#else
#define SCOPE_ID_TEST_IFNAME "1"
@@ -131,11 +131,7 @@ find_ifname_and_index (void)
return;
#ifdef HAVE_IF_INDEXTONAME
- for (SCOPE_ID_TEST_INDEX = 1; SCOPE_ID_TEST_INDEX < 255; SCOPE_ID_TEST_INDEX++) {
- if (if_indextoname (SCOPE_ID_TEST_INDEX, SCOPE_ID_TEST_IFNAME))
- break;
- }
- g_assert_cmpstr (SCOPE_ID_TEST_IFNAME, !=, "");
+ SCOPE_ID_TEST_INDEX = if_nametoindex (SCOPE_ID_TEST_IFNAME);
#endif
}

32
gnu/packages/patches/gstreamer-0.10-bison3.patch Normal file
View File

@ -0,0 +1,32 @@
See https://bugzilla.gnome.org/show_bug.cgi?id=706462
Subject: [PATCH] Make grammar.y work with Bison 3
YYLEX_PARAM is no longer supported in Bison 3.
---
gst/parse/grammar.y | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gst/parse/grammar.y b/gst/parse/grammar.y
index 8a9019c..f533389 100644
--- a/gst/parse/grammar.y
+++ b/gst/parse/grammar.y
@@ -26,7 +26,6 @@
*/
#define YYERROR_VERBOSE 1
-#define YYLEX_PARAM scanner
#define YYENABLE_NLS 0
@@ -659,6 +658,7 @@ static int yyerror (void *scanner, graph_t *graph, const char *s);
%right '.'
%left '!' '='
+%lex-param { void *scanner }
%parse-param { void *scanner }
%parse-param { graph_t *graph }
%pure-parser
--
1.8.3.4

14
gnu/packages/patches/gstreamer-0.10-silly-test.patch Normal file
View File

@ -0,0 +1,14 @@
See http://lists.freedesktop.org/archives/gstreamer-bugs/2013-January/098461.html
diff -ru gstreamer-0.10.36.orig/tests/check/Makefile.in gstreamer-0.10.36/tests/check/Makefile.in
--- gstreamer-0.10.36.orig/tests/check/Makefile.in 2012-02-20 23:48:29.000000000 +0100
+++ gstreamer-0.10.36/tests/check/Makefile.in 2013-10-30 21:55:48.000000000 +0100
@@ -42,7 +42,7 @@
gst/gstbus$(EXEEXT) gst/gstcaps$(EXEEXT) $(am__EXEEXT_2) \
gst/gstdatetime$(EXEEXT) gst/gstinfo$(EXEEXT) \
gst/gstiterator$(EXEEXT) gst/gstmessage$(EXEEXT) \
- gst/gstminiobject$(EXEEXT) gst/gstobject$(EXEEXT) \
+ gst/gstminiobject$(EXEEXT) \
gst/gstpad$(EXEEXT) gst/gstparamspecs$(EXEEXT) \
gst/gstpoll$(EXEEXT) gst/gstsegment$(EXEEXT) \
gst/gstsystemclock$(EXEEXT) gst/gstclock$(EXEEXT) \

19
gnu/packages/patches/pulseaudio-test-timeouts.patch Normal file
View File

@ -0,0 +1,19 @@
Increase the timeout of the thread test. Hydra was intermittedly
failing this test due to premature timeout, and slower machines
consistently fail.
Patch by Mark H Weaver <mhw@netris.org>.
--- pulseaudio/src/tests/thread-test.c.orig 2012-09-26 07:27:01.000000000 -0400
+++ pulseaudio/src/tests/thread-test.c 2013-10-31 22:53:23.224000184 -0400
@@ -152,6 +152,10 @@
s = suite_create("Thread");
tc = tcase_create("thread");
tcase_add_test(tc, thread_test);
+ /* the default timeout is too small,
+ * set it to a reasonable large one.
+ */
+ tcase_set_timeout(tc, 60 * 60);
suite_add_tcase(s, tc);
sr = srunner_create(s);

22
gnu/packages/patches/qt4-tests.patch Normal file
View File

@ -0,0 +1,22 @@
Drop tests requiring a running X server, but not starting any.
diff -ru qt-everywhere-opensource-src-4.8.5.orig/src/3rdparty/webkit/Source/WebKit/qt/tests/tests.pro qt-everywhere-opensource-src-4.8.5/src/3rdparty/webkit/Source/WebKit/qt/tests/tests.pro
--- qt-everywhere-opensource-src-4.8.5.orig/src/3rdparty/webkit/Source/WebKit/qt/tests/tests.pro 2013-10-12 13:15:47.000000000 +0200
+++ qt-everywhere-opensource-src-4.8.5/src/3rdparty/webkit/Source/WebKit/qt/tests/tests.pro 2013-10-12 13:20:15.000000000 +0200
@@ -1,15 +1,4 @@
TEMPLATE = subdirs
-SUBDIRS = qwebframe qwebpage qwebelement qgraphicswebview qwebhistoryinterface qwebview qwebhistory qwebinspector hybridPixmap
+SUBDIRS =
-linux-* {
- # This test bypasses the library and links the tested code's object itself.
- # This stresses the build system in some corners so we only run it on linux.
- SUBDIRS += MIMESniffing
-}
-
-contains(QT_CONFIG, declarative): SUBDIRS += qdeclarativewebview
-SUBDIRS += benchmarks/painting benchmarks/loading
-contains(DEFINES, ENABLE_WEBGL=1) {
- SUBDIRS += benchmarks/webgl
-}

74
gnu/packages/patches/valgrind-glibc.patch
View File

@ -1,64 +1,15 @@
commit 3781ac11ff374b3517011c1710ec517d52f25cd2
Author: tom <tom@a5019735-40e9-0310-863c-91ae7b9d1cf9>
Date: Mon Jan 14 09:48:49 2013 +0000
Accept glibc 2.17 as valid.
git-svn-id: svn://svn.valgrind.org/valgrind/trunk@13228 a5019735-40e9-0310-863c-91ae7b9d1cf9
diff --git a/configure.in b/configure.in
index e0fb12d..0f3b3df 100644
--- a/configure.in
+++ b/configure.in
@@ -906,6 +906,13 @@ case "${GLIBC_VERSION}" in
Accept glibc 2.18 as valid.
--- a/configure 2013-10-10 22:27:20.331223000 +0200
+++ b/configure 2013-10-10 22:27:55.055223000 +0200
@@ -6604,6 +6604,16 @@
DEFAULT_SUPP="glibc-2.34567-NPTL-helgrind.supp ${DEFAULT_SUPP}"
DEFAULT_SUPP="glibc-2.X-drd.supp ${DEFAULT_SUPP}"
;;
+ 2.17)
+ AC_MSG_RESULT(2.17 family)
+ AC_DEFINE([GLIBC_2_17], 1, [Define to 1 if you're using glibc 2.17.x])
+ DEFAULT_SUPP="glibc-2.X.supp ${DEFAULT_SUPP}"
+ DEFAULT_SUPP="glibc-2.34567-NPTL-helgrind.supp ${DEFAULT_SUPP}"
+ DEFAULT_SUPP="glibc-2.X-drd.supp ${DEFAULT_SUPP}"
+ ;;
darwin)
AC_MSG_RESULT(Darwin)
AC_DEFINE([DARWIN_LIBC], 1, [Define to 1 if you're using Darwin])
@@ -919,7 +926,7 @@ case "${GLIBC_VERSION}" in
*)
AC_MSG_RESULT([unsupported version ${GLIBC_VERSION}])
- AC_MSG_ERROR([Valgrind requires glibc version 2.2 - 2.16])
+ AC_MSG_ERROR([Valgrind requires glibc version 2.2 - 2.17])
AC_MSG_ERROR([or Darwin libc])
;;
esac
diff -ur valgrind-3.8.1/config.h.in valgrind-3.8.1/config.h.in
--- valgrind-3.8.1/config.h.in 2013-01-16 17:15:33.531018561 +0100
+++ valgrind-3.8.1/config.h.in 2013-01-16 17:19:21.000000000 +0100
@@ -48,6 +48,9 @@
/* Define to 1 if you're using glibc 2.16.x */
#undef GLIBC_2_16
+/* Define to 1 if you're using glibc 2.17.x */
+#undef GLIBC_2_17
+ 2.18)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: 2.18 family" >&5
+$as_echo "2.18 family" >&6; }
+
/* Define to 1 if you're using glibc 2.2.x */
#undef GLIBC_2_2
diff -ur valgrind-3.8.1/configure valgrind-3.8.1/configure
--- valgrind-3.8.1/configure 2013-01-16 17:15:33.563018480 +0100
+++ valgrind-3.8.1/configure 2013-01-16 17:19:21.373643238 +0100
@@ -6610,6 +6610,16 @@
DEFAULT_SUPP="glibc-2.34567-NPTL-helgrind.supp ${DEFAULT_SUPP}"
DEFAULT_SUPP="glibc-2.X-drd.supp ${DEFAULT_SUPP}"
;;
+ 2.17)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: 2.17 family" >&5
+$as_echo "2.17 family" >&6; }
+
+$as_echo "#define GLIBC_2_17 1" >>confdefs.h
+$as_echo "#define GLIBC_2_18 1" >>confdefs.h
+
+ DEFAULT_SUPP="glibc-2.X.supp ${DEFAULT_SUPP}"
+ DEFAULT_SUPP="glibc-2.34567-NPTL-helgrind.supp ${DEFAULT_SUPP}"
@ -67,12 +18,3 @@ diff -ur valgrind-3.8.1/configure valgrind-3.8.1/configure
darwin)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Darwin" >&5
$as_echo "Darwin" >&6; }
@@ -6630,7 +6640,7 @@
*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported version ${GLIBC_VERSION}" >&5
$as_echo "unsupported version ${GLIBC_VERSION}" >&6; }
- as_fn_error "Valgrind requires glibc version 2.2 - 2.16" "$LINENO" 5
+ as_fn_error "Valgrind requires glibc version 2.2 - 2.17" "$LINENO" 5
as_fn_error "or Darwin libc" "$LINENO" 5
;;
esac

15
gnu/packages/pdf.scm
View File

@ -31,7 +31,10 @@
#:use-module (gnu packages libpng)
#:use-module (gnu packages libtiff)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages xorg))
#:use-module (gnu packages xorg)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (srfi srfi-1))
(define-public poppler
(package
@ -47,7 +50,6 @@
;; FIXME: more dependencies could be added
;; cairo output: no (requires cairo >= 1.10.0)
;; qt4 wrapper: no
;; glib wrapper: no (requires cairo output)
;; introspection: no
;; use gtk-doc: no
;; use libcurl: no
@ -58,7 +60,14 @@
("libpng" ,libpng)
("libtiff" ,libtiff)
("pkg-config" ,pkg-config)
("zlib" ,zlib)))
("zlib" ,zlib)
;; To build poppler-glib (as needed by Evince), we need Cairo and
;; GLib. But of course, that Cairo must not depend on Poppler.
("cairo" ,(package (inherit cairo)
(inputs (alist-delete "poppler"
(package-inputs cairo)))))
("glib" ,glib)))
(arguments
`(#:tests? #f ; no test data provided with the tarball
#:configure-flags

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

@ -0,0 +1,48 @@
;;; 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 pem)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages perl))
(define-public pem
(package
(name "pem")
(version "0.7.9")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/pem/pem-"
version ".tar.gz"))
(sha256
(base32
"03iqcki1lakkck1akdyvljjapgqda3l0rh38id7jhrac9kcxqgg2"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.gnu.org/software/pem/")
(synopsis "Personal expenses manager")
(description
"GNU Pem is a simple tool for tracking personal income and
expenses. It operates from the command line and it stores its data
in a basic text format in your home directory. It can easily print
reports of your spending on different expenses via a basic search
feature.")
(license gpl3+)))

4
gnu/packages/pulseaudio.scm
View File

@ -22,6 +22,7 @@
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'l:))
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages linux)
#:use-module (gnu packages oggvorbis)
#:use-module (gnu packages pkg-config)
@ -141,7 +142,8 @@ parse JSON formatted strings back into the C representation of JSON objects.")
version ".tar.xz"))
(sha256
(base32
"1bndz4l8jxyq3zq128gzp3gryxl6yjs66j2y1d7yabw2n5mv7kim"))))
"1bndz4l8jxyq3zq128gzp3gryxl6yjs66j2y1d7yabw2n5mv7kim"))
(patches (list (search-patch "pulseaudio-test-timeouts.patch")))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--localstatedir=/var" ;"--sysconfdir=/etc"

91
gnu/packages/python.scm
View File

@ -19,7 +19,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages python)
#:use-module ((guix licenses) #:select (bsd-3 bsd-style psfl x11))
#:use-module ((guix licenses)
#:select (bsd-3 bsd-style psfl x11 gpl2+ lgpl2.1+))
#:use-module ((guix licenses) #:select (zlib)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (gnu packages)
@ -438,3 +439,91 @@ Python 3.3+.")
(description
"PyICU is a python extension wrapping the ICU C++ API.")
(license x11)))
(define-public python2-dogtail
;; Python 2 only, as it leads to "TabError: inconsistent use of tabs and
;; spaces in indentation" with Python 3.
(package
(name "python2-dogtail")
(version "0.8.2")
(source (origin
(method url-fetch)
(uri (string-append
"https://fedorahosted.org/released/dogtail/dogtail-"
version ".tar.gz"))
(sha256
(base32
"1yc4cg7ip87z15gyd4wy2vzbywrjc52a3m8r8gqy2b50d65llcg1"))))
(build-system python-build-system)
(arguments `(#:python ,python-2
#:tests? #f)) ; invalid command "test"
(home-page "https://fedorahosted.org/dogtail/")
(synopsis "GUI test tool and automation framework written in ​Python")
(description
"dogtail is a GUI test tool and automation framework written in Python.
It uses Accessibility (a11y) technologies to communicate with desktop
applications. dogtail scripts are written in Python and executed like any
other Python program.")
(license gpl2+)))
(define-public python2-empy
(package
(name "python2-empy")
(version "3.3")
(source (origin
(method url-fetch)
(uri (string-append "http://www.alcyone.com/software/empy/empy-"
version ".tar.gz"))
(sha256
(base32
"01g8mmkfnvjdmlhsihwyx56lrg7r5m5d2fg6mnxsvy6g0dnl69f6"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
#:phases (alist-replace
'check
(lambda _
(zero? (system* "./test.sh")))
%standard-phases)))
(home-page "http://www.alcyone.com/software/empy/")
(synopsis "Templating system for Python")
(description
"EmPy is a system for embedding Python expressions and statements in
template text; it takes an EmPy source file, processes it, and produces
output. This is accomplished via expansions, which are special signals to the
EmPy system and are set off by a special prefix (by default the at sign, @).
EmPy can expand arbitrary Python expressions and statements in this way, as
well as a variety of special forms. Textual data not explicitly delimited in
this way is sent unaffected to the output, allowing Python to be used in
effect as a markup language. Also supported are callbacks via hooks,
recording and playback via diversions, and dynamic, chainable filters. The
system is highly configurable via command line options and embedded
commands.")
(license lgpl2.1+)))
(define-public scons
(package
(name "scons")
(version "2.1.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/scons/scons-"
version ".tar.gz"))
(sha256
(base32
"07cjn4afb2cljjrd3cr7xf062qq58z8q96f58z6yplhdyqafsfa1"))))
(build-system python-build-system)
(arguments
;; With Python 3.x, fails to build with a syntax error.
`(#:python ,python-2
#:tests? #f)) ; no 'python setup.py test' command
(home-page "http://scons.org/")
(synopsis "Software construction tool written in Python")
(description
"SCons is a software construction tool. Think of SCons as an improved,
cross-platform substitute for the classic Make utility with integrated
functionality similar to autoconf/automake and compiler caches such as ccache.
In short, SCons is an easier, more reliable and faster way to build
software.")
(license x11)))

3
gnu/packages/qemu.scm
View File

@ -135,4 +135,5 @@ server and embedded PowerPC, and S390 guests.")
(package (inherit qemu)
(name "qemu-with-multiple-smb-shares")
(source (origin (inherit (package-source qemu))
(patches (search-patch "qemu-multiple-smb-shares.patch"))))))
(patches
(list (search-patch "qemu-multiple-smb-shares.patch")))))))

43
gnu/packages/qt.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages bison)
#:use-module (gnu packages compression)
#:use-module (gnu packages fontutils)
@ -139,3 +140,45 @@ X11 (yet).")
(description "Qt is a cross-platform application and UI framework for
developers using C++ or QML, a CSS & JavaScript like language.")
(license lgpl2.1)))
(define-public qt-4
(package (inherit qt)
(version "4.8.5")
(source (origin
(method url-fetch)
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
(string-copy version 0 (string-rindex version #\.))
"/" version
"/qt-everywhere-opensource-src-"
version ".tar.gz"))
(sha256
(base32
"0f51dbgn1dcck8pqimls2qyf1pfmsmyknh767cvw87c3d218ywpb"))
(patches (list (search-patch "qt4-tests.patch")))))
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* '("configure")
(("/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"
"-no-3dnow"
"-no-sse"
"-no-sse2"
"-no-sse3"
"-no-ssse3"
"-no-sse4.1"
"-no-sse4.2"
"-no-avx"
"-no-neon"))))
%standard-phases)))))

8
gnu/packages/rsync.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012, 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,14 +29,14 @@
(define-public rsync
(package
(name "rsync")
(version "3.0.9")
(version "3.1.0")
(source (origin
(method url-fetch)
(uri (string-append "http://rsync.samba.org/ftp/rsync/rsync-"
(uri (string-append "http://rsync.samba.org/ftp/rsync/src/rsync-"
version ".tar.gz"))
(sha256
(base32
"01bw4klqsrlhh3i9lazd485sd9qx5djvnwa21lj2h3a9sn6hzw9h"))))
"0kirw8wglqvwi1v8bwxp373g03xg857h59j5k3mmgff9gzvj7jl1"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)
("acl" ,acl)))

49
gnu/packages/sdl.scm Normal file
View File

@ -0,0 +1,49 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
;;;
;;; 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 sdl)
#:use-module (gnu packages)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages linux)
#:use-module (gnu packages xorg)
#:export (libmikmod))
(define libmikmod
(package
(name "libmikmod")
(version "3.3.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/mikmod/libmikmod/"
version "/libmikmod-" version ".tar.gz"))
(sha256
(base32
"0dr4kgvhq9wf2riibh178c2al996spwwak6zffpv5n5bqmw29w3r"))))
(build-system gnu-build-system)
(inputs `(("alsa-lib" ,alsa-lib)
("libx11" ,libx11)))
(synopsis "Library for module sound formats.")
(description
"MikMod is able to play a wide range of module formats, as well as
digital sound files. It can take advantage of particular features of your
system, such as sound redirection over the network.")
(license lgpl2.1)
(home-page "http://mikmod.sourceforge.net/")))

25
gnu/packages/system.scm
View File

@ -28,6 +28,8 @@
#:use-module (gnu packages ncurses)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'g:))
#:use-module ((gnu packages base)
#:select (tar))
#:use-module ((gnu packages compression)
@ -74,6 +76,7 @@ is based on GNU Guile.")
"1b4hfqv23l87cb37fxwzfk2sgspkyxpr3ig2hsd23hr6mm982j7z"))))
(build-system cmake-build-system)
(arguments '(#:tests? #f)) ; There are no tests.
(native-inputs `(("gettext" ,g:gettext)))
(home-page "http://projects.gw-computing.net/projects/dfc")
(synopsis "Display file system space usage using graphs and colors")
(description
@ -318,3 +321,25 @@ programs and scripts. At the same time, it is a feature-rich network debugging
and exploration tool, since it can create almost any kind of connection you
would need and has several interesting built-in capabilities.")
(license gpl2+)))
(define-public alive
(package
(name "alive")
(version "2.0.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/alive/alive-"
version ".tar.xz"))
(sha256
(base32
"1vrzg51ai68x9yld7vbgl58sxaw5qpx8rbakwcxn4cqq6vpxj38j"))))
(build-system gnu-build-system)
(arguments '(#:configure-flags '("alive_cv_nice_ping=yes")))
(inputs `(("guile" ,guile-2.0)
("inetutils" ,inetutils)))
(home-page "http://www.gnu.org/software/alive/")
(synopsis "Autologin and keep-alive daemon")
(description
"GNU Alive sends periodic pings to a server, generally to keep a
connection alive.")
(license gpl3+)))

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

@ -180,6 +180,33 @@ everything from small to very large projects with speed and efficiency.")
(license gpl2)
(home-page "http://git-scm.com/")))
(define-public mercurial
(package
(name "mercurial")
(version "2.7.1")
(source (origin
(method url-fetch)
(uri (string-append "http://mercurial.selenic.com/release/mercurial-"
version ".tar.gz"))
(sha256
(base32
"121m8f7vmipmdg00cnzdz2rjkgydh28mwfirqkrbs5fv089vywl4"))))
(build-system python-build-system)
(arguments
`(;; Restrict to Python 2, as Python 3 would require
;; the argument --c2to3.
#:python ,python-2
;; FIXME: Disabled tests because they require the nose unit
;; testing framework: https://nose.readthedocs.org/en/latest/ .
#:tests? #f))
(home-page "http://mercurial.selenic.com")
(synopsis "Decentralized version control system")
(description
"Mercurial is a free, distributed source control management tool.
It efficiently handles projects of any size
and offers an easy and intuitive interface.")
(license gpl2+)))
(define-public subversion
(package
(name "subversion")
@ -226,8 +253,8 @@ everything from small to very large projects with speed and efficiency.")
(home-page "http://subversion.apache.org/")
(synopsis "Subversion, a revision control system")
(description
"Subversion exists to be universally recognized and adopted as an
open-source, centralized version control system characterized by its
"Subversion exists to be universally recognized and adopted as a
centralized version control system characterized by its
reliability as a safe haven for valuable data; the simplicity of its model and
usage; and its ability to support the needs of a wide variety of users and
projects, from individuals to large-scale enterprise operations.")

3
gnu/packages/xorg.scm
View File

@ -4180,7 +4180,8 @@ tracking.")
(origin
(method url-fetch)
(uri (string-append
"ftp://ftp.freedesktop.org/pub/mesa/" version
"ftp://ftp.freedesktop.org/pub/mesa/older-versions/8.x/"
version
"/MesaLib-" version
".tar.bz2"))
(sha256

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

@ -64,7 +64,6 @@
(guix build gnu-build-system)
(guix build utils)))
(modules '((guix build cmake-build-system)
(guix build gnu-build-system)
(guix build utils))))
"Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
provides a 'CMakeLists.txt' file as its build system."

10
guix/build-system/perl.scm
View File

@ -35,9 +35,16 @@
;;
;; Code:
(define (default-perl)
"Return the default Perl package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages perl))))
(module-ref module 'perl)))
(define* (perl-build store name source inputs
#:key
(perl (@ (gnu packages perl) perl))
(perl (default-perl))
(search-paths '())
(tests? #t)
(make-maker-flags ''())
@ -50,7 +57,6 @@
(guix build gnu-build-system)
(guix build utils)))
(modules '((guix build perl-build-system)
(guix build gnu-build-system)
(guix build utils))))
"Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE
provides a `Makefile.PL' file as its build system."

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

@ -38,6 +38,8 @@
(if (file-exists? "CMakeLists.txt")
(let ((args `(,(string-append "-DCMAKE_INSTALL_PREFIX=" out)
,@configure-flags)))
(setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
(setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH"))
(format #t "running 'cmake' with arguments ~s~%" args)
(zero? (apply system* "cmake" args)))
(error "no CMakeLists.txt found"))))

34
guix/build/union.scm
View File

@ -22,6 +22,8 @@
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:export (tree-union
delete-duplicate-leaves
union-build))
@ -100,7 +102,25 @@ single leaf."
,@(map loop dirs))))
(leaf leaf))))
(define* (union-build output directories)
(define (file=? file1 file2)
"Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise."
(and (= (stat:size (stat file1)) (stat:size (stat file2)))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop)))))))))))
(define* (union-build output directories
#:key (log-port (current-error-port)))
"Build in the OUTPUT directory a symlink tree that is the union of all
the DIRECTORIES."
(define (file-tree dir)
@ -162,18 +182,21 @@ the DIRECTORIES."
;; LEAVES all actually point to the same file, so nothing to worry
;; about.
one-and-the-same)
((and lst (head _ ...))
;; A real collision.
((and lst (head rest ...))
;; A real collision, unless those files are all identical.
(unless (every (cut file=? head <>) rest)
(format (current-error-port) "warning: collision encountered: ~{~a ~}~%"
lst)
;; TODO: Implement smarter strategies.
(format (current-error-port) "warning: arbitrarily choosing ~a~%"
head)
head))
head)))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(when (file-port? log-port)
(setvbuf log-port _IOLBF))
(mkdir output)
(let loop ((tree (delete-duplicate-leaves
@ -189,8 +212,7 @@ the DIRECTORIES."
;; A leaf: create a symlink.
(let* ((dir (string-join dir "/"))
(target (string-append output "/" dir "/" (basename tree))))
(format (current-error-port) "`~a' ~~> `~a'~%"
tree target)
(format log-port "`~a' ~~> `~a'~%" tree target)
(symlink tree target)))
(((? string? subdir) leaves ...)
;; A sub-directory: create it in OUTPUT, and iterate over LEAVES.

3
guix/derivations.scm
View File

@ -441,7 +441,8 @@ that form."
(lambda* (path #:optional (output "out"))
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
path of its output OUTPUT."
(derivation->output-path (call-with-input-file path read-derivation)))))
(derivation->output-path (call-with-input-file path read-derivation)
output))))
(define (derivation-path->output-paths path)
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the

8
guix/download.scm
View File

@ -24,6 +24,7 @@
#:use-module ((guix store) #:select (derivation-path? add-to-store))
#:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
#:use-module (guix utils)
#:use-module (web uri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%mirrors
@ -244,6 +245,11 @@ must be a list of symbol/URL-list pairs."
#:key (log (current-error-port)))
"Download from URL to STORE, either under NAME or URL's basename if
omitted. Write progress reports to LOG."
(define uri
(string->uri url))
(if (memq (uri-scheme uri) '(file #f))
(add-to-store store name #f "sha256" (uri-path uri))
(call-with-temporary-output-file
(lambda (temp port)
(let ((result
@ -251,6 +257,6 @@ omitted. Write progress reports to LOG."
(build:url-fetch url temp #:mirrors %mirrors))))
(close port)
(and result
(add-to-store store name #f "sha256" temp))))))
(add-to-store store name #f "sha256" temp)))))))
;;; download.scm ends here

2
guix/gnu-maintenance.scm
View File

@ -86,7 +86,7 @@
;; This file contains package descriptions in recutils format.
;; See <https://lists.gnu.org/archive/html/guix-devel/2013-10/msg00071.html>.
(string->uri
(string-append %gnumaint-base-url "pkgdescr.txt?root=womb")))
(string-append %gnumaint-base-url "pkgblurbs.txt?root=womb")))
(define-record-type* <gnu-package-descriptor>
gnu-package-descriptor

6
guix/records.scm
View File

@ -73,7 +73,7 @@ thunked fields."
(memq (syntax->datum f) '#,thunked))
(define (field-bindings field+value)
;; Return field to value bindings, for use in `letrec*' below.
;; Return field to value bindings, for use in 'let*' below.
(map (lambda (field+value)
(syntax-case field+value ()
((field value)
@ -85,7 +85,7 @@ thunked fields."
(syntax-case s (inherit #,@fields)
((_ (inherit orig-record) (field value) (... ...))
#`(letrec* #,(field-bindings #'((field value) (... ...)))
#`(let* #,(field-bindings #'((field value) (... ...)))
#,(record-inheritance #'orig-record
#'((field value) (... ...)))))
((_ (field value) (... ...))
@ -116,7 +116,7 @@ thunked fields."
s)))))
(let ((fields (append fields (map car dflt))))
(cond ((lset= eq? fields 'expected)
#`(letrec* #,(field-bindings
#`(let* #,(field-bindings
#'((field value) (... ...)))
(ctor #,@(map field-value 'expected))))
((pair? (lset-difference eq? fields 'expected))

651
guix/scripts/package.scm
View File

@ -25,6 +25,7 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix config)
#:use-module (guix records)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
#:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 ftw)
@ -33,6 +34,7 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@ -49,10 +51,10 @@
;;;
;;; User environment.
;;; User profile.
;;;
(define %user-environment-directory
(define %user-profile-directory
(and=> (getenv "HOME")
(cut string-append <> "/.guix-profile")))
@ -67,30 +69,125 @@
;; coexist with Nix profiles.
(string-append %profile-directory "/guix-profile"))
;;;
;;; Manifests.
;;;
(define-record-type <manifest>
(manifest entries)
manifest?
(entries manifest-entries)) ; list of <manifest-entry>
;; Convenient alias, to avoid name clashes.
(define make-manifest manifest)
(define-record-type* <manifest-entry> manifest-entry
make-manifest-entry
manifest-entry?
(name manifest-entry-name) ; string
(version manifest-entry-version) ; string
(output manifest-entry-output ; string
(default "out"))
(path manifest-entry-path) ; store path
(dependencies manifest-entry-dependencies ; list of store paths
(default '()))
(inputs manifest-entry-inputs ; list of inputs to build
(default '()))) ; this entry
(define (profile-manifest profile)
"Return the PROFILE's manifest."
(let ((manifest (string-append profile "/manifest")))
(if (file-exists? manifest)
(call-with-input-file manifest read)
'(manifest (version 1) (packages ())))))
(let ((file (string-append profile "/manifest")))
(if (file-exists? file)
(call-with-input-file file read-manifest)
(manifest '()))))
(define (manifest->sexp manifest)
"Return a representation of MANIFEST as an sexp."
(define (entry->sexp entry)
(match entry
(($ <manifest-entry> name version path output (deps ...))
(list name version path output deps))))
(define (manifest-packages manifest)
"Return the packages listed in MANIFEST."
(match manifest
(($ <manifest> (entries ...))
`(manifest (version 1)
(packages ,(map entry->sexp entries))))))
(define (sexp->manifest sexp)
"Parse SEXP as a manifest."
(match sexp
(('manifest ('version 0)
('packages ((name version output path) ...)))
(zip name version output path
(make-list (length name) '())))
(manifest
(map (lambda (name version output path)
(manifest-entry
(name name)
(version version)
(output output)
(path path)))
name version output path)))
;; Version 1 adds a list of propagated inputs to the
;; name/version/output/path tuples.
(('manifest ('version 1)
('packages (packages ...)))
packages)
('packages ((name version output path deps) ...)))
(manifest
(map (lambda (name version output path deps)
(manifest-entry
(name name)
(version version)
(output output)
(path path)
(dependencies deps)))
name version output path deps)))
(_
(error "unsupported manifest format" manifest))))
(define (read-manifest port)
"Return the packages listed in MANIFEST."
(sexp->manifest (read port)))
(define (write-manifest manifest port)
"Write MANIFEST to PORT."
(write (manifest->sexp manifest) port))
(define (remove-manifest-entry name lst)
"Remove the manifest entry named NAME from LST."
(remove (match-lambda
(($ <manifest-entry> entry-name)
(string=? name entry-name)))
lst))
(define (manifest-remove manifest names)
"Remove entries for each of NAMES from MANIFEST."
(make-manifest (fold remove-manifest-entry
(manifest-entries manifest)
names)))
(define (manifest-installed? manifest name)
"Return #t if MANIFEST has an entry for NAME, #f otherwise."
(define (->bool x)
(not (not x)))
(->bool (find (match-lambda
(($ <manifest-entry> entry-name)
(string=? entry-name name)))
(manifest-entries manifest))))
(define (manifest=? m1 m2)
"Return #t if manifests M1 and M2 are equal. This differs from 'equal?' in
that the 'inputs' field is ignored for the comparison, since it is know to
have no effect on the manifest contents."
(equal? (manifest->sexp m1)
(manifest->sexp m2)))
;;;
;;; Profiles.
;;;
(define (profile-regexp profile)
"Return a regular expression that matches PROFILE's name and number."
(make-regexp (string-append "^" (regexp-quote (basename profile))
@ -157,17 +254,9 @@ case when generations have been deleted (there are \"holes\")."
0
(generation-numbers profile)))
(define (profile-derivation store packages)
"Return a derivation that builds a profile (a user environment) with
all of PACKAGES, a list of name/version/output/path/deps tuples."
(define packages*
;; Turn any package object in PACKAGES into its output path.
(map (match-lambda
((name version output path (deps ...))
`(,name ,version ,output ,path
,(map input->name+path deps))))
packages))
(define (profile-derivation store manifest)
"Return a derivation that builds a profile (aka. 'user environment') with
the given MANIFEST."
(define builder
`(begin
(use-modules (ice-9 pretty-print)
@ -178,33 +267,29 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(let ((output (assoc-ref %outputs "out"))
(inputs (map cdr %build-inputs)))
(format #t "building user environment `~a' with ~a packages...~%"
(format #t "building profile '~a' with ~a packages...~%"
output (length inputs))
(union-build output inputs)
(union-build output inputs
#:log-port (%make-void-port "w"))
(call-with-output-file (string-append output "/manifest")
(lambda (p)
(pretty-print '(manifest (version 1)
(packages ,packages*))
p))))))
(pretty-print ',(manifest->sexp manifest) p))))))
(define ensure-valid-input
;; If a package object appears in the given input, turn it into a
;; derivation path.
(match-lambda
((name (? package? p) sub-drv ...)
`(,name ,(package-derivation (%store) p) ,@sub-drv))
(input
input)))
(build-expression->derivation store "user-environment"
(build-expression->derivation store "profile"
(%current-system)
builder
(append-map (match-lambda
((name version output path deps)
`((,name ,path)
,@(map ensure-valid-input
deps))))
packages)
(($ <manifest-entry> name version
output path deps (inputs ..1))
(map (cute lower-input
(%store) <>)
inputs))
(($ <manifest-entry> name version
output path deps)
;; Assume PATH and DEPS are
;; already valid.
`((,name ,path) ,@deps)))
(manifest-entries manifest))
#:modules '((guix build union))))
(define (generation-number profile)
@ -214,9 +299,13 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(compose string->number (cut match:substring <> 1)))
0))
(define (generation-file-name profile generation)
"Return the file name for PROFILE's GENERATION."
(format #f "~a-~a-link" profile generation))
(define (link-to-empty-profile generation)
"Link GENERATION, a string, to the empty profile."
(let* ((drv (profile-derivation (%store) '()))
(let* ((drv (profile-derivation (%store) (manifest '())))
(prof (derivation->output-path drv "out")))
(when (not (build-derivations (%store) (list drv)))
(leave (_ "failed to build the empty profile~%")))
@ -227,8 +316,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
"Atomically switch PROFILE to the previous generation."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link"
profile previous-number)))
(previous-generation (generation-file-name profile previous-number)))
(format #t (_ "switching from generation ~a to ~a~%")
number previous-number)
(switch-symlinks profile previous-generation)))
@ -237,8 +325,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
"Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link"
profile previous-number))
(previous-generation (generation-file-name profile previous-number))
(manifest (string-append previous-generation "/manifest")))
(cond ((not (file-exists? profile)) ; invalid profile
(leave (_ "profile '~a' does not exist~%")
@ -256,7 +343,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(define (generation-time profile number)
"Return the creation time of a generation in the UTC format."
(make-time time-utc 0
(stat:ctime (stat (format #f "~a-~a-link" profile number)))))
(stat:ctime (stat (generation-file-name profile number)))))
(define* (matching-generations str #:optional (profile %current-profile)
#:key (duration-relation <=))
@ -325,8 +412,8 @@ DURATION-RELATION with the current time."
(else #f)))
(define (find-packages-by-description rx)
"Search in SYNOPSIS and DESCRIPTION using RX. Return a list of
matching packages."
"Return the list of packages whose name, synopsis, or description matches
RX."
(define (same-location? p1 p2)
;; Compare locations of two packages.
(equal? (package-location p1) (package-location p2)))
@ -337,7 +424,8 @@ matching packages."
(define matches?
(cut regexp-exec rx <>))
(if (or (and=> (package-synopsis package)
(if (or (matches? (gettext (package-name package)))
(and=> (package-synopsis package)
(compose matches? gettext))
(and=> (package-description package)
(compose matches? gettext)))
@ -349,6 +437,16 @@ matching packages."
(package-name p2))))
same-location?))
(define* (lower-input store input #:optional (system (%current-system)))
"Lower INPUT so that it contains derivations instead of packages."
(match input
((name (? package? package))
`(,name ,(package-derivation store package system)))
((name (? package? package) output)
`(,name ,(package-derivation store package system)
,output))
(_ input)))
(define (input->name+path input)
"Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
(let loop ((input input))
@ -402,6 +500,76 @@ return its return value."
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
#f))))
;;;
;;; Package specifications.
;;;
(define newest-available-packages
(memoize find-newest-available-packages))
(define (find-best-packages-by-name name version)
"If version is #f, return the list of packages named NAME with the highest
version numbers; otherwise, return the list of packages named NAME and at
VERSION."
(if version
(find-packages-by-name name version)
(match (vhash-assoc name (newest-available-packages))
((_ version pkgs ...) pkgs)
(#f '()))))
(define* (specification->package+output spec #:optional (output "out"))
"Find the package and output specified by SPEC, or #f and #f; SPEC may
optionally contain a version number and an output name, as in these examples:
guile
guile-2.0.9
guile:debug
guile-2.0.9:debug
If SPEC does not specify a version number, return the preferred newest
version; if SPEC does not specify an output, return OUTPUT."
(define (ensure-output p sub-drv)
(if (member sub-drv (package-outputs p))
sub-drv
(leave (_ "package `~a' lacks output `~a'~%")
(package-full-name p)
sub-drv)))
(let*-values (((name sub-drv)
(match (string-rindex spec #\:)
(#f (values spec output))
(colon (values (substring spec 0 colon)
(substring spec (+ 1 colon))))))
((name version)
(package-name->name+version name)))
(match (find-best-packages-by-name name version)
((p)
(values p (ensure-output p sub-drv)))
((p p* ...)
(warning (_ "ambiguous package specification `~a'~%")
spec)
(warning (_ "choosing ~a from ~a~%")
(package-full-name p)
(location->string (package-location p)))
(values p (ensure-output p sub-drv)))
(()
(leave (_ "~a: package not found~%") spec)))))
(define (upgradeable? name current-version current-path)
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
or if the newest available version is equal to CURRENT-VERSION but would have
an output path different than CURRENT-PATH."
(match (vhash-assoc name (newest-available-packages))
((_ candidate-version pkg . rest)
(case (version-compare candidate-version current-version)
((>) #t)
((<) #f)
((=) (let ((candidate-path (derivation->output-path
(package-derivation (%store) pkg))))
(not (string=? current-path candidate-path))))))
(#f #f)))
(define ftp-open*
;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new
;; FTP connection for each package, esp. since most of them are to the same
@ -437,26 +605,31 @@ but ~a is available upstream~%")
((getaddrinfo-error ftp-error) #f)
(else (apply throw key args))))))
(define* (search-path-environment-variables packages profile
;;;
;;; Search paths.
;;;
(define* (search-path-environment-variables entries profile
#:optional (getenv getenv))
"Return environment variable definitions that may be needed for the use of
PACKAGES in PROFILE. Use GETENV to determine the current settings and report
only settings not already effective."
ENTRIES, a list of manifest entries, in PROFILE. Use GETENV to determine the
current settings and report only settings not already effective."
;; Prefer ~/.guix-profile to the real profile directory name.
(let ((profile (if (and %user-environment-directory
(let ((profile (if (and %user-profile-directory
(false-if-exception
(string=? (readlink %user-environment-directory)
(string=? (readlink %user-profile-directory)
profile)))
%user-environment-directory
%user-profile-directory
profile)))
;; The search path info is not stored in the manifest. Thus, we infer the
;; search paths from same-named packages found in the distro.
(define package-in-manifest->package
(define manifest-entry->package
(match-lambda
((name version _ ...)
(($ <manifest-entry> name version)
(match (append (find-packages-by-name name version)
(find-packages-by-name name))
((p _ ...) p)
@ -478,16 +651,16 @@ only settings not already effective."
variable
(string-join directories separator)))))))
(let* ((packages (filter-map package-in-manifest->package packages))
(let* ((packages (filter-map manifest-entry->package entries))
(search-paths (delete-duplicates
(append-map package-native-search-paths
packages))))
(filter-map search-path-definition search-paths))))
(define (display-search-paths packages profile)
(define (display-search-paths entries profile)
"Display the search path environment variables that may need to be set for
PACKAGES, in the context of PROFILE."
(let ((settings (search-path-environment-variables packages profile)))
ENTRIES, a list of manifest entries, in the context of PROFILE."
(let ((settings (search-path-environment-variables entries profile)))
(unless (null? settings)
(format #t (_ "The following environment variable definitions may be needed:~%"))
(format #t "~{ ~a~%~}" settings))))
@ -633,6 +806,110 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(cons `(query list-available ,(or arg ""))
result)))))
(define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
return the new list of manifest entries."
(define (deduplicate deps)
;; Remove duplicate entries from DEPS, a list of propagated inputs, where
;; each input is a name/path tuple.
(define (same? d1 d2)
(match d1
((_ p1)
(match d2
((_ p2) (eq? p1 p2))
(_ #f)))
((_ p1 out1)
(match d2
((_ p2 out2)
(and (string=? out1 out2)
(eq? p1 p2)))
(_ #f)))))
(delete-duplicates deps same?))
(define (package->manifest-entry p output)
;; Return a manifest entry for the OUTPUT of package P.
(check-package-freshness p)
;; When given a package via `-e', install the first of its
;; outputs (XXX).
(let* ((output (or output (car (package-outputs p))))
(path (package-output (%store) p output))
(deps (deduplicate (package-transitive-propagated-inputs p))))
(manifest-entry
(name (package-name p))
(version (package-version p))
(output output)
(path path)
(dependencies (map input->name+path deps))
(inputs (cons (list (package-name p) p output)
deps)))))
(define upgrade-regexps
(filter-map (match-lambda
(('upgrade . regexp)
(make-regexp (or regexp "")))
(_ #f))
opts))
(define packages-to-upgrade
(match upgrade-regexps
(()
'())
((_ ...)
(let ((newest (find-newest-available-packages)))
(filter-map (match-lambda
(($ <manifest-entry> name version output path _)
(and (any (cut regexp-exec <> name)
upgrade-regexps)
(upgradeable? name version path)
(let ((output (or output "out")))
(call-with-values
(lambda ()
(specification->package+output name output))
list))))
(_ #f))
(manifest-entries manifest))))))
(define to-upgrade
(map (match-lambda
((package output)
(package->manifest-entry package output)))
packages-to-upgrade))
(define packages-to-install
(filter-map (match-lambda
(('install . (? package? p))
(list p "out"))
(('install . (? string? spec))
(and (not (store-path? spec))
(let-values (((package output)
(specification->package+output spec)))
(and package (list package output)))))
(_ #f))
opts))
(define to-install
(append (map (match-lambda
((package output)
(package->manifest-entry package output)))
packages-to-install)
(filter-map (match-lambda
(('install . (? package?))
#f)
(('install . (? store-path? path))
(let-values (((name version)
(package-name->name+version
(store-path-package-name path))))
(manifest-entry
(name name)
(version version)
(output #f)
(path path))))
(_ #f))
opts)))
(append to-upgrade to-install))
;;;
;;; Entry point.
@ -653,67 +930,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(let ((out (derivation->output-path (%guile-for-build))))
(not (valid-path? (%store) out))))
(define newest-available-packages
(memoize find-newest-available-packages))
(define (find-best-packages-by-name name version)
(if version
(find-packages-by-name name version)
(match (vhash-assoc name (newest-available-packages))
((_ version pkgs ...) pkgs)
(#f '()))))
(define* (find-package name #:optional (output "out"))
;; Find the package NAME; NAME may contain a version number and a
;; sub-derivation name. If the version number is not present,
;; return the preferred newest version. If the sub-derivation name is not
;; present, use OUTPUT.
(define request name)
(define (ensure-output p sub-drv)
(if (member sub-drv (package-outputs p))
p
(leave (_ "package `~a' lacks output `~a'~%")
(package-full-name p)
sub-drv)))
(let*-values (((name sub-drv)
(match (string-rindex name #\:)
(#f (values name output))
(colon (values (substring name 0 colon)
(substring name (+ 1 colon))))))
((name version)
(package-name->name+version name)))
(match (find-best-packages-by-name name version)
((p)
(list name (package-version p) sub-drv (ensure-output p sub-drv)
(package-transitive-propagated-inputs p)))
((p p* ...)
(warning (_ "ambiguous package specification `~a'~%")
request)
(warning (_ "choosing ~a from ~a~%")
(package-full-name p)
(location->string (package-location p)))
(list name (package-version p) sub-drv (ensure-output p sub-drv)
(package-transitive-propagated-inputs p)))
(()
(leave (_ "~a: package not found~%") request)))))
(define (upgradeable? name current-version current-path)
;; Return #t if there's a version of package NAME newer than
;; CURRENT-VERSION, or if the newest available version is equal to
;; CURRENT-VERSION but would have an output path different than
;; CURRENT-PATH.
(match (vhash-assoc name (newest-available-packages))
((_ candidate-version pkg . rest)
(case (version-compare candidate-version current-version)
((>) #t)
((<) #f)
((=) (let ((candidate-path (derivation->output-path
(package-derivation (%store) pkg))))
(not (string=? current-path candidate-path))))))
(#f #f)))
(define (ensure-default-profile)
;; Ensure the default profile symlink and directory exist and are
;; writable.
@ -725,11 +941,11 @@ more information.~%"))
(exit 1))
;; Create ~/.guix-profile if it doesn't exist yet.
(when (and %user-environment-directory
(when (and %user-profile-directory
%current-profile
(not (false-if-exception
(lstat %user-environment-directory))))
(symlink %current-profile %user-environment-directory))
(lstat %user-profile-directory))))
(symlink %current-profile %user-profile-directory))
(let ((s (stat %profile-directory #f)))
;; Attempt to create /…/profiles/per-user/$USER if needed.
@ -767,48 +983,17 @@ more information.~%"))
(define verbose? (assoc-ref opts 'verbose?))
(define profile (assoc-ref opts 'profile))
(define (canonicalize-deps deps)
;; Remove duplicate entries from DEPS, a list of propagated inputs,
;; where each input is a name/path tuple.
(define (same? d1 d2)
(match d1
((_ p1)
(match d2
((_ p2) (eq? p1 p2))
(_ #f)))
((_ p1 out1)
(match d2
((_ p2 out2)
(and (string=? out1 out2)
(eq? p1 p2)))
(_ #f)))))
(delete-duplicates deps same?))
(define (same-package? tuple name out)
(match tuple
((tuple-name _ tuple-output _ ...)
(and (equal? name tuple-name)
(equal? out tuple-output)))))
(define (package->tuple p)
;; Convert package P to a tuple.
;; When given a package via `-e', install the first of its
;; outputs (XXX).
(let* ((out (car (package-outputs p)))
(path (package-output (%store) p out))
(deps (package-transitive-propagated-inputs p)))
`(,(package-name p)
,(package-version p)
,out
,p
,(canonicalize-deps deps))))
(define (same-package? entry name output)
(match entry
(($ <manifest-entry> entry-name _ entry-output _ ...)
(and (equal? name entry-name)
(equal? output entry-output)))))
(define (show-what-to-remove/install remove install dry-run?)
;; Tell the user what's going to happen in high-level terms.
;; TODO: Report upgrades more clearly.
(match remove
(((name version _ path _) ..1)
((($ <manifest-entry> name version _ path _) ..1)
(let ((len (length name))
(remove (map (cut format #f " ~a-~a\t~a" <> <> <>)
name version path)))
@ -825,7 +1010,7 @@ more information.~%"))
remove))))
(_ #f))
(match install
(((name version output path _) ..1)
((($ <manifest-entry> name version output path _) ..1)
(let ((len (length name))
(install (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>)
name version output path)))
@ -846,15 +1031,15 @@ more information.~%"))
(generation-number profile))
(define (display-and-delete number)
(let ((generation (format #f "~a-~a-link" profile number)))
(let ((generation (generation-file-name profile number)))
(unless (zero? number)
(format #t (_ "deleting ~a~%") generation)
(delete-file generation))))
(define (delete-generation number)
(let* ((previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link"
profile previous-number)))
(previous-generation
(generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0
((and (= number current-generation-number)
(not (file-exists? previous-generation)))
@ -909,126 +1094,59 @@ more information.~%"))
(_ #f))
opts))
(else
(let* ((installed (manifest-packages (profile-manifest profile)))
(upgrade-regexps (filter-map (match-lambda
(('upgrade . regexp)
(make-regexp (or regexp "")))
(_ #f))
opts))
(upgrade (if (null? upgrade-regexps)
'()
(let ((newest (find-newest-available-packages)))
(filter-map
(match-lambda
((name version output path _)
(and (any (cut regexp-exec <> name)
upgrade-regexps)
(upgradeable? name version path)
(find-package name
(or output "out"))))
(_ #f))
installed))))
(install (append
upgrade
(filter-map (match-lambda
(('install . (? package? p))
(package->tuple p))
(('install . (? store-path?))
#f)
(('install . package)
(find-package package))
(_ #f))
opts)))
(drv (filter-map (match-lambda
((name version sub-drv
(? package? package)
(deps ...))
(check-package-freshness package)
(package-derivation (%store) package))
(_ #f))
install))
(install*
(append
(filter-map (match-lambda
(('install . (? package? p))
#f)
(('install . (? store-path? path))
(let-values (((name version)
(package-name->name+version
(store-path-package-name
path))))
`(,name ,version #f ,path ())))
(_ #f))
opts)
(map (lambda (tuple drv)
(match tuple
((name version sub-drv _ (deps ...))
(let ((output-path
(derivation->output-path
drv sub-drv)))
`(,name ,version ,sub-drv ,output-path
,(canonicalize-deps deps))))))
install drv)))
(let* ((manifest (profile-manifest profile))
(install* (options->installable opts manifest))
(remove (filter-map (match-lambda
(('remove . package)
package)
(_ #f))
opts))
(remove* (filter-map (cut assoc <> installed) remove))
(packages
(remove* (filter (cut manifest-installed? manifest <>)
remove))
(entries
(append install*
(fold (lambda (package result)
(match package
((name _ out _ ...)
(($ <manifest-entry> name _ out _ ...)
(filter (negate
(cut same-package? <>
name out))
result))))
(fold alist-delete installed remove)
install*))))
(manifest-entries
(manifest-remove manifest remove))
install*)))
(new (make-manifest entries)))
(when (equal? profile %current-profile)
(ensure-default-profile))
(if (manifest=? new manifest)
(format (current-error-port) (_ "nothing to be done~%"))
(let ((prof-drv (profile-derivation (%store) new)))
(show-what-to-remove/install remove* install* dry-run?)
(show-what-to-build (%store) drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
(show-what-to-build (%store) (list prof-drv)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run? dry-run?)
(or dry-run?
(and (build-derivations (%store) drv)
(let* ((prof-drv (profile-derivation (%store) packages))
(prof (derivation->output-path prof-drv))
(old-drv (profile-derivation
(%store) (manifest-packages
(profile-manifest profile))))
(old-prof (derivation->output-path old-drv))
(let* ((prof (derivation->output-path prof-drv))
(number (generation-number profile))
;; Always use NUMBER + 1 for the new profile,
;; possibly overwriting a "previous future
;; generation".
(name (format #f "~a-~a-link"
profile (+ 1 number))))
(if (string=? old-prof prof)
(when (or (pair? install) (pair? remove))
(format (current-error-port)
(_ "nothing to be done~%")))
(and (parameterize ((current-build-output-port
;; Output something when Guile
;; needs to be built.
(if (or verbose? (guile-missing?))
(current-error-port)
(%make-void-port "w"))))
(build-derivations (%store) (list prof-drv)))
(let ((count (length packages)))
(name (generation-file-name profile
(+ 1 number))))
(and (build-derivations (%store) (list prof-drv))
(let ((count (length entries)))
(switch-symlinks name prof)
(switch-symlinks profile name)
(format #t (N_ "~a package in profile~%"
"~a packages in profile~%"
count)
count)
(display-search-paths packages
(display-search-paths entries
profile)))))))))))
(define (process-query opts)
@ -1049,15 +1167,15 @@ more information.~%"))
(format #t (_ "~a\t(current)~%") header)
(format #t "~a~%" header)))
(for-each (match-lambda
((name version output location _)
(($ <manifest-entry> name version output location _)
(format #t " ~a\t~a\t~a\t~a~%"
name version output location)))
;; Show most recently installed packages last.
(reverse
(manifest-packages
(manifest-entries
(profile-manifest
(format #f "~a-~a-link" profile number)))))
(generation-file-name profile number)))))
(newline)))
(cond ((not (file-exists? profile)) ; XXX: race condition
@ -1082,9 +1200,9 @@ more information.~%"))
(('list-installed regexp)
(let* ((regexp (and regexp (make-regexp regexp)))
(manifest (profile-manifest profile))
(installed (manifest-packages manifest)))
(installed (manifest-entries manifest)))
(for-each (match-lambda
((name version output path _)
(($ <manifest-entry> name version output path _)
(when (or (not regexp)
(regexp-exec regexp name))
(format #t "~a\t~a\t~a\t~a~%"
@ -1125,9 +1243,9 @@ more information.~%"))
(('search-paths)
(let* ((manifest (profile-manifest profile))
(packages (manifest-packages manifest))
(settings (search-path-environment-variables packages
profile
(entries (manifest-entries manifest))
(packages (map manifest-entry-name entries))
(settings (search-path-environment-variables entries profile
(const #f))))
(format #t "~{~a~%~}" settings)
#t))
@ -1139,6 +1257,7 @@ more information.~%"))
(with-error-handling
(parameterize ((%store (open-connection)))
(set-build-options (%store)
#:print-build-trace #f
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes?
(assoc-ref opts 'substitutes?)

94
guix/scripts/pull.scm
View File

@ -45,13 +45,54 @@ files."
(use-modules (guix build utils)
(system base compile)
(ice-9 ftw)
(ice-9 match))
(ice-9 match)
(srfi srfi-1)
(srfi srfi-11)
(srfi srfi-26))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(let ((out (assoc-ref %outputs "out"))
(tar (assoc-ref %build-inputs "tar"))
(gzip (assoc-ref %build-inputs "gzip"))
(gcrypt (assoc-ref %build-inputs "gcrypt"))
(tarball (assoc-ref %build-inputs "tarball")))
(define* (compile-file* file #:key output-file (opts '()))
;; Like 'compile-file', but remove any (guix …) and (gnu …) modules
;; created during the process as an ugly workaround for
;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness,
;; but is overly conservative and very slow.
(define (module-directory+file module)
;; Return the directory for MODULE, like the 'dir-hint' in
;; boot-9.scm.
(match (module-name module)
((beginning ... last)
(values (string-concatenate
(map (lambda (elt)
(string-append (symbol->string elt)
file-name-separator-string))
beginning))
(symbol->string last)))))
(define (clear-module-tree! root)
;; Delete all the modules under ROOT.
(hash-for-each (lambda (name module)
(module-remove! root name)
(let-values (((dir name)
(module-directory+file module)))
(set-autoloaded! dir name #f))
(clear-module-tree! module))
(module-submodules root))
(hash-clear! (module-submodules root)))
(compile-file file #:output-file output-file #:opts opts)
(for-each (compose clear-module-tree! resolve-module)
'((guix) (gnu))))
(setenv "PATH" (string-append tar "/bin:" gzip "/bin"))
(system* "tar" "xvf" tarball)
@ -66,27 +107,9 @@ files."
(format #t "copying and compiling Guix to `~a'...~%" out)
;; Copy everything under guix/ and gnu/ plus guix.scm.
(file-system-fold (lambda (dir stat result) ; enter?
(or (string-prefix? "./guix" dir)
(string-prefix? "./gnu" dir)
(string=? "." dir)))
(lambda (file stat result) ; leaf
(when (or (not (string=? (dirname file) "."))
(string=? (basename file) "guix.scm"))
(let ((target (string-drop file 1)))
(copy-file file
(string-append out target)))))
(lambda (dir stat result) ; down
(mkdir (string-append out
(string-drop dir 1))))
(const #t) ; up
(const #t) ; skip
(lambda (file stat errno result)
(error "cannot access file"
file (strerror errno)))
#f
"."
lstat)
(copy-recursively "guix" (string-append out "/guix"))
(copy-recursively "gnu" (string-append out "/gnu"))
(copy-file "guix.scm" (string-append out "/guix.scm"))
;; Add a fake (guix config) module to allow the other modules to be
;; compiled. The user's (guix config) is the one that will be used.
@ -107,15 +130,12 @@ files."
".go")))
(format (current-error-port)
"compiling '~a'...~%" file)
(compile-file file
(compile-file* file
#:output-file go
#:opts %auto-compilation-options))))
#:opts
%auto-compilation-options))))
;; XXX: Because of the autoload hack in (guix build
;; download), we must build it first to avoid errors since
;; (gnutls) is unavailable.
(cons (string-append out "/guix/build/download.scm")
(find-files out "\\.scm")))
(find-files out "\\.scm"))
;; Remove the "fake" (guix config).
(delete-file (string-append out "/guix/config.scm"))
@ -137,13 +157,15 @@ files."
(define %default-options
;; Alist of default option values.
'())
`((tarball-url . ,%snapshot-url)))
(define (show-help)
(display (_ "Usage: guix pull [OPTION]...
Download and deploy the latest version of Guix.\n"))
(display (_ "
--verbose produce verbose output"))
(display (_ "
--url=URL download the Guix tarball from URL"))
(display (_ "
--bootstrap use the bootstrap Guile to build the new Guix"))
(newline)
@ -159,6 +181,10 @@ Download and deploy the latest version of Guix.\n"))
(list (option '("verbose") #f #f
(lambda (opt name arg result)
(alist-cons 'verbose? #t result)))
(option '("url") #t #f
(lambda (opt name arg result)
(alist-cons 'tarball-url arg
(alist-delete 'tarball-url result))))
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
@ -182,10 +208,10 @@ Download and deploy the latest version of Guix.\n"))
%default-options))
(with-error-handling
(let ((opts (parse-options))
(store (open-connection)))
(let ((tarball (download-to-store store %snapshot-url
"guix-latest.tar.gz")))
(let* ((opts (parse-options))
(store (open-connection))
(url (assoc-ref opts 'tarball-url)))
(let ((tarball (download-to-store store url "guix-latest.tar.gz")))
(unless tarball
(leave (_ "failed to download up-to-date source, exiting\n")))
(parameterize ((%guile-for-build

2
guix/ui.scm
View File

@ -123,7 +123,7 @@ messages."
(define (initialize-guix)
"Perform the usual initialization for stand-alone Guix commands."
(install-locale)
(textdomain "guix")
(textdomain %gettext-domain)
;; Ignore SIGPIPE. If the daemon closes the connection, we prefer to be
;; notified via an EPIPE later.

36
nix/scripts/list-runtime-roots.in
View File

@ -1,7 +1,7 @@
#!@GUILE@ -ds
!#
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,12 +28,17 @@
(ice-9 rdelim)
(ice-9 popen)
(srfi srfi-1)
(srfi srfi-26))
(srfi srfi-26)
(rnrs io ports))
(define %proc-directory
;; Mount point of Linuxish /proc file system.
"/proc")
(define %store-directory
(or (getenv "NIX_STORE_DIR")
"@storedir@"))
(define (proc-file-roots dir file)
"Return a one-element list containing the file pointed to by DIR/FILE,
or the empty list."
@ -78,6 +83,30 @@ or the empty list."
(else
(loop (read-line maps) roots)))))))
(define (proc-environ-roots dir)
"Return the list of store files referenced by DIR/environ, where DIR is a
/proc/XYZ directory."
(define split-on-nul
(cute string-tokenize <>
(char-set-complement (char-set #\nul))))
(define (rhs-file-names str)
(let ((equal (string-index str #\=)))
(if equal
(let* ((str (substring str (+ 1 equal)))
(rx (string-append (regexp-quote %store-directory)
"/[0-9a-z]{32}-[a-zA-Z0-9\\._+-]+")))
(map match:substring (list-matches rx str)))
'())))
(define environ
(string-append dir "/environ"))
(append-map rhs-file-names
(split-on-nul
(call-with-input-file environ
get-string-all))))
(define (lsof-roots)
"Return the list of roots as found by calling `lsof'."
(catch 'system
@ -111,6 +140,7 @@ or the empty list."
(append (proc-exe-roots proc)
(proc-cwd-roots proc)
(proc-fd-roots proc)
(proc-maps-roots proc))
(proc-maps-roots proc)
(proc-environ-roots proc))
'())))
(append proc-roots (lsof-roots))))))

4
scripts/guix.in
View File

@ -31,7 +31,8 @@
(define config-lookup
(let ((config '(("prefix" . "@prefix@")
("datarootdir" . "@datarootdir@")
("guilemoduledir" . "@guilemoduledir@")))
("guilemoduledir" . "@guilemoduledir@")
("localedir" . "@localedir@")))
(var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
(define (expand-var-ref match)
(lookup (match:substring match 1)))
@ -58,6 +59,7 @@
(define (run-guix-main)
(let ((guix-main (module-ref (resolve-interface '(guix ui))
'guix-main)))
(bindtextdomain "guix" (config-lookup "localedir"))
(apply guix-main (command-line))))
(maybe-augment-load-paths!)

17
tests/derivations.scm
View File

@ -260,6 +260,23 @@
(and (eq? 'one (call-with-input-file one read))
(eq? 'two (call-with-input-file two read)))))))
(test-assert "multiple-output derivation, derivation-path->output-path"
(let* ((builder (add-text-to-store %store "builder.sh"
"echo one > $out ; echo two > $second"
'()))
(drv (derivation %store "multiple"
%bash `(,builder)
#:outputs '("out" "second")))
(drv-file (derivation-file-name drv))
(one (derivation->output-path drv "out"))
(two (derivation->output-path drv "second"))
(first (derivation-path->output-path drv-file "out"))
(second (derivation-path->output-path drv-file "second")))
(and (not (string=? one two))
(string-suffix? "-second" two)
(string=? first one)
(string=? second two))))
(test-assert "user of multiple-output derivation"
;; Check whether specifying several inputs coming from the same
;; multiple-output derivation works.

6
tests/records.scm
View File

@ -36,9 +36,9 @@
(match (foo (bar 1))
(($ <foo> 1 42) #t)))))
(test-assert "define-record-type* with letrec* behavior"
(test-assert "define-record-type* with let* behavior"
;; Make sure field initializers can refer to each other as if they were in
;; a `letrec*'.
;; a 'let*'.
(begin
(define-record-type* <bar> bar make-bar
foo?
@ -69,7 +69,7 @@
(equal? c d)
(match e (($ <foo> 42 77) #t))))))
(test-assert "define-record-type* & inherit & letrec* behavior"
(test-assert "define-record-type* & inherit & let* behavior"
(begin
(define-record-type* <foo> foo make-foo
foo?