From 96be765ca5f89640b5d13e61ca04de7254040f3c Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Wed, 13 Feb 2013 00:41:05 +0100
Subject: gnu: Add signing-party.

* gnu/packages/gnupg.scm (signing-party): New variable.
---
 gnu/packages/gnupg.scm | 104 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)

(limited to 'gnu')

diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index 046d4c2d76..f26582fb22 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -227,3 +227,107 @@ (define-public pius
 PGP keysigning parties.")
    (license gpl2)
    (home-page "http://www.phildev.net/pius/index.shtml")))
+
+(define-public signing-party
+  (package
+   (name "signing-party")
+   (version "1.1.4")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "http://ftp.debian.org/debian/pool/main/s/signing-party/signing-party_"
+                                version ".orig.tar.gz"))
+            (sha256 (base32
+                     "188gp0prbh8qs29lq3pbf0qibfd6jq4fk7i0pfrybl8aahvm84rx"))))
+   (build-system gnu-build-system)
+   (inputs `(("perl" ,perl)))
+   (arguments
+    `(#:tests? #f
+      #:phases
+      (alist-replace
+       'unpack
+       (lambda* (#:key #:allow-other-keys #:rest args)
+         (let ((unpack (assoc-ref %standard-phases 'unpack)))
+           (apply unpack args)
+           ;; remove spurious symlink
+           (delete-file "keyanalyze/pgpring/depcomp")))
+      (alist-replace
+       'configure
+       (lambda* (#:key outputs #:allow-other-keys)
+         (let ((out (assoc-ref outputs "out")))
+           (substitute* "keyanalyze/Makefile"
+             (("LDLIBS") (string-append "CC=" (which "gcc") "\nLDLIBS")))
+           (substitute* "keyanalyze/Makefile"
+             (("./configure") (string-append "./configure --prefix=" out)))
+           (substitute* "keyanalyze/pgpring/configure"
+             (("/bin/sh") (which "bash")))
+           (substitute* "gpgwrap/Makefile"
+             (("\\} clean") (string-append "} clean\ninstall:\n\tinstall -D bin/gpgwrap "
+                                      out "/bin/gpgwrap\n")))
+           (substitute* '("gpgsigs/Makefile" "keyanalyze/Makefile"
+                          "keylookup/Makefile" "sig2dot/Makefile"
+                          "springgraph/Makefile")
+             (("/usr") out))))
+       (alist-replace
+        'install
+        (lambda* (#:key outputs #:allow-other-keys #:rest args)
+          (let ((out (assoc-ref outputs "out"))
+                (install (assoc-ref %standard-phases 'install)))
+            (apply install args)
+            (for-each
+              (lambda (dir file)
+                (copy-file (string-append dir "/" file)
+                           (string-append out "/bin/" file)))
+              '("caff" "caff" "caff" "gpgdir" "gpg-key2ps"
+                "gpglist" "gpg-mailkeys" "gpgparticipants")
+              '("caff" "pgp-clean" "pgp-fixkey" "gpgdir" "gpg-key2ps"
+                "gpglist" "gpg-mailkeys" "gpgparticipants"))
+            (for-each
+              (lambda (dir file)
+                (copy-file (string-append dir "/" file)
+                           (string-append out "/share/man/man1/" file)))
+              '("caff" "caff" "caff" "gpgdir"
+                "gpg-key2ps" "gpglist" "gpg-mailkeys"
+                "gpgparticipants" "gpgsigs" "gpgwrap/doc"
+                "keyanalyze" "keyanalyze/pgpring" "keyanalyze")
+              '("caff.1" "pgp-clean.1" "pgp-fixkey.1" "gpgdir.1"
+                "gpg-key2ps.1" "gpglist.1" "gpg-mailkeys.1"
+                "gpgparticipants.1" "gpgsigs.1" "gpgwrap.1"
+                "process_keys.1" "pgpring.1" "keyanalyze.1"))))
+      %standard-phases)))))
+   (synopsis "collection of scripts for simplifying gnupg key signing")
+   (description
+    "signing-party is a collection for all kinds of PGP/GnuPG related things,
+including tools for signing keys, keyring analysis, and party preparation.
+
+ * caff: CA - Fire and Forget signs and mails a key
+ 
+ * pgp-clean: removes all non-self signatures from key
+
+ * pgp-fixkey: removes broken packets from keys
+
+ * gpg-mailkeys: simply mail out a signed key to its owner
+
+ * gpg-key2ps: generate PostScript file with fingerprint paper strips
+
+ * gpgdir: recursive directory encryption tool
+
+ * gpglist: show who signed which of your UIDs
+
+ * gpgsigs: annotates list of GnuPG keys with already done signatures
+
+ * gpgparticipants: create list of party participants for the organiser
+
+ * gpgwrap: a passphrase wrapper
+
+ * keyanalyze: minimum signing distance (MSD) analysis on keyrings
+
+ * keylookup: ncurses wrapper around gpg --search
+
+ * sig2dot: converts a list of GnuPG signatures to a .dot file
+
+ * springgraph: creates a graph from a .dot file")
+   ;; gpl2+ for almost all programs, except for keyanalyze: gpl2
+   ;; and caff and gpgsigs: bsd-3, see
+   ;; http://packages.debian.org/changelogs/pool/main/s/signing-party/current/copyright
+   (license gpl2)
+   (home-page "http://pgp-tools.alioth.debian.org/")))
-- 
cgit v1.2.3


From 8c3c896dbebe022f5372dffaee9ad3f00c71180f 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 +
 gnu/packages/wdiff.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 62 insertions(+)
 create mode 100644 gnu/packages/wdiff.scm

(limited to 'gnu')

diff --git a/Makefile.am b/Makefile.am
index 3a84812ba6..e44753d596 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -152,6 +152,7 @@ MODULES =					\
   gnu/packages/time.scm				\
   gnu/packages/tmux.scm 			\
   gnu/packages/tor.scm				\
+  gnu/packages/wdiff.scm			\
   gnu/packages/wget.scm				\
   gnu/packages/which.scm			\
   gnu/packages/xml.scm				\
diff --git a/gnu/packages/wdiff.scm b/gnu/packages/wdiff.scm
new file mode 100644
index 0000000000..02d536c7de
--- /dev/null
+++ b/gnu/packages/wdiff.scm
@@ -0,0 +1,61 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Nikita Karetnikov <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 wdiff)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages screen)
+  #:use-module (gnu packages which))
+
+(define-public wdiff
+  (package
+    (name "wdiff")
+    (version "1.1.2")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://gnu/wdiff/wdiff-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "0q78y5awvjjmsvizqilbpwany62shlmlq2ayxkjbygmdafpk1k8j"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases (alist-cons-before
+                 'check 'fix-sh
+                 (lambda _
+                   (substitute* "tests/testsuite"
+                     (("#! /bin/sh")
+                      (string-append "#!" (which "sh")))))
+                 %standard-phases)))
+    (inputs `(("screen" ,screen)
+              ("which" ,which)))
+    (home-page "https://www.gnu.org/software/wdiff/")
+    (synopsis
+     "GNU Wdiff, a tool for comparing files on a word by word basis")
+    (description
+     "GNU Wdiff is a front end to 'diff' for comparing files on a word per
+word basis.  A word is anything between whitespace.  This is useful for
+comparing two texts in which a few words have been changed and for which
+paragraphs have been refilled.  It works by creating two temporary files, one
+word per line, and then executes 'diff' on these files.  It collects the
+'diff' output and uses it to produce a nicer display of word differences
+between the original files.")
+    (license gpl3+)))
\ No newline at end of file
-- 
cgit v1.2.3


From 250b0404d7bc6bb6b911d58585df41e876ee42de Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <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 'gnu')

diff --git a/Makefile.am b/Makefile.am
index e44753d596..7b0613d27b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -196,6 +196,7 @@ dist_patch_DATA =						\
   gnu/packages/patches/m4-readlink-EINVAL.patch			\
   gnu/packages/patches/m4-s_isdir.patch				\
   gnu/packages/patches/make-impure-dirs.patch			\
+  gnu/packages/patches/mcron-install.patch			\
   gnu/packages/patches/perl-no-sys-dirs.patch			\
   gnu/packages/patches/procps-make-3.82.patch			\
   gnu/packages/patches/readline-link-ncurses.patch		\
diff --git a/gnu/packages/patches/mcron-install.patch b/gnu/packages/patches/mcron-install.patch
new file mode 100644
index 0000000000..3cd291f576
--- /dev/null
+++ b/gnu/packages/patches/mcron-install.patch
@@ -0,0 +1,22 @@
+This patch allows us to install the Vixie-compatible binaries as
+non-root without creating /var/run, etc.
+
+--- mcron-1.0.6/makefile.in	2010-06-19 20:44:17.000000000 +0200
++++ mcron-1.0.6/makefile.in	2010-07-04 16:16:25.000000000 +0200
+@@ -1004,15 +1004,11 @@ mcron.c : main.scm crontab.scm makefile.
+ 	@rm -f mcron.escaped.scm > /dev/null 2>&1
+ 
+ install-exec-hook:
+-	@if [ "x@NO_VIXIE_CLOBBER@" != "xyes"   -a   "`id -u`" -eq "0" ]; then \
++	@if [ "x@NO_VIXIE_CLOBBER@" != "xyes" ]; then \
+        rm -f $(fpp)cron$(EXEEXT) > /dev/null 2>&1; \
+        $(INSTALL) --mode='u=rwx' mcron$(EXEEXT) $(fpp)cron$(EXEEXT); \
+        rm -f $(fpp)crontab$(EXEEXT) > /dev/null 2>&1; \
+        $(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT); \
+-       $(INSTALL) -d --mode='u=rwx' $(DESTDIR)/var/cron; \
+-       $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)/var/run; \
+-       $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@; \
+-       $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@/mcron; \
+     elif [ "x@NO_VIXIE_CLOBBER@" = "xyes" ]; then \
+        echo "Not installing Vixie-style programs"; \
+     else \
-- 
cgit v1.2.3


From e3b2cf4c7a28807a7225a80eda47dc5f5f7efa70 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Feb 2013 21:42:34 +0100
Subject: gnu: guile-static: Use libgc build with `USE_LIBC_PRIVATES'.

* gnu/packages/make-bootstrap.scm (%guile-static): Use libgc build with
  CPPFLAGS=-DUSE_LIBC_PRIVATES.
* gnu/packages/bdw-gc.scm (libgc): Add TODO to always do it.
---
 gnu/packages/bdw-gc.scm         |  1 +
 gnu/packages/make-bootstrap.scm | 87 +++++++++++++++++++++++------------------
 2 files changed, 50 insertions(+), 38 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/bdw-gc.scm b/gnu/packages/bdw-gc.scm
index 98526512f8..c338eab871 100644
--- a/gnu/packages/bdw-gc.scm
+++ b/gnu/packages/bdw-gc.scm
@@ -35,6 +35,7 @@ (define-public libgc
              (base32
               "05jwadjbrv8pr7z9cb4miskicxqpxm0pca4h2rg5cgbpajr2bx7b"))))
    (build-system gnu-build-system)
+   ;; TODO: Build with -DUSE_LIBC_PRIVATES (see make-bootstrap.scm).
    (synopsis "The Boehm-Demers-Weiser conservative garbage collector
 for C and C++")
    (description
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 8275344b6c..9e9ba939da 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -28,6 +28,7 @@ (define-module (gnu packages make-bootstrap)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages bdw-gc)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages multiprecision)
   #:use-module (ice-9 match)
@@ -399,44 +400,54 @@ (define %guile-static
   ;; A statically-linked Guile that is relocatable--i.e., it can search
   ;; .scm and .go files relative to its installation directory, rather
   ;; than in hard-coded configure-time paths.
-  (let ((guile (package (inherit guile-2.0)
-                 (inputs
-                  `(("patch/relocatable"
-                     ,(search-patch "guile-relocatable.patch"))
-                    ("patch/utf8"
-                     ,(search-patch "guile-default-utf8.patch"))
-                    ,@(package-inputs guile-2.0)))
-                 (arguments
-                  `(;; When `configure' checks for ltdl availability, it
-                    ;; doesn't try to link using libtool, and thus fails
-                    ;; because of a missing -ldl.  Work around that.
-                    #:configure-flags '("LDFLAGS=-ldl")
-
-                    #:phases (alist-cons-before
-                              'configure 'static-guile
-                              (lambda _
-                                (substitute* "libguile/Makefile.in"
-                                  ;; Create a statically-linked `guile'
-                                  ;; executable.
-                                  (("^guile_LDFLAGS =")
-                                   "guile_LDFLAGS = -all-static")
-
-                                  ;; Add `-ldl' *after* libguile-2.0.la.
-                                  (("^guile_LDADD =(.*)$" _ ldadd)
-                                   (string-append "guile_LDADD = "
-                                                  (string-trim-right ldadd)
-                                                  " -ldl\n"))))
-                              %standard-phases)
-
-                    ;; Allow Guile to be relocated, as is needed during
-                    ;; bootstrap.
-                    #:patches
-                    (list (assoc-ref %build-inputs "patch/relocatable")
-                          (assoc-ref %build-inputs "patch/utf8"))
-
-                    ;; There are uses of `dynamic-link' in
-                    ;; {foreign,coverage}.test that don't fly here.
-                    #:tests? #f)))))
+  (let* ((libgc (package (inherit libgc)
+                  (arguments
+                   ;; Make it so that we don't rely on /proc.  This is
+                   ;; especially useful in an initrd run before /proc is
+                   ;; mounted.
+                   '(#:configure-flags '("CPPFLAGS=-DUSE_LIBC_PRIVATES")))))
+         (guile (package (inherit guile-2.0)
+                  (inputs
+                   `(("patch/relocatable"
+                      ,(search-patch "guile-relocatable.patch"))
+                     ("patch/utf8"
+                      ,(search-patch "guile-default-utf8.patch"))
+                     ,@(package-inputs guile-2.0)))
+                  (propagated-inputs
+                   `(("bdw-gc" ,libgc)
+                     ,@(alist-delete "bdw-gc"
+                                     (package-propagated-inputs guile-2.0))))
+                  (arguments
+                   `(;; When `configure' checks for ltdl availability, it
+                     ;; doesn't try to link using libtool, and thus fails
+                     ;; because of a missing -ldl.  Work around that.
+                     #:configure-flags '("LDFLAGS=-ldl")
+
+                     #:phases (alist-cons-before
+                               'configure 'static-guile
+                               (lambda _
+                                 (substitute* "libguile/Makefile.in"
+                                   ;; Create a statically-linked `guile'
+                                   ;; executable.
+                                   (("^guile_LDFLAGS =")
+                                    "guile_LDFLAGS = -all-static")
+
+                                   ;; Add `-ldl' *after* libguile-2.0.la.
+                                   (("^guile_LDADD =(.*)$" _ ldadd)
+                                    (string-append "guile_LDADD = "
+                                                   (string-trim-right ldadd)
+                                                   " -ldl\n"))))
+                               %standard-phases)
+
+                     ;; Allow Guile to be relocated, as is needed during
+                     ;; bootstrap.
+                     #:patches
+                     (list (assoc-ref %build-inputs "patch/relocatable")
+                           (assoc-ref %build-inputs "patch/utf8"))
+
+                     ;; There are uses of `dynamic-link' in
+                     ;; {foreign,coverage}.test that don't fly here.
+                     #:tests? #f)))))
     (package-with-explicit-inputs (static-package guile)
                                   %standard-inputs-with-relocatable-glibc
                                   (current-source-location))))
-- 
cgit v1.2.3


From c2868b1e0c4155fbeffac9860d69a1ed6041156a Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 12 Feb 2013 20:29:30 -0500
Subject: Inhibit duplicates in fold-packages.

* gnu/packages.scm (fold2): New procedure.
  (fold-packages): Rework to suppress duplicates.
---
 gnu/packages.scm | 40 ++++++++++++++++++++++++++++------------
 1 file changed, 28 insertions(+), 12 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 792fe44efa..f2f98de476 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@ (define-module (gnu packages)
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -106,20 +108,34 @@ (define not-slash
                   (false-if-exception (resolve-interface name))))
               (package-files)))
 
+(define (fold2 f seed1 seed2 lst)
+  (if (null? lst)
+      (values seed1 seed2)
+      (call-with-values
+          (lambda () (f (car lst) seed1 seed2))
+        (lambda (seed1 seed2)
+          (fold2 f seed1 seed2 (cdr lst))))))
+
 (define (fold-packages proc init)
   "Call (PROC PACKAGE RESULT) for each available package, using INIT as
-the initial value of RESULT."
-  (fold (lambda (module result)
-          (fold (lambda (var result)
-                  (if (package? var)
-                      (proc var result)
-                      result))
-                result
-                (module-map (lambda (sym var)
-                              (false-if-exception (variable-ref var)))
-                            module)))
-        init
-        (package-modules)))
+the initial value of RESULT.  It is guaranteed to never traverse the
+same package twice."
+  (identity   ; discard second return value
+   (fold2 (lambda (module result seen)
+            (fold2 (lambda (var result seen)
+                     (if (and (package? var)
+                              (not (vhash-assq var seen)))
+                         (values (proc var result)
+                                 (vhash-consq var #t seen))
+                         (values result seen)))
+                   result
+                   seen
+                   (module-map (lambda (sym var)
+                                 (false-if-exception (variable-ref var)))
+                               module)))
+          init
+          vlist-null
+          (package-modules))))
 
 (define* (find-packages-by-name name #:optional version)
   "Return the list of packages with the given NAME.  If VERSION is not #f,
-- 
cgit v1.2.3


From dc5669cd654019994fa59ab26db59c292332ae55 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 12 Feb 2013 01:24:21 -0500
Subject: Build newest versions unless specified, and implement upgrades.

* gnu/packages.scm (find-newest-available-packages):
  New exported procedure.

* guix-build.in (newest-available-packages, find-best-packages-by-name):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.

* guix-package.in (%options): Add --upgrade/-u option.
  (newest-available-packages, find-best-packages-by-name, upgradeable?):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.
  (process-actions): Implement upgrade option.

* doc/guix.texi (Invoking guix-package): In the description of --install,
  mention that if no version number is specified, the newest available
  version will be selected.
---
 doc/guix.texi    |  7 +++---
 gnu/packages.scm | 26 +++++++++++++++++++-
 guix-build.in    | 20 +++++++++++++---
 guix-package.in  | 73 ++++++++++++++++++++++++++++++++++++++++++++++----------
 4 files changed, 106 insertions(+), 20 deletions(-)

(limited to 'gnu')

diff --git a/doc/guix.texi b/doc/guix.texi
index 9cb1431bf1..80149326c1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -491,9 +491,10 @@ Install @var{package}.
 
 @var{package} may specify either a simple package name, such as
 @code{guile}, or a package name followed by a hyphen and version number,
-such as @code{guile-1.8.8}.  In addition, @var{package} may contain a
-colon, followed by the name of one of the outputs of the package, as in
-@code{gcc:doc} or @code{binutils-2.22:lib}.
+such as @code{guile-1.8.8}.  If no version number is specified, the
+newest available version will be selected.  In addition, @var{package}
+may contain a colon, followed by the name of one of the outputs of the
+package, as in @code{gcc:doc} or @code{binutils-2.22:lib}.
 
 @cindex propagated inputs
 Sometimes packages have @dfn{propagated inputs}: these are dependencies
diff --git a/gnu/packages.scm b/gnu/packages.scm
index f2f98de476..b639541788 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -22,6 +22,7 @@ (define-module (gnu packages)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -30,7 +31,8 @@ (define-module (gnu packages)
             %patch-directory
             %bootstrap-binaries-path
             fold-packages
-            find-packages-by-name))
+            find-packages-by-name
+            find-newest-available-packages))
 
 ;;; Commentary:
 ;;;
@@ -153,3 +155,25 @@ (define right-package?
                        (cons package result)
                        result))
                  '()))
+
+(define (find-newest-available-packages)
+  "Return a vhash keyed by package names, and with
+associated values of the form
+
+  (newest-version newest-package ...)
+
+where the preferred package is listed first."
+
+  ;; FIXME: Currently, the preferred package is whichever one
+  ;; was found last by 'fold-packages'.  Find a better solution.
+  (fold-packages (lambda (p r)
+                   (let ((name    (package-name p))
+                         (version (package-version p)))
+                     (match (vhash-assoc name r)
+                       ((_ newest-so-far . pkgs)
+                        (case (version-compare version newest-so-far)
+                          ((>) (vhash-cons name `(,version ,p) r))
+                          ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+                          ((<) r)))
+                       (#f (vhash-cons name `(,version ,p) r)))))
+                 vlist-null))
diff --git a/guix-build.in b/guix-build.in
index f8c7115999..35ddb00861 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -13,6 +13,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
 !#
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,12 +38,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:use-module (guix utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
-  #:autoload   (gnu packages) (find-packages-by-name)
+  #:autoload   (gnu packages) (find-packages-by-name
+                               find-newest-available-packages)
   #:export (guix-build))
 
 (define %store
@@ -196,13 +199,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                  root (strerror (system-error-errno args)))
          (exit 1)))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package request)
     ;; Return a package matching REQUEST.  REQUEST may be a package
     ;; name, or a package name followed by a hyphen and a version
-    ;; number.
+    ;; number.  If the version number is not present, return the
+    ;; preferred newest version.
     (let-values (((name version)
                   (package-name->name+version request)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)                                      ; one match
          p)
         ((p x ...)                                ; several matches
diff --git a/guix-package.in b/guix-package.in
index ae3d2cd70e..584481acd5 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -14,6 +14,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <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.
 ;;;
@@ -42,6 +43,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -346,6 +348,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
+        (option '(#\u "upgrade") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'upgrade arg result)))
         (option '("roll-back") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'roll-back? #t result)))
@@ -421,9 +426,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                       (length req*))
                   (null? req*) req*))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package name)
     ;; Find the package NAME; NAME may contain a version number and a
-    ;; sub-derivation name.
+    ;; sub-derivation name.  If the version number is not present,
+    ;; return the preferred newest version.
     (define request name)
 
     (define (ensure-output p sub-drv)
@@ -441,7 +457,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                     (substring name (+ 1 colon))))))
                   ((name version)
                    (package-name->name+version name)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)
          (list name (package-version p) sub-drv (ensure-output p sub-drv)
                (package-transitive-propagated-inputs p)))
@@ -458,6 +474,21 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
+  (define (upgradeable? name current-version current-path)
+    ;; Return #t if there's a version of package NAME newer than
+    ;; CURRENT-VERSION, or if the newest available version is equal to
+    ;; CURRENT-VERSION but would have an output path different than
+    ;; CURRENT-PATH.
+    (match (vhash-assoc name (newest-available-packages))
+      ((_ candidate-version pkg . rest)
+       (case (version-compare candidate-version current-version)
+         ((>) #t)
+         ((<) #f)
+         ((=) (let ((candidate-path (derivation-path->output-path
+                                     (package-derivation (%store) pkg))))
+                (not (string=? current-path candidate-path))))))
+      (#f #f)))
+
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist.
 
@@ -510,13 +541,32 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (begin
           (roll-back profile)
           (process-actions (alist-delete 'roll-back? opts)))
-        (let* ((install  (filter-map (match-lambda
-                                      (('install . (? store-path?))
-                                       #f)
-                                      (('install . package)
-                                       (find-package package))
-                                      (_ #f))
-                                     opts))
+        (let* ((installed (manifest-packages (profile-manifest profile)))
+               (upgrade-regexps (filter-map (match-lambda
+                                             (('upgrade . regexp)
+                                              (make-regexp regexp))
+                                             (_ #f))
+                                            opts))
+               (upgrade  (if (null? upgrade-regexps)
+                             '()
+                             (let ((newest (find-newest-available-packages)))
+                               (filter-map (match-lambda
+                                            ((name version output path _)
+                                             (and (any (cut regexp-exec <> name)
+                                                       upgrade-regexps)
+                                                  (upgradeable? name version path)
+                                                  (find-package name)))
+                                            (_ #f))
+                                           installed))))
+               (install  (append
+                          upgrade
+                          (filter-map (match-lambda
+                                       (('install . (? store-path?))
+                                        #f)
+                                       (('install . package)
+                                        (find-package package))
+                                       (_ #f))
+                                      opts)))
                (drv      (filter-map (match-lambda
                                       ((name version sub-drv
                                              (? package? package)
@@ -553,10 +603,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                          (match package
                                            ((name _ ...)
                                             (alist-delete name result))))
-                                       (fold alist-delete
-                                             (manifest-packages
-                                              (profile-manifest profile))
-                                             remove)
+                                       (fold alist-delete installed remove)
                                        install*))))
 
           (when (equal? profile %current-profile)
-- 
cgit v1.2.3


From eb4908581cae8b787c63b39fa524adf764ae8c25 Mon Sep 17 00:00:00 2001
From: Cyril Roelandt <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 'gnu')

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 1dee732b81660ad2f6b4831c7e53c61e5ca32a0f Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 15 Feb 2013 00:26:52 +0100
Subject: gnu: linux-libre: Choose a config without debugging features.

* gnu/packages/linux.scm (linux-libre): Choose "defconfig" instead of
  "allmodconfig" since the latter enables all debugging features.  Add
  `CONFIG_CIFS=m'.
---
 gnu/packages/linux.scm | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

(limited to 'gnu')

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index f3e7d18627..b97315580b 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -133,7 +133,13 @@ (define-public linux-libre
                (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))
 
              (let ((build (assoc-ref %standard-phases 'build)))
-               (and (zero? (system* "make" "allmodconfig"))
+               (and (zero? (system* "make" "defconfig"))
+                    (begin
+                      (format #t "enabling additional modules...~%")
+                      (substitute* ".config"
+                        (("^# CONFIG_CIFS.*$")
+                         "CONFIG_CIFS=m\n"))
+                      (zero? (system* "make" "oldconfig")))
 
                     ;; Call the default `build' phase so `-j' is correctly
                     ;; passed.
-- 
cgit v1.2.3


From 6956067b04269ecf666b3b4b1e63ce00bc1944c8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <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 'gnu')

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 @@ (define %guile-static
                       ,(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 @@ (define %guile-static
                      ;; 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 e04f30e02307fb7660e3fb36ada8d5bcd53977f1 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 'gnu')

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 3665b4dc60cd1f7867c179806427c792f99dbf2b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 15 Feb 2013 22:04:51 +0100
Subject: gnu: samba: Augment the RUNPATH of executables to point to $out/lib.

* gnu/packages/samba.scm (samba): Add `add-lib-to-runpath' phase, and
  PatchELF as an input.
---
 gnu/packages/samba.scm | 47 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 42 insertions(+), 5 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm
index d414c285f8..93c9f70a50 100644
--- a/gnu/packages/samba.scm
+++ b/gnu/packages/samba.scm
@@ -27,6 +27,7 @@ (define-module (gnu packages samba)
   #:use-module (gnu packages readline)
   #:use-module (gnu packages libunwind)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages patchelf)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages python))
 
@@ -103,10 +104,45 @@ (define-public samba
                "1phl6mmrc72jyvbyrw6cv6b92cxq3v2pbn1fh97nnb4hild1fnjg"))))
     (build-system gnu-build-system)
     (arguments
-     '(#:phases (alist-cons-before 'configure 'chdir
-                                   (lambda _
-                                     (chdir "source3"))
-                                   %standard-phases)
+     '(#:phases (alist-cons-before
+                 'configure 'chdir
+                 (lambda _
+                   (chdir "source3"))
+                 (alist-cons-after
+                  'strip 'add-lib-to-runpath
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    (define (file-rpath file)
+                      ;; Return the RPATH of FILE.
+                      (let* ((p (open-pipe* OPEN_READ "patchelf"
+                                            "--print-rpath" file))
+                             (l (read-line p)))
+                        (and (zero? (close-pipe p)) l)))
+
+                    (define (augment-rpath file dir)
+                      ;; Add DIR to the RPATH of FILE.
+                      (let* ((rpath  (file-rpath file))
+                             (rpath* (if rpath
+                                         (string-append dir ":" rpath)
+                                         dir)))
+                        (format #t "~a: changing RPATH from `~a' to `~a'~%"
+                                file (or rpath "") rpath*)
+                        (zero? (system* "patchelf" "--set-rpath"
+                                        rpath* file))))
+
+                    (let* ((out (assoc-ref outputs "out"))
+                           (lib (string-append out "/lib")))
+                      ;; Add LIB to the RUNPATH of all the executables.
+                      (with-directory-excursion out
+                        (for-each (cut augment-rpath <> lib)
+                                  (append (find-files "bin" ".*")
+                                          (find-files "sbin" ".*"))))))
+                  %standard-phases))
+
+       #:modules ((guix build gnu-build-system)
+                  (guix build utils)
+                  (ice-9 popen)
+                  (ice-9 rdelim)
+                  (srfi srfi-26))
 
        ;; This flag is required to allow for "make test".
        #:configure-flags '("--enable-socket-wrapper")
@@ -126,7 +162,8 @@ (define-public samba
        ("popt" ,popt)
        ("openldap" ,openldap)
        ("linux-pam" ,linux-pam)
-       ("readline" ,readline)))
+       ("readline" ,readline)
+       ("patchelf" ,patchelf)))
     (native-inputs                                ; for the test suite
      `(("perl" ,perl)
        ("python" ,python)))
-- 
cgit v1.2.3


From ffb1ee524d076d32596bbf2ff90212ca12cae83a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 15 Feb 2013 22:36:05 +0100
Subject: gnu: qemu: Add dependency on Samba.

* gnu/packages/qemu.scm (qemu-kvm): Add dependency on Samba; pass
  `--smbd' to ./configure.
---
 gnu/packages/qemu.scm | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm
index e6859aadf0..785d470079 100644
--- a/gnu/packages/qemu.scm
+++ b/gnu/packages/qemu.scm
@@ -32,6 +32,7 @@ (define-module (gnu packages qemu)
   #:use-module (gnu packages libjpeg)
   #:use-module (gnu packages attr)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages samba)
   #:use-module (gnu packages perl))
 
 (define-public qemu-kvm
@@ -52,14 +53,17 @@ (define-public qemu-kvm
                  (lambda* (#:key inputs outputs #:allow-other-keys)
                    ;; The `configure' script doesn't understand some of the
                    ;; GNU options.  Thus, add a new phase that's compatible.
-                   (let ((out (assoc-ref outputs "out")))
+                   (let ((out   (assoc-ref outputs "out"))
+                         (samba (assoc-ref inputs "samba")))
                      (setenv "SHELL" (which "bash"))
 
                      ;; The binaries need to be linked against -lrt.
                      (setenv "LDFLAGS" "-lrt")
                      (zero?
                       (system* "./configure"
-                               (string-append "--prefix=" out)))))
+                               (string-append "--prefix=" out)
+                               (string-append "--smbd=" samba
+                                              "/sbin/smbd")))))
                  %standard-phases)))
     (inputs                                       ; TODO: Add optional inputs.
      `(;; ("mesa" ,mesa)
@@ -76,7 +80,8 @@ (define-public qemu-kvm
        ;; ("alsa-lib" ,alsa-lib)
        ;; ("SDL" ,SDL)
        ("zlib" ,zlib)
-       ("attr" ,attr)))
+       ("attr" ,attr)
+       ("samba" ,samba)))                         ; an optional dependency
     (home-page "http://www.linux-kvm.org/")
     (synopsis
      "Virtualization for Linux on x86 hardware containing virtualization extensions")
-- 
cgit v1.2.3


From 36439572609d38c4d8e7d380d3ac9c39e36f5bf8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 16 Feb 2013 00:29:43 +0100
Subject: gnu: guile-static: Add bindings for `reboot'.

* gnu/packages/patches/guile-linux-syscalls.patch: Add `scm_reboot'.
---
 gnu/packages/patches/guile-linux-syscalls.patch | 46 +++++++++++++++++++++++--
 1 file changed, 44 insertions(+), 2 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/patches/guile-linux-syscalls.patch b/gnu/packages/patches/guile-linux-syscalls.patch
index c0cb0f6d70..1fb24bde27 100644
--- a/gnu/packages/patches/guile-linux-syscalls.patch
+++ b/gnu/packages/patches/guile-linux-syscalls.patch
@@ -1,10 +1,13 @@
 This patch adds bindings to Linux syscalls for which glibc has symbols.
 
+Using the FFI would have been nice, but that's not an option when using
+a statically-linked Guile in an initrd that doesn't have libc.so around.
+
 diff --git a/libguile/posix.c b/libguile/posix.c
-index 324f21b..ace5211 100644
+index 324f21b..cbee94d 100644
 --- a/libguile/posix.c
 +++ b/libguile/posix.c
-@@ -2286,6 +2286,227 @@ scm_init_popen (void)
+@@ -2286,6 +2286,266 @@ scm_init_popen (void)
  }
  #endif
  
@@ -92,6 +95,45 @@ index 324f21b..ace5211 100644
 +}
 +#undef FUNC_NAME
 +
++/* Rebooting, halting, and all that.  */
++
++#include <sys/reboot.h>
++
++SCM_VARIABLE_INIT (flag_RB_AUTOBOOT, "RB_AUTOBOOT",
++		   scm_from_int (RB_AUTOBOOT));
++SCM_VARIABLE_INIT (flag_RB_HALT_SYSTEM, "RB_HALT_SYSTEM",
++		   scm_from_int (RB_HALT_SYSTEM));
++SCM_VARIABLE_INIT (flag_RB_ENABLE_CAD, "RB_ENABLE_CAD",
++		   scm_from_int (RB_ENABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_DISABLE_CAD, "RB_DISABLE_CAD",
++		   scm_from_int (RB_DISABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_POWER_OFF, "RB_POWER_OFF",
++		   scm_from_int (RB_POWER_OFF));
++SCM_VARIABLE_INIT (flag_RB_SW_SUSPEND, "RB_SW_SUSPEND",
++		   scm_from_int (RB_SW_SUSPEND));
++SCM_VARIABLE_INIT (flag_RB_KEXEC, "RB_KEXEC",
++		   scm_from_int (RB_KEXEC));
++
++SCM_DEFINE (scm_reboot, "reboot", 0, 1, 0,
++	    (SCM command),
++	    "Reboot the system.  @var{command} must be one of the @code{RB_} "
++	    "constants; if omitted, @var{RB_AUTOBOOT} is used, thus "
++	    "performing a hard reset.")
++#define FUNC_NAME s_scm_reboot
++{
++  int c_command;
++
++  if (SCM_UNBNDP (command))
++    c_command = RB_AUTOBOOT;
++  else
++    c_command = scm_to_int (command);
++
++  reboot (c_command);
++
++  return SCM_UNSPECIFIED;			  /* likely unreached */
++}
++#undef FUNC_NAME
++
 +/* Linux network interfaces.  See <linux/if.h>.  */
 +
 +#include <linux/if.h>
-- 
cgit v1.2.3


From 0228826262b2fd01371cdaf78cfe22371b18f2d7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 16 Feb 2013 00:30:25 +0100
Subject: gnu: guile-static: Change `name' field.

* gnu/packages/make-bootstrap.scm (%guile-static): Add `name' field with
  `-static' suffix.
---
 gnu/packages/make-bootstrap.scm | 1 +
 1 file changed, 1 insertion(+)

(limited to 'gnu')

diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 218f5a8e25..3bb926bd36 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -407,6 +407,7 @@ (define %guile-static
                    ;; mounted.
                    '(#:configure-flags '("CPPFLAGS=-DUSE_LIBC_PRIVATES")))))
          (guile (package (inherit guile-2.0)
+                  (name (string-append (package-name guile-2.0) "-static"))
                   (inputs
                    `(("patch/relocatable"
                       ,(search-patch "guile-relocatable.patch"))
-- 
cgit v1.2.3


From 161ed5476d27a69bbb940fd4a76f67976bd1d91e 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 'gnu')

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 @@ (define-module (gnu packages qemu)
   #: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 @@ (define-public qemu-kvm
     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
     (license gpl2)))
 
+(define-public qemu-kvm/smb-shares
+  ;; A patched QEMU-KVM where `-net smb' yields two shares instead of one: one
+  ;; for the store, and another one for exchanges with the host.
+  (package (inherit qemu-kvm)
+    (name "qemu-kvm-with-multiple-smb-shares")
+    (inputs `(,@(package-inputs qemu-kvm)
+              ("patch/smb-shares"
+               ,(search-patch "qemu-multiple-smb-shares.patch"))))
+    (arguments
+     `(#:patches (list (assoc-ref %build-inputs "patch/smb-shares"))
+       ,@(package-arguments qemu-kvm)))))
+
 (define-public qemu
   ;; The real one, with a complete target list.
   (package (inherit qemu-kvm)
-- 
cgit v1.2.3


From f09d925b1632d5a8dd0999651dab6424847deeea Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <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 'gnu')

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 040860152e63bbafb2eb3e93619e18d107c96b55 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 'gnu')

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 a24b75d8e1753da629ecf945f4022eee4c340aed Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 17 Feb 2013 15:01:52 +0100
Subject: gnu: texinfo: Update to 5.0.

* gnu/packages/texinfo.scm (texinfo): Update to 5.0.
---
 gnu/packages/texinfo.scm | 32 +++++++++++++++-----------------
 1 file changed, 15 insertions(+), 17 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm
index 9a264c627c..dba5cd2c2e 100644
--- a/gnu/packages/texinfo.scm
+++ b/gnu/packages/texinfo.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,28 +22,26 @@ (define-module (gnu packages texinfo)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages perl)
   #:use-module (gnu packages ncurses))
 
 (define-public texinfo
   (package
     (name "texinfo")
-    (version "4.13a")
-    (source
-     (origin
-      (method url-fetch)
-      (uri (string-append
-            "mirror://gnu/texinfo/texinfo-"
-            version
-            ".tar.lzma"))
-      (sha256
-       (base32
-        "1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d"))))
+    (version "5.0")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/texinfo/texinfo-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "1p34f68h9ggfj6ckgj0p62qlj7pmz3ha3vc91kh4hr44pnwm1pla"))))
     (build-system gnu-build-system)
-    (inputs `(("ncurses" ,ncurses) ("xz" ,xz)))
-    (home-page
-     "http://www.gnu.org/software/texinfo/")
-    (synopsis
-     "GNU Texinfo, the GNU documentation system")
+    (inputs `(("perl" ,perl)                      ; yuck!
+              ("ncurses" ,ncurses)
+              ("xz" ,xz)))
+    (home-page "http://www.gnu.org/software/texinfo/")
+    (synopsis "GNU Texinfo, the GNU documentation system")
     (description
      "Texinfo is the official documentation format of the GNU project.
 It was invented by Richard Stallman and Bob Chassell many years
-- 
cgit v1.2.3


From fd80c705b1768f4b716561c38e77af01e73377b7 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 17 Feb 2013 13:25:06 -0500
Subject: gnu: guile-reader: Rename packages to avoid version number confusion.

* gnu/packages/guile.scm (guile-reader): Change the character preceding the
  guile version number from '-' to '_' so that it will not be misinterpreted
  as the package version number.
---
 gnu/packages/guile.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gnu')

diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 729a921346..58e7c2910c 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -162,7 +162,7 @@ (define (guile-reader guile)
   "Build Guile-Reader against GUILE, a package of some version of Guile 1.8
 or 2.0."
   (package
-   (name (string-append "guile-reader-for-guile-" (package-version guile)))
+   (name (string-append "guile-reader-for-guile_" (package-version guile)))
    (version "0.6")
    (source  (origin
              (method url-fetch)
-- 
cgit v1.2.3


From f6d7be1e47961d78b7b94f9368bae3a716f73b74 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 20 Feb 2013 21:06:57 +0100
Subject: gnu: texinfo: Make Perl a propagated input.

* gnu/packages/texinfo.scm (texinfo): Make PERL a propagated input.
---
 gnu/packages/texinfo.scm | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm
index dba5cd2c2e..96016c053d 100644
--- a/gnu/packages/texinfo.scm
+++ b/gnu/packages/texinfo.scm
@@ -37,9 +37,10 @@ (define-public texinfo
               (base32
                "1p34f68h9ggfj6ckgj0p62qlj7pmz3ha3vc91kh4hr44pnwm1pla"))))
     (build-system gnu-build-system)
-    (inputs `(("perl" ,perl)                      ; yuck!
-              ("ncurses" ,ncurses)
+    (inputs `(("ncurses" ,ncurses)
               ("xz" ,xz)))
+    ;; TODO: Remove Perl from here when 'patch-shebang' DTRT with /usr/bin/env.
+    (propagated-inputs `(("perl" ,perl)))         ; yuck!
     (home-page "http://www.gnu.org/software/texinfo/")
     (synopsis "GNU Texinfo, the GNU documentation system")
     (description
-- 
cgit v1.2.3


From c9b940cd03423a0b6ad826b5d6e735c3e9c11630 Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Sat, 23 Feb 2013 16:30:03 +0100
Subject: gnu: Update libpng to 1.5.14.

* gnu/packages/libpng.scm (libpng): Switch to version 1.5.14.
---
 gnu/packages/libpng.scm | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/libpng.scm b/gnu/packages/libpng.scm
index d351ddcbf7..06facc9a9a 100644
--- a/gnu/packages/libpng.scm
+++ b/gnu/packages/libpng.scm
@@ -27,15 +27,15 @@ (define-module (gnu packages libpng)
 (define-public libpng
   (package
    (name "libpng")
-   (version "1.5.13")
+   (version "1.5.14")
    (source (origin
             (method url-fetch)
             (uri (string-append
                    "http://downloads.sourceforge.net/project/libpng/libpng15/"
                    version "/libpng-"
-                   version ".tar.gz"))
+                   version ".tar.xz"))
             (sha256 (base32
-                     "0dbh332qjhm3pa8m4ac73rk7dbbmigbqd3ch084m24ggg9qq4k0d"))))
+                     "0m3vz3gig7s63zanq5b1dgb5ph12qm0cylw4g4fbxlsq3f74hn8l"))))
    (build-system gnu-build-system)
    (inputs `(("zlib" ,zlib)))
    (synopsis "Libpng, a library for handling PNG files")
-- 
cgit v1.2.3


From abc00dc492efc9309aa721b63cb2f2883dbba3c6 Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Sat, 23 Feb 2013 18:39:49 +0100
Subject: gnu: screen: Use GNU mirror.

* gnu/packages/screen.scm (screen): Use GNU mirror.
---
 gnu/packages/screen.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gnu')

diff --git a/gnu/packages/screen.scm b/gnu/packages/screen.scm
index 608e63c7c6..ea1c21716a 100644
--- a/gnu/packages/screen.scm
+++ b/gnu/packages/screen.scm
@@ -31,7 +31,7 @@ (define-public screen
     (version "4.0.3")
     (source (origin
              (method url-fetch)
-             (uri (string-append "http://ftp.gnu.org/gnu/screen/screen-"
+             (uri (string-append "mirror://gnu/screen/screen-"
                                  version ".tar.gz"))
              (sha256
               (base32 "0xvckv1ia5pjxk7fs4za6gz2njwmfd54sc464n8ab13096qxbw3q"))))
-- 
cgit v1.2.3


From 431a35518f74f50238ccc106a6a3121a9fcc11b9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 1 Mar 2013 18:34:33 +0100
Subject: gnu: global: Update to 6.2.8.

* gnu/packages/global.scm (global): Update to 6.2.8.
---
 gnu/packages/global.scm | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

(limited to 'gnu')

diff --git a/gnu/packages/global.scm b/gnu/packages/global.scm
index b604ab6478..6ef36d5aea 100644
--- a/gnu/packages/global.scm
+++ b/gnu/packages/global.scm
@@ -28,15 +28,14 @@ (define-module (gnu packages global)
 (define-public global                             ; a global variable
   (package
     (name "global")
-    (version "6.2.7")
-    (source
-     (origin
-      (method url-fetch)
-      (uri (string-append "mirror://gnu/global/global-"
-                          version ".tar.gz"))
-      (sha256
-       (base32
-        "1dr250kz65wqpbms4lhz857mzmvmpmiaxgyqxvxkb4b0s840i14i"))))
+    (version "6.2.8")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/global/global-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32
+               "1l6g51kff5010gwmw08jbks1mssgddz7wggjvfsky3g000jkpvf1"))))
     (build-system gnu-build-system)
     (inputs `(("ncurses" ,ncurses)
               ("libtool" ,libtool)))
-- 
cgit v1.2.3


From 4cdbdd4439d493659af60608c37704545b376600 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 2 Mar 2013 17:00:33 +0100
Subject: gnu: Add libdaemon.

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

(limited to 'gnu')

diff --git a/Makefile.am b/Makefile.am
index bed4d06ec0..9018479a47 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -98,6 +98,7 @@ MODULES =					\
   gnu/packages/ld-wrapper.scm			\
   gnu/packages/less.scm				\
   gnu/packages/libapr.scm 			\
+  gnu/packages/libdaemon.scm			\
   gnu/packages/libevent.scm			\
   gnu/packages/libffi.scm			\
   gnu/packages/libidn.scm			\
diff --git a/gnu/packages/libdaemon.scm b/gnu/packages/libdaemon.scm
new file mode 100644
index 0000000000..0c77e280ac
--- /dev/null
+++ b/gnu/packages/libdaemon.scm
@@ -0,0 +1,61 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages libdaemon)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu))
+
+(define-public libdaemon
+  (package
+    (name "libdaemon")
+    (version "0.14")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append
+                   "http://0pointer.de/lennart/projects/libdaemon/libdaemon-"
+                   version
+                   ".tar.gz"))
+             (sha256
+              (base32
+               "0d5qlq5ab95wh1xc87rqrh1vx6i8lddka1w3f1zcqvcqdxgyn8zx"))))
+    (build-system gnu-build-system)
+    (home-page "http://0pointer.de/lennart/projects/libdaemon/")
+    (synopsis "Lightweight C library that eases the writing of UNIX daemons")
+    (description
+     "libdaemon is a lightweight C library that eases the writing of UNIX
+daemons. It consists of the following parts:
+
+  • A wrapper around fork() which does the correct daemonization procedure of
+    a process
+
+  • A wrapper around syslog() for simpler and compatible log output to Syslog
+    or STDERR
+
+  • An API for writing PID files
+
+  • An API for serializing UNIX signals into a pipe for usage with select() or
+    poll()
+
+  • An API for running subprocesses with STDOUT and STDERR redirected to
+    syslog.
+
+APIs like these are used in most daemon software available. It is not that
+simple to get it done right and code duplication is not a goal.")
+    (license lgpl2.1+)))
-- 
cgit v1.2.3


From 49f24f41e33d8ee1c6d8e5a92d388c3aebc3b81a Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Sun, 3 Mar 2013 14:10:57 +0100
Subject: gnu: Add vpnc.

* gnu/packages/vpn.scm: New file.
* Makefile.am (MODULES): Add it.
* gnu/packages/patches/vpnc-script.patch: New file.
* Makefile.am (dist_patch_DATA): Add it.
---
 Makefile.am                            |  4 ++-
 gnu/packages/patches/vpnc-script.patch | 15 ++++++++
 gnu/packages/vpn.scm                   | 66 ++++++++++++++++++++++++++++++++++
 3 files changed, 84 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/vpnc-script.patch
 create mode 100644 gnu/packages/vpn.scm

(limited to 'gnu')

diff --git a/Makefile.am b/Makefile.am
index 9018479a47..b70349adc0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -158,6 +158,7 @@ MODULES =					\
   gnu/packages/tmux.scm 			\
   gnu/packages/tor.scm				\
   gnu/packages/vim.scm 				\
+  gnu/packages/vpn.scm				\
   gnu/packages/wdiff.scm			\
   gnu/packages/wget.scm				\
   gnu/packages/which.scm			\
@@ -215,7 +216,8 @@ dist_patch_DATA =						\
   gnu/packages/patches/shishi-gets-undeclared.patch		\
   gnu/packages/patches/tar-gets-undeclared.patch		\
   gnu/packages/patches/tcsh-fix-autotest.patch 			\
-  gnu/packages/patches/teckit-cstdio.patch
+  gnu/packages/patches/teckit-cstdio.patch			\
+  gnu/packages/patches/vpnc-script.patch
 
 bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap
 bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux
diff --git a/gnu/packages/patches/vpnc-script.patch b/gnu/packages/patches/vpnc-script.patch
new file mode 100644
index 0000000000..a0d9481952
--- /dev/null
+++ b/gnu/packages/patches/vpnc-script.patch
@@ -0,0 +1,15 @@
+This patch adapts the vpnc script to newer kernel versions, see
+   https://lkml.org/lkml/2011/3/24/645
+
+diff -u a/vpnc-script.in b/vpnc-script.in
+--- a/vpnc-script.in	2013-03-03 13:55:16.000000000 +0100
++++ b/vpnc-script.in	2013-03-03 13:56:11.000000000 +0100
+@@ -116,7 +116,7 @@
+ 
+ if [ -n "$IPROUTE" ]; then
+ 	fix_ip_get_output () {
+-		sed 's/cache//;s/metric \?[0-9]\+ [0-9]\+//g;s/hoplimit [0-9]\+//g'
++		sed 's/cache//;s/metric \?[0-9]\+ [0-9]\+//g;s/hoplimit [0-9]\+//g;s/ipid 0x....//g'
+ 	}
+ 
+ 	set_vpngateway_route() {
diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm
new file mode 100644
index 0000000000..9393e1e7b4
--- /dev/null
+++ b/gnu/packages/vpn.scm
@@ -0,0 +1,66 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages vpn)
+  #:use-module ((guix licenses)
+                #:renamer (symbol-prefix-proc 'license:))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages perl))
+
+(define-public vpnc
+  (package
+   (name "vpnc")
+   (version "0.5.3")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "http://www.unix-ag.uni-kl.de/~massar/vpnc/vpnc-"
+                                version ".tar.gz"))
+            (sha256 (base32
+                     "1128860lis89g1s21hqxvap2nq426c9j4bvgghncc1zj0ays7kj6"))))
+   (build-system gnu-build-system)
+   (inputs `(("libgcrypt" ,libgcrypt)
+             ("perl" ,perl)
+             ("patch/script"
+                 ,(search-patch "vpnc-script.patch"))))
+   (arguments
+    `(#:tests? #f ; there is no check target
+      #:patches (list (assoc-ref %build-inputs
+                                 "patch/script"))
+      #:phases
+      (alist-replace
+       'configure
+       (lambda* (#:key outputs #:allow-other-keys)
+         (let ((out (assoc-ref outputs "out")))
+           (substitute* "Makefile"
+             (("PREFIX=/usr/local") (string-append "PREFIX=" out)))
+           (substitute* "Makefile"
+             (("ETCDIR=/etc/vpnc") (string-append "ETCDIR=" out "/etc/vpnc")))))
+       %standard-phases)))
+   (synopsis "vpnc, a client for cisco vpn concentrators")
+   (description
+    "vpnc is a VPN client compatible with Cisco's EasyVPN equipment.
+It supports IPSec (ESP) with Mode Configuration and Xauth. It supports only
+shared-secret IPSec authentication with Xauth, AES (256, 192, 128), 3DES,
+1DES, MD5, SHA1, DH1/2/5 and IP tunneling. It runs entirely in userspace.
+Only \"Universal TUN/TAP device driver support\" is needed in the kernel.")
+   (license license:gpl2+) ; some file are bsd-2, see COPYING
+   (home-page "http://www.unix-ag.uni-kl.de/~massar/vpnc/")))
-- 
cgit v1.2.3


From 2a1e82bb5c2ae28b0018aa765cff6733136b3f70 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 4 Mar 2013 00:46:44 +0100
Subject: gnu: Add Perl XML::Parser.

* gnu/packages/xml.scm (perl-xml-parser): New variable.
---
 gnu/packages/xml.scm | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

(limited to 'gnu')

diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm
index 1d7060a044..b3c5f7d512 100644
--- a/gnu/packages/xml.scm
+++ b/gnu/packages/xml.scm
@@ -26,7 +26,8 @@ (define-module (gnu packages xml)
                 #:renamer (symbol-prefix-proc 'license:))
   #:use-module (guix packages)
   #:use-module (guix download)
-  #:use-module (guix build-system gnu))
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system perl))
 
 (define-public expat
   (package
@@ -90,3 +91,34 @@ (define-public libxslt
      "Libxslt is an XSLT C library developed for the GNOME project. It is
 based on libxml for XML parsing, tree manipulation and XPath support.")
     (license license:x11)))
+
+(define-public perl-xml-parser
+  (package
+    (name "perl-xml-parser")
+    (version "2.41")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append
+                   "mirror://cpan/authors/id/M/MS/MSERGEANT/XML-Parser-"
+                   version ".tar.gz"))
+             (sha256
+              (base32
+               "1sadi505g5qmxr36lgcbrcrqh3a5gcdg32b405gnr8k54b6rg0dl"))))
+    (build-system perl-build-system)
+    (arguments `(#:make-maker-flags
+                 (let ((expat (assoc-ref %build-inputs "expat")))
+                   (list (string-append "EXPATLIBPATH=" expat "/lib")
+                         (string-append "EXPATINCPATH=" expat "/include")))))
+    (inputs `(("expat" ,expat)))
+    (license (package-license perl))
+    (synopsis "Perl bindings to the Expat XML parsing library")
+    (description
+     "This module provides ways to parse XML documents.  It is built on top of
+XML::Parser::Expat, which is a lower level interface to James Clark's expat
+library.  Each call to one of the parsing methods creates a new instance of
+XML::Parser::Expat which is then used to parse the document.  Expat options
+may be provided when the XML::Parser object is created.  These options are
+then passed on to the Expat object on each parse call.  They can also be given
+as extra arguments to the parse methods, in which case they override options
+given at XML::Parser creation time.")
+    (home-page "http://search.cpan.org/~toddr/XML-Parser-2.41/Parser.pm")))
-- 
cgit v1.2.3