me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into core-updates 

Conflicts:
	Makefile.am
	gnu/packages/base.scm
master
Ludovic Courtès 2013-03-29 21:44:31 +01:00
parent 14a3a67364 3f5a932eea
commit 4928e50033
42 changed files with 1671 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Makefile.am
View File

@ -38,6 +38,7 @@ MODULES = \
guix/gnu-maintenance.scm \ guix/gnu-maintenance.scm \
guix/licenses.scm \ guix/licenses.scm \
guix/build-system.scm \ guix/build-system.scm \
guix/build-system/cmake.scm \
guix/build-system/gnu.scm \ guix/build-system/gnu.scm \
guix/build-system/perl.scm \ guix/build-system/perl.scm \
guix/build-system/trivial.scm \ guix/build-system/trivial.scm \
@ -45,6 +46,7 @@ MODULES = \
guix/store.scm \ guix/store.scm \
guix/ui.scm \ guix/ui.scm \
guix/build/download.scm \ guix/build/download.scm \
guix/build/cmake-build-system.scm \
guix/build/gnu-build-system.scm \ guix/build/gnu-build-system.scm \
guix/build/perl-build-system.scm \ guix/build/perl-build-system.scm \
guix/build/utils.scm \ guix/build/utils.scm \
@ -58,6 +60,7 @@ MODULES = \
gnu/packages/aspell.scm \ gnu/packages/aspell.scm \
gnu/packages/attr.scm \ gnu/packages/attr.scm \
gnu/packages/autotools.scm \ gnu/packages/autotools.scm \
gnu/packages/avahi.scm \
gnu/packages/base.scm \ gnu/packages/base.scm \
gnu/packages/bash.scm \ gnu/packages/bash.scm \
gnu/packages/bdb.scm \ gnu/packages/bdb.scm \
@ -65,9 +68,12 @@ MODULES = \
gnu/packages/bison.scm \ gnu/packages/bison.scm \
gnu/packages/bootstrap.scm \ gnu/packages/bootstrap.scm \
gnu/packages/cdrom.scm \ gnu/packages/cdrom.scm \
gnu/packages/cflow.scm \
gnu/packages/check.scm \ gnu/packages/check.scm \
gnu/packages/cmake.scm \
gnu/packages/compression.scm \ gnu/packages/compression.scm \
gnu/packages/cpio.scm \ gnu/packages/cpio.scm \
gnu/packages/cppi.scm \
gnu/packages/cross-base.scm \ gnu/packages/cross-base.scm \
gnu/packages/curl.scm \ gnu/packages/curl.scm \
gnu/packages/cyrus-sasl.scm \ gnu/packages/cyrus-sasl.scm \
@ -75,10 +81,12 @@ MODULES = \
gnu/packages/ddrescue.scm \ gnu/packages/ddrescue.scm \
gnu/packages/ed.scm \ gnu/packages/ed.scm \
gnu/packages/emacs.scm \ gnu/packages/emacs.scm \
gnu/packages/fdisk.scm \
gnu/packages/file.scm \ gnu/packages/file.scm \
gnu/packages/flex.scm \ gnu/packages/flex.scm \
gnu/packages/fontutils.scm \ gnu/packages/fontutils.scm \
gnu/packages/gawk.scm \ gnu/packages/gawk.scm \
gnu/packages/gcc.scm \
gnu/packages/gdb.scm \ gnu/packages/gdb.scm \
gnu/packages/gdbm.scm \ gnu/packages/gdbm.scm \
gnu/packages/gettext.scm \ gnu/packages/gettext.scm \
@ -116,6 +124,8 @@ MODULES = \
gnu/packages/linux-initrd.scm \ gnu/packages/linux-initrd.scm \
gnu/packages/lout.scm \ gnu/packages/lout.scm \
gnu/packages/lsh.scm \ gnu/packages/lsh.scm \
gnu/packages/lsof.scm \
gnu/packages/lua.scm \
gnu/packages/m4.scm \ gnu/packages/m4.scm \
gnu/packages/mailutils.scm \ gnu/packages/mailutils.scm \
gnu/packages/make-bootstrap.scm \ gnu/packages/make-bootstrap.scm \
@ -162,6 +172,7 @@ MODULES = \
gnu/packages/tor.scm \ gnu/packages/tor.scm \
gnu/packages/vim.scm \ gnu/packages/vim.scm \
gnu/packages/vpn.scm \ gnu/packages/vpn.scm \
gnu/packages/w3m.scm \
gnu/packages/wdiff.scm \ gnu/packages/wdiff.scm \
gnu/packages/wget.scm \ gnu/packages/wget.scm \
gnu/packages/which.scm \ gnu/packages/which.scm \
@ -183,6 +194,7 @@ dist_patch_DATA = \
gnu/packages/patches/automake-skip-amhello-tests.patch \ gnu/packages/patches/automake-skip-amhello-tests.patch \
gnu/packages/patches/bigloo-gc-shebangs.patch \ gnu/packages/patches/bigloo-gc-shebangs.patch \
gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/binutils-ld-new-dtags.patch \
gnu/packages/patches/cmake-fix-tests.patch \
gnu/packages/patches/cpio-gets-undeclared.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \
gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \
gnu/packages/patches/emacs-configure-sh.patch \ gnu/packages/patches/emacs-configure-sh.patch \
@ -194,6 +206,7 @@ dist_patch_DATA = \
gnu/packages/patches/gettext-gets-undeclared.patch \ gnu/packages/patches/gettext-gets-undeclared.patch \
gnu/packages/patches/glib-tests-desktop.patch \ gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \ gnu/packages/patches/glib-tests-homedir.patch \
gnu/packages/patches/glib-tests-prlimit.patch \
gnu/packages/patches/glib-tests-timezone.patch \ gnu/packages/patches/glib-tests-timezone.patch \
gnu/packages/patches/glibc-bootstrap-system.patch \ gnu/packages/patches/glibc-bootstrap-system.patch \
gnu/packages/patches/glibc-no-ld-so-cache.patch \ gnu/packages/patches/glibc-no-ld-so-cache.patch \
@ -202,7 +215,7 @@ dist_patch_DATA = \
gnu/packages/patches/guile-default-utf8.patch \ gnu/packages/patches/guile-default-utf8.patch \
gnu/packages/patches/guile-linux-syscalls.patch \ gnu/packages/patches/guile-linux-syscalls.patch \
gnu/packages/patches/guile-relocatable.patch \ gnu/packages/patches/guile-relocatable.patch \
gnu/packages/patches/libapr-skip-getservbyname-test.patch \ gnu/packages/patches/libapr-skip-getservbyname-test.patch \
gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libtool-skip-tests.patch \ gnu/packages/patches/libtool-skip-tests.patch \
gnu/packages/patches/lsh-guile-compat.patch \ gnu/packages/patches/lsh-guile-compat.patch \
@ -219,9 +232,10 @@ dist_patch_DATA = \
gnu/packages/patches/readline-link-ncurses.patch \ gnu/packages/patches/readline-link-ncurses.patch \
gnu/packages/patches/shishi-gets-undeclared.patch \ gnu/packages/patches/shishi-gets-undeclared.patch \
gnu/packages/patches/tar-gets-undeclared.patch \ gnu/packages/patches/tar-gets-undeclared.patch \
gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \
gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/teckit-cstdio.patch \
gnu/packages/patches/vpnc-script.patch gnu/packages/patches/vpnc-script.patch \
gnu/packages/patches/w3m-fix-compile.patch
bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap
bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux

15
TODO
View File

@ -8,12 +8,6 @@ Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
* integrate needed Nix code * integrate needed Nix code
Guix uses Nix’s daemon (‘nix-worker’, later renamed to ‘nix-daemon’) to
actually perform builds, scheduling, substitution of pre-built binaries,
and GC-related tasks. The daemon mainly uses ‘libstore’ from Nix.
Integrating it in Guix itself will make Guix self-contained, thereby
simplifying our users’ lives.
** Remove dependency on OpenSSL ** Remove dependency on OpenSSL
The ‘openssl’ command-line tool is used in libstore to sign store paths The ‘openssl’ command-line tool is used in libstore to sign store paths
@ -51,14 +45,6 @@ For a start, we may use the instance at hydra.nixos.org, generously
provided by TU Delft. However, in the future, we may want to setup our provided by TU Delft. However, in the future, we may want to setup our
own instance at gnu.org. own instance at gnu.org.
* add guix pull
A tool that fetches the latest code from [[http://git.savannah.gnu.org/cgit/guix.git/snapshot/guix-master.tar.gz][cgit]], builds a derivation that
unpacks it, copies only .scm files (this excludes guix/config.in) and
compiles it, and then links to it from ~/.local/guix/latest . Change
guix-build and guix-package to have that directory first in their load
path.
* user interface * user interface
** Add a package.el (Emacs) back-end ** Add a package.el (Emacs) back-end
@ -167,7 +153,6 @@ etc.
See [[https://github.com/NixOS/nixpkgs/commit/d1662d715514e6ef9d3dc29f132f1b3d8e608a18][Shea Levy's `replace-dependency' in Nixpkgs]]. See [[https://github.com/NixOS/nixpkgs/commit/d1662d715514e6ef9d3dc29f132f1b3d8e608a18][Shea Levy's `replace-dependency' in Nixpkgs]].
* distro * distro
** choose a name! (Jinn?)
** port to new GNU/Linux platforms, notably ‘mipsel64-linux’ ** port to new GNU/Linux platforms, notably ‘mipsel64-linux’
** port to GNU/Hurd, aka. ‘i686-gnu’ ** port to GNU/Hurd, aka. ‘i686-gnu’

5
build-aux/download.scm
View File

@ -34,6 +34,11 @@
;;"http://www.fdn.fr/~lcourtes/software/guix/packages" ;;"http://www.fdn.fr/~lcourtes/software/guix/packages"
) )
;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile
;; up to 2.0.7.
(module-define! (resolve-module '(web client))
'shutdown (const #f))
(define (file-name->uri file) (define (file-name->uri file)
"Return the URI for FILE." "Return the URI for FILE."
(match (string-tokenize file (char-set-complement (char-set #\/))) (match (string-tokenize file (char-set-complement (char-set #\/)))

6
doc/guix.texi
View File

@ -514,6 +514,12 @@ Thus, when installing MPC, the MPFR and GMP libraries also get installed
in the profile; removing MPC also removes MPFR and GMP---unless they had in the profile; removing MPC also removes MPFR and GMP---unless they had
also been explicitly installed independently. also been explicitly installed independently.
@c XXX: keep me up-to-date
Besides, when installing a GNU package, the tool reports the
availability of a newer upstream version. In the future, it may provide
the option of installing directly from the upstream version, even if
that version is not yet in the distribution.
@item --install-from-expression=@var{exp} @item --install-from-expression=@var{exp}
@itemx -e @var{exp} @itemx -e @var{exp}
Install the package @var{exp} evaluates to. Install the package @var{exp} evaluates to.

77
gnu/packages/avahi.scm 100644
View File

@ -0,0 +1,77 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages avahi)
#:use-module ((guix licenses) #:select (lgpl2.1+))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages gdbm)
#:use-module (gnu packages libdaemon)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages glib)
#:use-module (gnu packages xml))
(define-public avahi
(package
(name "avahi")
(version "0.6.31")
(home-page "http://avahi.org")
(source (origin
(method url-fetch)
(uri (string-append home-page "/download/avahi-"
version ".tar.gz"))
(sha256
(base32
"0j5b5ld6bjyh3qhd2nw0jb84znq0wqai7fsrdzg7bpg24jdp2wl3"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--with-distro=none"
"--disable-python"
"--disable-mono"
"--disable-doxygen-doc"
"--disable-xmltoman"
"--enable-tests"
"--disable-qt3" "--disable-qt4"
"--disable-gtk" "--disable-gtk3")
#:phases (alist-cons-before
'configure 'set-perl-path
(lambda* (#:key inputs #:allow-other-keys)
;; FIXME: Remove this phase when proper support for search
;; paths is available.
(let ((xml-parser (assoc-ref inputs
"intltool/perl-xml-parser")))
(setenv "PERL5LIB"
(string-append xml-parser
"/lib/perl5/site_perl"))
#t))
%standard-phases)))
(inputs
`(("expat" ,expat)
("glib" ,glib)
("dbus" ,dbus)
("libdaemon" ,libdaemon)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("gdbm" ,gdbm)))
(synopsis "Avahi, an mDNS/DNS-SD implementation")
(description
"Avahi is a system which facilitates service discovery on a local
network. It is an implementation of the mDNS (for \"Multicast DNS\") and
DNS-SD (for \"DNS-Based Service Discovery\") protocols.")
(license lgpl2.1+)))

114
gnu/packages/base.scm
View File

@ -24,6 +24,7 @@
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gawk) #:use-module (gnu packages gawk)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages multiprecision) #:use-module (gnu packages multiprecision)
@ -382,119 +383,6 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
(license gpl3+) (license gpl3+)
(home-page "http://www.gnu.org/software/binutils/"))) (home-page "http://www.gnu.org/software/binutils/")))
(define-public gcc-4.7
(let ((stripped? #t)) ; TODO: make this a parameter
(package
(name "gcc")
(version "4.7.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"115h03hil99ljig8lkrq4qk426awmzh0g99wrrggxf8g07bq74la"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("mpfr" ,mpfr)
("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc.
(arguments
`(#:out-of-source? #t
#:strip-binaries? ,stripped?
#:configure-flags
`("--enable-plugin"
"--enable-languages=c,c++"
"--disable-multilib"
"--with-local-prefix=/no-gcc-local-prefix"
,(let ((libc (assoc-ref %build-inputs "libc")))
(if libc
(string-append "--with-native-system-header-dir=" libc
"/include")
"--without-headers")))
#:make-flags
(let ((libc (assoc-ref %build-inputs "libc")))
`(,@(if libc
(list (string-append "LDFLAGS_FOR_TARGET="
"-B" libc "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc
,(glibc-dynamic-linker)))
'())
,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g"))))
#:tests? #f
#:phases
(alist-cons-before
'configure 'pre-configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(libc (assoc-ref inputs "libc")))
(when libc
;; The following is not performed for `--without-headers'
;; cross-compiler builds.
;; Fix the dynamic linker's file name.
(substitute* (find-files "gcc/config"
"^linux(64|-elf)?\\.h$")
(("#define GLIBC_DYNAMIC_LINKER([^ ]*).*$" _ suffix)
(format #f "#define GLIBC_DYNAMIC_LINKER~a \"~a\"~%"
suffix
(string-append libc ,(glibc-dynamic-linker)))))
;; Tell where to find libstdc++, libc, and `?crt*.o', except
;; `crt{begin,end}.o', which come with GCC.
(substitute* (find-files "gcc/config"
"^(gnu-user(64)?|linux-elf)\\.h$")
(("#define LIB_SPEC (.*)$" _ suffix)
;; Note that with this "lib" spec, we may still add a
;; RUNPATH to GCC even when `libgcc_s' is not NEEDED.
;; There's not much that can be done to avoid it, though.
(format #f "#define LIB_SPEC \"-L~a/lib %{!static:-rpath=~a/lib \
%{!static-libgcc:-rpath=~a/lib64 -rpath=~a/lib}} \" ~a"
libc libc out out suffix))
(("#define STARTFILE_SPEC.*$" line)
(format #f "#define STANDARD_STARTFILE_PREFIX_1 \"~a/lib\"
#define STANDARD_STARTFILE_PREFIX_2 \"\"
~a~%"
libc line))))
;; Don't retain a dependency on the build-time sed.
(substitute* "fixincludes/fixincl.x"
(("static char const sed_cmd_z\\[\\] =.*;")
"static char const sed_cmd_z[] = \"sed\";"))))
(alist-cons-after
'configure 'post-configure
(lambda _
;; Don't store configure flags, to avoid retaining references to
;; build-time dependencies---e.g., `--with-ppl=/nix/store/xxx'.
(substitute* "Makefile"
(("^TOPLEVEL_CONFIGURE_ARGUMENTS=(.*)$" _ rest)
"TOPLEVEL_CONFIGURE_ARGUMENTS=\n")))
(alist-replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(zero?
(system* "make"
,(if stripped?
"install-strip"
"install"))))
%standard-phases)))))
(properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
(synopsis "The GNU Compiler Collection")
(description
"The GNU Compiler Collection includes compiler front ends for C, C++,
Objective-C, Fortran, OpenMP for C/C++/Fortran, Java, and Ada, as well as
libraries for these languages (libstdc++, libgcj, libgomp,...).
GCC development is a part of the GNU Project, aiming to improve the compiler
used in the GNU system including the GNU/Linux variant.")
(license gpl3+)
(home-page "http://gcc.gnu.org/"))))
(define-public glibc (define-public glibc
(package (package
(name "glibc") (name "glibc")

9
gnu/packages/bootstrap.scm
View File

@ -104,7 +104,8 @@ check whether everything is alright."
("tarball" ,(bootstrap-origin (source* (%current-system)))))) ("tarball" ,(bootstrap-origin (source* (%current-system))))))
(synopsis description*) (synopsis description*)
(description #f) (description #f)
(home-page #f))) (home-page #f)
(license #f)))
(define package-with-bootstrap-guile (define package-with-bootstrap-guile
(memoize (memoize
@ -285,7 +286,8 @@ $out/bin/guile --version~%"
"08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88"))))))))) "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88")))))))))
(synopsis "Bootstrap binaries and headers of the GNU C Library") (synopsis "Bootstrap binaries and headers of the GNU C Library")
(description #f) (description #f)
(home-page #f))) (home-page #f)
(license lgpl2.1+)))
(define %bootstrap-gcc (define %bootstrap-gcc
;; The initial GCC. Uses binaries from a tarball typically built by ;; The initial GCC. Uses binaries from a tarball typically built by
@ -352,7 +354,8 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
"06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2"))))))))) "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2")))))))))
(synopsis "Bootstrap binaries of the GNU Compiler Collection") (synopsis "Bootstrap binaries of the GNU Compiler Collection")
(description #f) (description #f)
(home-page #f))) (home-page #f)
(license gpl3+)))
(define %bootstrap-inputs (define %bootstrap-inputs
;; The initial, pre-built inputs. From now on, we can start building our ;; The initial, pre-built inputs. From now on, we can start building our

51
gnu/packages/cflow.scm 100644
View File

@ -0,0 +1,51 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages cflow)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix licenses)
#:use-module (gnu packages emacs))
(define-public cflow
(package
(name "cflow")
(version "1.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/cflow/cflow-"
version ".tar.bz2"))
(sha256
(base32
"1jkbq97ajcf834z68hbn3xfhiz921zhn39gklml1racf0kb3jzh3"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/cflow/")
(synopsis "A tool to analyze the control flow of C programs")
(description
"GNU cflow analyzes a collection of C source files and prints a
graph, charting control flow within the program.
GNU cflow is able to produce both direct and inverted flowgraphs
for C sources. Optionally a cross-reference listing can be
generated. Two output formats are implemented: POSIX and GNU
(extended).
The package also provides Emacs major mode for examining the
produced flowcharts in Emacs.")
(license gpl3+)))

78
gnu/packages/cmake.scm 100644
View File

@ -0,0 +1,78 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; 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 cmake)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages file))
(define-public cmake
(package
(name "cmake")
(version "2.8.10.2")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.cmake.org/files/v"
(substring version 0
(string-index version #\. (+ 1 (string-index version #\.))))
"/cmake-" version ".tar.gz"))
(sha256
(base32 "1c8fj6i2x9sb39wc9av2ighj415mw33cxfrlfpafcvm0knrlylnf"))))
(build-system gnu-build-system)
(arguments
'(#:test-target "test"
#:patches (list (assoc-ref %build-inputs "fix-tests"))
#:patch-flags '("-p0")
#:phases (alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; Replace "/bin/sh" by the right path in... a lot of
;; files.
(substitute*
'("Modules/CompilerId/Xcode-3.pbxproj.in"
"Modules/CompilerId/Xcode-1.pbxproj.in"
"Modules/CompilerId/Xcode-2.pbxproj.in"
"Modules/CPack.RuntimeScript.in"
"Source/cmakexbuild.cxx"
"Source/cmGlobalXCodeGenerator.cxx"
"Source/CTest/cmCTestBatchTestHandler.cxx"
"Source/cmLocalUnixMakefileGenerator3.cxx"
"Utilities/cmbzip2/Makefile-libbz2_so"
"Utilities/Release/release_cmake.cmake"
"Utilities/cmlibarchive/libarchive/archive_write_set_format_shar.c"
"Tests/CMakeLists.txt")
(("/bin/sh") (which "sh")))
(zero? (system* "./configure"
(string-append "--prefix=" out)))))
%standard-phases)))
(inputs
`(("file" ,file)
("fix-tests" ,(search-patch "cmake-fix-tests.patch"))))
(home-page "http://www.cmake.org/")
(synopsis "A cross-platform, open-source 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
and compiler independent configuration files. CMake generates native makefiles
and workspaces that can be used in the compiler environment of your choice.")
(license bsd-3)))

45
gnu/packages/cppi.scm 100644
View File

@ -0,0 +1,45 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages cppi)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix licenses))
(define-public cppi
(package
(name "cppi")
(version "1.18")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/cppi/cppi-"
version ".tar.xz"))
(sha256
(base32
"1jk42cjaggk71rimjnx3qpmb6hivps0917vl3z7wbxk3i2whb98j"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/cppi/")
(synopsis "A cpp directive indenter")
(description
"GNU cppi indents C preprocessor directives to reflect their nesting and
ensure that there is exactly one space character between each #if, #elif,
#define directive and the following token. The number of spaces between the
`#' and the following directive must correspond to the level of nesting of
that directive.")
(license gpl3+)))

6
gnu/packages/emacs.scm
View File

@ -31,14 +31,14 @@
(define-public emacs (define-public emacs
(package (package
(name "emacs") (name "emacs")
(version "24.2") (version "24.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/emacs/emacs-" (uri (string-append "mirror://gnu/emacs/emacs-"
version ".tar.bz2")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"13wbjfjmz13qpjwssy44nw2230lllmkkgjsy0rqfm6am2cf87n3k")))) "1385qzs3bsa52s5rcncbrkxlydkw0ajzrvfxgv8rws5fx512kakh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags

54
gnu/packages/fdisk.scm 100644
View File

@ -0,0 +1,54 @@
;;; 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 fdisk)
#:use-module ((guix licenses) #:select (gpl3+))
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (gnu packages guile)
#:use-module (gnu packages linux)
#:use-module (gnu packages parted)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public fdisk
(package
(name "fdisk")
(version "2.0.0a")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/fdisk/gnufdisk-"
version ".tar.gz"))
(sha256
(base32
"04nd7civ561x2lwcmxhsqbprml3178jfc58fy1v7hzqg5k4nbhy3"))))
(build-system gnu-build-system)
(inputs
`(("gettext" ,guix:gettext)
("guile" ,guile-1.8)
("util-linux" ,util-linux)
("parted" ,parted)))
(home-page "https://www.gnu.org/software/fdisk/")
(synopsis
"GNU Fdisk, a command-line disk partitioning tool")
(description
"GNU Fdisk provides alternatives to util-linux fdisk and util-linux
cfdisk. It uses GNU Parted.")
(license gpl3+)))

241
gnu/packages/gcc.scm 100644
View File

@ -0,0 +1,241 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages gcc)
#:use-module (guix licenses)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages compression)
#:use-module (gnu packages multiprecision)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define %gcc-infrastructure
;; Base URL for GCC's infrastructure.
"ftp://gcc.gnu.org/pub/gcc/infrastructure/")
(define-public gcc-4.7
(let ((stripped? #t)) ; TODO: make this a parameter
(package
(name "gcc")
(version "4.7.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"115h03hil99ljig8lkrq4qk426awmzh0g99wrrggxf8g07bq74la"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("mpfr" ,mpfr)
("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc.
(arguments
`(#:out-of-source? #t
#:strip-binaries? ,stripped?
#:configure-flags
`("--enable-plugin"
"--enable-languages=c,c++"
"--disable-multilib"
"--with-local-prefix=/no-gcc-local-prefix"
,(let ((libc (assoc-ref %build-inputs "libc")))
(if libc
(string-append "--with-native-system-header-dir=" libc
"/include")
"--without-headers")))
#:make-flags
(let ((libc (assoc-ref %build-inputs "libc")))
`(,@(if libc
(list (string-append "LDFLAGS_FOR_TARGET="
"-B" libc "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc
,(glibc-dynamic-linker)))
'())
,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g"))))
#:tests? #f
#:phases
(alist-cons-before
'configure 'pre-configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(libc (assoc-ref inputs "libc")))
(when libc
;; The following is not performed for `--without-headers'
;; cross-compiler builds.
;; Fix the dynamic linker's file name.
(substitute* (find-files "gcc/config"
"^linux(64|-elf)?\\.h$")
(("#define GLIBC_DYNAMIC_LINKER([^ ]*).*$" _ suffix)
(format #f "#define GLIBC_DYNAMIC_LINKER~a \"~a\"~%"
suffix
(string-append libc ,(glibc-dynamic-linker)))))
;; Tell where to find libstdc++, libc, and `?crt*.o', except
;; `crt{begin,end}.o', which come with GCC.
(substitute* (find-files "gcc/config"
"^(gnu-user(64)?|linux-elf)\\.h$")
(("#define LIB_SPEC (.*)$" _ suffix)
;; Note that with this "lib" spec, we may still add a
;; RUNPATH to GCC even when `libgcc_s' is not NEEDED.
;; There's not much that can be done to avoid it, though.
(format #f "#define LIB_SPEC \"-L~a/lib %{!static:-rpath=~a/lib \
%{!static-libgcc:-rpath=~a/lib64 -rpath=~a/lib}} \" ~a"
libc libc out out suffix))
(("#define STARTFILE_SPEC.*$" line)
(format #f "#define STANDARD_STARTFILE_PREFIX_1 \"~a/lib\"
#define STANDARD_STARTFILE_PREFIX_2 \"\"
~a~%"
libc line))))
;; Don't retain a dependency on the build-time sed.
(substitute* "fixincludes/fixincl.x"
(("static char const sed_cmd_z\\[\\] =.*;")
"static char const sed_cmd_z[] = \"sed\";"))))
(alist-cons-after
'configure 'post-configure
(lambda _
;; Don't store configure flags, to avoid retaining references to
;; build-time dependencies---e.g., `--with-ppl=/nix/store/xxx'.
(substitute* "Makefile"
(("^TOPLEVEL_CONFIGURE_ARGUMENTS=(.*)$" _ rest)
"TOPLEVEL_CONFIGURE_ARGUMENTS=\n")))
(alist-replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(zero?
(system* "make"
,(if stripped?
"install-strip"
"install"))))
%standard-phases)))))
(properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
(synopsis "The GNU Compiler Collection")
(description
"The GNU Compiler Collection includes compiler front ends for C, C++,
Objective-C, Fortran, OpenMP for C/C++/Fortran, Java, and Ada, as well as
libraries for these languages (libstdc++, libgcj, libgomp,...).
GCC development is a part of the GNU Project, aiming to improve the compiler
used in the GNU system including the GNU/Linux variant.")
(license gpl3+)
(home-page "http://gcc.gnu.org/"))))
(define-public isl
(package
(name "isl")
(version "0.11.1")
(source (origin
(method url-fetch)
(uri (list (string-append
"ftp://ftp.linux.student.kuleuven.be/pub/people/skimo/isl/isl-"
version
".tar.bz2")
(string-append %gcc-infrastructure
name "-" version ".tar.gz")))
(sha256
(base32
"13d9cqa5rzhbjq0xf0b2dyxag7pqa72xj9dhsa03m8ccr1a4npq9"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)))
(home-page "http://www.kotnet.org/~skimo/isl/")
(synopsis
"A library for manipulating sets and relations of integer points bounded
by linear constraints")
(description
"isl is a library for manipulating sets and relations of integer points
bounded by linear constraints. Supported operations on sets include
intersection, union, set difference, emptiness check, convex hull, (integer)
affine hull, integer projection, computing the lexicographic minimum using
parametric integer programming, coalescing and parametric vertex
enumeration. It also includes an ILP solver based on generalized basis
reduction, transitive closures on maps (which may encode infinite graphs),
dependence analysis and bounds on piecewise step-polynomials.")
(license lgpl2.1+)))
(define-public cloog
(package
(name "cloog")
(version "0.18.0")
(source
(origin
(method url-fetch)
(uri (list (string-append
"http://www.bastoul.net/cloog/pages/download/count.php3?url=cloog-"
version
".tar.gz")
(string-append %gcc-infrastructure
name "-" version ".tar.gz")))
(sha256
(base32
"0a12rwfwp22zd0nlld0xyql11cj390rrq1prw35yjsw8wzfshjhw"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("isl" ,isl)))
(arguments '(#:configure-flags '("--with-isl=system")))
(home-page "http://www.cloog.org/")
(synopsis "A library to generate code for scanning Z-polyhedra")
(description
"CLooG is a free software library to generate code for scanning
Z-polyhedra. That is, it finds a code (e.g., in C, FORTRAN...) that
reaches each integral point of one or more parameterized polyhedra.
CLooG has been originally written to solve the code generation problem
for optimizing compilers based on the polytope model. Nevertheless it
is used now in various area e.g., to build control automata for
high-level synthesis or to find the best polynomial approximation of a
function. CLooG may help in any situation where scanning polyhedra
matters. While the user has full control on generated code quality,
CLooG is designed to avoid control overhead and to produce a very
effective code.")
(license gpl2+)))
(define-public libelf
(package
(name "libelf")
(version "0.8.13")
(source (origin
(method url-fetch)
(uri (string-append "http://www.mr511.de/software/libelf-"
version ".tar.gz"))
(sha256
(base32
"0vf7s9dwk2xkmhb79aigqm0x0yfbw1j0b9ksm51207qwr179n6jr"))))
(build-system gnu-build-system)
(arguments '(#:phases (alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
;; This old `configure' script doesn't support
;; variables passed as arguments.
(let ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system* "./configure"
(string-append "--prefix=" out)))))
%standard-phases)))
(home-page "http://www.mr511.de/software/english.html")
(synopsis "An ELF object file access library")
(description "libelf is a C library to access ELF object files.")
(license lgpl2.0+)))

60
gnu/packages/glib.scm
View File

@ -18,7 +18,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages glib) (define-module (gnu packages glib)
#:use-module ((guix licenses) #:select (lgpl2.0+ gpl2+)) #:use-module ((guix licenses) #:select (lgpl2.0+ gpl2+ gpl2))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
@ -76,7 +76,7 @@ shared NFS home directories.")
(version "2.34.3") (version "2.34.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://ftp.gnome.org/pub/gnome/sources/" (uri (string-append "mirror://gnome/sources/"
name "/2.34/" name "/2.34/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
@ -99,11 +99,14 @@ shared NFS home directories.")
("patch/tests-homedir" ("patch/tests-homedir"
,(search-patch "glib-tests-homedir.patch")) ,(search-patch "glib-tests-homedir.patch"))
("patch/tests-desktop" ("patch/tests-desktop"
,(search-patch "glib-tests-desktop.patch")))) ,(search-patch "glib-tests-desktop.patch"))
("patch/tests-prlimit"
,(search-patch "glib-tests-prlimit.patch"))))
(arguments (arguments
'(#:patches (list (assoc-ref %build-inputs "patch/tests-tzdata") '(#:patches (list (assoc-ref %build-inputs "patch/tests-tzdata")
(assoc-ref %build-inputs "patch/tests-homedir") (assoc-ref %build-inputs "patch/tests-homedir")
(assoc-ref %build-inputs "patch/tests-desktop")) (assoc-ref %build-inputs "patch/tests-desktop")
(assoc-ref %build-inputs "patch/tests-prlimit"))
#:phases (alist-cons-before #:phases (alist-cons-before
'build 'pre-build 'build 'pre-build
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
@ -124,3 +127,52 @@ and interfaces for such runtime functionality as an event loop, threads,
dynamic loading, and an object system.") dynamic loading, and an object system.")
(home-page "http://developer.gnome.org/glib/") (home-page "http://developer.gnome.org/glib/")
(license lgpl2.0+))) ; some files are under lgpl2.1+ (license lgpl2.0+))) ; some files are under lgpl2.1+
(define-public intltool
(package
(name "intltool")
(version "0.40.6")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnome/sources/intltool/0.40/intltool-"
version
".tar.bz2"))
(sha256
(base32
"0r1vkvy5xzqk01yl6a0xlrry39bra24alkrx6279b77hc62my7jd"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'configure 'set-perl-path
(lambda* (#:key inputs #:allow-other-keys)
;; FIXME: Remove this phase when proper support for search
;; paths is available.
(let ((xml-parser (assoc-ref inputs "perl-xml-parser")))
(setenv "PERL5LIB"
(string-append xml-parser
"/lib/perl5/site_perl"))
#t))
%standard-phases)))
(native-inputs `(("pkg-config" ,pkg-config)))
(propagated-inputs
`(("gettext" ,guix:gettext)
("perl-xml-parser" ,xml:perl-xml-parser)
("perl" ,perl)))
(home-page "http://freedesktop.org/wiki/Software/intltool")
(synopsis "Tools to centralize translation of many different file formats")
(description
"intltool is a set of tools to centralize translation of many different
file formats using GNU gettext-compatible PO files.
The intltool collection can be used to do these things:
Extract translatable strings from various source files (.xml.in,
glade, .desktop.in, .server.in, .oaf.in).
Collect the extracted strings together with messages from traditional
source files (.c, .h) in po/$(PACKAGE).pot.
Merge back the translations from .po files into .xml, .desktop and
oaf files. This merge step will happen at build resp. installation time.")
(license gpl2)))

19
gnu/packages/gnupg.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -57,15 +57,14 @@ Daemon and possibly more in the future.")
(define-public libgcrypt (define-public libgcrypt
(package (package
(name "libgcrypt") (name "libgcrypt")
(version "1.5.0") (version "1.5.1")
(source (source (origin
(origin (method url-fetch)
(method url-fetch) (uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
(uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-" version ".tar.bz2"))
version ".tar.bz2")) (sha256
(sha256 (base32
(base32 "09z5zbxhvg6c7n8qcm8h9ygr28qli2n83hfq1f69jsg711cb37md"))))
"1ykkh7dm0gyndz7bbpvn3agijj8xb2h02m02f42hm504c18zqqjb"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(propagated-inputs (propagated-inputs
`(("libgpg-error" ,libgpg-error))) `(("libgpg-error" ,libgpg-error)))

4
gnu/packages/gnutls.scm
View File

@ -52,7 +52,7 @@ portable, and only require an ANSI C89 platform.")
(define-public gnutls (define-public gnutls
(package (package
(name "gnutls") (name "gnutls")
(version "3.1.6") (version "3.1.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -62,7 +62,7 @@ portable, and only require an ANSI C89 platform.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0zsybr9plllk1phh83bx9bg7c5ccik427j4n3k1s9fiy4j69n0w3")))) "0gkwhz7sypfy39jfj2yzrngbxq5j9l9smqc89mqlqsh25spc8009"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("guile" ,guile-2.0) `(("guile" ,guile-2.0)

75
gnu/packages/lsof.scm 100644
View File

@ -0,0 +1,75 @@
;;; 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 lsof)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages perl))
(define-public lsof
(package
(name "lsof")
(version "4.87")
(source (origin
(method url-fetch)
(uri (string-append "ftp://lsof.itap.purdue.edu/pub/tools/unix/lsof/lsof_"
version ".tar.bz2"))
(sha256 (base32
"0b6si72sml7gr9784ak491cxxbm9mx5bh174yg6rrirbv04kgpfz"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(arguments
`(#:tests? #f ; no test target
#:phases
(alist-replace
'unpack
(lambda* (#:key source name version #:allow-other-keys)
(let ((unpack (assoc-ref %standard-phases 'unpack)))
(apply unpack (list #:source source))
(apply unpack (list #:source (car (find-files "." "\\.tar$"))))))
(alist-replace
'configure
(lambda* (#:key #:allow-other-keys)
(setenv "LSOF_CC" "gcc")
(setenv "LSOF_MAKE" "make")
(system* "./Configure" "linux"))
(alist-replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(mkdir out)
(mkdir (string-append out "/bin"))
(copy-file "lsof" (string-append out "/bin/lsof"))
(mkdir (string-append out "/share"))
(mkdir (string-append out "/share/man"))
(mkdir (string-append out "/share/man/man8"))
(copy-file "lsof.8" (string-append out "/share/man/man8/lsof.8"))
))
%standard-phases)))))
(synopsis "lsof displays information about open files")
(description
"Lsof stands for LiSt Open Files, and it does just that.
It lists information about files that are open by the processes running
on the system.")
(license (license:fsf-free
"file://00FAQ"
"License inspired by zlib, see point 1.9 of 00FAQ in the distribution."))
(home-page "http://people.freebsd.org/~abe/")))

63
gnu/packages/lua.scm 100644
View File

@ -0,0 +1,63 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; 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 lua)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages readline))
(define-public lua
(package
(name "lua")
(version "5.2.1")
(source (origin
(method url-fetch)
(uri (string-append "http://www.lua.org/ftp/lua-"
version ".tar.gz"))
(sha256
(base32 "1rbv2ysq5fdksz7xg07dnrkl8i0gnx855hg4z6b324vng6l4sc34"))))
(build-system gnu-build-system)
(inputs `(("readline", readline)))
(arguments
'(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1))
#:test-target "test"
#:phases (alist-replace
'build
(lambda _ (zero? (system* "make" "linux"))) ; XXX: Other OS.
(alist-replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(zero? (system
(string-append "make install INSTALL_TOP=" out)))))
(alist-delete 'configure %standard-phases)))))
(home-page "http://www.lua.org/")
(synopsis "An embeddable scripting language.")
(description
"Lua is a powerful, fast, lightweight, embeddable scripting language. Lua
combines simple procedural syntax with powerful data description constructs
based on associative arrays and extensible semantics. Lua is dynamically typed,
runs by interpreting bytecode for a register-based virtual machine, and has
automatic memory management with incremental garbage collection, making it ideal
for configuration, scripting, and rapid prototyping.")
(license x11)))

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

@ -27,6 +27,7 @@
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages gawk) #:use-module (gnu packages gawk)
#:use-module (gnu packages gcc)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages bdw-gc) #:use-module (gnu packages bdw-gc)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)

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

@ -0,0 +1,45 @@
--- Tests/CMakeLists.txt 2013-03-20 22:57:13.000000000 +0100
+++ 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")
- configure_file(
- "${CMake_SOURCE_DIR}/Tests/CTestTestUpload/test.cmake.in"
- "${CMake_BINARY_DIR}/Tests/CTestTestUpload/test.cmake"
- @ONLY ESCAPE_QUOTES)
- add_test(CTestTestUpload ${CMAKE_CTEST_COMMAND}
- -S "${CMake_BINARY_DIR}/Tests/CTestTestUpload/test.cmake" -V
- --output-log "${CMake_BINARY_DIR}/Tests/CTestTestUpload/testOut.log"
- )
- set_tests_properties(CTestTestUpload PROPERTIES
- PASS_REGULAR_EXPRESSION "Upload\\.xml")
+# This test requires network connectivity: skip it.
+# configure_file(
+# "${CMake_SOURCE_DIR}/Tests/CTestTestUpload/test.cmake.in"
+# "${CMake_BINARY_DIR}/Tests/CTestTestUpload/test.cmake"
+# @ONLY ESCAPE_QUOTES)
+# add_test(CTestTestUpload ${CMAKE_CTEST_COMMAND}
+# -S "${CMake_BINARY_DIR}/Tests/CTestTestUpload/test.cmake" -V
+# --output-log "${CMake_BINARY_DIR}/Tests/CTestTestUpload/testOut.log"
+# )
+# set_tests_properties(CTestTestUpload PROPERTIES
+# PASS_REGULAR_EXPRESSION "Upload\\.xml")
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
@@ -729,8 +729,9 @@
ADD_EXECUTABLE(LIBCURL Testing/curltest.c)
TARGET_LINK_LIBRARIES(LIBCURL cmcurl ${CMAKE_DL_LIBS})
-IF(CMAKE_CURL_TEST_URL)
- ADD_TEST(curl LIBCURL ${CMAKE_CURL_TEST_URL})
-ENDIF(CMAKE_CURL_TEST_URL)
+# This test requires network connectivity: skip it.
+#IF(CMAKE_CURL_TEST_URL)
+# ADD_TEST(curl LIBCURL ${CMAKE_CURL_TEST_URL})
+#ENDIF(CMAKE_CURL_TEST_URL)
INSTALL(FILES COPYING DESTINATION ${CMake_DOC_DEST}/cmcurl)

11
gnu/packages/patches/emacs-configure-sh.patch
View File

@ -1,14 +1,13 @@
Make sure the right shell is used when creating src/epaths.h. Make sure the right shell is used when creating src/epaths.h.
--- emacs-24.2/configure 2013-01-13 17:01:53.000000000 +0100 --- emacs-24.3/configure 2013-03-14 17:42:26.000000000 +0100
+++ emacs-24.2/configure 2013-01-13 17:01:57.000000000 +0100 +++ emacs-24.3/configure 2013-03-14 17:42:58.000000000 +0100
@@ -24135,7 +24135,7 @@ done @@ -26463,7 +26463,7 @@ done
;; ;;
"epaths":C) "epaths":C)
echo creating src/epaths.h echo creating src/epaths.h
-${MAKE-make} epaths-force -${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
+${MAKE-make} epaths-force SHELL="$CONFIG_SHELL" +${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force SHELL="$CONFIG_SHELL"
;; ;;
"gdbinit":C) "gdbinit":C)
if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then

14
gnu/packages/patches/glib-tests-prlimit.patch 100644
View File

@ -0,0 +1,14 @@
prlimit(2) returns ENOSYS on Linux 2.6.32-5-xen-amd64 as found on
hydra.gnu.org, and strace(1) doesn't recognize it.
--- glib-2.34.3/glib/tests/thread.c 2012-11-20 15:27:12.000000000 +0100
+++ glib-2.34.3/glib/tests/thread.c 2013-03-27 14:48:31.000000000 +0100
@@ -130,7 +130,7 @@ test_thread3 (void)
static void
test_thread4 (void)
{
-#ifdef HAVE_PRLIMIT
+#if 0
struct rlimit ol, nl;
GThread *thread;
GError *error;

15
gnu/packages/patches/w3m-fix-compile.patch 100644
View File

@ -0,0 +1,15 @@
https://bugs.archlinux.org/task/33397
diff -aur old/main.c new/main.c
--- main.c 2013-01-14 18:16:14.216210053 -0600
+++ main.c 2013-01-14 18:17:28.816220559 -0600
@@ -833,7 +833,8 @@
mySignal(SIGPIPE, SigPipe);
#endif
- orig_GC_warn_proc = GC_set_warn_proc(wrap_GC_warn_proc);
+ orig_GC_warn_proc = GC_get_warn_proc();
+ GC_set_warn_proc(wrap_GC_warn_proc);
err_msg = Strnew();
if (load_argc == 0) {
/* no URL specified */

4
gnu/packages/texinfo.scm
View File

@ -28,14 +28,14 @@
(define-public texinfo (define-public texinfo
(package (package
(name "texinfo") (name "texinfo")
(version "5.0") (version "5.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/texinfo/texinfo-" (uri (string-append "mirror://gnu/texinfo/texinfo-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1p34f68h9ggfj6ckgj0p62qlj7pmz3ha3vc91kh4hr44pnwm1pla")))) "0864v5i488x3mb3v5p6nhy2kw0mqkzpa3b0453iibj81zlpq078q"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses) (inputs `(("ncurses" ,ncurses)
("xz" ,xz))) ("xz" ,xz)))

50
gnu/packages/vpn.scm
View File

@ -23,8 +23,14 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'gnu:))
#:use-module (gnu packages gnupg) #:use-module (gnu packages gnupg)
#:use-module (gnu packages perl)) #:use-module (gnu packages openssl)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages xml))
(define-public vpnc (define-public vpnc
(package (package
@ -64,3 +70,45 @@ shared-secret IPSec authentication with Xauth, AES (256, 192, 128), 3DES,
Only \"Universal TUN/TAP device driver support\" is needed in the kernel.") Only \"Universal TUN/TAP device driver support\" is needed in the kernel.")
(license license:gpl2+) ; some file are bsd-2, see COPYING (license license:gpl2+) ; some file are bsd-2, see COPYING
(home-page "http://www.unix-ag.uni-kl.de/~massar/vpnc/"))) (home-page "http://www.unix-ag.uni-kl.de/~massar/vpnc/")))
(define-public openconnect
(package
(name "openconnect")
(version "4.99")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.infradead.org/pub/openconnect/openconnect-"
version ".tar.gz"))
(sha256 (base32
"1rd8pap455wzkx19i0sy3cqap524b6fwcjvqynxp6lhm01di4bd6"))))
(build-system gnu-build-system)
(inputs
`(("gettext" ,gnu:gettext)
("libxml2" ,libxml2)
("openssl" ,openssl)
("pkg-config" ,pkg-config)
("vpnc" ,vpnc)
("zlib" ,zlib)))
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key inputs #:allow-other-keys #:rest args)
(let ((vpnc (assoc-ref inputs "vpnc"))
(configure (assoc-ref %standard-phases 'configure)))
(apply configure
(append args
(list '#:configure-flags
(list (string-append "--with-vpnc-script="
vpnc
"/etc/vpnc/vpnc-script")))))))
%standard-phases)))
(synopsis "client for cisco vpn")
(description
"OpenConnect is a client for Cisco's AnyConnect SSL VPN, which is
supported by the ASA5500 Series, by IOS 12.4(9)T or later on Cisco SR500,
870, 880, 1800, 2800, 3800, 7200 Series and Cisco 7301 Routers,
and probably others.")
(license license:lgpl2.1)
(home-page "http://www.infradead.org/openconnect/")))

81
gnu/packages/w3m.scm 100644
View File

@ -0,0 +1,81 @@
;;; 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 w3m)
#:use-module ((guix licenses) #:select (x11-style))
#:use-module ((gnu packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (gnu packages bdw-gc)
#:use-module (gnu packages compression)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages openssl)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public w3m
(package
(name "w3m")
(version "0.5.3")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/w3m/w3m-"
version ".tar.gz"))
(sha256
(base32
"1qx9f0kprf92r1wxl3sacykla0g04qsi0idypzz24b7xy9ix5579"))))
(build-system gnu-build-system)
(arguments `(#:tests? #f ; no check target
#:phases (alist-cons-before
'configure 'fix-perl
(lambda _
;; https://launchpad.net/bugs/935540
;; 'struct file_handle' is used by 'glibc'
(substitute* '("istream.c" "istream.h")
(("struct[[:blank:]]+file_handle")
"struct w3m_file_handle"))
(substitute* '("scripts/w3mmail.cgi.in"
"scripts/dirlist.cgi.in")
(("@PERL@") (which "perl"))))
%standard-phases)
;; cf. https://bugs.archlinux.org/task/33397
#:patches (list (assoc-ref %build-inputs
"patch/fix-compile"))
#:patch-flags '("-p0")))
(inputs
`(("gettext" ,guix:gettext)
("libgc" ,libgc)
("ncurses" ,ncurses)
("openssl" ,openssl)
("perl" ,perl)
("pkg-config" ,pkg-config)
("zlib" ,zlib)
("patch/fix-compile" ,(search-patch "w3m-fix-compile.patch"))))
(home-page "http://w3m.sourceforge.net/")
(synopsis "w3m, a text-mode web browser")
(description
"w3m is a text-based web browser as well as a pager like 'more' or
'less'. With w3m you can browse web pages through a terminal emulator
window. Moreover, w3m can be used as a text formatting tool which
typesets HTML into plain text.")
(license (x11-style "file://doc/README"
"See 'doc/README' in the distribution."))))

123
guix/build-system/cmake.scm 100644
View File

@ -0,0 +1,123 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system cmake)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (ice-9 match)
#:export (cmake-build
cmake-build-system))
;; Commentary:
;;
;; Standard build procedure for packages using CMake. This is implemented as an
;; extension of `gnu-build-system'.
;;
;; Code:
(define* (cmake-build store name source inputs
#:key (guile #f)
(outputs '("out")) (configure-flags ''())
(make-flags ''())
(patches ''()) (patch-flags ''("--batch" "-p1"))
(cmake (@ (gnu packages cmake) cmake))
(out-of-source? #f)
(path-exclusions ''())
(tests? #t)
(test-target "test")
(parallel-build? #t) (parallel-tests? #f)
(patch-shebangs? #t)
(strip-binaries? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build cmake-build-system)
%standard-phases))
(system (%current-system))
(imported-modules '((guix build cmake-build-system)
(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."
(define builder
`(begin
(use-modules ,@modules)
(cmake-build #:source ,(if (and source (derivation-path? source))
(derivation-path->output-path source)
source)
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:patches ,patches
#:patch-flags ,patch-flags
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
#:path-exclusions ,path-exclusions
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
((and (? string?) (? derivation-path?))
guile)
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages base)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(let ((cmake (package-derivation store cmake system)))
(build-expression->derivation store name system
builder
`(,@(if source
`(("source" ,source))
'())
("cmake" ,cmake)
,@inputs
;; Keep the standard inputs of
;; `gnu-build-system'.
,@(standard-inputs system))
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
(define cmake-build-system
(build-system (name 'cmake)
(description "The standard CMake build system")
(build cmake-build)))
;;; cmake.scm ends here

63
guix/build/cmake-build-system.scm 100644
View File

@ -0,0 +1,63 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build cmake-build-system)
#:use-module ((guix build gnu-build-system)
#:renamer (symbol-prefix-proc 'gnu:))
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:export (%standard-phases
cmake-build))
;; Commentary:
;;
;; Builder-side code of the standard cmake build procedure.
;;
;; Code:
(define* (configure #:key outputs (configure-flags '())
#:allow-other-keys)
"Configure the given package."
(let ((out (assoc-ref outputs "out")))
(if (file-exists? "CMakeLists.txt")
(let ((args `(,(string-append "-DCMAKE_INSTALL_PREFIX=" out)
,@configure-flags)))
(format #t "running 'cmake' with arguments ~s~%" args)
(zero? (apply system* "cmake" args)))
(error "no CMakeLists.txt found"))))
(define* (check #:key (tests? #t) (parallel-tests? #t) (test-target "test")
#:allow-other-keys)
(let ((gnu-check (assoc-ref gnu:%standard-phases 'check)))
(gnu-check #:tests? tests? #:test-target test-target
#:parallel-tests? parallel-tests?)))
(define %standard-phases
;; Everything is as with the GNU Build System except for the `configure'
;; and 'check' phases.
(alist-replace 'configure configure
(alist-replace 'check check
gnu:%standard-phases)))
(define* (cmake-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))
;;; cmake-build-system.scm ends here

129
guix/derivations.scm
View File

@ -235,6 +235,32 @@ DRV and not already available in STORE, recursively."
(hash-set! cache file drv) (hash-set! cache file drv)
drv)))))) drv))))))
(define-inlinable (write-sequence lst write-item port)
;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
;; comma.
(match lst
(()
#t)
((prefix (... ...) last)
(for-each (lambda (item)
(write-item item port)
(display "," port))
prefix)
(write-item last port))))
(define-inlinable (write-list lst write-item port)
;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
;; element.
(display "[" port)
(write-sequence lst write-item port)
(display "]" port))
(define-inlinable (write-tuple lst write-item port)
;; Same, but write LST as a tuple.
(display "(" port)
(write-sequence lst write-item port)
(display ")" port))
(define (write-derivation drv port) (define (write-derivation drv port)
"Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of "Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of
Eelco Dolstra's PhD dissertation for an overview of a previous version of Eelco Dolstra's PhD dissertation for an overview of a previous version of
@ -243,11 +269,8 @@ that form."
;; Make sure we're using the faster implementation. ;; Make sure we're using the faster implementation.
(define format simple-format) (define format simple-format)
(define (list->string lst) (define (write-string-list lst)
(string-append "[" (string-join lst ",") "]")) (write-list lst write port))
(define (write-list lst)
(display (list->string lst) port))
(define (coalesce-duplicate-inputs inputs) (define (coalesce-duplicate-inputs inputs)
;; Return a list of inputs, such that when INPUTS contains the same DRV ;; Return a list of inputs, such that when INPUTS contains the same DRV
@ -272,6 +295,34 @@ that form."
'() '()
inputs)) inputs))
(define (write-output output port)
(match output
((name . ($ <derivation-output> path hash-algo hash))
(write-tuple (list name path
(or (and=> hash-algo symbol->string) "")
(or (and=> hash bytevector->base16-string)
""))
write
port))))
(define (write-input input port)
(match input
(($ <derivation-input> path sub-drvs)
(display "(" port)
(write path port)
(display "," port)
(write-string-list (sort sub-drvs string<?))
(display ")" port))))
(define (write-env-var env-var port)
(match env-var
((name . value)
(display "(" port)
(write name port)
(display "," port)
(write value port)
(display ")" port))))
;; Note: lists are sorted alphabetically, to conform with the behavior of ;; Note: lists are sorted alphabetically, to conform with the behavior of
;; C++ `std::map' in Nix itself. ;; C++ `std::map' in Nix itself.
@ -279,37 +330,28 @@ that form."
(($ <derivation> outputs inputs sources (($ <derivation> outputs inputs sources
system builder args env-vars) system builder args env-vars)
(display "Derive(" port) (display "Derive(" port)
(write-list (map (match-lambda (write-list (sort outputs
((name . ($ <derivation-output> path hash-algo hash)) (lambda (o1 o2)
(format #f "(~s,~s,~s,~s)" (string<? (car o1) (car o2))))
name path write-output
(or (and=> hash-algo symbol->string) "") port)
(or (and=> hash bytevector->base16-string)
""))))
(sort outputs
(lambda (o1 o2)
(string<? (car o1) (car o2))))))
(display "," port) (display "," port)
(write-list (map (match-lambda (write-list (sort (coalesce-duplicate-inputs inputs)
(($ <derivation-input> path sub-drvs) (lambda (i1 i2)
(format #f "(~s,~a)" path (string<? (derivation-input-path i1)
(list->string (map object->string (derivation-input-path i2))))
(sort sub-drvs string<?)))))) write-input
(sort (coalesce-duplicate-inputs inputs) port)
(lambda (i1 i2)
(string<? (derivation-input-path i1)
(derivation-input-path i2))))))
(display "," port) (display "," port)
(write-list (map object->string (sort sources string<?))) (write-string-list (sort sources string<?))
(format port ",~s,~s," system builder) (format port ",~s,~s," system builder)
(write-list (map object->string args)) (write-string-list args)
(display "," port) (display "," port)
(write-list (map (match-lambda (write-list (sort env-vars
((name . value) (lambda (e1 e2)
(format #f "(~s,~s)" name value))) (string<? (car e1) (car e2))))
(sort env-vars write-env-var
(lambda (e1 e2) port)
(string<? (car e1) (car e2))))))
(display ")" port)))) (display ")" port))))
(define derivation-path->output-path (define derivation-path->output-path
@ -699,14 +741,21 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
(unsetenv "LD_LIBRARY_PATH"))) (unsetenv "LD_LIBRARY_PATH")))
(builder (add-text-to-store store (builder (add-text-to-store store
(string-append name "-guile-builder") (string-append name "-guile-builder")
(string-append
(object->string prologue) ;; Explicitly use UTF-8 for determinism,
(object->string ;; and also because UTF-8 output is faster.
`(exit (with-fluids ((%default-port-encoding
,(match exp "UTF-8"))
((_ ...) (call-with-output-string
(remove module-form? exp)) (lambda (port)
(_ `(,exp)))))) (write prologue port)
(write
`(exit
,(match exp
((_ ...)
(remove module-form? exp))
(_ `(,exp))))
port))))
;; The references don't really matter ;; The references don't really matter
;; since the builder is always used in ;; since the builder is always used in

6
guix/download.scm
View File

@ -43,7 +43,6 @@
"http://ftpmirror.gnu.org/" "http://ftpmirror.gnu.org/"
"ftp://ftp.cs.tu-berlin.de/pub/gnu/" "ftp://ftp.cs.tu-berlin.de/pub/gnu/"
"ftp://ftp.chg.ru/pub/gnu/"
"ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/" "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/"
;; This one is the master repository, and thus it's always ;; This one is the master repository, and thus it's always
@ -67,6 +66,11 @@
"ftp://trumpetti.atm.tut.fi/gcrypt/" "ftp://trumpetti.atm.tut.fi/gcrypt/"
"ftp://mirror.cict.fr/gnupg/" "ftp://mirror.cict.fr/gnupg/"
"ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/") "ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/")
(gnome
"http://ftp.belnet.be/ftp.gnome.org/"
"http://ftp.linux.org.uk/mirrors/ftp.gnome.org/"
"http://ftp.gnome.org/pub/GNOME/"
"http://mirror.yandex.ru/mirrors/ftp.gnome.org/")
(savannah (savannah
"http://download.savannah.gnu.org/releases/" "http://download.savannah.gnu.org/releases/"
"ftp://ftp.twaren.net/Unix/NonGNU/" "ftp://ftp.twaren.net/Unix/NonGNU/"

225
guix/gnu-maintenance.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +22,7 @@
#:use-module (web client) #:use-module (web client)
#:use-module (web response) #:use-module (web response)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
@ -29,7 +30,23 @@
#:use-module (system foreign) #:use-module (system foreign)
#:use-module (guix ftp-client) #:use-module (guix ftp-client)
#:use-module (guix utils) #:use-module (guix utils)
#:export (official-gnu-packages #:use-module (guix packages)
#:export (gnu-package-name
gnu-package-mundane-name
gnu-package-copyright-holder
gnu-package-savannah
gnu-package-fsd
gnu-package-language
gnu-package-logo
gnu-package-doc-category
gnu-package-doc-summary
gnu-package-doc-urls
gnu-package-download-url
official-gnu-packages
find-packages
gnu-package?
releases releases
latest-release latest-release
gnu-package-name->name+version)) gnu-package-name->name+version))
@ -47,16 +64,32 @@
;;; ;;;
(define (http-fetch uri) (define (http-fetch uri)
"Return a string containing the textual data at URI, a string." "Return an input port containing the textual data at URI, a string."
(let*-values (((resp data) (let*-values (((resp data)
(http-get (string->uri uri))) (http-get (string->uri uri)))
((code) ((code)
(response-code resp))) (response-code resp)))
(case code (case code
((200) ((200)
data) (cond ((string<=? (version) "2.0.5")
(begin
;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
;; encoding, which is required when fetching %PACKAGE-LIST-URL
;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
;; Since users may still be using these versions, warn them and
;; bail out.
(format (current-error-port)
"warning: using Guile ~a, ~a ~s encoding~%"
(version)
"which does not support HTTP"
(response-transfer-encoding resp))
(error "download failed; use a newer Guile"
uri resp)))
((string<=? (version) "2.0.7")
(open-input-string data))
(else data)))
(else (else
(error "download failed:" uri code (error "download failed" uri code
(response-reason-phrase resp)))))) (response-reason-phrase resp))))))
(define %package-list-url (define %package-list-url
@ -64,16 +97,114 @@
"viewvc/*checkout*/gnumaint/" "viewvc/*checkout*/gnumaint/"
"gnupackages.txt?root=womb")) "gnupackages.txt?root=womb"))
(define (official-gnu-packages) (define-record-type* <gnu-package-descriptor>
"Return a list of GNU packages." gnu-package-descriptor
(define %package-line-rx make-gnu-package-descriptor
(make-regexp "^package: (.+)$"))
gnu-package-descriptor?
(name gnu-package-name)
(mundane-name gnu-package-mundane-name)
(copyright-holder gnu-package-copyright-holder)
(savannah gnu-package-savannah)
(fsd gnu-package-fsd)
(language gnu-package-language)
(logo gnu-package-logo)
(doc-category gnu-package-doc-category)
(doc-summary gnu-package-doc-summary)
(doc-urls gnu-package-doc-urls)
(download-url gnu-package-download-url))
(define (official-gnu-packages)
"Return a list of records, which are GNU packages."
(define (group-package-fields port state)
;; Return a list of alists. Each alist contains fields of a GNU
;; package.
(let ((line (read-line port))
(field-rx (make-regexp "^([[:graph:]]+): (.*)$"))
(doc-urls-rx (make-regexp "^doc-url: (.*)$"))
(end-rx (make-regexp "^# End. .+Do not remove this line.+")))
(define (match-field str)
;; Packages are separated by empty strings. If STR is an
;; empty string, create a new list to store fields of a
;; different package. Otherwise, match and create a key-value
;; pair.
(match str
(""
(group-package-fields port (cons '() state)))
(str
(cond ((regexp-exec doc-urls-rx str)
=>
(lambda (match)
(if (equal? (assoc-ref (first state) "doc-urls") #f)
(group-package-fields
port (cons (cons (cons "doc-urls"
(list
(match:substring match 1)))
(first state))
(drop state 1)))
(group-package-fields
port (cons (cons (cons "doc-urls"
(cons (match:substring match 1)
(assoc-ref (first state)
"doc-urls")))
(assoc-remove! (first state)
"doc-urls"))
(drop state 1))))))
((regexp-exec field-rx str)
=>
(lambda (match)
(group-package-fields
port (cons (cons (cons (match:substring match 1)
(match:substring match 2))
(first state))
(drop state 1)))))
(else (group-package-fields port state))))))
(if (or (eof-object? line)
(regexp-exec end-rx line)) ; don't include dummy fields
(remove null-list? state)
(match-field line))))
(define (alist->record alist make keys)
;; Apply MAKE, which should be a syntactic constructor, to the
;; values associated with KEYS in ALIST.
(let ((args (map (cut assoc-ref alist <>) keys)))
(apply make args)))
(reverse
(map (lambda (alist)
(alist->record alist
make-gnu-package-descriptor
(list "package" "mundane-name" "copyright-holder"
"savannah" "fsd" "language" "logo"
"doc-category" "doc-summary" "doc-urls"
"download-url")))
(group-package-fields (http-fetch %package-list-url)
'(())))))
(define (find-packages regexp)
"Find GNU packages which satisfy REGEXP."
(let ((name-rx (make-regexp regexp)))
(filter (lambda (package)
(false-if-exception
(regexp-exec name-rx (gnu-package-name package))))
(official-gnu-packages))))
(define gnu-package?
(memoize
(lambda (package)
"Return true if PACKAGE is a GNU package. This procedure may access the
network to check in GNU's database."
;; TODO: Find a way to determine that a package is non-GNU without going
;; through the network.
(let ((url (and=> (package-source package) origin-uri))
(name (package-name package)))
(or (and (string? url) (string-prefix? "mirror://gnu" url))
(and (member name (map gnu-package-name (official-gnu-packages)))
#t))))))
(let ((lst (string-split (http-fetch %package-list-url) #\nl)))
(filter-map (lambda (line)
(and=> (regexp-exec %package-line-rx line)
(cut match:substring <> 1)))
lst)))
;;; ;;;
;;; Latest release. ;;; Latest release.
@ -119,43 +250,45 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(let ((end (string-contains tarball ".tar"))) (let ((end (string-contains tarball ".tar")))
(substring tarball 0 end))) (substring tarball 0 end)))
(define (release-file file)
;; Return #f if FILE is not a release tarball, otherwise return
;; PACKAGE-VERSION.
(and (not (string-suffix? ".sig" file))
(regexp-exec release-rx file)
(not (regexp-exec alpha-rx file))
(let ((s (sans-extension file)))
(and (regexp-exec %package-name-rx s) s))))
(let-values (((server directory) (ftp-server/directory project))) (let-values (((server directory) (ftp-server/directory project)))
(define conn (ftp-open server)) (define conn (ftp-open server))
(let loop ((directories (list directory)) (let loop ((directories (list directory))
(result '())) (result '()))
(if (null? directories) (match directories
(begin (()
(ftp-close conn) (ftp-close conn)
result) result)
(let* ((directory (car directories)) ((directory rest ...)
(files (ftp-list conn directory)) (let* ((files (ftp-list conn directory))
(subdirs (filter-map (lambda (file) (subdirs (filter-map (match-lambda
(match file ((name 'directory . _) name)
((name 'directory . _) name) (_ #f))
(_ #f))) files)))
files))) (loop (append (map (cut string-append directory "/" <>)
(loop (append (map (cut string-append directory "/" <>) subdirs)
subdirs) rest)
(cdr directories)) (append
(append ;; Filter out signatures, deltas, and files which
;; Filter out signatures, deltas, and files which ;; are potentially not releases of PROJECT--e.g.,
;; are potentially not releases of PROJECT--e.g., ;; in /gnu/guile, filter out guile-oops and
;; in /gnu/guile, filter out guile-oops and ;; guile-www; in mit-scheme, filter out binaries.
;; guile-www; in mit-scheme, filter out binaries. (filter-map (match-lambda
(filter-map (lambda (file) ((file 'file . _)
(match file (and=> (release-file file)
((file 'file . _) (cut cons <> directory)))
(and (not (string-suffix? ".sig" file)) (_ #f))
(regexp-exec release-rx file) files)
(not (regexp-exec alpha-rx file)) result))))))))
(let ((s (sans-extension file)))
(and (regexp-exec
%package-name-rx s)
(cons s directory)))))
(_ #f)))
files)
result)))))))
(define (latest-release project) (define (latest-release project)
"Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."

12
guix/licenses.scm
View File

@ -39,7 +39,7 @@
psfl public-domain psfl public-domain
qpl qpl
vim vim
x11 x11 x11-style
zlib zlib
fsf-free)) fsf-free))
@ -236,6 +236,16 @@ which may be a file:// URI pointing the package's tree."
"http://directory.fsf.org/wiki/License:X11" "http://directory.fsf.org/wiki/License:X11"
"https://www.gnu.org/licenses/license-list#X11License")) "https://www.gnu.org/licenses/license-list#X11License"))
(define* (x11-style uri #:optional (comment ""))
"Return an X11-style license, whose full text can be found at URI,
which may be a file:// URI pointing the package's tree."
(license "X11-style"
uri
(string-append
"This is an X11-style, non-copyleft free software license. "
"Check the URI for details. "
comment)))
(define zlib (define zlib
(license "Zlib" (license "Zlib"
"http://www.gzip.org/zlib/zlib_license.html" "http://www.gzip.org/zlib/zlib_license.html"

2
guix/packages.scm
View File

@ -135,7 +135,7 @@ representation."
(synopsis package-synopsis) ; one-line description (synopsis package-synopsis) ; one-line description
(description package-description) ; one or two paragraphs (description package-description) ; one or two paragraphs
(license package-license (default '())) (license package-license)
(home-page package-home-page) (home-page package-home-page)
(platforms package-platforms (default '())) (platforms package-platforms (default '()))
(maintainers package-maintainers (default '())) (maintainers package-maintainers (default '()))

47
guix/scripts/download.scm
View File

@ -110,26 +110,27 @@ and the hash of its contents.\n"))
(alist-cons 'argument arg result)) (alist-cons 'argument arg result))
%default-options)) %default-options))
(let* ((opts (parse-options)) (with-error-handling
(store (open-connection)) (let* ((opts (parse-options))
(arg (assq-ref opts 'argument)) (store (open-connection))
(uri (or (string->uri arg) (arg (assq-ref opts 'argument))
(leave (_ "guix-download: ~a: failed to parse URI~%") (uri (or (string->uri arg)
arg))) (leave (_ "guix-download: ~a: failed to parse URI~%")
(path (case (uri-scheme uri) arg)))
((file) (path (case (uri-scheme uri)
(add-to-store store (basename (uri-path uri)) ((file)
#f "sha256" (uri-path uri))) (add-to-store store (basename (uri-path uri))
(else #f "sha256" (uri-path uri)))
(fetch-and-store store (else
(cut url-fetch arg <> (fetch-and-store store
#:mirrors %mirrors) (cut url-fetch arg <>
(basename (uri-path uri)))))) #:mirrors %mirrors)
(hash (call-with-input-file (basename (uri-path uri))))))
(or path (hash (call-with-input-file
(leave (_ "guix-download: ~a: download failed~%") (or path
arg)) (leave (_ "guix-download: ~a: download failed~%")
(compose sha256 get-bytevector-all))) arg))
(fmt (assq-ref opts 'format))) (compose sha256 get-bytevector-all)))
(format #t "~a~%~a~%" path (fmt hash)) (fmt (assq-ref opts 'format)))
#t)) (format #t "~a~%~a~%" path (fmt hash))
#t)))

87
guix/scripts/package.scm
View File

@ -39,6 +39,7 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (guile-final)) #:use-module ((gnu packages base) #:select (guile-final))
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
#:use-module (guix gnu-maintenance)
#:export (guix-package)) #:export (guix-package))
(define %store (define %store
@ -266,6 +267,47 @@ matching packages."
(assoc-ref (derivation-outputs drv) sub-drv)))) (assoc-ref (derivation-outputs drv) sub-drv))))
`(,name ,out)))))) `(,name ,out))))))
(define-syntax-rule (waiting exp fmt rest ...)
"Display the given message while EXP is being evaluated."
(let* ((message (format #f fmt rest ...))
(blank (make-string (string-length message) #\space)))
(display message (current-error-port))
(force-output (current-error-port))
(let ((result exp))
;; Clear the line.
(display #\cr (current-error-port))
(display blank (current-error-port))
(display #\cr (current-error-port))
(force-output (current-error-port))
exp)))
(define (check-package-freshness package)
"Check whether PACKAGE has a newer version available upstream, and report
it."
;; TODO: Automatically inject the upstream version when desired.
(catch #t
(lambda ()
(when (false-if-exception (gnu-package? package))
(let ((name (package-name package))
(full-name (package-full-name package)))
(match (waiting (latest-release name)
(_ "looking for the latest release of GNU ~a...") name)
((latest-version . _)
(when (version>? latest-version full-name)
(format (current-error-port)
(_ "~a: note: using ~a \
but ~a is available upstream~%")
(location->string (package-location package))
full-name latest-version)))
(_ #t)))))
(lambda (key . args)
;; Silently ignore networking errors rather than preventing
;; installation.
(case key
((getaddrinfo-error ftp-error) #f)
(else (apply throw key args))))))
;;; ;;;
;;; Command-line options. ;;; Command-line options.
@ -510,6 +552,44 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
,path ,path
,(canonicalize-deps deps)))) ,(canonicalize-deps deps))))
(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)
(let ((len (length name))
(remove (map (cut format #f " ~a-~a\t~a" <> <> <>)
name version path)))
(if dry-run?
(format (current-error-port)
(N_ "The following package would be removed:~% ~{~a~%~}~%"
"The following packages would be removed:~% ~{~a~%~}~%"
len)
remove)
(format (current-error-port)
(N_ "The following package will be removed:~% ~{~a~%~}~%"
"The following packages will be removed:~% ~{~a~%~}~%"
len)
remove))))
(_ #f))
(match install
(((name version _ path _) ..1)
(let ((len (length name))
(install (map (cut format #f " ~a-~a\t~a" <> <> <>)
name version path)))
(if dry-run?
(format (current-error-port)
(N_ "The following package would be installed:~% ~{~a~%~}~%"
"The following packages would be installed:~% ~{~a~%~}~%"
len)
install)
(format (current-error-port)
(N_ "The following package will be installed:~% ~{~a~%~}~%"
"The following packages will be installed:~% ~{~a~%~}~%"
len)
install))))
(_ #f)))
;; First roll back if asked to. ;; First roll back if asked to.
(if (and (assoc-ref opts 'roll-back?) (not dry-run?)) (if (and (assoc-ref opts 'roll-back?) (not dry-run?))
(begin (begin
@ -547,6 +627,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
((name version sub-drv ((name version sub-drv
(? package? package) (? package? package)
(deps ...)) (deps ...))
(check-package-freshness package)
(package-derivation (%store) package)) (package-derivation (%store) package))
(_ #f)) (_ #f))
install)) install))
@ -576,6 +657,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
package) package)
(_ #f)) (_ #f))
opts)) opts))
(remove* (filter-map (cut assoc <> installed) remove))
(packages (append install* (packages (append install*
(fold (lambda (package result) (fold (lambda (package result)
(match package (match package
@ -587,6 +669,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
(show-what-to-remove/install remove* install* dry-run?)
(show-what-to-build (%store) drv dry-run?) (show-what-to-build (%store) drv dry-run?)
(or dry-run? (or dry-run?
@ -669,8 +752,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(let ((opts (parse-options))) (let ((opts (parse-options)))
(or (process-query opts) (or (process-query opts)
(parameterize ((%store (open-connection))) (with-error-handling
(with-error-handling (parameterize ((%store (open-connection)))
(parameterize ((%guile-for-build (parameterize ((%guile-for-build
(package-derivation (%store) (package-derivation (%store)
(if (assoc-ref opts 'bootstrap?) (if (assoc-ref opts 'bootstrap?)

6
guix/scripts/pull.scm
View File

@ -194,9 +194,9 @@ Download and deploy the latest version of Guix.\n"))
(leave (_ "~A: unexpected argument~%") arg)) (leave (_ "~A: unexpected argument~%") arg))
%default-options)) %default-options))
(let ((opts (parse-options)) (with-error-handling
(store (open-connection))) (let ((opts (parse-options))
(with-error-handling (store (open-connection)))
(let ((tarball (download-and-store store))) (let ((tarball (download-and-store store)))
(unless tarball (unless tarball
(leave (_ "failed to download up-to-date source, exiting\n"))) (leave (_ "failed to download up-to-date source, exiting\n")))

11
guix/snix.scm
View File

@ -277,7 +277,7 @@ ATTRIBUTE is true, only that attribute is considered."
%nix-instantiate "--strict" "--eval-only" "--xml" %nix-instantiate "--strict" "--eval-only" "--xml"
;; Pass a dummy `crossSystem' argument so that `buildInputs' and ;; Pass a dummy `crossSystem' argument so that `buildInputs' and
;; `buildNativeInputs' are not coalesced. ;; `nativeBuildInputs' are not coalesced.
;; XXX: This is hacky and has other problems. ;; XXX: This is hacky and has other problems.
;"--arg" "crossSystem" cross-system ;"--arg" "crossSystem" cross-system
@ -423,12 +423,15 @@ location of DERIVATION."
(build-system gnu-build-system) (build-system gnu-build-system)
;; When doing a native Nixpkgs build, `buildInputs' is empty and ;; When doing a native Nixpkgs build, `buildInputs' is empty and
;; everything is in `buildNativeInputs'. So we can't distinguish ;; everything is in `nativeBuildInputs'. So we can't distinguish
;; between both, here. ;; between both, here.
;;
;; Note that `nativeBuildInputs' was renamed from
;; `buildNativeInputs' in Nixpkgs sometime around March 2013.
,@(maybe-inputs 'inputs ,@(maybe-inputs 'inputs
(convert-inputs "buildNativeInputs")) (convert-inputs "nativeBuildInputs"))
,@(maybe-inputs 'propagated-inputs ,@(maybe-inputs 'propagated-inputs
(convert-inputs "propagatedBuildNativeInputs")) (convert-inputs "propagatedNativeBuildInputs"))
(home-page ,(and=> (find-attribute-by-name "homepage" meta) (home-page ,(and=> (find-attribute-by-name "homepage" meta)
attribute-value)) attribute-value))

50
guix/store.scm
View File

@ -39,6 +39,9 @@
nix-server-socket nix-server-socket
&nix-error nix-error? &nix-error nix-error?
&nix-connection-error nix-connection-error?
nix-connection-error-file
nix-connection-error-code
&nix-protocol-error nix-protocol-error? &nix-protocol-error nix-protocol-error?
nix-protocol-error-message nix-protocol-error-message
nix-protocol-error-status nix-protocol-error-status
@ -231,8 +234,19 @@
(define write-store-path-list write-string-list) (define write-store-path-list write-string-list)
(define read-store-path-list read-string-list) (define read-store-path-list read-string-list)
(define (write-contents file p) (define (write-contents file p size)
"Write the contents of FILE to output port P." "Write SIZE bytes from FILE to output port P."
(define (call-with-binary-input-file file proc)
;; Open FILE as a binary file. This avoids scan-for-encoding, and thus
;; avoids any initial buffering. Disable file name canonicalization to
;; avoid stat'ing like crazy.
(with-fluids ((%file-port-name-canonicalization #f))
(let ((port (open-file file "rb")))
(catch #t (cut proc port)
(lambda args
(close-port port)
(apply throw args))))))
(define (dump in size) (define (dump in size)
(define buf-size 65536) (define buf-size 65536)
(define buf (make-bytevector buf-size)) (define buf (make-bytevector buf-size))
@ -247,13 +261,14 @@
(put-bytevector p buf 0 read) (put-bytevector p buf 0 read)
(loop (- left read)))))))) (loop (- left read))))))))
(let ((size (stat:size (lstat file)))) (write-string "contents" p)
(write-string "contents" p) (write-long-long size p)
(write-long-long size p) (call-with-binary-input-file file
(call-with-input-file file ;; Use `sendfile' when available (Guile 2.0.8+).
(lambda (p) (if (compile-time-value (defined? 'sendfile))
(dump p size))) (cut sendfile p <> size 0)
(write-padding size p))) (cut dump <> size)))
(write-padding size p))
(define (write-file f p) (define (write-file f p)
(define %archive-version-1 "nix-archive-1") (define %archive-version-1 "nix-archive-1")
@ -271,7 +286,7 @@
(begin (begin
(write-string "executable" p) (write-string "executable" p)
(write-string "" p))) (write-string "" p)))
(write-contents f p)) (write-contents f p (stat:size s)))
((directory) ((directory)
(write-string "type" p) (write-string "type" p)
(write-string "directory" p) (write-string "directory" p)
@ -373,6 +388,11 @@
(define-condition-type &nix-error &error (define-condition-type &nix-error &error
nix-error?) nix-error?)
(define-condition-type &nix-connection-error &nix-error
nix-connection-error?
(file nix-connection-error-file)
(errno nix-connection-error-code))
(define-condition-type &nix-protocol-error &nix-error (define-condition-type &nix-protocol-error &nix-error
nix-protocol-error? nix-protocol-error?
(message nix-protocol-error-message) (message nix-protocol-error-message)
@ -392,7 +412,15 @@ operate, should the disk become full. Return a server object."
;; Enlarge the receive buffer. ;; Enlarge the receive buffer.
(setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
(connect s a) (catch 'system-error
(cut connect s a)
(lambda args
;; Translate the error to something user-friendly.
(let ((errno (system-error-errno args)))
(raise (condition (&nix-connection-error
(file file)
(errno errno)))))))
(write-int %worker-magic-1 s) (write-int %worker-magic-1 s)
(let ((r (read-int s))) (let ((r (read-int s)))
(and (eqv? r %worker-magic-2) (and (eqv? r %worker-magic-2)

4
guix/ui.scm
View File

@ -111,6 +111,10 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%") (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
file line column file line column
(package-full-name package) input))) (package-full-name package) input)))
((nix-connection-error? c)
(leave (_ "error: failed to connect to `~a': ~a~%")
(nix-connection-error-file c)
(strerror (nix-connection-error-code c))))
((nix-protocol-error? c) ((nix-protocol-error? c)
;; FIXME: Server-provided error messages aren't i18n'd. ;; FIXME: Server-provided error messages aren't i18n'd.
(leave (_ "error: build failed: ~a~%") (leave (_ "error: build failed: ~a~%")

17
hydra.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +21,21 @@
;;; tool. ;;; tool.
;;; ;;;
;; Attempt to use our very own Guix modules.
(eval-when (compile load eval)
;; Ignore any available .go, and force recompilation. This is because our
;; checkout in the store has mtime set to the epoch, and thus .go files look
;; newer, even though they may not correspond.
(set! %fresh-auto-compile #t)
(and=> (assoc-ref (current-source-location) 'filename)
(lambda (file)
(let ((dir (dirname file)))
(format (current-error-port) "prepending ~s to the load path~%"
dir)
(set! %load-path (cons dir %load-path))))))
(use-modules (guix store) (use-modules (guix store)
(guix packages) (guix packages)
((guix utils) #:select (%current-system)) ((guix utils) #:select (%current-system))

29
release.nix
View File

@ -42,12 +42,23 @@ let
if builtins.isAttrs drv if builtins.isAttrs drv
then pkgs.lib.overrideDerivation (pythonKludge drv) (args: { then pkgs.lib.overrideDerivation (pythonKludge drv) (args: {
__noChroot = true; __noChroot = true;
buildNativeInputs = map unchroot args.buildNativeInputs; nativeBuildInputs = map unchroot args.nativeBuildInputs;
propagatedBuildNativeInputs = propagatedNativeBuildInputs =
map unchroot args.propagatedBuildNativeInputs; map unchroot args.propagatedNativeBuildInputs;
}) })
else drv; else drv;
# Return a Nixpkgs with some derivations "unchrooted".
unchrootedNixpkgs = system:
import nixpkgs {
# XXX: Hack to make sure these ones also get "unchrooted".
config.packageOverrides = pkgs: {
zlib = unchroot pkgs.zlib;
libunistring = unchroot pkgs.libunistring;
};
inherit system;
};
# The Guile used to bootstrap the whole thing. It's normally # The Guile used to bootstrap the whole thing. It's normally
# downloaded by the build system, but here we download it via a # downloaded by the build system, but here we download it via a
# fixed-output derivation and stuff it into the build tree. # fixed-output derivation and stuff it into the build tree.
@ -67,7 +78,7 @@ let
jobs = { jobs = {
tarball = tarball =
unchroot unchroot
(let pkgs = import nixpkgs {}; in (let pkgs = unchrootedNixpkgs builtins.currentSystem; in
pkgs.releaseTools.sourceTarball { pkgs.releaseTools.sourceTarball {
name = "guix-tarball"; name = "guix-tarball";
src = <guix>; src = <guix>;
@ -82,7 +93,7 @@ let
in in
[ git_light ] ++ [ git_light ] ++
(with pkgs; [ guile sqlite bzip2 libgcrypt ]); (with pkgs; [ guile sqlite bzip2 libgcrypt ]);
buildNativeInputs = with pkgs; [ texinfo gettext cvs pkgconfig ]; nativeBuildInputs = with pkgs; [ texinfo gettext cvs pkgconfig ];
preAutoconf = ''git config submodule.nix.url "${<nix>}"''; preAutoconf = ''git config submodule.nix.url "${<nix>}"'';
configureFlags = configureFlags =
[ "--with-libgcrypt-prefix=${pkgs.libgcrypt}" [ "--with-libgcrypt-prefix=${pkgs.libgcrypt}"
@ -94,11 +105,11 @@ let
{ system ? builtins.currentSystem }: { system ? builtins.currentSystem }:
unchroot unchroot
(let pkgs = import nixpkgs { inherit system; }; in (let pkgs = unchrootedNixpkgs system; in
pkgs.releaseTools.nixBuild { pkgs.releaseTools.nixBuild {
name = "guix"; name = "guix";
buildInputs = with pkgs; [ guile sqlite bzip2 libgcrypt ]; buildInputs = with pkgs; [ guile sqlite bzip2 libgcrypt ];
buildNativeInputs = [ pkgs.pkgconfig ]; nativeBuildInputs = [ pkgs.pkgconfig ];
src = jobs.tarball; src = jobs.tarball;
configureFlags = configureFlags =
[ "--with-libgcrypt-prefix=${pkgs.libgcrypt}" [ "--with-libgcrypt-prefix=${pkgs.libgcrypt}"
@ -125,7 +136,7 @@ let
unchroot unchroot
(let (let
pkgs = import nixpkgs { inherit system; }; pkgs = unchrootedNixpkgs system;
build = jobs.build { inherit system; }; build = jobs.build { inherit system; };
in in
pkgs.lib.overrideDerivation build ({ configureFlags, ... }: { pkgs.lib.overrideDerivation build ({ configureFlags, ... }: {
@ -144,7 +155,7 @@ let
{ system ? builtins.currentSystem }: { system ? builtins.currentSystem }:
let let
pkgs = import nixpkgs { inherit system; }; pkgs = unchrootedNixpkgs system;
guix = jobs.build { inherit system; }; guix = jobs.build { inherit system; };
in in
# XXX: We have no way to tell the Nix code to swallow the .drv # XXX: We have no way to tell the Nix code to swallow the .drv

2
tests/packages.scm
View File

@ -49,7 +49,7 @@
(package (name name*) (version "0") (source #f) (package (name name*) (version "0") (source #f)
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis #f) (description #f) (synopsis #f) (description #f)
(home-page #f) (home-page #f) (license #f)
extra-fields ...)) extra-fields ...))
(test-assert "package-transitive-inputs" (test-assert "package-transitive-inputs"