diff --git a/Makefile.am b/Makefile.am index d87e6e0572..c9dcc4a356 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,12 +39,14 @@ MODULES = \ guix/licenses.scm \ guix/build-system.scm \ guix/build-system/gnu.scm \ + guix/build-system/perl.scm \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ guix/store.scm \ guix/ui.scm \ guix/build/download.scm \ guix/build/gnu-build-system.scm \ + guix/build/perl-build-system.scm \ guix/build/utils.scm \ guix/build/union.scm \ guix/packages.scm \ @@ -99,6 +101,7 @@ MODULES = \ gnu/packages/ld-wrapper.scm \ gnu/packages/less.scm \ gnu/packages/libapr.scm \ + gnu/packages/libdaemon.scm \ gnu/packages/libevent.scm \ gnu/packages/libffi.scm \ gnu/packages/libidn.scm \ @@ -158,6 +161,7 @@ MODULES = \ gnu/packages/tmux.scm \ gnu/packages/tor.scm \ gnu/packages/vim.scm \ + gnu/packages/vpn.scm \ gnu/packages/wdiff.scm \ gnu/packages/wget.scm \ gnu/packages/which.scm \ @@ -216,7 +220,8 @@ dist_patch_DATA = \ gnu/packages/patches/shishi-gets-undeclared.patch \ gnu/packages/patches/tar-gets-undeclared.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 bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux diff --git a/doc/guix.texi b/doc/guix.texi index 6a9ebab1f6..a07c277e70 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -514,6 +514,19 @@ 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 also been explicitly installed independently. +@item --install-from-expression=@var{exp} +@itemx -e @var{exp} +Install the package @var{exp} evaluates to. + +@var{exp} must be a Scheme expression that evaluates to a +@code{} object. This option is notably useful to disambiguate +between same-named variants of a package, with expressions such as +@code{(@@ (gnu packages base) guile-final)}. + +Note that this option installs the first output of the specified +package, which may be insufficient when needing a specific output of a +multiple-output package. + @item --remove=@var{package} @itemx -r @var{package} Remove @var{package}. @@ -657,6 +670,18 @@ store---i.e., files and directories no longer reachable from any root. @item --list-live Show the list of live store files and directories. + +@end table + +In addition, the references among existing store files can be queried: + +@table @code + +@item --references +@itemx --referrers +List the references (respectively, the referrers) of store files given +as arguments. + @end table diff --git a/gnu/packages/global.scm b/gnu/packages/global.scm index b604ab6478..6ef36d5aea 100644 --- a/gnu/packages/global.scm +++ b/gnu/packages/global.scm @@ -28,15 +28,14 @@ (define-module (gnu packages global) (define-public global ; a global variable (package (name "global") - (version "6.2.7") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://gnu/global/global-" - version ".tar.gz")) - (sha256 - (base32 - "1dr250kz65wqpbms4lhz857mzmvmpmiaxgyqxvxkb4b0s840i14i")))) + (version "6.2.8") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/global/global-" + version ".tar.gz")) + (sha256 + (base32 + "1l6g51kff5010gwmw08jbks1mssgddz7wggjvfsky3g000jkpvf1")))) (build-system gnu-build-system) (inputs `(("ncurses" ,ncurses) ("libtool" ,libtool))) diff --git a/gnu/packages/libdaemon.scm b/gnu/packages/libdaemon.scm new file mode 100644 index 0000000000..0c77e280ac --- /dev/null +++ b/gnu/packages/libdaemon.scm @@ -0,0 +1,61 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu packages libdaemon) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu)) + +(define-public libdaemon + (package + (name "libdaemon") + (version "0.14") + (source (origin + (method url-fetch) + (uri (string-append + "http://0pointer.de/lennart/projects/libdaemon/libdaemon-" + version + ".tar.gz")) + (sha256 + (base32 + "0d5qlq5ab95wh1xc87rqrh1vx6i8lddka1w3f1zcqvcqdxgyn8zx")))) + (build-system gnu-build-system) + (home-page "http://0pointer.de/lennart/projects/libdaemon/") + (synopsis "Lightweight C library that eases the writing of UNIX daemons") + (description + "libdaemon is a lightweight C library that eases the writing of UNIX +daemons. It consists of the following parts: + + • A wrapper around fork() which does the correct daemonization procedure of + a process + + • A wrapper around syslog() for simpler and compatible log output to Syslog + or STDERR + + • An API for writing PID files + + • An API for serializing UNIX signals into a pipe for usage with select() or + poll() + + • An API for running subprocesses with STDOUT and STDERR redirected to + syslog. + +APIs like these are used in most daemon software available. It is not that +simple to get it done right and code duplication is not a goal.") + (license lgpl2.1+))) diff --git a/gnu/packages/libpng.scm b/gnu/packages/libpng.scm index d351ddcbf7..06facc9a9a 100644 --- a/gnu/packages/libpng.scm +++ b/gnu/packages/libpng.scm @@ -27,15 +27,15 @@ (define-module (gnu packages libpng) (define-public libpng (package (name "libpng") - (version "1.5.13") + (version "1.5.14") (source (origin (method url-fetch) (uri (string-append "http://downloads.sourceforge.net/project/libpng/libpng15/" version "/libpng-" - version ".tar.gz")) + version ".tar.xz")) (sha256 (base32 - "0dbh332qjhm3pa8m4ac73rk7dbbmigbqd3ch084m24ggg9qq4k0d")))) + "0m3vz3gig7s63zanq5b1dgb5ph12qm0cylw4g4fbxlsq3f74hn8l")))) (build-system gnu-build-system) (inputs `(("zlib" ,zlib))) (synopsis "Libpng, a library for handling PNG files") diff --git a/gnu/packages/patches/vpnc-script.patch b/gnu/packages/patches/vpnc-script.patch new file mode 100644 index 0000000000..a0d9481952 --- /dev/null +++ b/gnu/packages/patches/vpnc-script.patch @@ -0,0 +1,15 @@ +This patch adapts the vpnc script to newer kernel versions, see + https://lkml.org/lkml/2011/3/24/645 + +diff -u a/vpnc-script.in b/vpnc-script.in +--- a/vpnc-script.in 2013-03-03 13:55:16.000000000 +0100 ++++ b/vpnc-script.in 2013-03-03 13:56:11.000000000 +0100 +@@ -116,7 +116,7 @@ + + if [ -n "$IPROUTE" ]; then + fix_ip_get_output () { +- sed 's/cache//;s/metric \?[0-9]\+ [0-9]\+//g;s/hoplimit [0-9]\+//g' ++ sed 's/cache//;s/metric \?[0-9]\+ [0-9]\+//g;s/hoplimit [0-9]\+//g;s/ipid 0x....//g' + } + + set_vpngateway_route() { diff --git a/gnu/packages/screen.scm b/gnu/packages/screen.scm index 608e63c7c6..ea1c21716a 100644 --- a/gnu/packages/screen.scm +++ b/gnu/packages/screen.scm @@ -31,7 +31,7 @@ (define-public screen (version "4.0.3") (source (origin (method url-fetch) - (uri (string-append "http://ftp.gnu.org/gnu/screen/screen-" + (uri (string-append "mirror://gnu/screen/screen-" version ".tar.gz")) (sha256 (base32 "0xvckv1ia5pjxk7fs4za6gz2njwmfd54sc464n8ab13096qxbw3q")))) diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm new file mode 100644 index 0000000000..9393e1e7b4 --- /dev/null +++ b/gnu/packages/vpn.scm @@ -0,0 +1,66 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Andreas Enge +;;; +;;; 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 . + +(define-module (gnu packages vpn) + #: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) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages perl)) + +(define-public vpnc + (package + (name "vpnc") + (version "0.5.3") + (source (origin + (method url-fetch) + (uri (string-append "http://www.unix-ag.uni-kl.de/~massar/vpnc/vpnc-" + version ".tar.gz")) + (sha256 (base32 + "1128860lis89g1s21hqxvap2nq426c9j4bvgghncc1zj0ays7kj6")))) + (build-system gnu-build-system) + (inputs `(("libgcrypt" ,libgcrypt) + ("perl" ,perl) + ("patch/script" + ,(search-patch "vpnc-script.patch")))) + (arguments + `(#:tests? #f ; there is no check target + #:patches (list (assoc-ref %build-inputs + "patch/script")) + #:phases + (alist-replace + 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* "Makefile" + (("PREFIX=/usr/local") (string-append "PREFIX=" out))) + (substitute* "Makefile" + (("ETCDIR=/etc/vpnc") (string-append "ETCDIR=" out "/etc/vpnc"))))) + %standard-phases))) + (synopsis "vpnc, a client for cisco vpn concentrators") + (description + "vpnc is a VPN client compatible with Cisco's EasyVPN equipment. +It supports IPSec (ESP) with Mode Configuration and Xauth. It supports only +shared-secret IPSec authentication with Xauth, AES (256, 192, 128), 3DES, +1DES, MD5, SHA1, DH1/2/5 and IP tunneling. It runs entirely in userspace. +Only \"Universal TUN/TAP device driver support\" is needed in the kernel.") + (license license:gpl2+) ; some file are bsd-2, see COPYING + (home-page "http://www.unix-ag.uni-kl.de/~massar/vpnc/"))) diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 1d7060a044..b3c5f7d512 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -26,7 +26,8 @@ (define-module (gnu packages xml) #:renamer (symbol-prefix-proc 'license:)) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu)) + #:use-module (guix build-system gnu) + #:use-module (guix build-system perl)) (define-public expat (package @@ -90,3 +91,34 @@ (define-public libxslt "Libxslt is an XSLT C library developed for the GNOME project. It is based on libxml for XML parsing, tree manipulation and XPath support.") (license license:x11))) + +(define-public perl-xml-parser + (package + (name "perl-xml-parser") + (version "2.41") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://cpan/authors/id/M/MS/MSERGEANT/XML-Parser-" + version ".tar.gz")) + (sha256 + (base32 + "1sadi505g5qmxr36lgcbrcrqh3a5gcdg32b405gnr8k54b6rg0dl")))) + (build-system perl-build-system) + (arguments `(#:make-maker-flags + (let ((expat (assoc-ref %build-inputs "expat"))) + (list (string-append "EXPATLIBPATH=" expat "/lib") + (string-append "EXPATINCPATH=" expat "/include"))))) + (inputs `(("expat" ,expat))) + (license (package-license perl)) + (synopsis "Perl bindings to the Expat XML parsing library") + (description + "This module provides ways to parse XML documents. It is built on top of +XML::Parser::Expat, which is a lower level interface to James Clark's expat +library. Each call to one of the parsing methods creates a new instance of +XML::Parser::Expat which is then used to parse the document. Expat options +may be provided when the XML::Parser object is created. These options are +then passed on to the Expat object on each parse call. They can also be given +as extra arguments to the parse methods, in which case they override options +given at XML::Parser creation time.") + (home-page "http://search.cpan.org/~toddr/XML-Parser-2.41/Parser.pm"))) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 5be4782c2f..8049e7510f 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -21,13 +21,13 @@ (define-module (guix build-system gnu) #: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 (srfi srfi-1) #:use-module (srfi srfi-39) #:use-module (ice-9 match) #:export (gnu-build gnu-build-system + standard-inputs package-with-explicit-inputs package-with-extra-configure-variable static-libgcc-package diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm new file mode 100644 index 0000000000..537c29e799 --- /dev/null +++ b/guix/build-system/perl.scm @@ -0,0 +1,103 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix build-system perl) + #: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 (perl-build + perl-build-system)) + +;; Commentary: +;; +;; Standard build procedure for Perl packages using the "makefile +;; maker"---i.e., "perl Makefile.PL". This is implemented as an extension of +;; `gnu-build-system'. +;; +;; Code: + +(define* (perl-build store name source inputs + #:key + (perl (@ (gnu packages perl) perl)) + (tests? #t) + (make-maker-flags ''()) + (phases '(@ (guix build perl-build-system) + %standard-phases)) + (outputs '("out")) + (system (%current-system)) + (guile #f) + (imported-modules '((guix build perl-build-system) + (guix build gnu-build-system) + (guix build utils))) + (modules '((guix build perl-build-system) + (guix build gnu-build-system) + (guix build utils)))) + "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE +provides a `Makefile.PL' file as its build system." + (define builder + `(begin + (use-modules ,@modules) + (perl-build #:name ,name + #:source ,(if (and source (derivation-path? source)) + (derivation-path->output-path source) + source) + #:make-maker-flags ,make-maker-flags + #:system ,system + #:test-target "test" + #:tests? ,tests? + #:outputs %outputs + #:inputs %build-inputs))) + + (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 ((perl (package-derivation store perl system))) + (build-expression->derivation store name system + builder + `(,@(if source + `(("source" ,source)) + '()) + ("perl" ,perl) + ,@inputs + + ;; Keep the standard inputs of + ;; `gnu-build-system'. + ,@(standard-inputs system)) + + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build))) + +(define perl-build-system + (build-system (name 'perl) + (description "The standard Perl build system") + (build perl-build))) + +;;; perl.scm ends here diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm new file mode 100644 index 0000000000..d625ef3ed6 --- /dev/null +++ b/guix/build/perl-build-system.scm @@ -0,0 +1,61 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix build perl-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 + perl-build)) + +;; Commentary: +;; +;; Builder-side code of the standard Perl package build procedure. +;; +;; Code: + +(define* (configure #:key outputs (make-maker-flags '()) + #:allow-other-keys) + "Configure the given Perl package." + (let ((out (assoc-ref outputs "out"))) + (if (file-exists? "Makefile.PL") + (let ((args `("Makefile.PL" ,(string-append "PREFIX=" out) + "INSTALLDIRS=site" ,@make-maker-flags))) + (format #t "running `perl' with arguments ~s~%" args) + (zero? (apply system* "perl" args))) + (error "no Makefile.PL found")))) + +(define %standard-phases + ;; Everything is as with the GNU Build System except for the `configure' + ;; phase. + (alist-replace 'configure configure + gnu:%standard-phases)) + +(define* (perl-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Perl package, applying all of PHASES in order." + (set-path-environment-variable "PERL5LIB" '("lib/perl5/site_perl") + (match inputs + (((_ . path) ...) + path))) + (apply gnu:gnu-build + #:inputs inputs #:phases phases + args)) + +;;; perl-build-system.scm ends here diff --git a/guix/download.scm b/guix/download.scm index 846c9e1e0b..b6bf6a0822 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge ;;; ;;; This file is part of GNU Guix. ;;; @@ -98,7 +99,51 @@ (define %mirrors "ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/" "http://apache.belnet.be/" "http://mirrors.ircam.fr/pub/apache/" - "http://apache-mirror.rbc.ru/pub/apache/")))) + "http://apache-mirror.rbc.ru/pub/apache/") + (xorg ; from http://www.x.org/wiki/Releases/Download + "http://xorg.freedesktop.org/releases/" ; main mirrors + "http://www.x.org/pub/" + "ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America + "ftp://xorg.mirrors.pair.com/" + "http://mirror.csclub.uwaterloo.ca/x.org/" + "http://xorg.mirrors.pair.com/" + "http://mirror.us.leaseweb.net/xorg/" + "ftp://artfiles.org/x.org/" ; Europe + "ftp://ftp.chg.ru/pub/X11/x.org/" + "ftp://ftp.fu-berlin.de/unix/X11/FTP.X.ORG/" + "ftp://ftp.gwdg.de/pub/x11/x.org/" + "ftp://ftp.mirrorservice.org/sites/ftp.x.org/" + "ftp://ftp.ntua.gr/pub/X11/" + "ftp://ftp.piotrkosoft.net/pub/mirrors/ftp.x.org/" + "ftp://ftp.portal-to-web.de/pub/mirrors/x.org/" + "ftp://ftp.solnet.ch/mirror/x.org/" + "ftp://ftp.sunet.se/pub/X11/" + "ftp://gd.tuwien.ac.at/X11/" + "ftp://mi.mirror.garr.it/mirrors/x.org/" + "ftp://mirror.cict.fr/x.org/" + "ftp://mirror.switch.ch/mirror/X11/" + "ftp://mirrors.ircam.fr/pub/x.org/" + "ftp://x.mirrors.skynet.be/pub/ftp.x.org/" + "ftp://ftp.cs.cuhk.edu.hk/pub/X11" ; East Asia + "ftp://ftp.u-aizu.ac.jp/pub/x11/x.org/" + "ftp://ftp.yz.yamagata-u.ac.jp/pub/X11/x.org/" + "ftp://ftp.kaist.ac.kr/x.org/" + "ftp://mirrors.go-part.com/xorg/" + "http://x.cs.pu.edu.tw/" + "ftp://ftp.is.co.za/pub/x.org") ; South Africa + (cpan ; from http://www.cpan.org/SITES.html + "http://cpan.enstimac.fr/" + "ftp://ftp.ciril.fr/pub/cpan/" + "ftp://artfiles.org/cpan.org/" + "http://www.cpan.org/" + "ftp://cpan.rinet.ru/pub/mirror/CPAN/" + "http://cpan.cu.be/" + "ftp://cpan.inode.at/" + "ftp://cpan.iht.co.il/" + "ftp://ftp.osuosl.org/pub/CPAN/" + "ftp://ftp.nara.wide.ad.jp/pub/CPAN/" + "http://mirrors.163.com/cpan/" + "ftp://cpan.mirror.ac.za/")))) (define (gnutls-derivation store system) "Return the GnuTLS derivation for SYSTEM." diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index fbd22a9e29..a49bfdbeb8 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -38,21 +38,18 @@ (define-module (guix scripts build) (define %store (make-parameter #f)) -(define (derivations-from-package-expressions exp system source?) - "Eval EXP and return the corresponding derivation path for SYSTEM. +(define (derivations-from-package-expressions str system source?) + "Read/eval STR and return the corresponding derivation path for SYSTEM. When SOURCE? is true, return the derivations of the package sources." - (let ((p (eval exp (current-module)))) - (if (package? p) - (if source? - (let ((source (package-source p)) - (loc (package-location p))) - (if source - (package-source-derivation (%store) source) - (leave (_ "~a: error: package `~a' has no source~%") - (location->string loc) (package-name p)))) - (package-derivation (%store) p system)) - (leave (_ "expression `~s' does not evaluate to a package~%") - exp)))) + (let ((p (read/eval-package-expression str))) + (if source? + (let ((source (package-source p)) + (loc (package-location p))) + (if source + (package-source-derivation (%store) source) + (leave (_ "~a: error: package `~a' has no source~%") + (location->string loc) (package-name p)))) + (package-derivation (%store) p system)))) ;;; @@ -119,9 +116,7 @@ (define %options (alist-cons 'derivations-only? #t result))) (option '(#\e "expression") #t #f (lambda (opt name arg result) - (alist-cons 'expression - (call-with-input-string arg read) - result))) + (alist-cons 'expression arg result))) (option '(#\K "keep-failed") #f #f (lambda (opt name arg result) (alist-cons 'keep-failed? #t result))) @@ -227,8 +222,8 @@ (define (find-package request) (let* ((src? (assoc-ref opts 'source?)) (sys (assoc-ref opts 'system)) (drv (filter-map (match-lambda - (('expression . exp) - (derivations-from-package-expressions exp sys + (('expression . str) + (derivations-from-package-expressions str sys src?)) (('argument . (? derivation-path? drv)) drv) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index f2d2e17d4b..12d80fd171 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -20,6 +20,7 @@ (define-module (guix scripts gc) #:use-module (guix ui) #:use-module (guix store) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) @@ -47,6 +48,11 @@ (define (show-help) (display (_ " --list-live list live paths")) (newline) + (display (_ " + --references list the references of PATHS")) + (display (_ " + --referrers list the referrers of PATHS")) + (newline) (display (_ " -h, --help display this help and exit")) (display (_ " @@ -125,6 +131,14 @@ (define %options (option '("list-live") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-live + (alist-delete 'action result)))) + (option '("references") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-references + (alist-delete 'action result)))) + (option '("referrers") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-referrers (alist-delete 'action result)))))) @@ -142,9 +156,37 @@ (define (parse-options) (alist-cons 'argument arg result)) %default-options)) + (define (symlink-target file) + (let ((s (false-if-exception (lstat file)))) + (if (and s (eq? 'symlink (stat:type s))) + (symlink-target (readlink file)) + file))) + + (define (store-directory file) + ;; Return the store directory that holds FILE if it's in the store, + ;; otherwise return FILE. + (or (and=> (string-match (string-append "^" (regexp-quote (%store-prefix)) + "/([^/]+)") + file) + (compose (cut string-append (%store-prefix) "/" <>) + (cut match:substring <> 1))) + file)) + (with-error-handling - (let ((opts (parse-options)) - (store (open-connection))) + (let* ((opts (parse-options)) + (store (open-connection)) + (paths (filter-map (match-lambda + (('argument . arg) arg) + (_ #f)) + opts))) + (define (list-relatives relatives) + (for-each (compose (lambda (path) + (for-each (cut simple-format #t "~a~%" <>) + (relatives store path))) + store-directory + symlink-target) + paths)) + (case (assoc-ref opts 'action) ((collect-garbage) (let ((min-freed (assoc-ref opts 'min-freed))) @@ -152,11 +194,11 @@ (define (parse-options) (collect-garbage store min-freed) (collect-garbage store)))) ((delete) - (let ((paths (filter-map (match-lambda - (('argument . arg) arg) - (_ #f)) - opts))) - (delete-paths store paths))) + (delete-paths store paths)) + ((list-references) + (list-relatives references)) + ((list-referrers) + (list-relatives referrers)) ((list-dead) (for-each (cut simple-format #t "~a~%" <>) (dead-paths store))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1f9355ff22..ccca614d88 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -281,6 +281,9 @@ (define (show-help) (display (_ " -i, --install=PACKAGE install PACKAGE")) (display (_ " + -e, --install-from-expression=EXP + install the package EXP evaluates to")) + (display (_ " -r, --remove=PACKAGE remove PACKAGE")) (display (_ " -u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP")) @@ -325,6 +328,10 @@ (define %options (option '(#\i "install") #t #f (lambda (opt name arg result) (alist-cons 'install arg result))) + (option '(#\e "install-from-expression") #t #f + (lambda (opt name arg result) + (alist-cons 'install (read/eval-package-expression arg) + result))) (option '(#\r "remove") #t #f (lambda (opt name arg result) (alist-cons 'remove arg result))) @@ -490,6 +497,19 @@ (define (same? d1 d2) (delete-duplicates (map input->name+path deps) same?)) + (define (package->tuple p) + (let ((path (package-derivation (%store) p)) + (deps (package-transitive-propagated-inputs p))) + `(,(package-name p) + ,(package-version p) + + ;; When given a package via `-e', install the first of its + ;; outputs (XXX). + ,(car (package-outputs p)) + + ,path + ,(canonicalize-deps deps)))) + ;; First roll back if asked to. (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) (begin @@ -515,6 +535,8 @@ (define (same? d1 d2) (install (append upgrade (filter-map (match-lambda + (('install . (? package? p)) + #f) (('install . (? store-path?)) #f) (('install . package) @@ -530,6 +552,8 @@ (define (same? d1 d2) install)) (install* (append (filter-map (match-lambda + (('install . (? package? p)) + (package->tuple p)) (('install . (? store-path? path)) (let-values (((name version) (package-name->name+version diff --git a/guix/store.scm b/guix/store.scm index 3627d5be04..80b36daf93 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -66,6 +66,10 @@ (define-module (guix store) substitutable-paths substitutable-path-info + references + referrers + valid-derivers + query-derivation-outputs live-paths dead-paths collect-garbage @@ -126,7 +130,8 @@ (define-enumerate-type operation-id (query-path-from-hash-part 29) (query-substitutable-path-infos 30) (query-valid-paths 31) - (query-substitutable-paths 32)) + (query-substitutable-paths 32) + (query-valid-derivers 33)) (define-enumerate-type hash-algo ;; hash.hh @@ -597,6 +602,27 @@ (define-operation (add-indirect-root (string file-name)) file name. Return #t on success." boolean) +(define references + (operation (query-references (store-path path)) + "Return the list of references of PATH." + store-path-list)) + +(define referrers + (operation (query-referrers (store-path path)) + "Return the list of path that refer to PATH." + store-path-list)) + +(define valid-derivers + (operation (query-valid-derivers (store-path path)) + "Return the list of valid \"derivers\" of PATH---i.e., all the +.drv present in the store that have PATH among their outputs." + store-path-list)) + +(define query-derivation-outputs ; avoid name clash with `derivation-outputs' + (operation (query-derivation-outputs (store-path path)) + "Return the list of outputs of PATH, a .drv file." + store-path-list)) + (define-operation (has-substitutes? (store-path path)) "Return #t if binary substitutes are available for PATH, and #f otherwise." boolean) diff --git a/guix/ui.scm b/guix/ui.scm index 7e0c61b4f8..03d881a428 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -38,6 +38,7 @@ (define-module (guix ui) show-what-to-build call-with-error-handling with-error-handling + read/eval-package-expression location->string call-with-temporary-output-file switch-symlinks @@ -116,6 +117,26 @@ (define (call-with-error-handling thunk) (nix-protocol-error-message c)))) (thunk))) +(define (read/eval-package-expression str) + "Read and evaluate STR and return the package it refers to, or exit an +error." + (let ((exp (catch #t + (lambda () + (call-with-input-string str read)) + (lambda args + (leave (_ "failed to read expression ~s: ~s~%") + str args))))) + (let ((p (catch #t + (lambda () + (eval exp the-scm-module)) + (lambda args + (leave (_ "failed to evaluate expression `~a': ~s~%") + exp args))))) + (if (package? p) + p + (leave (_ "expression `~s' does not evaluate to a package~%") + exp))))) + (define* (show-what-to-build store drv #:optional dry-run?) "Show what will or would (depending on DRY-RUN?) be built in realizing the derivations listed in DRV. Return #t if there's something to build, #f diff --git a/release.nix b/release.nix index 369d54ed96..5aab8600ab 100644 --- a/release.nix +++ b/release.nix @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2012 Ludovic Courtès + Copyright (C) 2012, 2013 Ludovic Courtès This file is part of GNU Guix. @@ -26,6 +26,28 @@ let succeedOnFailure = true; keepBuildDirectory = true; + # Run the given derivation in outside of a chroot. This hack is used on + # hydra.gnu.org where we want Guix derivations to run in a chroot that lacks + # /bin, whereas Nixpkgs relies on /bin/sh. + unchroot = + let + pkgs = import nixpkgs {}; + + # XXX: The `python' derivation contains a `modules' attribute that makes + # `overrideDerivation' fail with "cannot coerce an attribute set (except + # a derivation) to a string", so just remove it. + pythonKludge = drv: removeAttrs drv [ "modules" ]; + in + drv: + if builtins.isAttrs drv + then pkgs.lib.overrideDerivation (pythonKludge drv) (args: { + __noChroot = true; + buildNativeInputs = map unchroot args.buildNativeInputs; + propagatedBuildNativeInputs = + map unchroot args.propagatedBuildNativeInputs; + }) + else drv; + # The Guile used to bootstrap the whole thing. It's normally # downloaded by the build system, but here we download it via a # fixed-output derivation and stuff it into the build tree. @@ -44,23 +66,35 @@ let jobs = { tarball = - let pkgs = import nixpkgs {}; in + unchroot + (let pkgs = import nixpkgs {}; in pkgs.releaseTools.sourceTarball { name = "guix-tarball"; src = ; - buildInputs = with pkgs; [ guile sqlite bzip2 git libgcrypt ]; + buildInputs = + let git_light = pkgs.git.override { + # Minimal Git to avoid building too many dependencies. + withManual = false; + pythonSupport = false; + svnSupport = false; + guiSupport = false; + }; + in + [ git_light ] ++ + (with pkgs; [ guile sqlite bzip2 libgcrypt ]); buildNativeInputs = with pkgs; [ texinfo gettext cvs pkgconfig ]; preAutoconf = ''git config submodule.nix.url "${}"''; configureFlags = [ "--with-libgcrypt-prefix=${pkgs.libgcrypt}" "--localstatedir=/nix/var" ]; - }; + }); build = { system ? builtins.currentSystem }: - let pkgs = import nixpkgs { inherit system; }; in + unchroot + (let pkgs = import nixpkgs { inherit system; }; in pkgs.releaseTools.nixBuild { name = "guix"; buildInputs = with pkgs; [ guile sqlite bzip2 libgcrypt ]; @@ -83,13 +117,14 @@ let inherit succeedOnFailure keepBuildDirectory buildOutOfSourceTree; - }; + }); build_disable_daemon = { system ? builtins.currentSystem }: - let + unchroot + (let pkgs = import nixpkgs { inherit system; }; build = jobs.build { inherit system; }; in @@ -101,7 +136,7 @@ let # the chroot. preConfigure = "export NIX_REMOTE=daemon"; __noChroot = true; - }); + })); # Jobs to test the distro. distro = { diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index a90d085ab2..eac9d82e89 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -25,6 +25,18 @@ guix gc --version trap "rm -f guix-gc-root" EXIT rm -f guix-gc-root +# Check the references of a .drv. +drv="`guix build guile-bootstrap -d`" +out="`guix build guile-bootstrap`" +test -f "$drv" && test -d "$out" + +guix gc --references "$drv" | grep -e -bash +guix gc --references "$out" +guix gc --references "$out/bin/guile" + +if guix gc --references /dev/null; +then false; else true; fi + # Add then reclaim a .drv file. drv="`guix build idutils -d`" test -f "$drv" diff --git a/tests/guix-package.sh b/tests/guix-package.sh index cf8bc5c7e8..f84893ba0b 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -33,6 +33,10 @@ rm -f "$profile" trap 'rm "$profile" "$profile-"[0-9]* ; rm -rf t-home-'"$$" EXIT +# Use `-e' with a non-package expression. +if guix package --bootstrap -e +; +then false; else true; fi + guix package --bootstrap -p "$profile" -i guile-bootstrap test -L "$profile" && test -L "$profile-1-link" test -f "$profile/bin/guile" @@ -46,8 +50,9 @@ test -f "$profile/bin/guile" # Check whether we have network access. if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then - boot_make="`guix build -e '(@@ (gnu packages base) gnu-make-boot0)'`" - guix package --bootstrap -p "$profile" -i "$boot_make" + boot_make="(@@ (gnu packages base) gnu-make-boot0)" + boot_make_drv="`guix build -e "$boot_make"`" + guix package --bootstrap -p "$profile" -i "$boot_make_drv" test -L "$profile-2-link" test -f "$profile/bin/make" && test -f "$profile/bin/guile" @@ -94,7 +99,7 @@ then done # Reinstall after roll-back to the empty profile. - guix package --bootstrap -p "$profile" -i "$boot_make" + guix package --bootstrap -p "$profile" -e "$boot_make" test "`readlink_base "$profile"`" = "$profile-1-link" test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" @@ -104,7 +109,7 @@ then test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" # Install Make. - guix package --bootstrap -p "$profile" -i "$boot_make" + guix package --bootstrap -p "$profile" -e "$boot_make" test "`readlink_base "$profile"`" = "$profile-2-link" test -x "$profile/bin/guile" && test -x "$profile/bin/make" @@ -145,7 +150,7 @@ test -f "$HOME/.guix-profile/bin/guile" if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then - guix package --bootstrap -i "$boot_make" + guix package --bootstrap -e "$boot_make" test -f "$HOME/.guix-profile/bin/make" first_environment="`cd $HOME/.guix-profile ; pwd`" diff --git a/tests/store.scm b/tests/store.scm index c90fd3fed9..c2de99e160 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -23,6 +23,7 @@ (define-module (test-store) #:use-module (guix base32) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -79,6 +80,31 @@ (define (random-text) (> freed 0) (not (file-exists? p)))))) +(test-assert "references" + (let* ((t1 (add-text-to-store %store "random1" + (random-text) '())) + (t2 (add-text-to-store %store "random2" + (random-text) (list t1)))) + (and (equal? (list t1) (references %store t2)) + (equal? (list t2) (referrers %store t1)) + (null? (references %store t1)) + (null? (referrers %store t2))))) + +(test-assert "derivers" + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation %store "the-thing" (%current-system) + s `("-e" ,b) `(("foo" . ,(random-text))) + `((,b) (,s)))) + (o (derivation-path->output-path d))) + (and (build-derivations %store (list d)) + (equal? (query-derivation-outputs %store d) + (list o)) + (equal? (valid-derivers %store o) + (list d))))) + (test-assert "no substitutes" (let* ((s (open-connection)) (d1 (package-derivation s %bootstrap-guile (%current-system)))