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

Merge branch 'master' into core-updates

Browse source 
Conflicts:
	Makefile.am
	guix/scripts/gc.scm
	guix/scripts/package.scm
	guix/ui.scm
	tests/guix-package.sh
This commit is contained in:
Ludovic Courtès 2013-03-04 23:27:24 +01:00
commit 81eec00cb2
22 changed files with 655 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
Makefile.am
View file

@ -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

25
doc/guix.texi
View file

@ -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{<package>} 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

17
gnu/packages/global.scm
View file

@ -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)))

61
gnu/packages/libdaemon.scm Normal file
View file

@ -0,0 +1,61 @@
;;; 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 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+)))

6
gnu/packages/libpng.scm
View file

@ -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")

15
gnu/packages/patches/vpnc-script.patch Normal file
View file

@ -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() {

2
gnu/packages/screen.scm
View file

@ -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"))))

66
gnu/packages/vpn.scm Normal file
View file

@ -0,0 +1,66 @@
;;; 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 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/")))

34
gnu/packages/xml.scm
View file

@ -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")))

2
guix/build-system/gnu.scm
View file

@ -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

103
guix/build-system/perl.scm Normal file
View file

@ -0,0 +1,103 @@
;;; 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 (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

61
guix/build/perl-build-system.scm Normal file
View file

@ -0,0 +1,61 @@
;;; 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 (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

47
guix/download.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -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."

33
guix/scripts/build.scm
View file

@ -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)

56
guix/scripts/gc.scm
View file

@ -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)))

24
guix/scripts/package.scm
View file

@ -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

28
guix/store.scm
View file

@ -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)

21
guix/ui.scm
View file

@ -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

51
release.nix
View file

@ -1,5 +1,5 @@
/* GNU Guix --- Functional package management for GNU
Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org>
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 = <guix>;
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 "${<nix>}"'';
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 = {

12
tests/guix-gc.sh
View file

@ -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"

15
tests/guix-package.sh
View file

@ -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`"

26
tests/store.scm
View file

@ -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)))