From 922f11ad226810f64e663790fc5b366939c8b546 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
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 +
 1 file changed, 1 insertion(+)

(limited to 'Makefile.am')

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				\
-- 
cgit v1.2.3


From ab744c1af5668b1fa1b0688614aa9c12813f4921 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 f9c36483294f0e2eba9d0cde312023546aba9069 Mon Sep 17 00:00:00 2001
From: Cyril Roelandt <tipecaml@gmail.com>
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

(limited to 'Makefile.am')

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 <tipecaml@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages 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 e70a28b87e7280ac3d73a7cd5d9c3240e31e19e9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 <sys/mount.h>
++#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 <linux/if.h>.  */
++
++#include <linux/if.h>
++#include <linux/sockios.h>
++#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 52e6e2461f266feee99b6fb02dfd700fba589f77 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
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

(limited to 'Makefile.am')

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 <nikita@karetnikov.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages 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 106ca9d0c160137ac41466b6d7cf18eee4f4583e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 3855e242a24025cc6f83731e7cf5d2ea73aeb23e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages 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 d2474c2620a3b4a81e364ee3b741419a778f2472 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu 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 868c923f13e6ed95e1e5ad2bd32d4166842254ea Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
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

(limited to 'Makefile.am')

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 <http://www.gnu.org/licenses/>.
 
 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{<package>}
 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 <ludo@gnu.org>
-;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-build)
-  #: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 <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-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 <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-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 <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-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 <ludo@gnu.org>
-;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-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<? (@ (ice-9 i18n) string-locale<?)))
-    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
-    (define (enter? dir stat result)
-      (and stat (string=? dir name)))
-
-    (define (visit basename result)
-      (if (select? basename)
-          (cons basename result)
-          result))
-
-    (define (leaf name stat result)
-      (and result
-           (visit (basename name) result)))
-
-    (define (down name stat result)
-      (visit "." '()))
-
-    (define (up name stat result)
-      (visit ".." result))
-
-    (define (skip name stat result)
-      ;; All the sub-directories are skipped.
-      (visit (basename name) result))
-
-    (define (error name* stat errno result)
-      (if (string=? name name*)             ; top-level NAME is unreadable
-          result
-          (visit (basename name*) result)))
-
-    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
-           (lambda (files)
-             (sort files entry<?))))
-
-  (match (scandir (dirname profile)
-                  (cute regexp-exec (profile-regexp profile) <>))
-    (#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)
-      (string<? (package-name p1)
-                (package-name p2))))
-   same-location?))
-
-(define (input->name+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)
-                             (string<? (package-name p1)
-                                       (package-name p2)))))
-           #t))
-
-        (('search regexp)
-         (let ((regexp (make-regexp regexp regexp/icase)))
-           (for-each (cute package->recutils <> (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 <ludo@gnu.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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 <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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<? (@ (ice-9 i18n) string-locale<?)))
+    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
+    (define (enter? dir stat result)
+      (and stat (string=? dir name)))
+
+    (define (visit basename result)
+      (if (select? basename)
+          (cons basename result)
+          result))
+
+    (define (leaf name stat result)
+      (and result
+           (visit (basename name) result)))
+
+    (define (down name stat result)
+      (visit "." '()))
+
+    (define (up name stat result)
+      (visit ".." result))
+
+    (define (skip name stat result)
+      ;; All the sub-directories are skipped.
+      (visit (basename name) result))
+
+    (define (error name* stat errno result)
+      (if (string=? name name*)             ; top-level NAME is unreadable
+          result
+          (visit (basename name*) result)))
+
+    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
+           (lambda (files)
+             (sort files entry<?))))
+
+  (match (scandir (dirname profile)
+                  (cute regexp-exec (profile-regexp profile) <>))
+    (#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)
+      (string<? (package-name p1)
+                (package-name p2))))
+   same-location?))
+
+(define (input->name+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)
+                             (string<? (package-name p1)
+                                       (package-name p2)))))
+           #t))
+
+        (('search regexp)
+         (let ((regexp (make-regexp regexp regexp/icase)))
+           (for-each (cute package->recutils <> (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 <ludo@gnu.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; 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 <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;; 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 <http://www.gnu.org/licenses/>.
 
 #
-# 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 <http://www.gnu.org/licenses/>.
 
 #
-# 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 <http://www.gnu.org/licenses/>.
 
 #
-# 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 <http://www.gnu.org/licenses/>.
 
 #
-# 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 02d94dab8d7827eb0dae469025cf6aeead12b873 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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 <nikita@karetnikov.org>.
---
 Makefile.am | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'Makefile.am')

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 69ce1ffc7d5f12266e3a4cde605ca76a65c297b4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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

(limited to 'Makefile.am')

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 <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix 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,
+<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
+  (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 827d28914a16ef2d10ebdad4695efdb02ace07fb Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 27 Feb 2013 09:38:11 +0100
Subject: gnu: Add cross tool chain.

* gnu/packages/cross-base.scm: New file.
* gnu/packages/patches/gcc-cross-environment-variables.patch: New file.
* Makefile.am (MODULES): Add cross-base.scm.
  (dist_patch_DATA): Add gcc-cross-environment-variables.patch.
* gnu/packages/base.scm (gcc-4.7): Use `LDFLAGS_FOR_TARGET' instead of
  `LDFLAGS_FOR_BUILD', and use `-B' instead of `-L'.
* gnu/packages/bootstrap.scm (glibc-dynamic-linker): Add case for
  "mips64el-linux".
---
 Makefile.am                                        |   2 +
 gnu/packages/base.scm                              |   4 +-
 gnu/packages/bootstrap.scm                         |   1 +
 gnu/packages/cross-base.scm                        | 243 +++++++++++++++++++++
 .../patches/gcc-cross-environment-variables.patch  |  24 ++
 5 files changed, 272 insertions(+), 2 deletions(-)
 create mode 100644 gnu/packages/cross-base.scm
 create mode 100644 gnu/packages/patches/gcc-cross-environment-variables.patch

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index bed4d06ec0..d87e6e0572 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,6 +66,7 @@ MODULES =					\
   gnu/packages/check.scm			\
   gnu/packages/compression.scm			\
   gnu/packages/cpio.scm				\
+  gnu/packages/cross-base.scm			\
   gnu/packages/curl.scm				\
   gnu/packages/cyrus-sasl.scm			\
   gnu/packages/dejagnu.scm			\
@@ -185,6 +186,7 @@ dist_patch_DATA =						\
   gnu/packages/patches/flac-fix-memcmp-not-declared.patch	\
   gnu/packages/patches/flex-bison-tests.patch			\
   gnu/packages/patches/gawk-shell.patch				\
+  gnu/packages/patches/gcc-cross-environment-variables.patch	\
   gnu/packages/patches/gettext-gets-undeclared.patch		\
   gnu/packages/patches/glib-tests-desktop.patch			\
   gnu/packages/patches/glib-tests-homedir.patch			\
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 5c39ec3db8..5aeb050863 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -412,8 +412,8 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
         #:make-flags
         (let ((libc (assoc-ref %build-inputs "libc")))
           `(,@(if libc
-                  (list (string-append "LDFLAGS_FOR_BUILD="
-                                       "-L" libc "/lib "
+                  (list (string-append "LDFLAGS_FOR_TARGET="
+                                       "-B" libc "/lib "
                                        "-Wl,-dynamic-linker "
                                        "-Wl," libc
                                        ,(glibc-dynamic-linker)))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 22ee98879a..809eb84295 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -134,6 +134,7 @@ check whether everything is alright."
   "Return the name of Glibc's dynamic linker for SYSTEM."
   (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
         ((string=? system "i686-linux") "/lib/ld-linux.so.2")
+        ((string=? system "mips64el-linux") "/lib/ld.so.1")
         (else (error "dynamic linker name not known for this system"
                      system))))
 
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
new file mode 100644
index 0000000000..69dc9f5b0b
--- /dev/null
+++ b/gnu/packages/cross-base.scm
@@ -0,0 +1,243 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages cross-base)
+  #:use-module (guix licenses)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages linux)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix utils)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system trivial)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match))
+
+(define (cross p target)
+  (package (inherit p)
+    (location (source-properties->location (current-source-location)))
+    (name (string-append (package-name p) "-cross-" target))
+    (arguments
+     (substitute-keyword-arguments (package-arguments p)
+       ((#:configure-flags flags)
+        `(cons ,(string-append "--target=" target)
+               ,flags))))))
+
+(define cross-binutils
+  (cut cross binutils <>))
+
+(define* (cross-gcc target
+                    #:optional (xbinutils (cross-binutils target)) libc)
+  "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
+XBINUTILS as the associated cross-Binutils.  If LIBC is false, then build a
+GCC that does not target a libc; otherwise, target that libc."
+  (define args
+    ;; Get the arguments as if we were building for TARGET.  In particular, we
+    ;; want `glibc-dynamic-linker' to return the right thing.
+    (parameterize ((%current-system (gnu-triplet->nix-system target)))
+      (package-arguments gcc-4.7)))
+
+  (package (inherit gcc-4.7)
+    (name (string-append "gcc-cross-"
+                         (if libc "" "sans-libc-")
+                         target))
+    (arguments
+     `(#:implicit-inputs? #f
+       #:modules ((guix build gnu-build-system)
+                  (guix build utils)
+                  (ice-9 regex)
+                  (srfi srfi-1)
+                  (srfi srfi-26))
+       #:patches (list (assoc-ref %build-inputs "patch/cross-env-vars"))
+
+       ,@(substitute-keyword-arguments args
+           ((#:configure-flags flags)
+            `(append (list ,(string-append "--target=" target)
+                           ,@(if libc
+                                 '()
+                                 `( ;; Disable features not needed at this stage.
+                                   "--disable-shared" "--enable-static"
+
+                                   ;; Disable C++ because libstdc++'s
+                                   ;; configure script otherwise fails with
+                                   ;; "Link tests are not allowed after
+                                   ;; GCC_NO_EXECUTABLES."
+                                   "--enable-languages=c"
+
+                                   "--disable-threads" ; libgcc, would need libc
+                                   "--disable-libmudflap"
+                                   "--disable-libgomp"
+                                   "--disable-libssp"
+                                   "--disable-libquadmath"
+                                   "--disable-decimal-float" ; would need libc
+                                   )))
+
+                     ,(if libc
+                          flags
+                          `(remove (cut string-match "--enable-languages.*" <>)
+                                   ,flags))))
+           ((#:make-flags flags)
+            (if libc
+                `(let ((libc (assoc-ref %build-inputs "libc")))
+                   ;; FLAGS_FOR_TARGET are needed for the target libraries to
+                   ;; receive the -Bxxx for the startfiles.
+                   (cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
+                         ,flags))
+                flags))
+           ((#:phases phases)
+            (let ((phases
+                   `(alist-cons-after
+                     'install 'make-cross-binutils-visible
+                     (lambda* (#:key outputs inputs #:allow-other-keys)
+                       (let* ((out      (assoc-ref outputs "out"))
+                              (libexec  (string-append out "/libexec/gcc/"
+                                                       ,target))
+                              (binutils (string-append
+                                         (assoc-ref inputs "binutils-cross")
+                                         "/bin/" ,target "-")))
+                         (for-each (lambda (file)
+                                     (symlink (string-append binutils file)
+                                              (string-append libexec "/"
+                                                             file)))
+                                   '("as" "ld" "nm"))
+                         #t))
+                     ,phases)))
+             (if libc
+                 `(alist-cons-before
+                   'configure 'set-cross-path
+                   (lambda* (#:key inputs #:allow-other-keys)
+                     ;; Add the cross Linux headers to CROSS_CPATH, and remove
+                     ;; them from CPATH.
+                     (let ((libc  (assoc-ref inputs "libc"))
+                           (linux (assoc-ref inputs
+                                             "libc/cross-linux-headers")))
+                       (define (cross? x)
+                         ;; Return #t if X is a cross-libc or cross Linux.
+                         (or (string-prefix? libc x)
+                             (string-prefix? linux x)))
+
+                       (setenv "CROSS_CPATH"
+                               (string-append libc "/include:"
+                                              linux "/include"))
+                       (setenv "CROSS_LIBRARY_PATH"
+                               (string-append libc "/lib"))
+
+                       (let ((cpath   (search-path-as-string->list
+                                       (getenv "CPATH")))
+                             (libpath (search-path-as-string->list
+                                       (getenv "LIBRARY_PATH"))))
+                         (setenv "CPATH"
+                                 (list->search-path-as-string
+                                  (remove cross? cpath) ":"))
+                         (setenv "LIBRARY_PATH"
+                                 (list->search-path-as-string
+                                  (remove cross? libpath) ":"))
+                         #t)))
+                   ,phases)
+                 phases)))
+           ((#:strip-binaries? _)
+            ;; Disable stripping as this can break binaries, with object files
+            ;; of libgcc.a showing up as having an unknown architecture.  See
+            ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
+            ;; for instance.
+            #f))))
+    (inputs
+     `(("patch/cross-env-vars"
+        ,(search-patch "gcc-cross-environment-variables.patch"))
+
+       ("binutils-cross" ,xbinutils)
+
+       ;; Call it differently so that the builder can check whether the "libc"
+       ;; input is #f.
+       ("libc-native" ,@(assoc-ref %final-inputs "libc"))
+
+       ;; Remaining inputs.
+       ,@(let ((inputs (append (package-inputs gcc-4.7)
+                               (alist-delete "libc" %final-inputs))))
+           (if libc
+               `(("libc" ,libc)
+                 ,@inputs)
+               inputs))))))
+
+(define* (cross-libc target
+                     #:optional
+                     (xgcc (cross-gcc target))
+                     (xbinutils (cross-binutils target)))
+  "Return a libc cross-built for TARGET, a GNU triplet.  Use XGCC and
+XBINUTILS and the cross tool chain."
+  (define xlinux-headers
+    (package (inherit linux-libre-headers)
+      (name (string-append (package-name linux-libre-headers)
+                           "-cross-" target))
+      (arguments
+       (substitute-keyword-arguments (package-arguments linux-libre-headers)
+         ((#:phases phases)
+          `(alist-replace
+            'build
+            (lambda _
+              (setenv "ARCH" ,(system->linux-architecture target))
+              (format #t "`ARCH' set to `~a' (cross compiling)~%" (getenv "ARCH"))
+
+              (and (zero? (system* "make" "defconfig"))
+                   (zero? (system* "make" "mrproper" "headers_check"))))
+            ,phases))))
+      (inputs `(("cross-gcc" ,xgcc)
+                ("cross-binutils" ,xbinutils)
+                ,@(package-inputs linux-libre-headers)))))
+
+  (package (inherit glibc)
+    (name (string-append "glibc-cross-" target))
+    (arguments
+     (substitute-keyword-arguments
+         `(#:strip-binaries? #f                ; disable stripping (see above)
+           ,@(package-arguments glibc))
+       ((#:configure-flags flags)
+        `(cons ,(string-append "--host=" target)
+               ,flags))
+       ((#:phases phases)
+        `(alist-cons-before
+          'configure 'set-cross-linux-headers-path
+          (lambda* (#:key inputs #:allow-other-keys)
+            (let ((linux (assoc-ref inputs "cross-linux-headers")))
+              (setenv "CROSS_CPATH"
+                      (string-append linux "/include"))
+              #t))
+          ,phases))))
+    (propagated-inputs `(("cross-linux-headers" ,xlinux-headers)))
+    (inputs `(("cross-gcc" ,xgcc)
+              ("cross-binutils" ,xbinutils)
+              ,@(package-inputs glibc)))))
+
+
+;;;
+;;; Concrete cross toolchains.
+;;;
+
+(define-public xgcc-mips64el
+  (let ((triplet "mips64el-linux-gnu"))
+    (cross-gcc triplet
+               (cross-binutils triplet)
+               (cross-libc triplet))))
+
+;; (define-public xgcc-armel
+;;   (let ((triplet "armel-linux-gnueabi"))
+;;     (cross-gcc triplet
+;;                (cross-binutils triplet)
+;;                (cross-libc triplet))))
diff --git a/gnu/packages/patches/gcc-cross-environment-variables.patch b/gnu/packages/patches/gcc-cross-environment-variables.patch
new file mode 100644
index 0000000000..30a07ec3db
--- /dev/null
+++ b/gnu/packages/patches/gcc-cross-environment-variables.patch
@@ -0,0 +1,24 @@
+Search path environment variables for cross-compilers.  See the discussion
+at <http://gcc.gnu.org/ml/gcc/2013-02/msg00124.html>.
+
+--- gcc-4.7.2/gcc/incpath.c	2012-01-27 00:34:58.000000000 +0100
++++ gcc-4.7.2/gcc/incpath.c	2013-02-12 10:11:27.000000000 +0100
+@@ -452,7 +452,7 @@ register_include_chains (cpp_reader *pfi
+ 
+   /* CPATH and language-dependent environment variables may add to the
+      include chain.  */
+-  add_env_var_paths ("CPATH", BRACKET);
++  add_env_var_paths ("CROSS_CPATH", BRACKET);
+   add_env_var_paths (lang_env_vars[idx], SYSTEM);
+ 
+   target_c_incpath.extra_pre_includes (sysroot, iprefix, stdinc);
+
+--- gcc-4.7.2/gcc/system.h	2012-02-17 00:16:28.000000000 +0100
++++ gcc-4.7.2/gcc/system.h	2013-02-12 10:22:17.000000000 +0100
+@@ -1023,4 +1023,6 @@ helper_const_non_const_cast (const char
+ #define DEBUG_VARIABLE
+ #endif
+ 
++#define LIBRARY_PATH_ENV "CROSS_LIBRARY_PATH"
++
+ #endif /* ! GCC_SYSTEM_H */
-- 
cgit v1.2.3


From 9aea24b608659bfe6d6a72afff31edecd8e717c6 Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Sat, 23 Feb 2013 19:09:26 +0100
Subject: gnu: xorg: Initial import from nix.

* gnu/packages/xorg.scm: New module.
* Makefile.am: Add it.
---
 Makefile.am           |    1 +
 gnu/packages/xorg.scm | 3658 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 3659 insertions(+)
 create mode 100644 gnu/packages/xorg.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index c9dcc4a356..70387ef565 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -166,6 +166,7 @@ MODULES =					\
   gnu/packages/wget.scm				\
   gnu/packages/which.scm			\
   gnu/packages/xml.scm				\
+  gnu/packages/xorg.scm				\
   gnu/packages/zile.scm				\
   gnu/packages/zip.scm				\
   gnu/system/vm.scm
diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm
new file mode 100644
index 0000000000..bbbd7a943a
--- /dev/null
+++ b/gnu/packages/xorg.scm
@@ -0,0 +1,3658 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages xorg)
+  #: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 bison)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages flex)
+  #:use-module (gnu packages fontutils)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gperf)
+  #:use-module (gnu packages libpng)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages m4)
+  #:use-module (gnu packages openssl)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages python))
+
+(define-public applewmproto
+  (package
+    (name "applewmproto")
+    (version "1.4.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/applewmproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1zi4p07mp6jmk030p4gmglwxcwp0lzs5mi31y1b4rp8lsqxdxizw"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public bdftopcf
+  (package
+    (name "bdftopcf")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/bdftopcf-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "02hx981f7jfwylxj21s91yvv4h597nqqzz3vd6ar81zyn84b944w"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxfont" ,libxfont)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public bigreqsproto
+  (package
+    (name "bigreqsproto")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/bigreqsproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "07hvfm84scz8zjw14riiln2v4w03jlhp756ypwhq27g48jmic8a6"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public compositeproto
+  (package
+    (name "compositeproto")
+    (version "0.4.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/compositeproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1z0crmf669hirw4s7972mmp8xig80kfndja9h559haqbpvq5k4q4"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("fixesproto" ,fixesproto)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public damageproto
+  (package
+    (name "damageproto")
+    (version "1.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/damageproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0nzwr5pv9hg7c21n995pdiv0zqhs91yz3r8rn3aska4ykcp12z2w"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public dmxproto
+  (package
+    (name "dmxproto")
+    (version "2.3.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/dmxproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "02b5x9dkgajizm8dqyx2w6hmqx3v25l67mgf35nj6sz0lgk52877"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public encodings
+  (package
+    (name "encodings")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/encodings-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0ffmaw80vmfwdgvdkp6495xgsqszb6s0iira5j0j6pd4i0lk3mnf"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public fixesproto
+  (package
+    (name "fixesproto")
+    (version "5.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/fixesproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1ki4wiq2iivx5g4w5ckzbjbap759kfqd72yg18m3zpbb4hqkybxs"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-alias
+  (package
+    (name "font-alias")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-alias-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "16ic8wfwwr3jicaml7b5a0sk6plcgc1kg84w02881yhwmqm3nicb"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-arabic-misc
+  (package
+    (name "font-arabic-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-arabic-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1x246dfnxnmflzf0qzy62k8jdpkb6jkgspcjgbk8jcq9lw99npah"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-bh-ttf
+  (package
+    (name "font-bh-ttf")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-bh-ttf-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0pyjmc0ha288d4i4j0si4dh3ncf3jiwwjljvddrb0k8v4xiyljqv"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-cronyx-cyrillic
+  (package
+    (name "font-cronyx-cyrillic")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-cronyx-cyrillic-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0ai1v4n61k8j9x2a1knvfbl2xjxk3xxmqaq3p9vpqrspc69k31kf"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-cursor-misc
+  (package
+    (name "font-cursor-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-cursor-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0dd6vfiagjc4zmvlskrbjz85jfqhf060cpys8j0y1qpcbsrkwdhp"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-daewoo-misc
+  (package
+    (name "font-daewoo-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-daewoo-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1s2bbhizzgbbbn5wqs3vw53n619cclxksljvm759h9p1prqdwrdw"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-dec-misc
+  (package
+    (name "font-dec-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-dec-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0yzza0l4zwyy7accr1s8ab7fjqkpwggqydbm2vc19scdby5xz7g1"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-isas-misc
+  (package
+    (name "font-isas-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-isas-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0rx8q02rkx673a7skkpnvfkg28i8gmqzgf25s9yi0lar915sn92q"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-jis-misc
+  (package
+    (name "font-jis-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-jis-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0rdc3xdz12pnv951538q6wilx8mrdndpkphpbblszsv7nc8cw61b"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-micro-misc
+  (package
+    (name "font-micro-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-micro-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1dldxlh54zq1yzfnrh83j5vm0k4ijprrs5yl18gm3n9j1z0q2cws"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-misc-cyrillic
+  (package
+    (name "font-misc-cyrillic")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-misc-cyrillic-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0q2ybxs8wvylvw95j6x9i800rismsmx4b587alwbfqiw6biy63z4"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-misc-ethiopic
+  (package
+    (name "font-misc-ethiopic")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-misc-ethiopic-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "19cq7iq0pfad0nc2v28n681fdq3fcw1l1hzaq0wpkgpx7bc1zjsk"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-misc-meltho
+  (package
+    (name "font-misc-meltho")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-misc-meltho-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "148793fqwzrc3bmh2vlw5fdiwjc2n7vs25cic35gfp452czk489p"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-misc-misc
+  (package
+    (name "font-misc-misc")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-misc-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "150pq6n8n984fah34n3k133kggn9v0c5k07igv29sxp1wi07krxq"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("font-util" ,font-util)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-mutt-misc
+  (package
+    (name "font-mutt-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-mutt-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "13qghgr1zzpv64m0p42195k1kc77pksiv059fdvijz1n6kdplpxx"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-schumacher-misc
+  (package
+    (name "font-schumacher-misc")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-schumacher-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0nkym3n48b4v36y4s927bbkjnsmicajarnf6vlp7wxp0as304i74"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontscale" ,mkfontscale)
+        ("mkfontdir" ,mkfontdir)
+        ("font-util" ,font-util)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-screen-cyrillic
+  (package
+    (name "font-screen-cyrillic")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-screen-cyrillic-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0yayf1qlv7irf58nngddz2f1q04qkpr5jwp4aja2j5gyvzl32hl2"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-sony-misc
+  (package
+    (name "font-sony-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-sony-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1xfgcx4gsgik5mkgkca31fj3w72jw9iw76qyrajrsz1lp8ka6hr0"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public fontsproto
+  (package
+    (name "fontsproto")
+    (version "2.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/fontsproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1ab8mbqxdwvdz4k5x4xb9c4n5w7i1xw276cbpk4z7a1nlpjrg746"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-sun-misc
+  (package
+    (name "font-sun-misc")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-sun-misc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1q6jcqrffg9q5f5raivzwx9ffvf7r11g6g0b125na1bhpz5ly7s8"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-util
+  (package
+    (name "font-util")
+    (version "1.3.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-util-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "15cijajwhjzpy3ydc817zz8x5z4gbkyv3fps687jbq544mbfbafz"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public font-winitzki-cyrillic
+  (package
+    (name "font-winitzki-cyrillic")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/font-winitzki-cyrillic-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "181n1bgq8vxfxqicmy1jpm1hnr6gwn1kdhl6hr4frjigs1ikpldb"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mkfontdir" ,mkfontdir)
+        ("bdftopcf" ,bdftopcf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public gccmakedep
+  (package
+    (name "gccmakedep")
+    (version "1.0.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/util/gccmakedep-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "04dfamx3fvkvqfgs6xy2a6yqbxjrj4777ylxp38g60hhbdl4jg86"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public glproto
+  (package
+    (name "glproto")
+    (version "1.4.16")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/proto/glproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "13arnb4bz5pn89bxbh3shr8gihkhyznpjnq3zzr05msygwx6dpal"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public iceauth
+  (package
+    (name "iceauth")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/iceauth-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1aq6v671s2x5rc6zn0rgxb4wddg4vq94mckw3cpwl7ccrjjvd5hl"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libICE" ,libICE)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public imake
+  (package
+    (name "imake")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/util/imake-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1h8ww97aymm10l9qn21n1b9x5ypjrqr10qpf48jjcbc9fg77gklr"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public inputproto
+  (package
+    (name "inputproto")
+    (version "2.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/inputproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1c5wqamfsd8g5i8kya5pjfmcac8q5zq1l3vclh6p96f24nmicxfy"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public kbproto
+  (package
+    (name "kbproto")
+    (version "1.0.6")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/kbproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0yal11hhpiisy3w8wmacsdzzzcnc3xwnswxz8k7zri40xc5aqz03"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libAppleWM
+  (package
+    (name "libAppleWM")
+    (version "1.4.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libAppleWM-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0r8x28n45q89x91mz8mv0zkkcxi8wazkac886fyvflhiv2y8ap2y"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("applewmproto" ,applewmproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libFS
+  (package
+    (name "libFS")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libFS-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "05c3bqgn5m7j4kx8wvy0p36faq6f9jv5yq12m6033m4lflg7cwvh"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xtrans" ,xtrans)
+        ("xproto" ,xproto)
+        ("fontsproto" ,fontsproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libICE
+  (package
+    (name "libICE")
+    (version "1.0.8")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libICE-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "07mp13pb3s73kj7y490gnx619znzwk91mlf8kdw0rzq29ll93a94"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xtrans" ,xtrans)
+        ("xproto" ,xproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libSM
+  (package
+    (name "libSM")
+    (version "1.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libSM-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "07bzi6xwlhq36f60qfspjbz0qjj7zcgayi1vp4ihgx34kib1vhck"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xtrans" ,xtrans)
+        ("xproto" ,xproto)
+        ("util-linux" ,util-linux)
+        ("libICE" ,libICE)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("libICE" ,libICE)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libWindowsWM
+  (package
+    (name "libWindowsWM")
+    (version "1.0.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libWindowsWM-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1p0flwb67xawyv6yhri9w17m1i4lji5qnd0gq8v1vsfb8zw7rw15"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("windowswmproto" ,windowswmproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxScrnSaver
+  (package
+    (name "libxScrnSaver")
+    (version "1.2.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxScrnSaver-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "07ff4r20nkkrj7h08f9fwamds9b3imj8jz5iz6y38zqw6jkyzwcg"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("scrnsaverproto" ,scrnsaverproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxau
+  (package
+    (name "libxau")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxau-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "12d4f7sdv2pjxhk0lcay0pahccddszkw579dc59daqi37r8bllvi"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxaw
+  (package
+    (name "libxaw")
+    (version "1.0.11")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxaw-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "14ll7ndf5njc30hz2w197qvwp7fqj7y14wq4p1cyxlbipfn79a47"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("libxpm" ,libxpm)
+        ("libxmu" ,libxmu)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("libxmu" ,libxmu)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxcomposite
+  (package
+    (name "libxcomposite")
+    (version "0.4.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxcomposite-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1b8sniijb85v4my6v30ma9yqnwl4hkclci9l1hqxnipfyhl4sa9j"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxfixes" ,libxfixes)
+        ("libx11" ,libx11)
+        ("compositeproto" ,compositeproto)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("libxfixes" ,libxfixes)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxcursor
+  (package
+    (name "libxcursor")
+    (version "1.1.13")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxcursor-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "13xd1dyb06gwdwb0bxb22fkgdlmis6wrljm2xk6fhz0v9bg2g27p"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("xproto" ,xproto)
+        ("libxfixes" ,libxfixes)
+        ("libx11" ,libx11)
+        ("fixesproto" ,fixesproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxdamage
+  (package
+    (name "libxdamage")
+    (version "1.1.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxdamage-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1a678bwap74sqczbr2z4y4fvbr35km3inkm8bi1igjyk4v46jqdw"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxfixes" ,libxfixes)
+        ("xextproto" ,xextproto)
+        ("libx11" ,libx11)
+        ("fixesproto" ,fixesproto)
+        ("damageproto" ,damageproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxdmcp
+  (package
+    (name "libxdmcp")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxdmcp-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "13highx4xpgkiwykpcl7z2laslrjc4pzi4h617ny9p7r6116vkls"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxext
+  (package
+    (name "libxext")
+    (version "1.3.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxext-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0ng8clhn7srbkadxjc7ih3z3v27v9ny0aa0dqkgddgxpgrhrq8jn"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxau" ,libxau)
+        ("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("xproto" ,xproto)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxfixes
+  (package
+    (name "libxfixes")
+    (version "5.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxfixes-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1qx2rmwhmca2n7rgafy0arp15k5vwhdhhh6v6mx76hlj29328yjk"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libx11" ,libx11)
+        ("fixesproto" ,fixesproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxfont
+  (package
+    (name "libxfont")
+    (version "1.4.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxfont-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0w3irg00k6b6mziddnacln9q2rkf5848b04nvjqwv5bb1fw6zydv"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("zlib" ,zlib)
+        ("xtrans" ,xtrans)
+        ("xproto" ,xproto)
+        ("freetype" ,freetype)
+        ("fontsproto" ,fontsproto)
+        ("libfontenc" ,libfontenc)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxft
+  (package
+    (name "libxft")
+    (version "2.3.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxft-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1gdv6559cdz1lfw73x7wsvax1fkvphmayrymprljhyyb5nwk5kkz"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("renderproto" ,renderproto)
+        ("libx11" ,libx11)
+        ("xproto" ,xproto)
+        ("libxrender" ,libxrender)
+        ("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("freetype" ,freetype)
+        ("fontconfig" ,fontconfig)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("fontconfig" ,fontconfig)
+        ("freetype" ,freetype)
+        ("libxrender" ,libxrender)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxi
+  (package
+    (name "libxi")
+    (version "1.6.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxi-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "029ihw4jq8mng8rx7a3jdvq64jm1zdkqidca93zmxv4jf9yn5qzj"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("inputproto" ,inputproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxinerama
+  (package
+    (name "libxinerama")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxinerama-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1b3aq1762hxzchd9ndavdjlksq93991s0g2z6spf8wl3v0pprrx4"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xineramaproto" ,xineramaproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxmu
+  (package
+    (name "libxmu")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxmu-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1pbym8rrznxqd60zwf7w4xpf27sa72bky2knginqcfnca32q343h"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxp
+  (package
+    (name "libxp")
+    (version "1.0.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/lib/libxp-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1lj3cjg9ygbmclxvayy5v88kkndpy9jq6y68p13dc5jn01hg5lbi"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libxau" ,libxau)
+        ("libx11" ,libx11)
+        ("printproto" ,printproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxpm
+  (package
+    (name "libxpm")
+    (version "3.5.10")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxpm-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0dd737ch4q9gr151wff1m3q2j7wf3pip4y81601xdrsh8wipxnx6"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxrandr
+  (package
+    (name "libxrandr")
+    (version "1.4.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/lib/libxrandr-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1hzm2ndra4nf8xxzm4lzd225zj05hzbzcq464q2znah15ynd0fh3"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("renderproto" ,renderproto)
+        ("randrproto" ,randrproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxrender
+  (package
+    (name "libxrender")
+    (version "0.9.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxrender-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1rmvja2gkf5v0k2n1bcghw8v98m2kfn3af0rbmsda5dwr69npd7r"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("renderproto" ,renderproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxres
+  (package
+    (name "libxres")
+    (version "1.0.6")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxres-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1478pm70gdi6l70r4jpkyyg2am9wv6xh53z9ibwq5cg84p4n31pz"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("resourceproto" ,resourceproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxt
+  (package
+    (name "libxt")
+    (version "1.1.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxt-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1g85gwnhs7lg5f01gfi1cpb916xc3spm1fjlv2f4xz2zzk1r7dcd"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("libSM" ,libSM)
+        ("kbproto" ,kbproto)
+        ("libICE" ,libICE)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("libSM" ,libSM)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxtst
+  (package
+    (name "libxtst")
+    (version "1.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxtst-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1q750hjplq1rfyxkr4545z1y2a1wfnc828ynvbws7b4jwdk3xsky"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxi" ,libxi)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("recordproto" ,recordproto)
+        ("inputproto" ,inputproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxv
+  (package
+    (name "libxv")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxv-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "044hllz013afhzywwpxz007l4zjy99bv9im065rqd30zckmllrjx"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("videoproto" ,videoproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxvMC
+  (package
+    (name "libxvMC")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxvMC-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "18yf6ysc01pqkbk9704914ghalq1sl2hfdjmwggxm8qqhpy8bw18"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxv" ,libxv)
+        ("xproto" ,xproto)
+        ("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("videoproto" ,videoproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libdmx
+  (package
+    (name "libdmx")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libdmx-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1fiq73sfxcbyjval118ialwrzxhzb08xsxmg69adcs47i9j0p1x7"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xextproto" ,xextproto)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("dmxproto" ,dmxproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libfontenc
+  (package
+    (name "libfontenc")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libfontenc-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0zq1483xy31sssq0h3xxf8y1v4q14cp8rv164ayn7fsn30pq2wny"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("zlib" ,zlib)
+        ("xproto" ,xproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libpciaccess
+  (package
+    (name "libpciaccess")
+    (version "0.13.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libpciaccess-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "11509lkgd5j4g5wy0g13z4sf31h50hqx3jfwb2i4q6k98pv6iar7"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("zlib" ,zlib) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libpthread-stubs
+  (package
+    (name "libpthread-stubs")
+    (version "0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libpthread-stubs-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "16bjv3in19l84hbri41iayvvg4ls9gv1ma0x0qlbmwy67i7dbdim"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxcb
+  (package
+    (name "libxcb")
+    (version "1.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/libxcb-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "15icn78x610dvvgnji6b3pyn8nd88lz68hq0w73pcadf78mycmw8"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxdmcp" ,libxdmcp)
+        ("xcb-proto" ,xcb-proto)
+        ("libxau" ,libxau)
+        ("libpthread-stubs" ,libpthread-stubs)
+        ("libxslt" ,libxslt)
+        ("pkg-config" ,pkg-config)
+        ("python" ,python)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public libxkbfile
+  (package
+    (name "libxkbfile")
+    (version "1.0.8")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/libxkbfile-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0flg5arw6n3njagmsi4i4l0zl5bfx866a1h9ydc3bi1pqlclxaca"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libx11" ,libx11)
+        ("kbproto" ,kbproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public lndir
+  (package
+    (name "lndir")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/util/lndir-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0pdngiy8zdhsiqx2am75yfcl36l7kd7d7nl0rss8shcdvsqgmx29"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public luit
+  (package
+    (name "luit")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/luit-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0dn694mk56x6hdk6y9ylx4f128h5jcin278gnw2gb807rf3ygc1h"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libfontenc" ,libfontenc)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public makedepend
+  (package
+    (name "makedepend")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/makedepend-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1zpp2b9dfvlnfj2i1mzdyn785rpl7vih5lap7kcpiv80xspbhmmb"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public mkfontdir
+  (package
+    (name "mkfontdir")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/mkfontdir-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0c3563kw9fg15dpgx4dwvl12qz6sdqdns1pxa574hc7i5m42mman"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public mkfontscale
+  (package
+    (name "mkfontscale")
+    (version "1.1.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/mkfontscale-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1539h3ws66vcql6sf2831bcs0r4d9b05lcgpswkw33lvcxighmff"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("zlib" ,zlib)
+        ("xproto" ,xproto)
+        ("freetype" ,freetype)
+        ("libfontenc" ,libfontenc)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public pixman
+  (package
+    (name "pixman")
+    (version "0.26.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/lib/pixman-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0z34jb75wpbyj3gxn34icd8j81fk5d6s6qnwp2ncz7m8icf6afqr"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("pkg-config" ,pkg-config) ("perl" ,perl)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public printproto
+  (package
+    (name "printproto")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/proto/printproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "06liap8n4s25sgp27d371cc7yg9a08dxcr3pmdjp761vyin3360j"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxau" ,libxau) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public randrproto
+  (package
+    (name "randrproto")
+    (version "1.4.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/proto/randrproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1kq9h93qdnniiivry8jmhlgwn9fbx9xp5r9cmzfihlx5cs62xi45"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public recordproto
+  (package
+    (name "recordproto")
+    (version "1.14.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/recordproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0w3kgr1zabwf79bpc28dcnj0fpni6r53rpi82ngjbalj5s6m8xx7"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public renderproto
+  (package
+    (name "renderproto")
+    (version "0.11.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/renderproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0dr5xw6s0qmqg0q5pdkb4jkdhaja0vbfqla79qh5j1xjj9dmlwq6"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public resourceproto
+  (package
+    (name "resourceproto")
+    (version "1.2.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/resourceproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0638iyfiiyjw1hg3139pai0j6m65gkskrvd9684zgc6ydcx00riw"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public scrnsaverproto
+  (package
+    (name "scrnsaverproto")
+    (version "1.2.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/scrnsaverproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0rfdbfwd35d761xkfifcscx56q0n56043ixlmv70r4v4l66hmdwb"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public sessreg
+  (package
+    (name "sessreg")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/sessreg-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0lifgjxdvc6lwyjk90slddnr12fsv88ldy6qhklr5av409cfwd47"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public setxkbmap
+  (package
+    (name "setxkbmap")
+    (version "1.3.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/setxkbmap-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1inygpvlgc6vr5h9laxw9lnvafnccl3fy0g5n9ll28iq3yfmqc1x"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxkbfile" ,libxkbfile)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public smproxy
+  (package
+    (name "smproxy")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/smproxy-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "02fn5wa1gs2jap6sr9j9yk6zsvz82j8l61pf74iyqwa99q4wnb67"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("libxmu" ,libxmu)
+        ("libSM" ,libSM)
+        ("libICE" ,libICE)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public twm
+  (package
+    (name "twm")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/twm-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0i6dbf5vafi5hm4bcmnj6r412cncjlv9hkkbr6bzlh15qvg56p8g"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("libxmu" ,libxmu)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("libSM" ,libSM)
+        ("libICE" ,libICE)
+        ("pkg-config" ,pkg-config)
+        ("flex" ,flex)
+        ("bison" ,bison)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public util-macros
+  (package
+    (name "util-macros")
+    (version "1.17")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/util-macros-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1vbmrcn5n3wp4pyw0n4c3pyvzlc4yf7jzgngavfdq5zwfbgfsybx"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public videoproto
+  (package
+    (name "videoproto")
+    (version "2.3.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/videoproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0nk3i6gwkqq1w8zwn7bxz344pi1dwcjrmf6hr330h7hxjcj6viry"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public windowswmproto
+  (package
+    (name "windowswmproto")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/windowswmproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0syjxgy4m8l94qrm03nvn5k6bkxc8knnlld1gbllym97nvnv0ny0"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xauth
+  (package
+    (name "xauth")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xauth-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1382wdfiakgckbw1xxavzh1nm34q21b1zzy96qp7ws66xc48rxw4"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxmu" ,libxmu)
+        ("libxext" ,libxext)
+        ("libxau" ,libxau)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xbacklight
+  (package
+    (name "xbacklight")
+    (version "1.2.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xbacklight-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "199n9qszjiz82nbjz6ychh0xl15igm535mv0830wk4m59w9xclji"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("xcb-util" ,xcb-util)
+        ("libxcb" ,libxcb)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xbitmaps
+  (package
+    (name "xbitmaps")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xbitmaps-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "178ym90kwidia6nas4qr5n5yqh698vv8r02js0r4vg3b6lsb0w9n"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-proto
+  (package
+    (name "xcb-proto")
+    (version "1.8")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-proto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1c11652h9sjynw3scm1pn5z3a6ci888pq7hij8q5n8qrl33icg93"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("pkg-config" ,pkg-config) ("python" ,python)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-util
+  (package
+    (name "xcb-util")
+    (version "0.3.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-util-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1i0qbhqkcdlbbsj7ifkyjsffl61whj24d3zlg5pxf3xj1af2a4f6"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxcb" ,libxcb)
+        ("gperf" ,gperf)
+        ("m4" ,m4)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-util-image
+  (package
+    (name "xcb-util-image")
+    (version "0.3.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-util-image-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1pr1l1nkg197gyl9d0fpwmn72jqpxjfgn9y13q4gawg1m873qnnk"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("xcb-util" ,xcb-util)
+        ("libxcb" ,libxcb)
+        ("m4" ,m4)
+        ("gperf" ,gperf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-util-keysyms
+  (package
+    (name "xcb-util-keysyms")
+    (version "0.3.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-util-keysyms-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0vjwk7vrcfnlhiadv445c6skfxmdrg5v4qf81y8s2s5xagqarqbv"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxcb" ,libxcb)
+        ("m4" ,m4)
+        ("gperf" ,gperf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-util-renderutil
+  (package
+    (name "xcb-util-renderutil")
+    (version "0.3.8")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-util-renderutil-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0lkl9ij9b447c0br2qc5qsynjn09c4fdz7sd6yp7pyi8az2sb2cp"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxcb" ,libxcb)
+        ("m4" ,m4)
+        ("gperf" ,gperf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcb-util-wm
+  (package
+    (name "xcb-util-wm")
+    (version "0.3.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xcb/xcb-util-wm-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0c30fj33gvwzwhyz1dhsfwni0ai16bxpvxb4l6c6s7vvj7drp3q3"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxcb" ,libxcb)
+        ("m4" ,m4)
+        ("gperf" ,gperf)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xclock
+  (package
+    (name "xclock")
+    (version "1.0.6")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xclock-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1l1zxr69p0734fnx9rdqw79ahr273hr050sm8xdc0n51n1bnzfr1"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("libxrender" ,libxrender)
+        ("libxmu" ,libxmu)
+        ("libxkbfile" ,libxkbfile)
+        ("libxft" ,libxft)
+        ("libxaw" ,libxaw)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcmiscproto
+  (package
+    (name "xcmiscproto")
+    (version "1.2.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xcmiscproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1pyjv45wivnwap2wvsbrzdvjc5ql8bakkbkrvcv6q9bjjf33ccmi"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcmsdb
+  (package
+    (name "xcmsdb")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xcmsdb-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "03ms731l3kvaldq7ycbd30j6134b61i3gbll4b2gl022wyzbjq74"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcursorgen
+  (package
+    (name "xcursorgen")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xcursorgen-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "10f5wk1326mm45gvgpf4m2p0j80fcd0i4c52zikahb91zah72wdw"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxcursor" ,libxcursor)
+        ("libx11" ,libx11)
+        ("libpng" ,libpng)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xcursor-themes
+  (package
+    (name "xcursor-themes")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xcursor-themes-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1is4bak0qkkhv63mfa5l7492r475586y52yzfxyv3psppn662ilr"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxcursor" ,libxcursor)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xdm
+  (package
+    (name "xdm")
+    (version "1.1.11")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xdm-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0iqw11977lpr9nk1is4fca84d531vck0mq7jldwl44m0vrnl5nnl"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("libxpm" ,libxpm)
+        ("libxmu" ,libxmu)
+        ("libxinerama" ,libxinerama)
+        ("libxft" ,libxft)
+        ("libxext" ,libxext)
+        ("libxdmcp" ,libxdmcp)
+        ("libxaw" ,libxaw)
+        ("libxau" ,libxau)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xdpyinfo
+  (package
+    (name "xdpyinfo")
+    (version "1.3.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xdpyinfo-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0gypsvpmay3lsh3b1dg29pjxv95pkrr21d4w6ys02mrbld24kvi3"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxxf86vm" ,libxxf86vm)
+        ("libxxf86misc" ,libxxf86misc)
+        ("libxxf86dga" ,libxxf86dga)
+        ("libxtst" ,libxtst)
+        ("libxrender" ,libxrender)
+        ("libxinerama" ,libxinerama)
+        ("libxi" ,libxi)
+        ("libxext" ,libxext)
+        ("libxcomposite" ,libxcomposite)
+        ("libxcb" ,libxcb)
+        ("libx11" ,libx11)
+        ("libdmx" ,libdmx)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xdriinfo
+  (package
+    (name "xdriinfo")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xdriinfo-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "076bjix941znyjmh3j5jjsnhp2gv2iq53d0ks29mvvv87cyy9iim"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("mesa" ,mesa)
+        ("glproto" ,glproto)
+        ("libx11" ,libx11)
+        ("glproto" ,glproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xev
+  (package
+    (name "xev")
+    (version "1.2.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xev-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "13xk5z7vy87rnn4574z0jfzymdivyc7pl4axim81sx0pmdysg1ip"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("libxrandr" ,libxrandr)
+        ("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xextproto
+  (package
+    (name "xextproto")
+    (version "7.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xextproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "06kdanbnprxvgl56l5h0lqj4b0f1fbb1ndha33mv5wvy802v2lvw"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xeyes
+  (package
+    (name "xeyes")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xeyes-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "08d5x2kar5kg4yammw6hhk10iva6jmh8cqq176a1z7nm1il9hplp"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("libxrender" ,libxrender)
+        ("libxmu" ,libxmu)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xfs
+  (package
+    (name "xfs")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xfs-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "17g34yq789grnic83cqj5khq0knda1w2rgabhjflsyw9wg663shd"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xtrans" ,xtrans)
+        ("xproto" ,xproto)
+        ("libxfont" ,libxfont)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xgamma
+  (package
+    (name "xgamma")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xgamma-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0463sawps86jnxn121ramsz4sicy3az5wa5wsq4rqm8dm3za48p3"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxxf86vm" ,libxxf86vm)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xhost
+  (package
+    (name "xhost")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xhost-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0l483y6wfrjh37j16b41kpi2nc7ss5rvndafpbaylrs87ygx2w18"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxmu" ,libxmu)
+        ("libxau" ,libxau)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xineramaproto
+  (package
+    (name "xineramaproto")
+    (version "1.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xineramaproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0ns8abd27x7gbp4r44z3wc5k9zqxxj8zjnazqpcyr4n17nxp8xcp"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xinit
+  (package
+    (name "xinit")
+    (version "1.3.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xinit-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0d821rlqwyn2js7bkzicyp894n9gqv1hahxs285pas1zm3d7z1m1"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("xauth" ,xauth)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xinput
+  (package
+    (name "xinput")
+    (version "1.6.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xinput-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0zl4cdgnzh9shz20yn7hz889v4nkbyqwx0nb7dh6arn7abchgc2a"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("libxrandr" ,libxrandr)
+        ("libxinerama" ,libxinerama)
+        ("libxi" ,libxi)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("inputproto" ,inputproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xkbcomp
+  (package
+    (name "xkbcomp")
+    (version "1.2.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xkbcomp-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0bas1d2wjiy5zy9d0g92d2p9pwv4aapfbfidi7hxy8ax8jmwkl4i"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxkbfile" ,libxkbfile)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xkbevd
+  (package
+    (name "xkbevd")
+    (version "1.1.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xkbevd-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "05h1xcnbalndbrryyqs8wzy9h3wz655vc0ymhlk2q4aik17licjm"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxkbfile" ,libxkbfile)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xkbutils
+  (package
+    (name "xkbutils")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xkbutils-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1ga913pw6chssf2016kjyjl6ar2lj83pa497w97ak2kq603sy2g4"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("libxaw" ,libxaw)
+        ("libx11" ,libx11)
+        ("inputproto" ,inputproto)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xkeyboard-config
+  (package
+    (name "xkeyboard-config")
+    (version "2.6")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xkeyboard-config-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1nmb7ma8rqryicc5xqrn2hm5pwp5lkf7nj28bwbf63mz2r0mk892"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xkill
+  (package
+    (name "xkill")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xkill-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1ac110qbb9a4x1dim3vaghvdk3jc708i2p3f4rmag33458khg0xx"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxmu" ,libxmu)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xlsatoms
+  (package
+    (name "xlsatoms")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xlsatoms-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1y9nfl8s7njxbnci8c20j986xixharasgg40vdw92y593j6dk2rv"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxcb" ,libxcb) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xlsclients
+  (package
+    (name "xlsclients")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xlsclients-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1l97j15mg4wfzpm81wlpzagfjff7v4fwn7s2z2rpksk3gfcg7r8w"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxcb" ,libxcb) ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xmessage
+  (package
+    (name "xmessage")
+    (version "1.0.3")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/app/xmessage-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0nrxidff0pcd1ampfzj91ai74j6mx613j5kqk3j0c4xdshx5v8yg"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("libxaw" ,libxaw)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xmodmap
+  (package
+    (name "xmodmap")
+    (version "1.0.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xmodmap-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1dg47lay4vhrl9mfq3cfc6741a0m2n8wd4ljagd21ix3qklys8pg"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xorg-cf-files
+  (package
+    (name "xorg-cf-files")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/util/xorg-cf-files-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0s86h66b3w4623m88fg2csp41cnr08qc8i3gkj85k3wpwj1wxs9n"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xorg-docs
+  (package
+    (name "xorg-docs")
+    (version "1.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xorg-docs-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0prphdba6kgr1bxk7r07wxxx6x6pqjw6prr5qclypsb5sf5r3cdr"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xorg-server
+  (package
+    (name "xorg-server")
+    (version "1.12.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/individual/xserver/xorg-server-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1xscr6rf0q15hv3hmm51xhwk0c0rx7a2swkj14ygp8vb60sprh4a"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("bigreqsproto" ,bigreqsproto)
+        ("xtrans" ,xtrans)
+        ("xcmiscproto" ,xcmiscproto)
+        ("damageproto" ,damageproto)
+        ("libxfont" ,libxfont)
+        ("pixman" ,pixman)
+        ("libxext" ,libxext)
+        ("recordproto" ,recordproto)
+        ("xf86vidmodeproto" ,xf86vidmodeproto)
+        ("libdmx" ,libdmx)
+        ("dmxproto" ,dmxproto)
+        ("xf86dgaproto" ,xf86dgaproto)
+        ("xineramaproto" ,xineramaproto)
+        ("resourceproto" ,resourceproto)
+        ("scrnsaverproto" ,scrnsaverproto)
+        ("compositeproto" ,compositeproto)
+        ("xf86driproto" ,xf86driproto)
+        ("glproto" ,glproto)
+        ("xf86bigfontproto" ,xf86bigfontproto)
+        ("dbus" ,dbus)
+        ("mesa" ,mesa)
+        ("systemd" ,systemd)
+        ("zlib" ,zlib)
+        ("libxv" ,libxv)
+        ("libxt" ,libxt)
+        ("libxres" ,libxres)
+        ("libxrender" ,libxrender)
+        ("libxpm" ,libxpm)
+        ("libxmu" ,libxmu)
+        ("libxkbfile" ,libxkbfile)
+        ("libxfixes" ,libxfixes)
+        ("libxdmcp" ,libxdmcp)
+        ("libxaw" ,libxaw)
+        ("libxau" ,libxau)
+        ("libx11" ,libx11)
+        ("openssl" ,openssl)
+        ("libdrm" ,libdrm)
+        ("renderproto" ,renderproto)
+        ("pkg-config" ,pkg-config)))
+    (propagated-inputs
+      `(("kbproto" ,kbproto)
+        ("dri2proto" ,dri2proto)
+        ("randrproto" ,randrproto)
+        ("xextproto" ,xextproto)
+        ("inputproto" ,inputproto)
+        ("libpciaccess" ,libpciaccess)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xorg-sgml-doctools
+  (package
+    (name "xorg-sgml-doctools")
+    (version "1.11")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xorg-sgml-doctools-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0k5pffyi5bx8dmfn033cyhgd3gf6viqj3x769fqixifwhbgy2777"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xpr
+  (package
+    (name "xpr")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xpr-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1dbcv26w2yand2qy7b3h5rbvw1mdmdd57jw88v53sgdr3vrqvngy"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxmu" ,libxmu)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xprop
+  (package
+    (name "xprop")
+    (version "1.2.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xprop-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "18zi2any13zlb7f34fzyw6lkiwkd6k2scp3b800a1f4rj0c7m407"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xproto
+  (package
+    (name "xproto")
+    (version "7.0.23")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xproto-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "17lkmi12f89qvg4jj5spqzwzc24fmsqq68dv6kpy7r7b944lmq5d"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xrandr
+  (package
+    (name "xrandr")
+    (version "1.3.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xrandr-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "03lq1c1q4w5cf2ijs4b34v008lshibha9zv5lw08xpyhk9xgyn8h"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxrender" ,libxrender)
+        ("libxrandr" ,libxrandr)
+        ("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xrdb
+  (package
+    (name "xrdb")
+    (version "1.0.9")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xrdb-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1dza5a34nj68fzhlgwf18i5bk0n24ig28yihwpjy7vwn57hh2934"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxmu" ,libxmu)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xrefresh
+  (package
+    (name "xrefresh")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xrefresh-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0ywxzwa4kmnnmf8idr8ssgcil9xvbhnk155zpsh2i8ay93mh5586"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xset
+  (package
+    (name "xset")
+    (version "1.2.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xset-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1s61mvscd0h7y6anljarj7nkii6plhs8ndx1fm8b1f1h00a1qdv1"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxxf86misc" ,libxxf86misc)
+        ("xproto" ,xproto)
+        ("libxmu" ,libxmu)
+        ("libxext" ,libxext)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xsetroot
+  (package
+    (name "xsetroot")
+    (version "1.1.0")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xsetroot-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1bazzsf9sy0q2bj4lxvh1kvyrhmpggzb7jg575i15sksksa3xwc8"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxmu" ,libxmu)
+        ("libxcursor" ,libxcursor)
+        ("xbitmaps" ,xbitmaps)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xtrans
+  (package
+    (name "xtrans")
+    (version "1.2.7")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xtrans-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "19p1bw3qyn0ia1znx6q3gx92rr9rl88ylrfijjclm8vhpa8i30bz"))))
+    (build-system gnu-build-system)
+    (inputs `(("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xvinfo
+  (package
+    (name "xvinfo")
+    (version "1.1.1")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xvinfo-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "119rd93d7661ll1rfcdssn78l0b97326smziyr2f5wdwj2hlmiv0"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxext" ,libxext)
+        ("libxv" ,libxv)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xwd
+  (package
+    (name "xwd")
+    (version "1.0.5")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xwd-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0fkg6msy2zg7rda2rpxb7j6vmrdmqmk72xsxnyhz97196ykjnx82"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("libxt" ,libxt)
+        ("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xwininfo
+  (package
+    (name "xwininfo")
+    (version "1.1.2")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xwininfo-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "0fmcr5yl03xw7m8p9h1rk67rrj7gp5x16a547xhmg8idw2f6r9lg"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libxcb" ,libxcb)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
+  
+(define-public xwud
+  (package
+    (name "xwud")
+    (version "1.0.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append
+               "mirror://xorg/X11R7.7/src/everything/xwud-"
+               version
+               ".tar.bz2"))
+        (sha256
+          (base32
+            "1ggql6maivah58kwsh3z9x1hvzxm1a8888xx4s78cl77ryfa1cyn"))))
+    (build-system gnu-build-system)
+    (inputs
+      `(("xproto" ,xproto)
+        ("libx11" ,libx11)
+        ("pkg-config" ,pkg-config)))
+    (home-page #f)
+    (synopsis #f)
+    (description #f)
+    (license #f)))
+  
\ No newline at end of file
-- 
cgit v1.2.3


From 73274a8ae793b5335e35b89c8dcd65055dcdfe7b Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Fri, 29 Mar 2013 10:51:41 +0100
Subject: gnu: Really add lesstif.

* Makefile.am (MODULES): Commit the module addition.
---
 Makefile.am | 1 +
 1 file changed, 1 insertion(+)

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index 70387ef565..54ca41b3b8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -100,6 +100,7 @@ MODULES =					\
   gnu/packages/irssi.scm 			\
   gnu/packages/ld-wrapper.scm			\
   gnu/packages/less.scm				\
+  gnu/packages/lesstif.scm			\
   gnu/packages/libapr.scm 			\
   gnu/packages/libdaemon.scm			\
   gnu/packages/libevent.scm			\
-- 
cgit v1.2.3


From 14ecc0effca4d7447510bc67a774f897ac03ab87 Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Sun, 31 Mar 2013 17:25:11 +0200
Subject: gnu: Add xpdf.

* gnu/packages/pdf.scm (xpdf): New variable.
* gnu/packages/patches/xpdf-constchar.patch: New file.
* Makefile.am (dist_patch_DATA): Add it.
---
 Makefile.am                               |  3 ++-
 gnu/packages/patches/xpdf-constchar.patch | 15 +++++++++++
 gnu/packages/pdf.scm                      | 42 ++++++++++++++++++++++++++++---
 3 files changed, 56 insertions(+), 4 deletions(-)
 create mode 100644 gnu/packages/patches/xpdf-constchar.patch

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index 54ca41b3b8..9b9bdbf8b3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -223,7 +223,8 @@ dist_patch_DATA =						\
   gnu/packages/patches/tar-gets-undeclared.patch		\
   gnu/packages/patches/tcsh-fix-autotest.patch 			\
   gnu/packages/patches/teckit-cstdio.patch			\
-  gnu/packages/patches/vpnc-script.patch
+  gnu/packages/patches/vpnc-script.patch			\
+  gnu/packages/patches/xpdf-constchar.patch
 
 bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap
 bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux
diff --git a/gnu/packages/patches/xpdf-constchar.patch b/gnu/packages/patches/xpdf-constchar.patch
new file mode 100644
index 0000000000..95dbe73c71
--- /dev/null
+++ b/gnu/packages/patches/xpdf-constchar.patch
@@ -0,0 +1,15 @@
+This patch circumvents an error with 'const char *' to 'char *' conversion,
+see http://gnats.netbsd.org/45562 .
+
+diff -u a/xpdf/XPDFViewer.cc b/xpdf/XPDFViewer.cc
+--- a/xpdf/XPDFViewer.cc        2011-08-15 23:08:53.000000000 +0200
++++ b/xpdf/XPDFViewer.cc        2013-03-31 15:13:21.000000000 +0200
+@@ -1803,7 +1803,7 @@
+   menuPane = XmCreatePulldownMenu(toolBar, "zoomMenuPane", args, n);
+   for (i = 0; i < nZoomMenuItems; ++i) {
+     n = 0;
+-    s = XmStringCreateLocalized(zoomMenuInfo[i].label);
++    s = XmStringCreateLocalized((char *) zoomMenuInfo[i].label);
+     XtSetArg(args[n], XmNlabelString, s); ++n;
+     XtSetArg(args[n], XmNuserData, (XtPointer)i); ++n;
+     sprintf(buf, "zoom%d", i);
diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm
index a172414553..b2f1ade143 100644
--- a/gnu/packages/pdf.scm
+++ b/gnu/packages/pdf.scm
@@ -17,17 +17,21 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages pdf)
-  #:use-module ((guix licenses) #:select (gpl2+))
+  #: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 compression)
   #:use-module (gnu packages fontutils)
+  #:use-module (gnu packages ghostscript)
+  #:use-module (gnu packages lesstif)
   #:use-module (gnu packages libjpeg)
   #:use-module (gnu packages libpng)
   #:use-module (gnu packages libtiff)
-  #:use-module (gnu packages pkg-config))
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages xorg))
 
 (define-public poppler
   (package
@@ -63,5 +67,37 @@
    (synopsis "Poppler, a pdf rendering library")
    (description
     "Poppler is a PDF rendering library based on the xpdf-3.0 code base.")
-   (license gpl2+)
+   (license license:gpl2+)
    (home-page "http://poppler.freedesktop.org/")))
+
+(define-public xpdf
+  (package
+   (name "xpdf")
+   (version "3.03")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "ftp://ftp.foolabs.com/pub/xpdf/xpdf-"
+                                version ".tar.gz"))
+            (sha256 (base32
+                     "1jnfzdqc54wa73lw28kjv0m7120mksb0zkcn81jdlvijyvc67kq2"))))
+   (build-system gnu-build-system)
+   (inputs `(("freetype" ,freetype)
+             ("lesstif" ,lesstif)
+             ("libpaper" ,libpaper)
+             ("libx11" ,libx11)
+             ("libxext" ,libxext)
+             ("libxp" ,libxp)
+             ("libxpm" ,libxpm)
+             ("libxt" ,libxt)
+             ("zlib" ,zlib)
+             ("patch/constchar"
+                 ,(search-patch "xpdf-constchar.patch"))))
+   (arguments
+    `(#:tests? #f ; there is no check target
+      #:patches (list (assoc-ref %build-inputs
+                                 "patch/constchar"))))
+   (synopsis "Viewer for pdf files based on the Motif toolkit.")
+   (description
+    "Xpdf is a viewer for Portable Document Format (PDF) files")
+   (license license:gpl3) ; or gpl2, but not gpl2+
+   (home-page "http://www.foolabs.com/xpdf/")))
-- 
cgit v1.2.3


From 1010e530d38af0b87fced74267bb7864a213b158 Mon Sep 17 00:00:00 2001
From: Cyril Roelandt <tipecaml@gmail.com>
Date: Mon, 1 Apr 2013 00:23:42 +0200
Subject: gnu: Add dwm.

* gnu/packages/dwm.scm: New file.
* Makefile.am: Add it.
---
 Makefile.am          |  1 +
 gnu/packages/dwm.scm | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)
 create mode 100644 gnu/packages/dwm.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index 053dc1e8c5..8dd9808dcd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -79,6 +79,7 @@ MODULES =					\
   gnu/packages/cyrus-sasl.scm			\
   gnu/packages/dejagnu.scm			\
   gnu/packages/ddrescue.scm			\
+  gnu/packages/dwm.scm				\
   gnu/packages/ed.scm				\
   gnu/packages/emacs.scm			\
   gnu/packages/fdisk.scm			\
diff --git a/gnu/packages/dwm.scm b/gnu/packages/dwm.scm
new file mode 100644
index 0000000000..ce87b14e5f
--- /dev/null
+++ b/gnu/packages/dwm.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages dwm)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages xorg))
+
+(define-public dwm
+  (package
+    (name "dwm")
+    (version "6.0")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://dl.suckless.org/dwm/dwm-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32 "0mpbivy9j80l1jqq4bd4g4z8s5c54fxrjj44avmfwncjwqylifdj"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f
+       #:phases
+       (alist-replace
+        'configure
+        (lambda _
+         (substitute* "Makefile" (("\\$\\{CC\\}") "gcc"))
+         #t)
+        (alist-replace
+         'install
+         (lambda* (#:key outputs #:allow-other-keys)
+          (let ((out (assoc-ref outputs "out")))
+           (zero?
+            (system* "make" "install"
+                     (string-append "DESTDIR=" out) "PREFIX="))))
+         %standard-phases))))
+    (inputs
+     `(("libx11" ,libx11)
+       ("libxinerama" ,libxinerama)))
+    (home-page "http://dwm.suckless.org/")
+    (synopsis "Dynamic window manager")
+    (description
+     "dwm is a dynamic window manager for X. It manages windows in tiled,
+monocle and floating layouts. All of the layouts can be applied dynamically,
+optimising the environment for the application in use and the task performed.
+
+In tiled layout windows are managed in a master and stacking area. The master
+area contains the window which currently needs most attention, whereas the
+stacking area contains all other windows. In monocle layout all windows are
+maximised to the screen size. In floating layout windows can be resized and
+moved freely. Dialog windows are always managed floating, regardless of the
+layout applied.
+
+Windows are grouped by tags. Each window can be tagged with one or multiple
+tags. Selecting certain tags displays all windows with these tags.
+
+Each screen contains a small status bar which displays all available tags, the
+layout, the number of visible windows, the title of the focused window, and the
+text read from the root window name property, if the screen is focused. A
+floating window is indicated with an empty square and a maximised floating
+window is indicated with a filled square before the windows title. The selected
+tags are indicated with a different color. The tags of the focused window are
+indicated with a filled square in the top left corner. The tags which are
+applied to one or more windows are indicated with an empty square in the top
+left corner.
+
+dwm draws a small customizable border around windows to indicate the focus
+state.")
+    (license x11)))
-- 
cgit v1.2.3


From f14d6b697e31b04e5657f27388b777ccee3aa5cb Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 2 Apr 2013 10:59:27 +0200
Subject: gnu: Add libphidget.

* gnu/packages/libphidget.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am                 |  1 +
 gnu/packages/libphidget.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+)
 create mode 100644 gnu/packages/libphidget.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index 8dd9808dcd..722b3b79fe 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -116,6 +116,7 @@ MODULES =					\
   gnu/packages/libffi.scm			\
   gnu/packages/libidn.scm			\
   gnu/packages/libjpeg.scm			\
+  gnu/packages/libphidget.scm			\
   gnu/packages/libpng.scm			\
   gnu/packages/libsigsegv.scm			\
   gnu/packages/libtiff.scm			\
diff --git a/gnu/packages/libphidget.scm b/gnu/packages/libphidget.scm
new file mode 100644
index 0000000000..0f4ae5f965
--- /dev/null
+++ b/gnu/packages/libphidget.scm
@@ -0,0 +1,42 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages libphidget)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix licenses)
+  #:use-module (gnu packages libusb))
+
+(define-public libphidget
+  (package
+   (name "libphidget")
+   (version "2.1.8.20130320")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append
+                  "http://www.phidgets.com/downloads/libraries/libphidget_"
+                  version ".tar.gz"))
+            (sha256
+             (base32 "09ibrz1df5ajqcm9vmx6zw8qama2rzf0961yhmmfsy629qfhyrk0"))))
+   (build-system gnu-build-system)
+   (inputs `(("libusb" ,libusb)))
+   (home-page "http://www.phidgets.com/")
+   (license lgpl3+)
+   (synopsis "C library to manipulate Phidgets")
+   (description synopsis)))
-- 
cgit v1.2.3


From 419fffa2e84bdcfee13572e1b346a7487926113d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 2 Apr 2013 10:44:20 +0200
Subject: Add preliminary binary substituter.

* guix/scripts/substitute-binary.scm: New file.
* Makefile.am (MODULES): Add it.
* nix/scripts/substitute-binary.in: New file.
* config-daemon.ac: Produce nix/scripts/substitute-binary.
* daemon.am (nodist_pkglibexec_SCRIPTS): Add
  nix/scripts/substitute-binary.
* guix/store.scm (substitutable-path-info): Use the
  `query-substitutable-path-infos' RPC.
* nix/nix-daemon/guix-daemon.cc (main): Honor `NIX_SUBSTITUTERS'.
* pre-inst-env.in: Set `NIX_SUBSTITUTERS'.
* test-env.in: Leave `NIX_SUBSTITUTERS' unchanged.  Set
  `GUIX_BINARY_SUBSTITUTE_URL, and create
  $NIX_STATE_DIR/substituter-data.
  Run `guix-daemon' within `./pre-inst-env'.
* tests/store.scm ("substitute query"): New test.
---
 .gitignore                         |   1 +
 Makefile.am                        |   1 +
 config-daemon.ac                   |   5 +-
 daemon.am                          |   3 +-
 guix/scripts/substitute-binary.scm | 232 +++++++++++++++++++++++++++++++++++++
 guix/store.scm                     |   2 +-
 nix/nix-daemon/guix-daemon.cc      |  12 +-
 nix/scripts/substitute-binary.in   |  11 ++
 pre-inst-env.in                    |   3 +-
 test-env.in                        |  17 ++-
 tests/store.scm                    |  39 +++++++
 11 files changed, 313 insertions(+), 13 deletions(-)
 create mode 100755 guix/scripts/substitute-binary.scm
 create mode 100644 nix/scripts/substitute-binary.in

(limited to 'Makefile.am')

diff --git a/.gitignore b/.gitignore
index 302e473fd8..f2b1f1cd39 100644
--- a/.gitignore
+++ b/.gitignore
@@ -72,3 +72,4 @@ stamp-h[0-9]
 /doc/guix.tp
 /doc/guix.vr
 /doc/guix.vrs
+/nix/scripts/substitute-binary
diff --git a/Makefile.am b/Makefile.am
index 722b3b79fe..8b3057fd0b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -31,6 +31,7 @@ MODULES =					\
   guix/scripts/package.scm			\
   guix/scripts/gc.scm				\
   guix/scripts/pull.scm				\
+  guix/scripts/substitute-binary.scm		\
   guix/base32.scm				\
   guix/utils.scm				\
   guix/derivations.scm				\
diff --git a/config-daemon.ac b/config-daemon.ac
index f48741dfda..eed1e23f9e 100644
--- a/config-daemon.ac
+++ b/config-daemon.ac
@@ -93,8 +93,9 @@ if test "x$guix_build_daemon" = "xyes"; then
   AC_MSG_RESULT([$GUIX_TEST_ROOT])
   AC_SUBST([GUIX_TEST_ROOT])
 
-  AC_CONFIG_FILES([nix/scripts/list-runtime-roots],
-    [chmod +x nix/scripts/list-runtime-roots])
+  AC_CONFIG_FILES([nix/scripts/list-runtime-roots
+                   nix/scripts/substitute-binary],
+    [chmod +x nix/scripts/list-runtime-roots nix/scripts/substitute-binary])
 fi
 
 AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
diff --git a/daemon.am b/daemon.am
index 4f2314b773..069700b1b6 100644
--- a/daemon.am
+++ b/daemon.am
@@ -159,7 +159,8 @@ nix/libstore/schema.sql.hh: nix/libstore/schema.sql
 	           (write (get-string-all in) out)))))"
 
 nodist_pkglibexec_SCRIPTS =			\
-  nix/scripts/list-runtime-roots
+  nix/scripts/list-runtime-roots		\
+  nix/scripts/substitute-binary
 
 EXTRA_DIST +=					\
   nix/sync-with-upstream			\
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
new file mode 100755
index 0000000000..6e886b6c96
--- /dev/null
+++ b/guix/scripts/substitute-binary.scm
@@ -0,0 +1,232 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts substitute-binary)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:export (guix-substitute-binary))
+
+;;; Comment:
+;;;
+;;; This is the "binary substituter".  It is invoked by the daemon do check
+;;; for the existence of available "substitutes" (pre-built binaries), and to
+;;; actually use them as a substitute to building things locally.
+;;;
+;;; If possible, substitute a binary for the requested store path, using a Nix
+;;; "binary cache".  This program implements the Nix "substituter" protocol.
+;;;
+;;; Code:
+
+(define (fields->alist port)
+  "Read recutils-style record from PORT and return them as a list of key/value
+pairs."
+  (define field-rx
+    (make-regexp "^([[:graph:]]+): (.*)$"))
+
+  (let loop ((line   (read-line port))
+             (result '()))
+    (cond ((eof-object? line)
+           (reverse result))
+          ((regexp-exec field-rx line)
+           =>
+           (lambda (match)
+             (loop (read-line port)
+                   (alist-cons (match:substring match 1)
+                               (match:substring match 2)
+                               result))))
+          (else
+           (error "unmatched line" line)))))
+
+(define (alist->record alist make keys)
+  "Apply MAKE to the values associated with KEYS in ALIST."
+  (let ((args (map (cut assoc-ref alist <>) keys)))
+    (apply make args)))
+
+(define (fetch uri)
+  (case (uri-scheme uri)
+    ((file)
+     (open-input-file (uri-path uri)))
+    ((http)
+     (let*-values (((resp port)
+                    ;; XXX: `http-get*' was introduced in 2.0.7, and deprecated
+                    ;; in 2.0.8 (!).  Assume it is available here.
+                    (if (version>? "2.0.7" (version))
+                        (http-get* uri #:decode-body? #f)
+                        (http-get uri #:streaming? #t)))
+                   ((code)
+                    (response-code resp))
+                   ((size)
+                    (response-content-length resp)))
+       (case code
+         ((200)                                   ; OK
+          port)
+         ((301                                    ; moved permanently
+           302)                                   ; found (redirection)
+          (let ((uri (response-location resp)))
+            (format #t "following redirection to `~a'...~%"
+                    (uri->string uri))
+            (fetch uri)))
+         (else
+          (error "download failed" (uri->string uri)
+                 code (response-reason-phrase resp))))))))
+
+(define-record-type <cache>
+  (%make-cache url store-directory wants-mass-query?)
+  cache?
+  (url               cache-url)
+  (store-directory   cache-store-directory)
+  (wants-mass-query? cache-wants-mass-query?))
+
+(define (open-cache url)
+  "Open the binary cache at URL.  Return a <cache> object on success, or #f on
+failure."
+  (define (download-cache-info url)
+    ;; Download the `nix-cache-info' from URL, and return its contents as an
+    ;; list of key/value pairs.
+    (and=> (false-if-exception (fetch (string->uri url)))
+           fields->alist))
+
+  (and=> (download-cache-info (string-append url "/nix-cache-info"))
+         (lambda (properties)
+           (alist->record properties
+                          (cut %make-cache url <...>)
+                          '("StoreDir" "WantMassQuery")))))
+
+(define-record-type <narinfo>
+  (%make-narinfo path url compression file-hash file-size nar-hash nar-size
+                 references deriver system)
+  narinfo?
+  (path         narinfo-path)
+  (url          narinfo-url)
+  (compression  narinfo-compression)
+  (file-hash    narinfo-file-hash)
+  (file-size    narinfo-file-size)
+  (nar-hash     narinfo-hash)
+  (nar-size     narinfo-size)
+  (references   narinfo-references)
+  (deriver      narinfo-deriver)
+  (system       narinfo-system))
+
+(define (make-narinfo path url compression file-hash file-size nar-hash nar-size
+                      references deriver system)
+  "Return a new <narinfo> object."
+  (%make-narinfo path url compression file-hash
+                 (and=> file-size string->number)
+                 nar-hash
+                 (and=> nar-size string->number)
+                 (string-tokenize references)
+                 (match deriver
+                   ((or #f "") #f)
+                   (_ deriver))
+                 system))
+
+(define (fetch-narinfo cache path)
+  "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
+  (define (download url)
+    ;; Download the `nix-cache-info' from URL, and return its contents as an
+    ;; list of key/value pairs.
+    (and=> (false-if-exception (fetch (string->uri url)))
+           fields->alist))
+
+  (and=> (download (string-append (cache-url cache) "/"
+                                  (store-path-hash-part path)
+                                  ".narinfo"))
+         (lambda (properties)
+           (alist->record properties make-narinfo
+                          '("StorePath" "URL" "Compression"
+                            "FileHash" "FileSize" "NarHash" "NarSize"
+                            "References" "Deriver" "System")))))
+
+(define %cache-url
+  (or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+      "http://hydra.gnu.org"))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-substitute-binary . args)
+  "Implement the build daemon's substituter protocol."
+  (match args
+    (("--query")
+     (let ((cache (open-cache %cache-url)))
+       (let loop ((command (read-line)))
+         (or (eof-object? command)
+             (begin
+               (match (string-tokenize command)
+                 (("have" paths ..1)
+                  ;; Return the subset of PATHS available in CACHE.
+                  (let ((substitutable
+                         (if cache
+                             (par-map (cut fetch-narinfo cache <>)
+                                      paths)
+                             '())))
+                    (for-each (lambda (narinfo)
+                                (when narinfo
+                                  (display (narinfo-path narinfo))
+                                  (newline)))
+                              substitutable)))
+                 (("info" paths ..1)
+                  ;; Reply info about PATHS if it's in CACHE.
+                  (let ((substitutable
+                         (if cache
+                             (par-map (cut fetch-narinfo cache <>)
+                                      paths)
+                             '())))
+                    (for-each (lambda (narinfo)
+                                (format #t "~a\n~a\n~a\n"
+                                        (narinfo-path narinfo)
+                                        (or (and=> (narinfo-deriver narinfo)
+                                                   (cute string-append
+                                                         (%store-prefix) "/"
+                                                         <>))
+                                            "")
+                                        (length (narinfo-references narinfo)))
+                                (for-each (cute format #t "~a/~a~%"
+                                                (%store-prefix) <>)
+                                          (narinfo-references narinfo))
+                                (format #t "~a\n~a\n"
+                                        (or (narinfo-file-size narinfo) 0)
+                                        (or (narinfo-size narinfo) 0))
+                                (newline))
+                              substitutable)))
+                 (wtf
+                  (error "unknown `--query' command" wtf)))
+               (loop (read-line)))))))
+    (("--substitute" store-path destination)
+     ;; Download PATH and add it to the store.
+     ;; TODO: Implement.
+     (format (current-error-port) "substitution not implemented yet~%")
+     #f)
+    (("--version")
+     (show-version-and-exit "guix substitute-binary"))))
+
+;;; substitute-binary.scm ends here
diff --git a/guix/store.scm b/guix/store.scm
index 3bb2656bb6..de9785c835 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -662,7 +662,7 @@ file name.  Return #t on success."
              store-path-list))
 
 (define substitutable-path-info
-  (operation (query-substitutable-paths (store-path-list paths))
+  (operation (query-substitutable-path-infos (store-path-list paths))
              "Return information about the subset of PATHS that is
 substitutable.  For each substitutable path, a `substitutable?' object is
 returned."
diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc
index 1611840bd4..0e2f36150b 100644
--- a/nix/nix-daemon/guix-daemon.cc
+++ b/nix/nix-daemon/guix-daemon.cc
@@ -200,9 +200,17 @@ main (int argc, char *argv[])
     {
       settings.processEnvironment ();
 
-      /* FIXME: Disable substitutes until we have something that works.  */
-      settings.useSubstitutes = false;
+      /* Use our substituter by default.  */
       settings.substituters.clear ();
+      string subs = getEnv ("NIX_SUBSTITUTERS", "default");
+      if (subs == "default")
+	/* XXX: No substituters until we have something that works.  */
+	settings.substituters.clear ();
+	// settings.substituters.push_back (settings.nixLibexecDir
+	// 				 + "/guix/substitute-binary");
+      else
+	settings.substituters = tokenizeString<Strings> (subs, ":");
+
 
       argp_parse (&argp, argc, argv, 0, 0, 0);
 
diff --git a/nix/scripts/substitute-binary.in b/nix/scripts/substitute-binary.in
new file mode 100644
index 0000000000..48d7bb8ff1
--- /dev/null
+++ b/nix/scripts/substitute-binary.in
@@ -0,0 +1,11 @@
+#!@SHELL@
+# A shorthand for "guix substitute-binary", for use by the daemon.
+
+if test "x$GUIX_UNINSTALLED" = "x"
+then
+    prefix="@prefix@"
+    exec_prefix="@exec_prefix@"
+    exec "@bindir@/guix" substitute-binary "$@"
+else
+    exec guix substitute-binary "$@"
+fi
diff --git a/pre-inst-env.in b/pre-inst-env.in
index 4e079c8d41..5e7758cd7c 100644
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -35,8 +35,9 @@ export PATH
 # Daemon helpers.
 
 NIX_ROOT_FINDER="@abs_top_builddir@/nix/scripts/list-runtime-roots"
+NIX_SUBSTITUTERS="@abs_top_builddir@/nix/scripts/substitute-binary"
 NIX_SETUID_HELPER="@abs_top_builddir@/nix-setuid-helper"
-export NIX_ROOT_FINDER NIX_SETUID_HELPER
+export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS
 
 # The following variables need only be defined when compiling Guix
 # modules, but we define them to be on the safe side in case of
diff --git a/test-env.in b/test-env.in
index 491a45c7b4..9a6257197c 100644
--- a/test-env.in
+++ b/test-env.in
@@ -1,7 +1,7 @@
 #!/bin/sh
 
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -26,7 +26,6 @@
 
 if [ -x "@abs_top_builddir@/guix-daemon" ]
 then
-    NIX_SUBSTITUTERS=""		# don't resort to substituters
     NIX_SETUID_HELPER="@abs_top_builddir@/nix-setuid-helper" # normally unused
     NIX_IGNORE_SYMLINK_STORE=1	# in case the store is a symlink
     NIX_STORE_DIR="@GUIX_TEST_ROOT@/store"
@@ -39,18 +38,24 @@ then
     # that the directory name must be chosen so that the socket's file
     # name is less than 108-char long (the size of `sun_path' in glibc).
     # Currently, in Nix builds, we're at ~106 chars...
-    NIX_STATE_DIR="@GUIX_TEST_ROOT@/var/$$" # allow for parallel tests
+    NIX_STATE_DIR="@GUIX_TEST_ROOT@/var/$$"
 
-    export NIX_SUBSTITUTERS NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR	\
+    # A place to store data of the substituter.
+    GUIX_BINARY_SUBSTITUTE_URL="file://$NIX_STATE_DIR/substituter-data"
+    rm -rf "$NIX_STATE_DIR/substituter-data"
+    mkdir -p "$NIX_STATE_DIR/substituter-data"
+
+    export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR			\
 	NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR		\
-	NIX_ROOT_FINDER NIX_SETUID_HELPER
+	NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL
 
     # Do that because store.scm calls `canonicalize-path' on it.
     mkdir -p "$NIX_STORE_DIR"
 
     # Launch the daemon without chroot support because is may be
     # unavailable, for instance if we're not running as root.
-    "@abs_top_builddir@/guix-daemon" --disable-chroot &
+    "@abs_top_builddir@/pre-inst-env"				\
+	"@abs_top_builddir@/guix-daemon" --disable-chroot &
 
     daemon_pid=$!
     trap "kill $daemon_pid ; rm -rf $NIX_STATE_DIR" EXIT
diff --git a/tests/store.scm b/tests/store.scm
index d6e1aa54e3..c75b99c6a9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -26,6 +26,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
+  #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64))
@@ -128,6 +129,44 @@
          (null? (substitutable-paths s o))
          (null? (substitutable-path-info s o)))))
 
+(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
+
+(test-assert "substitute query"
+  (let* ((s   (open-connection))
+         (d   (package-derivation s %bootstrap-guile (%current-system)))
+         (o   (derivation-path->output-path d))
+         (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+                     (compose uri-path string->uri))))
+    ;; Create fake substituter data, to be read by `substitute-binary'.
+    (call-with-output-file (string-append dir "/nix-cache-info")
+      (lambda (p)
+        (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+                (getenv "NIX_STORE_DIR"))))
+    (call-with-output-file (string-append dir "/" (store-path-hash-part o)
+                                          ".narinfo")
+      (lambda (p)
+        (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+References: 
+System: ~a
+Deriver: ~a~%"
+                o                                   ; StorePath
+                (string-append dir "/example.nar")  ; URL
+                (%current-system)                   ; System
+                (basename d))))                     ; Deriver
+
+    ;; Make sure `substitute-binary' correctly communicates the above data.
+    (set-build-options s #:use-substitutes? #t)
+    (and (has-substitutes? s o)
+         (equal? (list o) (substitutable-paths s (list o)))
+         (match (pk 'spi (substitutable-path-info s (list o)))
+           (((? substitutable? s))
+            (and (equal? (substitutable-deriver s) d)
+                 (null? (substitutable-references s))
+                 (equal? (substitutable-nar-size s) 1234)))))))
+
 (test-end "store")
 
 
-- 
cgit v1.2.3


From f0cd71f21e41d5a638b69ecee0fa3939f27a4502 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 4 Apr 2013 22:29:08 +0200
Subject: Add (guix nar) and (guix serialization).

* guix/store.scm (write-int, read-int, write-long-long, read-long-long,
  write-padding, write-string, read-string, read-latin1-string,
  write-string-list, read-string-list, write-store-path,
  read-store-path, write-store-path-list, read-store-path-list): Move to
  serialization.scm.
  (write-contents, write-file): Move to nar.scm.
* guix/nar.scm, guix/serialization.scm: New files.
* Makefile.am (MODULES): Add them.
---
 Makefile.am            |   2 +
 guix/nar.scm           | 110 ++++++++++++++++++++++++++++++++++++
 guix/serialization.scm | 114 +++++++++++++++++++++++++++++++++++++
 guix/store.scm         | 149 +------------------------------------------------
 4 files changed, 228 insertions(+), 147 deletions(-)
 create mode 100644 guix/nar.scm
 create mode 100644 guix/serialization.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index 8b3057fd0b..e4afb74310 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -34,6 +34,8 @@ MODULES =					\
   guix/scripts/substitute-binary.scm		\
   guix/base32.scm				\
   guix/utils.scm				\
+  guix/serialization.scm			\
+  guix/nar.scm					\
   guix/derivations.scm				\
   guix/download.scm				\
   guix/gnu-maintenance.scm			\
diff --git a/guix/nar.scm b/guix/nar.scm
new file mode 100644
index 0000000000..b42f03c514
--- /dev/null
+++ b/guix/nar.scm
@@ -0,0 +1,110 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix nar)
+  #:use-module (guix utils)
+  #:use-module (guix serialization)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 ftw)
+  #:export (write-file))
+
+;;; Comment:
+;;;
+;;; Read and write Nix archives, aka. ‘nar’.
+;;;
+;;; Code:
+
+(define (write-contents file p size)
+  "Write SIZE bytes from FILE to output port P."
+  (define (call-with-binary-input-file file proc)
+    ;; Open FILE as a binary file.  This avoids scan-for-encoding, and thus
+    ;; avoids any initial buffering.  Disable file name canonicalization to
+    ;; avoid stat'ing like crazy.
+    (with-fluids ((%file-port-name-canonicalization #f))
+      (let ((port (open-file file "rb")))
+        (catch #t (cut proc port)
+          (lambda args
+            (close-port port)
+            (apply throw args))))))
+
+  (define (dump in size)
+    (define buf-size 65536)
+    (define buf (make-bytevector buf-size))
+
+    (let loop ((left size))
+      (if (<= left 0)
+          0
+          (let ((read (get-bytevector-n! in buf 0 buf-size)))
+            (if (eof-object? read)
+                left
+                (begin
+                  (put-bytevector p buf 0 read)
+                  (loop (- left read))))))))
+
+  (write-string "contents" p)
+  (write-long-long size p)
+  (call-with-binary-input-file file
+    ;; Use `sendfile' when available (Guile 2.0.8+).
+    (if (compile-time-value (defined? 'sendfile))
+        (cut sendfile p <> size 0)
+        (cut dump <> size)))
+  (write-padding size p))
+
+(define (write-file file port)
+  "Write the contents of FILE to PORT in Nar format, recursing into
+sub-directories of FILE as needed."
+  (define %archive-version-1 "nix-archive-1")
+  (define p port)
+
+  (write-string %archive-version-1 p)
+
+  (let dump ((f file))
+    (let ((s (lstat f)))
+      (write-string "(" p)
+      (case (stat:type s)
+        ((regular)
+         (write-string "type" p)
+         (write-string "regular" p)
+         (if (not (zero? (logand (stat:mode s) #o100)))
+             (begin
+               (write-string "executable" p)
+               (write-string "" p)))
+         (write-contents f p (stat:size s)))
+        ((directory)
+         (write-string "type" p)
+         (write-string "directory" p)
+         (let ((entries (remove (cut member <> '("." ".."))
+                                (scandir f))))
+           (for-each (lambda (e)
+                       (let ((f (string-append f "/" e)))
+                         (write-string "entry" p)
+                         (write-string "(" p)
+                         (write-string "name" p)
+                         (write-string e p)
+                         (write-string "node" p)
+                         (dump f)
+                         (write-string ")" p)))
+                     entries)))
+        (else
+         (error "ENOSYS")))
+      (write-string ")" p))))
+
+;;; nar.scm ends here
diff --git a/guix/serialization.scm b/guix/serialization.scm
new file mode 100644
index 0000000000..474dc69de5
--- /dev/null
+++ b/guix/serialization.scm
@@ -0,0 +1,114 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix serialization)
+  #:use-module (guix utils)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (write-int read-int
+            write-long-long read-long-long
+            write-padding
+            write-string read-string read-latin1-string
+            write-string-list read-string-list
+            write-store-path read-store-path
+            write-store-path-list read-store-path-list))
+
+;;; Comment:
+;;;
+;;; Serialization procedures used by the RPCs and the Nar format.  This module
+;;; is for internal consumption.
+;;;
+;;; Code:
+
+;; Similar to serialize.cc in Nix.
+
+(define (write-int n p)
+  (let ((b (make-bytevector 8 0)))
+    (bytevector-u32-set! b 0 n (endianness little))
+    (put-bytevector p b)))
+
+(define (read-int p)
+  (let ((b (get-bytevector-n p 8)))
+    (bytevector-u32-ref b 0 (endianness little))))
+
+(define (write-long-long n p)
+  (let ((b (make-bytevector 8 0)))
+    (bytevector-u64-set! b 0 n (endianness little))
+    (put-bytevector p b)))
+
+(define (read-long-long p)
+  (let ((b (get-bytevector-n p 8)))
+    (bytevector-u64-ref b 0 (endianness little))))
+
+(define write-padding
+  (let ((zero (make-bytevector 8 0)))
+    (lambda (n p)
+      (let ((m (modulo n 8)))
+        (or (zero? m)
+            (put-bytevector p zero 0 (- 8 m)))))))
+
+(define (write-string s p)
+  (let* ((s (string->utf8 s))
+         (l (bytevector-length s))
+         (m (modulo l 8))
+         (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
+    (bytevector-u32-set! b 0 l (endianness little))
+    (bytevector-copy! s 0 b 8 l)
+    (put-bytevector p b)))
+
+(define (read-string p)
+  (let* ((len (read-int p))
+         (m   (modulo len 8))
+         (bv  (get-bytevector-n p len))
+         (str (utf8->string bv)))
+    (or (zero? m)
+        (get-bytevector-n p (- 8 m)))
+    str))
+
+(define (read-latin1-string p)
+  (let* ((len (read-int p))
+         (m   (modulo len 8))
+         (str (get-string-n p len)))
+    (or (zero? m)
+        (get-bytevector-n p (- 8 m)))
+    str))
+
+(define (write-string-list l p)
+  (write-int (length l) p)
+  (for-each (cut write-string <> p) l))
+
+(define (read-string-list p)
+  (let ((len (read-int p)))
+    (unfold (cut >= <> len)
+            (lambda (i)
+              (read-string p))
+            1+
+            0)))
+
+(define (write-store-path f p)
+  (write-string f p))                             ; TODO: assert path
+
+(define (read-store-path p)
+  (read-string p))                                ; TODO: assert path
+
+(define write-store-path-list write-string-list)
+(define read-store-path-list read-string-list)
+
+;;; serialization.scm ends here
diff --git a/guix/store.scm b/guix/store.scm
index de9785c835..cc21af84e4 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -17,8 +17,10 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix store)
+  #:use-module (guix nar)
   #:use-module (guix utils)
   #:use-module (guix config)
+  #:use-module (guix serialization)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -29,7 +31,6 @@
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:export (%daemon-socket-file
 
@@ -161,152 +162,6 @@
 
 
 
-;; serialize.cc
-
-(define (write-int n p)
-  (let ((b (make-bytevector 8 0)))
-    (bytevector-u32-set! b 0 n (endianness little))
-    (put-bytevector p b)))
-
-(define (read-int p)
-  (let ((b (get-bytevector-n p 8)))
-    (bytevector-u32-ref b 0 (endianness little))))
-
-(define (write-long-long n p)
-  (let ((b (make-bytevector 8 0)))
-    (bytevector-u64-set! b 0 n (endianness little))
-    (put-bytevector p b)))
-
-(define (read-long-long p)
-  (let ((b (get-bytevector-n p 8)))
-    (bytevector-u64-ref b 0 (endianness little))))
-
-(define write-padding
-  (let ((zero (make-bytevector 8 0)))
-    (lambda (n p)
-      (let ((m (modulo n 8)))
-        (or (zero? m)
-            (put-bytevector p zero 0 (- 8 m)))))))
-
-(define (write-string s p)
-  (let* ((s (string->utf8 s))
-         (l (bytevector-length s))
-         (m (modulo l 8))
-         (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
-    (bytevector-u32-set! b 0 l (endianness little))
-    (bytevector-copy! s 0 b 8 l)
-    (put-bytevector p b)))
-
-(define (read-string p)
-  (let* ((len (read-int p))
-         (m   (modulo len 8))
-         (bv  (get-bytevector-n p len))
-         (str (utf8->string bv)))
-    (or (zero? m)
-        (get-bytevector-n p (- 8 m)))
-    str))
-
-(define (read-latin1-string p)
-  (let* ((len (read-int p))
-         (m   (modulo len 8))
-         (str (get-string-n p len)))
-    (or (zero? m)
-        (get-bytevector-n p (- 8 m)))
-    str))
-
-(define (write-string-list l p)
-  (write-int (length l) p)
-  (for-each (cut write-string <> p) l))
-
-(define (read-string-list p)
-  (let ((len (read-int p)))
-    (unfold (cut >= <> len)
-            (lambda (i)
-              (read-string p))
-            1+
-            0)))
-
-(define (write-store-path f p)
-  (write-string f p))                             ; TODO: assert path
-
-(define (read-store-path p)
-  (read-string p))                                ; TODO: assert path
-
-(define write-store-path-list write-string-list)
-(define read-store-path-list read-string-list)
-
-(define (write-contents file p size)
-  "Write SIZE bytes from FILE to output port P."
-  (define (call-with-binary-input-file file proc)
-    ;; Open FILE as a binary file.  This avoids scan-for-encoding, and thus
-    ;; avoids any initial buffering.  Disable file name canonicalization to
-    ;; avoid stat'ing like crazy.
-    (with-fluids ((%file-port-name-canonicalization #f))
-      (let ((port (open-file file "rb")))
-        (catch #t (cut proc port)
-          (lambda args
-            (close-port port)
-            (apply throw args))))))
-
-  (define (dump in size)
-    (define buf-size 65536)
-    (define buf (make-bytevector buf-size))
-
-    (let loop ((left size))
-      (if (<= left 0)
-          0
-          (let ((read (get-bytevector-n! in buf 0 buf-size)))
-            (if (eof-object? read)
-                left
-                (begin
-                  (put-bytevector p buf 0 read)
-                  (loop (- left read))))))))
-
-  (write-string "contents" p)
-  (write-long-long size p)
-  (call-with-binary-input-file file
-    ;; Use `sendfile' when available (Guile 2.0.8+).
-    (if (compile-time-value (defined? 'sendfile))
-        (cut sendfile p <> size 0)
-        (cut dump <> size)))
-  (write-padding size p))
-
-(define (write-file f p)
-  (define %archive-version-1 "nix-archive-1")
-
-  (write-string %archive-version-1 p)
-
-  (let dump ((f f))
-    (let ((s (lstat f)))
-      (write-string "(" p)
-      (case (stat:type s)
-        ((regular)
-         (write-string "type" p)
-         (write-string "regular" p)
-         (if (not (zero? (logand (stat:mode s) #o100)))
-             (begin
-               (write-string "executable" p)
-               (write-string "" p)))
-         (write-contents f p (stat:size s)))
-        ((directory)
-         (write-string "type" p)
-         (write-string "directory" p)
-         (let ((entries (remove (cut member <> '("." ".."))
-                                (scandir f))))
-           (for-each (lambda (e)
-                       (let ((f (string-append f "/" e)))
-                         (write-string "entry" p)
-                         (write-string "(" p)
-                         (write-string "name" p)
-                         (write-string e p)
-                         (write-string "node" p)
-                         (dump f)
-                         (write-string ")" p)))
-                     entries)))
-        (else
-         (error "ENOSYS")))
-      (write-string ")" p))))
-
 ;; Information about a substitutable store path.
 (define-record-type <substitutable>
   (substitutable path deriver refs dl-size nar-size)
-- 
cgit v1.2.3


From 3fdc99da1933e07985b6ca04d3b9412d5df05ade Mon Sep 17 00:00:00 2001
From: Cyril Roelandt <tipecaml@gmail.com>
Date: Sat, 6 Apr 2013 00:28:39 +0200
Subject: gnu: Python: fix the compilation of some modules from the standard
 library.

This commit enables the bz2, dbm, readline, ssl and zlib modules.

* gnu/packages/gdbm.scm: Enable the compatibility mode.
* gnu/packages/python.scm: Enable a few modules from the standard library.
* gnu/packages/patches/python-fix-dbm.patch: New file.
* Makefile.am: Add it.
---
 Makefile.am                               |  1 +
 gnu/packages/gdbm.scm                     |  1 +
 gnu/packages/patches/python-fix-dbm.patch | 20 +++++++++++++++++++
 gnu/packages/python.scm                   | 33 ++++++++++++++++++++++++++++---
 4 files changed, 52 insertions(+), 3 deletions(-)
 create mode 100644 gnu/packages/patches/python-fix-dbm.patch

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index e4afb74310..ab72b1faa7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -234,6 +234,7 @@ dist_patch_DATA =						\
   gnu/packages/patches/make-impure-dirs.patch			\
   gnu/packages/patches/mcron-install.patch			\
   gnu/packages/patches/perl-no-sys-dirs.patch			\
+  gnu/packages/patches/python-fix-dbm.patch			\
   gnu/packages/patches/procps-make-3.82.patch			\
   gnu/packages/patches/qemu-multiple-smb-shares.patch		\
   gnu/packages/patches/readline-link-ncurses.patch		\
diff --git a/gnu/packages/gdbm.scm b/gnu/packages/gdbm.scm
index 588b732b02..76733dba65 100644
--- a/gnu/packages/gdbm.scm
+++ b/gnu/packages/gdbm.scm
@@ -34,6 +34,7 @@
       (sha256
        (base32
         "0h9lfzdjc2yl849y0byg51h6xfjg0y7vg9jnsw3gpfwlbd617y13"))))
+    (arguments `(#:configure-flags '("--enable-libgdbm-compat")))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/gdbm/")
     (synopsis "GNU dbm key/value database library")
diff --git a/gnu/packages/patches/python-fix-dbm.patch b/gnu/packages/patches/python-fix-dbm.patch
new file mode 100644
index 0000000000..29e4521f3f
--- /dev/null
+++ b/gnu/packages/patches/python-fix-dbm.patch
@@ -0,0 +1,20 @@
+This patch allows the dbm module to be built using the compatibility mode of
+gdbm. It will not be needed any more with Python 2.7.4.
+--- setup.py	2013-04-06 00:53:37.000000000 +0200
++++ setup.py.new	2013-04-06 19:55:05.000000000 +0200
+@@ -1158,10 +1158,14 @@
+             for cand in dbm_order:
+                 if cand == "ndbm":
+                     if find_file("ndbm.h", inc_dirs, []) is not None:
+-                        # Some systems have -lndbm, others don't
++                        # Some systems have -lndbm, some have -lgdbm_compat,
++                        # others have no particular linker flags.
+                         if self.compiler.find_library_file(lib_dirs,
+                                                                'ndbm'):
+                             ndbm_libs = ['ndbm']
++                        elif self.compiler.find_library_file(lib_dirs,
++                                                             'gdbm_compat'):
++                            ndbm_libs = ['gdbm_compat']
+                         else:
+                             ndbm_libs = []
+                         print "building dbm using ndbm"
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index 26b76864ce..30bb8e22f7 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -19,7 +19,10 @@
 
 (define-module (gnu packages python)
   #:use-module ((guix licenses) #:select (psfl))
+  #:use-module (gnu packages)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages gdbm)
+  #:use-module (gnu packages readline)
   #:use-module (gnu packages openssl)
   #:use-module (guix packages)
   #:use-module (guix download)
@@ -38,11 +41,35 @@
        (base32
         "11f9aw855lrmknr6c82gm1ijr3n0smc6idyp94y7774yivjnplv1"))))
     (build-system gnu-build-system)
-    (arguments `(#:tests? #f)) ; XXX: some tests fail
+    (arguments
+     `(#:tests? #f ; XXX: some tests fail
+       #:patches (list (assoc-ref %build-inputs "patch-dbm"))
+       #:patch-flags '("-p0")
+       #:configure-flags
+        (let ((bz2 (assoc-ref %build-inputs "bzip2"))
+              (gdbm (assoc-ref %build-inputs "gdbm"))
+              (openssl (assoc-ref %build-inputs "openssl"))
+              (readline (assoc-ref %build-inputs "readline"))
+              (zlib (assoc-ref %build-inputs "zlib")))
+         (list (string-append "CPPFLAGS="
+                "-I" bz2 "/include "
+                "-I" gdbm "/include "
+                "-I" openssl "/include "
+                "-I" readline "/include "
+                "-I" zlib "/include")
+               (string-append "LDFLAGS="
+                "-L" bz2 "/lib "
+                "-L" gdbm "/lib "
+                "-L" openssl "/lib "
+                "-L" readline "/lib "
+                "-L" zlib "/lib")))))
     (inputs
-     `(("zlib" ,zlib)
+     `(("bzip2" ,bzip2)
+       ("gdbm" ,gdbm)
        ("openssl" ,openssl)
-       ("bzip2" ,bzip2)))
+       ("readline" ,readline)
+       ("zlib" ,zlib)
+       ("patch-dbm" ,(search-patch "python-fix-dbm.patch"))))
     (native-search-paths
      (list (search-path-specification
             (variable "PYTHONPATH")
-- 
cgit v1.2.3


From 865c4ef33ce65ca87002a268230edae504c87166 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Fri, 5 Apr 2013 23:08:44 +0000
Subject: gnu: shishi: Update to 1.0.2.

* gnu/packages/shishi.scm (shishi): Update to 1.0.2.
* gnu/packages/patches/shishi-gets-undeclared.patch: Remove it.
* Makefile.am (dist_patch_DATA): Adjust accordingly.
---
 Makefile.am                                       |  1 -
 gnu/packages/patches/shishi-gets-undeclared.patch | 71 -----------------------
 gnu/packages/shishi.scm                           | 46 +++++----------
 3 files changed, 16 insertions(+), 102 deletions(-)
 delete mode 100644 gnu/packages/patches/shishi-gets-undeclared.patch

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index ab72b1faa7..f73437f0f4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -238,7 +238,6 @@ dist_patch_DATA =						\
   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		\
   gnu/packages/patches/tcsh-fix-autotest.patch			\
   gnu/packages/patches/teckit-cstdio.patch			\
diff --git a/gnu/packages/patches/shishi-gets-undeclared.patch b/gnu/packages/patches/shishi-gets-undeclared.patch
deleted file mode 100644
index a3d6d0cca2..0000000000
--- a/gnu/packages/patches/shishi-gets-undeclared.patch
+++ /dev/null
@@ -1,71 +0,0 @@
-This patch is needed to allow builds with newer versions of
-the GNU libc (2.16+).
-
-
-commit 66712c23388e93e5c518ebc8515140fa0c807348
-Author: Eric Blake <eblake@redhat.com>
-Date:   Thu Mar 29 13:30:41 2012 -0600
-
-    stdio: don't assume gets any more
-    
-    Gnulib intentionally does not have a gets module, and now that C11
-    and glibc have dropped it, we should be more proactive about warning
-    any user on a platform that still has a declaration of this dangerous
-    interface.
-    
-    * m4/stdio_h.m4 (gl_STDIO_H, gl_STDIO_H_DEFAULTS): Drop gets
-    support.
-    * modules/stdio (Makefile.am): Likewise.
-    * lib/stdio-read.c (gets): Likewise.
-    * tests/test-stdio-c++.cc: Likewise.
-    * m4/warn-on-use.m4 (gl_WARN_ON_USE_PREPARE): Fix comment.
-    * lib/stdio.in.h (gets): Make warning occur in more places.
-    * doc/posix-functions/gets.texi (gets): Update documentation.
-    Reported by Christer Solskogen.
-    
-    Signed-off-by: Eric Blake <eblake@redhat.com>
-
-diff --git a/gl/stdio.in.h b/gl/stdio.in.h
-index aa7b599..c377b6e 100644
---- a/gl/stdio.in.h
-+++ b/gl/stdio.in.h
-@@ -698,22 +698,11 @@ _GL_WARN_ON_USE (getline, "getline is unportable - "
- # endif
- #endif
- 
--#if @GNULIB_GETS@
--# if @REPLACE_STDIO_READ_FUNCS@ && @GNULIB_STDIO_H_NONBLOCKING@
--#  if !(defined __cplusplus && defined GNULIB_NAMESPACE)
--#   undef gets
--#   define gets rpl_gets
--#  endif
--_GL_FUNCDECL_RPL (gets, char *, (char *s) _GL_ARG_NONNULL ((1)));
--_GL_CXXALIAS_RPL (gets, char *, (char *s));
--# else
--_GL_CXXALIAS_SYS (gets, char *, (char *s));
--#  undef gets
--# endif
--_GL_CXXALIASWARN (gets);
- /* It is very rare that the developer ever has full control of stdin,
--   so any use of gets warrants an unconditional warning.  Assume it is
--   always declared, since it is required by C89.  */
-+   so any use of gets warrants an unconditional warning; besides, C11
-+   removed it.  */
-+#undef gets
-+#if HAVE_RAW_DECL_GETS
- _GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead");
- #endif
- 
-@@ -1053,9 +1042,9 @@ _GL_WARN_ON_USE (snprintf, "snprintf is unportable - "
- # endif
- #endif
- 
--/* Some people would argue that sprintf should be handled like gets
--   (for example, OpenBSD issues a link warning for both functions),
--   since both can cause security holes due to buffer overruns.
-+/* Some people would argue that all sprintf uses should be warned about
-+   (for example, OpenBSD issues a link warning for it),
-+   since it can cause security holes due to buffer overruns.
-    However, we believe that sprintf can be used safely, and is more
-    efficient than snprintf in those safe cases; and as proof of our
-    belief, we use sprintf in several gnulib modules.  So this header
diff --git a/gnu/packages/shishi.scm b/gnu/packages/shishi.scm
index 1590221496..767037a580 100644
--- a/gnu/packages/shishi.scm
+++ b/gnu/packages/shishi.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -18,12 +18,11 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages shishi)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses) #:select (gpl3+))
   #:use-module (gnu packages)
   #:use-module (gnu packages gnutls)
   #:use-module (gnu packages gnupg)
-  #:use-module ((gnu packages compression)
-                #:renamer (symbol-prefix-proc 'guix:))
+  #:use-module (gnu packages compression)
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu))
@@ -31,41 +30,28 @@
 (define-public shishi
   (package
     (name "shishi")
-    (version "1.0.1")
+    (version "1.0.2")
     (source
      (origin
       (method url-fetch)
-      (uri (string-append
-            "mirror://gnu/shishi/shishi-"
-            version
-            ".tar.gz"))
+      (uri (string-append "mirror://gnu/shishi/shishi-"
+                          version ".tar.gz"))
       (sha256
        (base32
-        "13c6w9rpaqb3am65nrn86byvmll5r78pld2vb0i68491vww4fzlx"))))
+        "032qf72cpjdfffq1yq54gz3ahgqf2ijca4vl31sfabmjzq9q370d"))))
     (build-system gnu-build-system)
-    (arguments
-     `(#:make-flags
-       '("CPPFLAGS=-DMAX_ERROR_DESCRIPTION_SIZE=ASN1_MAX_ERROR_DESCRIPTION_SIZE")
-       #:patches (list (assoc-ref %build-inputs
-                                  "patch/gets"))))
     (inputs
      `(("gnutls" ,gnutls)
-       ("zlib" ,guix:zlib)
+       ("zlib" ,zlib)
        ("libgcrypt" ,libgcrypt)
-       ("libtasn1" ,libtasn1)
-       ("patch/gets" ,(search-patch "shishi-gets-undeclared.patch"))))
+       ("libtasn1" ,libtasn1)))
     (home-page "http://www.gnu.org/software/shishi/")
     (synopsis
-     "GNU Shishi, free implementation of the Kerberos 5 network security system")
+     "GNU Shishi, an implementation of the Kerberos 5 network security system")
     (description
-     " GNU Shishi is an implementation of the Kerberos 5 network
-  authentication system, as specified in RFC 4120.  Shishi can be
-  used to authenticate users in distributed systems.
-
-  Shishi contains a library (`libshishi') that can be used by
-  application developers to add support for Kerberos 5.  Shishi
-  contains a command line utility (1shishi') that is used by
-  users to acquire and manage tickets (and more).  The server
-  side, a Key Distribution Center, is implemented by `shishid'.
-")
-    (license gpl3+))) ; some files are under GPLv2+
+     "Shishi contains a library ('libshishi') that can be used by application
+developers to add support for Kerberos 5.  Shishi contains a command line
+utility ('shishi') that is used by users to acquire and manage tickets (and
+more).  The server side, a Key Distribution Center (KDC), is implemented by
+'shishid', and support X.509 authenticated TLS via GnuTLS.")
+    (license gpl3+)))
-- 
cgit v1.2.3


From ca877f5a3a0e216d2e0e62bea3e42cdc2e4c3dab Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 8 Apr 2013 22:54:08 +0200
Subject: nar: Implement restoration from Nar.

* guix/nar.scm (&nar-error, &nar-read-error): New condition types.
  (dump): New procedure.
  (write-contents)[dump]: Remove.  Use the one above instead.
  (read-contents, write-file, restore-file): New procedures.
  (%archive-version-1): New variable.
---
 Makefile.am   |   1 +
 guix/nar.scm  | 150 +++++++++++++++++++++++++++++++++++++++++++++++++++-------
 tests/nar.scm |  95 +++++++++++++++++++++++++++++++++++++
 3 files changed, 228 insertions(+), 18 deletions(-)
 create mode 100644 tests/nar.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index f73437f0f4..a1bda16759 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -302,6 +302,7 @@ TESTS =						\
   tests/packages.scm				\
   tests/snix.scm				\
   tests/store.scm				\
+  tests/nar.scm					\
   tests/union.scm				\
   tests/guix-build.sh				\
   tests/guix-download.sh			\
diff --git a/guix/nar.scm b/guix/nar.scm
index b42f03c514..9ae76ff2a9 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -19,12 +19,23 @@
 (define-module (guix nar)
   #:use-module (guix utils)
   #:use-module (guix serialization)
+  #:use-module ((guix build utils) #:select (with-directory-excursion))
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 ftw)
-  #:export (write-file))
+  #:use-module (ice-9 match)
+  #:export (nar-error?
+            nar-read-error?
+            nar-read-error-file
+            nar-read-error-port
+            nar-read-error-token
+
+            write-file
+            restore-file))
 
 ;;; Comment:
 ;;;
@@ -32,6 +43,31 @@
 ;;;
 ;;; Code:
 
+(define-condition-type &nar-error &error      ; XXX: inherit from &nix-error ?
+  nar-error?)
+
+(define-condition-type &nar-read-error &nar-error
+  nar-read-error?
+  (port  nar-read-error-port)                   ; port from which we read
+  (file  nar-read-error-file)                   ; file we were restoring, or #f
+  (token nar-read-error-token))                 ; faulty token, or #f
+
+
+(define (dump in out size)
+  "Copy SIZE bytes from IN to OUT."
+  (define buf-size 65536)
+  (define buf (make-bytevector buf-size))
+
+  (let loop ((left size))
+    (if (<= left 0)
+        0
+        (let ((read (get-bytevector-n! in buf 0 (min left buf-size))))
+          (if (eof-object? read)
+              left
+              (begin
+                (put-bytevector out buf 0 read)
+                (loop (- left read))))))))
+
 (define (write-contents file p size)
   "Write SIZE bytes from FILE to output port P."
   (define (call-with-binary-input-file file proc)
@@ -45,33 +81,55 @@
             (close-port port)
             (apply throw args))))))
 
-  (define (dump in size)
-    (define buf-size 65536)
-    (define buf (make-bytevector buf-size))
-
-    (let loop ((left size))
-      (if (<= left 0)
-          0
-          (let ((read (get-bytevector-n! in buf 0 buf-size)))
-            (if (eof-object? read)
-                left
-                (begin
-                  (put-bytevector p buf 0 read)
-                  (loop (- left read))))))))
-
   (write-string "contents" p)
   (write-long-long size p)
   (call-with-binary-input-file file
     ;; Use `sendfile' when available (Guile 2.0.8+).
     (if (compile-time-value (defined? 'sendfile))
         (cut sendfile p <> size 0)
-        (cut dump <> size)))
+        (cut dump <> p size)))
   (write-padding size p))
 
+(define (read-contents in out)
+  "Read the contents of a file from the Nar at IN, write it to OUT, and return
+the size in bytes."
+  (define executable?
+    (match (read-string in)
+      ("contents"
+       #f)
+      ("executable"
+       (match (list (read-string in) (read-string in))
+         (("" "contents") #t)
+         (x (raise
+             (condition (&message
+                         (message "unexpected executable file marker"))
+                        (&nar-read-error (port in)
+                                         (file #f)
+                                         (token x))))))
+       #t)
+      (x
+       (raise
+        (condition (&message (message "unsupported nar file type"))
+                   (&nar-read-error (port in) (file #f) (token x)))))))
+
+  (let ((size (read-long-long in)))
+    ;; Note: `sendfile' cannot be used here because of port buffering on IN.
+    (dump in out size)
+
+    (when executable?
+      (chmod out #o755))
+    (let ((m (modulo size 8)))
+      (unless (zero? m)
+        (get-bytevector-n in (- 8 m))))
+    size))
+
+(define %archive-version-1
+  ;; Magic cookie for Nix archives.
+  "nix-archive-1")
+
 (define (write-file file port)
   "Write the contents of FILE to PORT in Nar format, recursing into
 sub-directories of FILE as needed."
-  (define %archive-version-1 "nix-archive-1")
   (define p port)
 
   (write-string %archive-version-1 p)
@@ -104,7 +162,63 @@ sub-directories of FILE as needed."
                          (write-string ")" p)))
                      entries)))
         (else
-         (error "ENOSYS")))
+         (raise (condition (&message (message "ENOSYS"))
+                           (&nar-error)))))
       (write-string ")" p))))
 
+(define (restore-file port file)
+  "Read a file (possibly a directory structure) in Nar format from PORT.
+Restore it as FILE."
+  (let ((signature (read-string port)))
+    (unless (equal? signature %archive-version-1)
+      (raise
+       (condition (&message (message "invalid nar signature"))
+                  (&nar-read-error (port port)
+                                   (token signature)
+                                   (file #f))))))
+
+  (let restore ((file file))
+    (match (list (read-string port) (read-string port) (read-string port))
+      (("(" "type" "regular")
+       (call-with-output-file file (cut read-contents port <>))
+       (match (read-string port)
+         (")" #t)
+         (x (raise
+             (condition
+              (&message (message "invalid nar end-of-file marker"))
+              (&nar-read-error (port port) (file file) (token x)))))))
+      (("(" "type" "directory")
+       (let ((dir file))
+         (mkdir dir)
+         (let loop ((prefix (read-string port)))
+           (match prefix
+             ("entry"
+              (match (list (read-string port)
+                           (read-string port) (read-string port)
+                           (read-string port))
+                (("(" "name" file "node")
+                 (restore (string-append dir "/" file))
+                 (match (read-string port)
+                   (")" #t)
+                   (x
+                    (raise
+                     (condition
+                      (&message
+                       (message "unexpected directory entry termination"))
+                      (&nar-read-error (port port)
+                                       (file file)
+                                       (token x))))))
+                 (loop (read-string port)))))
+             (")" #t)                             ; done with DIR
+             (x
+              (raise
+               (condition
+                (&message (message "unexpected directory inter-entry marker"))
+                (&nar-read-error (port port) (file file) (token x)))))))))
+      (x
+       (raise
+        (condition
+         (&message (message "unsupported nar entry type"))
+         (&nar-read-error (port port) (file file) (token x))))))))
+
 ;;; nar.scm ends here
diff --git a/tests/nar.scm b/tests/nar.scm
new file mode 100644
index 0000000000..2d9bffd487
--- /dev/null
+++ b/tests/nar.scm
@@ -0,0 +1,95 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-nar)
+  #:use-module (guix nar)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 ftw))
+
+;; Test the (guix nar) module.
+
+(define (rm-rf dir)
+  (file-system-fold (const #t)                    ; enter?
+                    (lambda (file stat result)    ; leaf
+                      (delete-file file))
+                    (const #t)                    ; down
+                    (lambda (dir stat result)     ; up
+                      (rmdir dir))
+                    (const #t)                    ; skip
+                    (const #t)                    ; error
+                    #t
+                    dir
+                    lstat))
+
+
+(test-begin "nar")
+
+(test-assert "write-file + restore-file"
+  (let* ((input  (string-append (dirname (search-path %load-path "guix.scm"))
+                                "/guix"))
+         (output (string-append (dirname input)
+                                "/test-nar-"
+                                (number->string (getpid))))
+         (nar    (string-append output ".nar")))
+    (dynamic-wind
+      (lambda () #t)
+      (lambda ()
+        (call-with-output-file nar
+          (cut write-file input <>))
+        (call-with-input-file nar
+          (cut restore-file <> output))
+        (let* ((strip   (cute string-drop <> (string-length input)))
+               (sibling (compose (cut string-append output <>) strip))
+               (file=?  (lambda (a b)
+                          (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
+                               (case (stat:type (lstat a))
+                                 ((regular)
+                                  (equal?
+                                   (call-with-input-file a get-bytevector-all)
+                                   (call-with-input-file b get-bytevector-all)))
+                                 ((symlink)
+                                  (string=? (readlink a) (readlink b)))
+                                 (else
+                                  (error "what?" (lstat a))))))))
+          (file-system-fold (const #t)
+                            (lambda (name stat result) ; leaf
+                              (and result
+                                   (file=? name (sibling name))))
+                            (lambda (name stat result) ; down
+                              result)
+                            (lambda (name stat result) ; up
+                              result)
+                            (const #f)                 ; skip
+                            (lambda (name stat errno result)
+                              (pk 'error name stat errno)
+                              #f)
+                            (> (stat:nlink (stat output)) 2)
+                            input
+                            lstat)))
+      (lambda ()
+        (false-if-exception (delete-file nar))
+        (false-if-exception (rm-rf output))
+        ))))
+
+(test-end "nar")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
-- 
cgit v1.2.3


From c5c555b186a894e6bd3d5709c5199fcab1f0b7d0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Apr 2013 21:26:41 +0200
Subject: gnu: Add Ratpoison.

* gnu/packages/ratpoison.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am                |  1 +
 gnu/packages/ratpoison.scm | 71 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)
 create mode 100644 gnu/packages/ratpoison.scm

(limited to 'Makefile.am')

diff --git a/Makefile.am b/Makefile.am
index a1bda16759..d07272f8bd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -157,6 +157,7 @@ MODULES =					\
   gnu/packages/pth.scm				\
   gnu/packages/python.scm			\
   gnu/packages/qemu.scm				\
+  gnu/packages/ratpoison.scm			\
   gnu/packages/readline.scm			\
   gnu/packages/recutils.scm			\
   gnu/packages/rsync.scm			\
diff --git a/gnu/packages/ratpoison.scm b/gnu/packages/ratpoison.scm
new file mode 100644
index 0000000000..30e6c224d6
--- /dev/null
+++ b/gnu/packages/ratpoison.scm
@@ -0,0 +1,71 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages ratpoison)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module ((guix licenses) #:select (gpl2+))
+  #:use-module (gnu packages xorg)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages readline)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages fontutils))
+
+(define-public ratpoison
+  (package
+    (name "ratpoison")
+    (version "1.4.6")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://savannah/ratpoison/ratpoison-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("perl" ,perl)
+       ("pkg-config" ,pkg-config)
+       ("libXi" ,libxi)
+       ("readline" ,readline)
+       ("xextproto" ,xextproto)
+       ("libXtst" ,libxtst)
+       ("freetype" ,freetype)
+       ("fontconfig" ,fontconfig)
+       ("libXft" ,libxft)
+       ("libXpm" ,libxpm)
+       ("libXt" ,libxt)
+       ("inputproto" ,inputproto)
+       ("libX11" ,libx11)))
+    (home-page "http://www.nongnu.org/ratpoison/")
+    (synopsis "A simple mouse-free tiling window manager")
+    (description
+     "Ratpoison is a simple window manager with no fat library
+dependencies, no fancy graphics, no window decorations, and no
+rodent dependence.  It is largely modelled after GNU Screen which
+has done wonders in the virtual terminal market.
+
+The screen can be split into non-overlapping frames.  All windows
+are kept maximized inside their frames to take full advantage of
+your precious screen real estate.
+
+All interaction with the window manager is done through keystrokes.
+Ratpoison has a prefix map to minimize the key clobbering that
+cripples Emacs and other quality pieces of software.")
+    (license gpl2+)))
-- 
cgit v1.2.3