From 96be765ca5f89640b5d13e61ca04de7254040f3c Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 13 Feb 2013 00:41:05 +0100 Subject: gnu: Add signing-party. * gnu/packages/gnupg.scm (signing-party): New variable. --- gnu/packages/gnupg.scm | 104 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 046d4c2d76..f26582fb22 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -227,3 +227,107 @@ pius-keyring-mgr and pius-party-worksheet help organisers of PGP keysigning parties.") (license gpl2) (home-page "http://www.phildev.net/pius/index.shtml"))) + +(define-public signing-party + (package + (name "signing-party") + (version "1.1.4") + (source (origin + (method url-fetch) + (uri (string-append "http://ftp.debian.org/debian/pool/main/s/signing-party/signing-party_" + version ".orig.tar.gz")) + (sha256 (base32 + "188gp0prbh8qs29lq3pbf0qibfd6jq4fk7i0pfrybl8aahvm84rx")))) + (build-system gnu-build-system) + (inputs `(("perl" ,perl))) + (arguments + `(#:tests? #f + #:phases + (alist-replace + 'unpack + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((unpack (assoc-ref %standard-phases 'unpack))) + (apply unpack args) + ;; remove spurious symlink + (delete-file "keyanalyze/pgpring/depcomp"))) + (alist-replace + 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* "keyanalyze/Makefile" + (("LDLIBS") (string-append "CC=" (which "gcc") "\nLDLIBS"))) + (substitute* "keyanalyze/Makefile" + (("./configure") (string-append "./configure --prefix=" out))) + (substitute* "keyanalyze/pgpring/configure" + (("/bin/sh") (which "bash"))) + (substitute* "gpgwrap/Makefile" + (("\\} clean") (string-append "} clean\ninstall:\n\tinstall -D bin/gpgwrap " + out "/bin/gpgwrap\n"))) + (substitute* '("gpgsigs/Makefile" "keyanalyze/Makefile" + "keylookup/Makefile" "sig2dot/Makefile" + "springgraph/Makefile") + (("/usr") out)))) + (alist-replace + 'install + (lambda* (#:key outputs #:allow-other-keys #:rest args) + (let ((out (assoc-ref outputs "out")) + (install (assoc-ref %standard-phases 'install))) + (apply install args) + (for-each + (lambda (dir file) + (copy-file (string-append dir "/" file) + (string-append out "/bin/" file))) + '("caff" "caff" "caff" "gpgdir" "gpg-key2ps" + "gpglist" "gpg-mailkeys" "gpgparticipants") + '("caff" "pgp-clean" "pgp-fixkey" "gpgdir" "gpg-key2ps" + "gpglist" "gpg-mailkeys" "gpgparticipants")) + (for-each + (lambda (dir file) + (copy-file (string-append dir "/" file) + (string-append out "/share/man/man1/" file))) + '("caff" "caff" "caff" "gpgdir" + "gpg-key2ps" "gpglist" "gpg-mailkeys" + "gpgparticipants" "gpgsigs" "gpgwrap/doc" + "keyanalyze" "keyanalyze/pgpring" "keyanalyze") + '("caff.1" "pgp-clean.1" "pgp-fixkey.1" "gpgdir.1" + "gpg-key2ps.1" "gpglist.1" "gpg-mailkeys.1" + "gpgparticipants.1" "gpgsigs.1" "gpgwrap.1" + "process_keys.1" "pgpring.1" "keyanalyze.1")))) + %standard-phases))))) + (synopsis "collection of scripts for simplifying gnupg key signing") + (description + "signing-party is a collection for all kinds of PGP/GnuPG related things, +including tools for signing keys, keyring analysis, and party preparation. + + * caff: CA - Fire and Forget signs and mails a key + + * pgp-clean: removes all non-self signatures from key + + * pgp-fixkey: removes broken packets from keys + + * gpg-mailkeys: simply mail out a signed key to its owner + + * gpg-key2ps: generate PostScript file with fingerprint paper strips + + * gpgdir: recursive directory encryption tool + + * gpglist: show who signed which of your UIDs + + * gpgsigs: annotates list of GnuPG keys with already done signatures + + * gpgparticipants: create list of party participants for the organiser + + * gpgwrap: a passphrase wrapper + + * keyanalyze: minimum signing distance (MSD) analysis on keyrings + + * keylookup: ncurses wrapper around gpg --search + + * sig2dot: converts a list of GnuPG signatures to a .dot file + + * springgraph: creates a graph from a .dot file") + ;; gpl2+ for almost all programs, except for keyanalyze: gpl2 + ;; and caff and gpgsigs: bsd-3, see + ;; http://packages.debian.org/changelogs/pool/main/s/signing-party/current/copyright + (license gpl2) + (home-page "http://pgp-tools.alioth.debian.org/"))) -- cgit v1.2.3 From 0d1e6ce4d2e384b73fc393ca13602ac6db41c1be Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 12 Feb 2013 12:02:15 -0500 Subject: Add version-compare and version>? to utils.scm. * guix/utils.scm (version-compare, version>?): New exported procedures, based on version-string>?, which was formerly in gnu-maintenance.scm. * guix/gnu-maintenance.scm (version-string>?): Removed procedure. (latest-release): Use 'version>?' instead of 'version-string>?'. --- guix/gnu-maintenance.scm | 12 ++---------- guix/utils.scm | 20 ++++++++++++++++++++ 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index c934694147..6475c386d3 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -28,6 +28,7 @@ #:use-module (srfi srfi-26) #:use-module (system foreign) #:use-module (guix ftp-client) + #:use-module (guix utils) #:export (official-gnu-packages releases latest-release @@ -156,21 +157,12 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). files) result))))))) -(define version-string>? - (let ((strverscmp - (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) - (error "could not find `strverscmp' (from GNU libc)")))) - (pointer->procedure int sym (list '* '*))))) - (lambda (a b) - "Return #t when B denotes a newer version than A." - (> (strverscmp (string->pointer a) (string->pointer b)) 0)))) - (define (latest-release project) "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." (let ((releases (releases project))) (and (not (null? releases)) (fold (lambda (release latest) - (if (version-string>? (car release) (car latest)) + (if (version>? (car release) (car latest)) release latest)) '("" . "") diff --git a/guix/utils.scm b/guix/utils.scm index 7ab835e7f1..d7c37e37d1 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -57,6 +57,8 @@ gnu-triplet->nix-system %current-system + version-compare + version>? package-name->name+version)) @@ -422,6 +424,24 @@ returned by `config.guess'." ;; By default, this is equal to (gnu-triplet->nix-system %host-type). (make-parameter %system)) +(define version-compare + (let ((strverscmp + (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) + (error "could not find `strverscmp' (from GNU libc)")))) + (pointer->procedure int sym (list '* '*))))) + (lambda (a b) + "Return '> when A denotes a newer version than B, +'< when A denotes a older version than B, +or '= when they denote equal versions." + (let ((result (strverscmp (string->pointer a) (string->pointer b)))) + (cond ((positive? result) '>) + ((negative? result) '<) + (else '=)))))) + +(define (version>? a b) + "Return #t when A denotes a newer version than B." + (eq? '> (version-compare a b))) + (define (package-name->name+version name) "Given NAME, a package name like \"foo-0.9.1b\", return two values: \"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and -- cgit v1.2.3 From 8c3c896dbebe022f5372dffaee9ad3f00c71180f Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Wed, 13 Feb 2013 02:18:46 +0000 Subject: gnu: Add GNU Wdiff. * gnu/packages/wdiff.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + gnu/packages/wdiff.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 gnu/packages/wdiff.scm diff --git a/Makefile.am b/Makefile.am index 3a84812ba6..e44753d596 100644 --- a/Makefile.am +++ b/Makefile.am @@ -152,6 +152,7 @@ MODULES = \ gnu/packages/time.scm \ gnu/packages/tmux.scm \ gnu/packages/tor.scm \ + gnu/packages/wdiff.scm \ gnu/packages/wget.scm \ gnu/packages/which.scm \ gnu/packages/xml.scm \ diff --git a/gnu/packages/wdiff.scm b/gnu/packages/wdiff.scm new file mode 100644 index 0000000000..02d536c7de --- /dev/null +++ b/gnu/packages/wdiff.scm @@ -0,0 +1,61 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Nikita Karetnikov +;;; +;;; 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 wdiff) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages screen) + #:use-module (gnu packages which)) + +(define-public wdiff + (package + (name "wdiff") + (version "1.1.2") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/wdiff/wdiff-" + version ".tar.gz")) + (sha256 + (base32 + "0q78y5awvjjmsvizqilbpwany62shlmlq2ayxkjbygmdafpk1k8j")))) + (build-system gnu-build-system) + (arguments + `(#:phases (alist-cons-before + 'check 'fix-sh + (lambda _ + (substitute* "tests/testsuite" + (("#! /bin/sh") + (string-append "#!" (which "sh"))))) + %standard-phases))) + (inputs `(("screen" ,screen) + ("which" ,which))) + (home-page "https://www.gnu.org/software/wdiff/") + (synopsis + "GNU Wdiff, a tool for comparing files on a word by word basis") + (description + "GNU Wdiff is a front end to 'diff' for comparing files on a word per +word basis. A word is anything between whitespace. This is useful for +comparing two texts in which a few words have been changed and for which +paragraphs have been refilled. It works by creating two temporary files, one +word per line, and then executes 'diff' on these files. It collects the +'diff' output and uses it to produce a nicer display of word differences +between the original files.") + (license gpl3+))) \ No newline at end of file -- cgit v1.2.3 From 250b0404d7bc6bb6b911d58585df41e876ee42de Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Feb 2013 16:09:29 +0100 Subject: gnu: Add missing patch for mcron. * gnu/packages/patches/mcron-install.patch: New file. * Makefile.am (dist_patch_DATA): Add it. --- Makefile.am | 1 + gnu/packages/patches/mcron-install.patch | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 gnu/packages/patches/mcron-install.patch diff --git a/Makefile.am b/Makefile.am index e44753d596..7b0613d27b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -196,6 +196,7 @@ dist_patch_DATA = \ gnu/packages/patches/m4-readlink-EINVAL.patch \ gnu/packages/patches/m4-s_isdir.patch \ gnu/packages/patches/make-impure-dirs.patch \ + gnu/packages/patches/mcron-install.patch \ gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/procps-make-3.82.patch \ gnu/packages/patches/readline-link-ncurses.patch \ diff --git a/gnu/packages/patches/mcron-install.patch b/gnu/packages/patches/mcron-install.patch new file mode 100644 index 0000000000..3cd291f576 --- /dev/null +++ b/gnu/packages/patches/mcron-install.patch @@ -0,0 +1,22 @@ +This patch allows us to install the Vixie-compatible binaries as +non-root without creating /var/run, etc. + +--- mcron-1.0.6/makefile.in 2010-06-19 20:44:17.000000000 +0200 ++++ mcron-1.0.6/makefile.in 2010-07-04 16:16:25.000000000 +0200 +@@ -1004,15 +1004,11 @@ mcron.c : main.scm crontab.scm makefile. + @rm -f mcron.escaped.scm > /dev/null 2>&1 + + install-exec-hook: +- @if [ "x@NO_VIXIE_CLOBBER@" != "xyes" -a "`id -u`" -eq "0" ]; then \ ++ @if [ "x@NO_VIXIE_CLOBBER@" != "xyes" ]; then \ + rm -f $(fpp)cron$(EXEEXT) > /dev/null 2>&1; \ + $(INSTALL) --mode='u=rwx' mcron$(EXEEXT) $(fpp)cron$(EXEEXT); \ + rm -f $(fpp)crontab$(EXEEXT) > /dev/null 2>&1; \ + $(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT); \ +- $(INSTALL) -d --mode='u=rwx' $(DESTDIR)/var/cron; \ +- $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)/var/run; \ +- $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@; \ +- $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@/mcron; \ + elif [ "x@NO_VIXIE_CLOBBER@" = "xyes" ]; then \ + echo "Not installing Vixie-style programs"; \ + else \ -- cgit v1.2.3 From e3b2cf4c7a28807a7225a80eda47dc5f5f7efa70 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Feb 2013 21:42:34 +0100 Subject: gnu: guile-static: Use libgc build with `USE_LIBC_PRIVATES'. * gnu/packages/make-bootstrap.scm (%guile-static): Use libgc build with CPPFLAGS=-DUSE_LIBC_PRIVATES. * gnu/packages/bdw-gc.scm (libgc): Add TODO to always do it. --- gnu/packages/bdw-gc.scm | 1 + gnu/packages/make-bootstrap.scm | 87 +++++++++++++++++++++++------------------ 2 files changed, 50 insertions(+), 38 deletions(-) diff --git a/gnu/packages/bdw-gc.scm b/gnu/packages/bdw-gc.scm index 98526512f8..c338eab871 100644 --- a/gnu/packages/bdw-gc.scm +++ b/gnu/packages/bdw-gc.scm @@ -35,6 +35,7 @@ (base32 "05jwadjbrv8pr7z9cb4miskicxqpxm0pca4h2rg5cgbpajr2bx7b")))) (build-system gnu-build-system) + ;; TODO: Build with -DUSE_LIBC_PRIVATES (see make-bootstrap.scm). (synopsis "The Boehm-Demers-Weiser conservative garbage collector for C and C++") (description diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 8275344b6c..9e9ba939da 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -28,6 +28,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages gawk) #:use-module (gnu packages guile) + #:use-module (gnu packages bdw-gc) #:use-module (gnu packages linux) #:use-module (gnu packages multiprecision) #:use-module (ice-9 match) @@ -399,44 +400,54 @@ ;; A statically-linked Guile that is relocatable--i.e., it can search ;; .scm and .go files relative to its installation directory, rather ;; than in hard-coded configure-time paths. - (let ((guile (package (inherit guile-2.0) - (inputs - `(("patch/relocatable" - ,(search-patch "guile-relocatable.patch")) - ("patch/utf8" - ,(search-patch "guile-default-utf8.patch")) - ,@(package-inputs guile-2.0))) - (arguments - `(;; When `configure' checks for ltdl availability, it - ;; doesn't try to link using libtool, and thus fails - ;; because of a missing -ldl. Work around that. - #:configure-flags '("LDFLAGS=-ldl") - - #:phases (alist-cons-before - 'configure 'static-guile - (lambda _ - (substitute* "libguile/Makefile.in" - ;; Create a statically-linked `guile' - ;; executable. - (("^guile_LDFLAGS =") - "guile_LDFLAGS = -all-static") - - ;; Add `-ldl' *after* libguile-2.0.la. - (("^guile_LDADD =(.*)$" _ ldadd) - (string-append "guile_LDADD = " - (string-trim-right ldadd) - " -ldl\n")))) - %standard-phases) - - ;; Allow Guile to be relocated, as is needed during - ;; bootstrap. - #:patches - (list (assoc-ref %build-inputs "patch/relocatable") - (assoc-ref %build-inputs "patch/utf8")) - - ;; There are uses of `dynamic-link' in - ;; {foreign,coverage}.test that don't fly here. - #:tests? #f))))) + (let* ((libgc (package (inherit libgc) + (arguments + ;; Make it so that we don't rely on /proc. This is + ;; especially useful in an initrd run before /proc is + ;; mounted. + '(#:configure-flags '("CPPFLAGS=-DUSE_LIBC_PRIVATES"))))) + (guile (package (inherit guile-2.0) + (inputs + `(("patch/relocatable" + ,(search-patch "guile-relocatable.patch")) + ("patch/utf8" + ,(search-patch "guile-default-utf8.patch")) + ,@(package-inputs guile-2.0))) + (propagated-inputs + `(("bdw-gc" ,libgc) + ,@(alist-delete "bdw-gc" + (package-propagated-inputs guile-2.0)))) + (arguments + `(;; When `configure' checks for ltdl availability, it + ;; doesn't try to link using libtool, and thus fails + ;; because of a missing -ldl. Work around that. + #:configure-flags '("LDFLAGS=-ldl") + + #:phases (alist-cons-before + 'configure 'static-guile + (lambda _ + (substitute* "libguile/Makefile.in" + ;; Create a statically-linked `guile' + ;; executable. + (("^guile_LDFLAGS =") + "guile_LDFLAGS = -all-static") + + ;; Add `-ldl' *after* libguile-2.0.la. + (("^guile_LDADD =(.*)$" _ ldadd) + (string-append "guile_LDADD = " + (string-trim-right ldadd) + " -ldl\n")))) + %standard-phases) + + ;; Allow Guile to be relocated, as is needed during + ;; bootstrap. + #:patches + (list (assoc-ref %build-inputs "patch/relocatable") + (assoc-ref %build-inputs "patch/utf8")) + + ;; There are uses of `dynamic-link' in + ;; {foreign,coverage}.test that don't fly here. + #:tests? #f))))) (package-with-explicit-inputs (static-package guile) %standard-inputs-with-relocatable-glibc (current-source-location)))) -- cgit v1.2.3 From 9011e97f8df093795bb746ad5d1d50fc1c3f61ca Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 14 Feb 2013 00:14:29 +0100 Subject: build-system/gnu: Make the strip behavior of `static-package' configurable. * guix/build-system/gnu.scm (static-package): Add #:strip-all? keyword parameter. --- guix/build-system/gnu.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 82f5bb8490..5be4782c2f 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -111,20 +111,24 @@ flags for VARIABLE, the associated value is augmented." "A version of P linked with `-static-gcc'." (package-with-extra-configure-variable p "LDFLAGS" "-static-libgcc")) -(define* (static-package p #:optional (loc (current-source-location))) - "Return a statically-linked version of package P." +(define* (static-package p #:optional (loc (current-source-location)) + #:key (strip-all? #t)) + "Return a statically-linked version of package P. If STRIP-ALL? is true, +use `--strip-all' as the arguments to `strip'." (let ((args (package-arguments p))) (package (inherit p) (location (source-properties->location loc)) (arguments (let ((a (default-keyword-arguments args '(#:configure-flags '() - #:strip-flags #f)))) + #:strip-flags '("--strip-debug"))))) (substitute-keyword-arguments a ((#:configure-flags flags) `(cons* "--disable-shared" "LDFLAGS=-static" ,flags)) - ((#:strip-flags _) - ''("--strip-all")))))))) + ((#:strip-flags flags) + (if strip-all? + ''("--strip-all") + flags)))))))) (define %store -- cgit v1.2.3 From c2868b1e0c4155fbeffac9860d69a1ed6041156a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 12 Feb 2013 20:29:30 -0500 Subject: Inhibit duplicates in fold-packages. * gnu/packages.scm (fold2): New procedure. (fold-packages): Rework to suppress duplicates. --- gnu/packages.scm | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/gnu/packages.scm b/gnu/packages.scm index 792fe44efa..f2f98de476 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +21,7 @@ #:use-module (guix packages) #:use-module (guix utils) #:use-module (ice-9 ftw) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-39) @@ -106,20 +108,34 @@ (false-if-exception (resolve-interface name)))) (package-files))) +(define (fold2 f seed1 seed2 lst) + (if (null? lst) + (values seed1 seed2) + (call-with-values + (lambda () (f (car lst) seed1 seed2)) + (lambda (seed1 seed2) + (fold2 f seed1 seed2 (cdr lst)))))) + (define (fold-packages proc init) "Call (PROC PACKAGE RESULT) for each available package, using INIT as -the initial value of RESULT." - (fold (lambda (module result) - (fold (lambda (var result) - (if (package? var) - (proc var result) - result)) - result - (module-map (lambda (sym var) - (false-if-exception (variable-ref var))) - module))) - init - (package-modules))) +the initial value of RESULT. It is guaranteed to never traverse the +same package twice." + (identity ; discard second return value + (fold2 (lambda (module result seen) + (fold2 (lambda (var result seen) + (if (and (package? var) + (not (vhash-assq var seen))) + (values (proc var result) + (vhash-consq var #t seen)) + (values result seen))) + result + seen + (module-map (lambda (sym var) + (false-if-exception (variable-ref var))) + module))) + init + vlist-null + (package-modules)))) (define* (find-packages-by-name name #:optional version) "Return the list of packages with the given NAME. If VERSION is not #f, -- cgit v1.2.3 From dc5669cd654019994fa59ab26db59c292332ae55 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 12 Feb 2013 01:24:21 -0500 Subject: Build newest versions unless specified, and implement upgrades. * gnu/packages.scm (find-newest-available-packages): New exported procedure. * guix-build.in (newest-available-packages, find-best-packages-by-name): New procedures. (find-package): Use find-best-packages-by-name, to guarantee that if a version number is not specified, only the newest versions will be considered. * guix-package.in (%options): Add --upgrade/-u option. (newest-available-packages, find-best-packages-by-name, upgradeable?): New procedures. (find-package): Use find-best-packages-by-name, to guarantee that if a version number is not specified, only the newest versions will be considered. (process-actions): Implement upgrade option. * doc/guix.texi (Invoking guix-package): In the description of --install, mention that if no version number is specified, the newest available version will be selected. --- doc/guix.texi | 7 +++--- gnu/packages.scm | 26 +++++++++++++++++++- guix-build.in | 20 +++++++++++++--- guix-package.in | 73 ++++++++++++++++++++++++++++++++++++++++++++++---------- 4 files changed, 106 insertions(+), 20 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 9cb1431bf1..80149326c1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -491,9 +491,10 @@ Install @var{package}. @var{package} may specify either a simple package name, such as @code{guile}, or a package name followed by a hyphen and version number, -such as @code{guile-1.8.8}. In addition, @var{package} may contain a -colon, followed by the name of one of the outputs of the package, as in -@code{gcc:doc} or @code{binutils-2.22:lib}. +such as @code{guile-1.8.8}. If no version number is specified, the +newest available version will be selected. In addition, @var{package} +may contain a colon, followed by the name of one of the outputs of the +package, as in @code{gcc:doc} or @code{binutils-2.22:lib}. @cindex propagated inputs Sometimes packages have @dfn{propagated inputs}: these are dependencies diff --git a/gnu/packages.scm b/gnu/packages.scm index f2f98de476..b639541788 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -22,6 +22,7 @@ #:use-module (guix utils) #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) + #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-39) @@ -30,7 +31,8 @@ %patch-directory %bootstrap-binaries-path fold-packages - find-packages-by-name)) + find-packages-by-name + find-newest-available-packages)) ;;; Commentary: ;;; @@ -153,3 +155,25 @@ then only return packages whose version is equal to VERSION." (cons package result) result)) '())) + +(define (find-newest-available-packages) + "Return a vhash keyed by package names, and with +associated values of the form + + (newest-version newest-package ...) + +where the preferred package is listed first." + + ;; FIXME: Currently, the preferred package is whichever one + ;; was found last by 'fold-packages'. Find a better solution. + (fold-packages (lambda (p r) + (let ((name (package-name p)) + (version (package-version p))) + (match (vhash-assoc name r) + ((_ newest-so-far . pkgs) + (case (version-compare version newest-so-far) + ((>) (vhash-cons name `(,version ,p) r)) + ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) + ((<) r))) + (#f (vhash-cons name `(,version ,p) r))))) + vlist-null)) diff --git a/guix-build.in b/guix-build.in index f8c7115999..35ddb00861 100644 --- a/guix-build.in +++ b/guix-build.in @@ -13,6 +13,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ !# ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,12 +38,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ #:use-module (guix utils) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) - #:autoload (gnu packages) (find-packages-by-name) + #:autoload (gnu packages) (find-packages-by-name + find-newest-available-packages) #:export (guix-build)) (define %store @@ -196,13 +199,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) root (strerror (system-error-errno args))) (exit 1))))) + (define newest-available-packages + (memoize find-newest-available-packages)) + + (define (find-best-packages-by-name name version) + (if version + (find-packages-by-name name version) + (match (vhash-assoc name (newest-available-packages)) + ((_ version pkgs ...) pkgs) + (#f '())))) + (define (find-package request) ;; Return a package matching REQUEST. REQUEST may be a package ;; name, or a package name followed by a hyphen and a version - ;; number. + ;; number. If the version number is not present, return the + ;; preferred newest version. (let-values (((name version) (package-name->name+version request))) - (match (find-packages-by-name name version) + (match (find-best-packages-by-name name version) ((p) ; one match p) ((p x ...) ; several matches diff --git a/guix-package.in b/guix-package.in index ae3d2cd70e..584481acd5 100644 --- a/guix-package.in +++ b/guix-package.in @@ -14,6 +14,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -346,6 +348,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (option '(#\r "remove") #t #f (lambda (opt name arg result) (alist-cons 'remove arg result))) + (option '(#\u "upgrade") #t #f + (lambda (opt name arg result) + (alist-cons 'upgrade arg result))) (option '("roll-back") #f #f (lambda (opt name arg result) (alist-cons 'roll-back? #t result))) @@ -421,9 +426,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (length req*)) (null? req*) req*)))) + (define newest-available-packages + (memoize find-newest-available-packages)) + + (define (find-best-packages-by-name name version) + (if version + (find-packages-by-name name version) + (match (vhash-assoc name (newest-available-packages)) + ((_ version pkgs ...) pkgs) + (#f '())))) + (define (find-package name) ;; Find the package NAME; NAME may contain a version number and a - ;; sub-derivation name. + ;; sub-derivation name. If the version number is not present, + ;; return the preferred newest version. (define request name) (define (ensure-output p sub-drv) @@ -441,7 +457,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (substring name (+ 1 colon)))))) ((name version) (package-name->name+version name))) - (match (find-packages-by-name name version) + (match (find-best-packages-by-name name version) ((p) (list name (package-version p) sub-drv (ensure-output p sub-drv) (package-transitive-propagated-inputs p))) @@ -458,6 +474,21 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (() (leave (_ "~a: package not found~%") request))))) + (define (upgradeable? name current-version current-path) + ;; Return #t if there's a version of package NAME newer than + ;; CURRENT-VERSION, or if the newest available version is equal to + ;; CURRENT-VERSION but would have an output path different than + ;; CURRENT-PATH. + (match (vhash-assoc name (newest-available-packages)) + ((_ candidate-version pkg . rest) + (case (version-compare candidate-version current-version) + ((>) #t) + ((<) #f) + ((=) (let ((candidate-path (derivation-path->output-path + (package-derivation (%store) pkg)))) + (not (string=? current-path candidate-path)))))) + (#f #f))) + (define (ensure-default-profile) ;; Ensure the default profile symlink and directory exist. @@ -510,13 +541,32 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (begin (roll-back profile) (process-actions (alist-delete 'roll-back? opts))) - (let* ((install (filter-map (match-lambda - (('install . (? store-path?)) - #f) - (('install . package) - (find-package package)) - (_ #f)) - opts)) + (let* ((installed (manifest-packages (profile-manifest profile))) + (upgrade-regexps (filter-map (match-lambda + (('upgrade . regexp) + (make-regexp regexp)) + (_ #f)) + opts)) + (upgrade (if (null? upgrade-regexps) + '() + (let ((newest (find-newest-available-packages))) + (filter-map (match-lambda + ((name version output path _) + (and (any (cut regexp-exec <> name) + upgrade-regexps) + (upgradeable? name version path) + (find-package name))) + (_ #f)) + installed)))) + (install (append + upgrade + (filter-map (match-lambda + (('install . (? store-path?)) + #f) + (('install . package) + (find-package package)) + (_ #f)) + opts))) (drv (filter-map (match-lambda ((name version sub-drv (? package? package) @@ -553,10 +603,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (match package ((name _ ...) (alist-delete name result)))) - (fold alist-delete - (manifest-packages - (profile-manifest profile)) - remove) + (fold alist-delete installed remove) install*)))) (when (equal? profile %current-profile) -- cgit v1.2.3 From eb4908581cae8b787c63b39fa524adf764ae8c25 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Wed, 13 Feb 2013 23:20:11 +0100 Subject: gnu: Add vim. * gnu/packages/vim.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + gnu/packages/vim.scm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 gnu/packages/vim.scm diff --git a/Makefile.am b/Makefile.am index 7b0613d27b..739b75e430 100644 --- a/Makefile.am +++ b/Makefile.am @@ -152,6 +152,7 @@ MODULES = \ gnu/packages/time.scm \ gnu/packages/tmux.scm \ gnu/packages/tor.scm \ + gnu/packages/vim.scm \ gnu/packages/wdiff.scm \ gnu/packages/wget.scm \ gnu/packages/which.scm \ diff --git a/gnu/packages/vim.scm b/gnu/packages/vim.scm new file mode 100644 index 0000000000..a80f50a4a6 --- /dev/null +++ b/gnu/packages/vim.scm @@ -0,0 +1,74 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Cyril Roelandt +;;; +;;; 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 vim) + #: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 gawk) + #:use-module (gnu packages ncurses) + #:use-module (gnu packages perl) + #:use-module (gnu packages system) ; For GNU hostname + #:use-module (gnu packages tcsh)) + +(define-public vim + (package + (name "vim") + (version "7.3") + (source (origin + (method url-fetch) + (uri (string-append "ftp://ftp.vim.org/pub/vim/unix/vim-" + version ".tar.bz2")) + (sha256 + (base32 + "079201qk8g9yisrrb0dn52ch96z3lzw6z473dydw9fzi0xp5spaw")))) + (build-system gnu-build-system) + (arguments + `(#:test-target "test" + #:parallel-tests? #f + #:phases + (alist-replace + 'configure + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (apply configure args) + (substitute* "runtime/tools/mve.awk" + (("/usr/bin/nawk") (which "gawk"))) + (substitute* "src/testdir/Makefile" + (("/bin/sh") (which "sh"))))) + %standard-phases))) + (inputs + `(("gawk", gawk) + ("inetutils", inetutils) + ("ncurses", ncurses) + ("perl", perl) + ("tcsh" ,tcsh))) ; For runtime/tools/vim32 + (home-page "http://www.vim.org/") + (synopsis "VIM 7.3, a text editor based on vi.") + (description + "Vim is a highly configurable text editor built to enable efficient text +editing. It is an improved version of the vi editor distributed with most UNIX +systems. + +Vim is often called a \"programmer's editor,\" and so useful for programming +that many consider it an entire IDE. It's not just for programmers, though. Vim +is perfect for all kinds of text editing, from composing email to editing +configuration files. ") + (license license:vim))) -- cgit v1.2.3 From 1dee732b81660ad2f6b4831c7e53c61e5ca32a0f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2013 00:26:52 +0100 Subject: gnu: linux-libre: Choose a config without debugging features. * gnu/packages/linux.scm (linux-libre): Choose "defconfig" instead of "allmodconfig" since the latter enables all debugging features. Add `CONFIG_CIFS=m'. --- gnu/packages/linux.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index f3e7d18627..b97315580b 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -133,7 +133,13 @@ (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))) (let ((build (assoc-ref %standard-phases 'build))) - (and (zero? (system* "make" "allmodconfig")) + (and (zero? (system* "make" "defconfig")) + (begin + (format #t "enabling additional modules...~%") + (substitute* ".config" + (("^# CONFIG_CIFS.*$") + "CONFIG_CIFS=m\n")) + (zero? (system* "make" "oldconfig"))) ;; Call the default `build' phase so `-j' is correctly ;; passed. -- cgit v1.2.3 From 6956067b04269ecf666b3b4b1e63ce00bc1944c8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2013 00:29:28 +0100 Subject: gnu: guile-static: Add bindings for low-level Linux syscalls. * gnu/packages/make-bootstrap.scm (%guile-static): Add `guile-linux-syscalls.patch' as an input, and use it. * gnu/packages/patches/guile-linux-syscalls.patch: New file. * Makefile.am (dist_patch_DATA): Add it. --- Makefile.am | 1 + gnu/packages/make-bootstrap.scm | 5 +- gnu/packages/patches/guile-linux-syscalls.patch | 234 ++++++++++++++++++++++++ 3 files changed, 239 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/guile-linux-syscalls.patch diff --git a/Makefile.am b/Makefile.am index 739b75e430..9ab0709c68 100644 --- a/Makefile.am +++ b/Makefile.am @@ -186,6 +186,7 @@ dist_patch_DATA = \ gnu/packages/patches/grub-gets-undeclared.patch \ gnu/packages/patches/guile-1.8-cpp-4.5.patch \ gnu/packages/patches/guile-default-utf8.patch \ + gnu/packages/patches/guile-linux-syscalls.patch \ gnu/packages/patches/guile-relocatable.patch \ gnu/packages/patches/libapr-skip-getservbyname-test.patch \ gnu/packages/patches/libevent-dns-tests.patch \ diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 9e9ba939da..218f5a8e25 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -412,6 +412,8 @@ ,(search-patch "guile-relocatable.patch")) ("patch/utf8" ,(search-patch "guile-default-utf8.patch")) + ("patch/syscalls" + ,(search-patch "guile-linux-syscalls.patch")) ,@(package-inputs guile-2.0))) (propagated-inputs `(("bdw-gc" ,libgc) @@ -443,7 +445,8 @@ ;; bootstrap. #:patches (list (assoc-ref %build-inputs "patch/relocatable") - (assoc-ref %build-inputs "patch/utf8")) + (assoc-ref %build-inputs "patch/utf8") + (assoc-ref %build-inputs "patch/syscalls")) ;; There are uses of `dynamic-link' in ;; {foreign,coverage}.test that don't fly here. diff --git a/gnu/packages/patches/guile-linux-syscalls.patch b/gnu/packages/patches/guile-linux-syscalls.patch new file mode 100644 index 0000000000..c0cb0f6d70 --- /dev/null +++ b/gnu/packages/patches/guile-linux-syscalls.patch @@ -0,0 +1,234 @@ +This patch adds bindings to Linux syscalls for which glibc has symbols. + +diff --git a/libguile/posix.c b/libguile/posix.c +index 324f21b..ace5211 100644 +--- a/libguile/posix.c ++++ b/libguile/posix.c +@@ -2286,6 +2286,227 @@ scm_init_popen (void) + } + #endif + ++ ++/* Linux! */ ++ ++#include ++#include "libguile/foreign.h" ++#include "libguile/bytevectors.h" ++ ++SCM_DEFINE (scm_mount, "mount", 3, 2, 0, ++ (SCM source, SCM target, SCM type, SCM flags, SCM data), ++ "Mount file system of @var{type} specified by @var{source} " ++ "on @var{target}.") ++#define FUNC_NAME s_scm_mount ++{ ++ int err; ++ char *c_source, *c_target, *c_type; ++ unsigned long c_flags; ++ void *c_data; ++ ++ c_source = scm_to_locale_string (source); ++ c_target = scm_to_locale_string (target); ++ c_type = scm_to_locale_string (type); ++ c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_ulong (flags); ++ c_data = SCM_UNBNDP (data) ? NULL : scm_to_pointer (data); ++ ++ err = mount (c_source, c_target, c_type, c_flags, c_data); ++ if (err != 0) ++ err = errno; ++ ++ free (c_source); ++ free (c_target); ++ free (c_type); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++ ++/* Linux's module installation syscall. See `kernel/module.c' in Linux; ++ the function itself is part of the GNU libc. ++ ++ Load the LEN bytes at MODULE as a kernel module, with arguments from ++ ARGS, a space-separated list of options. */ ++extern long init_module (void *module, unsigned long len, const char *args); ++ ++SCM_DEFINE (scm_load_linux_module, "load-linux-module", 1, 1, 0, ++ (SCM data, SCM options), ++ "Load the Linux kernel module whose contents are in bytevector " ++ "DATA (the contents of a @code{.ko} file), with the arguments " ++ "from the OPTIONS string.") ++#define FUNC_NAME s_scm_load_linux_module ++{ ++ long err; ++ void *c_data; ++ unsigned long c_len; ++ char *c_options; ++ ++ SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, data); ++ ++ c_data = SCM_BYTEVECTOR_CONTENTS (data); ++ c_len = SCM_BYTEVECTOR_LENGTH (data); ++ c_options = ++ scm_to_locale_string (SCM_UNBNDP (options) ? scm_nullstr : options); ++ ++ err = init_module (c_data, c_len, c_options); ++ ++ free (c_options); ++ ++ if (err != 0) ++ { ++ /* XXX: `insmod' actually provides better translation of some of ++ the error codes. */ ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++ ++/* Linux network interfaces. See . */ ++ ++#include ++#include ++#include "libguile/socket.h" ++ ++SCM_VARIABLE_INIT (flag_IFF_UP, "IFF_UP", ++ scm_from_int (IFF_UP)); ++SCM_VARIABLE_INIT (flag_IFF_BROADCAST, "IFF_BROADCAST", ++ scm_from_int (IFF_BROADCAST)); ++SCM_VARIABLE_INIT (flag_IFF_DEBUG, "IFF_DEBUG", ++ scm_from_int (IFF_DEBUG)); ++SCM_VARIABLE_INIT (flag_IFF_LOOPBACK, "IFF_LOOPBACK", ++ scm_from_int (IFF_LOOPBACK)); ++SCM_VARIABLE_INIT (flag_IFF_POINTOPOINT, "IFF_POINTOPOINT", ++ scm_from_int (IFF_POINTOPOINT)); ++SCM_VARIABLE_INIT (flag_IFF_NOTRAILERS, "IFF_NOTRAILERS", ++ scm_from_int (IFF_NOTRAILERS)); ++SCM_VARIABLE_INIT (flag_IFF_RUNNING, "IFF_RUNNING", ++ scm_from_int (IFF_RUNNING)); ++SCM_VARIABLE_INIT (flag_IFF_NOARP, "IFF_NOARP", ++ scm_from_int (IFF_NOARP)); ++SCM_VARIABLE_INIT (flag_IFF_PROMISC, "IFF_PROMISC", ++ scm_from_int (IFF_PROMISC)); ++SCM_VARIABLE_INIT (flag_IFF_ALLMULTI, "IFF_ALLMULTI", ++ scm_from_int (IFF_ALLMULTI)); ++ ++SCM_DEFINE (scm_set_network_interface_address, "set-network-interface-address", ++ 3, 0, 0, ++ (SCM socket, SCM name, SCM address), ++ "Configure network interface @var{name}.") ++#define FUNC_NAME s_scm_set_network_interface_address ++{ ++ char *c_name; ++ struct ifreq ifr; ++ struct sockaddr *c_address; ++ size_t sa_len; ++ int fd, err; ++ ++ socket = SCM_COERCE_OUTPORT (socket); ++ SCM_VALIDATE_OPFPORT (1, socket); ++ fd = SCM_FPORT_FDES (socket); ++ ++ memset (&ifr, 0, sizeof ifr); ++ c_name = scm_to_locale_string (name); ++ c_address = scm_to_sockaddr (address, &sa_len); ++ ++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1); ++ memcpy (&ifr.ifr_addr, c_address, sa_len); ++ ++ err = ioctl (fd, SIOCSIFADDR, &ifr); ++ if (err != 0) ++ err = errno; ++ ++ free (c_name); ++ free (c_address); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++ ++SCM_DEFINE (scm_set_network_interface_flags, "set-network-interface-flags", ++ 3, 0, 0, ++ (SCM socket, SCM name, SCM flags), ++ "Change the flags of network interface @var{name} to " ++ "@var{flags}.") ++#define FUNC_NAME s_scm_set_network_interface_flags ++{ ++ struct ifreq ifr; ++ char *c_name; ++ int fd, err; ++ ++ socket = SCM_COERCE_OUTPORT (socket); ++ SCM_VALIDATE_OPFPORT (1, socket); ++ fd = SCM_FPORT_FDES (socket); ++ ++ memset (&ifr, 0, sizeof ifr); ++ c_name = scm_to_locale_string (name); ++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1); ++ ifr.ifr_flags = scm_to_short (flags); ++ ++ err = ioctl (fd, SIOCSIFFLAGS, &ifr); ++ if (err != 0) ++ err = errno; ++ ++ free (c_name); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++ ++SCM_DEFINE (scm_network_interface_flags, "network-interface-flags", ++ 2, 0, 0, ++ (SCM socket, SCM name), ++ "Return the flags of network interface @var{name}.") ++#define FUNC_NAME s_scm_network_interface_flags ++{ ++ struct ifreq ifr; ++ char *c_name; ++ int fd, err; ++ ++ socket = SCM_COERCE_OUTPORT (socket); ++ SCM_VALIDATE_OPFPORT (1, socket); ++ fd = SCM_FPORT_FDES (socket); ++ ++ memset (&ifr, 0, sizeof ifr); ++ c_name = scm_to_locale_string (name); ++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1); ++ ++ err = ioctl (fd, SIOCGIFFLAGS, &ifr); ++ if (err != 0) ++ err = errno; ++ ++ free (c_name); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return scm_from_short (ifr.ifr_flags); ++} ++#undef FUNC_NAME ++ + void + scm_init_posix () + { -- cgit v1.2.3 From e04f30e02307fb7660e3fb36ada8d5bcd53977f1 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Fri, 15 Feb 2013 10:46:29 +0000 Subject: gnu: Add GNU Parted. * gnu/packages/parted.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + gnu/packages/parted.scm | 71 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) create mode 100644 gnu/packages/parted.scm diff --git a/Makefile.am b/Makefile.am index 9ab0709c68..84277ddc13 100644 --- a/Makefile.am +++ b/Makefile.am @@ -124,6 +124,7 @@ MODULES = \ gnu/packages/oggvorbis.scm \ gnu/packages/openldap.scm \ gnu/packages/openssl.scm \ + gnu/packages/parted.scm \ gnu/packages/patchelf.scm \ gnu/packages/pcre.scm \ gnu/packages/pdf.scm \ diff --git a/gnu/packages/parted.scm b/gnu/packages/parted.scm new file mode 100644 index 0000000000..b99c52e457 --- /dev/null +++ b/gnu/packages/parted.scm @@ -0,0 +1,71 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Nikita Karetnikov +;;; +;;; 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 parted) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages check) + #:use-module ((gnu packages gettext) + #:renamer (symbol-prefix-proc 'guix:)) + #:use-module (gnu packages linux) + #:use-module (gnu packages readline)) + +(define-public parted + (package + (name "parted") + (version "3.1") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/parted/parted-" + version ".tar.xz")) + (sha256 + (base32 + "05fa4m1bky9d13hqv91jlnngzlyn7y4rnnyq6d86w0dg3vww372y")))) + (build-system gnu-build-system) + (arguments `(#:configure-flags '("--disable-device-mapper") + #:phases (alist-cons-before + 'configure 'fix-mkswap + (lambda* (#:key inputs #:allow-other-keys) + (let ((util-linux (assoc-ref inputs + "util-linux"))) + (substitute* + "tests/t9050-partition-table-types.sh" + (("mkswap") + (string-append util-linux "/sbin/mkswap"))))) + %standard-phases))) + (inputs + ;; XXX: add 'lvm2'. + `(("check" ,check) + ("gettext" ,guix:gettext) + ("readline" ,readline) + ("util-linux" ,util-linux))) + (home-page "http://www.gnu.org/software/parted/") + (synopsis + "GNU Parted, a tool to manipulate partitions") + (description + "GNU Parted is an industrial-strength package for creating, destroying, +resizing, checking and copying partitions, and the file systems on them. This +is useful for creating space for new operating systems, reorganising disk +usage, copying data on hard disks and disk imaging. + +It contains a library, libparted, and a command-line frontend, parted, which +also serves as a sample implementation and script backend.") + (license gpl3+))) \ No newline at end of file -- cgit v1.2.3 From 3665b4dc60cd1f7867c179806427c792f99dbf2b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2013 22:04:51 +0100 Subject: gnu: samba: Augment the RUNPATH of executables to point to $out/lib. * gnu/packages/samba.scm (samba): Add `add-lib-to-runpath' phase, and PatchELF as an input. --- gnu/packages/samba.scm | 47 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm index d414c285f8..93c9f70a50 100644 --- a/gnu/packages/samba.scm +++ b/gnu/packages/samba.scm @@ -27,6 +27,7 @@ #:use-module (gnu packages readline) #:use-module (gnu packages libunwind) #:use-module (gnu packages linux) + #:use-module (gnu packages patchelf) #:use-module (gnu packages perl) #:use-module (gnu packages python)) @@ -103,10 +104,45 @@ anywhere.") "1phl6mmrc72jyvbyrw6cv6b92cxq3v2pbn1fh97nnb4hild1fnjg")))) (build-system gnu-build-system) (arguments - '(#:phases (alist-cons-before 'configure 'chdir - (lambda _ - (chdir "source3")) - %standard-phases) + '(#:phases (alist-cons-before + 'configure 'chdir + (lambda _ + (chdir "source3")) + (alist-cons-after + 'strip 'add-lib-to-runpath + (lambda* (#:key outputs #:allow-other-keys) + (define (file-rpath file) + ;; Return the RPATH of FILE. + (let* ((p (open-pipe* OPEN_READ "patchelf" + "--print-rpath" file)) + (l (read-line p))) + (and (zero? (close-pipe p)) l))) + + (define (augment-rpath file dir) + ;; Add DIR to the RPATH of FILE. + (let* ((rpath (file-rpath file)) + (rpath* (if rpath + (string-append dir ":" rpath) + dir))) + (format #t "~a: changing RPATH from `~a' to `~a'~%" + file (or rpath "") rpath*) + (zero? (system* "patchelf" "--set-rpath" + rpath* file)))) + + (let* ((out (assoc-ref outputs "out")) + (lib (string-append out "/lib"))) + ;; Add LIB to the RUNPATH of all the executables. + (with-directory-excursion out + (for-each (cut augment-rpath <> lib) + (append (find-files "bin" ".*") + (find-files "sbin" ".*")))))) + %standard-phases)) + + #:modules ((guix build gnu-build-system) + (guix build utils) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-26)) ;; This flag is required to allow for "make test". #:configure-flags '("--enable-socket-wrapper") @@ -126,7 +162,8 @@ anywhere.") ("popt" ,popt) ("openldap" ,openldap) ("linux-pam" ,linux-pam) - ("readline" ,readline))) + ("readline" ,readline) + ("patchelf" ,patchelf))) (native-inputs ; for the test suite `(("perl" ,perl) ("python" ,python))) -- cgit v1.2.3 From ffb1ee524d076d32596bbf2ff90212ca12cae83a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2013 22:36:05 +0100 Subject: gnu: qemu: Add dependency on Samba. * gnu/packages/qemu.scm (qemu-kvm): Add dependency on Samba; pass `--smbd' to ./configure. --- gnu/packages/qemu.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index e6859aadf0..785d470079 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -32,6 +32,7 @@ #:use-module (gnu packages libjpeg) #:use-module (gnu packages attr) #:use-module (gnu packages linux) + #:use-module (gnu packages samba) #:use-module (gnu packages perl)) (define-public qemu-kvm @@ -52,14 +53,17 @@ (lambda* (#:key inputs outputs #:allow-other-keys) ;; The `configure' script doesn't understand some of the ;; GNU options. Thus, add a new phase that's compatible. - (let ((out (assoc-ref outputs "out"))) + (let ((out (assoc-ref outputs "out")) + (samba (assoc-ref inputs "samba"))) (setenv "SHELL" (which "bash")) ;; The binaries need to be linked against -lrt. (setenv "LDFLAGS" "-lrt") (zero? (system* "./configure" - (string-append "--prefix=" out))))) + (string-append "--prefix=" out) + (string-append "--smbd=" samba + "/sbin/smbd"))))) %standard-phases))) (inputs ; TODO: Add optional inputs. `(;; ("mesa" ,mesa) @@ -76,7 +80,8 @@ ;; ("alsa-lib" ,alsa-lib) ;; ("SDL" ,SDL) ("zlib" ,zlib) - ("attr" ,attr))) + ("attr" ,attr) + ("samba" ,samba))) ; an optional dependency (home-page "http://www.linux-kvm.org/") (synopsis "Virtualization for Linux on x86 hardware containing virtualization extensions") -- cgit v1.2.3 From 36439572609d38c4d8e7d380d3ac9c39e36f5bf8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 00:29:43 +0100 Subject: gnu: guile-static: Add bindings for `reboot'. * gnu/packages/patches/guile-linux-syscalls.patch: Add `scm_reboot'. --- gnu/packages/patches/guile-linux-syscalls.patch | 46 +++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/gnu/packages/patches/guile-linux-syscalls.patch b/gnu/packages/patches/guile-linux-syscalls.patch index c0cb0f6d70..1fb24bde27 100644 --- a/gnu/packages/patches/guile-linux-syscalls.patch +++ b/gnu/packages/patches/guile-linux-syscalls.patch @@ -1,10 +1,13 @@ This patch adds bindings to Linux syscalls for which glibc has symbols. +Using the FFI would have been nice, but that's not an option when using +a statically-linked Guile in an initrd that doesn't have libc.so around. + diff --git a/libguile/posix.c b/libguile/posix.c -index 324f21b..ace5211 100644 +index 324f21b..cbee94d 100644 --- a/libguile/posix.c +++ b/libguile/posix.c -@@ -2286,6 +2286,227 @@ scm_init_popen (void) +@@ -2286,6 +2286,266 @@ scm_init_popen (void) } #endif @@ -92,6 +95,45 @@ index 324f21b..ace5211 100644 +} +#undef FUNC_NAME + ++/* Rebooting, halting, and all that. */ ++ ++#include ++ ++SCM_VARIABLE_INIT (flag_RB_AUTOBOOT, "RB_AUTOBOOT", ++ scm_from_int (RB_AUTOBOOT)); ++SCM_VARIABLE_INIT (flag_RB_HALT_SYSTEM, "RB_HALT_SYSTEM", ++ scm_from_int (RB_HALT_SYSTEM)); ++SCM_VARIABLE_INIT (flag_RB_ENABLE_CAD, "RB_ENABLE_CAD", ++ scm_from_int (RB_ENABLE_CAD)); ++SCM_VARIABLE_INIT (flag_RB_DISABLE_CAD, "RB_DISABLE_CAD", ++ scm_from_int (RB_DISABLE_CAD)); ++SCM_VARIABLE_INIT (flag_RB_POWER_OFF, "RB_POWER_OFF", ++ scm_from_int (RB_POWER_OFF)); ++SCM_VARIABLE_INIT (flag_RB_SW_SUSPEND, "RB_SW_SUSPEND", ++ scm_from_int (RB_SW_SUSPEND)); ++SCM_VARIABLE_INIT (flag_RB_KEXEC, "RB_KEXEC", ++ scm_from_int (RB_KEXEC)); ++ ++SCM_DEFINE (scm_reboot, "reboot", 0, 1, 0, ++ (SCM command), ++ "Reboot the system. @var{command} must be one of the @code{RB_} " ++ "constants; if omitted, @var{RB_AUTOBOOT} is used, thus " ++ "performing a hard reset.") ++#define FUNC_NAME s_scm_reboot ++{ ++ int c_command; ++ ++ if (SCM_UNBNDP (command)) ++ c_command = RB_AUTOBOOT; ++ else ++ c_command = scm_to_int (command); ++ ++ reboot (c_command); ++ ++ return SCM_UNSPECIFIED; /* likely unreached */ ++} ++#undef FUNC_NAME ++ +/* Linux network interfaces. See . */ + +#include -- cgit v1.2.3 From 0228826262b2fd01371cdaf78cfe22371b18f2d7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 00:30:25 +0100 Subject: gnu: guile-static: Change `name' field. * gnu/packages/make-bootstrap.scm (%guile-static): Add `name' field with `-static' suffix. --- gnu/packages/make-bootstrap.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 218f5a8e25..3bb926bd36 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -407,6 +407,7 @@ ;; mounted. '(#:configure-flags '("CPPFLAGS=-DUSE_LIBC_PRIVATES"))))) (guile (package (inherit guile-2.0) + (name (string-append (package-name guile-2.0) "-static")) (inputs `(("patch/relocatable" ,(search-patch "guile-relocatable.patch")) -- cgit v1.2.3 From d510ab46144b4c7cb27e383f0031c9b363335cd3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 01:37:26 +0100 Subject: packages: Add `package-output'. * guix/packages.scm (package-output): New procedure. * tests/packages.scm ("package-output"): New test. --- guix/packages.scm | 13 +++++++++++++ tests/packages.scm | 9 ++++++++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/guix/packages.scm b/guix/packages.scm index b372f03818..51984baa3b 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -20,10 +20,12 @@ #:use-module (guix utils) #:use-module (guix store) #:use-module (guix base32) + #:use-module (guix derivations) #:use-module (guix build-system) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:re-export (%current-system) @@ -62,6 +64,7 @@ package-source-derivation package-derivation package-cross-derivation + package-output &package-error package-error? @@ -305,3 +308,13 @@ PACKAGE for SYSTEM." (define* (package-cross-derivation store package) ;; TODO #f) + +(define* (package-output store package output + #:optional (system (%current-system))) + "Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the +symbolic output name, such as \"out\". Note that this procedure calls +`package-derivation', which is costly." + (let-values (((_ drv) + (package-derivation store package system))) + (derivation-output-path + (assoc-ref (derivation-outputs drv) output)))) diff --git a/tests/packages.scm b/tests/packages.scm index 32ee558518..f441532d22 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -71,7 +71,7 @@ ("d" ,d) ("d/x" "something.drv")) (pk 'x (package-transitive-inputs e)))))) -(test-skip (if (not %store) 3 0)) +(test-skip (if (not %store) 4 0)) (test-assert "return values" (let-values (((drv-path drv) @@ -79,6 +79,13 @@ (and (derivation-path? drv-path) (derivation? drv)))) +(test-assert "package-output" + (let* ((package (dummy-package "p")) + (drv-path (package-derivation %store package))) + (and (derivation-path? drv-path) + (string=? (derivation-path->output-path drv-path) + (package-output %store package "out"))))) + (test-assert "trivial" (let* ((p (package (inherit (dummy-package "trivial")) (build-system trivial-build-system) -- cgit v1.2.3 From 161ed5476d27a69bbb940fd4a76f67976bd1d91e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 02:09:10 +0100 Subject: gnu: qemu-kvm: Add patch to have multiple SMB shares. * gnu/packages/qemu.scm (qemu-kvm/smb-shares): New variable. * gnu/packages/patches/qemu-multiple-smb-shares.patch: New file. * Makefile.am (dist_patch_DATA): Add it. --- Makefile.am | 1 + gnu/packages/patches/qemu-multiple-smb-shares.patch | 20 ++++++++++++++++++++ gnu/packages/qemu.scm | 13 +++++++++++++ 3 files changed, 34 insertions(+) create mode 100644 gnu/packages/patches/qemu-multiple-smb-shares.patch diff --git a/Makefile.am b/Makefile.am index 84277ddc13..c9e3ca92f5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -202,6 +202,7 @@ dist_patch_DATA = \ gnu/packages/patches/mcron-install.patch \ gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/procps-make-3.82.patch \ + gnu/packages/patches/qemu-multiple-smb-shares.patch \ gnu/packages/patches/readline-link-ncurses.patch \ gnu/packages/patches/shishi-gets-undeclared.patch \ gnu/packages/patches/tar-gets-undeclared.patch \ diff --git a/gnu/packages/patches/qemu-multiple-smb-shares.patch b/gnu/packages/patches/qemu-multiple-smb-shares.patch new file mode 100644 index 0000000000..c20066cbfe --- /dev/null +++ b/gnu/packages/patches/qemu-multiple-smb-shares.patch @@ -0,0 +1,20 @@ +This file extends `-smb' to add a share for the Nix store, and changes +the name of the default share. + +--- a/net/slirp.c ++++ b/net/slirp.c +@@ -515,8 +515,12 @@ static int slirp_smb(SlirpState* s, const char *exported_dir, + "log file=%s/log.smbd\n" + "smb passwd file=%s/smbpasswd\n" + "security = share\n" +- "[qemu]\n" +- "path=%s\n" ++ "[store]\n" ++ "path=/nix/store\n" ++ "read only=yes\n" ++ "guest ok=yes\n" ++ "[xchg]\n" ++ "path=%s/xchg\n" + "read only=no\n" + "guest ok=yes\n", + s->smb_dir, diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 785d470079..b10935ce0d 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -22,6 +22,7 @@ #:use-module (guix utils) #:use-module ((guix licenses) #:select (gpl2)) #:use-module (guix build-system gnu) + #:use-module (gnu packages) #:use-module (gnu packages autotools) #:use-module (gnu packages pkg-config) #:use-module (gnu packages glib) @@ -96,6 +97,18 @@ underway to get the required changes upstream.") ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'. (license gpl2))) +(define-public qemu-kvm/smb-shares + ;; A patched QEMU-KVM where `-net smb' yields two shares instead of one: one + ;; for the store, and another one for exchanges with the host. + (package (inherit qemu-kvm) + (name "qemu-kvm-with-multiple-smb-shares") + (inputs `(,@(package-inputs qemu-kvm) + ("patch/smb-shares" + ,(search-patch "qemu-multiple-smb-shares.patch")))) + (arguments + `(#:patches (list (assoc-ref %build-inputs "patch/smb-shares")) + ,@(package-arguments qemu-kvm))))) + (define-public qemu ;; The real one, with a complete target list. (package (inherit qemu-kvm) -- cgit v1.2.3 From f09d925b1632d5a8dd0999651dab6424847deeea Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 03:25:59 +0100 Subject: gnu: Add support for Guile in Linux initrd. * gnu/packages/linux-initrd.scm: New file. --- Makefile.am | 1 + gnu/packages/linux-initrd.scm | 288 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 289 insertions(+) create mode 100644 gnu/packages/linux-initrd.scm diff --git a/Makefile.am b/Makefile.am index c9e3ca92f5..f81516c227 100644 --- a/Makefile.am +++ b/Makefile.am @@ -107,6 +107,7 @@ MODULES = \ gnu/packages/libusb.scm \ gnu/packages/libunwind.scm \ gnu/packages/linux.scm \ + gnu/packages/linux-initrd.scm \ gnu/packages/lout.scm \ gnu/packages/lsh.scm \ gnu/packages/m4.scm \ diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm new file mode 100644 index 0000000000..348e411d07 --- /dev/null +++ b/gnu/packages/linux-initrd.scm @@ -0,0 +1,288 @@ +;;; 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 linux-initrd) + #:use-module (guix utils) + #:use-module (guix licenses) + #:use-module (gnu packages) + #:use-module (gnu packages cpio) + #:use-module (gnu packages compression) + #:use-module (gnu packages linux) + #:use-module ((gnu packages make-bootstrap) + #:select (%guile-static-stripped)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system trivial)) + + +;;; Commentary: +;;; +;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in +;;; particular initrd's that run Guile. +;;; +;;; Code: + + +(define* (expression->initrd exp + #:key + (guile %guile-static-stripped) + (cpio cpio) + (gzip gzip) + (name "guile-initrd") + (system (%current-system)) + (linux #f) + (linux-modules '())) + "Return a package that contains a Linux initrd (a gzipped cpio archive) +containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list +of `.ko' file names to be copied from LINUX into the initrd." + ;; TODO: Add a `modules' parameter. + + ;; General Linux overview in `Documentation/early-userspace/README' and + ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. + + (define builder + `(begin + (use-modules (guix build utils) + (ice-9 pretty-print) + (ice-9 popen) + (ice-9 match) + (ice-9 ftw) + (srfi srfi-26) + (system base compile) + (rnrs bytevectors) + ((system foreign) #:select (sizeof))) + + (let ((guile (assoc-ref %build-inputs "guile")) + (cpio (string-append (assoc-ref %build-inputs "cpio") + "/bin/cpio")) + (gzip (string-append (assoc-ref %build-inputs "gzip") + "/bin/gzip")) + (out (assoc-ref %outputs "out"))) + (mkdir out) + (mkdir "contents") + (with-directory-excursion "contents" + (copy-recursively guile ".") + (call-with-output-file "init" + (lambda (p) + (format p "#!/bin/guile -ds~%!#~%" guile) + (pretty-print ',exp p))) + (chmod "init" #o555) + (chmod "bin/guile" #o555) + + ;; Compile `init'. + (let ((go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" + (effective-version) + (if (eq? (native-endianness) (endianness little)) + "LE" + "BE") + (sizeof '*) + (effective-version)))) + (mkdir-p go-dir) + (compile-file "init" + #:opts %auto-compilation-options + #:output-file (string-append go-dir "/init.go"))) + + (let* ((linux (assoc-ref %build-inputs "linux")) + (module-dir (and linux + (string-append linux "/lib/modules")))) + (mkdir "modules") + ,@(map (lambda (module) + `(match (find-files module-dir ,module) + ((file) + (format #t "copying '~a'...~%" file) + (copy-file file (string-append "modules/" + ,module))) + (() + (error "module not found" ,module module-dir)) + ((_ ...) + (error "several modules by that name" + ,module module-dir)))) + linux-modules)) + + ;; Reset the timestamps of all the files that will make it in the + ;; initrd. + (for-each (cut utime <> 0 0 0 0) + (find-files "." ".*")) + + (system* cpio "--version") + (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" + "-O" (string-append out "/initrd") + "-H" "newc" "--null"))) + (define print0 + (let ((len (string-length "./"))) + (lambda (file) + (format pipe "~a\0" (string-drop file len))))) + + ;; Note: as per `ramfs-rootfs-initramfs.txt', always add + ;; directory entries before the files that are inside of it: "The + ;; Linux kernel cpio extractor won't create files in a directory + ;; that doesn't exist, so the directory entries must go before + ;; the files that go in those directories." + (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (print0 file)) + (lambda (dir stat result) ; down + (unless (string=? dir ".") + (print0 dir))) + (const #f) ; up + (const #f) ; skip + (const #f) + #f + ".") + + (and (zero? (close-pipe pipe)) + (with-directory-excursion out + (and (zero? (system* gzip "--best" "initrd")) + (rename-file "initrd.gz" "initrd"))))))))) + + (let ((name* name)) + (package + (name name*) + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:modules ((guix build utils)) + #:builder ,builder)) + (inputs `(("guile" ,guile) + ("cpio" ,cpio) + ("gzip" ,gzip) + ,@(if linux + `(("linux" ,linux)) + '()))) + (synopsis "An initial RAM disk (initrd) for the Linux kernel") + (description + "An initial RAM disk (initrd), really a gzipped cpio archive, for use by +the Linux kernel.") + (license gpl3+) + (home-page "http://www.gnu.org/software/guix/")))) + +(define-public qemu-initrd + (expression->initrd + '(begin + (use-modules (rnrs io ports) + (srfi srfi-1) + (srfi srfi-26) + (ice-9 match) + ((system foreign) #:select (string->pointer)) + ((system base compile) #:select (compile-file))) + + (display "Welcome, this is GNU/Guile!\n") + (display "Use '--repl' for an initrd REPL.\n\n") + + (mkdir "/proc") + (mount "none" "/proc" "proc") + + (mkdir "/sys") + (mount "none" "/sys" "sysfs") + + (let* ((command (string-trim-both + (call-with-input-file "/proc/cmdline" + get-string-all))) + (args (string-split command char-set:blank)) + (option (lambda (opt) + (let ((opt (string-append opt "="))) + (and=> (find (cut string-prefix? opt <>) + args) + (lambda (arg) + (substring arg (+ 1 (string-index arg #\=)))))))) + (to-load (option "--load")) + (root (option "--root"))) + + (when (member "--repl" args) + ((@ (system repl repl) start-repl))) + + (let ((slurp (lambda (module) + (call-with-input-file + (string-append "/modules/" module) + get-bytevector-all)))) + (display "loading CIFS and companion modules...\n") + (for-each (compose load-linux-module slurp) + (list "md4.ko" "ecb.ko" "cifs.ko"))) + + ;; See net/slirp.c for default QEMU networking values. + (display "configuring network...\n") + (let* ((sock (socket AF_INET SOCK_STREAM 0)) + (address (make-socket-address AF_INET + (inet-pton AF_INET + "10.0.2.10") + 0)) + (flags (network-interface-flags sock "eth0"))) + (set-network-interface-address sock "eth0" address) + (set-network-interface-flags sock "eth0" + (logior flags IFF_UP)) + (if (logand (network-interface-flags sock "eth0") IFF_UP) + (display "network interface is up\n") + (display "network interface is DOWN\n")) + + (mkdir "/etc") + (call-with-output-file "/etc/resolv.conf" + (lambda (p) + (display "nameserver 10.0.2.3\n" p))) + (sleep 1)) + + ;; Prepare the real root file system under /root. + (unless (file-exists? "/root") + (mkdir "/root")) + (if root + (mount root "/root" "ext3") + (mount "none" "/root" "tmpfs")) + (mkdir "/root/proc") + (mount "none" "/root/proc" "proc") + (mkdir "/root/sys") + (mount "none" "/root/sys" "sysfs") + (mkdir "/root/xchg") + (mkdir "/root/nix") + (mkdir "/root/nix/store") + + (mkdir "/root/dev") + (let ((makedev (lambda (major minor) + (+ (* major 256) minor)))) + (mknod "/root/dev/null" 'char-special #o666 (makedev 1 3)) + (mknod "/root/dev/zero" 'char-special #o666 (makedev 1 5))) + + ;; Mount the host's store and exchange directory. + (display "mounting QEMU's SMB shares...\n") + (let ((server "10.0.2.4")) + (mount (string-append "//" server "/store") "/root/nix/store" "cifs" 0 + (string->pointer "guest,sec=none")) + (mount (string-append "//" server "/xchg") "/root/xchg" "cifs" 0 + (string->pointer "guest,sec=none"))) + + (if to-load + (begin + (format #t "loading boot file '~a'...\n" to-load) + (compile-file (string-append "/root/" to-load) + #:output-file "/root/loader.go" + #:opts %auto-compilation-options) + (match (primitive-fork) + (0 + (chroot "/root") + (load-compiled "/loader.go")) + (pid + (format #t "boot file loaded under PID ~a~%" pid) + (let ((status (waitpid pid))) + (reboot))))) + (begin + (display "no boot file passed via '--load'\n") + (display "entering a warm and cozy REPL\n") + ((@ (system repl repl) start-repl)))))) + #:name "qemu-initrd" + #:linux linux-libre + #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) + +;;; linux-initrd.scm ends here -- cgit v1.2.3 From 040860152e63bbafb2eb3e93619e18d107c96b55 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2013 03:28:26 +0100 Subject: Add (gnu system vm). * gnu/system/vm.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 3 +- gnu/system/vm.scm | 263 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 265 insertions(+), 1 deletion(-) create mode 100644 gnu/system/vm.scm diff --git a/Makefile.am b/Makefile.am index f81516c227..7a1b6ad163 100644 --- a/Makefile.am +++ b/Makefile.am @@ -160,7 +160,8 @@ MODULES = \ gnu/packages/which.scm \ gnu/packages/xml.scm \ gnu/packages/zile.scm \ - gnu/packages/zip.scm + gnu/packages/zip.scm \ + gnu/system/vm.scm GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm new file mode 100644 index 0000000000..3dae35d776 --- /dev/null +++ b/gnu/system/vm.scm @@ -0,0 +1,263 @@ +;;; 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 system vm) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module ((gnu packages base) #:select (%final-inputs guile-final)) + #:use-module (gnu packages qemu) + #:use-module (gnu packages parted) + #:use-module (gnu packages grub) + #:use-module (gnu packages linux) + #:use-module (gnu packages linux-initrd) + #:use-module ((gnu packages make-bootstrap) + #:select (%guile-static-stripped)) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (expression->derivation-in-linux-vm + qemu-image)) + + +;;; Commentary: +;;; +;;; Tools to evaluate build expressions within virtual machines. +;;; +;;; Code: + +(define* (expression->derivation-in-linux-vm store name system exp inputs + #:key + (linux linux-libre) + (initrd qemu-initrd) + (qemu qemu-kvm/smb-shares) + (env-vars '()) + (modules '()) + (guile-for-build + (%guile-for-build)) + + (make-disk-image? #f) + (disk-image-size + (* 100 (expt 2 20)))) + "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the +virtual machine, EXP has access to all of INPUTS from the store; it should put +its output files in the `/xchg' directory, which is copied to the derivation's +output when the VM terminates. + +When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of +DISK-IMAGE-SIZE bytes and return it." + (define input-alist + (map (match-lambda + ((input package) + `(,input . ,(package-output store package "out" system))) + ((input package sub-drv) + `(,input . ,(package-output store package sub-drv system)))) + inputs)) + + (define exp* + ;; EXP, but with INPUTS available. + `(let ((%build-inputs ',input-alist)) + ,exp)) + + (define builder + ;; Code that launches the VM that evaluates EXP. + `(begin + (use-modules (guix build utils)) + + (let ((out (assoc-ref %outputs "out")) + (cu (string-append (assoc-ref %build-inputs "coreutils") + "/bin")) + (qemu (string-append (assoc-ref %build-inputs "qemu") + "/bin/qemu-system-" + (car (string-split ,system #\-)))) + (img (string-append (assoc-ref %build-inputs "qemu") + "/bin/qemu-img")) + (linux (string-append (assoc-ref %build-inputs "linux") + "/bzImage")) + (initrd (string-append (assoc-ref %build-inputs "initrd") + "/initrd")) + (builder (assoc-ref %build-inputs "builder"))) + + ;; XXX: QEMU uses "rm -rf" when it's done to remove the temporary SMB + ;; directory, so it really needs `rm' in $PATH. + (setenv "PATH" cu) + + ,(if make-disk-image? + `(zero? (system* img "create" "image.qcow2" + ,(number->string disk-image-size))) + '(begin)) + + (mkdir "xchg") + (and (zero? + (system* qemu "-nographic" "-no-reboot" + "-net" "nic,model=e1000" + "-net" (string-append "user,smb=" (getcwd)) + "-kernel" linux + "-initrd" initrd + "-append" (string-append "console=ttyS0 --load=" + builder) + ,@(if make-disk-image? + '("-hda" "image.qcow2") + '()))) + ,(if make-disk-image? + '(copy-file "image.qcow2" ; XXX: who mkdir'd OUT? + out) + '(begin + (mkdir out) + (copy-recursively "xchg" out))))))) + + (let ((user-builder (add-text-to-store store "builder-in-linux-vm" + (object->string exp*) + '())) + (->drv (cut package-derivation store <> system)) + (coreutils (car (assoc-ref %final-inputs "coreutils")))) + (build-expression->derivation store name system builder + `(("qemu" ,(->drv qemu)) + ("linux" ,(->drv linux)) + ("initrd" ,(->drv initrd)) + ("coreutils" ,(->drv coreutils)) + ("builder" ,user-builder) + ,@(map (match-lambda + ((name package sub-drv ...) + `(,name ,(->drv package) + ,@sub-drv))) + inputs)) + #:env-vars env-vars + #:modules `((guix build utils) + ,@modules) + #:guile-for-build guile-for-build))) + +(define* (qemu-image store #:key + (name "qemu-image") + (system (%current-system)) + (disk-image-size (* 100 (expt 2 20))) + (linux linux-libre) + (initrd qemu-initrd) + (inputs '())) + "Return a bootable, stand-alone QEMU image." + (expression->derivation-in-linux-vm + store "qemu-image" system + `(let ((parted (string-append (assoc-ref %build-inputs "parted") + "/sbin/parted")) + (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") + "/sbin/mkfs.ext3")) + (grub (string-append (assoc-ref %build-inputs "grub") + "/sbin/grub-install")) + (umount (string-append (assoc-ref %build-inputs "util-linux") + "/bin/umount")) ; XXX: add to Guile + (initrd (string-append (assoc-ref %build-inputs "initrd") + "/initrd")) + (linux (string-append (assoc-ref %build-inputs "linux") + "/bzImage")) + (makedev (lambda (major minor) + (+ (* major 256) minor)))) + + ;; GRUB is full of shell scripts. + (setenv "PATH" + (string-append (dirname grub) ":" + (assoc-ref %build-inputs "coreutils") "/bin:" + (assoc-ref %build-inputs "findutils") "/bin:" + (assoc-ref %build-inputs "sed") "/bin:" + (assoc-ref %build-inputs "grep") "/bin:" + (assoc-ref %build-inputs "gawk") "/bin")) + + (display "creating partition table...\n") + (mknod "/dev/vda" 'block-special #o644 (makedev 8 0)) + (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" + "mkpart" "primary" "ext2" "1MiB" + ,(format #f "~aB" + (- disk-image-size + (* 5 (expt 2 20)))))) + (begin + (display "creating ext3 partition...\n") + (mknod "/dev/vda1" 'block-special #o644 (makedev 8 1)) + (and (zero? (system* mkfs "-F" "/dev/vda1")) + (begin + (display "mounting partition...\n") + (mkdir "/fs") + (mount "/dev/vda1" "/fs" "ext3") + (mkdir "/fs/boot") + (mkdir "/fs/boot/grub") + (copy-file linux "/fs/boot/bzImage") + (copy-file initrd "/fs/boot/initrd") + (call-with-output-file "/fs/boot/grub/grub.cfg" + (lambda (p) + (display " +set timeout=10 +search.file /boot/bzImage + +menuentry \"Boot-to-Guile! Happy Birthday Guile 2.0! (Guile, Guix & co.)\" { + linux /boot/bzImage --repl + initrd /boot/initrd +}" p))) + (and (zero? + (system* grub "--no-floppy" + "--boot-directory" "/fs/boot" + "/dev/vda")) + (zero? + (system* umount "/fs")))))))) + `(("parted" ,parted) + ("grub" ,grub) + ("e2fsprogs" ,e2fsprogs) + ("linux" ,linux-libre) + ("initrd" ,qemu-initrd) + + ;; For shell scripts. + ("sed" ,(car (assoc-ref %final-inputs "sed"))) + ("grep" ,(car (assoc-ref %final-inputs "grep"))) + ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) + ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) + ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) + ("util-linux" ,util-linux)) + #:make-disk-image? #t + #:disk-image-size disk-image-size)) + + +;;; +;;; Guile 2.0 potluck examples. +;;; + +(define (example1) + (let ((store #f)) + (dynamic-wind + (lambda () + (set! store (open-connection))) + (lambda () + (parameterize ((%guile-for-build (package-derivation store guile-final))) + (expression->derivation-in-linux-vm + store "vm-test" (%current-system) + '(begin + (display "hello from boot!\n") + (call-with-output-file "/xchg/hello" + (lambda (p) + (display "world" p)))) + '()))) + (lambda () + (close-connection store))))) + +(define (example2) + (let ((store #f)) + (dynamic-wind + (lambda () + (set! store (open-connection))) + (lambda () + (parameterize ((%guile-for-build (package-derivation store guile-final))) + (qemu-image store #:disk-image-size (* 30 (expt 2 20))))) + (lambda () + (close-connection store))))) + +;;; vm.scm ends here -- cgit v1.2.3 From e49951eb3e1e1a8e7bad6d7471483e70b0865352 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 14 Feb 2013 04:15:25 -0500 Subject: Replace individual scripts with master 'guix' script. * scripts/guix.in: New script. * Makefile.am (bin_SCRIPTS): Add 'scripts/guix'. Remove 'guix-build', 'guix-download', 'guix-import', 'guix-package', and 'guix-gc'. (MODULES): Add 'guix/scripts/build.scm', 'guix/scripts/download.scm', 'guix/scripts/import.scm', 'guix/scripts/package.scm', and 'guix/scripts/gc.scm'. * configure.ac (AC_CONFIG_FILES): Add 'scripts/guix'. Remove 'guix-build', 'guix-download', 'guix-import', 'guix-package', and 'guix-gc'. * guix-build.in, guix-download.in, guix-gc.in, guix-import.in, guix-package.in: Remove shell script boilerplate. Move to guix-COMMAND.in to guix/scripts/COMMAND.scm. Rename module from (guix-COMMAND) to (guix scripts COMMAND). Change "guix-COMMAND" to "guix COMMAND" in usage help string. * pre-inst-env.in: Add "@abs_top_builddir@/scripts" to the front of $PATH. Export $GUIX_UNINSTALLED. * tests/guix-build.sh, tests/guix-daemon.sh, tests/guix-download.sh, tests/guix-gc.sh, tests/guix-package.sh: Use "guix COMMAND" instead of "guix-COMMAND". * doc/guix.texi: Replace all occurrences of "guix-COMMAND" with "guix COMMAND". * po/POTFILES.in: Update. --- .gitignore | 6 +- Makefile.am | 11 +- configure.ac | 9 +- doc/guix.texi | 82 +++--- guix-build.in | 317 --------------------- guix-download.in | 164 ----------- guix-gc.in | 183 ------------ guix-import.in | 137 --------- guix-package.in | 706 ---------------------------------------------- guix/scripts/build.scm | 304 ++++++++++++++++++++ guix/scripts/download.scm | 151 ++++++++++ guix/scripts/gc.scm | 165 +++++++++++ guix/scripts/import.scm | 124 ++++++++ guix/scripts/package.scm | 693 +++++++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 38 ++- po/POTFILES.in | 8 +- pre-inst-env.in | 11 +- scripts/guix.in | 56 ++++ tests/guix-build.sh | 26 +- tests/guix-daemon.sh | 6 +- tests/guix-download.sh | 12 +- tests/guix-gc.sh | 24 +- tests/guix-package.sh | 56 ++-- 23 files changed, 1654 insertions(+), 1635 deletions(-) delete mode 100644 guix-build.in delete mode 100644 guix-download.in delete mode 100644 guix-gc.in delete mode 100644 guix-import.in delete mode 100644 guix-package.in create mode 100644 guix/scripts/build.scm create mode 100644 guix/scripts/download.scm create mode 100644 guix/scripts/gc.scm create mode 100644 guix/scripts/import.scm create mode 100644 guix/scripts/package.scm create mode 100644 scripts/guix.in diff --git a/.gitignore b/.gitignore index ecdaed2ef0..302e473fd8 100644 --- a/.gitignore +++ b/.gitignore @@ -34,7 +34,6 @@ config.cache /po/remove-potcdate.sin /po/stamp-po /po/guix.pot -/guix-build /tests/*.trs /INSTALL /m4/* @@ -44,12 +43,9 @@ config.cache /doc/guix.pdf /doc/stamp-vti /doc/version.texi -/guix-download /gnu/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz /gnu/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz -/guix-package /guix/config.scm -/guix-import /nix/nix-daemon/nix-daemon.cc /nix/config.h /nix/config.h.in @@ -64,7 +60,7 @@ stamp-h[0-9] /nix/scripts/list-runtime-roots /test-env /nix/nix-setuid-helper/nix-setuid-helper.cc -/guix-gc +/scripts/guix /doc/guix.aux /doc/guix.cp /doc/guix.cps diff --git a/Makefile.am b/Makefile.am index 7a1b6ad163..5932e1350a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -18,17 +18,18 @@ # along with GNU Guix. If not, see . bin_SCRIPTS = \ - guix-build \ - guix-download \ - guix-import \ - guix-package \ - guix-gc + scripts/guix nodist_noinst_SCRIPTS = \ pre-inst-env \ test-env MODULES = \ + guix/scripts/build.scm \ + guix/scripts/download.scm \ + guix/scripts/import.scm \ + guix/scripts/package.scm \ + guix/scripts/gc.scm \ guix/base32.scm \ guix/utils.scm \ guix/derivations.scm \ diff --git a/configure.ac b/configure.ac index a9cf17ac57..dd1f843afb 100644 --- a/configure.ac +++ b/configure.ac @@ -117,14 +117,9 @@ AC_CONFIG_FILES([Makefile po/Makefile.in guix/config.scm]) -AC_CONFIG_FILES([guix-build - guix-download - guix-import - guix-package - guix-gc +AC_CONFIG_FILES([scripts/guix pre-inst-env test-env], - [chmod +x guix-build guix-download guix-import guix-package guix-gc \ - pre-inst-env test-env]) + [chmod +x scripts/guix pre-inst-env test-env]) AC_OUTPUT diff --git a/doc/guix.texi b/doc/guix.texi index 80149326c1..f84b37686a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13,9 +13,9 @@ @dircategory Package management @direntry * guix: (guix). Guix, the functional package manager. -* guix-package: (guix)Invoking guix-package +* guix package: (guix)Invoking guix package Managing packages with Guix. -* guix-build: (guix)Invoking guix-build +* guix build: (guix)Invoking guix build Building packages with Guix. @end direntry @@ -196,7 +196,7 @@ are all performed by a specialized process, the @dfn{Guix daemon}, on behalf of clients. Only the daemon may access the store and its associated database. Thus, any operation that manipulates the store goes through the daemon. For instance, command-line tools such as -@command{guix-package} and @command{guix-build} communicate with the +@command{guix package} and @command{guix build} communicate with the daemon (@i{via} remote procedure calls) to instruct it what to do. In a standard multi-user setup, Guix and its daemon---the @@ -302,8 +302,8 @@ Use @var{n} CPU cores to build each derivation; @code{0} means as many as available. The default value is @code{1}, but it may be overridden by clients, such -as the @code{--cores} option of @command{guix-build} (@pxref{Invoking -guix-build}). +as the @code{--cores} option of @command{guix build} (@pxref{Invoking +guix build}). The effect is to define the @code{NIX_BUILD_CORES} environment variable in the build process, which can then use it to exploit internal @@ -319,7 +319,7 @@ Produce debugging output. This is useful to debug daemon start-up issues, but then it may be overridden by clients, for example the @code{--verbosity} option of -@command{guix-build} (@pxref{Invoking guix-build}). +@command{guix build} (@pxref{Invoking guix build}). @item --chroot-directory=@var{dir} Add @var{dir} to the build chroot. @@ -384,8 +384,8 @@ management tools it provides. @menu * Features:: How Guix will make your life brighter. -* Invoking guix-package:: Package installation, removal, etc. -* Invoking guix-gc:: Running the garbage collector. +* Invoking guix package:: Package installation, removal, etc. +* Invoking guix gc:: Running the garbage collector. @end menu @node Features @@ -408,14 +408,14 @@ simply continues to point to @file{/nix/store/@dots{}-gcc-4.8.0/bin/gcc}---i.e., both versions of GCC coexist on the same system without any interference. -The @command{guix-package} command is the central tool to manage -packages (@pxref{Invoking guix-package}). It operates on those per-user +The @command{guix package} command is the central tool to manage +packages (@pxref{Invoking guix package}). It operates on those per-user profiles, and can be used @emph{with normal user privileges}. The command provides the obvious install, remove, and upgrade operations. Each invocation is actually a @emph{transaction}: either the specified operation succeeds, or nothing happens. Thus, if the -@command{guix-package} process is terminated during the transaction, +@command{guix package} process is terminated during the transaction, or if a power outage occurs during the transaction, then the user's profile remains in its previous state, and remains usable. @@ -427,7 +427,7 @@ of their profile, which was known to work well. All those packages in the package store may be @emph{garbage-collected}. Guix can determine which packages are still referenced by the user profiles, and remove those that are provably no longer referenced -(@pxref{Invoking guix-gc}). Users may also explicitly remove old +(@pxref{Invoking guix gc}). Users may also explicitly remove old generations of their profile so that the packages they refer to can be collected. @@ -447,17 +447,17 @@ details.}. When a pre-built binary for a @file{/nix/store} path is available from an external source, Guix just downloads it; otherwise, it builds the package from source, locally. -@node Invoking guix-package -@section Invoking @command{guix-package} +@node Invoking guix package +@section Invoking @command{guix package} -The @command{guix-package} command is the tool that allows users to +The @command{guix package} command is the tool that allows users to install, upgrade, and remove packages, as well as rolling back to previous configurations. It operates only on the user's own profile, and works with normal user privileges (@pxref{Features}). Its syntax is: @example -guix-package @var{options} +guix package @var{options} @end example Primarily, @var{options} specifies the operations to be performed during @@ -473,13 +473,13 @@ variable, and so on. In a multi-user setup, user profiles must be stored in a place registered as a @dfn{garbage-collector root}, which -@file{$HOME/.guix-profile} points to (@pxref{Invoking guix-gc}). That +@file{$HOME/.guix-profile} points to (@pxref{Invoking guix gc}). That directory is normally @code{@var{localstatedir}/profiles/per-user/@var{user}}, where @var{localstatedir} is the value passed to @code{configure} as @code{--localstatedir}, and @var{user} is the user name. It must be created by @code{root}, with @var{user} as the owner. When it does not -exist, @command{guix-package} emits an error about it. +exist, @command{guix package} emits an error about it. The @var{options} can be among the following: @@ -548,7 +548,7 @@ useful to distribution developers. @end table -In addition to these actions @command{guix-package} supports the +In addition to these actions @command{guix package} supports the following options to query the current state of a profile, or the availability of packages: @@ -565,7 +565,7 @@ This allows specific fields to be extracted using the @command{recsel} command, for instance: @example -$ guix-package -s malloc | recsel -p name,version +$ guix package -s malloc | recsel -p name,version name: glibc version: 2.17 @@ -599,22 +599,22 @@ source location of its definition. @end table -@node Invoking guix-gc -@section Invoking @command{guix-gc} +@node Invoking guix gc +@section Invoking @command{guix gc} @cindex garbage collector Packages that are installed but not used may be @dfn{garbage-collected}. -The @command{guix-gc} command allows users to explicitly run the garbage +The @command{guix gc} command allows users to explicitly run the garbage collector to reclaim space from the @file{/nix/store} directory. The garbage collector has a set of known @dfn{roots}: any file under @file{/nix/store} reachable from a root is considered @dfn{live} and cannot be deleted; any other file is considered @dfn{dead} and may be deleted. The set of garbage collector roots includes default user -profiles, and may be augmented with @command{guix-build --root}, for -example (@pxref{Invoking guix-build}). +profiles, and may be augmented with @command{guix build --root}, for +example (@pxref{Invoking guix build}). -The @command{guix-gc} command has three modes of operation: it can be +The @command{guix gc} command has three modes of operation: it can be used to garbage-collect any dead files (the default), to delete specific files (the @code{--delete} option), or to print garbage-collector information. The available options are listed below: @@ -737,7 +737,7 @@ The @code{sha256} field specifies the expected SHA256 hash of the file being downloaded. It is mandatory, and allows Guix to check the integrity of the file. The @code{(base32 @dots{})} form introduces the base32 representation of the hash. A convenient way to obtain this -information is with the @code{guix-download} tool. +information is with the @code{guix download} tool. @item @cindex GNU Build System @@ -795,9 +795,9 @@ Guile process launched by the daemon (@pxref{Derivations}). Once a package definition is in place@footnote{Simple package definitions like the one above may be automatically converted from the -Nixpkgs distribution using the @command{guix-import} command.}, the -package may actually be built using the @code{guix-build} command-line -tool (@pxref{Invoking guix-build}). +Nixpkgs distribution using the @command{guix import} command.}, the +package may actually be built using the @code{guix build} command-line +tool (@pxref{Invoking guix build}). Behind the scenes, a derivation corresponding to the @code{} object is first computed by the @code{package-derivation} procedure. @@ -1015,22 +1015,22 @@ space. @chapter Utilities @menu -* Invoking guix-build:: Building packages from the command line. +* Invoking guix build:: Building packages from the command line. @end menu -@node Invoking guix-build -@section Invoking @command{guix-build} +@node Invoking guix build +@section Invoking @command{guix build} -The @command{guix-build} command builds packages or derivations and +The @command{guix build} command builds packages or derivations and their dependencies, and prints the resulting store paths. Note that it does not modify the user's profile---this is the job of the -@command{guix-package} command (@pxref{Invoking guix-package}). Thus, +@command{guix package} command (@pxref{Invoking guix package}). Thus, it is mainly useful for distribution developers. The general syntax is: @example -guix-build @var{options} @var{package-or-derivation}@dots{} +guix build @var{options} @var{package-or-derivation}@dots{} @end example @var{package-or-derivation} may be either the name of a package found in @@ -1058,7 +1058,7 @@ version 1.8 of Guile. Build the packages' source derivations, rather than the packages themselves. -For instance, @code{guix-build -S gcc} returns something like +For instance, @code{guix build -S gcc} returns something like @file{/nix/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball. @item --system=@var{system} @@ -1106,7 +1106,7 @@ may be helpful when debugging setup issues with the build daemon. @end table -Behind the scenes, @command{guix-build} is essentially an interface to +Behind the scenes, @command{guix build} is essentially an interface to the @code{package-derivation} procedure of the @code{(guix packages)} module, and to the @code{build-derivations} procedure of the @code{(guix store)} module. @@ -1121,11 +1121,11 @@ Guix comes with a distribution of free software@footnote{The term users of that software}.} that form the basis of the GNU system. This includes core GNU packages such as GNU libc, GCC, and Binutils, as well as many GNU and non-GNU applications. The complete list of available -packages can be seen by running @command{guix-package} (@pxref{Invoking -guix-package}): +packages can be seen by running @command{guix package} (@pxref{Invoking +guix package}): @example -guix-package --list-available +guix package --list-available @end example The package definitions of the distribution may are provided by Guile diff --git a/guix-build.in b/guix-build.in deleted file mode 100644 index 35ddb00861..0000000000 --- a/guix-build.in +++ /dev/null @@ -1,317 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code - -prefix="@prefix@" -datarootdir="@datarootdir@" - -GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" -export GUILE_LOAD_COMPILED_PATH - -main='(module-ref (resolve-interface '\''(guix-build)) '\'guix-build')' -exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ - -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès -;;; Copyright © 2013 Mark H Weaver -;;; -;;; 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) - #:use-module (guix ui) - #:use-module (guix store) - #:use-module (guix derivations) - #:use-module (guix packages) - #:use-module (guix utils) - #:use-module (ice-9 format) - #:use-module (ice-9 match) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-37) - #:autoload (gnu packages) (find-packages-by-name - find-newest-available-packages) - #:export (guix-build)) - -(define %store - (make-parameter #f)) - -(define (derivations-from-package-expressions exp system source?) - "Eval EXP 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)))) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - ;; Alist of default option values. - `((system . ,(%current-system)) - (substitutes? . #t) - (verbosity . 0))) - -(define (show-help) - (display (_ "Usage: guix-build [OPTION]... PACKAGE-OR-DERIVATION... -Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) - (display (_ " - -e, --expression=EXPR build the package EXPR evaluates to")) - (display (_ " - -S, --source build the packages' source derivations")) - (display (_ " - -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) - (display (_ " - -d, --derivations return the derivation paths of the given packages")) - (display (_ " - -K, --keep-failed keep build tree of failed builds")) - (display (_ " - -n, --dry-run do not build the derivations")) - (display (_ " - --no-substitutes build instead of resorting to pre-built substitutes")) - (display (_ " - -c, --cores=N allow the use of up to N CPU cores for the build")) - (display (_ " - -r, --root=FILE make FILE a symlink to the result, and register it - as a garbage collector root")) - (display (_ " - --verbosity=LEVEL use the given verbosity LEVEL")) - (newline) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specifications of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix-build"))) - - (option '(#\S "source") #f #f - (lambda (opt name arg result) - (alist-cons 'source? #t result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '(#\d "derivations") #f #f - (lambda (opt name arg result) - (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))) - (option '(#\K "keep-failed") #f #f - (lambda (opt name arg result) - (alist-cons 'keep-failed? #t result))) - (option '(#\c "cores") #t #f - (lambda (opt name arg result) - (let ((c (false-if-exception (string->number arg)))) - (if c - (alist-cons 'cores c result) - (leave (_ "~a: not a number~%") arg))))) - (option '(#\n "dry-run") #f #f - (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) - (option '("no-substitutes") #f #f - (lambda (opt name arg result) - (alist-cons 'substitutes? #f - (alist-delete 'substitutes? result)))) - (option '(#\r "root") #t #f - (lambda (opt name arg result) - (alist-cons 'gc-root arg result))) - (option '("verbosity") #t #f - (lambda (opt name arg result) - (let ((level (string->number arg))) - (alist-cons 'verbosity level - (alist-delete 'verbosity result))))))) - - -;;; -;;; Entry point. -;;; - -(define (guix-build . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - - (define (register-root paths root) - ;; Register ROOT as an indirect GC root for all of PATHS. - (let* ((root (string-append (canonicalize-path (dirname root)) - "/" root))) - (catch 'system-error - (lambda () - (match paths - ((path) - (symlink path root) - (add-indirect-root (%store) root)) - ((paths ...) - (fold (lambda (path count) - (let ((root (string-append root "-" (number->string count)))) - (symlink path root) - (add-indirect-root (%store) root)) - (+ 1 count)) - 0 - paths)))) - (lambda args - (format (current-error-port) - (_ "failed to create GC root `~a': ~a~%") - root (strerror (system-error-errno args))) - (exit 1))))) - - (define newest-available-packages - (memoize find-newest-available-packages)) - - (define (find-best-packages-by-name name version) - (if version - (find-packages-by-name name version) - (match (vhash-assoc name (newest-available-packages)) - ((_ version pkgs ...) pkgs) - (#f '())))) - - (define (find-package request) - ;; Return a package matching REQUEST. REQUEST may be a package - ;; name, or a package name followed by a hyphen and a version - ;; number. If the version number is not present, return the - ;; preferred newest version. - (let-values (((name version) - (package-name->name+version request))) - (match (find-best-packages-by-name name version) - ((p) ; one match - p) - ((p x ...) ; several matches - (format (current-error-port) - (_ "warning: ambiguous package specification `~a'~%") - request) - (format (current-error-port) - (_ "warning: choosing ~a from ~a~%") - (package-full-name p) - (location->string (package-location p))) - p) - (_ ; no matches - (if version - (leave (_ "~A: package not found for version ~a~%") - name version) - (leave (_ "~A: unknown package~%") name)))))) - - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (with-error-handling - (let ((opts (parse-options))) - (parameterize ((%store (open-connection))) - (let* ((src? (assoc-ref opts 'source?)) - (sys (assoc-ref opts 'system)) - (drv (filter-map (match-lambda - (('expression . exp) - (derivations-from-package-expressions exp sys - src?)) - (('argument . (? derivation-path? drv)) - drv) - (('argument . (? string? x)) - (let ((p (find-package x))) - (if src? - (let ((s (package-source p))) - (package-source-derivation - (%store) s)) - (package-derivation (%store) p sys)))) - (_ #f)) - opts)) - (req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build (%store) d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cut valid-path? (%store) <>) - derivation-path->output-path) - drv) - (map derivation-input-path req)))) - (roots (filter-map (match-lambda - (('gc-root . root) root) - (_ #f)) - opts))) - (if (assoc-ref opts 'dry-run?) - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)) - - ;; TODO: Add more options. - (set-build-options (%store) - #:keep-failed? (assoc-ref opts 'keep-failed?) - #:build-cores (or (assoc-ref opts 'cores) 0) - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:verbosity (assoc-ref opts 'verbosity)) - - (if (assoc-ref opts 'derivations-only?) - (begin - (format #t "~{~a~%~}" drv) - (for-each (cut register-root <> <>) - (map list drv) roots)) - (or (assoc-ref opts 'dry-run?) - (and (build-derivations (%store) drv) - (for-each (lambda (d) - (let ((drv (call-with-input-file d - read-derivation))) - (format #t "~{~a~%~}" - (map (match-lambda - ((out-name . out) - (derivation-path->output-path - d out-name))) - (derivation-outputs drv))))) - drv) - (for-each (cut register-root <> <>) - (map (lambda (drv) - (map cdr - (derivation-path->output-paths drv))) - drv) - roots))))))))) diff --git a/guix-download.in b/guix-download.in deleted file mode 100644 index ea62b09a7b..0000000000 --- a/guix-download.in +++ /dev/null @@ -1,164 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code - -prefix="@prefix@" -datarootdir="@datarootdir@" - -GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" -export GUILE_LOAD_COMPILED_PATH - -main='(module-ref (resolve-interface '\''(guix-download)) '\'guix-download')' -exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ - -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 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-download) - #:use-module (guix ui) - #:use-module (guix store) - #:use-module (guix utils) - #:use-module (guix base32) - #:use-module ((guix download) #:select (%mirrors)) - #:use-module (guix build download) - #:use-module (web uri) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) - #:export (guix-download)) - -(define (call-with-temporary-output-file proc) - (let* ((template (string-copy "guix-download.XXXXXX")) - (out (mkstemp! template))) - (dynamic-wind - (lambda () - #t) - (lambda () - (proc template out)) - (lambda () - (false-if-exception (delete-file template)))))) - -(define (fetch-and-store store fetch name) - "Call FETCH for URI, and pass it the name of a file to write to; eventually, -copy data from that port to STORE, under NAME. Return the resulting -store path." - (call-with-temporary-output-file - (lambda (temp port) - (let ((result - (parameterize ((current-output-port (current-error-port))) - (fetch temp)))) - (close port) - (and result - (add-to-store store name #f "sha256" temp)))))) - -;;; -;;; Command-line options. -;;; - -(define %default-options - ;; Alist of default option values. - `((format . ,bytevector->nix-base32-string))) - -(define (show-help) - (display (_ "Usage: guix-download [OPTION]... URL -Download the file at URL, add it to the store, and print its store path -and the hash of its contents.\n")) - (format #t (_ " - -f, --format=FMT write the hash in the given format (default: `nix-base32')")) - (newline) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specifications of the command-line options. - (list (option '(#\f "format") #t #f - (lambda (opt name arg result) - (define fmt-proc - (match arg - ("nix-base32" - bytevector->nix-base32-string) - ("base32" - bytevector->base32-string) - ((or "base16" "hex" "hexadecimal") - bytevector->base16-string) - (x - (format (current-error-port) - "unsupported hash format: ~a~%" arg)))) - - (alist-cons 'format fmt-proc - (alist-delete 'format result)))) - - (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix-download"))))) - - -;;; -;;; Entry point. -;;; - -(define (guix-download . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (let* ((opts (parse-options)) - (store (open-connection)) - (arg (assq-ref opts 'argument)) - (uri (or (string->uri arg) - (leave (_ "guix-download: ~a: failed to parse URI~%") - arg))) - (path (case (uri-scheme uri) - ((file) - (add-to-store store (basename (uri-path uri)) - #f "sha256" (uri-path uri))) - (else - (fetch-and-store store - (cut url-fetch arg <> - #:mirrors %mirrors) - (basename (uri-path uri)))))) - (hash (call-with-input-file - (or path - (leave (_ "guix-download: ~a: download failed~%") - arg)) - (compose sha256 get-bytevector-all))) - (fmt (assq-ref opts 'format))) - (format #t "~a~%~a~%" path (fmt hash)) - #t)) diff --git a/guix-gc.in b/guix-gc.in deleted file mode 100644 index 1a4a5413d9..0000000000 --- a/guix-gc.in +++ /dev/null @@ -1,183 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code - -prefix="@prefix@" -datarootdir="@datarootdir@" - -GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" -export GUILE_LOAD_COMPILED_PATH - -main='(module-ref (resolve-interface '\''(guix-gc)) '\'guix-gc')' -exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ - -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 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-gc) - #:use-module (guix ui) - #:use-module (guix store) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:export (guix-gc)) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - ;; Alist of default option values. - `((action . collect-garbage))) - -(define (show-help) - (display (_ "Usage: guix-gc [OPTION]... PATHS... -Invoke the garbage collector.\n")) - (display (_ " - -C, --collect-garbage[=MIN] - collect at least MIN bytes of garbage")) - (display (_ " - -d, --delete attempt to delete PATHS")) - (display (_ " - --list-dead list dead paths")) - (display (_ " - --list-live list live paths")) - (newline) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define (size->number str) - "Convert STR, a storage measurement representation such as \"1024\" or -\"1MiB\", to a number of bytes. Raise an error if STR could not be -interpreted." - (define unit-pos - (string-rindex str char-set:digit)) - - (define unit - (and unit-pos (substring str (+ 1 unit-pos)))) - - (let* ((numstr (if unit-pos - (substring str 0 (+ 1 unit-pos)) - str)) - (num (string->number numstr))) - (if num - (* num - (match unit - ("KiB" (expt 2 10)) - ("MiB" (expt 2 20)) - ("GiB" (expt 2 30)) - ("TiB" (expt 2 40)) - ("KB" (expt 10 3)) - ("MB" (expt 10 6)) - ("GB" (expt 10 9)) - ("TB" (expt 10 12)) - ("" 1) - (_ - (format (current-error-port) (_ "error: unknown unit: ~a~%") - unit) - (exit 1)))) - (begin - (format (current-error-port) - (_ "error: invalid number: ~a") numstr) - (exit 1))))) - -(define %options - ;; Specification of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix-gc"))) - - (option '(#\C "collect-garbage") #f #t - (lambda (opt name arg result) - (let ((result (alist-cons 'action 'collect-garbage - (alist-delete 'action result)))) - (match arg - ((? string?) - (let ((amount (size->number arg))) - (if arg - (alist-cons 'min-freed amount result) - (begin - (format (current-error-port) - (_ "error: invalid amount of storage: ~a~%") - arg) - (exit 1))))) - (#f result))))) - (option '(#\d "delete") #f #f - (lambda (opt name arg result) - (alist-cons 'action 'delete - (alist-delete 'action result)))) - (option '("list-dead") #f #f - (lambda (opt name arg result) - (alist-cons 'action 'list-dead - (alist-delete 'action result)))) - (option '("list-live") #f #f - (lambda (opt name arg result) - (alist-cons 'action 'list-live - (alist-delete 'action result)))))) - - -;;; -;;; Entry point. -;;; - -(define (guix-gc . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (with-error-handling - (let ((opts (parse-options)) - (store (open-connection))) - (case (assoc-ref opts 'action) - ((collect-garbage) - (let ((min-freed (assoc-ref opts 'min-freed))) - (if min-freed - (collect-garbage store min-freed) - (collect-garbage store)))) - ((delete) - (let ((paths (filter-map (match-lambda - (('argument . arg) arg) - (_ #f)) - opts))) - (delete-paths store paths))) - ((list-dead) - (for-each (cut simple-format #t "~a~%" <>) - (dead-paths store))) - ((list-live) - (for-each (cut simple-format #t "~a~%" <>) - (live-paths store))))))) diff --git a/guix-import.in b/guix-import.in deleted file mode 100644 index 97619a9a59..0000000000 --- a/guix-import.in +++ /dev/null @@ -1,137 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code - -prefix="@prefix@" -datarootdir="@datarootdir@" - -GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" -export GUILE_LOAD_COMPILED_PATH - -main='(module-ref (resolve-interface '\''(guix-import)) '\'guix-import')' -exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ - -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 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-import) - #:use-module (guix ui) - #:use-module (guix snix) - #:use-module (guix utils) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) - #:export (guix-import)) - - -;;; -;;; Helper. -;;; - -(define (newline-rewriting-port output) - "Return an output port that rewrites strings containing the \\n escape -to an actual newline. This works around the behavior of `pretty-print' -and `write', which output these as \\n instead of actual newlines, -whereas we want the `description' field to contain actual newlines -rather than \\n." - (define (write-string str) - (let loop ((chars (string->list str))) - (match chars - (() - #t) - ((#\\ #\n rest ...) - (newline output) - (loop rest)) - ((chr rest ...) - (write-char chr output) - (loop rest))))) - - (make-soft-port (vector (cut write-char <>) - write-string - (lambda _ #t) ; flush - #f - (lambda _ #t) ; close - #f) - "w")) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - '()) - -(define (show-help) - (display (_ "Usage: guix-import NIXPKGS ATTRIBUTE -Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specification of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix-import"))))) - - -;;; -;;; Entry point. -;;; - -(define (guix-import . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (let* ((opts (parse-options)) - (args (filter-map (match-lambda - (('argument . value) - value) - (_ #f)) - (reverse opts)))) - (match args - ((nixpkgs attribute) - (let-values (((expr loc) - (nixpkgs->guix-package nixpkgs attribute))) - (format #t ";; converted from ~a:~a~%~%" - (location-file loc) (location-line loc)) - (pretty-print expr (newline-rewriting-port (current-output-port))))) - (_ - (leave (_ "wrong number of arguments~%")))))) diff --git a/guix-package.in b/guix-package.in deleted file mode 100644 index 584481acd5..0000000000 --- a/guix-package.in +++ /dev/null @@ -1,706 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code - -prefix="@prefix@" -datarootdir="@datarootdir@" - -GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" -export GUILE_LOAD_COMPILED_PATH - -main='(module-ref (resolve-interface '\''(guix-package)) '\'guix-package')' -exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ - -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès -;;; Copyright © 2013 Nikita Karetnikov -;;; Copyright © 2013 Mark H Weaver -;;; -;;; 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-package) - #:use-module (guix ui) - #:use-module (guix store) - #:use-module (guix derivations) - #:use-module (guix packages) - #:use-module (guix utils) - #:use-module (guix config) - #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) - #:use-module (ice-9 ftw) - #:use-module (ice-9 format) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-37) - #:use-module (gnu packages) - #:use-module ((gnu packages base) #:select (guile-final)) - #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) - #:export (guix-package)) - -(define %store - (make-parameter #f)) - - -;;; -;;; User environment. -;;; - -(define %user-environment-directory - (and=> (getenv "HOME") - (cut string-append <> "/.guix-profile"))) - -(define %profile-directory - (string-append (or (getenv "NIX_STATE_DIR") %state-directory) "/profiles/" - (or (and=> (getenv "USER") - (cut string-append "per-user/" <>)) - "default"))) - -(define %current-profile - ;; Call it `guix-profile', not `profile', to allow Guix profiles to - ;; coexist with Nix profiles. - (string-append %profile-directory "/guix-profile")) - -(define (profile-manifest profile) - "Return the PROFILE's manifest." - (let ((manifest (string-append profile "/manifest"))) - (if (file-exists? manifest) - (call-with-input-file manifest read) - '(manifest (version 1) (packages ()))))) - -(define (manifest-packages manifest) - "Return the packages listed in MANIFEST." - (match manifest - (('manifest ('version 0) - ('packages ((name version output path) ...))) - (zip name version output path - (make-list (length name) '()))) - - ;; Version 1 adds a list of propagated inputs to the - ;; name/version/output/path tuples. - (('manifest ('version 1) - ('packages (packages ...))) - packages) - - (_ - (error "unsupported manifest format" manifest)))) - -(define (profile-regexp profile) - "Return a regular expression that matches PROFILE's name and number." - (make-regexp (string-append "^" (regexp-quote (basename profile)) - "-([0-9]+)"))) - -(define (profile-numbers profile) - "Return the list of generation numbers of PROFILE, or '(0) if no -former profiles were found." - (define* (scandir name #:optional (select? (const #t)) - (entry (file-system-fold enter? leaf down up skip error #f name lstat) - (lambda (files) - (sort files entry)) - (#f ; no profile directory - '(0)) - (() ; no profiles - '(0)) - ((profiles ...) ; former profiles around - (map (compose string->number - (cut match:substring <> 1) - (cute regexp-exec (profile-regexp profile) <>)) - profiles)))) - -(define (previous-profile-number profile number) - "Return the number of the generation before generation NUMBER of -PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the -case when generations have been deleted (there are \"holes\")." - (fold (lambda (candidate highest) - (if (and (< candidate number) (> candidate highest)) - candidate - highest)) - 0 - (profile-numbers profile))) - -(define (profile-derivation store packages) - "Return a derivation that builds a profile (a user environment) with -all of PACKAGES, a list of name/version/output/path/deps tuples." - (define builder - `(begin - (use-modules (ice-9 pretty-print) - (guix build union)) - - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (let ((output (assoc-ref %outputs "out")) - (inputs (map cdr %build-inputs))) - (format #t "building user environment `~a' with ~a packages...~%" - output (length inputs)) - (union-build output inputs) - (call-with-output-file (string-append output "/manifest") - (lambda (p) - (pretty-print '(manifest (version 1) - (packages ,packages)) - p)))))) - - (build-expression->derivation store "user-environment" - (%current-system) - builder - (append-map (match-lambda - ((name version output path deps) - `((,name ,path) - ,@deps))) - packages) - #:modules '((guix build union)))) - -(define (profile-number profile) - "Return PROFILE's number or 0. An absolute file name must be used." - (or (and=> (false-if-exception (regexp-exec (profile-regexp profile) - (basename (readlink profile)))) - (compose string->number (cut match:substring <> 1))) - 0)) - -(define (switch-symlinks link target) - "Atomically switch LINK, a symbolic link, to point to TARGET. Works -both when LINK already exists and when it does not." - (let ((pivot (string-append link ".new"))) - (symlink target pivot) - (rename-file pivot link))) - -(define (roll-back profile) - "Roll back to the previous generation of PROFILE." - (let* ((number (profile-number profile)) - (previous-number (previous-profile-number profile number)) - (previous-profile (format #f "~a-~a-link" - profile previous-number)) - (manifest (string-append previous-profile "/manifest"))) - - (define (switch-link) - ;; Atomically switch PROFILE to the previous profile. - (format #t (_ "switching from generation ~a to ~a~%") - number previous-number) - (switch-symlinks profile previous-profile)) - - (cond ((not (file-exists? profile)) ; invalid profile - (format (current-error-port) - (_ "error: profile `~a' does not exist~%") - profile)) - ((zero? number) ; empty profile - (format (current-error-port) - (_ "nothing to do: already at the empty profile~%"))) - ((or (zero? previous-number) ; going to emptiness - (not (file-exists? previous-profile))) - (let*-values (((drv-path drv) - (profile-derivation (%store) '())) - ((prof) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) - (when (not (build-derivations (%store) (list drv-path))) - (leave (_ "failed to build the empty profile~%"))) - - (switch-symlinks previous-profile prof) - (switch-link))) - (else (switch-link))))) ; anything else - -(define (find-packages-by-description rx) - "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of -matching packages." - (define (same-location? p1 p2) - ;; Compare locations of two packages. - (equal? (package-location p1) (package-location p2))) - - (delete-duplicates - (sort - (fold-packages (lambda (package result) - (define matches? - (cut regexp-exec rx <>)) - - (if (or (and=> (package-synopsis package) - (compose matches? gettext)) - (and=> (package-description package) - (compose matches? gettext))) - (cons package result) - result)) - '()) - (lambda (p1 p2) - (stringname+path input) - "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple." - (let loop ((input input)) - (match input - ((name package) - (loop `(,name ,package "out"))) - ((name package sub-drv) - (let*-values (((_ drv) - (package-derivation (%store) package)) - ((out) - (derivation-output-path - (assoc-ref (derivation-outputs drv) sub-drv)))) - `(,name ,out)))))) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - ;; Alist of default option values. - `((profile . ,%current-profile))) - -(define (show-help) - (display (_ "Usage: guix-package [OPTION]... PACKAGES... -Install, remove, or upgrade PACKAGES in a single transaction.\n")) - (display (_ " - -i, --install=PACKAGE install PACKAGE")) - (display (_ " - -r, --remove=PACKAGE remove PACKAGE")) - (display (_ " - -u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP")) - (display (_ " - --roll-back roll back to the previous generation")) - (newline) - (display (_ " - -p, --profile=PROFILE use PROFILE instead of the user's default profile")) - (display (_ " - -n, --dry-run show what would be done without actually doing it")) - (display (_ " - --bootstrap use the bootstrap Guile to build the profile")) - (display (_ " - --verbose produce verbose output")) - (newline) - (display (_ " - -s, --search=REGEXP search in synopsis and description using REGEXP")) - (display (_ " - -I, --list-installed[=REGEXP] - list installed packages matching REGEXP")) - (display (_ " - -A, --list-available[=REGEXP] - list available packages matching REGEXP")) - (newline) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specification of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix-package"))) - - (option '(#\i "install") #t #f - (lambda (opt name arg result) - (alist-cons 'install arg result))) - (option '(#\r "remove") #t #f - (lambda (opt name arg result) - (alist-cons 'remove arg result))) - (option '(#\u "upgrade") #t #f - (lambda (opt name arg result) - (alist-cons 'upgrade arg result))) - (option '("roll-back") #f #f - (lambda (opt name arg result) - (alist-cons 'roll-back? #t result))) - (option '(#\p "profile") #t #f - (lambda (opt name arg result) - (alist-cons 'profile arg - (alist-delete 'profile result)))) - (option '(#\n "dry-run") #f #f - (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) - (option '("bootstrap") #f #f - (lambda (opt name arg result) - (alist-cons 'bootstrap? #t result))) - (option '("verbose") #f #f - (lambda (opt name arg result) - (alist-cons 'verbose? #t result))) - (option '(#\s "search") #t #f - (lambda (opt name arg result) - (cons `(query search ,(or arg "")) - result))) - (option '(#\I "list-installed") #f #t - (lambda (opt name arg result) - (cons `(query list-installed ,(or arg "")) - result))) - (option '(#\A "list-available") #f #t - (lambda (opt name arg result) - (cons `(query list-available ,(or arg "")) - result))))) - - -;;; -;;; Entry point. -;;; - -(define (guix-package . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (leave (_ "~A: extraneous argument~%") arg)) - %default-options)) - - (define (guile-missing?) - ;; Return #t if %GUILE-FOR-BUILD is not available yet. - (let ((out (derivation-path->output-path (%guile-for-build)))) - (not (valid-path? (%store) out)))) - - (define (show-what-to-build drv dry-run?) - ;; Show what will/would be built in realizing the derivations listed - ;; in DRV. - (let* ((req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build - (%store) d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cute valid-path? (%store) <>) - derivation-path->output-path) - drv) - (map derivation-input-path req))))) - (if dry-run? - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)))) - - (define newest-available-packages - (memoize find-newest-available-packages)) - - (define (find-best-packages-by-name name version) - (if version - (find-packages-by-name name version) - (match (vhash-assoc name (newest-available-packages)) - ((_ version pkgs ...) pkgs) - (#f '())))) - - (define (find-package name) - ;; Find the package NAME; NAME may contain a version number and a - ;; sub-derivation name. If the version number is not present, - ;; return the preferred newest version. - (define request name) - - (define (ensure-output p sub-drv) - (if (member sub-drv (package-outputs p)) - p - (leave (_ "~a: error: package `~a' lacks output `~a'~%") - (location->string (package-location p)) - (package-full-name p) - sub-drv))) - - (let*-values (((name sub-drv) - (match (string-rindex name #\:) - (#f (values name "out")) - (colon (values (substring name 0 colon) - (substring name (+ 1 colon)))))) - ((name version) - (package-name->name+version name))) - (match (find-best-packages-by-name name version) - ((p) - (list name (package-version p) sub-drv (ensure-output p sub-drv) - (package-transitive-propagated-inputs p))) - ((p p* ...) - (format (current-error-port) - (_ "warning: ambiguous package specification `~a'~%") - request) - (format (current-error-port) - (_ "warning: choosing ~a from ~a~%") - (package-full-name p) - (location->string (package-location p))) - (list name (package-version p) sub-drv (ensure-output p sub-drv) - (package-transitive-propagated-inputs p))) - (() - (leave (_ "~a: package not found~%") request))))) - - (define (upgradeable? name current-version current-path) - ;; Return #t if there's a version of package NAME newer than - ;; CURRENT-VERSION, or if the newest available version is equal to - ;; CURRENT-VERSION but would have an output path different than - ;; CURRENT-PATH. - (match (vhash-assoc name (newest-available-packages)) - ((_ candidate-version pkg . rest) - (case (version-compare candidate-version current-version) - ((>) #t) - ((<) #f) - ((=) (let ((candidate-path (derivation-path->output-path - (package-derivation (%store) pkg)))) - (not (string=? current-path candidate-path)))))) - (#f #f))) - - (define (ensure-default-profile) - ;; Ensure the default profile symlink and directory exist. - - ;; Create ~/.guix-profile if it doesn't exist yet. - (when (and %user-environment-directory - %current-profile - (not (false-if-exception - (lstat %user-environment-directory)))) - (symlink %current-profile %user-environment-directory)) - - ;; Attempt to create /…/profiles/per-user/$USER if needed. - (unless (directory-exists? %profile-directory) - (catch 'system-error - (lambda () - (mkdir-p %profile-directory)) - (lambda args - ;; Often, we cannot create %PROFILE-DIRECTORY because its - ;; parent directory is root-owned and we're running - ;; unprivileged. - (format (current-error-port) - (_ "error: while creating directory `~a': ~a~%") - %profile-directory - (strerror (system-error-errno args))) - (format (current-error-port) - (_ "Please create the `~a' directory, with you as the owner.~%") - %profile-directory) - (exit 1))))) - - (define (process-actions opts) - ;; Process any install/remove/upgrade action from OPTS. - - (define dry-run? (assoc-ref opts 'dry-run?)) - (define verbose? (assoc-ref opts 'verbose?)) - (define profile (assoc-ref opts 'profile)) - - (define (canonicalize-deps deps) - ;; Remove duplicate entries from DEPS, a list of propagated inputs, - ;; where each input is a name/path tuple. - (define (same? d1 d2) - (match d1 - ((_ path1) - (match d2 - ((_ path2) - (string=? path1 path2)))))) - - (delete-duplicates (map input->name+path deps) same?)) - - ;; First roll back if asked to. - (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) - (begin - (roll-back profile) - (process-actions (alist-delete 'roll-back? opts))) - (let* ((installed (manifest-packages (profile-manifest profile))) - (upgrade-regexps (filter-map (match-lambda - (('upgrade . regexp) - (make-regexp regexp)) - (_ #f)) - opts)) - (upgrade (if (null? upgrade-regexps) - '() - (let ((newest (find-newest-available-packages))) - (filter-map (match-lambda - ((name version output path _) - (and (any (cut regexp-exec <> name) - upgrade-regexps) - (upgradeable? name version path) - (find-package name))) - (_ #f)) - installed)))) - (install (append - upgrade - (filter-map (match-lambda - (('install . (? store-path?)) - #f) - (('install . package) - (find-package package)) - (_ #f)) - opts))) - (drv (filter-map (match-lambda - ((name version sub-drv - (? package? package) - (deps ...)) - (package-derivation (%store) package)) - (_ #f)) - install)) - (install* (append - (filter-map (match-lambda - (('install . (? store-path? path)) - (let-values (((name version) - (package-name->name+version - (store-path-package-name - path)))) - `(,name ,version #f ,path ()))) - (_ #f)) - opts) - (map (lambda (tuple drv) - (match tuple - ((name version sub-drv _ (deps ...)) - (let ((output-path - (derivation-path->output-path - drv sub-drv))) - `(,name ,version ,sub-drv ,output-path - ,(canonicalize-deps deps)))))) - install drv))) - (remove (filter-map (match-lambda - (('remove . package) - package) - (_ #f)) - opts)) - (packages (append install* - (fold (lambda (package result) - (match package - ((name _ ...) - (alist-delete name result)))) - (fold alist-delete installed remove) - install*)))) - - (when (equal? profile %current-profile) - (ensure-default-profile)) - - (show-what-to-build drv dry-run?) - - (or dry-run? - (and (build-derivations (%store) drv) - (let* ((prof-drv (profile-derivation (%store) packages)) - (prof (derivation-path->output-path prof-drv)) - (old-drv (profile-derivation - (%store) (manifest-packages - (profile-manifest profile)))) - (old-prof (derivation-path->output-path old-drv)) - (number (profile-number profile)) - - ;; Always use NUMBER + 1 for the new profile, - ;; possibly overwriting a "previous future - ;; generation". - (name (format #f "~a-~a-link" - profile (+ 1 number)))) - (if (string=? old-prof prof) - (when (or (pair? install) (pair? remove)) - (format (current-error-port) - (_ "nothing to be done~%"))) - (and (parameterize ((current-build-output-port - ;; Output something when Guile - ;; needs to be built. - (if (or verbose? (guile-missing?)) - (current-error-port) - (%make-void-port "w")))) - (build-derivations (%store) (list prof-drv))) - (begin - (switch-symlinks name prof) - (switch-symlinks profile name)))))))))) - - (define (process-query opts) - ;; Process any query specified by OPTS. Return #t when a query was - ;; actually processed, #f otherwise. - (let ((profile (assoc-ref opts 'profile))) - (match (assoc-ref opts 'query) - (('list-installed regexp) - (let* ((regexp (and regexp (make-regexp regexp))) - (manifest (profile-manifest profile)) - (installed (manifest-packages manifest))) - (for-each (match-lambda - ((name version output path _) - (when (or (not regexp) - (regexp-exec regexp name)) - (format #t "~a\t~a\t~a\t~a~%" - name (or version "?") output path)))) - installed) - #t)) - - (('list-available regexp) - (let* ((regexp (and regexp (make-regexp regexp))) - (available (fold-packages - (lambda (p r) - (let ((n (package-name p))) - (if regexp - (if (regexp-exec regexp n) - (cons p r) - r) - (cons p r)))) - '()))) - (for-each (lambda (p) - (format #t "~a\t~a\t~a\t~a~%" - (package-name p) - (package-version p) - (string-join (package-outputs p) ",") - (location->string (package-location p)))) - (sort available - (lambda (p1 p2) - (stringrecutils <> (current-output-port)) - (find-packages-by-description regexp)) - #t)) - (_ #f)))) - - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (let ((opts (parse-options))) - (or (process-query opts) - (parameterize ((%store (open-connection))) - (with-error-handling - (parameterize ((%guile-for-build - (package-derivation (%store) - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - guile-final)))) - (process-actions opts))))))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm new file mode 100644 index 0000000000..bad04418f1 --- /dev/null +++ b/guix/scripts/build.scm @@ -0,0 +1,304 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Mark H Weaver +;;; +;;; 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 scripts build) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix utils) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-37) + #:autoload (gnu packages) (find-packages-by-name + find-newest-available-packages) + #:export (guix-build)) + +(define %store + (make-parameter #f)) + +(define (derivations-from-package-expressions exp system source?) + "Eval EXP 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)))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((system . ,(%current-system)) + (substitutes? . #t) + (verbosity . 0))) + +(define (show-help) + (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... +Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) + (display (_ " + -e, --expression=EXPR build the package EXPR evaluates to")) + (display (_ " + -S, --source build the packages' source derivations")) + (display (_ " + -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) + (display (_ " + -d, --derivations return the derivation paths of the given packages")) + (display (_ " + -K, --keep-failed keep build tree of failed builds")) + (display (_ " + -n, --dry-run do not build the derivations")) + (display (_ " + --no-substitutes build instead of resorting to pre-built substitutes")) + (display (_ " + -c, --cores=N allow the use of up to N CPU cores for the build")) + (display (_ " + -r, --root=FILE make FILE a symlink to the result, and register it + as a garbage collector root")) + (display (_ " + --verbosity=LEVEL use the given verbosity LEVEL")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix-build"))) + + (option '(#\S "source") #f #f + (lambda (opt name arg result) + (alist-cons 'source? #t result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '(#\d "derivations") #f #f + (lambda (opt name arg result) + (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))) + (option '(#\K "keep-failed") #f #f + (lambda (opt name arg result) + (alist-cons 'keep-failed? #t result))) + (option '(#\c "cores") #t #f + (lambda (opt name arg result) + (let ((c (false-if-exception (string->number arg)))) + (if c + (alist-cons 'cores c result) + (leave (_ "~a: not a number~%") arg))))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + (option '("no-substitutes") #f #f + (lambda (opt name arg result) + (alist-cons 'substitutes? #f + (alist-delete 'substitutes? result)))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))) + (option '("verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-build . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (define (register-root paths root) + ;; Register ROOT as an indirect GC root for all of PATHS. + (let* ((root (string-append (canonicalize-path (dirname root)) + "/" root))) + (catch 'system-error + (lambda () + (match paths + ((path) + (symlink path root) + (add-indirect-root (%store) root)) + ((paths ...) + (fold (lambda (path count) + (let ((root (string-append root "-" (number->string count)))) + (symlink path root) + (add-indirect-root (%store) root)) + (+ 1 count)) + 0 + paths)))) + (lambda args + (format (current-error-port) + (_ "failed to create GC root `~a': ~a~%") + root (strerror (system-error-errno args))) + (exit 1))))) + + (define newest-available-packages + (memoize find-newest-available-packages)) + + (define (find-best-packages-by-name name version) + (if version + (find-packages-by-name name version) + (match (vhash-assoc name (newest-available-packages)) + ((_ version pkgs ...) pkgs) + (#f '())))) + + (define (find-package request) + ;; Return a package matching REQUEST. REQUEST may be a package + ;; name, or a package name followed by a hyphen and a version + ;; number. If the version number is not present, return the + ;; preferred newest version. + (let-values (((name version) + (package-name->name+version request))) + (match (find-best-packages-by-name name version) + ((p) ; one match + p) + ((p x ...) ; several matches + (format (current-error-port) + (_ "warning: ambiguous package specification `~a'~%") + request) + (format (current-error-port) + (_ "warning: choosing ~a from ~a~%") + (package-full-name p) + (location->string (package-location p))) + p) + (_ ; no matches + (if version + (leave (_ "~A: package not found for version ~a~%") + name version) + (leave (_ "~A: unknown package~%") name)))))) + + (install-locale) + (textdomain "guix") + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (with-error-handling + (let ((opts (parse-options))) + (parameterize ((%store (open-connection))) + (let* ((src? (assoc-ref opts 'source?)) + (sys (assoc-ref opts 'system)) + (drv (filter-map (match-lambda + (('expression . exp) + (derivations-from-package-expressions exp sys + src?)) + (('argument . (? derivation-path? drv)) + drv) + (('argument . (? string? x)) + (let ((p (find-package x))) + (if src? + (let ((s (package-source p))) + (package-source-derivation + (%store) s)) + (package-derivation (%store) p sys)))) + (_ #f)) + opts)) + (req (append-map (lambda (drv-path) + (let ((d (call-with-input-file drv-path + read-derivation))) + (derivation-prerequisites-to-build (%store) d))) + drv)) + (req* (delete-duplicates + (append (remove (compose (cut valid-path? (%store) <>) + derivation-path->output-path) + drv) + (map derivation-input-path req)))) + (roots (filter-map (match-lambda + (('gc-root . root) root) + (_ #f)) + opts))) + (if (assoc-ref opts 'dry-run?) + (format (current-error-port) + (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*) + (format (current-error-port) + (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*)) + + ;; TODO: Add more options. + (set-build-options (%store) + #:keep-failed? (assoc-ref opts 'keep-failed?) + #:build-cores (or (assoc-ref opts 'cores) 0) + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:verbosity (assoc-ref opts 'verbosity)) + + (if (assoc-ref opts 'derivations-only?) + (begin + (format #t "~{~a~%~}" drv) + (for-each (cut register-root <> <>) + (map list drv) roots)) + (or (assoc-ref opts 'dry-run?) + (and (build-derivations (%store) drv) + (for-each (lambda (d) + (let ((drv (call-with-input-file d + read-derivation))) + (format #t "~{~a~%~}" + (map (match-lambda + ((out-name . out) + (derivation-path->output-path + d out-name))) + (derivation-outputs drv))))) + drv) + (for-each (cut register-root <> <>) + (map (lambda (drv) + (map cdr + (derivation-path->output-paths drv))) + drv) + roots))))))))) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm new file mode 100644 index 0000000000..1098e6714b --- /dev/null +++ b/guix/scripts/download.scm @@ -0,0 +1,151 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 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 scripts download) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix base32) + #:use-module ((guix download) #:select (%mirrors)) + #:use-module (guix build download) + #:use-module (web uri) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:export (guix-download)) + +(define (call-with-temporary-output-file proc) + (let* ((template (string-copy "guix-download.XXXXXX")) + (out (mkstemp! template))) + (dynamic-wind + (lambda () + #t) + (lambda () + (proc template out)) + (lambda () + (false-if-exception (delete-file template)))))) + +(define (fetch-and-store store fetch name) + "Call FETCH for URI, and pass it the name of a file to write to; eventually, +copy data from that port to STORE, under NAME. Return the resulting +store path." + (call-with-temporary-output-file + (lambda (temp port) + (let ((result + (parameterize ((current-output-port (current-error-port))) + (fetch temp)))) + (close port) + (and result + (add-to-store store name #f "sha256" temp)))))) + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((format . ,bytevector->nix-base32-string))) + +(define (show-help) + (display (_ "Usage: guix download [OPTION]... URL +Download the file at URL, add it to the store, and print its store path +and the hash of its contents.\n")) + (format #t (_ " + -f, --format=FMT write the hash in the given format (default: `nix-base32')")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\f "format") #t #f + (lambda (opt name arg result) + (define fmt-proc + (match arg + ("nix-base32" + bytevector->nix-base32-string) + ("base32" + bytevector->base32-string) + ((or "base16" "hex" "hexadecimal") + bytevector->base16-string) + (x + (format (current-error-port) + "unsupported hash format: ~a~%" arg)))) + + (alist-cons 'format fmt-proc + (alist-delete 'format result)))) + + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix-download"))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-download . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (install-locale) + (textdomain "guix") + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (let* ((opts (parse-options)) + (store (open-connection)) + (arg (assq-ref opts 'argument)) + (uri (or (string->uri arg) + (leave (_ "guix-download: ~a: failed to parse URI~%") + arg))) + (path (case (uri-scheme uri) + ((file) + (add-to-store store (basename (uri-path uri)) + #f "sha256" (uri-path uri))) + (else + (fetch-and-store store + (cut url-fetch arg <> + #:mirrors %mirrors) + (basename (uri-path uri)))))) + (hash (call-with-input-file + (or path + (leave (_ "guix-download: ~a: download failed~%") + arg)) + (compose sha256 get-bytevector-all))) + (fmt (assq-ref opts 'format))) + (format #t "~a~%~a~%" path (fmt hash)) + #t)) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm new file mode 100644 index 0000000000..8e2587186e --- /dev/null +++ b/guix/scripts/gc.scm @@ -0,0 +1,165 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 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 scripts gc) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-gc)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((action . collect-garbage))) + +(define (show-help) + (display (_ "Usage: guix gc [OPTION]... PATHS... +Invoke the garbage collector.\n")) + (display (_ " + -C, --collect-garbage[=MIN] + collect at least MIN bytes of garbage")) + (display (_ " + -d, --delete attempt to delete PATHS")) + (display (_ " + --list-dead list dead paths")) + (display (_ " + --list-live list live paths")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define (size->number str) + "Convert STR, a storage measurement representation such as \"1024\" or +\"1MiB\", to a number of bytes. Raise an error if STR could not be +interpreted." + (define unit-pos + (string-rindex str char-set:digit)) + + (define unit + (and unit-pos (substring str (+ 1 unit-pos)))) + + (let* ((numstr (if unit-pos + (substring str 0 (+ 1 unit-pos)) + str)) + (num (string->number numstr))) + (if num + (* num + (match unit + ("KiB" (expt 2 10)) + ("MiB" (expt 2 20)) + ("GiB" (expt 2 30)) + ("TiB" (expt 2 40)) + ("KB" (expt 10 3)) + ("MB" (expt 10 6)) + ("GB" (expt 10 9)) + ("TB" (expt 10 12)) + ("" 1) + (_ + (format (current-error-port) (_ "error: unknown unit: ~a~%") + unit) + (exit 1)))) + (begin + (format (current-error-port) + (_ "error: invalid number: ~a") numstr) + (exit 1))))) + +(define %options + ;; Specification of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix-gc"))) + + (option '(#\C "collect-garbage") #f #t + (lambda (opt name arg result) + (let ((result (alist-cons 'action 'collect-garbage + (alist-delete 'action result)))) + (match arg + ((? string?) + (let ((amount (size->number arg))) + (if arg + (alist-cons 'min-freed amount result) + (begin + (format (current-error-port) + (_ "error: invalid amount of storage: ~a~%") + arg) + (exit 1))))) + (#f result))))) + (option '(#\d "delete") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'delete + (alist-delete 'action result)))) + (option '("list-dead") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-dead + (alist-delete 'action result)))) + (option '("list-live") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-live + (alist-delete 'action result)))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-gc . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (with-error-handling + (let ((opts (parse-options)) + (store (open-connection))) + (case (assoc-ref opts 'action) + ((collect-garbage) + (let ((min-freed (assoc-ref opts 'min-freed))) + (if min-freed + (collect-garbage store min-freed) + (collect-garbage store)))) + ((delete) + (let ((paths (filter-map (match-lambda + (('argument . arg) arg) + (_ #f)) + opts))) + (delete-paths store paths))) + ((list-dead) + (for-each (cut simple-format #t "~a~%" <>) + (dead-paths store))) + ((list-live) + (for-each (cut simple-format #t "~a~%" <>) + (live-paths store))))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm new file mode 100644 index 0000000000..0bc6926c66 --- /dev/null +++ b/guix/scripts/import.scm @@ -0,0 +1,124 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 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 scripts import) + #:use-module (guix ui) + #:use-module (guix snix) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:export (guix-import)) + + +;;; +;;; Helper. +;;; + +(define (newline-rewriting-port output) + "Return an output port that rewrites strings containing the \\n escape +to an actual newline. This works around the behavior of `pretty-print' +and `write', which output these as \\n instead of actual newlines, +whereas we want the `description' field to contain actual newlines +rather than \\n." + (define (write-string str) + (let loop ((chars (string->list str))) + (match chars + (() + #t) + ((#\\ #\n rest ...) + (newline output) + (loop rest)) + ((chr rest ...) + (write-char chr output) + (loop rest))))) + + (make-soft-port (vector (cut write-char <>) + write-string + (lambda _ #t) ; flush + #f + (lambda _ #t) ; close + #f) + "w")) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import NIXPKGS ATTRIBUTE +Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix-import"))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-import . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (install-locale) + (textdomain "guix") + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((nixpkgs attribute) + (let-values (((expr loc) + (nixpkgs->guix-package nixpkgs attribute))) + (format #t ";; converted from ~a:~a~%~%" + (location-file loc) (location-line loc)) + (pretty-print expr (newline-rewriting-port (current-output-port))))) + (_ + (leave (_ "wrong number of arguments~%")))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm new file mode 100644 index 0000000000..4935837d33 --- /dev/null +++ b/guix/scripts/package.scm @@ -0,0 +1,693 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2013 Mark H Weaver +;;; +;;; 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 scripts package) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix utils) + #:use-module (guix config) + #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) + #:use-module (ice-9 ftw) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-37) + #:use-module (gnu packages) + #:use-module ((gnu packages base) #:select (guile-final)) + #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) + #:export (guix-package)) + +(define %store + (make-parameter #f)) + + +;;; +;;; User environment. +;;; + +(define %user-environment-directory + (and=> (getenv "HOME") + (cut string-append <> "/.guix-profile"))) + +(define %profile-directory + (string-append (or (getenv "NIX_STATE_DIR") %state-directory) "/profiles/" + (or (and=> (getenv "USER") + (cut string-append "per-user/" <>)) + "default"))) + +(define %current-profile + ;; Call it `guix-profile', not `profile', to allow Guix profiles to + ;; coexist with Nix profiles. + (string-append %profile-directory "/guix-profile")) + +(define (profile-manifest profile) + "Return the PROFILE's manifest." + (let ((manifest (string-append profile "/manifest"))) + (if (file-exists? manifest) + (call-with-input-file manifest read) + '(manifest (version 1) (packages ()))))) + +(define (manifest-packages manifest) + "Return the packages listed in MANIFEST." + (match manifest + (('manifest ('version 0) + ('packages ((name version output path) ...))) + (zip name version output path + (make-list (length name) '()))) + + ;; Version 1 adds a list of propagated inputs to the + ;; name/version/output/path tuples. + (('manifest ('version 1) + ('packages (packages ...))) + packages) + + (_ + (error "unsupported manifest format" manifest)))) + +(define (profile-regexp profile) + "Return a regular expression that matches PROFILE's name and number." + (make-regexp (string-append "^" (regexp-quote (basename profile)) + "-([0-9]+)"))) + +(define (profile-numbers profile) + "Return the list of generation numbers of PROFILE, or '(0) if no +former profiles were found." + (define* (scandir name #:optional (select? (const #t)) + (entry (file-system-fold enter? leaf down up skip error #f name lstat) + (lambda (files) + (sort files entry)) + (#f ; no profile directory + '(0)) + (() ; no profiles + '(0)) + ((profiles ...) ; former profiles around + (map (compose string->number + (cut match:substring <> 1) + (cute regexp-exec (profile-regexp profile) <>)) + profiles)))) + +(define (previous-profile-number profile number) + "Return the number of the generation before generation NUMBER of +PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the +case when generations have been deleted (there are \"holes\")." + (fold (lambda (candidate highest) + (if (and (< candidate number) (> candidate highest)) + candidate + highest)) + 0 + (profile-numbers profile))) + +(define (profile-derivation store packages) + "Return a derivation that builds a profile (a user environment) with +all of PACKAGES, a list of name/version/output/path/deps tuples." + (define builder + `(begin + (use-modules (ice-9 pretty-print) + (guix build union)) + + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (let ((output (assoc-ref %outputs "out")) + (inputs (map cdr %build-inputs))) + (format #t "building user environment `~a' with ~a packages...~%" + output (length inputs)) + (union-build output inputs) + (call-with-output-file (string-append output "/manifest") + (lambda (p) + (pretty-print '(manifest (version 1) + (packages ,packages)) + p)))))) + + (build-expression->derivation store "user-environment" + (%current-system) + builder + (append-map (match-lambda + ((name version output path deps) + `((,name ,path) + ,@deps))) + packages) + #:modules '((guix build union)))) + +(define (profile-number profile) + "Return PROFILE's number or 0. An absolute file name must be used." + (or (and=> (false-if-exception (regexp-exec (profile-regexp profile) + (basename (readlink profile)))) + (compose string->number (cut match:substring <> 1))) + 0)) + +(define (switch-symlinks link target) + "Atomically switch LINK, a symbolic link, to point to TARGET. Works +both when LINK already exists and when it does not." + (let ((pivot (string-append link ".new"))) + (symlink target pivot) + (rename-file pivot link))) + +(define (roll-back profile) + "Roll back to the previous generation of PROFILE." + (let* ((number (profile-number profile)) + (previous-number (previous-profile-number profile number)) + (previous-profile (format #f "~a-~a-link" + profile previous-number)) + (manifest (string-append previous-profile "/manifest"))) + + (define (switch-link) + ;; Atomically switch PROFILE to the previous profile. + (format #t (_ "switching from generation ~a to ~a~%") + number previous-number) + (switch-symlinks profile previous-profile)) + + (cond ((not (file-exists? profile)) ; invalid profile + (format (current-error-port) + (_ "error: profile `~a' does not exist~%") + profile)) + ((zero? number) ; empty profile + (format (current-error-port) + (_ "nothing to do: already at the empty profile~%"))) + ((or (zero? previous-number) ; going to emptiness + (not (file-exists? previous-profile))) + (let*-values (((drv-path drv) + (profile-derivation (%store) '())) + ((prof) + (derivation-output-path + (assoc-ref (derivation-outputs drv) "out")))) + (when (not (build-derivations (%store) (list drv-path))) + (leave (_ "failed to build the empty profile~%"))) + + (switch-symlinks previous-profile prof) + (switch-link))) + (else (switch-link))))) ; anything else + +(define (find-packages-by-description rx) + "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of +matching packages." + (define (same-location? p1 p2) + ;; Compare locations of two packages. + (equal? (package-location p1) (package-location p2))) + + (delete-duplicates + (sort + (fold-packages (lambda (package result) + (define matches? + (cut regexp-exec rx <>)) + + (if (or (and=> (package-synopsis package) + (compose matches? gettext)) + (and=> (package-description package) + (compose matches? gettext))) + (cons package result) + result)) + '()) + (lambda (p1 p2) + (stringname+path input) + "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple." + (let loop ((input input)) + (match input + ((name package) + (loop `(,name ,package "out"))) + ((name package sub-drv) + (let*-values (((_ drv) + (package-derivation (%store) package)) + ((out) + (derivation-output-path + (assoc-ref (derivation-outputs drv) sub-drv)))) + `(,name ,out)))))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((profile . ,%current-profile))) + +(define (show-help) + (display (_ "Usage: guix package [OPTION]... PACKAGES... +Install, remove, or upgrade PACKAGES in a single transaction.\n")) + (display (_ " + -i, --install=PACKAGE install PACKAGE")) + (display (_ " + -r, --remove=PACKAGE remove PACKAGE")) + (display (_ " + -u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP")) + (display (_ " + --roll-back roll back to the previous generation")) + (newline) + (display (_ " + -p, --profile=PROFILE use PROFILE instead of the user's default profile")) + (display (_ " + -n, --dry-run show what would be done without actually doing it")) + (display (_ " + --bootstrap use the bootstrap Guile to build the profile")) + (display (_ " + --verbose produce verbose output")) + (newline) + (display (_ " + -s, --search=REGEXP search in synopsis and description using REGEXP")) + (display (_ " + -I, --list-installed[=REGEXP] + list installed packages matching REGEXP")) + (display (_ " + -A, --list-available[=REGEXP] + list available packages matching REGEXP")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix-package"))) + + (option '(#\i "install") #t #f + (lambda (opt name arg result) + (alist-cons 'install arg result))) + (option '(#\r "remove") #t #f + (lambda (opt name arg result) + (alist-cons 'remove arg result))) + (option '(#\u "upgrade") #t #f + (lambda (opt name arg result) + (alist-cons 'upgrade arg result))) + (option '("roll-back") #f #f + (lambda (opt name arg result) + (alist-cons 'roll-back? #t result))) + (option '(#\p "profile") #t #f + (lambda (opt name arg result) + (alist-cons 'profile arg + (alist-delete 'profile result)))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) + (option '("verbose") #f #f + (lambda (opt name arg result) + (alist-cons 'verbose? #t result))) + (option '(#\s "search") #t #f + (lambda (opt name arg result) + (cons `(query search ,(or arg "")) + result))) + (option '(#\I "list-installed") #f #t + (lambda (opt name arg result) + (cons `(query list-installed ,(or arg "")) + result))) + (option '(#\A "list-available") #f #t + (lambda (opt name arg result) + (cons `(query list-available ,(or arg "")) + result))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-package . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (leave (_ "~A: extraneous argument~%") arg)) + %default-options)) + + (define (guile-missing?) + ;; Return #t if %GUILE-FOR-BUILD is not available yet. + (let ((out (derivation-path->output-path (%guile-for-build)))) + (not (valid-path? (%store) out)))) + + (define (show-what-to-build drv dry-run?) + ;; Show what will/would be built in realizing the derivations listed + ;; in DRV. + (let* ((req (append-map (lambda (drv-path) + (let ((d (call-with-input-file drv-path + read-derivation))) + (derivation-prerequisites-to-build + (%store) d))) + drv)) + (req* (delete-duplicates + (append (remove (compose (cute valid-path? (%store) <>) + derivation-path->output-path) + drv) + (map derivation-input-path req))))) + (if dry-run? + (format (current-error-port) + (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*) + (format (current-error-port) + (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*)))) + + (define newest-available-packages + (memoize find-newest-available-packages)) + + (define (find-best-packages-by-name name version) + (if version + (find-packages-by-name name version) + (match (vhash-assoc name (newest-available-packages)) + ((_ version pkgs ...) pkgs) + (#f '())))) + + (define (find-package name) + ;; Find the package NAME; NAME may contain a version number and a + ;; sub-derivation name. If the version number is not present, + ;; return the preferred newest version. + (define request name) + + (define (ensure-output p sub-drv) + (if (member sub-drv (package-outputs p)) + p + (leave (_ "~a: error: package `~a' lacks output `~a'~%") + (location->string (package-location p)) + (package-full-name p) + sub-drv))) + + (let*-values (((name sub-drv) + (match (string-rindex name #\:) + (#f (values name "out")) + (colon (values (substring name 0 colon) + (substring name (+ 1 colon)))))) + ((name version) + (package-name->name+version name))) + (match (find-best-packages-by-name name version) + ((p) + (list name (package-version p) sub-drv (ensure-output p sub-drv) + (package-transitive-propagated-inputs p))) + ((p p* ...) + (format (current-error-port) + (_ "warning: ambiguous package specification `~a'~%") + request) + (format (current-error-port) + (_ "warning: choosing ~a from ~a~%") + (package-full-name p) + (location->string (package-location p))) + (list name (package-version p) sub-drv (ensure-output p sub-drv) + (package-transitive-propagated-inputs p))) + (() + (leave (_ "~a: package not found~%") request))))) + + (define (upgradeable? name current-version current-path) + ;; Return #t if there's a version of package NAME newer than + ;; CURRENT-VERSION, or if the newest available version is equal to + ;; CURRENT-VERSION but would have an output path different than + ;; CURRENT-PATH. + (match (vhash-assoc name (newest-available-packages)) + ((_ candidate-version pkg . rest) + (case (version-compare candidate-version current-version) + ((>) #t) + ((<) #f) + ((=) (let ((candidate-path (derivation-path->output-path + (package-derivation (%store) pkg)))) + (not (string=? current-path candidate-path)))))) + (#f #f))) + + (define (ensure-default-profile) + ;; Ensure the default profile symlink and directory exist. + + ;; Create ~/.guix-profile if it doesn't exist yet. + (when (and %user-environment-directory + %current-profile + (not (false-if-exception + (lstat %user-environment-directory)))) + (symlink %current-profile %user-environment-directory)) + + ;; Attempt to create /…/profiles/per-user/$USER if needed. + (unless (directory-exists? %profile-directory) + (catch 'system-error + (lambda () + (mkdir-p %profile-directory)) + (lambda args + ;; Often, we cannot create %PROFILE-DIRECTORY because its + ;; parent directory is root-owned and we're running + ;; unprivileged. + (format (current-error-port) + (_ "error: while creating directory `~a': ~a~%") + %profile-directory + (strerror (system-error-errno args))) + (format (current-error-port) + (_ "Please create the `~a' directory, with you as the owner.~%") + %profile-directory) + (exit 1))))) + + (define (process-actions opts) + ;; Process any install/remove/upgrade action from OPTS. + + (define dry-run? (assoc-ref opts 'dry-run?)) + (define verbose? (assoc-ref opts 'verbose?)) + (define profile (assoc-ref opts 'profile)) + + (define (canonicalize-deps deps) + ;; Remove duplicate entries from DEPS, a list of propagated inputs, + ;; where each input is a name/path tuple. + (define (same? d1 d2) + (match d1 + ((_ path1) + (match d2 + ((_ path2) + (string=? path1 path2)))))) + + (delete-duplicates (map input->name+path deps) same?)) + + ;; First roll back if asked to. + (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) + (begin + (roll-back profile) + (process-actions (alist-delete 'roll-back? opts))) + (let* ((installed (manifest-packages (profile-manifest profile))) + (upgrade-regexps (filter-map (match-lambda + (('upgrade . regexp) + (make-regexp regexp)) + (_ #f)) + opts)) + (upgrade (if (null? upgrade-regexps) + '() + (let ((newest (find-newest-available-packages))) + (filter-map (match-lambda + ((name version output path _) + (and (any (cut regexp-exec <> name) + upgrade-regexps) + (upgradeable? name version path) + (find-package name))) + (_ #f)) + installed)))) + (install (append + upgrade + (filter-map (match-lambda + (('install . (? store-path?)) + #f) + (('install . package) + (find-package package)) + (_ #f)) + opts))) + (drv (filter-map (match-lambda + ((name version sub-drv + (? package? package) + (deps ...)) + (package-derivation (%store) package)) + (_ #f)) + install)) + (install* (append + (filter-map (match-lambda + (('install . (? store-path? path)) + (let-values (((name version) + (package-name->name+version + (store-path-package-name + path)))) + `(,name ,version #f ,path ()))) + (_ #f)) + opts) + (map (lambda (tuple drv) + (match tuple + ((name version sub-drv _ (deps ...)) + (let ((output-path + (derivation-path->output-path + drv sub-drv))) + `(,name ,version ,sub-drv ,output-path + ,(canonicalize-deps deps)))))) + install drv))) + (remove (filter-map (match-lambda + (('remove . package) + package) + (_ #f)) + opts)) + (packages (append install* + (fold (lambda (package result) + (match package + ((name _ ...) + (alist-delete name result)))) + (fold alist-delete installed remove) + install*)))) + + (when (equal? profile %current-profile) + (ensure-default-profile)) + + (show-what-to-build drv dry-run?) + + (or dry-run? + (and (build-derivations (%store) drv) + (let* ((prof-drv (profile-derivation (%store) packages)) + (prof (derivation-path->output-path prof-drv)) + (old-drv (profile-derivation + (%store) (manifest-packages + (profile-manifest profile)))) + (old-prof (derivation-path->output-path old-drv)) + (number (profile-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (format #f "~a-~a-link" + profile (+ 1 number)))) + (if (string=? old-prof prof) + (when (or (pair? install) (pair? remove)) + (format (current-error-port) + (_ "nothing to be done~%"))) + (and (parameterize ((current-build-output-port + ;; Output something when Guile + ;; needs to be built. + (if (or verbose? (guile-missing?)) + (current-error-port) + (%make-void-port "w")))) + (build-derivations (%store) (list prof-drv))) + (begin + (switch-symlinks name prof) + (switch-symlinks profile name)))))))))) + + (define (process-query opts) + ;; Process any query specified by OPTS. Return #t when a query was + ;; actually processed, #f otherwise. + (let ((profile (assoc-ref opts 'profile))) + (match (assoc-ref opts 'query) + (('list-installed regexp) + (let* ((regexp (and regexp (make-regexp regexp))) + (manifest (profile-manifest profile)) + (installed (manifest-packages manifest))) + (for-each (match-lambda + ((name version output path _) + (when (or (not regexp) + (regexp-exec regexp name)) + (format #t "~a\t~a\t~a\t~a~%" + name (or version "?") output path)))) + installed) + #t)) + + (('list-available regexp) + (let* ((regexp (and regexp (make-regexp regexp))) + (available (fold-packages + (lambda (p r) + (let ((n (package-name p))) + (if regexp + (if (regexp-exec regexp n) + (cons p r) + r) + (cons p r)))) + '()))) + (for-each (lambda (p) + (format #t "~a\t~a\t~a\t~a~%" + (package-name p) + (package-version p) + (string-join (package-outputs p) ",") + (location->string (package-location p)))) + (sort available + (lambda (p1 p2) + (stringrecutils <> (current-output-port)) + (find-packages-by-description regexp)) + #t)) + (_ #f)))) + + (install-locale) + (textdomain "guix") + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (let ((opts (parse-options))) + (or (process-query opts) + (parameterize ((%store (open-connection))) + (with-error-handling + (parameterize ((%guile-for-build + (package-derivation (%store) + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + guile-final)))) + (process-actions opts))))))) diff --git a/guix/ui.scm b/guix/ui.scm index 4aa93de3b4..644a3070f6 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,6 +31,7 @@ #:export (_ N_ install-locale + initialize-guix leave show-version-and-exit show-bug-report-information @@ -38,7 +40,9 @@ location->string fill-paragraph string->recutils - package->recutils)) + package->recutils + run-guix-command + guix-main)) ;;; Commentary: ;;; @@ -62,6 +66,12 @@ (_ "warning: failed to install locale: ~a~%") (strerror (system-error-errno args)))))) +(define (initialize-guix) + (install-locale) + (textdomain "guix") + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF)) + (define-syntax-rule (leave fmt args ...) "Format FMT and ARGS to the error port and exit." (begin @@ -210,4 +220,30 @@ WIDTH columns." (and=> (package-description p) description->recutils)) (newline port)) +(define (show-guix-usage) + ;; TODO: Dynamically generate a summary of available commands. + (format (current-error-port) + (_ "Usage: guix COMMAND ARGS...~%"))) + +(define (run-guix-command command . args) + ;; TODO: Gracefully report errors + (let* ((module (resolve-interface `(guix scripts ,command))) + (command-main (module-ref module + (symbol-append 'guix- command)))) + (apply command-main args))) + +(define (guix-main arg0 . args) + (initialize-guix) + (let () + (define (option? str) (string-prefix? "-" str)) + (match args + (() (show-guix-usage) (exit 1)) + (("--help") (show-guix-usage)) + (("--version") (show-version-and-exit "guix")) + (((? option? arg1) args ...) (show-guix-usage) (exit 1)) + ((command args ...) + (apply run-guix-command + (string->symbol command) + args))))) + ;;; ui.scm ends here diff --git a/po/POTFILES.in b/po/POTFILES.in index 049a1c707e..5c0f131c06 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -4,8 +4,8 @@ gnu/packages/base.scm gnu/packages/guile.scm gnu/packages/lout.scm gnu/packages/recutils.scm +guix/scripts/build.scm +guix/scripts/download.scm +guix/scripts/package.scm +guix/scripts/gc.scm guix/ui.scm -guix-build.in -guix-download.in -guix-package.in -guix-gc.in diff --git a/pre-inst-env.in b/pre-inst-env.in index 1dc63cd90c..4e079c8d41 100644 --- a/pre-inst-env.in +++ b/pre-inst-env.in @@ -27,9 +27,9 @@ GUILE_LOAD_COMPILED_PATH="@abs_top_builddir@${GUILE_LOAD_COMPILED_PATH:+:}$GUILE GUILE_LOAD_PATH="@abs_top_builddir@:@abs_top_srcdir@${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH -# Define $PATH so that `guix-build' and friends are easily found. +# Define $PATH so that `guix' and friends are easily found. -PATH="@abs_top_builddir@:$PATH" +PATH="@abs_top_builddir@/scripts:@abs_top_builddir@:$PATH" export PATH # Daemon helpers. @@ -43,7 +43,12 @@ export NIX_ROOT_FINDER NIX_SETUID_HELPER # auto-compilation. NIX_HASH="@NIX_HASH@" - export NIX_HASH +# Define $GUIX_UNINSTALLED to prevent `guix' from +# prepending @guilemoduledir@ to the Guile load paths. + +GUIX_UNINSTALLED=1 +export GUIX_UNINSTALLED + exec "$@" diff --git a/scripts/guix.in b/scripts/guix.in new file mode 100644 index 0000000000..2fdde7d13a --- /dev/null +++ b/scripts/guix.in @@ -0,0 +1,56 @@ +#!@GUILE@ -s +-*- scheme -*- +!# +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Mark H Weaver +;;; +;;; 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 . + +;; IMPORTANT: We must avoid loading any modules from Guix here, +;; because we need to adjust the guile load paths first. +;; It's okay to import modules from core Guile though. +(use-modules (ice-9 regex)) + +(let () + (define-syntax-rule (push! elt v) (set! v (cons elt v))) + + (define config-lookup + (let ((config '(("prefix" . "@prefix@") + ("datarootdir" . "@datarootdir@") + ("guilemoduledir" . "@guilemoduledir@"))) + (var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}"))) + (define (expand-var-ref match) + (lookup (match:substring match 1))) + (define (expand str) + (regexp-substitute/global #f var-ref-regexp str + 'pre expand-var-ref 'post)) + (define (lookup name) + (expand (assoc-ref config name))) + lookup)) + + (define (maybe-augment-load-paths!) + (unless (getenv "GUIX_UNINSTALLED") + (let ((module-dir (config-lookup "guilemoduledir"))) + (push! module-dir %load-path) + (push! module-dir %load-compiled-path)))) + + (define (run-guix-main) + (let ((guix-main (module-ref (resolve-interface '(guix ui)) + 'guix-main))) + (apply guix-main (command-line)))) + + (maybe-augment-load-paths!) + (run-guix-main)) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 5718b07d0c..721a7c6769 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -17,44 +17,44 @@ # along with GNU Guix. If not, see . # -# Test the `guix-build' command-line utility. +# Test the `guix build' command-line utility. # -guix-build --version +guix build --version # Should fail. -if guix-build -e +; +if guix build -e +; then false; else true; fi # Should fail because this is a source-less package. -if guix-build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S +if guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S then false; else true; fi # Should pass. -guix-build -e '(@@ (gnu packages base) %bootstrap-guile)' | \ +guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \ grep -e '-guile-' -guix-build hello -d | \ +guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' # Should fail because the name/version combination could not be found. -if guix-build hello-0.0.1 -n; then false; else true; fi +if guix build hello-0.0.1 -n; then false; else true; fi # Keep a symlink to the result, registered as a root. result="t-result-$$" -guix-build -r "$result" \ +guix build -r "$result" \ -e '(@@ (gnu packages base) %bootstrap-guile)' test -x "$result/bin/guile" # Should fail, because $result already exists. -if guix-build -r "$result" -e '(@@ (gnu packages base) %bootstrap-guile)' +if guix build -r "$result" -e '(@@ (gnu packages base) %bootstrap-guile)' then false; else true; fi rm -f "$result" # Parsing package names and versions. -guix-build -n time # PASS -guix-build -n time-1.7 # PASS, version found -if guix-build -n time-3.2; # FAIL, version not found +guix build -n time # PASS +guix build -n time-1.7 # PASS, version found +if guix build -n time-3.2; # FAIL, version not found then false; else true; fi -if guix-build -n something-that-will-never-exist; # FAIL +if guix build -n something-that-will-never-exist; # FAIL then false; else true; fi diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 0d39ff4c24..698516490b 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -23,7 +23,7 @@ set -e guix-daemon --version -guix-build --version +guix build --version -guix-build -e '(@ (gnu packages bootstrap) %bootstrap-guile)' -guix-build coreutils -n +guix build -e '(@ (gnu packages bootstrap) %bootstrap-guile)' +guix build coreutils -n diff --git a/tests/guix-download.sh b/tests/guix-download.sh index f0ea731430..7af6f181f6 100644 --- a/tests/guix-download.sh +++ b/tests/guix-download.sh @@ -17,20 +17,20 @@ # along with GNU Guix. If not, see . # -# Test the `guix-download' command-line utility. +# Test the `guix download' command-line utility. # -guix-download --version +guix download --version # Make sure it fails here. -if guix-download http://does.not/exist +if guix download http://does.not/exist then false; else true; fi -if guix-download unknown://some/where; +if guix download unknown://some/where; then false; else true; fi -if guix-download not/a/uri; +if guix download not/a/uri; then false; else true; fi # This one should succeed. -guix-download "file://$abs_top_srcdir/README" +guix download "file://$abs_top_srcdir/README" diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index 805300eeec..a90d085ab2 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -17,38 +17,38 @@ # along with GNU Guix. If not, see . # -# Test the `guix-gc' command-line utility. +# Test the `guix gc' command-line utility. # -guix-gc --version +guix gc --version trap "rm -f guix-gc-root" EXIT rm -f guix-gc-root # Add then reclaim a .drv file. -drv="`guix-build idutils -d`" +drv="`guix build idutils -d`" test -f "$drv" -guix-gc --list-dead | grep "$drv" -guix-gc --delete "$drv" +guix gc --list-dead | grep "$drv" +guix gc --delete "$drv" ! test -f "$drv" # Add a .drv, register it as a root. -drv="`guix-build --root=guix-gc-root lsh -d`" +drv="`guix build --root=guix-gc-root lsh -d`" test -f "$drv" && test -L guix-gc-root -guix-gc --list-live | grep "$drv" -if guix-gc --delete "$drv"; +guix gc --list-live | grep "$drv" +if guix gc --delete "$drv"; then false; else true; fi rm guix-gc-root -guix-gc --list-dead | grep "$drv" -guix-gc --delete "$drv" +guix gc --list-dead | grep "$drv" +guix gc --delete "$drv" ! test -f "$drv" # Try a random collection. -guix-gc -C 1KiB +guix gc -C 1KiB # Check trivial error cases. -if guix-gc --delete /dev/null; +if guix gc --delete /dev/null; then false; else true; fi diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 617318b796..cf8bc5c7e8 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -18,10 +18,10 @@ # along with GNU Guix. If not, see . # -# Test the `guix-package' command-line utility. +# Test the `guix package' command-line utility. # -guix-package --version +guix package --version readlink_base () { @@ -33,12 +33,12 @@ rm -f "$profile" trap 'rm "$profile" "$profile-"[0-9]* ; rm -rf t-home-'"$$" EXIT -guix-package --bootstrap -p "$profile" -i guile-bootstrap +guix package --bootstrap -p "$profile" -i guile-bootstrap test -L "$profile" && test -L "$profile-1-link" test -f "$profile/bin/guile" # Installing the same package a second time does nothing. -guix-package --bootstrap -p "$profile" -i guile-bootstrap +guix package --bootstrap -p "$profile" -i guile-bootstrap test -L "$profile" && test -L "$profile-1-link" ! test -f "$profile-2-link" test -f "$profile/bin/guile" @@ -46,8 +46,8 @@ 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="`guix build -e '(@@ (gnu packages base) gnu-make-boot0)'`" + guix package --bootstrap -p "$profile" -i "$boot_make" test -L "$profile-2-link" test -f "$profile/bin/make" && test -f "$profile/bin/guile" @@ -55,7 +55,7 @@ then # Check whether `--list-installed' works. # XXX: Change the tests when `--install' properly extracts the package # name and version string. - installed="`guix-package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`" + installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`" case "x$installed" in "guile-bootstrap make-boot0") true;; @@ -65,68 +65,68 @@ then false;; esac - test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap" + test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap" # Search. - test "`guix-package -s "GNU Hello" | grep ^name:`" = "name: hello" - test "`guix-package -s "n0t4r341p4ck4g3"`" = "" + test "`guix package -s "GNU Hello" | grep ^name:`" = "name: hello" + test "`guix package -s "n0t4r341p4ck4g3"`" = "" # Remove a package. - guix-package --bootstrap -p "$profile" -r "guile-bootstrap" + guix package --bootstrap -p "$profile" -r "guile-bootstrap" test -L "$profile-3-link" test -f "$profile/bin/make" && ! test -f "$profile/bin/guile" # Roll back. - guix-package --roll-back -p "$profile" + guix package --roll-back -p "$profile" test "`readlink_base "$profile"`" = "$profile-2-link" test -x "$profile/bin/guile" && test -x "$profile/bin/make" - guix-package --roll-back -p "$profile" + guix package --roll-back -p "$profile" test "`readlink_base "$profile"`" = "$profile-1-link" test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" # Move to the empty profile. for i in `seq 1 3` do - guix-package --bootstrap --roll-back -p "$profile" + guix package --bootstrap --roll-back -p "$profile" ! test -f "$profile/bin" ! test -f "$profile/lib" test "`readlink_base "$profile"`" = "$profile-0-link" done # Reinstall after roll-back to the empty profile. - guix-package --bootstrap -p "$profile" -i "$boot_make" + guix package --bootstrap -p "$profile" -i "$boot_make" test "`readlink_base "$profile"`" = "$profile-1-link" test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" # Roll-back to generation 0, and install---all at once. - guix-package --bootstrap -p "$profile" --roll-back -i guile-bootstrap + guix package --bootstrap -p "$profile" --roll-back -i guile-bootstrap test "`readlink_base "$profile"`" = "$profile-1-link" 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" -i "$boot_make" test "`readlink_base "$profile"`" = "$profile-2-link" test -x "$profile/bin/guile" && test -x "$profile/bin/make" # Make a "hole" in the list of generations, and make sure we can # roll back "over" it. rm "$profile-1-link" - guix-package --bootstrap -p "$profile" --roll-back + guix package --bootstrap -p "$profile" --roll-back test "`readlink_base "$profile"`" = "$profile-0-link" fi # Make sure the `:' syntax works. -guix-package --bootstrap -i "binutils:lib" -p "$profile" -n +guix package --bootstrap -i "binutils:lib" -p "$profile" -n # Make sure nonexistent outputs are reported. -guix-package --bootstrap -i "guile-bootstrap:out" -p "$profile" -n -if guix-package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n; +guix package --bootstrap -i "guile-bootstrap:out" -p "$profile" -n +if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n; then false; else true; fi -if guix-package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile"; +if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile"; then false; else true; fi # Check whether `--list-available' returns something sensible. -guix-package -A 'gui.*e' | grep guile +guix package -A 'gui.*e' | grep guile # # Try with the default profile. @@ -139,17 +139,17 @@ export HOME mkdir -p "$HOME" -guix-package --bootstrap -i guile-bootstrap +guix package --bootstrap -i guile-bootstrap test -L "$HOME/.guix-profile" 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 -i "$boot_make" test -f "$HOME/.guix-profile/bin/make" first_environment="`cd $HOME/.guix-profile ; pwd`" - guix-package --bootstrap --roll-back + guix package --bootstrap --roll-back test -f "$HOME/.guix-profile/bin/guile" ! test -f "$HOME/.guix-profile/bin/make" test "`cd $HOME/.guix-profile ; pwd`" = "$first_environment" @@ -159,12 +159,12 @@ fi default_profile="`readlink "$HOME/.guix-profile"`" for i in `seq 1 3` do - guix-package --bootstrap --roll-back + guix package --bootstrap --roll-back ! test -f "$HOME/.guix-profile/bin" ! test -f "$HOME/.guix-profile/lib" test "`readlink "$default_profile"`" = "$default_profile-0-link" done # Extraneous argument. -if guix-package install foo-bar; +if guix package install foo-bar; then false; else true; fi -- cgit v1.2.3 From a24b75d8e1753da629ecf945f4022eee4c340aed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Feb 2013 15:01:52 +0100 Subject: gnu: texinfo: Update to 5.0. * gnu/packages/texinfo.scm (texinfo): Update to 5.0. --- gnu/packages/texinfo.scm | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm index 9a264c627c..dba5cd2c2e 100644 --- a/gnu/packages/texinfo.scm +++ b/gnu/packages/texinfo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès +;;; Copyright © 2012, 2013 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,28 +22,26 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages compression) + #:use-module (gnu packages perl) #:use-module (gnu packages ncurses)) (define-public texinfo (package (name "texinfo") - (version "4.13a") - (source - (origin - (method url-fetch) - (uri (string-append - "mirror://gnu/texinfo/texinfo-" - version - ".tar.lzma")) - (sha256 - (base32 - "1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d")))) + (version "5.0") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/texinfo/texinfo-" + version ".tar.xz")) + (sha256 + (base32 + "1p34f68h9ggfj6ckgj0p62qlj7pmz3ha3vc91kh4hr44pnwm1pla")))) (build-system gnu-build-system) - (inputs `(("ncurses" ,ncurses) ("xz" ,xz))) - (home-page - "http://www.gnu.org/software/texinfo/") - (synopsis - "GNU Texinfo, the GNU documentation system") + (inputs `(("perl" ,perl) ; yuck! + ("ncurses" ,ncurses) + ("xz" ,xz))) + (home-page "http://www.gnu.org/software/texinfo/") + (synopsis "GNU Texinfo, the GNU documentation system") (description "Texinfo is the official documentation format of the GNU project. It was invented by Richard Stallman and Bob Chassell many years -- cgit v1.2.3 From 633f045f62b783f6fb70b4d436d073a8103a8433 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Feb 2013 15:38:02 +0100 Subject: scripts: Remove initialization now redundant with `initialize-guix'. * guix/scripts/build.scm (guix-build): Remove calls to `install-locale', `textdomain', etc., now redundant with `initialize-guix'. * guix/scripts/download.scm (guix-download): Likewise. * guix/scripts/import.scm (guix-import): Likewise. * guix/scripts/package.scm (guix-package): Likewise. * guix/ui.scm: Remove export of `install-locale' and `initialize-guix'. (initialize-guix): Add docstring. --- guix/scripts/build.scm | 5 ----- guix/scripts/download.scm | 5 ----- guix/scripts/import.scm | 5 ----- guix/scripts/package.scm | 5 ----- guix/ui.scm | 3 +-- 5 files changed, 1 insertion(+), 22 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index bad04418f1..3e241ca9da 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -221,11 +221,6 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) name version) (leave (_ "~A: unknown package~%") name)))))) - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - (with-error-handling (let ((opts (parse-options))) (parameterize ((%store (open-connection))) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 1098e6714b..790cf9fc2f 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -121,11 +121,6 @@ and the hash of its contents.\n")) (alist-cons 'argument arg result)) %default-options)) - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - (let* ((opts (parse-options)) (store (open-connection)) (arg (assq-ref opts 'argument)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 0bc6926c66..f0aaa80aa0 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -102,11 +102,6 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) (alist-cons 'argument arg result)) %default-options)) - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 4935837d33..559be50824 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -676,11 +676,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) #t)) (_ #f)))) - (install-locale) - (textdomain "guix") - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - (let ((opts (parse-options))) (or (process-query opts) (parameterize ((%store (open-connection))) diff --git a/guix/ui.scm b/guix/ui.scm index 644a3070f6..af8b238ce1 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -30,8 +30,6 @@ #:use-module (ice-9 match) #:export (_ N_ - install-locale - initialize-guix leave show-version-and-exit show-bug-report-information @@ -67,6 +65,7 @@ (strerror (system-error-errno args)))))) (define (initialize-guix) + "Perform the usual initialization for stand-alone Guix commands." (install-locale) (textdomain "guix") (setvbuf (current-output-port) _IOLBF) -- cgit v1.2.3 From d8f257f99e0e3925b46898c1579ebfaaaad75094 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Feb 2013 13:23:45 -0500 Subject: Update `TODO'. --- TODO | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/TODO b/TODO index eb0cb9b2c3..f115b4f47c 100644 --- a/TODO +++ b/TODO @@ -51,7 +51,7 @@ 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 own instance at gnu.org. -* add guix-pull +* 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 @@ -152,10 +152,9 @@ Support sophisticated collision handling when building a union: check whether the colliding files are identical, honor per-package priorities, etc. -* guix-package +* guix package ** add ‘--list-generations’, and ‘--delete-generations’ -** add ‘--upgrade’ * guix build utils ** Add equivalent to "rm -rf" -- cgit v1.2.3 From fd80c705b1768f4b716561c38e77af01e73377b7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Feb 2013 13:25:06 -0500 Subject: gnu: guile-reader: Rename packages to avoid version number confusion. * gnu/packages/guile.scm (guile-reader): Change the character preceding the guile version number from '-' to '_' so that it will not be misinterpreted as the package version number. --- gnu/packages/guile.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 729a921346..58e7c2910c 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -162,7 +162,7 @@ call interface, and powerful string processing.") "Build Guile-Reader against GUILE, a package of some version of Guile 1.8 or 2.0." (package - (name (string-append "guile-reader-for-guile-" (package-version guile))) + (name (string-append "guile-reader-for-guile_" (package-version guile))) (version "0.6") (source (origin (method url-fetch) -- cgit v1.2.3 From fdca1c079b7c1222f097a6f3a60a86e04dc8a1a4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Feb 2013 16:25:30 +0100 Subject: scripts: Remove hyphen in the command name shown by `--version'. * guix/scripts/build.scm (%options): Remove hyphen from the name passed to `show-version-and-exit'. * guix/scripts/download.scm (%options): Likewise. * guix/scripts/gc.scm (%options): Likewise. * guix/scripts/import.scm (%options): Likewise. * guix/scripts/package.scm (%options): Likewise. --- guix/scripts/build.scm | 2 +- guix/scripts/download.scm | 2 +- guix/scripts/gc.scm | 2 +- guix/scripts/import.scm | 2 +- guix/scripts/package.scm | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 3e241ca9da..7863fb881b 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -105,7 +105,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix-build"))) + (show-version-and-exit "guix build"))) (option '(#\S "source") #f #f (lambda (opt name arg result) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 790cf9fc2f..10370e59af 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -104,7 +104,7 @@ and the hash of its contents.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix-download"))))) + (show-version-and-exit "guix download"))))) ;;; diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 8e2587186e..f2d2e17d4b 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -97,7 +97,7 @@ interpreted." (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix-gc"))) + (show-version-and-exit "guix gc"))) (option '(#\C "collect-garbage") #f #t (lambda (opt name arg result) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index f0aaa80aa0..0b95afced1 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -85,7 +85,7 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix-import"))))) + (show-version-and-exit "guix import"))))) ;;; diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 559be50824..23786fb7d8 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -327,7 +327,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix-package"))) + (show-version-and-exit "guix package"))) (option '(#\i "install") #t #f (lambda (opt name arg result) -- cgit v1.2.3 From 855a8ad71def2ebc594ed32c57bda0ca4e13d91c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Feb 2013 22:18:16 +0100 Subject: build: Build guix/scripts/download.go after guix/build/download.go. * Makefile.am (guix/scripts/download.go): Add dependency on `guix/build/download.go'. Reported by Nikita Karetnikov . --- Makefile.am | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile.am b/Makefile.am index 5932e1350a..cabbe21cdd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -164,6 +164,9 @@ MODULES = \ gnu/packages/zip.scm \ gnu/system/vm.scm +# Because of the autoload hack in (guix build download), we must build it +# first to avoid errors on systems where (gnutls) is unavailable. +guix/scripts/download.go: guix/build/download.go GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go -- cgit v1.2.3 From 9c8ba706d0b95684c27e407396e4b29790e0f27c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Feb 2013 22:19:11 +0100 Subject: Add Mark to `AUTHORS'. --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index f604029914..fc9a7fdd90 100644 --- a/AUTHORS +++ b/AUTHORS @@ -12,3 +12,4 @@ alphabetical order): Andreas Enge Nikita Karetnikov Cyril Roelandt + Mark H. Weaver -- cgit v1.2.3 From 9fd72fb1ffbc3800c28f90a1b36e15d3fba974e1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Feb 2013 21:53:59 +0100 Subject: store: Add the `%daemon-socket-file' parameter. * guix/store.scm (%daemon-socket-file): New variable. (open-connection): Use it as the default value for FILE. --- guix/store.scm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index 6a3f036a8c..3627d5be04 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -31,7 +31,9 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw) #:use-module (ice-9 regex) - #:export (nix-server? + #:export (%daemon-socket-file + + nix-server? nix-server-major-version nix-server-minor-version nix-server-socket @@ -143,6 +145,12 @@ (string-append (or (getenv "NIX_STATE_DIR") %state-directory) "/daemon-socket/socket")) +(define %daemon-socket-file + ;; File name of the socket the daemon listens too. + (make-parameter (or (getenv "GUIX_DAEMON_SOCKET") + %default-socket-path))) + + ;; serialize.cc @@ -365,7 +373,7 @@ (message nix-protocol-error-message) (status nix-protocol-error-status)) -(define* (open-connection #:optional (file %default-socket-path) +(define* (open-connection #:optional (file (%daemon-socket-file)) #:key (reserve-space? #t)) "Connect to the daemon over the Unix-domain socket at FILE. When RESERVE-SPACE? is true, instruct it to reserve a little bit of extra -- cgit v1.2.3 From 15b673ebe88cd98d3f49039a5da1a37bfc5f9b8e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Feb 2013 22:43:07 +0100 Subject: Update from upstream Nix. --- nix-upstream | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nix-upstream b/nix-upstream index e42df686f3..3e067ac11c 160000 --- a/nix-upstream +++ b/nix-upstream @@ -1 +1 @@ -Subproject commit e42df686f309c5cd08a8653207e79e9caae37b67 +Subproject commit 3e067ac11c1621f989011432f619652a9c20e6f4 -- cgit v1.2.3 From b8d2aa264de4ebff472698347588f36ed6d4a3e8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Feb 2013 22:48:13 +0100 Subject: daemon: Add `--listen'. * nix/nix-daemon/guix-daemon.cc (GUIX_OPT_LISTEN): New macro. (options): Add `--listen'. (parse_opt): Handle it. * doc/guix.texi (Invoking guix-daemon): Mention it. --- doc/guix.texi | 7 +++++++ nix/nix-daemon/guix-daemon.cc | 19 ++++++++++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/doc/guix.texi b/doc/guix.texi index f84b37686a..849ab06c4a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -367,6 +367,13 @@ Do not keep build logs. By default they are kept under Assume @var{system} as the current system type. By default it is the architecture/kernel pair found at configure time, such as @code{x86_64-linux}. + +@item --listen=@var{socket} +Listen for connections on @var{socket}, the file name of a Unix-domain +socket. The default socket is +@file{@var{localstatedir}/daemon-socket/socket}. This option is only +useful in exceptional circumstances, such as if you need to run several +daemons on the same machine. @end table diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index 604a26f0b1..1611840bd4 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -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. @@ -64,6 +64,7 @@ builds derivations on behalf of its clients."; #define GUIX_OPT_IMPERSONATE_LINUX_26 8 #define GUIX_OPT_DEBUG 9 #define GUIX_OPT_CHROOT_DIR 10 +#define GUIX_OPT_LISTEN 11 static const struct argp_option options[] = { @@ -103,6 +104,8 @@ static const struct argp_option options[] = " (this option has no effect in this configuration)" #endif }, + { "listen", GUIX_OPT_LISTEN, "SOCKET", 0, + "Listen for connections on SOCKET" }, { "debug", GUIX_OPT_DEBUG, 0, 0, "Produce debugging output" }, { 0, 0, 0, 0, 0 } @@ -138,6 +141,17 @@ parse_opt (int key, char *arg, struct argp_state *state) case GUIX_OPT_LOSE_LOGS: settings.keepLog = false; break; + case GUIX_OPT_LISTEN: + try + { + settings.nixDaemonSocketFile = canonPath (arg); + } + catch (std::exception &e) + { + fprintf (stderr, "error: %s\n", e.what ()); + exit (EXIT_FAILURE); + } + break; case GUIX_OPT_DEBUG: verbosity = lvlDebug; break; @@ -207,6 +221,9 @@ main (int argc, char *argv[]) } #endif + printMsg (lvlDebug, + format ("listening on `%1%'") % settings.nixDaemonSocketFile); + run (nothing); } catch (std::exception &e) -- cgit v1.2.3 From 0442d3459559df7f1f4ab1f0ca2077cb070dea41 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Feb 2013 22:58:56 +0100 Subject: build: Add missing -I flag for the daemon. * daemon.am (libstore_a_CPPFLAGS): Add missing -I, for schema.sql.hh. --- daemon.am | 1 + 1 file changed, 1 insertion(+) diff --git a/daemon.am b/daemon.am index e314e4d222..0c9bc9fb69 100644 --- a/daemon.am +++ b/daemon.am @@ -105,6 +105,7 @@ libstore_headers = \ libstore_a_CPPFLAGS = \ $(libutil_a_CPPFLAGS) \ -I$(top_srcdir)/nix/libstore \ + -I$(top_builddir)/nix/libstore \ -DNIX_STORE_DIR=\"$(storedir)\" \ -DNIX_DATA_DIR=\"$(datadir)\" \ -DNIX_STATE_DIR=\"$(localstatedir)/nix\" \ -- cgit v1.2.3 From f6d7be1e47961d78b7b94f9368bae3a716f73b74 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 21:06:57 +0100 Subject: gnu: texinfo: Make Perl a propagated input. * gnu/packages/texinfo.scm (texinfo): Make PERL a propagated input. --- gnu/packages/texinfo.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm index dba5cd2c2e..96016c053d 100644 --- a/gnu/packages/texinfo.scm +++ b/gnu/packages/texinfo.scm @@ -37,9 +37,10 @@ (base32 "1p34f68h9ggfj6ckgj0p62qlj7pmz3ha3vc91kh4hr44pnwm1pla")))) (build-system gnu-build-system) - (inputs `(("perl" ,perl) ; yuck! - ("ncurses" ,ncurses) + (inputs `(("ncurses" ,ncurses) ("xz" ,xz))) + ;; TODO: Remove Perl from here when 'patch-shebang' DTRT with /usr/bin/env. + (propagated-inputs `(("perl" ,perl))) ; yuck! (home-page "http://www.gnu.org/software/texinfo/") (synopsis "GNU Texinfo, the GNU documentation system") (description -- cgit v1.2.3 From 8dcb0c55ab90c5e994f5adf1dfc68180197489bc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 21:08:09 +0100 Subject: derivations: Add a search path parameter for module derivations. * guix/derivations.scm (imported-modules, compiled-modules): Add a `module-path' parameter. Use it instead of %LOAD-PATH. --- guix/derivations.scm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 60d57afa12..18a637ae5a 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -558,9 +558,10 @@ system, imported, and appears under FINAL-PATH in the resulting store path." (define* (imported-modules store modules #:key (name "module-import") (system (%current-system)) - (guile (%guile-for-build))) + (guile (%guile-for-build)) + (module-path %load-path)) "Return a derivation that contains the source files of MODULES, a list of -module names such as `(ice-9 q)'. All of MODULES must be in the current +module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH search path." ;; TODO: Determine the closure of MODULES, build the `.go' files, ;; canonicalize the source files through read/write, etc. @@ -568,7 +569,7 @@ search path." (let ((f (string-append (string-join (map symbol->string m) "/") ".scm"))) - (cons f (search-path %load-path f)))) + (cons f (search-path module-path f)))) modules))) (imported-files store files #:name name #:system system #:guile guile))) @@ -576,13 +577,15 @@ search path." (define* (compiled-modules store modules #:key (name "module-import-compiled") (system (%current-system)) - (guile (%guile-for-build))) + (guile (%guile-for-build)) + (module-path %load-path)) "Return a derivation that builds a tree containing the `.go' files corresponding to MODULES. All the MODULES are built in a context where they can refer to each other." (let* ((module-drv (imported-modules store modules #:system system - #:guile guile)) + #:guile guile + #:module-path module-path)) (module-dir (derivation-path->output-path module-drv)) (files (map (lambda (m) (let ((f (string-join (map symbol->string m) -- cgit v1.2.3 From 80736cdf200105cb15872130cf1bb266c588505c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 22:59:35 +0100 Subject: download: Adjust to `http-get*' deprecation. * guix/build/download.scm (http-fetch): Adjust to use #:streaming? when using Guile 2.0.8+. --- guix/build/download.scm | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index cda715993e..6c2e8235d0 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -178,17 +178,26 @@ which is not available during bootstrap." (define (http-fetch uri file) "Fetch data from URI and write it to FILE. Return FILE on success." + (define post-2.0.7? + (or (string>? (major-version) "2") + (string>? (minor-version) "0") + (string>? (micro-version) "7") + (string>? (version) "2.0.7"))) + (let*-values (((connection) (open-connection-for-uri uri)) ((resp bv-or-port) - ;; XXX: `http-get*' was introduced in 2.0.7. We know - ;; we're using it within the chroot, but - ;; `guix-download' might be using a different version. - ;; So keep this compatibility hack for now. - (if (module-defined? (resolve-interface '(web client)) - 'http-get*) - (http-get* uri #:port connection #:decode-body? #f) - (http-get uri #:port connection #:decode-body? #f))) + ;; XXX: `http-get*' was introduced in 2.0.7, and replaced by + ;; #:streaming? in 2.0.8. We know we're using it within the + ;; chroot, but `guix-download' might be using a different + ;; version. So keep this compatibility hack for now. + (if post-2.0.7? + (http-get uri #:port connection #:decode-body? #f + #:streaming? #t) + (if (module-defined? (resolve-interface '(web client)) + 'http-get*) + (http-get* uri #:port connection #:decode-body? #f) + (http-get uri #:port connection #:decode-body? #f)))) ((code) (response-code resp)) ((size) -- cgit v1.2.3 From c61b026e3ae0ee2aca438100828ed55d226bfad6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 23:03:24 +0100 Subject: ui: Add temporary file handling and atomic symlink switch. * guix/scripts/download.scm (call-with-temporary-output-file): Move to ui.scm. * guix/scripts/package.scm (switch-symlinks): Likewise. * guix/ui.scm (call-with-temporary-output-file, switch-symlinks): New procedures. --- guix/scripts/download.scm | 11 ----------- guix/scripts/package.scm | 7 ------- guix/ui.scm | 24 ++++++++++++++++++++++++ 3 files changed, 24 insertions(+), 18 deletions(-) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 10370e59af..3dc227fdcd 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -33,17 +33,6 @@ #:use-module (rnrs io ports) #:export (guix-download)) -(define (call-with-temporary-output-file proc) - (let* ((template (string-copy "guix-download.XXXXXX")) - (out (mkstemp! template))) - (dynamic-wind - (lambda () - #t) - (lambda () - (proc template out)) - (lambda () - (false-if-exception (delete-file template)))))) - (define (fetch-and-store store fetch name) "Call FETCH for URI, and pass it the name of a file to write to; eventually, copy data from that port to STORE, under NAME. Return the resulting diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 23786fb7d8..38e8ae1150 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -192,13 +192,6 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (compose string->number (cut match:substring <> 1))) 0)) -(define (switch-symlinks link target) - "Atomically switch LINK, a symbolic link, to point to TARGET. Works -both when LINK already exists and when it does not." - (let ((pivot (string-append link ".new"))) - (symlink target pivot) - (rename-file pivot link))) - (define (roll-back profile) "Roll back to the previous generation of PROFILE." (let* ((number (profile-number profile)) diff --git a/guix/ui.scm b/guix/ui.scm index af8b238ce1..9c27dd8b3a 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -36,6 +36,8 @@ call-with-error-handling with-error-handling location->string + call-with-temporary-output-file + switch-symlinks fill-paragraph string->recutils package->recutils @@ -125,6 +127,28 @@ General help using GNU software: ")) (($ file line column) (format #f "~a:~a:~a" file line column)))) +(define (call-with-temporary-output-file proc) + "Call PROC with a name of a temporary file and open output port to that +file; close the file and delete it when leaving the dynamic extent of this +call." + (let* ((template (string-copy "guix-file.XXXXXX")) + (out (mkstemp! template))) + (dynamic-wind + (lambda () + #t) + (lambda () + (proc template out)) + (lambda () + (false-if-exception (close out)) + (false-if-exception (delete-file template)))))) + +(define (switch-symlinks link target) + "Atomically switch LINK, a symbolic link, to point to TARGET. Works +both when LINK already exists and when it does not." + (let ((pivot (string-append link ".new"))) + (symlink target pivot) + (rename-file pivot link))) + (define* (fill-paragraph str width #:optional (column 0)) "Fill STR such that each line contains at most WIDTH characters, assuming that the first character is at COLUMN. -- cgit v1.2.3 From 7730d112a2707522943d06940da25a22841a4568 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 23:32:15 +0100 Subject: build: Adjust guix.texi to Texinfo 5.0. * doc/guix.texi: Change @title and @subtitle syntax to please Texinfo 5.0. --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 849ab06c4a..9245bd00f5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -20,8 +20,8 @@ @end direntry @titlepage -@title{GNU Guix Reference Manual} -@subtitle{Using the GNU Guix Functional Package Manager} +@title GNU Guix Reference Manual +@subtitle Using the GNU Guix Functional Package Manager @author Ludovic Courtès @author Nikita Karetnikov -- cgit v1.2.3 From 9bb2b96aabdbb245c4a409e96b25df2954cfe385 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 23:41:24 +0100 Subject: ui: Factorize `show-what-to-build'. * guix/scripts/package.scm (guix-package)[show-what-to-build]: Move to.. * guix/ui.scm (show-what-to-build): ... here. Add a `store' parameter'. Adjust callers. * guix/scripts/build.scm (guix-build): Use it. Remove `req' and `req*' variables. --- guix/scripts/build.scm | 23 ++--------------------- guix/scripts/package.scm | 28 +--------------------------- guix/ui.scm | 29 +++++++++++++++++++++++++++++ 3 files changed, 32 insertions(+), 48 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 7863fb881b..fbd22a9e29 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -241,31 +241,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (package-derivation (%store) p sys)))) (_ #f)) opts)) - (req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build (%store) d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cut valid-path? (%store) <>) - derivation-path->output-path) - drv) - (map derivation-input-path req)))) (roots (filter-map (match-lambda (('gc-root . root) root) (_ #f)) opts))) - (if (assoc-ref opts 'dry-run?) - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)) + + (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?)) ;; TODO: Add more options. (set-build-options (%store) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 38e8ae1150..1f9355ff22 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -380,32 +380,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (let ((out (derivation-path->output-path (%guile-for-build)))) (not (valid-path? (%store) out)))) - (define (show-what-to-build drv dry-run?) - ;; Show what will/would be built in realizing the derivations listed - ;; in DRV. - (let* ((req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build - (%store) d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cute valid-path? (%store) <>) - derivation-path->output-path) - drv) - (map derivation-input-path req))))) - (if dry-run? - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)))) - (define newest-available-packages (memoize find-newest-available-packages)) @@ -589,7 +563,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (when (equal? profile %current-profile) (ensure-default-profile)) - (show-what-to-build drv dry-run?) + (show-what-to-build (%store) drv dry-run?) (or dry-run? (and (build-derivations (%store) drv) diff --git a/guix/ui.scm b/guix/ui.scm index 9c27dd8b3a..2b75504573 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -22,17 +22,20 @@ #:use-module (guix store) #:use-module (guix config) #:use-module (guix packages) + #:use-module (guix derivations) #:use-module ((guix licenses) #:select (license? license-name)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (ice-9 match) + #:use-module (ice-9 format) #:export (_ N_ leave show-version-and-exit show-bug-report-information + show-what-to-build call-with-error-handling with-error-handling location->string @@ -112,6 +115,32 @@ General help using GNU software: ")) (nix-protocol-error-message c)))) (thunk))) +(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." + (let* ((req (append-map (lambda (drv-path) + (let ((d (call-with-input-file drv-path + read-derivation))) + (derivation-prerequisites-to-build + store d))) + drv)) + (req* (delete-duplicates + (append (remove (compose (cute valid-path? store <>) + derivation-path->output-path) + drv) + (map derivation-input-path req))))) + (if dry-run? + (format (current-error-port) + (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*) + (format (current-error-port) + (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*)))) + (define-syntax with-error-handling (syntax-rules () "Run BODY within a user-friendly error condition handler." -- cgit v1.2.3 From f651b477b701d086402c18665eca68b26c3bec6b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 23:46:38 +0100 Subject: Add "guix pull". * guix/scripts/pull.scm: New file. * Makefile.am (MODULES): Add it. * doc/guix.texi (Invoking guix pull): New node. (Invoking guix package): Add cross-ref to it. * guix/ui.scm (config-directory): New procedure. * scripts/guix.in: When `GUIX_UNINSTALLED' is undefined, add $XDG_CONFIG_HOME/guix/latest to the search path. * po/POTFILES.in: Add guix/scripts/pull.scm. --- Makefile.am | 1 + doc/guix.texi | 33 ++++++++ guix/scripts/pull.scm | 222 ++++++++++++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 21 +++++ po/POTFILES.in | 1 + scripts/guix.in | 12 ++- 6 files changed, 288 insertions(+), 2 deletions(-) create mode 100644 guix/scripts/pull.scm diff --git a/Makefile.am b/Makefile.am index cabbe21cdd..bed4d06ec0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -30,6 +30,7 @@ MODULES = \ guix/scripts/import.scm \ guix/scripts/package.scm \ guix/scripts/gc.scm \ + guix/scripts/pull.scm \ guix/base32.scm \ guix/utils.scm \ guix/derivations.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 9245bd00f5..6a9ebab1f6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -393,6 +393,7 @@ management tools it provides. * Features:: How Guix will make your life brighter. * Invoking guix package:: Package installation, removal, etc. * Invoking guix gc:: Running the garbage collector. +* Invoking guix pull:: Fetching the latest Guix and distribution. @end menu @node Features @@ -521,6 +522,11 @@ Remove @var{package}. @itemx -u @var{regexp} Upgrade all the installed packages matching @var{regexp}. +Note that this upgrades package to the latest version of packages found +in the distribution currently installed. To update your distribution, +you should regularly run @command{guix pull} (@pxref{Invoking guix +pull}). + @item --roll-back Roll back to the previous @dfn{generation} of the profile---i.e., undo the last transaction. @@ -654,6 +660,33 @@ Show the list of live store files and directories. @end table +@node Invoking guix pull +@section Invoking @command{guix pull} + +Packages are installed or upgraded to the latest version available in +the distribution currently available on your local machine. To update +that distribution, along with the Guix tools, you must run @command{guix +pull}: the command downloads the latest Guix source code and package +descriptions, and deploys it. + +On completion, @command{guix package} will use packages and package +versions from this just-retrieved copy of Guix. Not only that, but all +the Guix commands and Scheme modules will also be taken from that latest +version. New @command{guix} sub-commands added by the update also +become available. + +The @command{guix pull} command is usually invoked with no arguments, +but it supports the following options: + +@table @code +@item --verbose +Produce verbose output, writing build logs to the standard error output. + +@item --bootstrap +Use the bootstrap Guile to build the latest Guix. This option is only +useful to Guix developers. +@end table + @c ********************************************************************* @node Programming Interface @chapter Programming Interface diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm new file mode 100644 index 0000000000..f12133fff7 --- /dev/null +++ b/guix/scripts/pull.scm @@ -0,0 +1,222 @@ +;;; 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 scripts pull) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix config) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix build download) + #:use-module (gnu packages base) + #:use-module ((gnu packages bootstrap) + #:select (%bootstrap-guile)) + #:use-module (gnu packages compression) + #:use-module (gnu packages gnupg) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:export (guix-pull)) + +(define %snapshot-url + "http://hydra.gnu.org/job/guix/master/tarball/latest/download" + ;;"http://git.savannah.gnu.org/cgit/guix.git/snapshot/guix-master.tar.gz" + ) + +(define (download-and-store store) + "Download the latest Guix tarball, add it to STORE, and return its store +path." + ;; FIXME: Authenticate the downloaded file! + ;; FIXME: Optimize data transfers using rsync, Git, bsdiff, or GNUnet's DHT. + (call-with-temporary-output-file + (lambda (temp port) + (let ((result + (parameterize ((current-output-port (current-error-port))) + (url-fetch %snapshot-url temp)))) + (close port) + (and result + (add-to-store store "guix-latest.tar.gz" #f "sha256" temp)))))) + +(define (unpack store tarball) + "Return a derivation that unpacks TARBALL into STORE and compiles Scheme +files." + (define builder + `(begin + (use-modules (guix build utils) + (system base compile) + (ice-9 ftw) + (ice-9 match)) + + (let ((out (assoc-ref %outputs "out")) + (tar (assoc-ref %build-inputs "tar")) + (gzip (assoc-ref %build-inputs "gzip")) + (gcrypt (assoc-ref %build-inputs "gcrypt")) + (tarball (assoc-ref %build-inputs "tarball"))) + (setenv "PATH" (string-append tar "/bin:" gzip "/bin")) + + (system* "tar" "xvf" tarball) + (match (scandir "." (lambda (name) + (and (not (member name '("." ".."))) + (file-is-directory? name)))) + ((dir) + (chdir dir)) + (x + (error "tarball did not produce a single source directory" x))) + + (format #t "copying and compiling Guix to `~a'...~%" out) + + ;; Copy everything under guix/ and gnu/ plus guix.scm. + (file-system-fold (lambda (dir stat result) ; enter? + (or (string-prefix? "./guix" dir) + (string-prefix? "./gnu" dir) + (string=? "." dir))) + (lambda (file stat result) ; leaf + (when (or (not (string=? (dirname file) ".")) + (string=? (basename file) "guix.scm")) + (let ((target (string-drop file 1))) + (copy-file file + (string-append out target))))) + (lambda (dir stat result) ; down + (mkdir (string-append out + (string-drop dir 1)))) + (const #t) ; up + (const #t) ; skip + (lambda (file stat errno result) + (error "cannot access file" + file (strerror errno))) + #f + "." + lstat) + + ;; Add a fake (guix config) module to allow the other modules to be + ;; compiled. The user's (guix config) is the one that will be used. + (copy-file "guix/config.scm.in" + (string-append out "/guix/config.scm")) + (substitute* (string-append out "/guix/config.scm") + (("@LIBGCRYPT@") + (string-append gcrypt "/lib/libgcrypt"))) + + ;; Augment the search path so Scheme code can be compiled. + (set! %load-path (cons out %load-path)) + (set! %load-compiled-path (cons out %load-compiled-path)) + + ;; Compile the .scm files. + (for-each (lambda (file) + (when (string-suffix? ".scm" file) + (let ((go (string-append (string-drop-right file 4) + ".go"))) + (compile-file file + #:output-file go + #:opts %auto-compilation-options)))) + (find-files out "\\.scm")) + + ;; Remove the "fake" (guix config). + (delete-file (string-append out "/guix/config.scm")) + (delete-file (string-append out "/guix/config.go"))))) + + (build-expression->derivation store "guix-latest" (%current-system) + builder + `(("tar" ,(package-derivation store tar)) + ("gzip" ,(package-derivation store gzip)) + ("gcrypt" ,(package-derivation store + libgcrypt)) + ("tarball" ,tarball)) + #:modules '((guix build utils)))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + '()) + +(define (show-help) + (display (_ "Usage: guix pull [OPTION]... +Download and deploy the latest version of Guix.\n")) + (display (_ " + --verbose produce verbose output")) + (display (_ " + --bootstrap use the bootstrap Guile to build the new Guix")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '("verbose") #f #f + (lambda (opt name arg result) + (alist-cons 'verbose? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) + + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix pull"))))) + +(define (guix-pull . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (leave (_ "~A: unexpected argument~%") arg)) + %default-options)) + + (let ((opts (parse-options)) + (store (open-connection))) + (with-error-handling + (let ((tarball (download-and-store store))) + (unless tarball + (leave (_ "failed to download up-to-date source, exiting\n"))) + (parameterize ((%guile-for-build + (package-derivation store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + guile-final))) + (current-build-output-port + (if (assoc-ref opts 'verbose?) + (current-error-port) + (%make-void-port "w")))) + (let*-values (((config-dir) + (config-directory)) + ((source drv) + (unpack store tarball)) + ((source-dir) + (derivation-output-path + (assoc-ref (derivation-outputs drv) "out")))) + (show-what-to-build store (list source)) + (if (build-derivations store (list source)) + (let ((latest (string-append config-dir "/latest"))) + (add-indirect-root store latest) + (switch-symlinks latest source-dir) + (format #t + (_ "updated ~a successfully deployed under `~a'~%") + %guix-package-name latest) + #t)))))))) diff --git a/guix/ui.scm b/guix/ui.scm index 2b75504573..7d1ea2bcbd 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -41,6 +41,7 @@ location->string call-with-temporary-output-file switch-symlinks + config-directory fill-paragraph string->recutils package->recutils @@ -178,6 +179,26 @@ both when LINK already exists and when it does not." (symlink target pivot) (rename-file pivot link))) +(define (config-directory) + "Return the name of the configuration directory, after making sure that it +exists. Honor the XDG specs, +." + (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME") + (and=> (getenv "HOME") + (cut string-append <> "/.config"))) + (cut string-append <> "/guix")))) + (catch 'system-error + (lambda () + (mkdir dir) + dir) + (lambda args + (match (system-error-errno args) + ((or EEXIST 0) + dir) + (err + (leave (_ "failed to create configuration directory `~a': ~a~%") + dir (strerror err)))))))) + (define* (fill-paragraph str width #:optional (column 0)) "Fill STR such that each line contains at most WIDTH characters, assuming that the first character is at COLUMN. diff --git a/po/POTFILES.in b/po/POTFILES.in index 5c0f131c06..bdb894db20 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -8,4 +8,5 @@ guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm guix/scripts/gc.scm +guix/scripts/pull.scm guix/ui.scm diff --git a/scripts/guix.in b/scripts/guix.in index 2fdde7d13a..1315789a9c 100644 --- a/scripts/guix.in +++ b/scripts/guix.in @@ -22,7 +22,8 @@ ;; IMPORTANT: We must avoid loading any modules from Guix here, ;; because we need to adjust the guile load paths first. ;; It's okay to import modules from core Guile though. -(use-modules (ice-9 regex)) +(use-modules (ice-9 regex) + (srfi srfi-26)) (let () (define-syntax-rule (push! elt v) (set! v (cons elt v))) @@ -45,7 +46,14 @@ (unless (getenv "GUIX_UNINSTALLED") (let ((module-dir (config-lookup "guilemoduledir"))) (push! module-dir %load-path) - (push! module-dir %load-compiled-path)))) + (push! module-dir %load-compiled-path)) + (let ((updates-dir (and=> (or (getenv "XDG_CONFIG_HOME") + (and=> (getenv "HOME") + (cut string-append <> "/.config"))) + (cut string-append <> "/guix/latest")))) + (when (file-exists? updates-dir) + (push! updates-dir %load-path) + (push! updates-dir %load-compiled-path))))) (define (run-guix-main) (let ((guix-main (module-ref (resolve-interface '(guix ui)) -- cgit v1.2.3 From 525ca3e912507d45e1df29e7ab88b090f8d19dd4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 Feb 2013 10:27:34 +0100 Subject: guix: Make sure UPDATES-DIR is valid. * scripts/guix.in: Make sure UPDATES-DIR is not #f. --- scripts/guix.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/guix.in b/scripts/guix.in index 1315789a9c..4015560cd5 100644 --- a/scripts/guix.in +++ b/scripts/guix.in @@ -51,7 +51,7 @@ (and=> (getenv "HOME") (cut string-append <> "/.config"))) (cut string-append <> "/guix/latest")))) - (when (file-exists? updates-dir) + (when (and updates-dir (file-exists? updates-dir)) (push! updates-dir %load-path) (push! updates-dir %load-compiled-path))))) -- cgit v1.2.3 From 7b50c68455b07713392cb92a56dbf74fbcc2d182 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 22 Feb 2013 20:01:29 +0100 Subject: pull: Build (guix build download) first, because of the (gnutls) autoload. * guix/scripts/pull.scm (unpack): Build (guix build download) first, as done in 855a8ad71def2ebc594ed32c57bda0ca4e13d91c. Reported by Andreas Enge . --- guix/scripts/pull.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index f12133fff7..42ff525524 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -123,7 +123,12 @@ files." (compile-file file #:output-file go #:opts %auto-compilation-options)))) - (find-files out "\\.scm")) + + ;; XXX: Because of the autoload hack in (guix build + ;; download), we must build it first to avoid errors since + ;; (gnutls) is unavailable. + (cons (string-append out "/guix/build/download.scm") + (find-files out "\\.scm"))) ;; Remove the "fake" (guix config). (delete-file (string-append out "/guix/config.scm")) -- cgit v1.2.3 From 4d60610ad7929f5745afec36bd856434cc825bd9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 22 Feb 2013 21:08:06 +0100 Subject: pull: Distinguish "already up to date" from "updated". * guix/ui.scm (show-what-to-build): Return (length req*). * guix/scripts/pull.scm (guix-pull): Print an "already up to date" message when there's nothing to build. --- guix/scripts/pull.scm | 20 ++++++++++++-------- guix/ui.scm | 6 ++++-- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 42ff525524..942bf501c5 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -216,12 +216,16 @@ Download and deploy the latest version of Guix.\n")) ((source-dir) (derivation-output-path (assoc-ref (derivation-outputs drv) "out")))) - (show-what-to-build store (list source)) - (if (build-derivations store (list source)) - (let ((latest (string-append config-dir "/latest"))) - (add-indirect-root store latest) - (switch-symlinks latest source-dir) - (format #t - (_ "updated ~a successfully deployed under `~a'~%") - %guix-package-name latest) + (if (show-what-to-build store (list source)) + (if (build-derivations store (list source)) + (let ((latest (string-append config-dir "/latest"))) + (add-indirect-root store latest) + (switch-symlinks latest source-dir) + (format #t + (_ "updated ~a successfully deployed under `~a'~%") + %guix-package-name latest) + #t) + (leave (_ "failed to update Guix, check the build log~%"))) + (begin + (display (_ "Guix already up to date\n")) #t)))))))) diff --git a/guix/ui.scm b/guix/ui.scm index 7d1ea2bcbd..7e0c61b4f8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -118,7 +118,8 @@ General help using GNU software: ")) (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." +derivations listed in DRV. Return #t if there's something to build, #f +otherwise." (let* ((req (append-map (lambda (drv-path) (let ((d (call-with-input-file drv-path read-derivation))) @@ -140,7 +141,8 @@ derivations listed in DRV." (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" (length req*)) - (null? req*) req*)))) + (null? req*) req*)) + (pair? req*))) (define-syntax with-error-handling (syntax-rules () -- cgit v1.2.3 From c9b940cd03423a0b6ad826b5d6e735c3e9c11630 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 23 Feb 2013 16:30:03 +0100 Subject: gnu: Update libpng to 1.5.14. * gnu/packages/libpng.scm (libpng): Switch to version 1.5.14. --- gnu/packages/libpng.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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-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") -- cgit v1.2.3 From abc00dc492efc9309aa721b63cb2f2883dbba3c6 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 23 Feb 2013 18:39:49 +0100 Subject: gnu: screen: Use GNU mirror. * gnu/packages/screen.scm (screen): Use GNU mirror. --- gnu/packages/screen.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 @@ (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")))) -- cgit v1.2.3 From 149acc2981d8580d9fd258e6c47a16bacfa67cb7 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 23 Feb 2013 18:59:43 +0100 Subject: download: Add X.org mirrors. * guix/download.scm (%mirrors): Add `xorg'. --- guix/download.scm | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/guix/download.scm b/guix/download.scm index 846c9e1e0b..3caba5f924 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,38 @@ "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 (define (gnutls-derivation store system) "Return the GnuTLS derivation for SYSTEM." -- cgit v1.2.3 From fae31edcec43c93a996a1872c68d1c540af0068f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Feb 2013 22:40:35 +0100 Subject: store: Add queries for references & co. * guix/store.scm (operation-id)[query-valid-derivers]: New value. (references, referrers, valid-derivers, query-derivation-outputs): New procedures. * tests/store.scm ("references", "derivers"): New tests. --- guix/store.scm | 28 +++++++++++++++++++++++++++- tests/store.scm | 26 ++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 1 deletion(-) 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 @@ substitutable-paths substitutable-path-info + references + referrers + valid-derivers + query-derivation-outputs live-paths dead-paths collect-garbage @@ -126,7 +130,8 @@ (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 @@ name--it is the caller's responsibility to ensure that it is an absolute 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/tests/store.scm b/tests/store.scm index c90fd3fed9..c2de99e160 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -23,6 +23,7 @@ #: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 @@ (> 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))) -- cgit v1.2.3 From ba8b732d209a891455ef08b81125796dab797435 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Feb 2013 23:16:00 +0100 Subject: guix gc: Add `--references' and `--referrers'. * guix/scripts/gc.scm (show-help): Update. (%options): Add `--references' and `--referrers'. (guix-gc)[symlink-target, store-directory]: New procedures. Handle the `list-references' and `list-referrers' actions. * tests/guix-gc.sh: Add tests for `--references'. * doc/guix.texi (Invoking guix gc): Document `--references' and `--referrers'. --- doc/guix.texi | 12 ++++++++++++ guix/scripts/gc.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++++------- tests/guix-gc.sh | 12 ++++++++++++ 3 files changed, 73 insertions(+), 7 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 6a9ebab1f6..ec784ce349 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -657,6 +657,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/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 @@ #: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 @@ Invoke the garbage collector.\n")) (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 @@ interpreted." (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 @@ interpreted." (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 @@ interpreted." (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/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" -- cgit v1.2.3 From 431a35518f74f50238ccc106a6a3121a9fcc11b9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Mar 2013 18:34:33 +0100 Subject: gnu: global: Update to 6.2.8. * gnu/packages/global.scm (global): Update to 6.2.8. --- gnu/packages/global.scm | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) 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-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))) -- cgit v1.2.3 From 5d4b411f8a3372455a8c92d10a28e88e9edba6eb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Mar 2013 21:12:32 +0100 Subject: guix package: Add `--install-from-expression'. * guix/scripts/package.scm (read/eval-package-expression): New procedure. (show-help): Add `-e'. (%options): Likewise. (guix-package)[process-actions]: Handle ('install . p) pairs, where P is a package. * tests/guix-package.sh: Add `boot_make_drv'. Use `-i $boot_make_drv' once, and then use `-e $boot_make'. * doc/guix.texi (Invoking guix package): Document `-e'. --- doc/guix.texi | 13 +++++++++++++ guix/scripts/package.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ tests/guix-package.sh | 15 ++++++++++----- 3 files changed, 67 insertions(+), 5 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index ec784ce349..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}. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1f9355ff22..28ef721603 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -266,6 +266,26 @@ matching packages." (assoc-ref (derivation-outputs drv) sub-drv)))) `(,name ,out)))))) +(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))))) + ;;; ;;; Command-line options. @@ -281,6 +301,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (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 +348,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (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 +517,19 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (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 +555,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (install (append upgrade (filter-map (match-lambda + (('install . (? package? p)) + #f) (('install . (? store-path?)) #f) (('install . package) @@ -530,6 +572,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) 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/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`" -- cgit v1.2.3 From eb0880e71d326753829a41b7afd66392960434cc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Mar 2013 21:55:42 +0100 Subject: ui: Factorize `read/eval-package-expression'. * guix/scripts/package.scm (read/eval-package-expression): Move to... * guix/ui.scm (read/eval-package-expression): ... here. * guix/scripts/build.scm (derivations-from-package-expressions): Use it. --- guix/scripts/build.scm | 33 ++++++++++++++------------------- guix/scripts/package.scm | 20 -------------------- guix/ui.scm | 21 +++++++++++++++++++++ 3 files changed, 35 insertions(+), 39 deletions(-) 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 %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 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (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 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (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/package.scm b/guix/scripts/package.scm index 28ef721603..ccca614d88 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -266,26 +266,6 @@ matching packages." (assoc-ref (derivation-outputs drv) sub-drv)))) `(,name ,out)))))) -(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))))) - ;;; ;;; Command-line options. 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 @@ 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 @@ General help using GNU software: ")) (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 -- cgit v1.2.3 From 11a7ceb9e804c63a22e4bc0ce2a3c302d7ecb18e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 2 Mar 2013 15:14:22 +0100 Subject: release.nix: Build outside of a chroot. * release.nix (unchroot): New function. (jobs)[tarball, build, build_disable_daemon]: Use it. --- release.nix | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/release.nix b/release.nix index 369d54ed96..aed99717df 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,15 @@ 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 {}; in + drv: pkgs.lib.overrideDerivation drv (args: { + __noChroot = true; + }); + # 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,7 +53,8 @@ let jobs = { tarball = - let pkgs = import nixpkgs {}; in + unchroot + (let pkgs = import nixpkgs {}; in pkgs.releaseTools.sourceTarball { name = "guix-tarball"; src = ; @@ -55,12 +65,13 @@ let [ "--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 +94,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 +113,7 @@ let # the chroot. preConfigure = "export NIX_REMOTE=daemon"; __noChroot = true; - }); + })); # Jobs to test the distro. distro = { -- cgit v1.2.3 From c86929e403559a6f9bc4cd76bbdd9fe9edd9686f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 2 Mar 2013 15:25:04 +0100 Subject: release.nix: Unchroot recursively. * release.nix (unchroot): Operate recursively on build inputs. --- release.nix | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/release.nix b/release.nix index aed99717df..91eb372c60 100644 --- a/release.nix +++ b/release.nix @@ -30,10 +30,23 @@ let # 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 {}; in - drv: pkgs.lib.overrideDerivation drv (args: { - __noChroot = true; - }); + 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 -- cgit v1.2.3 From 4cdbdd4439d493659af60608c37704545b376600 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 2 Mar 2013 17:00:33 +0100 Subject: gnu: Add libdaemon. * gnu/packages/libdaemon.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + gnu/packages/libdaemon.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 gnu/packages/libdaemon.scm diff --git a/Makefile.am b/Makefile.am index bed4d06ec0..9018479a47 100644 --- a/Makefile.am +++ b/Makefile.am @@ -98,6 +98,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 \ 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+))) -- cgit v1.2.3 From d688a2f0fd2ab32f476917798e59e9ce9beef868 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 2 Mar 2013 22:56:30 +0100 Subject: release.nix: Reduce the number of dependencies. * release.nix (tarball): Use a minimal Git. --- release.nix | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 91eb372c60..5aab8600ab 100644 --- a/release.nix +++ b/release.nix @@ -71,7 +71,17 @@ let 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 = -- cgit v1.2.3 From 49f24f41e33d8ee1c6d8e5a92d388c3aebc3b81a Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 3 Mar 2013 14:10:57 +0100 Subject: gnu: Add vpnc. * gnu/packages/vpn.scm: New file. * Makefile.am (MODULES): Add it. * gnu/packages/patches/vpnc-script.patch: New file. * Makefile.am (dist_patch_DATA): Add it. --- Makefile.am | 4 ++- gnu/packages/patches/vpnc-script.patch | 15 ++++++++ gnu/packages/vpn.scm | 66 ++++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/vpnc-script.patch create mode 100644 gnu/packages/vpn.scm diff --git a/Makefile.am b/Makefile.am index 9018479a47..b70349adc0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -158,6 +158,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 \ @@ -215,7 +216,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/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/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/"))) -- cgit v1.2.3 From 6af3101999b4cec58d10f28c257afc63ebc483a4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Mar 2013 00:46:27 +0100 Subject: download: Add CPAN mirrors. * guix/download.scm (%mirrors)[cpan]: New URLs. --- guix/download.scm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/guix/download.scm b/guix/download.scm index 3caba5f924..b6bf6a0822 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -130,7 +130,20 @@ "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 + "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." -- cgit v1.2.3 From 08fd1ebefdf7a61ede3de490dc466bc41ef1ba97 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Mar 2013 00:41:46 +0100 Subject: Add (guix build-system perl). * guix/build-system/perl.scm, guix/build/perl-build-system.scm: New files. * Makefile.am (MODULES): Add them. * guix/build-system/gnu.scm (standard-inputs): Make public. --- Makefile.am | 2 + guix/build-system/gnu.scm | 2 +- guix/build-system/perl.scm | 103 +++++++++++++++++++++++++++++++++++++++ guix/build/perl-build-system.scm | 61 +++++++++++++++++++++++ 4 files changed, 167 insertions(+), 1 deletion(-) create mode 100644 guix/build-system/perl.scm create mode 100644 guix/build/perl-build-system.scm diff --git a/Makefile.am b/Makefile.am index b70349adc0..c56bc41226 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 \ 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 @@ #: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 -- cgit v1.2.3 From 2a1e82bb5c2ae28b0018aa765cff6733136b3f70 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Mar 2013 00:46:44 +0100 Subject: gnu: Add Perl XML::Parser. * gnu/packages/xml.scm (perl-xml-parser): New variable. --- gnu/packages/xml.scm | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) 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 @@ #: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 @@ things the parser might find in the XML document (like start tags).") "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"))) -- cgit v1.2.3