Merge branch 'master' into core-updates

.dir-locals.el

@@ -6,6 +6,7 @@
  (scheme-mode
   .
   ((indent-tabs-mode . nil)
+   (eval . (put 'eval-when 'scheme-indent-function 1))
    (eval . (put 'test-assert 'scheme-indent-function 1))
    (eval . (put 'test-equal 'scheme-indent-function 1))
    (eval . (put 'test-eq 'scheme-indent-function 1))
@@ -16,6 +17,8 @@
    (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
    (eval . (put 'package 'scheme-indent-function 0))
    (eval . (put 'origin 'scheme-indent-function 0))
+   (eval . (put 'operating-system 'scheme-indent-function 0))
+   (eval . (put 'file-system 'scheme-indent-function 0))
    (eval . (put 'manifest-entry 'scheme-indent-function 0))
    (eval . (put 'manifest-pattern 'scheme-indent-function 0))
    (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
@@ -31,7 +34,13 @@
    (eval . (put 'with-monad 'scheme-indent-function 1))
    (eval . (put 'mlet* 'scheme-indent-function 2))
    (eval . (put 'mlet 'scheme-indent-function 2))
-   (eval . (put 'run-with-store 'scheme-indent-function 1))))
+   (eval . (put 'run-with-store 'scheme-indent-function 1))
+
+   ;; Recognize '~' and '$', as used for gexps, as quotation symbols.  This
+   ;; notably allows '(' in Paredit to not insert a space when the preceding
+   ;; symbol is one of these.
+   (eval . (modify-syntax-entry ?~ "'"))
+   (eval . (modify-syntax-entry ?$ "'"))))
  (emacs-lisp-mode . ((indent-tabs-mode . nil)))
  (texinfo-mode    . ((indent-tabs-mode . nil)
                      (fill-column . 72))))

.gitmodules

@@ -1,3 +1,3 @@
 [submodule "nix-upstream"]
 	path = nix-upstream
-	url = http://github.com/NixOS/nix.git
+	url = https://github.com/NixOS/nix.git

HACKING

@@ -159,7 +159,8 @@ patches include fixing typos, etc.)
 For patches that just add a new package, and a simple one, it’s OK to commit,
 if you’re confident (which means you successfully built it in a chroot setup,
 and have done a reasonable copyright and license auditing.)  Likewise for
-package upgrades.  We have a mailing list for commit notifications
+package upgrades, except upgrades that trigger a lot of rebuilds (for example,
+upgrading GnuTLS or GLib.)  We have a mailing list for commit notifications
 (guix-commits@gnu.org), so people can notice.  Before pushing your changes,
 make sure to run ‘git pull --rebase’.
 

Makefile.am

@@ -37,6 +37,7 @@ MODULES =					\
   guix/download.scm				\
   guix/git-download.scm				\
   guix/monads.scm				\
+  guix/gexp.scm					\
   guix/profiles.scm				\
   guix/serialization.scm			\
   guix/nar.scm					\
@@ -58,7 +59,6 @@ MODULES =					\
   guix/build/download.scm			\
   guix/build/cmake-build-system.scm		\
   guix/build/git.scm				\
-  guix/build/gnome.scm				\
   guix/build/gnu-build-system.scm		\
   guix/build/gnu-dist.scm			\
   guix/build/linux-initrd.scm			\
@@ -70,6 +70,9 @@ MODULES =					\
   guix/build/rpath.scm				\
   guix/build/svn.scm				\
   guix/build/vm.scm				\
+  guix/build/install.scm			\
+  guix/build/activation.scm			\
+  guix/build/syscalls.scm			\
   guix/packages.scm				\
   guix/snix.scm					\
   guix/scripts/download.scm			\
@@ -139,9 +142,11 @@ SCM_TESTS =					\
   tests/snix.scm				\
   tests/store.scm				\
   tests/monads.scm				\
+  tests/gexp.scm				\
   tests/nar.scm					\
   tests/union.scm				\
-  tests/profiles.scm
+  tests/profiles.scm				\
+  tests/syscalls.scm
 
 SH_TESTS =					\
   tests/guix-build.sh				\
@@ -254,6 +259,7 @@ endif BUILD_DAEMON
 ACLOCAL_AMFLAGS = -I m4
 AM_DISTCHECK_CONFIGURE_FLAGS =			\
   --with-libgcrypt-prefix="$(LIBGCRYPT_PREFIX)"	\
+  --with-libgcrypt-libdir="$(LIBGCRYPT_LIBDIR)"	\
   --with-nix-prefix="$(NIX_PREFIX)"		\
   --enable-daemon
 

TODO

@@ -63,32 +63,6 @@ create a new ‘dir’.
       ("i3" ,p3)))
 #+END_SRC
 
-* MAYBE use HOP-like escapes to refer to inputs in build-side code
-
-Instead of doing things like:
-
-#+BEGIN_SRC scheme
-  (inputs `(("foo" ,foo)))
-  (arguments '(#:configure-flags
-               (list (string-append "--with-foo="
-                                    (assoc-ref %build-inputs "foo")))))
-#+END_SRC
-
-Allow things like:
-
-#+BEGIN_SRC scheme
-  (inputs (list foo))
-  (arguments ~(#:configure-flags
-               (list (string-append "--with-foo=" $foo))))
-  
-#+END_SRC
-
-... where '~' is 'build-quote' and '$' is 'build-unquote'.  Better yet,
-automatically compute the list of references of an expression passed to
-'derivation-expression'.
-
-Use a [[http://dorophone.blogspot.fr/2011/09/scheme-syntax-is-monad.html][monad]] for the syntax.
-
 * synchronize non-GNU package descriptions with the [[http://directory.fsf.org][FSD]]
 
 Meta-data for GNU packages, including descriptions and synopses, can be

build-aux/hydra/demo-os.scm

@@ -22,9 +22,10 @@
 ;;; machine images that we build.
 ;;;
 
-(use-modules (gnu packages zile)
+(use-modules (gnu)
+
+             (gnu packages zile)
              (gnu packages xorg)
-             (gnu packages base)
              (gnu packages admin)
              (gnu packages guile)
              (gnu packages bash)
@@ -33,8 +34,6 @@
              (gnu packages tor)
              (gnu packages package-management)
 
-             (gnu system shadow)                  ; 'user-account'
-             (gnu services base)
              (gnu services networking)
              (gnu services xorg))
 
@@ -42,11 +41,32 @@
  (host-name "gnu")
  (timezone "Europe/Paris")
  (locale "en_US.UTF-8")
+ (bootloader (grub-configuration
+              (device "/dev/sda")))
+ (file-systems
+  ;; We provide a dummy file system for /, but that's OK because the VM build
+  ;; code will automatically declare the / file system for us.
+  (list (file-system
+          (mount-point "/")
+          (device "dummy")
+          (type "dummy"))
+        ;; %fuse-control-file-system   ; needs fuse.ko
+        %binary-format-file-system))
  (users (list (user-account
                (name "guest")
-               (uid 1000) (gid 100)
+               (group "wheel")
+               (password "")
                (comment "Guest of GNU")
                (home-directory "/home/guest"))))
+ (groups (list (user-group (name "root") (id 0))
+               (user-group
+                (name "wheel")
+                (id 1)
+                (members '("guest")))             ; allow 'guest' to use sudo
+               (user-group
+                (name "users")
+                (id 100)
+                (members '("guest")))))
  (services (cons* (slim-service #:auto-login? #t
                                 #:default-user "guest")
 
@@ -56,6 +76,9 @@
                                              #:gateway "10.0.2.2")
 
                   %base-services))
+ (pam-services
+  ;; Explicitly allow for empty passwords.
+  (base-pam-services #:allow-empty-passwords? #t))
  (packages (list bash coreutils findutils grep sed
                  procps psmisc less
                  guile-2.0 dmd guix util-linux inetutils

config-daemon.ac

@@ -38,13 +38,21 @@ if test "x$guix_build_daemon" = "xyes"; then
   case "$LIBGCRYPT_PREFIX" in
     no)
       LIBGCRYPT_CFLAGS=""
-      LIBGCRYPT_LIBS=""
       ;;
     *)
       LIBGCRYPT_CFLAGS="-I$LIBGCRYPT_PREFIX/include"
-      LIBGCRYPT_LIBS="-L$LIBGCRYPT_PREFIX/lib -lgcrypt"
       ;;
   esac
+
+  case "$LIBGCRYPT_LIBDIR" in
+    no)
+      LIBGCRYPT_LIBS="-lgcrypt"
+      ;;
+   *)
+      LIBGCRYPT_LIBS="-L$LIBGCRYPT_LIBDIR -lgcrypt"
+      ;;
+  esac
+
   AC_SUBST([LIBGCRYPT_CFLAGS])
   AC_SUBST([LIBGCRYPT_LIBS])
 
@@ -67,9 +75,14 @@ if test "x$guix_build_daemon" = "xyes"; then
   AC_CHECK_FUNCS([chroot unshare])
   AC_CHECK_HEADERS([sched.h sys/param.h sys/mount.h])
 
-  dnl Check for lutimes, optionally used for changing the mtime of
+  dnl lutimes and lchown: used when canonicalizing store items.
-  dnl symlinks.
+  dnl posix_fallocate: used when extracting archives.
-  AC_CHECK_FUNCS([lutimes])
+  dnl vfork: to speed up spawning of helper programs.
+  dnl sched_setaffinity: to improve RPC locality.
+  dnl statvfs: to detect disk-full conditions.
+  dnl strsignal: for error reporting.
+  AC_CHECK_FUNCS([lutimes lchown posix_fallocate vfork sched_setaffinity \
+     statvfs nanosleep strsignal])
 
   dnl Check whether the store optimiser can optimise symlinks.
   AC_MSG_CHECKING([whether it is possible to create a link to a symlink])

configure.ac

@@ -116,19 +116,44 @@ AC_ARG_WITH([libgcrypt-prefix],
     yes|no)
       LIBGCRYPT="libgcrypt"
       LIBGCRYPT_PREFIX="no"
+      LIBGCRYPT_LIBDIR="no"
       ;;
     *)
       LIBGCRYPT="$withval/lib/libgcrypt"
       LIBGCRYPT_PREFIX="$withval"
+      LIBGCRYPT_LIBDIR="$withval/lib"
       ;;
    esac],
-  [LIBGCRYPT="libgcrypt"])
+  [LIBGCRYPT="libgcrypt"
+   LIBGCRYPT_PREFIX="no"
+   LIBGCRYPT_LIBDIR="no"])
+
+AC_ARG_WITH([libgcrypt-libdir],
+  [AS_HELP_STRING([--with-libgcrypt-libdir=DIR],
+     [search for GNU libgcrypt's shared library in DIR])],
+  [case "$withval" in
+    yes|no)
+      LIBGCRYPT="libgcrypt"
+      LIBGCRYPT_LIBDIR="no"
+      ;;
+    *)
+      LIBGCRYPT="$withval/libgcrypt"
+      LIBGCRYPT_LIBDIR="$withval"
+      ;;
+   esac],
+  [if test "x$LIBGCRYPT" = x; then
+      LIBGCRYPT="libgcrypt"
+   fi
+   if test "x$LIBGCRYPT_LIBDIR" = x; then
+      LIBGCRYPT_LIBDIR="no"
+   fi])
 
 dnl Library name suitable for `dynamic-link'.
 AC_MSG_CHECKING([for libgcrypt shared library name])
 AC_MSG_RESULT([$LIBGCRYPT])
 AC_SUBST([LIBGCRYPT])
 AC_SUBST([LIBGCRYPT_PREFIX])
+AC_SUBST([LIBGCRYPT_LIBDIR])
 
 GUIX_ASSERT_LIBGCRYPT_USABLE
 

doc/guix.texi

@@ -11,7 +11,7 @@
 
 @copying
 Copyright @copyright{} 2012, 2013, 2014 Ludovic Courtès@*
-Copyright @copyright{} 2013 Andreas Enge@*
+Copyright @copyright{} 2013, 2014 Andreas Enge@*
 Copyright @copyright{} 2013 Nikita Karetnikov
 
 Permission is granted to copy, distribute and/or modify this document
@@ -828,6 +828,17 @@ name: libgc
 version: 7.2alpha6
 @end example
 
+Similarly, to show the name of all the packages available under the
+terms of the GNU@tie{}LGPL version 3:
+
+@example
+$ guix package -s "" | recsel -p name -e 'license ~ "LGPL 3"'
+name: elfutils
+
+name: gmp
+@dots{}
+@end example
+
 @item --list-installed[=@var{regexp}]
 @itemx -I [@var{regexp}]
 List the currently installed packages in the specified profile, with the
@@ -1305,6 +1316,7 @@ package definitions.
 * The Store::                   Manipulating the package store.
 * Derivations::                 Low-level interface to package derivations.
 * The Store Monad::             Purely functional interface to the store.
+* G-Expressions::               Manipulating build expressions.
 @end menu
 
 @node Defining Packages
@@ -1762,13 +1774,21 @@ to a Bash executable in the store:
                            "echo hello world > $out\n" '())))
   (derivation store "foo"
               bash `("-e" ,builder)
+              #:inputs `((,bash) (,builder))
               #:env-vars '(("HOME" . "/homeless"))))
 @result{} #<derivation /gnu/store/@dots{}-foo.drv => /gnu/store/@dots{}-foo>
 @end lisp
 
-As can be guessed, this primitive is cumbersome to use directly.  An
+As can be guessed, this primitive is cumbersome to use directly.  A
-improved variant is @code{build-expression->derivation}, which allows
+better approach is to write build scripts in Scheme, of course!  The
-the caller to directly pass a Guile expression as the build script:
+best course of action for that is to write the build code as a
+``G-expression'', and to pass it to @code{gexp->derivation}.  For more
+information, @ref{G-Expressions}.
+
+Once upon a time, @code{gexp->derivation} did not exist and constructing
+derivations with build code written in Scheme was achieved with
+@code{build-expression->derivation}, documented below.  This procedure
+is now deprecated in favor of the much nicer @code{gexp->derivation}.
 
 @deffn {Scheme Procedure} build-expression->derivation @var{store} @
        @var{name} @var{exp} @
@@ -1816,20 +1836,6 @@ containing one file:
 @result{} #<derivation /gnu/store/@dots{}-goo.drv => @dots{}>
 @end lisp
 
-@cindex strata of code
-Remember that the build expression passed to
-@code{build-expression->derivation} is run by a separate Guile process
-than the one that calls @code{build-expression->derivation}: it is run
-by a Guile process launched by the daemon, typically in a chroot.  So,
-while there is a single language for both the @dfn{host} and the build
-side, there are really two @dfn{strata} of code: the host-side, and the
-build-side code@footnote{The term @dfn{stratum} in this context was
-coined by Manuel Serrano et al. in the context of their work on Hop.}.
-This distinction is important to keep in mind, notably when using
-higher-level constructs such as @var{gnu-build-system} (@pxref{Defining
-Packages}).  For this reason, Guix modules that are meant to be used in
-the build stratum are kept in the @code{(guix build @dots{})} name
-space.
 
 @node The Store Monad
 @section The Store Monad
@@ -1873,11 +1879,12 @@ Consider this ``normal'' procedure:
 
 Using @code{(guix monads)}, it may be rewritten as a monadic function:
 
+@c FIXME: Find a better example, one that uses 'mlet'.
 @example
 (define (sh-symlink)
   ;; Same, but return a monadic value.
-  (mlet %store-monad ((sh (package-file bash "bin")))
+  (gexp->derivation "sh"
-    (derivation-expression "sh" `(symlink ,sh %output))))
+                    #~(symlink (string-append #$bash "/bin/bash") #$output)))
 @end example
 
 There are two things to note in the second version: the @code{store}
@@ -1978,21 +1985,206 @@ directory of @var{package}.  When @var{file} is omitted, return the name
 of the @var{output} directory of @var{package}.
 @end deffn
 
-@deffn {Monadic Procedure} derivation-expression @var{name} @var{exp} @
-       [#:system (%current-system)] [#:inputs '()] @
-       [#:outputs '("out")] [#:hash #f] @
-       [#:hash-algo #f] [#:env-vars '()] [#:modules '()] @
-       [#:references-graphs #f] [#:guile-for-build #f]
-Monadic version of @code{build-expression->derivation}
-(@pxref{Derivations}).
-@end deffn
-
 @deffn {Monadic Procedure} package->derivation @var{package} [@var{system}]
 Monadic version of @code{package-derivation} (@pxref{Defining
 Packages}).
 @end deffn
 
 
+@node G-Expressions
+@section G-Expressions
+
+@cindex G-expression
+@cindex build code quoting
+So we have ``derivations'', which represent a sequence of build actions
+to be performed to produce an item in the store (@pxref{Derivations}).
+Those build actions are performed when asking the daemon to actually
+build the derivations; they are run by the daemon in a container
+(@pxref{Invoking guix-daemon}).
+
+@cindex strata of code
+It should come as no surprise that we like to write those build actions
+in Scheme.  When we do that, we end up with two @dfn{strata} of Scheme
+code@footnote{The term @dfn{stratum} in this context was coined by
+Manuel Serrano et al.@: in the context of their work on Hop.  Oleg
+Kiselyov, who has written insightful
+@url{http://okmij.org/ftp/meta-programming/#meta-scheme, essays and code
+on this topic}, refers to this kind of code generation as
+@dfn{staging}.}: the ``host code''---code that defines packages, talks
+to the daemon, etc.---and the ``build code''---code that actually
+performs build actions, such as making directories, invoking
+@command{make}, etc.
+
+To describe a derivation and its build actions, one typically needs to
+embed build code inside host code.  It boils down to manipulating build
+code as data, and Scheme's homoiconicity---code has a direct
+representation as data---comes in handy for that.  But we need more than
+Scheme's normal @code{quasiquote} mechanism to construct build
+expressions.
+
+The @code{(guix gexp)} module implements @dfn{G-expressions}, a form of
+S-expressions adapted to build expressions.  G-expressions, or
+@dfn{gexps}, consist essentially in three syntactic forms: @code{gexp},
+@code{ungexp}, and @code{ungexp-splicing} (or simply: @code{#~},
+@code{#$}, and @code{#$@@}), which are comparable respectively to
+@code{quasiquote}, @code{unquote}, and @code{unquote-splicing}
+(@pxref{Expression Syntax, @code{quasiquote},, guile, GNU Guile
+Reference Manual}).  However, there are major differences:
+
+@itemize
+@item
+Gexps are meant to be written to a file and run or manipulated by other
+processes.
+
+@item
+When a package or derivation is unquoted inside a gexp, the result is as
+if its output file name had been introduced.
+
+@item
+Gexps carry information about the packages or derivations they refer to,
+and these dependencies are automatically added as inputs to the build
+processes that use them.
+@end itemize
+
+To illustrate the idea, here is an example of a gexp:
+
+@example
+(define build-exp
+  #~(begin
+      (mkdir #$output)
+      (chdir #$output)
+      (symlink (string-append #$coreutils "/bin/ls") 
+               "list-files")))
+@end example
+
+This gexp can be passed to @code{gexp->derivation}; we obtain a
+derivation that builds a directory containing exactly one symlink to
+@file{/gnu/store/@dots{}-coreutils-8.22/bin/ls}:
+
+@example
+(gexp->derivation "the-thing" build-exp)
+@end example
+
+As one would expect, the @code{"/gnu/store/@dots{}-coreutils-8.22"} string is
+substituted to the reference to the @var{coreutils} package in the
+actual build code, and @var{coreutils} is automatically made an input to
+the derivation.  Likewise, @code{#$output} (equivalent to @code{(ungexp
+output)}) is replaced by a string containing the derivation's output
+directory name.  The syntactic form to construct gexps is summarized
+below.
+
+@deffn {Scheme Syntax} #~@var{exp}
+@deffnx {Scheme Syntax} (gexp @var{exp})
+Return a G-expression containing @var{exp}.  @var{exp} may contain one
+or more of the following forms:
+
+@table @code
+@item #$@var{obj}
+@itemx (ungexp @var{obj})
+Introduce a reference to @var{obj}.  @var{obj} may be a package or a
+derivation, in which case the @code{ungexp} form is replaced by its
+output file name---e.g., @code{"/gnu/store/@dots{}-coreutils-8.22}.
+
+If @var{obj} is a list, it is traversed and any package or derivation
+references are substituted similarly.
+
+If @var{obj} is another gexp, its contents are inserted and its
+dependencies are added to those of the containing gexp.
+
+If @var{obj} is another kind of object, it is inserted as is.
+
+@item #$@var{package-or-derivation}:@var{output}
+@itemx (ungexp @var{package-or-derivation} @var{output})
+This is like the form above, but referring explicitly to the
+@var{output} of @var{package-or-derivation}---this is useful when
+@var{package-or-derivation} produces multiple outputs (@pxref{Packages
+with Multiple Outputs}).
+
+@item #$output[:@var{output}]
+@itemx (ungexp output [@var{output}])
+Insert a reference to derivation output @var{output}, or to the main
+output when @var{output} is omitted.
+
+This only makes sense for gexps passed to @code{gexp->derivation}.
+
+@item #$@@@var{lst}
+@itemx (ungexp-splicing @var{lst})
+Like the above, but splices the contents of @var{lst} inside the
+containing list.
+
+@end table
+
+G-expressions created by @code{gexp} or @code{#~} are run-time objects
+of the @code{gexp?} type (see below.)
+@end deffn
+
+@deffn {Scheme Procedure} gexp? @var{obj}
+Return @code{#t} if @var{obj} is a G-expression.
+@end deffn
+
+G-expressions are meant to be written to disk, either as code building
+some derivation, or as plain files in the store.  The monadic procedures
+below allow you to do that (@pxref{The Store Monad}, for more
+information about monads.)
+
+@deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @
+       [#:system (%current-system)] [#:inputs '()] @
+       [#:hash #f] [#:hash-algo #f] @
+       [#:recursive? #f] [#:env-vars '()] [#:modules '()] @
+       [#:references-graphs #f] [#:local-build? #f] @
+       [#:guile-for-build #f]
+Return a derivation @var{name} that runs @var{exp} (a gexp) with
+@var{guile-for-build} (a derivation) on @var{system}.
+
+Make @var{modules} available in the evaluation context of @var{EXP};
+@var{MODULES} is a list of names of Guile modules from the current
+search path to be copied in the store, compiled, and made available in
+the load path during the execution of @var{exp}---e.g., @code{((guix
+build utils) (guix build gnu-build-system))}.
+
+The other arguments are as for @code{derivation} (@pxref{Derivations}).
+@end deffn
+
+@deffn {Monadic Procedure} gexp->script @var{name} @var{exp}
+Return an executable script @var{name} that runs @var{exp} using
+@var{guile} with @var{modules} in its search path.
+
+The example below builds a script that simply invokes the @command{ls}
+command:
+
+@example
+(use-modules (guix gexp) (gnu packages base))
+
+(gexp->script "list-files"
+              #~(execl (string-append #$coreutils "/bin/ls")
+                       "ls"))
+@end example
+
+When ``running'' it through the store (@pxref{The Store Monad,
+@code{run-with-store}}), we obtain a derivation that produces an
+executable file @file{/gnu/store/@dots{}-list-files} along these lines:
+
+@example
+#!/gnu/store/@dots{}-guile-2.0.11/bin/guile -ds
+!#
+(execl (string-append "/gnu/store/@dots{}-coreutils-8.22"/bin/ls")
+       "ls")
+@end example
+@end deffn
+
+@deffn {Monadic Procedure} gexp->file @var{name} @var{exp}
+Return a derivation that builds a file @var{name} containing @var{exp}.
+
+The resulting file holds references to all the dependencies of @var{exp}
+or a subset thereof.
+@end deffn
+
+Of course, in addition to gexps embedded in ``host'' code, there are
+also modules containing build tools.  To make it clear that they are
+meant to be used in the build stratum, these modules are kept in the
+@code{(guix build @dots{})} name space.
+
+
 @c *********************************************************************
 @node Utilities
 @chapter Utilities
@@ -2412,6 +2604,7 @@ to join!  @ref{Contributing}, for information about how you can help.
 @node Installing Debugging Files
 @section Installing Debugging Files
 
+@cindex debugging files
 Program binaries, as produced by the GCC compilers for instance, are
 typically written in the ELF format, with a section containing
 @dfn{debugging information}.  Debugging information is what allows the
@@ -2442,7 +2635,7 @@ installs the debugging information for the GNU C Library and for GNU
 Guile:
 
 @example
-guix package -i glibc:debug -i guile:debug
+guix package -i glibc:debug guile:debug
 @end example
 
 GDB must then be told to look for debug files in the user's profile, by
@@ -2457,9 +2650,16 @@ GDB}):
 From there on, GDB will pick up debugging information from the
 @code{.debug} files under @file{~/.guix-profile/lib/debug}.
 
+In addition, you will most likely want GDB to be able to show the source
+code being debugged.  To do that, you will have to unpack the source
+code of the package of interest (obtained with @code{guix build
+--source}, @pxref{Invoking guix build}), and to point GDB to that source
+directory using the @code{directory} command (@pxref{Source Path,
+@code{directory},, gdb, Debugging with GDB}).
+
 @c XXX: keep me up-to-date
 The @code{debug} output mechanism in Guix is implemented by the
-@code{gnu-build-system} (@pxref{Defining Packages}).  Currently, it is
+@code{gnu-build-system} (@pxref{Build Systems}).  Currently, it is
 opt-in---debugging information is available only for those packages
 whose definition explicitly declares a @code{debug} output.  This may be
 changed to opt-out in the future, if our build farm servers can handle
@@ -2570,6 +2770,7 @@ needed is to review and apply the patch.
 * Package Naming::       What's in a name?
 * Version Numbers::      When the name is not enough.
 * Python Modules::       Taming the snake.
+* Perl Modules::         Little pearls.
 @end menu
 
 @node Software Freedom
@@ -2611,12 +2812,15 @@ the string in the @code{name} field of a package definition.  This name
 is used by package management commands such as
 @command{guix package} and @command{guix build}.
 
-Both are usually the same and correspond to the lowercase conversion of the
+Both are usually the same and correspond to the lowercase conversion of
-project name chosen upstream.  For instance, the GNUnet project is packaged
+the project name chosen upstream, with underscores replaced with
-as @code{gnunet}.  We do not add @code{lib} prefixes for library packages,
+hyphens.  For instance, GNUnet is available as @code{gnunet}, and
-unless these are already part of the official project name.  But see
+SDL_net as @code{sdl-net}.
-@ref{Python Modules} for special rules concerning modules for
+
-the Python language.
+We do not add @code{lib} prefixes for library packages, unless these are
+already part of the official project name.  But see @pxref{Python
+Modules} and @ref{Perl Modules} for special rules concerning modules for
+the Python and Perl languages.
 
 
 @node Version Numbers
@@ -2678,6 +2882,19 @@ for instance, the module python-dateutil is packaged under the names
 @code{python-dateutil} and @code{python2-dateutil}.
 
 
+@node Perl Modules
+@subsection Perl Modules
+
+Perl programs standing for themselves are named as any other package,
+using the lowercase upstream name.
+For Perl packages containing a single class, we use the lowercase class name,
+replace all occurrences of @code{::} by dashes and prepend the prefix
+@code{perl-}.
+So the class @code{XML::Parser} becomes @code{perl-xml-parser}.
+Modules containing several classes keep their lowercase upstream name and
+are also prepended by @code{perl-}.  Such modules tend to have the word
+@code{perl} somewhere in their name, which gets dropped in favor of the
+prefix.  For instance, @code{libwww-perl} becomes @code{perl-libwww}.
 
 
 
@@ -2895,9 +3112,8 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
 
 @findex operating-system
 @lisp
-(use-modules (gnu services base)   ; for '%base-services'
+(use-modules (gnu)   ; for 'user-account', '%base-services', etc.
              (gnu services ssh)    ; for 'lsh-service'
-             (gnu system shadow)   ; for 'user-account'
              (gnu packages base)   ; Coreutils, grep, etc.
              (gnu packages bash)   ; Bash
              (gnu packages admin)  ; dmd, Inetutils
@@ -2911,6 +3127,12 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
    (host-name "komputilo")
    (timezone "Europe/Paris")
    (locale "fr_FR.UTF-8")
+   (bootloader (grub-configuration
+                 (device "/dev/sda")))
+   (file-systems (list (file-system
+                         (device "/dev/disk/by-label/root")
+                         (mount-point "/")
+                         (type "ext3"))))
    (users (list (user-account
                  (name "alice")
                  (password "")
@@ -2986,6 +3208,29 @@ operating system is instantiate.  Currently the following values are
 supported:
 
 @table @code
+@item build
+Build the operating system's derivation, which includes all the
+configuration files and programs needed to boot and run the system.
+This action does not actually install anything.
+
+@item init
+Populate the given directory with all the files necessary to run the
+operating system specified in @var{file}.  This is useful for first-time
+installations of the GNU system.  For instance:
+
+@example
+guix system init my-os-config.scm /mnt
+@end example
+
+copies to @file{/mnt} all the store items required by the configuration
+specified in @file{my-os-config.scm}.  This includes configuration
+files, packages, and so on.  It also creates other essential files
+needed for the system to operate correctly---e.g., the @file{/etc},
+@file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
+
+This command also installs GRUB on the device specified in
+@file{my-os-config}, unless the @option{--no-grub} option was passed.
+
 @item vm
 @cindex virtual machine
 Build a virtual machine that contain the operating system declared in
@@ -2994,9 +3239,23 @@ Build a virtual machine that contain the operating system declared in
 The VM shares its store with the host system.
 
 @item vm-image
-Return a virtual machine image of the operating system declared in
+@itemx disk-image
-@var{file} that stands alone.  Use the @option{--image-size} option to
+Return a virtual machine or disk image of the operating system declared
-specify the size of the image.
+in @var{file} that stands alone.  Use the @option{--image-size} option
+to specify the size of the image.
+
+When using @code{vm-image}, the returned image is in qcow2 format, which
+the QEMU emulator can efficiently use.
+
+When using @code{disk-image}, a raw disk image is produced; it can be
+copied as is to a USB stick, for instance.  Assuming @code{/dev/sdc} is
+the device corresponding to a USB stick, one can copy the image on it
+using the following command:
+
+@example
+# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
+@end example
+
 @end table
 
 @var{options} can contain any of the common build options provided by
@@ -3039,29 +3298,33 @@ like:
 
 @lisp
 (define (nscd-service)
-  (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
+  (with-monad %store-monad
     (return (service
              (documentation "Run libc's name service cache daemon.")
              (provision '(nscd))
-             (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
+             (activate #~(begin
-                                                "--foreground"))
+                           (use-modules (guix build utils))
-             (stop  `(make-kill-destructor))
+                           (mkdir-p "/var/run/nscd")))
-
+             (start #~(make-forkexec-constructor
-             (respawn? #f)
+                       (string-append #$glibc "/sbin/nscd")
-             (inputs `(("glibc" ,glibc)))))))
+                       "-f" "/dev/null" "--foreground"))
+             (stop #~(make-kill-destructor))
+             (respawn? #f)))))
 @end lisp
 
 @noindent
-The @code{inputs} field specifies that this service depends on the
+The @code{activate}, @code{start}, and @code{stop} fields are G-expressions
-@var{glibc} package---the package that contains the @command{nscd}
+(@pxref{G-Expressions}).  The @code{activate} field contains a script to
-program.  The @code{start} and @code{stop} fields are expressions that
+run at ``activation'' time; it makes sure that the @file{/var/run/nscd}
-make use of dmd's facilities to start and stop processes (@pxref{Service
+directory exists before @command{nscd} is started.
-De- and Constructors,,, dmd, GNU dmd Manual}).  The @code{provision}
+
-field specifies the name under which this service is known to dmd, and
+The @code{start} and @code{stop} fields refer to dmd's facilities to
-@code{documentation} specifies on-line documentation.  Thus, the
+start and stop processes (@pxref{Service De- and Constructors,,, dmd,
-commands @command{deco start ncsd}, @command{deco stop nscd}, and
+GNU dmd Manual}).  The @code{provision} field specifies the name under
-@command{deco doc nscd} will do what you would expect (@pxref{Invoking
+which this service is known to dmd, and @code{documentation} specifies
-deco,,, dmd, GNU dmd Manual}).
+on-line documentation.  Thus, the commands @command{deco start ncsd},
+@command{deco stop nscd}, and @command{deco doc nscd} will do what you
+would expect (@pxref{Invoking deco,,, dmd, GNU dmd Manual}).
 
 
 @c *********************************************************************

gnu-system.am

@@ -1,6 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
-# Copyright © 2013 Andreas Enge <andreas@enge.fr>
+# Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 # Copyright © 2013, 2014 Mark H Weaver <mhw@netris.org>
 #
 # This file is part of GNU Guix.
@@ -22,6 +22,7 @@
 # binaries.
 
 GNU_SYSTEM_MODULES =				\
+  gnu.scm					\
   gnu/packages.scm				\
   gnu/packages/acct.scm				\
   gnu/packages/acl.scm				\
@@ -35,14 +36,17 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/autogen.scm			\
   gnu/packages/autotools.scm			\
   gnu/packages/avahi.scm			\
+  gnu/packages/backup.scm			\
   gnu/packages/base.scm				\
   gnu/packages/bash.scm				\
   gnu/packages/bdb.scm				\
   gnu/packages/bdw-gc.scm			\
+  gnu/packages/bittorrent.scm			\
   gnu/packages/bison.scm			\
   gnu/packages/boost.scm			\
   gnu/packages/bootstrap.scm			\
   gnu/packages/calcurse.scm			\
+  gnu/packages/ccache.scm			\
   gnu/packages/cdrom.scm			\
   gnu/packages/cflow.scm			\
   gnu/packages/check.scm			\
@@ -61,6 +65,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/ddrescue.scm			\
   gnu/packages/dictionaries.scm			\
   gnu/packages/docbook.scm			\
+  gnu/packages/doxygen.scm			\
   gnu/packages/dwm.scm				\
   gnu/packages/ed.scm				\
   gnu/packages/elf.scm				\
@@ -72,6 +77,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/fonts.scm			\
   gnu/packages/fontutils.scm			\
   gnu/packages/freeipmi.scm			\
+  gnu/packages/ftp.scm				\
   gnu/packages/games.scm			\
   gnu/packages/gawk.scm				\
   gnu/packages/gcal.scm				\
@@ -83,6 +89,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/gettext.scm			\
   gnu/packages/ghostscript.scm			\
   gnu/packages/giflib.scm			\
+  gnu/packages/gimp.scm				\
   gnu/packages/gkrellm.scm			\
   gnu/packages/gl.scm				\
   gnu/packages/glib.scm				\
@@ -147,11 +154,13 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/make-bootstrap.scm		\
   gnu/packages/maths.scm			\
   gnu/packages/mc.scm				\
+  gnu/packages/mcrypt.scm			\
   gnu/packages/messaging.scm			\
   gnu/packages/mit-krb5.scm			\
   gnu/packages/moe.scm				\
   gnu/packages/mpd.scm				\
   gnu/packages/mp3.scm				\
+  gnu/packages/mpi.scm				\
   gnu/packages/multiprecision.scm		\
   gnu/packages/mtools.scm			\
   gnu/packages/mysql.scm			\
@@ -170,6 +179,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/parallel.scm			\
   gnu/packages/parted.scm			\
   gnu/packages/patchutils.scm			\
+  gnu/packages/pciutils.scm			\
   gnu/packages/pcre.scm				\
   gnu/packages/pdf.scm				\
   gnu/packages/pem.scm				\
@@ -236,12 +246,15 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/zip.scm				\
 						\
   gnu/services.scm				\
+  gnu/services/avahi.scm			\
   gnu/services/base.scm				\
+  gnu/services/dbus.scm				\
   gnu/services/dmd.scm				\
   gnu/services/networking.scm			\
   gnu/services/xorg.scm				\
 						\
   gnu/system.scm				\
+  gnu/system/file-systems.scm			\
   gnu/system/grub.scm				\
   gnu/system/linux.scm				\
   gnu/system/linux-initrd.scm			\
@@ -259,7 +272,9 @@ dist_patch_DATA =						\
   gnu/packages/patches/binutils-loongson-workaround.patch	\
   gnu/packages/patches/bitlbee-fix-tests.patch			\
   gnu/packages/patches/bitlbee-memset-fix.patch			\
+  gnu/packages/patches/ccache-stdc-predef-test.patch		\
   gnu/packages/patches/cdparanoia-fpic.patch			\
+  gnu/packages/patches/clucene-pkgconfig.patch			\
   gnu/packages/patches/cmake-fix-tests.patch			\
   gnu/packages/patches/coreutils-dummy-man.patch		\
   gnu/packages/patches/coreutils-skip-nohup.patch		\
@@ -269,6 +284,8 @@ dist_patch_DATA =						\
   gnu/packages/patches/diffutils-gets-undeclared.patch		\
   gnu/packages/patches/dmd-getpw.patch				\
   gnu/packages/patches/dmd-tests-longer-sleeps.patch		\
+  gnu/packages/patches/doxygen-test.patch			\
+  gnu/packages/patches/doxygen-tmake.patch			\
   gnu/packages/patches/emacs-configure-sh.patch			\
   gnu/packages/patches/findutils-absolute-paths.patch		\
   gnu/packages/patches/flac-fix-memcmp-not-declared.patch	\
@@ -311,13 +328,20 @@ dist_patch_DATA =						\
   gnu/packages/patches/make-impure-dirs.patch			\
   gnu/packages/patches/mc-fix-ncurses-build.patch		\
   gnu/packages/patches/mcron-install.patch			\
+  gnu/packages/patches/mhash-keygen-test-segfault.patch		\
   gnu/packages/patches/mit-krb5-init-fix.patch			\
   gnu/packages/patches/mpc123-initialize-ao.patch		\
+  gnu/packages/patches/openssl-CVE-2010-5298.patch		\
+  gnu/packages/patches/openssl-extension-checking-fixes.patch	\
   gnu/packages/patches/patchelf-page-size.patch			\
   gnu/packages/patches/patchutils-xfail-gendiff-tests.patch	\
   gnu/packages/patches/perl-no-sys-dirs.patch			\
+  gnu/packages/patches/perl-tk-x11-discover.patch		\
+  gnu/packages/patches/petsc-fix-threadcomm.patch		\
   gnu/packages/patches/plotutils-libpng-jmpbuf.patch		\
   gnu/packages/patches/procps-make-3.82.patch			\
+  gnu/packages/patches/pybugz-encode-error.patch		\
+  gnu/packages/patches/pybugz-stty.patch			\
   gnu/packages/patches/python-fix-tests.patch			\
   gnu/packages/patches/python-libffi-mips-n32-fix.patch		\
   gnu/packages/patches/qt4-tests.patch				\
@@ -325,11 +349,14 @@ dist_patch_DATA =						\
   gnu/packages/patches/readline-link-ncurses.patch		\
   gnu/packages/patches/ripperx-libm.patch			\
   gnu/packages/patches/scheme48-tests.patch			\
+  gnu/packages/patches/scotch-test-threading.patch		\
   gnu/packages/patches/slim-session.patch			\
   gnu/packages/patches/slim-config.patch			\
   gnu/packages/patches/slim-sigusr1.patch			\
+  gnu/packages/patches/soprano-find-clucene.patch		\
   gnu/packages/patches/source-highlight-regexrange-test.patch	\
   gnu/packages/patches/sqlite-large-page-size-fix.patch		\
+  gnu/packages/patches/superlu-dist-scotchmetis.patch		\
   gnu/packages/patches/tcsh-fix-autotest.patch			\
   gnu/packages/patches/teckit-cstdio.patch			\
   gnu/packages/patches/valgrind-glibc.patch			\

gnu.scm

@@ -0,0 +1,46 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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))
+
+;;; Commentary:
+;;;
+;;; This composite module re-exports core parts the (gnu …) public modules.
+;;;
+;;; Code:
+
+(eval-when (eval load compile)
+  (begin
+    (define %public-modules
+      '((gnu system)
+        (gnu system file-systems)
+        (gnu system grub)                         ; 'grub-configuration'
+        (gnu system linux)                        ; 'base-pam-services'
+        (gnu system shadow)                       ; 'user-account'
+        (gnu system linux-initrd)
+        (gnu services)
+        (gnu services base)
+        (gnu packages)
+        (gnu packages base)))
+
+    (for-each (let ((i (module-public-interface (current-module))))
+                (lambda (m)
+                  (module-use! i (resolve-interface m))))
+              %public-modules)))
+
+;;; gnu.scm ends here

gnu/packages/admin.scm

@@ -40,10 +40,14 @@
                 #:select (tar))
   #:use-module ((gnu packages compression)
                 #:select (gzip))
+  #:use-module ((gnu packages openssl)
+                #:renamer (symbol-prefix-proc 'o:))
   #:use-module (gnu packages bison)
   #:use-module (gnu packages flex)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages groff)
   #:use-module (gnu packages xorg))
 
 (define-public dmd
@@ -471,6 +475,28 @@ network statistics collection, security monitoring, network debugging, etc.")
     ;; fad-*.c and a couple other files are BSD-4, but the rest is BSD-3.
     (license bsd-3)))
 
+(define-public tcpdump
+  (package
+    (name "tcpdump")
+    (version "4.5.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "http://www.tcpdump.org/release/tcpdump-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "15hb7zkzd66nag102qbv100hcnf7frglbkylmr8adwr8f5jkkaql"))))
+    (build-system gnu-build-system)
+    (inputs `(("libpcap" ,libpcap)
+              ("openssl" ,o:openssl)))
+    (native-inputs `(("perl" ,perl)))        ; for tests
+    (home-page "http://www.tcpdump.org/")
+    (synopsis "Network packet analyzer")
+    (description
+     "Tcpdump is a command-line tool to analyze network traffic passing
+through the network interface controller.")
+    (license bsd-3)))
+
 (define-public jnettop
   (package
     (name "jnettop")
@@ -542,3 +568,157 @@ by bandwidth they use.")
 console window to allow commands to be interactively run on multiple servers
 over ssh connections.")
     (license gpl2+)))
+
+(define-public rottlog
+  (package
+    (name "rottlog")
+    (version "0.72.2")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://gnu/rottlog/rottlog-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "0751mb9l2f0jrk3vj6q8ilanifd121dliwk0c34g8k0dlzsv3kd7"))
+              (modules '((guix build utils)))
+              (snippet
+               '(substitute* "Makefile.in"
+                  (("-o \\$\\{LOG_OWN\\} -g \\$\\{LOG_GROUP\\}")
+                   ;; Don't try to chown root.
+                   "")
+                  (("mkdir -p \\$\\(ROTT_STATDIR\\)")
+                   ;; Don't attempt to create /var/lib/rottlog.
+                   "true")))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:configure-flags (list (string-append "ROTT_ETCDIR="
+                                              (assoc-ref %outputs "out")
+                                              "/etc")
+                               "--localstatedir=/var")
+       #:phases (alist-cons-after
+                 'install 'install-info
+                 (lambda _
+                   (zero? (system* "make" "install-info")))
+                 %standard-phases)))
+    (native-inputs `(("texinfo" ,texinfo)
+                     ("util-linux" ,util-linux))) ; for 'cal'
+    (home-page "http://www.gnu.org/software/rottlog/")
+    (synopsis "Log rotation and management")
+    (description
+     "GNU Rot[t]log is a program for managing log files.  It is used to
+automatically rotate out log files when they have reached a given size or
+according to a given schedule.  It can also be used to automatically compress
+and archive such logs.  Rot[t]log will mail reports of its activity to the
+system administrator.")
+    (license gpl3+)))
+
+(define-public sudo
+  (package
+    (name "sudo")
+    (version "1.8.10p2")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (list (string-append "http://www.sudo.ws/sudo/dist/sudo-"
+                                    version ".tar.gz")
+                     (string-append "ftp://ftp.sudo.ws/pub/sudo/OLD/sudo-"
+                                    version ".tar.gz")))
+              (sha256
+               (base32
+                "1wbrygz584abmywklq0b4xhqn3s1bjk3rrladslr5nycdpdvhv5s"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:configure-flags '("--with-logpath=/var/log/sudo.log")
+       #:phases (alist-cons-before
+                 'configure 'pre-configure
+                 (lambda _
+                   (substitute* "configure"
+                     ;; Refer to the right executables.
+                     (("/usr/bin/mv") (which "mv"))
+                     (("/usr/bin/sh") (which "sh")))
+                   (substitute* (find-files "." "Makefile\\.in")
+                     (("-O [[:graph:]]+ -G [[:graph:]]+")
+                      ;; Allow installation as non-root.
+                      "")
+                     (("^install: (.*)install-sudoers(.*)" _ before after)
+                      ;; Don't try to create /etc/sudoers.
+                      (string-append "install: " before after "\n"))))
+                 %standard-phases)
+
+       ;; XXX: The 'testsudoers' test series expects user 'root' to exist, but
+       ;; the chroot's /etc/passwd doesn't have it.  Turn off the tests.
+       #:tests? #f))
+    (inputs
+     `(("groff" ,groff)
+       ("linux-pam" ,linux-pam)
+       ("coreutils" ,coreutils)))
+    (home-page "http://www.sudo.ws/")
+    (synopsis "Run commands as root")
+    (description
+     "Sudo (su \"do\") allows a system administrator to delegate authority to
+give certain users (or groups of users) the ability to run some (or all)
+commands as root or another user while providing an audit trail of the
+commands and their arguments.")
+
+    ;; See <http://www.sudo.ws/sudo/license.html>.
+    (license x11)))
+
+(define-public wpa-supplicant
+  (package
+    (name "wpa-supplicant")
+    (version "2.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "http://hostap.epitest.fi/releases/wpa_supplicant-"
+                    version
+                    ".tar.gz"))
+              (sha256
+               (base32
+                "0xxjw7lslvql1ykfbwmbhdrnjsjljf59fbwf837418s97dz2wqwi"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-replace
+                 'configure
+                 (lambda* (#:key outputs #:allow-other-keys)
+                   (chdir "wpa_supplicant")
+                   (copy-file "defconfig" ".config")
+                   (let ((port (open-file ".config" "al")))
+                     (display "
+      CONFIG_DEBUG_SYSLOG=y
+      CONFIG_CTRL_IFACE_DBUS=y
+      CONFIG_CTRL_IFACE_DBUS_NEW=y
+      CONFIG_CTRL_IFACE_DBUS_INTRO=y
+      CONFIG_DRIVER_NL80211=y
+      CFLAGS += $(shell pkg-config libnl-3.0 --cflags)
+      CONFIG_LIBNL32=y
+      CONFIG_READLINE=y\n" port)
+                     (close-port port)))
+                 %standard-phases)
+
+      #:make-flags (list "CC=gcc"
+                         (string-append "BINDIR=" (assoc-ref %outputs "out")
+                                        "/sbin")
+                         (string-append "LIBDIR=" (assoc-ref %outputs "out")
+                                        "/lib"))
+      #:tests? #f))
+    (inputs
+     `(("readline" ,readline)
+       ("libnl" ,libnl)
+       ("dbus" ,dbus)
+       ("openssl" ,o:openssl)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "http://hostap.epitest.fi/wpa_supplicant/")
+    (synopsis "Connecting to WPA and WPA2-protected wireless networks")
+    (description
+     "wpa_supplicant is a WPA Supplicant with support for WPA and WPA2 (IEEE
+802.11i / RSN).  Supplicant is the IEEE 802.1X/WPA component that is used in
+the client stations.  It implements key negotiation with a WPA Authenticator
+and it controls the roaming and IEEE 802.11 authentication/association of the
+WLAN driver.
+
+This package provides the 'wpa_supplicant' daemon and the 'wpa_cli' command.")
+
+    ;; In practice, this is linked against Readline, which makes it GPLv3+.
+    (license bsd-3)))

gnu/packages/algebra.scm

@@ -21,6 +21,7 @@
 (define-module (gnu packages algebra)
   #:use-module (gnu packages)
   #:use-module (gnu packages multiprecision)
+  #:use-module (gnu packages mpi)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages readline)
   #:use-module (gnu packages flex)
@@ -123,14 +124,14 @@ PARI is also available as a C library to allow for faster computations.")
 (define-public gp2c
   (package
    (name "gp2c")
-   (version "0.0.8pl1")
+   (version "0.0.9pl1")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "http://pari.math.u-bordeaux.fr/pub/pari/GP2C/gp2c-"
                   version ".tar.gz"))
             (sha256 (base32
-                     "0r1xrshgx0db2snmacwvg5r99fhd9rpblcfs86pfsp23hnjxj9i0"))))
+                     "1p36060vwhn38j77r4c3jqyaslvhvgm6fdw2486k7krxk5ai7ph5"))))
    (build-system gnu-build-system)
    (native-inputs `(("perl" ,perl)))
    (inputs `(("pari-gp" ,pari-gp)))
@@ -196,14 +197,14 @@ syntax is similar to that of C, so basic usage is familiar.  It also includes
 (define-public fftw
   (package
     (name "fftw")
-    (version "3.3.3")
+    (version "3.3.4")
     (source (origin
              (method url-fetch)
              (uri (string-append "ftp://ftp.fftw.org/pub/fftw/fftw-"
                                  version".tar.gz"))
              (sha256
               (base32
-               "1wwp9b2va7vkq3ay7a9jk22nr4x5q6m37rzqy2j8y3d11c5grkc5"))))
+               "10h9mzjxnwlsjziah4lri85scc05rlajz39nqf3mbh4vja8dw34g"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--enable-shared" "--enable-openmp")
@@ -237,3 +238,17 @@ cosine/ sine transforms or DCT/DST).")
     (description
      (string-append (package-description fftw)
                     "  Single-precision version."))))
+
+(define-public fftw-openmpi
+  (package (inherit fftw)
+    (name "fftw-openmpi")
+    (inputs
+     `(("openmpi" ,openmpi)
+       ,@(package-inputs fftw)))
+    (arguments
+     (substitute-keyword-arguments (package-arguments fftw)
+       ((#:configure-flags cf)
+        `(cons "--enable-mpi" ,cf))))
+    (description
+     (string-append (package-description fftw)
+                    "  With OpenMPI parallelism support."))))

gnu/packages/autotools.scm

@@ -74,6 +74,20 @@ know anything about Autoconf or M4.")
        (base32
         "1fjm21k2na07f3vasf288a0zx66lbv0hd3l9bvv3q8p62s3pg569"))))))
 
+(define-public autoconf-2.64
+  ;; As of GDB 7.8, GDB is still developed using this version of Autoconf.
+  (package (inherit autoconf)
+    (version "2.64")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://gnu/autoconf/autoconf-"
+                          version ".tar.xz"))
+      (sha256
+       (base32
+        "0j3jdjpf5ly39dlp0bg70h72nzqr059k0x8iqxvaxf106chpgn9j"))))))
+
+
 (define* (autoconf-wrapper #:optional (autoconf autoconf))
   "Return an wrapper around AUTOCONF that generates `configure' scripts that
 use our own Bash instead of /bin/sh in shebangs.  For that reason, it should

gnu/packages/backup.scm

@@ -0,0 +1,71 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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 backup)
+  #:use-module (guix packages)
+  #:use-module (guix licenses)
+  #:use-module (guix download)
+  #:use-module (guix build-system python)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages rsync)
+  #:use-module (srfi srfi-1))
+
+(define-public duplicity
+  (package
+    (name "duplicity")
+    (version "0.6.24")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "https://code.launchpad.net/duplicity/"
+                          (string-join (take (string-split version #\.) 2) ".")
+                          "-series/" version "/+download/duplicity-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "0l14nrhbgkyjgvh339bbhnm6hrdwrjadphq1jmpi0mcgcdbdfh8x"))))
+    (build-system python-build-system)
+    (native-inputs
+     `(("python2-setuptools" ,python2-setuptools)))
+    (inputs
+     `(("python" ,python-2)
+       ("librsync" ,librsync)
+       ("mock" ,python2-mock)           ;for testing
+       ("lockfile" ,python2-lockfile)
+       ("gnupg" ,gnupg-1)))             ;gpg executable needed
+    (arguments
+     `(#:python ,python-2               ;setup assumes Python 2
+       #:test-target "test"
+       #:phases (alist-cons-before
+                 'check 'patch-tests
+                 (lambda _
+                   (substitute* "testing/functional/__init__.py"
+                     (("/bin/sh") (which "sh"))))
+                 %standard-phases)))
+    (home-page "http://duplicity.nongnu.org/index.html")
+    (synopsis "Encrypted backup using rsync algorithm")
+    (description
+     "Duplicity backs up directories by producing encrypted tar-format volumes
+and uploading them to a remote or local file server.  Because duplicity uses
+librsync, the incremental archives are space efficient and only record the
+parts of files that have changed since the last backup.  Because duplicity
+uses GnuPG to encrypt and/or sign these archives, they will be safe from
+spying and/or modification by the server.")
+    (license gpl2+)))

gnu/packages/base.scm

@@ -1184,4 +1184,7 @@ and binaries, plus debugging symbols in the 'debug' output), and Binutils.")
 (define-public gcc-toolchain-4.8
   (gcc-toolchain gcc-final))
 
+(define-public gcc-toolchain-4.9
+  (gcc-toolchain gcc-4.9))
+
 ;;; base.scm ends here

gnu/packages/bittorrent.scm

@@ -0,0 +1,91 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 bittorrent)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module ((guix licenses)
+                #:renamer (symbol-prefix-proc 'l:))
+  #:use-module (gnu packages openssl)
+  #:use-module (gnu packages libevent)
+  #:use-module (gnu packages curl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages file)
+  #:use-module (gnu packages linux)
+  #:use-module ((gnu packages compression)
+                #:select (zlib))
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gtk))
+
+(define-public transmission
+  (package
+    (name "transmission")
+    (version "2.83")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://transmission.cachefly.net/transmission-"
+                    version ".tar.xz"))
+              (sha256
+               (base32
+                "0cqlgl6jmjw1caybz6nzh3l8z0jak1dxba01isv72zvy2r8b1qdh"))))
+    (build-system gnu-build-system)
+    (outputs '("out"                      ; library and command-line interface
+               "gui"))                    ; graphical user interface
+    (arguments
+     '(#:phases (alist-cons-after
+                 'install 'move-gui
+                 (lambda* (#:key outputs #:allow-other-keys)
+                   ;; Move the GUI to its own output, so that "out" doesn't
+                   ;; depend on GTK+.
+                   (let ((out (assoc-ref outputs "out"))
+                         (gui (assoc-ref outputs "gui")))
+                     (mkdir-p (string-append gui "/bin"))
+                     (rename-file (string-append out "/bin/transmission-gtk")
+                                  (string-append gui
+                                                 "/bin/transmission-gtk"))))
+                 %standard-phases)))
+    (inputs
+     `(("inotify-tools" ,inotify-tools)
+       ("libevent" ,libevent)
+       ("curl" ,curl)
+       ("openssl" ,openssl)
+       ("file" ,file)
+       ("zlib" ,zlib)
+       ("gtk+" ,gtk+)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "http://www.transmissionbt.com/")
+    (synopsis "Fast and easy BitTorrent client")
+    (description
+     "Transmission is a BitTorrent client that comes with graphical,
+textual, and Web user interfaces.  Transmission also has a daemon for
+unattended operationg.  It supports local peer discovery, full encryption,
+DHT, µTP, PEX and Magnet Links.")
+
+    ;; COPYING reads:
+    ;;
+    ;;     Transmission can be redistributed and/or modified under the terms of
+    ;; the GNU GPLv2 (http://www.gnu.org/licenses/license-list.html#GPLv2),
+    ;; the GNU GPLv3 (http://www.gnu.org/licenses/license-list.html#GNUGPLv3),
+    ;; or any future license endorsed by Mnemosyne LLC.
+    ;;
+    ;; A few files files carry an MIT/X11 license header.
+    (license l:gpl3+)))

gnu/packages/calcurse.scm

@@ -16,7 +16,7 @@
 ;;; 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 autogen)
+(define-module (gnu packages calcurse)
   #:use-module (guix packages)
   #:use-module (guix licenses)
   #:use-module (guix download)

gnu/packages/ccache.scm

@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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 ccache)
+  #:use-module (guix packages)
+  #:use-module ((guix licenses) #:select (gpl3+))
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages compression))
+
+(define-public ccache
+  (package
+    (name "ccache")
+    (version "3.1.9")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "https://www.samba.org/ftp/ccache/ccache-"
+                          version ".tar.xz"))
+      (sha256
+       (base32
+        "1i06015jjc0n55xgvhv2h37fjp0i7z8a10s0v40f87c5mprzv0a9"))
+      (patches (list (search-patch "ccache-stdc-predef-test.patch")))))
+    (build-system gnu-build-system)
+    (native-inputs `(("perl" ,perl)))   ;for test.sh
+    (inputs `(("zlib" ,zlib)))
+    (arguments
+     '(#:phases (alist-cons-before
+                 'check 'patch-test-shebangs
+                 (lambda _
+                   (substitute* '("test/test_hashutil.c" "test.sh")
+                     (("#!/bin/sh") (string-append "#!" (which "sh")))))
+                 %standard-phases)))
+    (home-page "https://ccache.samba.org/")
+    (synopsis "Compiler cache")
+    (description
+     "Ccache is a compiler cache.  It speeds up recompilation by caching
+previous compilations and detecting when the same compilation is being done
+again.  Supported languages are C, C++, Objective-C and Objective-C++.")
+    (license gpl3+)))

gnu/packages/compression.scm

@@ -238,6 +238,29 @@ LZO is written in ANSI C.  Both the source code and the compressed data
 format are designed to be portable across platforms.")
     (license license:gpl2+)))
 
+(define-public lzop
+  (package
+    (name "lzop")
+    (version "1.03")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://www.lzop.org/download/lzop-"
+                           version ".tar.gz"))
+       (sha256
+        (base32
+         "1jdjvc4yjndf7ihmlcsyln2rbnbaxa86q4jskmkmm7ylfy65nhn1"))))
+    (build-system gnu-build-system)
+    (inputs `(("lzo" ,lzo)))
+    (home-page "http://www.lzop.org/")
+    (synopsis "Compress or expand files")
+    (description
+     "Lzop is a file compressor which is very similar to gzip.  Lzop uses the
+LZO data compression library for compression services, and its main advantages
+over gzip are much higher compression and decompression speed (at the cost of
+some compression ratio).")
+    (license license:gpl2+)))
+
 (define-public lzip
   (package
     (name "lzip")

gnu/packages/cyrus-sasl.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -34,8 +34,12 @@
    (version "2.1.26")
    (source (origin
             (method url-fetch)
-            (uri (string-append "ftp://ftp.cyrusimap.org/cyrus-sasl/cyrus-sasl-" version
+            (uri (list (string-append
-                                ".tar.gz"))
+                        "http://cyrusimap.org/releases/cyrus-sasl-"
+                        version ".tar.gz")
+                       (string-append
+                        "ftp://ftp.cyrusimap.org/cyrus-sasl/cyrus-sasl-"
+                        version ".tar.gz")))
             (sha256 (base32
                      "1hvvbcsg21nlncbgs0cgn3iwlnb3vannzwsp6rwvnn9ba4v53g4g"))))
    (build-system gnu-build-system)

gnu/packages/doxygen.scm

@@ -0,0 +1,74 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 doxygen)
+  #:use-module ((guix licenses) #:select (gpl3+))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages flex)
+  #:use-module (gnu packages graphviz)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages python))
+
+(define-public doxygen
+  (package
+    (name "doxygen")
+    (version "1.8.7")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://ftp.stack.nl/pub/users/dimitri/"
+                                 name "-" version ".src.tar.gz"))
+             (sha256
+              (base32
+               "1ng3dv5fninhfi2fj75ghkr5jwsl653fxv2sxhaswj11x2vcdsn6"))
+             (patches (list (search-patch "doxygen-tmake.patch")
+                            (search-patch "doxygen-test.patch")))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("bison" ,bison)
+       ("flex" ,flex)
+       ("libxml2" ,libxml2) ; provides xmllint for the tests
+       ("perl" ,perl) ; for the tests
+       ("python" ,python-2))) ; for creating the documentation
+    (propagated-inputs
+     `(("graphviz" ,graphviz)))
+    (arguments
+     `(#:test-target "test"
+       #:phases
+         (alist-replace
+          'configure
+          (lambda* (#:key outputs #:allow-other-keys)
+            (let ((out (assoc-ref outputs "out")))
+              ;; do not pass "--enable-fast-install", which makes the
+              ;; configure process fail
+              (zero? (system*
+                      "./configure"
+                      "--prefix" out))))
+          %standard-phases)))
+    (home-page "http://www.stack.nl/~dimitri/doxygen/")
+    (synopsis "tool for generating documentation from annotated sources")
+    (description "Doxygen is the de facto standard tool for generating
+documentation from annotated C++ sources, but it also supports other popular
+programming languages such as C, Objective-C, C#, PHP, Java, Python,
+IDL (Corba, Microsoft, and UNO/OpenOffice flavors), Fortran, VHDL, Tcl,
+and to some extent D.")
+    (license gpl3+)))

gnu/packages/ftp.scm

@@ -0,0 +1,56 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 ftp)
+  #:use-module ((guix licenses) #:select (gpl3+))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages ncurses)
+  #:use-module (gnu packages readline)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages gnutls)
+  #:use-module (gnu packages compression))
+
+(define-public lftp
+  (package
+    (name "lftp")
+    (version "4.4.15")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "http://lftp.yar.ru/ftp/lftp-"
+                                  version ".tar.xz"))
+              (sha256
+               (base32
+                "0s38vc2ij869dwx3i1c7sk96mqv0hknf3cqf86av59rqnix0px3m"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (inputs
+     `(("zlib" ,zlib)
+       ("readline" ,readline)
+       ("gnutls" ,gnutls)))
+    (home-page "http://lftp.yar.ru/")
+    (synopsis "Command-line file transfer program")
+    (description
+     "LFTP is a sophisticated FTP/HTTP client, and a file transfer program
+supporting a number of network protocols.  Like Bash, it has job control and
+uses the Readline library for input.  It has bookmarks, a built-in mirror
+command, and can transfer several files in parallel.  It was designed with
+reliability in mind.")
+    (license gpl3+)))

gnu/packages/games.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 John Darrington <jmd@gnu.org>
+;;; Copyright © 2014 David Thompson <dthompson2@worcester.edu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +33,7 @@
   #:use-module (gnu packages xorg)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages sqlite)
+  #:use-module (gnu packages sdl)
   #:use-module (guix build-system gnu))
 
 (define-public gnubg
@@ -94,3 +96,65 @@ you to set the size of the cube (the default is 3x3) or to change the colors.
  You may even apply photos to the faces instead of colors.  The game is
 scriptable with Guile.")
     (license gpl3+)))
+
+(define-public abbaye
+  (package
+    (name "abbaye")
+    (version "1.13")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://abbaye-for-linux.googlecode.com/files/abbaye-for-linux-src-"
+                           version ".tar.gz"))
+       (sha256
+        (base32
+         "1wgvckgqa2084rbskxif58wbb83xbas8s1i8s7d57xbj08ryq8rk"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:modules ((ice-9 match)
+                  (guix build gnu-build-system)
+                  (guix build utils))
+       #:phases (alist-cons-after
+                 'set-paths 'set-sdl-paths
+                 (lambda* (#:key inputs outputs (search-paths '()) #:allow-other-keys)
+                   (define input-directories
+                     (match inputs
+                       (((_ . dir) ...)
+                        dir)))
+                   ;; This package does not use pkg-config, so modify CPATH
+                   ;; variable to point to include/SDL for SDL header files.
+                   (set-path-environment-variable "CPATH"
+                                                  '("include/SDL")
+                                                  input-directories))
+                 (alist-cons-after
+                  'patch-source-shebangs 'patch-makefile
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    ;; Replace /usr with package output directory.
+                    (for-each (lambda (file)
+                                (substitute* file
+                                  (("/usr") (assoc-ref outputs "out"))))
+                              '("makefile" "src/pantallas.c" "src/comun.h")))
+                  (alist-cons-before
+                   'install 'make-install-dirs
+                   (lambda* (#:key outputs #:allow-other-keys)
+                     (let ((prefix (assoc-ref outputs "out")))
+                       ;; Create directories that the makefile assumes exist.
+                       (mkdir-p (string-append prefix "/bin"))
+                       (mkdir-p (string-append prefix "/share/applications"))))
+                   ;; No configure script.
+                   (alist-delete 'configure %standard-phases))))
+       #:tests? #f)) ;; No check target.
+    (native-inputs `(("pkg-config" ,pkg-config)))
+    (inputs `(("sdl" ,sdl)
+              ("sdl-gfx" ,sdl-gfx)
+              ("sdl-image" ,sdl-image)
+              ("sdl-mixer" ,sdl-mixer)
+              ("sdl-ttf" ,sdl-ttf)))
+    (home-page "http://code.google.com/p/abbaye-for-linux/")
+    (synopsis "GNU/Linux port of the indie game \"l'Abbaye des Morts\"")
+    (description "L'Abbaye des Morts is a 2D platform game set in 13th century
+France.  The Cathars, who preach about good Christian beliefs, were being
+expelled by the Catholic Church out of the Languedoc region in France.  One of
+them, called Jean Raymond, found an old church in which to hide, not knowing
+that beneath its ruins lay buried an ancient evil.")
+    (license gpl3+)))

gnu/packages/gcc.scm

@@ -227,6 +227,17 @@ Go.  It also includes runtime support libraries for these languages.")
               (base32
                "1j6dwgby4g3p3lz7zkss32ghr45zpdidrg8xvazvn91lqxv25p09"))))))
 
+(define-public gcc-4.9
+  (package (inherit gcc-4.7)
+    (version "4.9.0")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/gcc/gcc-"
+                                 version "/gcc-" version ".tar.bz2"))
+             (sha256
+              (base32
+               "0mqjxpw2klskls00lwx1k24pnyzm3whqxg3hk74c3sddgfllgc5r"))))))
+
 (define (custom-gcc gcc name languages)
   "Return a custom version of GCC that supports LANGUAGES."
   (package (inherit gcc)

gnu/packages/gdb.scm

@@ -33,14 +33,14 @@
 (define-public gdb
   (package
     (name "gdb")
-    (version "7.7")
+    (version "7.7.1")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/gdb/gdb-"
                                  version ".tar.bz2"))
              (sha256
               (base32
-               "08vcb97j1b7vxwq6088wb6s3g3bm8iwikd922y0xsgbbxv3d2104"))))
+               "199sn1p0gzli6icp9dcvrphdvyi7hm4cc9zhziq0q6vg81h55g8d"))))
     (build-system gnu-build-system)
     (arguments
      '(#:tests? #f ; FIXME "make check" fails on single-processor systems.
@@ -57,7 +57,11 @@
        ("readline" ,readline)
        ("ncurses" ,ncurses)
        ("python" ,python-wrapper)
-       ("dejagnu" ,dejagnu)))
+       ("dejagnu" ,dejagnu)
+
+       ;; Allow use of XML-formatted syscall information.  This enables 'catch
+       ;; syscall' and similar commands.
+       ("libxml2" ,libxml2)))
     (native-inputs
       `(("texinfo" ,texinfo)))
     (home-page "http://www.gnu.org/software/gdb/")

gnu/packages/gimp.scm

@@ -0,0 +1,63 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 gimp)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module ((guix licenses)
+                #:renamer (symbol-prefix-proc 'license:))
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gtk)
+  #:use-module (gnu packages gnome)
+  #:use-module (gnu packages libpng)
+  #:use-module (gnu packages libjpeg)
+  #:use-module ((gnu packages ghostscript)
+                #:select (lcms))
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages photo)
+  #:use-module (gnu packages xorg)
+  #:use-module (gnu packages imagemagick))
+
+(define-public babl
+  (package
+    (name "babl")
+    (version "0.1.10")
+    (source (origin
+              (method url-fetch)
+              (uri (list (string-append "http://ftp.gtk.org/pub/babl/0.1/babl-"
+                                        version ".tar.bz2")
+                         (string-append "ftp://ftp.gtk.org/pub/babl/0.1/babl-"
+                                        version ".tar.bz2")))
+              (sha256
+               (base32
+                "1x2mb7zfbvk9d0a7h5cpdff9hhjsadxvqml2jay2bpf7x9nc6gwl"))))
+    (build-system gnu-build-system)
+    (home-page "http://gegl.org/babl/")
+    (synopsis "Image pixel format conversion library")
+    (description
+     "babl is a dynamic, any to any, pixel format translation library.
+It allows converting between different methods of storing pixels known as
+pixel formats that have with different bitdepths and other data
+representations, color models and component permutations.
+
+A vocabulary to formulate new pixel formats from existing primitives is
+provided as well as the framework to add new color models and data types.")
+    (license license:lgpl3+)))

gnu/packages/glib.scm

@@ -160,6 +160,17 @@ shared NFS home directories.")
       ;; In 'gio/tests', 'gdbus-test-codegen-generated.h' is #included in a
       ;; file that gets compiled possibly before it has been fully generated.
       #:parallel-tests? #f))
+
+   (native-search-paths
+    ;; This variable is not really "owned" by GLib, but several related
+    ;; packages refer to it: gobject-introspection's tools use it as a search
+    ;; path for .gir files, and it's also a search path for schemas produced
+    ;; by 'glib-compile-schemas'.
+    (list (search-path-specification
+           (variable "XDG_DATA_DIRS")
+           (directories '("share")))))
+   (search-paths native-search-paths)
+
    (synopsis "Thread-safe general utility library; basis of GTK+ and GNOME")
    (description
     "GLib provides data structure handling for C, portability wrappers,

gnu/packages/gnome.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,25 +18,31 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages gnome)
-  #:use-module ((guix licenses) #:select (gpl2 gpl2+ lgpl2.0+ lgpl2.1+ lgpl3))
+  #: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 bison)
+  #:use-module (gnu packages flex)  
   #:use-module (gnu packages glib)
   #:use-module (gnu packages gnupg)
   #:use-module (gnu packages gstreamer)
   #:use-module (gnu packages gtk)
   #:use-module (gnu packages pdf)
+  #:use-module (gnu packages popt)
   #:use-module (gnu packages ghostscript)
   #:use-module (gnu packages iso-codes)
   #:use-module (gnu packages libcanberra)
+  #:use-module (gnu packages libjpeg)
   #:use-module (gnu packages libpng)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python)
   #:use-module (gnu packages xml)
   #:use-module (gnu packages gl)
+  #:use-module (gnu packages compression)
   #:use-module (gnu packages xorg))
 
 (define-public brasero
@@ -75,7 +82,7 @@
     (description "Brasero is an application to burn CD/DVD for the Gnome
 Desktop.  It is designed to be as simple as possible and has some unique
 features to enable users to create their discs easily and quickly.")
-    (license gpl2+)))
+    (license license:gpl2+)))
 
 (define-public gnome-desktop
   (package
@@ -116,7 +123,7 @@ stability. Documentation for the API is available with gtk-doc.
 
 The gnome-about program helps find which version of GNOME is installed.")
     ; Some bits under the LGPL.
-    (license gpl2+)))
+    (license license:gpl2+)))
 
 (define-public gnome-doc-utils
   (package
@@ -146,7 +153,7 @@ The gnome-about program helps find which version of GNOME is installed.")
      "Gnome-doc-utils is a collection of documentation utilities for the
 Gnome project.  It includes xml2po tool which makes it easier to translate
 and keep up to date translations of documentation.")
-    (license gpl2+))) ; xslt under lgpl
+    (license license:gpl2+))) ; xslt under lgpl
 
 (define-public libgnome-keyring
   (package
@@ -177,7 +184,7 @@ and keep up to date translations of documentation.")
      "Client library to access passwords from the GNOME keyring.")
 
     ;; Though a couple of files are LGPLv2.1+.
-    (license lgpl2.0+)))
+    (license license:lgpl2.0+)))
 
 (define-public evince
   (package
@@ -242,7 +249,7 @@ and keep up to date translations of documentation.")
 currently supports PDF, PostScript, DjVu, TIFF and DVI.  The goal
 of Evince is to replace the multiple document viewers that exist
 on the GNOME Desktop with a single simple application.")
-    (license gpl2+)))
+    (license license:gpl2+)))
 
 (define-public gsettings-desktop-schemas
   (package
@@ -269,7 +276,7 @@ on the GNOME Desktop with a single simple application.")
     (description
      "Gsettings-desktop-schemas contains a collection of GSettings schemas
 for settings shared by various components of the GNOME desktop.")
-    (license lgpl2.1+)))
+    (license license:lgpl2.1+)))
 
 (define-public icon-naming-utils
   (package
@@ -294,7 +301,7 @@ for settings shared by various components of the GNOME desktop.")
      "To help with the transition to the Freedesktop Icon Naming
 Specification, the icon naming utility maps the icon names used by the
 GNOME and KDE desktops to the icon names proposed in the specification.")
-    (license lgpl2.1+)))
+    (license license:lgpl2.1+)))
 
 (define-public gnome-icon-theme
   (package
@@ -321,7 +328,7 @@ GNOME and KDE desktops to the icon names proposed in the specification.")
      "GNOME icon theme")
     (description
      "Icons for the GNOME desktop.")
-    (license lgpl3))) ; or Creative Commons BY-SA 3.0
+    (license license:lgpl3))) ; or Creative Commons BY-SA 3.0
 
 (define-public shared-mime-info
   (package
@@ -352,7 +359,7 @@ and the update-mime-database command used to extend it.  It requires glib2 to
 be installed for building the update command.  Additionally, it uses intltool
 for translations, though this is only a dependency for the maintainers.  This
 database is translated at Transifex.")
-    (license gpl2+)))
+    (license license:gpl2+)))
 
 (define-public hicolor-icon-theme
   (package
@@ -374,7 +381,7 @@ database is translated at Transifex.")
      "Freedesktop icon theme")
     (description
      "Freedesktop icon theme.")
-    (license gpl2)))
+    (license license:gpl2)))
 
 (define-public libnotify
   (package
@@ -405,7 +412,7 @@ database is translated at Transifex.")
 notification daemon, as defined in the Desktop Notifications spec. These
 notifications can be used to inform the user about an event or display
 some form of information without getting in the user's way.")
-    (license lgpl2.1+)))
+    (license license:lgpl2.1+)))
 
 (define-public libpeas
   (package
@@ -421,45 +428,16 @@ some form of information without getting in the user's way.")
        (base32
         "13fzyzv6c0cfdj83z1s16lv8k997wpnzyzr0wfwcfkcmvz64g1q0"))))
     (build-system gnu-build-system)
-    (arguments
-     `(#:modules ((guix build gnome)
-                  (guix build gnu-build-system)
-                  (guix build utils))
-       #:imported-modules ((guix build gnome)
-                           (guix build gnu-build-system)
-                           (guix build utils))
-       #:phases
-        (alist-replace
-         'configure
-         (lambda* (#:key inputs #:allow-other-keys #:rest args)
-          (let ((configure (assoc-ref %standard-phases 'configure)))
-           (substitute* "libpeas-gtk/Makefile.in"
-            (("--add-include-path")
-             (string-append
-               " --add-include-path=" (gir-directory inputs "atk")
-               " --add-include-path=" (gir-directory inputs "gdk-pixbuf")
-               " --add-include-path=" (gir-directory inputs "gtk+")
-               " --add-include-path=" (gir-directory inputs "pango")
-               " --add-include-path")))
-           (substitute* "libpeas-gtk/Makefile.in"
-            (("--includedir=\\$\\(top_builddir")
-             (string-append
-              " --includedir=" (gir-directory inputs "atk")
-              " --includedir=" (gir-directory inputs "gdk-pixbuf")
-              " --includedir=" (gir-directory inputs "gtk+")
-              " --includedir=" (gir-directory inputs "pango")
-              " --includedir=$(top_builddir")))
-           (apply configure args)))
-         %standard-phases)))
     (inputs
      `(("atk" ,atk)
        ("gdk-pixbuf" ,gdk-pixbuf)
        ("glib" ,glib)
-       ("gobject-introspection" ,gobject-introspection)
        ("gtk+" ,gtk+)
-       ("intltool" ,intltool)
+       ("pango" ,pango)))
-       ("pango" ,pango)
+    (native-inputs
-       ("pkg-config" ,pkg-config)))
+     `(("pkg-config" ,pkg-config)
+       ("gobject-introspection" ,gobject-introspection)
+       ("intltool" ,intltool)))
     (home-page "https://wiki.gnome.org/Libpeas")
     (synopsis "GObject plugin system")
     (description
@@ -469,7 +447,7 @@ set of features including, but not limited to: multiple extension points; on
 demand (lazy) programming language support for C, Python and JS; simplicity of
 the API")
 
-    (license lgpl2.0+)))
+    (license license:lgpl2.0+)))
 
 (define-public gtkglext
   (package
@@ -495,7 +473,7 @@ the API")
     (description "GtkGLExt is an OpenGL extension to GTK+. It provides
 additional GDK objects which support OpenGL rendering in GTK+ and GtkWidget
 API add-ons to make GTK+ widgets OpenGL-capable.")
-    (license lgpl2.1+)))
+    (license license:lgpl2.1+)))
 
 (define-public glade3
   (package
@@ -522,4 +500,593 @@ API add-ons to make GTK+ widgets OpenGL-capable.")
     (description "Glade is a rapid application development (RAD) tool to
 enable quick & easy development of user interfaces for the GTK+ toolkit and
 the GNOME desktop environment.")
-    (license lgpl2.0+)))
+    (license license:lgpl2.0+)))
+
+(define-public libcroco
+  (package
+    (name "libcroco")
+    (version "0.6.8")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/libcroco/0.6/libcroco-"
+                    version
+                    ".tar.xz"))
+              (sha256
+               (base32
+                "0w453f3nnkbkrly7spx5lx5pf6mwynzmd5qhszprq8amij2invpa"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (inputs
+     `(("glib" ,glib)
+       ("libxml2" ,libxml2)
+       ("zlib" ,zlib)))
+    (home-page "https://github.com/GNOME/libcroco")
+    (synopsis "CSS2 parsing and manipulation library")
+    (description
+     "Libcroco is a standalone CSS2 parsing and manipulation library.
+The parser provides a low level event driven SAC-like API and a CSS object
+model like API.  Libcroco provides a CSS2 selection engine and an experimental
+XML/CSS rendering engine.")
+
+    ;; LGPLv2.1-only.
+    (license license:lgpl2.1)))
+
+(define-public libgsf
+  (package
+    (name "libgsf")
+    (version "1.14.30")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://gnome/sources/libgsf/1.14/libgsf-"
+                                  version ".tar.xz"))
+              (sha256
+               (base32
+                "0w2v1a9sxsymd1mcy4mwsz4r6za9iwq69rj86nb939p41d4c6j6b"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("python" ,python)
+       ("zlib" ,zlib)
+       ("bzip2" ,bzip2)))
+    (propagated-inputs
+     `(("gdk-pixbuf" ,gdk-pixbuf)
+       ("glib" ,glib)
+       ("libxml2" ,libxml2)))
+    (home-page "http://www.gnome.org/projects/libgsf")
+    (synopsis "GNOME's Structured File Library")
+    (description
+     "Libgsf aims to provide an efficient extensible I/O abstraction for
+dealing with different structured file formats.")
+
+    ;; LGPLv2.1-only.
+    (license license:lgpl2.1)))
+
+(define-public librsvg
+  (package
+    (name "librsvg")
+    (version "2.40.2")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/librsvg/2.40/librsvg-"
+                    version ".tar.xz"))
+              (sha256
+               (base32
+                "071959yjb2i1bja7ciy4bmpnd6fn2is9jjqsvvvnsqwl69j9n128"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (alist-cons-before
+        'configure 'augment-gir-search-path
+        (lambda* (#:key inputs #:allow-other-keys)
+          (substitute* "gdk-pixbuf-loader/Makefile.in"
+            ;; By default the gdk-pixbuf loader is installed under
+            ;; gdk-pixbuf's prefix.  Work around that.
+            (("gdk_pixbuf_moduledir = .*$")
+             (string-append "gdk_pixbuf_moduledir = "
+                            "$(prefix)/lib/gdk-pixbuf-2.0/2.0.10/"
+                             "loaders\n"))
+            ;; Likewise, create a separate 'loaders.cache' file.
+            (("gdk_pixbuf_cache_file = .*$")
+             "gdk_pixbuf_cache_file = $(gdk_pixbuf_moduledir).cache\n")))
+        %standard-phases)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("gobject-introspection" ,gobject-introspection))) ; g-ir-compiler, etc.
+    (inputs
+     `(("pango" ,pango)
+       ("libcroco" ,libcroco)
+       ("bzip2" ,bzip2)
+       ("libgsf" ,libgsf)
+       ("libxml2" ,libxml2)))
+    (propagated-inputs
+     ;; librsvg-2.0.pc refers to all of that.
+     `(("cairo" ,cairo)
+       ("gdk-pixbuf" ,gdk-pixbuf)
+       ("glib" ,glib)))
+    (home-page "https://wiki.gnome.org/LibRsvg")
+    (synopsis "Render SVG files using Cairo")
+    (description
+     "librsvg is a C library to render SVG files using the Cairo 2D graphics
+library.")
+    (license license:lgpl2.0+)))
+
+(define-public libidl
+  (package
+    (name "libidl")
+    (version "0.8.14")
+    (source (origin
+              (method url-fetch)
+              (uri (let ((upstream-name "libIDL"))
+		     (string-append
+		      "mirror://gnome/sources/" upstream-name "/" (string-take version 3) "/" upstream-name "-"
+		      version
+		      ".tar.bz2")))
+              (sha256
+               (base32
+                "08129my8s9fbrk0vqvnmx6ph4nid744g5vbwphzkaik51664vln5"))))
+    (build-system gnu-build-system)
+    (inputs `(("glib" ,glib)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("flex", flex)
+       ("bison" ,bison)))
+    (home-page "http://freecode.com/projects/libidl")
+    (synopsis "Create trees of CORBA Interface Definition Language files")
+    (description  "libidl is a library for creating trees of CORBA Interface
+Definition Language (idl) files, which is a specification for defining
+portable interfaces. libidl was initially written for orbit (the orb from the
+GNOME project, and the primary means of libidl distribution). However, the
+functionality was designed to be as reusable and portable as possible.") 
+    (license license:lgpl2.0+)))
+
+
+(define-public orbit2
+  (package
+    (name "orbit2")
+    (version "2.14.19")
+    (source (origin
+              (method url-fetch)
+              (uri (let ((upstream-name "ORBit2")) 
+		     (string-append
+		      "mirror://gnome/sources/" upstream-name "/" (string-take version 4) "/" upstream-name "-"
+		      version
+		      ".tar.bz2")))
+              (sha256
+               (base32 "0l3mhpyym9m5iz09fz0rgiqxl2ym6kpkwpsp1xrr4aa80nlh1jam"))))
+    (build-system gnu-build-system)
+    (arguments
+     ;; The programmer kindly gives us a hook to turn off deprecation warnings ...
+     `(#:configure-flags '("DISABLE_DEPRECATED_CFLAGS=-DGLIB_DISABLE_DEPRECATION_WARNINGS")
+                         ;; ... which they then completly ignore !!
+                         #:phases
+                         (alist-cons-before
+                          'configure 'ignore-deprecations
+                          (lambda _
+                            (substitute* "linc2/src/Makefile.in"
+                              (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS")))
+                          %standard-phases)))
+    (inputs `(("glib" ,glib)
+              ("libidl" ,libidl)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://projects.gnome.org/orbit2/")
+    (synopsis "CORBA 2.4-compliant Object Request Broker")
+    (description  "orbit2 is a CORBA 2.4-compliant Object Request Broker (orb)
+featuring mature C, C++ and Python bindings.") 
+    ;; Licence notice is unclear.  The Web page simply say "GPL" without giving a version.
+    ;; SOME of the code files have licence notices for GPLv2+
+    ;; The tarball contains files of the text of GPLv2 and LGPLv2
+    (license license:gpl2+))) 
+
+
+(define-public libbonobo
+  (package
+    (name "libbonobo")
+    (version "2.32.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 4) "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32 "0swp4kk6x7hy1rvd1f9jba31lvfc6qvafkvbpg9h0r34fzrd8q4i"))))
+    (build-system gnu-build-system)
+    (arguments
+     ;; The programmer kindly gives us a hook to turn off deprecation warnings ...
+     `(#:configure-flags '("DISABLE_DEPRECATED_CFLAGS=-DGLIB_DISABLE_DEPRECATION_WARNINGS")
+                         ;; ... which they then completly ignore !!
+                         #:phases
+                         (alist-cons-before
+                          'configure 'ignore-deprecations
+                          (lambda _
+                            (substitute* "activation-server/Makefile.in"
+                              (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS")))
+                          %standard-phases)))
+    (inputs `(("popt" ,popt)
+              ("libxml2" ,libxml2)))
+    ;; The following are Required by the .pc file
+    (propagated-inputs  
+     `(("glib" ,glib)
+       ("orbit2" ,orbit2)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)
+       ("flex" ,flex)
+       ("bison" ,bison)))
+    (home-page "https://developer.gnome.org/libbonobo/")
+    (synopsis "Framework for creating reusable components for use in GNOME applications")
+    (description "Bonobo is a framework for creating reusable components for
+use in GNOME applications, built on top of CORBA.") 
+    ;; Licence not explicitly stated.  Source files contain no licence notices.
+    ;; Tarball contains text of both GPLv2 and LGPLv2
+    ;; GPLv2 covers both conditions
+    (license license:gpl2+)))
+
+
+(define-public gconf
+  (package
+    (name "gconf")
+    (version "3.2.6")
+    (source (origin
+              (method url-fetch)
+	      (uri 
+	       (let ((upstream-name "GConf"))
+		 (string-append
+		  "mirror://gnome/sources/" upstream-name "/" (string-take version 3)  "/" upstream-name "-"
+		  version
+		  ".tar.xz")))
+              (sha256
+               (base32 "0k3q9nh53yhc9qxf1zaicz4sk8p3kzq4ndjdsgpaa2db0ccbj4hr"))))
+    (build-system gnu-build-system)
+    (inputs `(("glib" ,glib)
+              ("dbus" ,dbus)
+              ("dbus-glib" ,dbus-glib)
+              ("libxml2" ,libxml2)))
+    (propagated-inputs `(("orbit2" ,orbit2))) ; referred to in the .pc file
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://projects.gnome.org/gconf/")
+    (synopsis "store application preferences")
+    (description  "gconf is a system for storing application preferences. It
+is intended for user preferences; not arbitrary data storage.") 
+    (license license:lgpl2.0+))) 
+
+
+(define-public gnome-mime-data
+  (package
+    (name "gnome-mime-data")
+    (version "2.18.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 4)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "1mvg8glb2a40yilmyabmb7fkbzlqd3i3d31kbkabqnq86xdnn69p"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("perl" ,perl)
+       ("intltool" ,intltool)))
+    (home-page "http://www.gnome.org")
+    (synopsis "base MIME and Application database for GNOME")
+    (description  "GNOME Mime Data is a module which contains the base MIME
+and Application database for GNOME.  The data stored by this module is
+designed to be accessed through the MIME functions in GnomeVFS.")
+    (license license:gpl2+)))
+
+
+(define-public gnome-vfs
+  (package
+    (name "gnome-vfs")
+    (version "2.24.4")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 4)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32 "1ajg8jb8k3snxc7rrgczlh8daxkjidmcv3zr9w809sq4p2sn9pk2"))))
+    (build-system gnu-build-system)
+    (arguments
+     ;; The programmer kindly gives us a hook to turn off deprecation warnings ...
+     `(#:configure-flags '("DISABLE_DEPRECATED_CFLAGS=-DGLIB_DISABLE_DEPRECATION_WARNINGS")
+                         ;; ... which they then completly ignore !!
+                         #:phases
+                         (alist-cons-before
+                          'configure 'ignore-deprecations
+                          (lambda _
+                            (begin
+                              (substitute* "libgnomevfs/Makefile.in"
+                                (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS"))
+                              (substitute* "daemon/Makefile.in"
+                                (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS"))))
+                          %standard-phases)))
+    (inputs `(("glib" ,glib)
+              ("libxml2" ,libxml2)
+              ("dbus-glib" ,dbus-glib)
+              ("dbus" ,dbus)
+              ("gconf" ,gconf)
+              ("gnome-mime-data" ,gnome-mime-data)
+              ("zlib" ,zlib)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/gnome-vfs/")
+    (synopsis "access files and folders in GNOME applications")
+    (description  "GnomeVFS is the core library used to access files and
+folders in GNOME applications. It provides a file system abstraction which
+allows applications to access local and remote files with a single consistent API.")
+    (license license:lgpl2.0+)))
+
+
+
+(define-public libgnome
+  (package
+    (name "libgnome")
+    (version "2.32.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "197pnq8y0knqjhm2fg4j6hbqqm3qfzfnd0irhwxpk1b4hqb3kimj"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (alist-cons-before
+        'configure 'enable-deprecated
+        (lambda _ 
+          (substitute* "libgnome/Makefile.in"
+            (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS")))
+        %standard-phases)))
+    (inputs `(("popt" ,popt)
+              ("libxml2" ,libxml2)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    ;; The following are listed as Required in the .pc file
+    ;; (except for libcanberra -- which seems to be oversight on the part
+    ;; of the upstream developers -- anything that links against libgnome,
+    ;; must also link against libcanberra
+    (propagated-inputs
+     `(("libcanberra" ,libcanberra)
+       ("libbonobo" ,libbonobo)
+       ("gconf" ,gconf)
+       ("gnome-vfs" ,gnome-vfs)
+       ("glib" ,glib)))
+    (home-page "https://developer.gnome.org/libgnome/")
+    (synopsis "Useful routines for building applications")
+    (description  "The libgnome library provides a number of useful routines
+for building modern applications, including session management, activation of
+files and URIs, and displaying help.")
+    (license license:lgpl2.0+)))
+
+
+(define-public libart-lgpl
+  (package
+    (name "libart-lgpl")
+    (version "2.3.9")
+    (source (origin
+              (method url-fetch)
+              (uri (let ((upstream-name "libart_lgpl"))
+                     (string-append
+                      "mirror://gnome/sources/" upstream-name "/" 
+                      (string-take version 3) "/" upstream-name "-" version
+                      ".tar.bz2")))
+              (sha256
+               (base32
+                "072r4svs4hjf2f4gxzx02n3f970kdv9fpx54r2m8bd42fjyyawrw"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://people.gnome.org/~mathieu/libart")
+    (synopsis "2D drawing library")
+    (description  "Libart is a 2D drawing library intended as a 
+high-quality vector-based 2D library with antialiasing and alpha composition.")
+    (license license:lgpl2.0+)))
+
+
+
+(define-public libgnomecanvas
+  (package
+    (name "libgnomecanvas")
+    (version "2.30.3")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 4)  "/" name "-"
+                    version
+                    ".tar.gz"))
+              (sha256
+               (base32
+                "1nhnq4lfkk8ljkdafscwaggx0h95mq0rxnd7zgqyq0xb6kkqbjm8"))))
+    (build-system gnu-build-system)
+    ;; Mentioned as Required in the .pc file
+    (propagated-inputs `(("libart-lgpl" ,libart-lgpl)
+                         ("gtk+" ,gtk+-2)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/libgnomecanvas/")
+    (synopsis "Flexible widget for creating interactive structured graphics")
+    (description  "The GnomeCanvas widget provides a flexible widget for
+creating interactive structured graphics.")
+    (license license:lgpl2.0+)))
+
+(define-public libgnomeui
+  (package
+    (name "libgnomeui")
+    (version "2.24.5")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 4)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "03rwbli76crkjl6gp422wrc9lqpl174k56cp9i96b7l8jlj2yddf"))))
+    (build-system gnu-build-system)
+    ;; Mentioned as Required in the .pc file
+    (propagated-inputs `(("libgnome" ,libgnome)
+                         ("libgnome-keyring" ,libgnome-keyring)))
+    (inputs `(("libgnomecanvas" ,libgnomecanvas)
+              ("libbonoboui" ,libbonoboui)
+              ("libjpeg" ,libjpeg)
+              ("popt" ,popt)
+              ("libbonobo" ,libbonobo)
+              ("libxml2" ,libxml2)
+              ("libglade" ,libglade)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/libgnomeui/")
+    (synopsis "Additional widgets for applications")
+    (description  "The libgnomeui library provides additional widgets for
+applications. Many of the widgets from libgnomeui have already been ported to GTK+.")
+    (license license:lgpl2.0+)))
+
+(define-public libglade
+  (package
+    (name "libglade")
+    (version "2.6.4")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "1v2x2s04jry4gpabws92i0wq2ghd47yr5n9nhgnkd7c38xv1wdk4"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("gtk+-2" ,gtk+-2)
+       ("libxml2" ,libxml2)
+       ("python" ,python))) ;; needed for the optional libglade-convert program
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/libglade")
+    (synopsis "load glade interfaces and access the glade built widgets")
+    (description  "libglade is a library that provides interfaces for loading
+graphical interfaces described in glade files and for accessing the
+widgets built in the loading process.")
+    (license license:gpl2+))) ; This is correct.  GPL not LGPL
+
+(define-public libgnomeprint
+  (package
+    (name "libgnomeprint")
+    (version "2.8.2")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "129ka3nn8gx9dlfry17ib79azxk45wzfv5rgqzw6dwx2b5ns8phm"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("popt" ,popt)
+       ("libart-lgpl" ,libart-lgpl)
+       ("gtk+" ,gtk+-2)
+       ("libxml2" ,libxml2))) 
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://projects.gnome.org/gnome-print/home/faq.html")
+    (synopsis "printing framework for GNOME")
+    (description  "Gnome-print is a high-quality printing framework for GNOME.")
+    (license license:lgpl2.0+)))
+
+
+(define-public libgnomeprintui
+  (package
+    (name "libgnomeprintui")
+    (version "2.8.2")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "1ivipk7r61rg90p9kp889j28xlyyj6466ypvwa4jvnrcllnaajsw"))))
+    (build-system gnu-build-system)
+    ;; Mentioned as Required in the .pc file
+    (propagated-inputs `(("libgnomeprint" ,libgnomeprint)))
+    (inputs `(("gtk+" ,gtk+-2)
+              ("glib" ,glib)
+              ("gnome-icon-theme" ,gnome-icon-theme)
+              ("libgnomecanvas" ,libgnomecanvas)
+              ("libxml2" ,libxml2))) 
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://projects.gnome.org/gnome-print/home/faq.html")
+    (synopsis "Printing framework for GNOME")
+    (description  "Gnome-print is a high-quality printing framework for GNOME.")
+    (license license:lgpl2.0+)))
+
+
+(define-public libbonoboui
+  (package
+    (name "libbonoboui")
+    (version "2.24.5")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "1kbgqh7bw0fdx4f1a1aqwpff7gp5mwhbaz60c6c98bc4djng5dgs"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (alist-cons-before
+        'check 'start-xserver
+        (lambda* (#:key inputs #:allow-other-keys)
+          (let ((xorg-server (assoc-ref inputs "xorg-server"))
+                (disp ":1"))
+            
+            (setenv "HOME" (getcwd))
+            (setenv "DISPLAY" disp)
+            ;; There must be a running X server and make check doesn't start one.
+            ;; Therefore we must do it.
+            (zero? (system (format #f "~a/bin/Xvfb ~a &" xorg-server disp)))))
+        %standard-phases)))
+    ;; Mentioned as Required by the .pc file
+    (propagated-inputs `(("libxml2" ,libxml2)))
+    (inputs
+     `(("popt" ,popt)
+       ("pangox-compat" ,pangox-compat)
+       ("libgnome" ,libgnome)
+       ("libgnomecanvas" ,libgnomecanvas)
+       ("libglade" ,libglade)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("xorg-server" ,xorg-server) ; For running the tests
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/libbonoboui/")
+    (synopsis "Some user interface controls using Bonobo")
+    (description  "The Bonobo UI library provides a number of user interface
+controls using the Bonobo component framework.")
+    (license license:lgpl2.0+)))
+

gnu/packages/gnupg.scm

@@ -279,7 +279,7 @@ and every application benefits from this.")
                      "1g1jly3wl4ks6h8ydkygyl2c4i7v3z91rg42005m6vm70y1d8b3d"))))
    (build-system gnu-build-system)
    (inputs `(("perl" ,perl)
-             ("python" ,python-wrapper)
+             ("python" ,python-2)           ; uses the Python 2 'print' syntax
              ("gpg" ,gnupg)))
    (arguments
     `(#:tests? #f

gnu/packages/gtk.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,9 +53,10 @@
              (base32
               "1c2hbg66wfvibsz2ia0ri48yr62751fn950i97c53j3b0fjifsb3"))))
    (build-system gnu-build-system)
-   (inputs `(("glib" ,glib)
+   (inputs `(("glib" ,glib)))
-             ("gobject-introspection" ,gobject-introspection)))
+   (native-inputs
-   (native-inputs `(("pkg-config" ,pkg-config)))
+    `(("pkg-config" ,pkg-config)
+      ("gobject-introspection" ,gobject-introspection))) ; g-ir-compiler, etc.
    (synopsis "GNOME accessibility toolkit")
    (description
     "ATK provides the set of accessibility interfaces that are implemented
@@ -156,10 +157,10 @@ affine transformation (scale, rotation, shear, etc.)")
     `(("cairo" ,cairo)
       ("harfbuzz" ,harfbuzz)))
    (inputs
-    `(("gobject-introspection" ,gobject-introspection)
+    `(("zlib" ,zlib)))
-      ("zlib" ,zlib)))
    (native-inputs
-    `(("pkg-config" ,pkg-config)))
+    `(("pkg-config" ,pkg-config)
+      ("gobject-introspection" ,gobject-introspection))) ; g-ir-compiler, etc.
    (synopsis "GNOME text and font handling library")
    (description
     "Pango is the core text and font handling library used in GNOME
@@ -168,6 +169,33 @@ used throughout the world.")
    (license license:lgpl2.0+)
    (home-page "https://developer.gnome.org/pango/")))
 
+(define-public pangox-compat
+  (package
+    (name "pangox-compat")
+    (version "0.0.2")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append
+                   "mirror://gnome/sources/" name "/" (string-take version 3)  "/" name "-"
+                   version
+                   ".tar.xz"))
+             (sha256
+              (base32
+               "0ip0ziys6mrqqmz4n71ays0kf5cs1xflj1gfpvs4fgy2nsrr482m"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("glib" ,glib)
+       ("pango" ,pango)))
+    (native-inputs
+     `(("intltool" ,intltool)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://developer.gnome.org/pango")
+    (synopsis "functions now obsolete in pango")
+    (description  "Pangox was a X backend to pango.  It is now obsolete and no
+longer provided by recent pango releases.  pangox-compat provides the
+functions which were removed.")
+    (license license:lgpl2.0+)))
+
 
 (define-public gtksourceview
   (package
@@ -236,12 +264,12 @@ printing and other features typical of a source code editor.")
    (build-system gnu-build-system)
    (inputs
     `(("glib" ,glib)
-      ("gobject-introspection", gobject-introspection)
       ("libjpeg" ,libjpeg)
       ("libpng" ,libpng)
       ("libtiff" ,libtiff)))
    (native-inputs
-     `(("pkg-config" ,pkg-config)))
+     `(("pkg-config" ,pkg-config)
+       ("gobject-introspection", gobject-introspection))) ; g-ir-compiler, etc.
    (synopsis "GNOME image loading and manipulation library")
    (description
     "GdkPixbuf is a library for image loading and manipulation developed
@@ -366,21 +394,15 @@ application suites.")
       ("libxinerama" ,libxinerama)
       ("pango" ,pango)))
    (inputs
-    `(("gobject-introspection" ,gobject-introspection)
+    `(("libxml2" ,libxml2)))
-      ("libxml2" ,libxml2)))
    (native-inputs
-     `(("perl" ,perl)
+    `(("perl" ,perl)
       ("pkg-config" ,pkg-config)
+      ("gobject-introspection" ,gobject-introspection)
       ("python-wrapper" ,python-wrapper)
       ("xorg-server" ,xorg-server)))
    (arguments
-    `(#:modules ((guix build gnome)
+    `(#:phases
-                 (guix build gnu-build-system)
-                 (guix build utils))
-      #:imported-modules ((guix build gnome)
-                          (guix build gnu-build-system)
-                          (guix build utils))
-      #:phases
       (alist-replace
        'configure
        (lambda* (#:key inputs #:allow-other-keys #:rest args)
@@ -391,32 +413,8 @@ application suites.")
            ;; directory.
            ;; See the manual page for dbus-uuidgen to correct this issue.
            (substitute* "testsuite/Makefile.in"
-            (("SUBDIRS = gdk gtk a11y css reftests") "SUBDIRS = gdk"))
+             (("SUBDIRS = gdk gtk a11y css reftests")
-
+              "SUBDIRS = gdk"))
-	   ;; We need to tell GIR where it can find some of the required .gir
-           ;; files.
-           (substitute* "gdk/Makefile.in"
-            (("--add-include-path=../gdk")
-             (string-append
-              "--add-include-path=../gdk"
-              " --add-include-path=" (gir-directory inputs "gdk-pixbuf")
-              " --add-include-path=" (gir-directory inputs "pango")))
-            (("--includedir=\\.")
-             (string-append "--includedir=."
-              " --includedir=" (gir-directory inputs "gdk-pixbuf")
-              " --includedir=" (gir-directory inputs "pango"))))
-
-           (substitute* "gtk/Makefile.in"
-            (("--add-include-path=../gdk")
-             (string-append "--add-include-path=../gdk"
-              " --add-include-path=" (gir-directory inputs "atk")
-              " --add-include-path=" (gir-directory inputs "gdk-pixbuf")
-              " --add-include-path=" (gir-directory inputs "pango")))
-            (("--includedir=../gdk")
-             (string-append "--includedir=../gdk"
-              " --includedir=" (gir-directory inputs "atk")
-              " --includedir=" (gir-directory inputs "gdk-pixbuf")
-              " --includedir=" (gir-directory inputs "pango"))))
            (apply configure args)))
        %standard-phases)))))
 

gnu/packages/guile.scm

@@ -247,7 +247,8 @@ many readers as needed).")
     (inputs `(("ncurses" ,ncurses)
               ("guile" ,guile-2.0)))
     (arguments
-     '(#:configure-flags (list (string-append "--with-guilesitedir="
+     '(#:configure-flags (list "--with-ncursesw"  ; Unicode support
+                               (string-append "--with-guilesitedir="
                                               (assoc-ref %outputs "out")
                                               "/share/guile/site/2.0"))
        #:phases (alist-cons-after
@@ -271,18 +272,18 @@ library.")
 (define-public mcron
   (package
     (name "mcron")
-    (version "1.0.6")
+    (version "1.0.7")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/mcron/mcron-"
                                  version ".tar.gz"))
              (sha256
               (base32
-               "0yvrfzzdy2m7fbqkr61fw01wd9r2jpnbyabxhcsfivgxywknl0fy"))
+               "1d214fmhsn3kvpnwxnqwfpy6gr5c5dbz2mx3sijhxi070vkfibxc"))
              (patches (list (search-patch "mcron-install.patch")))))
     (build-system gnu-build-system)
-    (inputs
+    (native-inputs `(("pkg-config" ,pkg-config)))
-     `(("ed" ,ed) ("which" ,which) ("guile" ,guile-1.8)))
+    (inputs `(("ed" ,ed) ("which" ,which) ("guile" ,guile-2.0)))
     (home-page "http://www.gnu.org/software/mcron/")
     (synopsis "Run jobs at scheduled times")
     (description

gnu/packages/imagemagick.scm

@@ -37,14 +37,14 @@
 (define-public imagemagick
   (package
     (name "imagemagick")
-    (version "6.8.8-10")
+    (version "6.8.9-0")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://imagemagick/ImageMagick-"
                                  version ".tar.xz"))
              (sha256
               (base32
-               "0crdazi2f1qj1ppb01f0mhqjw5q3afswgw49fa1m100bxmqpf77k"))))
+               "1lapn2798fkc2wn81slpms5p21kq4dsyg45khsk7n8p69cvrmw2b"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (alist-cons-before

gnu/packages/kde.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,14 +17,22 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages kde)
-  #:use-module ((guix licenses) #:select (bsd-2 lgpl2.1+))
+  #:use-module ((guix licenses) #:select (bsd-2 lgpl2.0+ lgpl2.1 lgpl2.1+))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system cmake)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages doxygen)
+  #:use-module (gnu packages geeqie)
   #:use-module (gnu packages glib)
+  #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages pulseaudio)
+  #:use-module (gnu packages python)
   #:use-module (gnu packages qt)
+  #:use-module (gnu packages rdf)
+  #:use-module (gnu packages video)
+  #:use-module (gnu packages xml)
   #:use-module (gnu packages xorg))
 
 (define-public automoc4
@@ -78,3 +86,122 @@
     (synopsis "Qt 4 multimedia API")
     (description "KDE desktop environment")
     (license lgpl2.1+)))
+
+(define-public qjson
+  (package
+    (name "qjson")
+    (version "0.8.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://github.com/flavio/qjson/archive/"
+                                 version ".tar.gz"))
+             (sha256
+              (base32
+               "163fspi0xc705irv79qw861fmh68pjyla9vx3kqiq6xrdhb9834j"))))
+    (build-system cmake-build-system)
+    (inputs
+     `(("qt" ,qt-4)))
+    (arguments
+     `(#:tests? #f)) ; no test target
+    (home-page "http://qjson.sourceforge.net/")
+    (synopsis "Qt-based library for handling JSON")
+    (description "QJson is a Qt-based library that maps JSON data to QVariant
+objects and vice versa.  JSON arrays are mapped to QVariantList instances,
+while JSON objects are mapped to QVariantMap.")
+    (license lgpl2.1+)))
+
+(define-public libdbusmenu-qt
+  (package
+    (name "libdbusmenu-qt")
+    (version "0.9.2")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://launchpad.net/" name "/trunk/"
+                                 version "/+download/"
+                                 name "-" version ".tar.bz2"))
+             (sha256
+              (base32
+               "1v0ri5g9xw2z64ik0kx0ra01v8rpjn2kxprrxppkls1wvav1qv5f"))))
+    (build-system cmake-build-system)
+    (native-inputs
+     `(("doxygen" ,doxygen) ; used for static documentation
+       ("pkg-config" ,pkg-config)
+       ("qjson", qjson))) ; used for the tests
+    (inputs
+     `(("qt" ,qt-4)))
+    (arguments
+     `(#:tests? #f)) ; no check target
+    (home-page "https://launchpad.net/libdbusmenu-qt/")
+    (synopsis "Qt implementation of the DBusMenu protocol")
+    (description "The library provides a Qt implementation of the DBusMenu
+protocol.  The DBusMenu protocol makes it possible for applications to export
+and import their menus over DBus.")
+    (license lgpl2.0+)))
+
+(define-public attica
+  (package
+    (name "attica")
+    (version "0.4.2")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://download.kde.org/stable/"
+                                 name "/"
+                                 name "-" version ".tar.bz2"))
+             (sha256
+              (base32
+               "1y74gsyzi70dfr9d1f1b08k130rm3jaibsppg8dv5h3211vm771v"))))
+    (build-system cmake-build-system)
+    (inputs
+     `(("qt" ,qt-4)))
+    (home-page "https://projects.kde.org/projects/kdesupport/attica")
+    (synopsis "Qt library for the Open Collaboration Services API")
+    (description "Attica is a Qt library that implements the Open
+Collaboration Services API version 1.6.  It grants easy access to the
+services such as querying information about persons and contents.  The
+library is used in KNewStuff3 as content provider.  In order to integrate
+with KDE's Plasma Desktop, a platform plugin exists in kdebase.")
+    (license lgpl2.1+)))
+
+(define-public strigi
+  (package
+    (name "strigi")
+    (version "0.7.8")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://www.vandenoever.info/software/"
+                                 name "/"
+                                 name "-" version ".tar.bz2"))
+             (sha256
+              (base32
+               "12grxzqwnvbyqw7q1gnz42lypadxmq89vk2qpxczmpmc4nk63r23"))))
+    (build-system cmake-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    ;; FIXME: Add optional inputs XAttr, FAM, Log4cxx
+    (inputs
+     `(("clucene" ,clucene)
+       ("dbus" ,dbus)
+       ("exiv2" ,exiv2)
+       ("ffmpeg" ,ffmpeg)
+       ("libxml2" ,libxml2)
+       ("perl" ,perl)
+       ("python" ,python-wrapper)
+       ("qt" ,qt-4)
+       ("zlib" ,zlib)))
+    (arguments
+     `(#:tests? #f)) ; FIXME: Test 23/25 ProcessInputStreamTest fails.
+    (home-page "http://www.vandenoever.info/software/strigi/")
+    (synopsis "Desktop search daemon")
+    (description "Strigi is a desktop search daemon with the following
+main features:
+very fast crawling;
+very small memory footprint;
+no hammering of the system;
+pluggable backend, currently clucene and hyperestraier, sqlite3 and xapian
+are in the works;
+communication between daemon and search program over an abstract interface,
+currently a simple socket;
+simple interface for implementing plugins for extracting information;
+calculation of sha1 for every file crawled
+(allows fast finding of duplicates).")
+    (license lgpl2.0+)))

gnu/packages/libevent.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,7 +23,9 @@
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages which)
-  #:use-module (gnu packages python))
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages autotools)
+  #:use-module (gnu packages pkg-config))
 
 (define-public libevent
   (package
@@ -58,3 +60,44 @@ network servers.  An application just needs to call event_dispatch() and
 then add or remove events dynamically without having to change the event
 loop.")
     (license bsd-3)))
+
+(define-public libuv
+  (package
+    (name "libuv")
+    (version "0.11.25")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "https://github.com/joyent/libuv/archive/v"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "1ys2wlypdbv59yywn91d5vl329z50mi7ivi3fj5rjm4mr9g3wnmr"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-cons-before
+                 'configure 'autogen
+                 (lambda _
+                   ;; Fashionable people don't run 'make dist' these days, so
+                   ;; we need to do that ourselves.
+                   (zero? (system* "./autogen.sh")))
+                 %standard-phases)
+
+       ;; XXX: Some tests want /dev/tty, attempt to make connections, etc.
+       #:tests? #f))
+    (native-inputs `(("autoconf" ,(autoconf-wrapper))
+                     ("automake" ,automake)
+                     ("libtool" ,libtool "bin")
+
+                     ;; libuv.pc is installed only when pkg-config is found.
+                     ("pkg-config" ,pkg-config)))
+    (home-page "https://github.com/joyent/libuv")
+    (synopsis "Library for asynchronous I/O")
+    (description
+     "libuv is a multi-platform support library with a focus on asynchronous
+I/O.  Among other things, it supports event loops via epoll, kqueue, and
+similar IOCP, and event ports, asynchronous TCP/UDP sockets, asynchronous DNS
+resolution, asynchronous file system operations, and threading primitives.")
+
+    ;; A few files fall under other non-copyleft licenses; see 'LICENSE' for
+    ;; details.
+    (license x11)))

gnu/packages/linux.scm

@@ -38,11 +38,14 @@
   #:use-module (gnu packages attr)
   #:use-module (gnu packages xml)
   #:use-module (gnu packages autotools)
+  #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages check)
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system cmake)
-  #:use-module (guix build-system python))
+  #:use-module (guix build-system python)
+  #:use-module (guix build-system trivial))
 
 (define-public (system->linux-architecture arch)
   "Return the Linux architecture name for ARCH, a Guix system name such as
@@ -440,7 +443,8 @@ slabtop, and skill.")
                "0ibkkvp6kan0hn0d1anq4n2md70j5gcm7mwna515w82xwyr02rfw"))))
     (build-system gnu-build-system)
     (inputs `(("util-linux" ,util-linux)))
-    (native-inputs `(("pkg-config" ,pkg-config)))
+    (native-inputs `(("pkg-config" ,pkg-config)
+                     ("texinfo" ,texinfo)))    ; for the libext2fs Info manual
     (arguments
      '(#:phases (alist-cons-before
                  'configure 'patch-shells
@@ -466,6 +470,39 @@ slabtop, and skill.")
                    lgpl2.0                        ; libext2fs
                    x11))))                        ; libuuid
 
+(define-public e2fsck/static
+  (package
+    (name "e2fsck-static")
+    (version (package-version e2fsprogs))
+    (build-system trivial-build-system)
+    (source #f)
+    (arguments
+     `(#:modules ((guix build utils))
+       #:builder
+       (begin
+         (use-modules (guix build utils)
+                      (ice-9 ftw)
+                      (srfi srfi-26))
+
+         (let ((source (string-append (assoc-ref %build-inputs "e2fsprogs")
+                                      "/sbin"))
+               (bin    (string-append (assoc-ref %outputs "out") "/sbin")))
+           (mkdir-p bin)
+           (with-directory-excursion bin
+             (for-each (lambda (file)
+                         (copy-file (string-append source "/" file)
+                                    file)
+                         (remove-store-references file)
+                         (chmod file #o555))
+                       (scandir source (cut string-prefix? "fsck." <>))))))))
+    (inputs `(("e2fsprogs" ,(static-package e2fsprogs))))
+    (synopsis "Statically-linked fsck.* commands from e2fsprogs")
+    (description
+     "This package provides statically-linked command of fsck.ext[234] taken
+from the e2fsprogs package.  It is meant to be used in initrds.")
+    (home-page (package-home-page e2fsprogs))
+    (license (package-license e2fsprogs))))
+
 (define-public strace
   (package
     (name "strace")
@@ -962,6 +999,23 @@ space, using the FUSE library.  Mounting a union file system allows you to
 UnionFS-FUSE additionally supports copy-on-write.")
     (license bsd-3)))
 
+(define fuse-static
+  (package (inherit fuse)
+    (name "fuse-static")
+    (source (origin (inherit (package-source fuse))
+              (modules '((guix build utils)))
+              (snippet
+               ;; Normally libfuse invokes mount(8) so that /etc/mtab is
+               ;; updated.  Change calls to 'mtab_needs_update' to 0 so that
+               ;; it doesn't do that, allowing us to remove the dependency on
+               ;; util-linux (something that is useful in initrds.)
+               '(substitute* '("lib/mount_util.c"
+                               "util/mount_util.c")
+                  (("mtab_needs_update[[:blank:]]*\\([a-z_]+\\)")
+                   "0")
+                  (("/bin/")
+                   "")))))))
+
 (define-public unionfs-fuse/static
   (package (inherit unionfs-fuse)
     (synopsis "User-space union file system (statically linked)")
@@ -976,4 +1030,118 @@ UnionFS-FUSE additionally supports copy-on-write.")
                                   libs " dl)"))))))
     (arguments
      '(#:tests? #f
-       #:configure-flags '("-DCMAKE_EXE_LINKER_FLAGS=-static")))))
+       #:configure-flags '("-DCMAKE_EXE_LINKER_FLAGS=-static")))
+    (inputs `(("fuse" ,fuse-static)))))
+
+(define-public numactl
+  (package
+    (name "numactl")
+    (version "2.0.9")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "ftp://oss.sgi.com/www/projects/libnuma/download/numactl-"
+                    version
+                    ".tar.gz"))
+              (sha256
+               (base32
+                "073myxlyyhgxh1w3r757ajixb7s2k69czc3r0g12c3scq7k3784w"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-replace
+                 'configure
+                 (lambda* (#:key outputs #:allow-other-keys)
+                   ;; There's no 'configure' script, just a raw makefile.
+                   (substitute* "Makefile"
+                     (("^prefix := .*$")
+                      (string-append "prefix := " (assoc-ref outputs "out")
+                                     "\n"))
+                     (("^libdir := .*$")
+                      ;; By default the thing tries to install under
+                      ;; $prefix/lib64 when on a 64-bit platform.
+                      (string-append "libdir := $(prefix)/lib\n"))))
+                 %standard-phases)
+
+       #:make-flags (list
+                     ;; By default the thing tries to use 'cc'.
+                     "CC=gcc"
+
+                     ;; Make sure programs have an RPATH so they can find
+                     ;; libnuma.so.
+                     (string-append "LDLIBS=-Wl,-rpath="
+                                    (assoc-ref %outputs "out") "/lib"))
+
+       ;; There's a 'test' target, but it requires NUMA support in the kernel
+       ;; to run, which we can't assume to have.
+       #:tests? #f))
+    (home-page "http://oss.sgi.com/projects/libnuma/")
+    (synopsis "Tools for non-uniform memory access (NUMA) machines")
+    (description
+     "NUMA stands for Non-Uniform Memory Access, in other words a system whose
+memory is not all in one place.  The numactl program allows you to run your
+application program on specific CPU's and memory nodes.  It does this by
+supplying a NUMA memory policy to the operating system before running your
+program.
+
+The package contains other commands, such as numademo, numastat and memhog.
+The numademo command provides a quick overview of NUMA performance on your
+system.")
+    (license (list gpl2                           ; programs
+                   lgpl2.1))))                    ; library
+
+(define-public kbd
+  (package
+    (name "kbd")
+    (version "2.0.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://kernel.org/linux/utils/kbd/kbd-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "0c34b0za2v0934acvgnva0vaqpghmmhz4zh7k0m9jd4mbc91byqm"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-cons-before
+                 'build 'pre-build
+                 (lambda* (#:key inputs #:allow-other-keys)
+                   (let ((gzip  (assoc-ref %build-inputs "gzip"))
+                         (bzip2 (assoc-ref %build-inputs "bzip2")))
+                     (substitute* "src/libkeymap/findfile.c"
+                       (("gzip")
+                        (string-append gzip "/bin/gzip"))
+                       (("bzip2")
+                        (string-append bzip2 "/bin/bzip2")))))
+                 %standard-phases)))
+    (inputs `(("check" ,check)
+              ("gzip" ,guix:gzip)
+              ("bzip2" ,guix:bzip2)
+              ("pam" ,linux-pam)))
+    (native-inputs `(("pkg-config" ,pkg-config)))
+    (home-page "ftp://ftp.kernel.org/pub/linux/utils/kbd/")
+    (synopsis "Linux keyboard utilities and keyboard maps")
+    (description
+     "This package contains keytable files and keyboard utilities compatible
+for systems using the Linux kernel.  This includes commands such as
+'loadkeys', 'setfont', 'kbdinfo', and 'chvt'.")
+    (license gpl2+)))
+
+(define-public inotify-tools
+  (package
+    (name "inotify-tools")
+    (version "3.13")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://sourceforge/inotify-tools/inotify-tools/"
+                    version "/inotify-tools-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0icl4bx041axd5dvhg89kilfkysjj86hjakc7bk8n49cxjn4cha6"))))
+    (build-system gnu-build-system)
+    (home-page "http://inotify-tools.sourceforge.net/")
+    (synopsis "Monitor file accesses")
+    (description
+     "The inotify-tools packages provides a C library and command-line tools
+to use Linux' inotify mechanism, which allows file accesses to be monitored.")
+    (license gpl2+)))

gnu/packages/lua.scm

@@ -2,6 +2,7 @@
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014 Raimon Grau <raimonster@gmail.com>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,13 +30,13 @@
 (define-public lua
   (package
     (name "lua")
-    (version "5.2.1")
+    (version "5.2.3")
     (source (origin
              (method url-fetch)
              (uri (string-append "http://www.lua.org/ftp/lua-"
                                  version ".tar.gz"))
              (sha256
-              (base32 "1rbv2ysq5fdksz7xg07dnrkl8i0gnx855hg4z6b324vng6l4sc34"))))
+              (base32 "0b8034v1s82n4dg5rzcn12067ha3nxaylp2vdp8gg08kjsbzphhk"))))
     (build-system gnu-build-system)
     (inputs `(("readline", readline)))
     (arguments
@@ -45,7 +46,7 @@
        #:test-target "test"
        #:phases (alist-replace
                  'build
-                 (lambda _ (zero? (system* "make" "linux"))) ; XXX: Other OS.
+                 (lambda _ (zero? (system* "make" "CFLAGS=-fPIC" "linux")))
                  (alist-replace
                   'install
                   (lambda* (#:key outputs #:allow-other-keys)
@@ -66,6 +67,16 @@ automatic memory management with incremental garbage collection, making it ideal
 for configuration, scripting, and rapid prototyping.")
     (license x11)))
 
+(define-public lua-5.1
+  (package (inherit lua)
+    (version "5.1.5")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://www.lua.org/ftp/lua-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32 "0cskd4w0g6rdm2q8q3i4n1h3j8kylhs3rq8mxwl9vwlmlxbgqh16"))))))
+
 (define-public luajit
   (package
     (name "luajit")

gnu/packages/mail.scm

@@ -20,9 +20,12 @@
 (define-module (gnu packages mail)
   #:use-module (gnu packages)
   #:use-module (gnu packages autotools)
+  #:use-module (gnu packages base)
   #:use-module (gnu packages cyrus-sasl)
   #:use-module (gnu packages dejagnu)
+  #:use-module (gnu packages emacs)
   #:use-module (gnu packages gdbm)
+  #:use-module (gnu packages glib)
   #:use-module (gnu packages gnupg)
   #:use-module (gnu packages gnutls)
   #:use-module (gnu packages guile)
@@ -32,7 +35,9 @@
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages openssl)
   #:use-module (gnu packages perl)
+  #:use-module (gnu packages python)
   #:use-module (gnu packages readline)
+  #:use-module (gnu packages search)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages glib)
@@ -44,6 +49,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
+  #:use-module (guix build-system python)
   #:use-module (srfi srfi-1))
 
 (define-public mailutils
@@ -253,4 +259,71 @@ content (body).  The program is able to learn from the user's classifications
 and corrections.  It is based on a Bayesian filter.")
     (license gpl2)))
 
+(define-public offlineimap
+  (package
+    (name "offlineimap")
+    (version "6.5.5")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "https://github.com/OfflineIMAP/offlineimap/"
+                                  "archive/v" version ".tar.gz"))
+              (sha256
+               (base32
+                "00k84qagph3xnxss6rkxm61x07ngz8fvffx4z9jyw5baf3cdd32p"))))
+    (build-system python-build-system)
+    (native-inputs `(("python" ,python-2)))
+    (arguments
+     ;; The setup.py script expects python-2.
+     `(#:python ,python-2
+      ;; Tests require a modifiable IMAP account.
+       #:tests? #f))
+    (home-page "http://www.offlineimap.org")
+    (synopsis "Synch emails between two repositories")
+    (description
+     "OfflineImap synchronizes emails between two repositories, so that you
+can read the same mailbox from multiple computers.  It supports IMAP as REMOTE
+repository and Maildir/IMAP as LOCAL repository.")
+    (license gpl2+)))
+
+(define-public mu
+  (package
+    (name "mu")
+    (version "0.9.9.5")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "https://mu0.googlecode.com/files/mu-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "1hwkliyb8fjrz5sw9fcisssig0jkdxzhccw0ld0l9a10q1l9mqhp"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("texinfo" ,texinfo)))
+    ;; TODO: Add webkit and gtk to build the mug GUI.
+    (inputs
+     `(("xapian" ,xapian)
+       ("emacs" ,emacs)
+       ("guile" ,guile-2.0)
+       ("glib" ,glib)
+       ("gmime" ,gmime)
+       ("tzdata" ,tzdata)))             ;for mu/test/test-mu-query.c
+    (arguments
+     '(#:phases (alist-cons-before
+                 'check 'check-tz-setup
+                 (lambda* (#:key inputs #:allow-other-keys)
+                   ;; For mu/test/test-mu-query.c
+                   (setenv "TZDIR"
+                           (string-append (assoc-ref inputs "tzdata")
+                                          "/share/zoneinfo")))
+                 %standard-phases)))
+    (home-page "http://www.djcbsoftware.nl/code/mu/")
+    (synopsis "Quickly find emails")
+    (description
+     "Mu is a tool for dealing with e-mail messages stored in the
+Maildir-format.  Mu's purpose in life is to help you to quickly find the
+messages you need; in addition, it allows you to view messages, extract
+attachments, create new maildirs, and so on.")
+    (license gpl3+)))
+
 ;;; mail.scm ends here

gnu/packages/make-bootstrap.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,7 +40,9 @@
             %glibc-bootstrap-tarball
             %gcc-bootstrap-tarball
             %guile-bootstrap-tarball
-            %bootstrap-tarballs))
+            %bootstrap-tarballs
+
+            %guile-static-stripped))
 
 ;;; Commentary:
 ;;;

gnu/packages/man.scm

@@ -102,6 +102,10 @@ a flexible and convenient way.")
        ("groff" ,groff)
        ("less" ,less)
        ("libpipeline" ,libpipeline)))
+    (native-search-paths
+     (list (search-path-specification
+            (variable "MANPATH")
+            (directories '("share/man")))))
     (home-page "http://man-db.nongnu.org/")
     (synopsis "Standard Unix documentation system")
     (description
@@ -117,7 +121,7 @@ the traditional flat-text whatis databases.")
     (source (origin
               (method url-fetch)
               (uri (string-append
-                    "mirror://kernel/linux/docs/man-pages/man-pages-"
+                    "mirror://kernel.org/linux/docs/man-pages/man-pages-"
                     version ".tar.xz"))
               (sha256
                (base32

gnu/packages/maths.scm

@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014 John Darrington <jmd@gnu.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,11 +25,16 @@
                 #:renamer (symbol-prefix-proc 'license:))
   #:use-module (guix packages)
   #:use-module (guix download)
+  #:use-module (guix utils)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
+  #:use-module (gnu packages algebra)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages curl)
   #:use-module (gnu packages elf)
+  #:use-module (gnu packages flex)
   #:use-module (gnu packages fltk)
   #:use-module (gnu packages fontutils)
   #:use-module (gnu packages gettext)
@@ -37,14 +43,18 @@
   #:use-module (gnu packages ghostscript)
   #:use-module (gnu packages gtk)
   #:use-module (gnu packages less)
+  #:use-module (gnu packages gnome)
   #:use-module (gnu packages xorg)
   #:use-module (gnu packages gl)
+  #:use-module (gnu packages mpi)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages pcre)
+  #:use-module (gnu packages popt)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python)
   #:use-module (gnu packages readline)
+  #:use-module (gnu packages tcsh)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages texlive)
   #:use-module (gnu packages xml))
@@ -137,7 +147,7 @@ LP/MIP solver is included in the package.")
 (define-public pspp
   (package
     (name "pspp")
-    (version "0.8.2")
+    (version "0.8.3")
     (source
      (origin
       (method url-fetch)
@@ -145,7 +155,7 @@ LP/MIP solver is included in the package.")
                           version ".tar.gz"))
       (sha256
        (base32
-        "1w7h3dglgx0jlq1wb605b8pgfsk2vr1q2q2rj7bsajh9ihbcsixr"))))
+        "0vri2pzvmm38qaihfvwlry30f40lcnps4blg59ixic4q20ldxf5d"))))
     (build-system gnu-build-system)
     (inputs
      `(("cairo" ,cairo)
@@ -190,43 +200,14 @@ output in text, PostScript, PDF or HTML.")
     (inputs `(("fortran" ,gfortran-4.8)
               ("python" ,python-2)))
     (arguments
-     `(#:modules ((guix build cmake-build-system)
+     `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES")
-                  (guix build utils)
-                  (guix build rpath)
-                  (srfi srfi-1))
-       #:imported-modules ((guix build cmake-build-system)
-                           (guix build gnu-build-system)
-                           (guix build utils)
-                           (guix build rpath))
-       #:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES")
        #:phases (alist-cons-before
                  'check 'patch-python
                  (lambda* (#:key inputs #:allow-other-keys)
                    (let ((python (assoc-ref inputs "python")))
                      (substitute* "lapack_testing.py"
                        (("/usr/bin/env python") python))))
-                 (alist-cons-after
+                  %standard-phases)))
-                  'strip 'add-libs-to-runpath
-                  (lambda* (#:key inputs outputs #:allow-other-keys)
-                    (let* ((out     (assoc-ref outputs "out"))
-                           (fortran (assoc-ref inputs "fortran"))
-                           (libc    (assoc-ref inputs "libc"))
-                           (rpaths  `(,(string-append fortran "/lib64")
-                                      ,(string-append fortran "/lib")
-                                      ,(string-append libc "/lib")
-                                      ,(string-append out "/lib"))))
-                      ;; Set RUNPATH for all libraries
-                      (with-directory-excursion out
-                        (for-each
-                         (lambda (lib)
-                           (let ((lib-rpaths (file-rpath lib)))
-                             (for-each
-                              (lambda (dir)
-                                (or (member dir lib-rpaths)
-                                    (augment-rpath lib dir)))
-                              rpaths)))
-                         (find-files "lib" ".*so$")))))
-                  %standard-phases))))
     (synopsis "Library for numerical linear algebra")
     (description
      "LAPACK is a Fortran 90 library for solving the most commonly occurring
@@ -349,3 +330,499 @@ applications and it provides great support for visualizing results.  Work may
 be performed both at the interactive command-line as well as via script
 files.")
     (license license:gpl3+)))
+
+(define-public gmsh
+  (package
+    (name "gmsh")
+    (version "2.8.4")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://www.geuz.org/gmsh/src/gmsh-"
+                          version "-source.tgz"))
+      (sha256
+       (base32 "0jv2yvk28w86rx5mvjkb0w12ff2jxih7axnpvznpd295lg5jg7hr"))
+      (modules '((guix build utils)))
+      (snippet
+       ;; Remove non-free METIS code
+       '(delete-file-recursively "contrib/Metis"))))
+    (build-system cmake-build-system)
+    (native-inputs `(("patchelf" ,patchelf))) ;for augment-rpath
+    (propagated-inputs
+     `(("fltk" ,fltk)
+       ("gfortran" ,gfortran-4.8)
+       ("gmp" ,gmp)
+       ("hdf5-lib" ,hdf5 "lib")
+       ("hdf5-include" ,hdf5 "include")
+       ("lapack" ,lapack)
+       ("mesa" ,mesa)
+       ("libx11" ,libx11)
+       ("libxext" ,libxext)))
+    (arguments
+     `(#:configure-flags `("-DENABLE_METIS:BOOL=OFF"
+                           "-DENABLE_BUILD_SHARED:BOOL=ON"
+                           "-DENABLE_BUILD_DYNAMIC:BOOL=ON")))
+    (home-page "http://www.geuz.org/gmsh/")
+    (synopsis "3D finite element grid generator")
+    (description "Gmsh is a 3D finite element grid generator with a built-in
+CAD engine and post-processor.  Its design goal is to provide a fast, light
+and user-friendly meshing tool with parametric input and advanced
+visualization capabilities.  Gmsh is built around four modules: geometry,
+mesh, solver and post-processing.  The specification of any input to these
+modules is done either interactively using the graphical user interface or in
+ASCII text files using Gmsh's own scripting language.")
+    (license license:gpl2+)))
+
+(define-public petsc
+  (package
+    (name "petsc")
+    (version "3.4.4")
+    (source
+     (origin
+      (method url-fetch)
+      ;; The *-lite-* tarball does not contain the *large* documentation
+      (uri (string-append "http://ftp.mcs.anl.gov/pub/petsc/release-snapshots/"
+                          "petsc-lite-" version ".tar.gz"))
+      (sha256
+       (base32 "0v5dg6dhdjpi5ianvd4mm6hsvxzv1bsxwnh9f9myag0a0d9xk9iv"))
+      (patches
+       (list (search-patch "petsc-fix-threadcomm.patch")))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("python" ,python-2)
+       ("perl" ,perl)))
+    (inputs
+     `(("gfortran" ,gfortran-4.8)
+       ("lapack" ,lapack)
+       ("superlu" ,superlu)
+       ;; leaving out hdf5 and fftw, as petsc expects them to be built with mpi
+       ;; leaving out opengl, as configuration seems to only be for mac
+       ))
+    (arguments
+     `(#:test-target "test"
+       #:parallel-build? #f
+       #:configure-flags
+       `("--with-mpi=0"
+         "--with-openmp=1"
+         "--with-superlu=1"
+         ,(string-append "--with-superlu-include="
+                         (assoc-ref %build-inputs "superlu") "/include")
+         ,(string-append "--with-superlu-lib="
+                         (assoc-ref %build-inputs "superlu") "/lib/libsuperlu.a"))
+       #:phases
+       (alist-replace
+        'configure
+        ;; PETSc's configure script is actually a python script, so we can't
+        ;; run it with bash.
+        (lambda* (#:key outputs (configure-flags '())
+                  #:allow-other-keys)
+          (let* ((prefix (assoc-ref outputs "out"))
+                 (flags `(,(string-append "--prefix=" prefix)
+                          ,@configure-flags)))
+            (format #t "build directory: ~s~%" (getcwd))
+            (format #t "configure flags: ~s~%" flags)
+            (zero? (apply system* "./configure" flags))))
+        (alist-cons-after
+         'configure 'clean-local-references
+         ;; Try to keep build directory names from leaking into compiled code
+         (lambda* (#:key inputs outputs #:allow-other-keys)
+           (let ((out (assoc-ref outputs "out")))
+             (substitute* (find-files "." "^petsc(conf|machineinfo).h$")
+               (((getcwd)) out))))
+         (alist-cons-after
+          'install 'clean-install
+          ;; Try to keep installed files from leaking build directory names.
+          (lambda* (#:key inputs outputs #:allow-other-keys)
+            (let ((out     (assoc-ref outputs "out"))
+                  (fortran (assoc-ref inputs  "gfortran")))
+              (substitute* (map (lambda (file)
+                                  (string-append out "/" file))
+                                '("conf/petscvariables"
+                                  "conf/PETScConfig.cmake"))
+                (((getcwd)) out))
+              ;; Make compiler references point to the store
+              (substitute* (string-append out "/conf/petscvariables")
+                (("= g(cc|\\+\\+|fortran)" _ suffix)
+                 (string-append "= " fortran "/bin/g" suffix)))
+              ;; PETSc installs some build logs, which aren't necessary.
+              (for-each (lambda (file)
+                          (let ((f (string-append out "/" file)))
+                            (when (file-exists? f)
+                              (delete-file f))))
+                        '("conf/configure.log"
+                          "conf/make.log"
+                          "conf/test.log"
+                          "conf/error.log"
+                          "conf/RDict.db"
+                          ;; Once installed, should uninstall with Guix
+                          "conf/uninstall.py"))))
+          %standard-phases)))))
+    (home-page "http://www.mcs.anl.gov/petsc")
+    (synopsis "Library to solve PDEs")
+    (description "PETSc, pronounced PET-see (the S is silent), is a suite of
+data structures and routines for the scalable (parallel) solution of
+scientific applications modeled by partial differential equations.")
+    (license (license:bsd-style
+              "http://www.mcs.anl.gov/petsc/documentation/copyright.html"))))
+
+(define-public petsc-complex
+  (package (inherit petsc)
+    (name "petsc-complex")
+    (arguments
+     (substitute-keyword-arguments (package-arguments petsc)
+       ((#:configure-flags cf)
+        `(cons "--with-scalar-type=complex" ,cf))))
+    (synopsis "Library to solve PDEs (with complex scalars)")))
+
+(define-public petsc-openmpi
+  (package (inherit petsc)
+    (name "petsc-openmpi")
+    (inputs
+     `(("openmpi" ,openmpi)
+       ,@(package-inputs petsc)))
+    (arguments
+     (substitute-keyword-arguments (package-arguments petsc)
+       ((#:configure-flags cf)
+        ``("--with-mpiexec=mpirun"
+           ,(string-append "--with-mpi-dir="
+                           (assoc-ref %build-inputs "openmpi"))
+           ,@(delete "--with-mpi=0" ,cf)))))
+    (synopsis "Library to solve PDEs (with MPI support)")))
+
+(define-public petsc-complex-openmpi
+  (package (inherit petsc-complex)
+    (name "petsc-complex-openmpi")
+    (inputs
+     `(("openmpi" ,openmpi)
+       ,@(package-inputs petsc-complex)))
+    (arguments
+     (substitute-keyword-arguments (package-arguments petsc-complex)
+       ((#:configure-flags cf)
+        ``("--with-mpiexec=mpirun"
+           ,(string-append "--with-mpi-dir="
+                           (assoc-ref %build-inputs "openmpi"))
+           ,@(delete "--with-mpi=0" ,cf)))))
+    (synopsis "Library to solve PDEs (with complex scalars and MPI support)")))
+
+(define-public superlu
+  (package
+    (name "superlu")
+    (version "4.3")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://crd-legacy.lbl.gov/~xiaoye/SuperLU/"
+                           "superlu_" version ".tar.gz"))
+       (sha256
+        (base32 "10b785s9s4x0m9q7ihap09275pq4km3k2hk76jiwdfdr5qr2168n"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("tcsh" ,tcsh)))
+    (inputs
+     `(("lapack" ,lapack)
+       ("gfortran" ,gfortran-4.8)))
+    (arguments
+     `(#:parallel-build? #f
+       #:tests? #f                      ;tests are run as part of `make all`
+       #:phases
+       (alist-replace
+        'configure
+        (lambda* (#:key inputs outputs #:allow-other-keys)
+          (call-with-output-file "make.inc"
+            (lambda (port)
+              (format port "
+PLAT        =
+SuperLUroot = ~a
+SUPERLULIB  = ~a/lib/libsuperlu.a
+TMGLIB      = libtmglib.a
+BLASDEF     = -DUSE_VENDOR_BLAS
+BLASLIB     = -L~a/lib -lblas
+LIBS        = $(SUPERLULIB) $(BLASLIB)
+ARCH        = ar
+ARCHFLAGS   = cr
+RANLIB      = ranlib
+CC          = gcc
+PIC         = -fPIC
+CFLAGS      = -O3 -DPRNTlevel=0 $(PIC)
+NOOPTS      = -O0 $(PIC)
+FORTRAN     = gfortran
+FFLAGS      = -O2 $(PIC)
+LOADER      = $(CC)
+CDEFS       = -DAdd_"
+                      (getcwd)
+                      (assoc-ref outputs "out")
+                      (assoc-ref inputs "lapack")))))
+        (alist-cons-before
+         'build 'create-install-directories
+         (lambda* (#:key outputs #:allow-other-keys)
+           (for-each
+            (lambda (dir)
+              (mkdir-p (string-append (assoc-ref outputs "out")
+                                      "/" dir)))
+            '("lib" "include")))
+         (alist-replace
+          'install
+          (lambda* (#:key outputs #:allow-other-keys)
+            ;; Library is placed in lib during the build phase.  Copy over
+            ;; headers to include.
+            (let* ((out    (assoc-ref outputs "out"))
+                   (incdir (string-append out "/include")))
+              (for-each (lambda (file)
+                          (let ((base (basename file)))
+                            (format #t "installing `~a' to `~a'~%"
+                                    base incdir)
+                            (copy-file file
+                                       (string-append incdir "/" base))))
+                        (find-files "SRC" ".*\\.h$"))))
+          %standard-phases)))))
+    (home-page "http://crd-legacy.lbl.gov/~xiaoye/SuperLU/")
+    (synopsis "Supernodal direct solver for sparse linear systems")
+    (description
+     "SuperLU is a general purpose library for the direct solution of large,
+sparse, nonsymmetric systems of linear equations on high performance machines.
+The library is written in C and is callable from either C or Fortran.  The
+library routines perform an LU decomposition with partial pivoting and
+triangular system solves through forward and back substitution.  The library
+also provides threshold-based ILU factorization preconditioners.")
+    (license license:bsd-3)))
+
+(define-public superlu-dist
+  (package
+    (name "superlu-dist")
+    (version "3.3")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://crd-legacy.lbl.gov/~xiaoye/SuperLU/"
+                           "superlu_dist_" version ".tar.gz"))
+       (sha256
+        (base32 "1hnak09yxxp026blq8zhrl7685yip16svwngh1wysqxf8z48vzfj"))
+       (patches (list (search-patch "superlu-dist-scotchmetis.patch")))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("tcsh" ,tcsh)))
+    (inputs
+     `(("gfortran" ,gfortran-4.8)))
+    (propagated-inputs
+     `(("openmpi" ,openmpi)             ;headers include MPI heades
+       ("lapack" ,lapack)               ;required to link with output library
+       ("pt-scotch" ,pt-scotch)))       ;same
+    (arguments
+     `(#:parallel-build? #f             ;race conditions using ar
+       #:phases
+       (alist-replace
+        'configure
+        (lambda* (#:key inputs outputs #:allow-other-keys)
+          (call-with-output-file "make.inc"
+            (lambda (port)
+              (format port "
+PLAT        =
+DSuperLUroot = ~a
+DSUPERLULIB  = ~a/lib/libsuperlu_dist.a
+BLASDEF     = -DUSE_VENDOR_BLAS
+BLASLIB     = -L~a/lib -lblas
+PARMETISLIB = -L~a/lib \
+              -lptscotchparmetis -lptscotch -lptscotcherr -lptscotcherrexit \
+              -lscotch -lscotcherr -lscotcherrexit
+METISLIB    = -L~:*~a/lib \
+              -lscotchmetis -lscotch -lscotcherr -lscotcherrexit
+LIBS        = $(DSUPERLULIB) $(PARMETISLIB) $(METISLIB) $(BLASLIB)
+ARCH        = ar
+ARCHFLAGS   = cr
+RANLIB      = ranlib
+CC          = mpicc
+PIC         = -fPIC
+CFLAGS      = -O3 -g -DPRNTlevel=0 $(PIC)
+NOOPTS      = -O0 -g $(PIC)
+FORTRAN     = mpifort
+FFLAGS      = -O2 -g $(PIC)
+LOADER      = $(CC)
+CDEFS       = -DAdd_"
+                      (getcwd)
+                      (assoc-ref outputs "out")
+                      (assoc-ref inputs "lapack")
+                      (assoc-ref inputs "pt-scotch")))))
+        (alist-cons-after
+         'unpack 'remove-broken-symlinks
+         (lambda _
+           (for-each delete-file
+                     (find-files "MAKE_INC" "\\.#make\\..*")))
+         (alist-cons-before
+          'build 'create-install-directories
+          (lambda* (#:key outputs #:allow-other-keys)
+            (for-each
+             (lambda (dir)
+               (mkdir-p (string-append (assoc-ref outputs "out")
+                                       "/" dir)))
+             '("lib" "include")))
+          (alist-replace
+           'check
+           (lambda _
+             (with-directory-excursion "EXAMPLE"
+               (and
+                (zero? (system* "mpirun" "-n" "2"
+                                "./pddrive" "-r" "1" "-c" "2" "g20.rua"))
+                (zero? (system* "mpirun" "-n" "2"
+                                "./pzdrive" "-r" "1" "-c" "2" "cg20.cua")))))
+           (alist-replace
+            'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              ;; Library is placed in lib during the build phase.  Copy over
+              ;; headers to include.
+              (let* ((out    (assoc-ref outputs "out"))
+                     (incdir (string-append out "/include")))
+                (for-each (lambda (file)
+                            (let ((base (basename file)))
+                              (format #t "installing `~a' to `~a'~%"
+                                      base incdir)
+                              (copy-file file
+                                         (string-append incdir "/" base))))
+                          (find-files "SRC" ".*\\.h$"))))
+            %standard-phases)))))))
+    (home-page (package-home-page superlu))
+    (synopsis "Parallel supernodal direct solver")
+    (description
+     "SuperLU_DIST is a parallel extension to the serial SuperLU library.
+It is targeted for distributed memory parallel machines.  SuperLU_DIST is
+implemented in ANSI C, and MPI for communications.")
+    (license license:bsd-3)))
+
+(define-public scotch
+  (package
+    (name "scotch")
+    (version "6.0.0")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "https://gforge.inria.fr/frs/download.php/31831/"
+                          "scotch_" version ".tar.gz"))
+      (sha256
+       (base32 "0yfqf9lk7chb3h42777x42x4adx0v3n0b41q0cdqrdmscp4iczp5"))
+      (patches (list (search-patch "scotch-test-threading.patch")))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("zlib" ,zlib)
+       ("flex" ,flex)
+       ("bison" ,bison)))
+    (arguments
+     `(#:phases
+       (alist-cons-after
+        'unpack 'chdir-to-src
+        (lambda _ (chdir "src"))
+        (alist-replace
+         'configure
+         (lambda _
+           (call-with-output-file "Makefile.inc"
+             (lambda (port)
+               (format port "
+EXE =
+LIB = .a
+OBJ = .o
+MAKE = make
+AR = ar
+ARFLAGS = -ruv
+CCS = gcc
+CCP = mpicc
+CCD = gcc
+CPPFLAGS =~{ -D~a~}
+CFLAGS = -O2 -g $(CPPFLAGS)
+LDFLAGS = -lz -lm -lrt -lpthread
+CP = cp
+LEX = flex -Pscotchyy -olex.yy.c
+LN = ln
+MKDIR = mkdir
+MV = mv
+RANLIB = ranlib
+YACC = bison -pscotchyy -y -b y
+"
+                       '("COMMON_FILE_COMPRESS_GZ"
+                         "COMMON_PTHREAD"
+                         "COMMON_RANDOM_FIXED_SEED"
+                         ;; TODO: Define once our MPI supports
+                         ;; MPI_THREAD_MULTIPLE
+                         ;; "SCOTCH_PTHREAD"
+                         ;; "SCOTCH_PTHREAD_NUMBER=2"
+                         "restrict=__restrict")))))
+         (alist-replace
+          'install
+          (lambda* (#:key outputs #:allow-other-keys)
+            (let ((out (assoc-ref outputs "out")))
+              (mkdir out)
+              (zero? (system* "make"
+                              (string-append "prefix=" out)
+                              "install"))))
+          %standard-phases)))))
+    (home-page "http://www.labri.fr/perso/pelegrin/scotch/")
+    (synopsis "Programs and libraries for graph algorithms")
+    (description "SCOTCH is a set of programs and libraries which implement
+the static mapping and sparse matrix reordering algorithms developed within
+the SCOTCH project.  Its purpose is to apply graph theory, with a divide and
+conquer approach, to scientific computing problems such as graph and mesh
+partitioning, static mapping, and sparse matrix ordering, in application
+domains ranging from structural mechanics to operating systems or
+bio-chemistry.")
+    ;; See LICENSE_en.txt
+    (license license:cecill-c)))
+
+(define-public pt-scotch
+  (package (inherit scotch)
+    (name "pt-scotch")
+    (propagated-inputs
+     `(("openmpi" ,openmpi)))           ;Headers include MPI headers
+    (arguments
+     (substitute-keyword-arguments (package-arguments scotch)
+       ((#:phases scotch-phases)
+        `(alist-replace
+          'build
+          ;; TODO: Would like to add parallelism here
+          (lambda _
+            (and
+             (zero? (system* "make" "ptscotch"))
+             ;; Install the serial metis compatibility library
+             (zero? (system* "make" "-C" "libscotchmetis" "install"))))
+          (alist-replace
+           'check
+           (lambda _ (zero? (system* "make" "ptcheck")))
+           (alist-replace
+            'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let ((out (assoc-ref outputs "out")))
+                (mkdir out)
+                (zero? (system* "make"
+                                (string-append "prefix=" out)
+                                "install"))))
+            ,scotch-phases))))))
+    (synopsis "Programs and libraries for graph algorithms (with MPI)")))
+
+(define-public gsegrafix
+  (package
+    (name "gsegrafix")
+    (version "1.0.6")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://gnu/" name "/" name "-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "1b13hvx063zv970y750bx41wpx6hwd5ngjhbdrna8w8yy5kmxcda"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:configure-flags '("LDFLAGS=-lm")))
+    (inputs
+     `(("libgnomecanvas" ,libgnomecanvas)
+       ("libbonoboui" ,libbonoboui)
+       ("libgnomeui" ,libgnomeui)
+       ("libgnomeprintui" ,libgnomeprintui)
+       ("popt" ,popt)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "http://www.gnu.org/software/gsegrafix/")
+    (synopsis "GNOME application to create scientific and engineering plots")
+    (description  "GSEGrafix is an application which produces high-quality graphical
+plots for science and engineering.  Plots are specified via simple ASCII
+parameter files and data files and are presented in an anti-aliased GNOME
+canvas.  The program supports rectangular two-dimensional plots, histograms,
+polar-axis plots and three-dimensional plots.  Plots can be printed or saved
+to BMP, JPEG or PNG image formats.")
+    (license license:gpl3+)))

gnu/packages/mcrypt.scm

@@ -0,0 +1,114 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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 mcrypt)
+  #:use-module (guix packages)
+  #:use-module ((guix licenses) #:select (gpl2+))
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages file))
+
+(define-public mcrypt
+  (package
+    (name "mcrypt")
+    (version "2.6.8")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://sourceforge/mcrypt/mcrypt-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "161031n1w9pb4yzz9i47szc12a4mwpcpvyxnvafsik2l9s2aliai"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("zlib" ,zlib)
+       ("libmcrypt" ,libmcrypt)
+       ("libmhash" ,libmhash)))
+    (home-page "http://mcrypt.sourceforge.net/")
+    (synopsis "Replacement for the popular Unix crypt command")
+    (description
+     "MCrypt is a replacement for the old crypt() package and crypt(1)
+command, with extensions.  It allows developers to use a wide range of
+encryption functions, without making drastic changes to their code.  It allows
+users to encrypt files or data streams without having to be cryptographers.
+The companion to MCrypt is Libmcrypt, which contains the actual encryption
+functions themselves, and provides a standardized mechanism for accessing
+them.")
+    (license gpl2+)))
+
+(define-public libmcrypt
+  (package
+    (name "libmcrypt")
+    (version "2.5.8")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://sourceforge/mcrypt/libmcrypt-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "0gipgb939vy9m66d3k8il98rvvwczyaw2ixr8yn6icds9c3nrsz4"))))
+    (build-system gnu-build-system)
+    (native-inputs `(("file" ,file)))
+    (home-page "http://mcrypt.sourceforge.net/")
+    (synopsis "Encryption algorithm library")
+    (description
+     "Libmcrypt is a data encryption library.  The library is thread safe and
+provides encryption and decryption functions.  This version of the library
+supports many encryption algorithms and encryption modes.  Some algorithms
+which are supported: SERPENT, RIJNDAEL, 3DES, GOST, SAFER+, CAST-256, RC2,
+XTEA, 3WAY, TWOFISH, BLOWFISH, ARCFOUR, WAKE and more.")
+    (license gpl2+)))
+
+(define-public libmhash
+  (package
+    (name "libmhash")
+    (version "0.9.9.9")
+    (source
+     (origin
+      (method url-fetch)
+
+      (uri (string-append "mirror://sourceforge/mhash/mhash-"
+                          version ".tar.bz2"))
+      (sha256
+       (base32
+        "1w7yiljan8gf1ibiypi6hm3r363imm3sxl1j8hapjdq3m591qljn"))
+      (patches (list (search-patch "mhash-keygen-test-segfault.patch")))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("file" ,file)
+       ("perl" ,perl)))                 ;for tests
+    (home-page "http://mhash.sourceforge.net/")
+    (synopsis "Thread-safe hash library")
+    (description
+     "mhash is a thread-safe hash library, implemented in C, and provides a
+uniform interface to a large number of hash algorithms. These algorithms can
+be used to compute checksums, message digests, and other signatures. The HMAC
+support implements the basics for message authentication, following RFC 2104.
+
+Algorithms currently supplied are:
+
+CRC-32, CRC-32B, ALDER-32, MD-2, MD-4, MD-5, RIPEMD-128, RIPEMD-160,
+RIPEMD-256, RIPEMD-320, SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, HAVAL-128,
+HAVAL-160, HAVAL-192, HAVAL-256, TIGER, TIGER-128, TIGER-160, GOST, WHIRLPOOL,
+SNEFRU-128, SNEFRU-256")
+    (license gpl2+)))

gnu/packages/mp3.scm

@@ -30,6 +30,9 @@
   #:use-module (gnu packages pcre)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages xiph)
+  #:use-module (gnu packages pulseaudio)
+  #:use-module ((gnu packages linux)
+                #:select (alsa-lib))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu))
@@ -186,6 +189,30 @@ This package contains the binary.")
    (license license:gpl2+)
    (home-page "http://mp3splt.sourceforge.net/mp3splt_page/home.php")))
 
+(define-public mpg123
+  (package
+    (name "mpg123")
+    (version "1.19.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://sourceforge/mpg123/mpg123-"
+                                  version ".tar.bz2"))
+              (sha256
+               (base32
+                "06xhd68mj9yp0r6l771aq0d7xgnl402a3wm2mvhxmd3w3ph29446"))))
+    (build-system gnu-build-system)
+    (arguments '(#:configure-flags '("--with-default-audio=pulse")))
+    (native-inputs `(("pkg-config" ,pkg-config)))
+    (inputs `(("pulseaudio" ,pulseaudio)
+              ("alsa-lib" ,alsa-lib)))
+    (home-page "http://www.mpg123.org/")
+    (synopsis "Console MP3 player and decoder library")
+    (description
+     "mpg123 is a real time MPEG 1.0/2.0/2.5 audio player/decoder for layers
+1,2 and 3 (MPEG 1.0 layer 3 aka MP3 most commonly tested).  It comes with a
+command-line tool as well as a C library, libmpg123.")
+    (license license:lgpl2.1)))
+
 (define-public mpg321
   (package
     (name "mpg321")

gnu/packages/mpd.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <dthompson2@worcester.edu>
+;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (gnu packages avahi)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages curl)
+  #:use-module (gnu packages doxygen)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mp3)
@@ -53,9 +55,7 @@
                (base32
                 "0csb9r3nlmbwpiryixjr5k33x3zqd61xjhwmlps3a6prck1n1xw2"))))
     (build-system gnu-build-system)
-    (arguments
+    (native-inputs `(("doxygen" ,doxygen)))
-     ;; FIXME: Needs doxygen.
-     '(#:configure-flags '("--disable-documentation")))
     (synopsis "Music Player Daemon client library")
     (description "A stable, documented, asynchronous API library for
 interfacing MPD in the C, C++ & Objective C languages.")

gnu/packages/mpi.scm

@@ -0,0 +1,130 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2014 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 mpi)
+  #:use-module (guix packages)
+  #:use-module ((guix licenses)
+                #:hide (expat))
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages gcc)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages pciutils)
+  #:use-module (gnu packages xorg)
+  #:use-module (gnu packages gtk)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages ncurses)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages valgrind)
+  #:use-module (srfi srfi-1))
+
+(define-public hwloc
+  (package
+    (name "hwloc")
+    (version "1.9")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "http://www.open-mpi.org/software/hwloc/v"
+                                  version "/downloads/hwloc-"
+                                  version ".tar.bz2"))
+              (sha256
+               (base32
+                "0zjgiili2a8v63s8ly3a8qp8ibxv1jw3zbgm7diic3w1qgqiza14"))))
+    (build-system gnu-build-system)
+    (arguments
+     ;; Enable libpci support, which effectively makes hwloc GPLv2+.
+     '(#:configure-flags '("--enable-libpci")))
+    (inputs
+     `(("libx11" ,libx11)
+       ("cairo" ,cairo)
+       ("ncurses" ,ncurses)
+       ("expat" ,expat)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     ;; 'hwloc.pc' refers to libpci and libnuma, hence the propagation.
+     `(("numactl" ,numactl)
+       ("pciutils" ,pciutils)))
+    (home-page "http://www.open-mpi.org/projects/hwloc/")
+    (synopsis "Abstraction of hardware architectures")
+    (description
+     "hwloc provides a portable abstraction (across OS,
+versions, architectures, ...) of the hierarchical topology of modern
+architectures, including NUMA memory nodes, sockets, shared caches, cores and
+simultaneous multithreading.  It also gathers various attributes such as cache
+and memory information.  It primarily aims at helping high-performance
+computing applications with gathering information about the hardware so as to
+exploit it accordingly and efficiently.
+
+hwloc may display the topology in multiple convenient formats.  It also offers
+a powerful programming interface to gather information about the hardware,
+bind processes, and much more.")
+
+    ;; But see above about linking against libpci.
+    (license bsd-3)))
+
+(define-public openmpi
+  (package
+    (name "openmpi")
+    (version "1.8.1")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://www.open-mpi.org/software/ompi/v"
+                          (string-join (take (string-split version #\.) 2)
+                                       ".")
+                          "/downloads/openmpi-" version ".tar.bz2"))
+      (sha256
+       (base32
+        "13z1q69f3qwmmhpglarfjminfy2yw4rfqr9jydjk5507q3mjf50p"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("hwloc" ,hwloc)
+       ("gfortran" ,gfortran-4.8)
+       ("valgrind" ,valgrind)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (arguments
+     `(#:configure-flags `("--enable-static"
+                           "--enable-oshmem"
+                           ;; Thread support causes some applications to hang
+                           ;; "--enable-event-thread-support"
+                           ;; "--enable-opal-multi-threads"
+                           ;; "--enable-orte-progress-threads"
+                           ;; "--enable-mpi-thread-multiple"
+                           "--enable-mpi-ext=all"
+                           "--with-devel-headers"
+                           "--enable-debug"
+                           "--enable-memchecker"
+                           ,(string-append "--with-valgrind="
+                                           (assoc-ref %build-inputs "valgrind"))
+                           ,(string-append "--with-hwloc="
+                                           (assoc-ref %build-inputs "hwloc")))))
+    (home-page "http://www.open-mpi.org")
+    (synopsis "MPI-2 implementation")
+    (description
+     "The Open MPI Project is an MPI-2 implementation that is developed and
+maintained by a consortium of academic, research, and industry partners.  Open
+MPI is therefore able to combine the expertise, technologies, and resources
+from all across the High Performance Computing community in order to build the
+best MPI library available.  Open MPI offers advantages for system and
+software vendors, application developers and computer science researchers.")
+    ;; See file://LICENSE
+    (license bsd-2)))

gnu/packages/openssl.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,7 +35,10 @@
                                 ".tar.gz"))
             (sha256
              (base32
-              "0a70qdqccg16nw4bbawa6pjvzn05vfp5wkwg6jl0grch7f683jsk"))))
+              "0a70qdqccg16nw4bbawa6pjvzn05vfp5wkwg6jl0grch7f683jsk"))
+            (patches
+             (list (search-patch "openssl-CVE-2010-5298.patch")
+                   (search-patch "openssl-extension-checking-fixes.patch")))))
    (build-system gnu-build-system)
    (native-inputs `(("perl" ,perl)))
    (arguments

gnu/packages/patches/ccache-stdc-predef-test.patch

@@ -0,0 +1,157 @@
+This patch is a combination of the following commits::
+
+  https://git.samba.org/?p=ccache.git;a=commit;h=b5d63f81c1a83fd4c50b769a96a04f581b7db70c
+  https://git.samba.org/?p=ccache.git;a=commit;h=a11f5688748ecb49f590b3f4bc0e9b3458f9a56f
+  https://git.samba.org/?p=ccache.git;a=commit;h=5a9322c56ed0cd16255966e99077843aae57ab3e
+
+from the general discussion at
+http://comments.gmane.org/gmane.comp.compilers.ccache/1089
+
+--- a/test.sh
++++ b/test.sh
+@@ -562,6 +562,12 @@
+ EOF
+     backdate test1.h test2.h test3.h
+ 
++    $COMPILER -c -Wp,-MD,expected.d test.c
++    expected_d_content=`cat expected.d`
++
++    $COMPILER -c -Wp,-MMD,expected_mmd.d test.c
++    expected_mmd_d_content=`cat expected_mmd.d`
++
+     ##################################################################
+     # First compilation is a miss.
+     testname="first compilation"
+@@ -677,7 +683,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     rm -f other.d
+ 
+@@ -685,7 +691,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     rm -f other.d
+ 
+@@ -698,7 +704,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_mmd_d_content"
+ 
+     rm -f other.d
+ 
+@@ -706,7 +712,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_mmd_d_content"
+ 
+     rm -f other.d
+ 
+@@ -760,7 +766,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     rm -f test.d
+ 
+@@ -768,7 +774,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     ##################################################################
+     # Check the scenario of running a ccache with direct mode on a cache
+@@ -780,7 +786,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     rm -f test.d
+ 
+@@ -788,7 +794,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 1
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     rm -f test.d
+ 
+@@ -796,7 +802,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 2
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     rm -f test.d
+ 
+@@ -804,7 +810,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 2
+     checkstat 'cache miss' 1
+-    checkfile test.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile test.d "$expected_d_content"
+ 
+     ##################################################################
+     # Check that -MF works.
+@@ -815,7 +821,7 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     rm -f other.d
+ 
+@@ -823,7 +829,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     ##################################################################
+     # Check that a missing .d file in the cache is handled correctly.
+@@ -835,13 +841,13 @@
+     checkstat 'cache hit (direct)' 0
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     $CCACHE $COMPILER -c -MD test.c
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 0
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     find $CCACHE_DIR -name '*.d' -exec rm -f '{}' \;
+ 
+@@ -849,7 +855,7 @@
+     checkstat 'cache hit (direct)' 1
+     checkstat 'cache hit (preprocessed)' 1
+     checkstat 'cache miss' 1
+-    checkfile other.d "test.o: test.c test1.h test3.h test2.h"
++    checkfile other.d "$expected_d_content"
+ 
+     ##################################################################
+     # Check that stderr from both the preprocessor and the compiler is emitted

gnu/packages/patches/clucene-pkgconfig.patch

@@ -0,0 +1,21 @@
+Taken from the Debian package.
+
+From 7be4a19b76d98260cf95040a47935f854a4ba7a4 Mon Sep 17 00:00:00 2001
+From: Valentin Rusu <kde@rusu.info>
+Date: Sat, 17 Dec 2011 13:47:58 +0100
+Subject: [PATCH] Fix .pc file by adding clucene-shared library
+
+---
+ src/core/libclucene-core.pc.cmake |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+--- a/src/core/libclucene-core.pc.cmake
++++ b/src/core/libclucene-core.pc.cmake
+@@ -6,6 +6,6 @@ includedir=${prefix}/include:${prefix}/i
+ Name: libclucene
+ Description: CLucene - a C++ search engine, ported from the popular Apache Lucene
+ Version: @CLUCENE_VERSION_MAJOR@.@CLUCENE_VERSION_MINOR@.@CLUCENE_VERSION_REVISION@.@CLUCENE_VERSION_PATCH@
+-Libs: -L${prefix}/@LIB_DESTINATION@/ -lclucene-core
++Libs: -L${prefix}/@LIB_DESTINATION@/ -lclucene-core -lclucene-shared
+ Cflags: -I${prefix}/include -I${prefix}/include/CLucene/ext
+ ~

gnu/packages/patches/doxygen-test.patch

@@ -0,0 +1,38 @@
+Modify the expected outcome of test 012 so that it passes when bibtex is
+not in the path, as we do not wish to add texlive as an input just for this
+test.
+
+diff -u -r doxygen-1.8.7.orig/testing/012/citelist.xml doxygen-1.8.7/testing/012/citelist.xml
+--- doxygen-1.8.7.orig/testing/012/citelist.xml	2014-04-24 23:43:34.000000000 +0200
++++ doxygen-1.8.7/testing/012/citelist.xml	2014-04-24 23:49:43.000000000 +0200
+@@ -4,17 +4,6 @@
+     <compoundname>citelist</compoundname>
+     <title>Bibliography</title>
+     <detaileddescription>
+-      <para>
+-        <variablelist>
+-          <varlistentry>
+-            <term><anchor id="_1CITEREF_knuth79"/>[1]</term>
+-          </varlistentry>
+-          <listitem>
+-            <para>Donald<nonbreakablespace/>E. Knuth. <emphasis>Tex and Metafont, New Directions in Typesetting</emphasis>. American Mathematical Society and Digital Press, Stanford, 1979.</para>
+-            <para/>
+-          </listitem>
+-        </variablelist>
+-      </para>
+     </detaileddescription>
+   </compounddef>
+ </doxygen>
+diff -u -r doxygen-1.8.7.orig/testing/012/indexpage.xml doxygen-1.8.7/testing/012/indexpage.xml
+--- doxygen-1.8.7.orig/testing/012/indexpage.xml	2014-04-24 23:43:34.000000000 +0200
++++ doxygen-1.8.7/testing/012/indexpage.xml	2014-04-24 23:44:05.000000000 +0200
+@@ -4,7 +4,7 @@
+     <compoundname>index</compoundname>
+     <title>My Project</title>
+     <detaileddescription>
+-      <para>See <ref refid="citelist_1CITEREF_knuth79" kindref="member">[1]</ref> for more info. </para>
++      <para>See <ref refid="citelist_1CITEREF_knuth79" kindref="member">knuth79</ref> for more info. </para>
+     </detaileddescription>
+   </compounddef>
+ </doxygen>
+Nur in doxygen-1.8.7/testing: test_output_012.

gnu/packages/patches/doxygen-tmake.patch

@@ -0,0 +1,24 @@
+Fix the `check_unix' function, which looks for `/bin/uname' to determine
+whether we're on a Unix-like system.
+Taken from nixpkgs.
+
+--- doxygen-1.5.8/tmake/bin/tmake	2008-12-06 14:16:20.000000000 +0100
++++ doxygen-1.5.8/tmake/bin/tmake	2009-03-05 11:29:55.000000000 +0100
+@@ -234,17 +234,7 @@ sub tmake_verb {
+ #
+ 
+ sub check_unix {
+-    my($r);
+-    $r = 0;
+-    if ( -f "/bin/uname" ) {
+-	$r = 1;
+-	(-f "\\bin\\uname") && ($r = 0);
+-    }
+-    if ( -f "/usr/bin/uname" ) {
+-	$r = 1;
+-	(-f "\\usr\\bin\\uname") && ($r = 0);
+-    }
+-    return $r;
++    return 1;
+ }
+ 

gnu/packages/patches/mhash-keygen-test-segfault.patch

@@ -0,0 +1,13 @@
+This patch from resolution of https://sourceforge.net/p/mhash/bugs/37/
+
+--- a/src/keygen_test.c
++++ b/src/keygen_test.c
+@@ -121,8 +121,6 @@
+ 	
+ 	mhash_keygen_ext(KEYGEN_S2K_SALTED, data, key, keysize, password, passlen);
+ 
+-	mutils_memset(tmp, 0, keysize * 2);
+-
+ 	tmp = mutils_asciify(key, keysize);
+ 
+ 	result = mutils_strcmp((mutils_word8 *) KEY2, tmp);

gnu/packages/patches/openssl-CVE-2010-5298.patch

@@ -0,0 +1,27 @@
+From db978be7388852059cf54e42539a363d549c5bfd Mon Sep 17 00:00:00 2001
+From: Kurt Roeckx <kurt@roeckx.be>
+Date: Sun, 13 Apr 2014 15:05:30 +0200
+Subject: [PATCH] Don't release the buffer when there still is data in it
+
+RT: 2167, 3265
+---
+ ssl/s3_pkt.c | 3 ++-
+ 1 file changed, 2 insertions(+), 1 deletion(-)
+
+diff --git a/ssl/s3_pkt.c b/ssl/s3_pkt.c
+index b9e45c7..32e9207 100644
+--- a/ssl/s3_pkt.c
++++ b/ssl/s3_pkt.c
+@@ -1055,7 +1055,8 @@ int ssl3_read_bytes(SSL *s, int type, unsigned char *buf, int len, int peek)
+ 				{
+ 				s->rstate=SSL_ST_READ_HEADER;
+ 				rr->off=0;
+-				if (s->mode & SSL_MODE_RELEASE_BUFFERS)
++				if (s->mode & SSL_MODE_RELEASE_BUFFERS &&
++					s->s3->rbuf.left == 0)
+ 					ssl3_release_read_buffer(s);
+ 				}
+ 			}
+-- 
+1.9.1
+

gnu/packages/patches/openssl-extension-checking-fixes.patch

@@ -0,0 +1,40 @@
+From 300b9f0b704048f60776881f1d378c74d9c32fbd Mon Sep 17 00:00:00 2001
+From: "Dr. Stephen Henson" <steve@openssl.org>
+Date: Tue, 15 Apr 2014 18:48:54 +0100
+Subject: [PATCH] Extension checking fixes.
+
+When looking for an extension we need to set the last found
+position to -1 to properly search all extensions.
+
+PR#3309.
+---
+ crypto/x509v3/v3_purp.c | 6 +++---
+ 1 file changed, 3 insertions(+), 3 deletions(-)
+
+diff --git a/crypto/x509v3/v3_purp.c b/crypto/x509v3/v3_purp.c
+index 6c40c7d..5f931db 100644
+--- a/crypto/x509v3/v3_purp.c
++++ b/crypto/x509v3/v3_purp.c
+@@ -389,8 +389,8 @@ static void x509v3_cache_extensions(X509 *x)
+ 	/* Handle proxy certificates */
+ 	if((pci=X509_get_ext_d2i(x, NID_proxyCertInfo, NULL, NULL))) {
+ 		if (x->ex_flags & EXFLAG_CA
+-		    || X509_get_ext_by_NID(x, NID_subject_alt_name, 0) >= 0
+-		    || X509_get_ext_by_NID(x, NID_issuer_alt_name, 0) >= 0) {
++		    || X509_get_ext_by_NID(x, NID_subject_alt_name, -1) >= 0
++		    || X509_get_ext_by_NID(x, NID_issuer_alt_name, -1) >= 0) {
+ 			x->ex_flags |= EXFLAG_INVALID;
+ 		}
+ 		if (pci->pcPathLengthConstraint) {
+@@ -670,7 +670,7 @@ static int check_purpose_timestamp_sign(const X509_PURPOSE *xp, const X509 *x,
+ 		return 0;
+ 
+ 	/* Extended Key Usage MUST be critical */
+-	i_ext = X509_get_ext_by_NID((X509 *) x, NID_ext_key_usage, 0);
++	i_ext = X509_get_ext_by_NID((X509 *) x, NID_ext_key_usage, -1);
+ 	if (i_ext >= 0)
+ 		{
+ 		X509_EXTENSION *ext = X509_get_ext((X509 *) x, i_ext);
+-- 
+1.9.1
+

gnu/packages/patches/perl-tk-x11-discover.patch

@@ -0,0 +1,14 @@
+On non-x86_64 systems, this conditional can cause a specified X11 build value
+to be overwritten to null, causing x11 discovery to fail.
+
+--- a/myConfig	2014-05-12 11:16:48.152719722 -0500
++++ b/myConfig	2014-05-12 11:16:24.704719113 -0500
+@@ -350,7 +350,7 @@
+   #
+   # Prefer 64bit libraries on certain architectures
+   #
+-  unless (defined $xlib and $Config{'archname'} =~ m/x86_64/)
++  unless (defined $xlib or not $Config{'archname'} =~ m/x86_64/)
+     {
+       $xlib64 = &lX11(0, chooseX11(</usr/X11*/lib64>));
+     }

gnu/packages/patches/petsc-fix-threadcomm.patch

@@ -0,0 +1,15 @@
+Fix "error: unknown type name 'cpu_set_t'".  Patch submitted upstream
+http://lists.mcs.anl.gov/pipermail/petsc-dev/2014-May/015345.html
+
+--- a/src/sys/threadcomm/impls/openmp/tcopenmp.c	2014-03-13 21:47:22.000000000 -0500
++++ b/src/sys/threadcomm/impls/openmp/tcopenmp.c	2014-04-02 14:44:57.185170151 -0500
+@@ -1,6 +1,9 @@
+ #define PETSC_DESIRE_FEATURE_TEST_MACROS
+ #include <../src/sys/threadcomm/impls/openmp/tcopenmpimpl.h>
+ #include <omp.h>
++#if defined(PETSC_HAVE_SCHED_CPU_SET_T)
++#include <sched.h>
++#endif
+ 
+ PetscErrorCode PetscThreadCommGetRank_OpenMP(PetscInt *trank)
+ {

gnu/packages/patches/pybugz-encode-error.patch

@@ -0,0 +1,17 @@
+In case of 'AttributeError', 'value' is None, so do not try to
+access it.
+Submitted upstream.
+
+--- pybugz-0.6.11/bugz.py	2006-09-02 14:35:37.000000000 +0200
++++ pybugz-0.6.11/bugz.py	2014-05-05 16:02:20.000000000 +0200
+@@ -1249,9 +1254,9 @@ class PrettyBugz(Bugz):
+         for field, name in FIELDS + MORE_FIELDS:
+             try:
+                 value = result.find('//%s' % field).text
++                print '%-12s: %s' % (name, value.encode(self.enc))
+             except AttributeError:
+                 continue
+-            print '%-12s: %s' % (name, value.encode(self.enc))
+ 
+         # Print out the cc'ed people
+         cced = result.findall('.//cc')

gnu/packages/patches/pybugz-stty.patch

@@ -0,0 +1,19 @@
+Gracefully deal with 'stty size' failures.
+Submitted upstream.
+
+--- pybugz-0.6.11/bugz.py	2006-09-02 14:35:37.000000000 +0200
++++ pybugz-0.6.11/bugz.py	2014-05-05 15:17:03.000000000 +0200
+@@ -288,7 +288,12 @@ def get_cols():
+     stty = which('stty')
+     if stty:
+         row_cols = commands.getoutput("%s size" % stty)
+-        rows, cols = map(int, row_cols.split())
++        try:
++            rows, cols = map(int, row_cols.split())
++        except:
++            # In some cases 'stty size' will just fail with
++            # "Inappropriate ioctl for device".
++            cols = DEFAULT_NUM_COLS
+         return cols
+     else:
+         return DEFAULT_NUM_COLS

gnu/packages/patches/scotch-test-threading.patch

@@ -0,0 +1,139 @@
+* These tests assume threading support, even when the library is compiled
+  without it.  Protect these checks.
+
+* Tests should not require keyboard interaction.
+
+--- a/src/check/test_scotch_dgraph_band.c	2012-09-27 10:46:42.000000000 -0500
++++ b/src/check/test_scotch_dgraph_band.c	2014-05-13 14:36:07.479270243 -0500
+@@ -99,10 +99,12 @@
+     errorPrint ("main: Cannot initialize (1)");
+     exit       (1);
+   }
++#ifdef SCOTCH_PTHREAD
+   if (thrdlvlreqval > thrdlvlproval) {
+     errorPrint ("main: Cannot initialize (2)");
+     exit       (1);
+   }
++#endif
+ 
+   if (argc != 2) {
+     errorPrint ("main: invalid number of parameters");
+@@ -115,12 +117,14 @@
+ 
+   fprintf (stderr, "Proc %2d of %2d, pid %d\n", proclocnum, procglbnbr, getpid ());
+ 
++#ifdef SCOTCH_DEBUG_CHECK2
+   if (proclocnum == 0) {                          /* Synchronize on keybord input */
+     char           c;
+ 
+     printf ("Waiting for key press...\n");
+     scanf ("%c", &c);
+   }
++#endif /* SCOTCH_DEBUG_CHECK2 */
+ 
+   if (MPI_Barrier (proccomm) != MPI_SUCCESS) {    /* Synchronize for debug */
+     errorPrint ("main: cannot communicate");
+--- a/src/check/test_scotch_dgraph_grow.c	2012-11-30 12:19:33.000000000 -0600
++++ b/src/check/test_scotch_dgraph_grow.c	2014-05-13 14:35:31.307269303 -0500
+@@ -103,10 +103,12 @@
+     errorPrint ("main: Cannot initialize (1)");
+     exit       (1);
+   }
++#ifdef SCOTCH_PTHREAD
+   if (thrdlvlreqval > thrdlvlproval) {
+     errorPrint ("main: Cannot initialize (2)");
+     exit       (1);
+   }
++#endif
+ 
+   if (argc != 2) {
+     errorPrint ("main: invalid number of parameters");
+@@ -119,12 +121,14 @@
+ 
+   fprintf (stderr, "Proc %2d of %2d, pid %d\n", proclocnum, procglbnbr, getpid ());
+ 
++#ifdef SCOTCH_DEBUG_CHECK2
+   if (proclocnum == 0) {                          /* Synchronize on keybord input */
+     char           c;
+ 
+     printf ("Waiting for key press...\n");
+     scanf ("%c", &c);
+   }
++#endif /* SCOTCH_DEBUG_CHECK2 */
+ 
+   if (MPI_Barrier (proccomm) != MPI_SUCCESS) {    /* Synchronize for debug */
+     errorPrint ("main: cannot communicate");
+--- a/src/check/test_scotch_dgraph_redist.c	2012-09-26 11:42:27.000000000 -0500
++++ b/src/check/test_scotch_dgraph_redist.c	2014-05-13 14:34:30.323267722 -0500
+@@ -98,10 +98,12 @@
+     errorPrint ("main: Cannot initialize (1)");
+     exit       (1);
+   }
++#ifdef SCOTCH_PTHREAD
+   if (thrdlvlreqval > thrdlvlproval) {
+     errorPrint ("main: Cannot initialize (2)");
+     exit       (1);
+   }
++#endif
+ 
+   if (argc != 2) {
+     errorPrint ("main: invalid number of parameters");
+@@ -114,7 +116,6 @@
+ 
+   fprintf (stderr, "Proc %2d of %2d, pid %d\n", proclocnum, procglbnbr, getpid ());
+ 
+-#define SCOTCH_DEBUG_CHECK2
+ #ifdef SCOTCH_DEBUG_CHECK2
+   if (proclocnum == 0) {                          /* Synchronize on keybord input */
+     char           c;
+--- /tmp/nix-build-scotch-6.0.0.drv-9/scotch_6.0.0/src/check/test_common_thread.c	2012-11-30 11:05:23.000000000 -0600
++++ scotch_6.0.0/src/check/test_common_thread.c	2014-05-13 17:26:27.159535244 -0500
+@@ -90,7 +90,7 @@
+ /*                       */
+ /*************************/
+ 
+-#if ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD))
++#ifdef SCOTCH_PTHREAD
+ 
+ static
+ void
+@@ -161,7 +161,7 @@
+   return (o);
+ }
+ 
+-#endif /* ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD)) */
++#endif /* SCOTCH_PTHREAD */
+ 
+ /*********************/
+ /*                   */
+@@ -175,14 +175,14 @@
+ char *              argv[])
+ {
+   TestThreadGroup       groudat;
+-#if ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD))
++#ifdef SCOTCH_PTHREAD
+   TestThread * restrict thrdtab;
+   int                   thrdnbr;
+-#endif /* ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD)) */
++#endif /* SCOTCH_PTHREAD */
+ 
+   SCOTCH_errorProg (argv[0]);
+ 
+-#if ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD))
++#ifdef SCOTCH_PTHREAD
+   thrdnbr = SCOTCH_PTHREAD_NUMBER;
+ 
+   groudat.redusum = COMPVAL (thrdnbr);
+@@ -197,9 +197,9 @@
+     errorPrint ("main: cannot launch or run threads");
+     return     (1);
+   }
+-#else /* ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD)) */
+-  printf ("Scotch not compiled with either COMMON_PTHREAD or SCOTCH_PTHREAD\n");
+-#endif /* ((defined COMMON_PTHREAD) || (defined SCOTCH_PTHREAD)) */
++#else /* not SCOTCH_PTHREAD */
++  printf ("Scotch not compiled with SCOTCH_PTHREAD\n");
++#endif /* not SCOTCH_PTHREAD */
+ 
+   return (0);
+ }

gnu/packages/patches/soprano-find-clucene.patch

@@ -0,0 +1,15 @@
+Search for clucene include file in the clucene include directory.
+
+diff -u -r soprano-2.9.4.orig/cmake/modules/FindCLucene.cmake soprano-2.9.4/cmake/modules/FindCLucene.cmake
+--- soprano-2.9.4.orig/cmake/modules/FindCLucene.cmake	2013-10-09 19:22:28.000000000 +0200
++++ soprano-2.9.4/cmake/modules/FindCLucene.cmake	2014-04-28 20:08:11.000000000 +0200
+@@ -77,7 +77,8 @@
+ 
+ get_filename_component(TRIAL_LIBRARY_DIR ${CLUCENE_LIBRARY} PATH)
+ find_path(CLUCENE_LIBRARY_DIR
+-  NAMES CLucene/clucene-config.h PATHS ${TRIAL_LIBRARY_DIR} ${TRIAL_LIBRARY_PATHS} ${TRIAL_INCLUDE_PATHS} NO_DEFAULT_PATH)
++  NAMES CLucene/clucene-config.h PATHS ${TRIAL_LIBRARY_DIR} ${TRIAL_LIBRARY_PATHS} ${TRIAL_INCLUDE_PATHS} ${CLUCENE_INCLUDE_DIR} NO_DEFAULT_PATH)
++message (STATUS "XXX ${CLUCENE_LIBRARY_DIR}")
+ if(CLUCENE_LIBRARY_DIR)
+   message(STATUS "Found CLucene library dir: ${CLUCENE_LIBRARY_DIR}")
+   file(READ ${CLUCENE_LIBRARY_DIR}/CLucene/clucene-config.h CLCONTENT)

gnu/packages/patches/superlu-dist-scotchmetis.patch

@@ -0,0 +1,21 @@
+The METIS interface from Scotch may segfault if passed NULL to indicate a
+default parameter, so use the older calling style.
+
+--- a/SRC/get_perm_c.c	2014-05-16 23:38:30.070835316 -0500
++++ b/SRC/get_perm_c.c	2014-05-16 23:39:04.582836211 -0500
+@@ -70,11 +70,13 @@
+ #else
+ 
+     /* Earlier version 3.x.x */
+-    /* METIS_NodeND(&nm, b_colptr, b_rowind, &numflag, metis_options,
+-       perm, iperm);*/
++    METIS_NodeND(&nm, b_colptr, b_rowind, &numflag, metis_options,
++                 perm, iperm);
+ 
+     /* Latest version 4.x.x */
++#if 0
+     METIS_NodeND(&nm, b_colptr, b_rowind, NULL, NULL, perm, iperm);
++#endif
+ 
+     /*check_perm_dist("metis perm",  n, perm);*/
+ #endif

gnu/packages/pciutils.scm

@@ -0,0 +1,91 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 pciutils)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module ((guix licenses)
+                #:renamer (symbol-prefix-proc 'license:))
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages which))
+
+(define-public pciutils
+  (package
+    (name "pciutils")
+    (version "3.2.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "mirror://kernel.org/software/utils/pciutils/pciutils-"
+                    version
+                    ".tar.bz2"))
+              (sha256
+               (base32
+                "0d9as9jzjjg5c1nwf58z1y1i7rf9fqxmww1civckhcvcn0xr85mq"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-replace
+                 'configure
+                 (lambda* (#:key outputs #:allow-other-keys)
+                   ;; There's no 'configure' script, just a raw makefile.
+                   (substitute* "Makefile"
+                     (("^PREFIX=.*$")
+                      (string-append "PREFIX := " (assoc-ref outputs "out")
+                                     "\n"))
+                     (("^MANDIR:=.*$")
+                       ;; By default the thing tries to automatically
+                       ;; determine whether to use $prefix/man or
+                       ;; $prefix/share/man, and wrongly so.
+                      (string-append "MANDIR := " (assoc-ref outputs "out")
+                                     "/share/man\n"))
+                     (("^SHARED=.*$")
+                      ;; Build libpciutils.so.
+                      "SHARED := yes\n")
+                     (("^ZLIB=.*$")
+                      ;; Ask for zlib support.
+                      "ZLIB := yes\n")))
+
+                 (alist-replace
+                  'install
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    ;; Install the commands, library, and .pc files.
+                    (zero? (system* "make" "install" "install-lib")))
+                  %standard-phases))
+
+       ;; Make sure programs have an RPATH so they can find libpciutils.so.
+       #:make-flags (list (string-append "LDFLAGS=-Wl,-rpath="
+                                         (assoc-ref %outputs "out") "/lib"))
+
+       ;; No test suite.
+       #:tests? #f))
+    (native-inputs
+     `(("which" ,which)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     ;; TODO: Add dependency on Linux libkmod.
+     `(("zlib" ,zlib)))
+    (home-page "http://mj.ucw.cz/sw/pciutils/")
+    (synopsis "Programs for inspecting and manipulating PCI devices")
+    (description
+     "The PCI Utilities are a collection of programs for inspecting and
+manipulating configuration of PCI devices, all based on a common portable
+library libpci which offers access to the PCI configuration space on a variety
+of operating systems.  This includes the 'lspci' and 'setpci' commands.")
+    (license license:gpl2+)))

gnu/packages/perl.scm

@@ -106,14 +106,14 @@ matching a regular expression.")
 (define-public perl-io-tty
   (package
     (name "perl-io-tty")
-    (version "1.10")
+    (version "1.11")
     (source (origin
               (method url-fetch)
               (uri (string-append "mirror://cpan/authors/id/T/TO/TODDR/IO-Tty-"
                                   version ".tar.gz"))
               (sha256
                (base32
-                "1cgqyv1zg8857inlnfczrrgpqr0r6mmqv29b7jlmxv47s4df59ii"))))
+                "0lgd9xcbi4gf4gw1ka6fj94my3w1f3k1zamb4pfln0qxz45zlxx4"))))
     (build-system perl-build-system)
     (home-page "http://search.cpan.org/~toddr/IO-Tty/")
     (synopsis "Perl interface to pseudo ttys")

gnu/packages/python.scm

@@ -21,7 +21,7 @@
 
 (define-module (gnu packages python)
   #:use-module ((guix licenses)
-                #:select (bsd-3 bsd-style psfl x11 x11-style
+                #:select (bsd-3 bsd-style expat psfl x11 x11-style
                           gpl2 gpl2+ lgpl2.1+))
   #:use-module ((guix licenses) #:select (zlib)
                                 #:renamer (symbol-prefix-proc 'license:))
@@ -293,6 +293,55 @@ etc. ")
 (define-public python2-babel
   (package-with-python2 python-babel))
 
+(define-public python-lockfile
+  (package
+    (name "python-lockfile")
+    (version "0.9.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://pypi.python.org/packages/source/l/lockfile/"
+                           "lockfile-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0iwif7i84gwpvrnpv4brshdk8j6l77smvknm8k3bg77mj6f5ini3"))))
+    (build-system python-build-system)
+    (arguments '(#:test-target "check"))
+    (home-page "http://code.google.com/p/pylockfile/")
+    (synopsis "Platform-independent file locking module")
+    (description
+     "The lockfile package exports a LockFile class which provides a simple
+API for locking files.")
+    (license expat)))
+
+(define-public python2-lockfile
+  (package-with-python2 python-lockfile))
+
+(define-public python-mock
+  (package
+    (name "python-mock")
+    (version "1.0.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://pypi.python.org/packages/source/m/mock/"
+                           "mock-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0kzlsbki6q0awf89rc287f3aj8x431lrajf160a70z0ikhnxsfdq"))))
+    (build-system python-build-system)
+    (arguments '(#:test-target "check"))
+    (home-page "http://code.google.com/m/mock/")
+    (synopsis "A Python Mocking and Patching Library for Testing")
+    (description
+     "Mock is a library for testing in Python.  It allows you to replace parts
+of your system under test with mock objects and make assertions about how they
+have been used.")
+    (license expat)))
+
+(define-public python2-mock
+  (package-with-python2 python-mock))
+
 
 (define-public python-setuptools
   (package
@@ -578,7 +627,10 @@ commands.")
                     version ".tar.gz"))
               (sha256
                (base32
-                "17ni00p08gp5lkxlrrcnvi3x09fmajnlbz4da03qcgl9q21ym4jd"))))
+                "17ni00p08gp5lkxlrrcnvi3x09fmajnlbz4da03qcgl9q21ym4jd"))
+              (patches (map search-patch
+                            (list "pybugz-stty.patch"
+                                  "pybugz-encode-error.patch")))))
     (build-system python-build-system)
     (arguments
      `(#:python ,python-2                         ; SyntaxError with Python 3

gnu/packages/qemu.scm

@@ -44,14 +44,14 @@
   ;; This is QEMU without GUI support.
   (package
     (name "qemu-headless")
-    (version "1.7.1")
+    (version "2.0.0")
     (source (origin
              (method url-fetch)
              (uri (string-append "http://wiki.qemu-project.org/download/qemu-"
                                  version ".tar.bz2"))
              (sha256
               (base32
-               "1x5y06zhp0gc97g1sb98vf7dkawg63xywv0mbnpfnbi20jh452fn"))))
+               "0frsahiw56jr4cqr9m6s383lyj4ar9hfs2wp3y4yr76krah1mk30"))))
     (build-system gnu-build-system)
     (arguments
      '(#:phases (alist-replace

gnu/packages/qt.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -150,7 +150,7 @@ developers using C++ or QML, a CSS & JavaScript like language.")
 
 (define-public qt-4
   (package (inherit qt)
-    (version "4.8.5")
+    (version "4.8.6")
     (source (origin
              (method url-fetch)
              (uri (string-append "http://download.qt-project.org/official_releases/qt/"
@@ -160,10 +160,11 @@ developers using C++ or QML, a CSS & JavaScript like language.")
                                  version ".tar.gz"))
              (sha256
               (base32
-               "0f51dbgn1dcck8pqimls2qyf1pfmsmyknh767cvw87c3d218ywpb"))
+               "0b036iqgmbbv37dgwwfihw3mihjbnw3kb5kaisdy0qi8nn8xs54b"))
              (patches (list (search-patch "qt4-tests.patch")))))
     (inputs `(,@(alist-delete "libjpeg" (package-inputs qt))
-              ("libjepg" ,libjpeg-8)))
+              ("libjepg" ,libjpeg-8)
+              ("libsm" ,libsm)))
     (arguments
      `(#:phases
          (alist-replace

gnu/packages/rdf.scm

@@ -17,13 +17,22 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages rdf)
-  #:use-module ((guix licenses) #:select (lgpl2.0+ lgpl2.1+))
+  #:use-module ((guix licenses) #:select (lgpl2.0+ lgpl2.1 lgpl2.1+))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages bdb)
+  #:use-module (gnu packages boost)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages curl)
+  #:use-module (gnu packages doxygen)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages multiprecision)
+  #:use-module (gnu packages pcre)
+  #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages qt)
   #:use-module (gnu packages xml))
@@ -60,15 +69,107 @@ Turtle 2013, N-Quads, N-Triples 1.1, Atom 1.0, RSS 1.0, GraphViz DOT,
 HTML and JSON.")
     (license lgpl2.1+))) ; or any choice of gpl2+ or asl2.0
 
+(define-public clucene
+  (package
+    (name "clucene")
+    (version "2.3.3.4")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://sourceforge/clucene/"
+                                 "clucene-core-unstable/2.3/clucene-core-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32
+               "1arffdwivig88kkx685pldr784njm0249k0rb1f1plwavlrw9zfx"))
+             (patches (list (search-patch "clucene-pkgconfig.patch")))))
+    (build-system cmake-build-system)
+    (inputs
+     `(("boost" ,boost) ; could also use bundled copy
+       ("zlib" ,zlib)))
+    (arguments
+     `(#:test-target "cl_test"
+       #:tests? #f)) ; Tests do not compile, as TestIndexSearcher.cpp uses
+                     ; undeclared usleep. After fixing this, one needs to run
+                     ; "make test" in addition to "make cl_test", then
+                     ; SimpleTest fails.
+                     ; Notice that the library appears to be unmaintained
+                     ; with no reaction to bug reports.
+    (home-page "http://clucene.sourceforge.net/")
+    (synopsis "C text indexing and searching library")
+    (description "CLucene is a high-performance, scalable, cross platform,
+full-featured indexing and searching API.  It is a port of the very popular
+Java Lucene text search engine API to C++.")
+    (license lgpl2.1)))
+
+(define-public rasqal
+  (package
+    (name "rasqal")
+    (version "0.9.32")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://download.librdf.org/source/" name
+                                 "-" version ".tar.gz"))
+             (sha256
+              (base32
+               "13rfprkk7d74065c7bafyshajwa6lshj7m9l741zlz9viqhh7fpf"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("perl" ,perl)
+       ("perl-xml-dom" ,perl-xml-dom) ; for the tests
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("libgcrypt" ,libgcrypt)
+       ("libxml2" ,libxml2)
+       ("mpfr" ,mpfr)
+       ("pcre" ,pcre)
+       ("util-linux" ,util-linux)))
+    (propagated-inputs
+     `(("raptor2" ,raptor2))) ; stipulated by rasqal.pc
+    (arguments
+     `(#:parallel-tests? #f
+       ; test failure reported upstream, see
+       ; http://bugs.librdf.org/mantis/view.php?id=571
+       #:tests? #f))
+    (home-page "http://librdf.org/rasqal/")
+    (synopsis "RDF query library")
+    (description "Rasqal is a C library that handles Resource Description
+Framework (RDF) query language syntaxes, query construction and execution
+of queries returning results as bindings, boolean, RDF graphs/triples or
+syntaxes.  The supported query languages are SPARQL Query 1.0,
+SPARQL Query 1.1, SPARQL Update 1.1 (no executing) and the Experimental
+SPARQL extensions (LAQRS).  Rasqal can write binding query results in the
+SPARQL XML, SPARQL JSON, CSV, TSV, HTML, ASCII tables, RDF/XML and
+Turtle/N3 and read them in SPARQL XML, RDF/XML and Turtle/N3.")
+    (license lgpl2.1+))) ; or any choice of gpl2+ or asl2.0
+
+(define-public redland
+  (package
+    (name "redland")
+    (version "1.0.17")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://download.librdf.org/source/" name
+                                 "-" version ".tar.gz"))
+             (sha256
+              (base32
+               "109n0kp39p966dpiasad2bb7q66rwbcb9avjvimw28chnpvlf66y"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("perl" ,perl) ; needed for installation
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("bdb" ,bdb)
+       ("rasqal" ,rasqal)))
+    (home-page "http://librdf.org/")
+    (synopsis "RDF library")
+    (description "The Redland RDF Library (librdf) provides the RDF API
+and triple stores.")
+    (license lgpl2.1+))) ; or any choice of gpl2+ or asl2.0
+
 (define-public soprano
   (package
     (name "soprano")
-    (version "2.9.3")
+    (version "2.9.4")
-    ;; 2.9.4 requires clucene, see
-    ;; http://www.mailinglistarchive.com/html/lfs-book@linuxfromscratch.org/2013-10/msg00285.html
-    ;; The stable clucene-0.9.21b fails one of its tests;
-    ;; in the unstable clucene-2.3.3.4 the binary cl_test is not found.
-    ;; In any case, the library seems to be unmaintained.
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/soprano/Soprano/"
@@ -76,14 +177,17 @@ HTML and JSON.")
                                 "soprano-" version ".tar.bz2"))
              (sha256
               (base32
-               "08gb5d8bgy7vc6qd6r1kkmmc5rli67dlglpjqjlahpnvs26r1cwl"))))
+               "1rg0x7yg0a1cbnxz7kqk52580wla8jbnj4d4r3j7l7g7ajyny1k4"))
+             (patches (list (search-patch "soprano-find-clucene.patch")))))
     (build-system cmake-build-system)
-    ;; FIXME: Add optional dependencies: Redland, odbci, clucene; doxygen
     (native-inputs
-     `(("pkg-config" ,pkg-config)))
+     `(("doxygen" ,doxygen)
+       ("pkg-config" ,pkg-config)))
     (inputs
-     `(("qt" ,qt-4)
+     `(("clucene" ,clucene)
-       ("raptor2" ,raptor2)))
+       ("qt" ,qt-4)
+       ("rasqal" ,rasqal)
+       ("redland" ,redland)))
     (home-page "http://soprano.sourceforge.net/")
     (synopsis "RDF data library for Qt")
     (description "Soprano (formerly known as QRDF) is a library which

gnu/packages/rsync.scm

@@ -20,6 +20,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages acl)
+  #:use-module (gnu packages which)
   #:use-module (guix licenses)
   #:use-module (guix packages)
   #:use-module (guix download)
@@ -49,3 +50,29 @@ by sending only the differences between the source files and the existing
 files in the destination.")
    (license gpl3+)
    (home-page "http://rsync.samba.org/")))
+
+(define-public librsync
+  (package
+    (name "librsync")
+    (version "0.9.7")
+       (source (origin
+            (method url-fetch)
+            (uri (string-append "mirror://sourceforge/librsync/librsync/"
+                                version "/librsync-" version ".tar.gz"))
+            (sha256
+             (base32
+              "1mj1pj99mgf1a59q9f2mxjli2fzxpnf55233pc1klxk2arhf8cv6"))))
+   (build-system gnu-build-system)
+   (native-inputs
+    `(("which" ,which)
+      ("perl" ,perl)))
+   (arguments '(#:configure-flags '("--enable-shared")))
+   (home-page "http://librsync.sourceforge.net/")
+   (synopsis "Implementation of the rsync remote-delta algorithm")
+   (description
+    "Librsync is a free software library that implements the rsync
+remote-delta algorithm.  This algorithm allows efficient remote updates of a
+file, without requiring the old and new versions to both be present at the
+sending end. The library uses a \"streaming\" design similar to that of zlib
+with the aim of allowing it to be embedded into many different applications.")
+   (license lgpl2.1+)))

gnu/packages/screen.scm

@@ -29,13 +29,13 @@
 (define-public screen
   (package
     (name "screen")
-    (version "4.0.3")
+    (version "4.2.1")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/screen/screen-"
                                  version ".tar.gz"))
              (sha256
-              (base32 "0xvckv1ia5pjxk7fs4za6gz2njwmfd54sc464n8ab13096qxbw3q"))))
+              (base32 "105hp6qdd8rl71p81klmxiz4mlb60kh9r7czayrx40g38x858s2l"))))
     (build-system gnu-build-system)
     (inputs
      `(("ncurses", ncurses)

gnu/packages/sdl.scm

@@ -147,12 +147,17 @@ other supporting functions for SDL.")
               (base32
                "16an9slbb8ci7d89wakkmyfvp7c0cval8xw4hkg0842nhhlp540b"))))
     (build-system gnu-build-system)
+    (native-inputs `(("pkg-config" ,pkg-config)))
     ;; FIXME: Add webp
-    (inputs `(("libpng" ,libpng)
+    ;;
-              ("libjpeg" ,libjpeg)
+    ;; libjpeg, libpng, and libtiff are propagated inputs because the
-              ("libtiff" ,libtiff)
+    ;; SDL_image headers include the headers of these libraries.  SDL is a
-              ("pkg-config" ,pkg-config)))
+    ;; propagated input because the pkg-config file refers to SDL's pkg-config
-    (propagated-inputs `(("sdl" ,sdl)))
+    ;; file.
+    (propagated-inputs `(("sdl" ,sdl)
+                         ("libjpeg" ,libjpeg)
+                         ("libpng" ,libpng)
+                         ("libtiff" ,libtiff)))
     (synopsis "SDL image loading library")
     (description "SDL_image is an image file loading library for SDL that
 supports the following formats: BMP, GIF, JPEG, LBM, PCX, PNG, PNM, TGA, TIFF,

gnu/packages/slim.scm

@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Guy Grant <gzg@riseup.net>
 ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,15 +76,8 @@
                       ;; "systemd".  Strip that.
                       "")))
 		 %standard-phases)
-       #:configure-flags '("-DUSE_PAM=yes" "-DUSE_CONSOLEKIT=no"
+       #:configure-flags '("-DUSE_PAM=yes"
-
+                           "-DUSE_CONSOLEKIT=no")
-                           ;; Don't build libslim.so, because then the build
-                           ;; system is unable to set the right RUNPATH on the
-                           ;; 'slim' binary.
-                           "-DBUILD_SHARED_LIBS=OFF"
-
-                           ;; Leave a valid RUNPATH upon install.
-                           "-DCMAKE_SKIP_BUILD_RPATH=ON")
        #:tests? #f))
     (home-page "http://slim.berlios.de/")
     (synopsis "Desktop-independent graphcal login manager for X11")

gnu/packages/ssh.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -53,39 +53,10 @@
                 "1jyaj9h1iglvn02hrvcchbx8ycjpj8b91h8mi459k7q5jp2xgd9b"))))
     (build-system cmake-build-system)
     (arguments
-     '(#:configure-flags '("-DWITH_GCRYPT=ON"
+     '(#:configure-flags '("-DWITH_GCRYPT=ON")
-
-                           ;; Leave a valid RUNPATH upon install.
-                           "-DCMAKE_SKIP_BUILD_RPATH=ON")
 
        ;; TODO: Add 'CMockery' and '-DWITH_TESTING=ON' for the test suite.
-       #:tests? #f
+       #:tests? #f))
-
-       #:modules ((guix build cmake-build-system)
-                  (guix build utils)
-                  (guix build rpath))
-       #:imported-modules ((guix build gnu-build-system)
-                           (guix build cmake-build-system)
-                           (guix build utils)
-                           (guix build rpath))
-
-       #:phases (alist-cons-after
-                 'install 'augment-runpath
-                 (lambda* (#:key outputs #:allow-other-keys)
-                   ;; libssh_threads.so NEEDs libssh.so, so add $libdir to its
-                   ;; RUNPATH.
-                   (define (dereference file)
-                     (let ((target (false-if-exception (readlink file))))
-                       (if target
-                           (dereference target)
-                           file)))
-
-                   (let* ((out (assoc-ref outputs "out"))
-                          (lib (string-append out "/lib")))
-                     (with-directory-excursion lib
-                       (augment-rpath (dereference "libssh_threads.so")
-                                      lib))))
-                 %standard-phases)))
     (inputs `(("zlib" ,zlib)
                ;; Link against an older gcrypt, because libssh tries to access
                ;; fields of 'gcry_thread_cbs' that are now private:

gnu/packages/tcl.scm

@@ -23,6 +23,7 @@
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system perl)
+  #:use-module (gnu packages)
   #:use-module (gnu packages libpng)
   #:use-module (gnu packages libjpeg)
   #:use-module (gnu packages perl)
@@ -177,7 +178,8 @@ X11 GUIs.")
                    version ".tar.gz"))
              (sha256
               (base32
-               "0jarvplhfvnm0shhdm2a5zczlnk9mkf8jvfjiwyhjrr3cy1gl0w0"))))
+               "0jarvplhfvnm0shhdm2a5zczlnk9mkf8jvfjiwyhjrr3cy1gl0w0"))
+             (patches (list (search-patch "perl-tk-x11-discover.patch")))))
     (build-system perl-build-system)
     (native-inputs `(("pkg-config" ,pkg-config)))
     (inputs `(("libx11" ,libx11)

gnu/packages/version-control.scm

@@ -21,7 +21,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages version-control)
-  #:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2 gpl2+ gpl3+))
+  #:use-module ((guix licenses)
+                #:select (asl2.0 gpl1+ gpl2 gpl2+ gpl3+ x11-style))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
@@ -413,3 +414,24 @@ when a file change has been described in the ChangeLog but the file has not
 been added to the VC.  vc-chlog scans changed files and generates
 standards-compliant ChangeLog entries based on the changes that it detects.")
     (license gpl3+)))
+
+(define-public diffstat
+  (package
+    (name "diffstat")
+    (version "1.58")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "ftp://invisible-island.net/diffstat/diffstat-"
+                    version ".tgz"))
+              (sha256
+               (base32
+                "14rpf5c05ff30f6vn6pn6pzy0k4g4is5im656ahsxff3k58i7mgs"))))
+    (build-system gnu-build-system)
+    (home-page "http://invisible-island.net/diffstat/")
+    (synopsis "Make histograms from the output of 'diff'")
+    (description
+     "diffstat reads the output of 'diff' and displays a histogram of the
+insertions, deletions, and modifications per-file.  It is useful for reviewing
+large, complex patch files.")
+    (license (x11-style "file://COPYING"))))

gnu/packages/video.scm

@@ -17,19 +17,37 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages video)
-  #:use-module ((guix licenses) #:select (gpl2+))
+  #:use-module ((guix licenses) #:select (gpl2 gpl2+))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages algebra)
+  #:use-module (gnu packages avahi)
+  #:use-module (gnu packages cdrom)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages fontutils)
+  #:use-module (gnu packages gl)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages gnutls)
+  #:use-module (gnu packages libjpeg)
+  #:use-module (gnu packages libpng)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages lua)
+  #:use-module (gnu packages mp3)
   #:use-module (gnu packages openssl)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages pulseaudio)
   #:use-module (gnu packages python)
+  #:use-module (gnu packages qt)
+  #:use-module (gnu packages sdl)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu packages version-control)
   #:use-module (gnu packages xiph)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages xorg)
   #:use-module (gnu packages yasm))
 
 (define-public ffmpeg
@@ -192,3 +210,161 @@
 convert and stream audio and video.  It includes the libavcodec
 audio/video codec library.")
     (license gpl2+)))
+
+(define-public vlc
+  (package
+    (name "vlc")
+    (version "2.1.4")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append
+                   "http://download.videolan.org/pub/videolan/vlc/"
+                   version "/vlc-" version ".tar.xz"))
+             (sha256
+              (base32
+               "1lymhbb2bns73qivdaqanhggjjhyc9fwfgf5ikhng0a74msnqmiy"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("git" ,git) ; needed for a test
+       ("pkg-config" ,pkg-config)))
+    ;; FIXME: Add optional inputs once available.
+    (inputs
+     `(("alsa-lib" ,alsa-lib)
+       ("avahi" ,avahi)
+       ("dbus" ,dbus)
+       ("flac" ,flac)
+       ("ffmpeg" ,ffmpeg)
+       ("fontconfig" ,fontconfig)
+       ("freetype" ,freetype)
+       ("gnutls" ,gnutls)
+       ("libcddb" ,libcddb)
+       ("libgcrypt" ,libgcrypt)
+       ("libkate" ,libkate)
+       ("libmad" ,libmad)
+       ("libogg" ,libogg)
+       ("libpng" ,libpng)
+       ("libsamplerate" ,libsamplerate)
+       ("libssh2" ,libssh2)
+       ("libvorbis" ,libvorbis)
+       ("libtheora" ,libtheora)
+       ("libxext" ,libxext)
+       ("libxinerama" ,libxinerama)
+       ("libxml2" ,libxml2)
+       ("libxpm" ,libxpm)
+       ("lua" ,lua-5.1)
+       ("mesa" ,mesa)
+       ("opus" ,opus)
+       ("perl" ,perl)
+       ("pulseaudio" ,pulseaudio)
+       ("python" ,python-wrapper)
+       ("qt" ,qt-4)
+       ("sdl" ,sdl)
+       ("sdl-image" ,sdl-image)
+       ("speex" ,speex)
+       ("xcb-util-keysyms" ,xcb-util-keysyms)))
+    (arguments
+     `(#:configure-flags
+       `("--disable-a52" ; FIXME: reenable once available
+         "--disable-mmx" ; FIXME: may be enabled on x86_64
+         "--disable-sse" ; 1-4, no separate options available
+         "--disable-neon"
+         "--disable-altivec"
+         ,(string-append "LDFLAGS=-Wl,-rpath -Wl,"
+                         (assoc-ref %build-inputs "ffmpeg")
+                         "/lib")))) ; needed for the tests
+    (home-page "https://www.videolan.org/")
+    (synopsis "Audio and video framework")
+    (description "VLC is a cross-platform multimedia player and framework
+that plays most multimedia files as well as DVD, Audio CD, VCD, and various
+treaming protocols.")
+    (license gpl2+)))
+
+(define-public mplayer
+  (package
+    (name "mplayer")
+    (version "1.1.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append
+                   "http://www.mplayerhq.hu/MPlayer/releases/MPlayer-"
+                   version ".tar.xz"))
+             (sha256
+              (base32
+               "0xlcg7rszrwmw29wqr0plsw5d1rq0hb7vjsq7bmmfsly2z1wg3yf"))))
+    (build-system gnu-build-system)
+    ;; FIXME: Add additional inputs once available.
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (inputs
+     `(("alsa-lib" ,alsa-lib)
+       ("cdparanoia" ,cdparanoia)
+       ("fontconfig" ,fontconfig)
+       ("freetype" ,freetype)
+       ("lame" ,lame)
+       ("libmpg123" ,mpg123)                      ; audio codec for MP3
+;;        ("giflib" ,giflib) ; uses QuantizeBuffer, requires version >= 5
+       ("libjpeg" ,libjpeg)
+       ("libpng" ,libpng)
+       ("libtheora" ,libtheora)
+       ("libvorbis" ,libvorbis)
+       ("libx11" ,libx11)
+       ("libxxf86dga" ,libxxf86dga)
+       ("libxinerama" ,libxinerama)
+       ("libxv" ,libxv)
+       ("mesa" ,mesa)
+       ("perl" ,perl)
+       ("pulseaudio" ,pulseaudio)
+       ("python" ,python-wrapper)
+       ("sdl" ,sdl)
+       ("speex" ,speex)
+       ("yasm" ,yasm)
+       ("zlib" ,zlib)))
+    (arguments
+     `(#:tests? #f ; no test target
+       #:phases
+         (alist-replace
+          'configure
+          ;; configure does not work followed by "SHELL=..." and
+          ;; "CONFIG_SHELL=..."; set environment variables instead
+          (lambda* (#:key inputs outputs #:allow-other-keys)
+            (let ((out (assoc-ref outputs "out"))
+                  (libx11 (assoc-ref inputs "libx11")))
+              (substitute* "configure"
+                (("#! /bin/sh") (string-append "#!" (which "bash"))))
+              (setenv "SHELL" (which "bash"))
+              (setenv "CONFIG_SHELL" (which "bash"))
+              (zero? (system*
+                      "./configure"
+                      (string-append "--extra-cflags=-I"
+                                     libx11 "/include") ; to detect libx11
+                      "--disable-tremor-internal" ; forces external libvorbis
+                      (string-append "--prefix=" out)
+                      ;; drop special machine instructions not supported
+                      ;; on all instances of the target
+                      ,@(if (string-prefix? "x86_64"
+                                            (or (%current-target-system)
+                                                (%current-system)))
+                            '()
+                            '("--disable-3dnow"
+                              "--disable-3dnowext"
+                              "--disable-mmx"
+                              "--disable-mmxext"
+                              "--disable-sse"
+                              "--disable-sse2"))
+                      "--disable-ssse3"
+                      "--disable-altivec"
+                      "--disable-armv5te"
+                      "--disable-armv6"
+                      "--disable-armv6t2"
+                      "--disable-armvfp"
+                      "--disable-neon"
+                      "--disable-thumb"
+                      "--disable-iwmmxt"))))
+          %standard-phases)))
+    (home-page "http://www.mplayerhq.hu/design7/news.html")
+    (synopsis "Audio and video player")
+    (description "MPlayer is a movie player.  It plays most MPEG/VOB, AVI,
+Ogg/OGM, VIVO, ASF/WMA/WMV, QT/MOV/MP4, RealMedia, Matroska, NUT,
+NuppelVideo, FLI, YUV4MPEG, FILM, RoQ, PVA files.  One can watch VideoCD,
+SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
+    (license gpl2)))

gnu/packages/wdiff.scm

@@ -28,7 +28,7 @@
 (define-public wdiff
   (package
     (name "wdiff")
-    (version "1.2.1")
+    (version "1.2.2")
     (source
      (origin
       (method url-fetch)
@@ -36,7 +36,7 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "1gb5hpiyikada9bwz63q3g96zs383iskiir0xsqynqnvq1vd4n41"))))
+        "0sxgg0ms5lhi4aqqvz1rj4s77yi9wymfm3l3gbjfd1qchy66kzrl"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (alist-cons-before

gnu/packages/xiph.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
@@ -25,6 +25,7 @@
   #:use-module (gnu packages bison)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages curl)
+  #:use-module (gnu packages doxygen)
   #:use-module (gnu packages libpng)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python)
@@ -231,12 +232,13 @@ meaning that audio is compressed in FLAC without any loss in quality.")
              (base32
               "0s3vr2nxfxlf1k75iqpp4l78yf4gil3f0v778kvlngbchvaq23n4"))))
    (build-system gnu-build-system)
-   ;; FIXME: Add optional inputs doxygen (for documentation) and liboggz
+   (native-inputs `(("doxygen" ,doxygen)
+                    ("pkg-config" ,pkg-config)))
+   ;; FIXME: Add optional input liboggz
    (inputs `(("bison" ,bison)
              ("libogg" ,libogg)
              ("libpng" ,libpng)
-             ("pkg-config" ,pkg-config)
+("python" ,python-wrapper)
-             ("python" ,python-wrapper)
              ("zlib" ,zlib)))
    (synopsis "kate, a karaoke and text codec for embedding in ogg")
    (description

gnu/packages/xorg.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
@@ -1153,10 +1153,11 @@ tracking.")
           (base32
             "07bzi6xwlhq36f60qfspjbz0qjj7zcgayi1vp4ihgx34kib1vhck"))))
     (build-system gnu-build-system)
+    (propagated-inputs
+      `(("libice" ,libice))) ; SMlib.h includes ICElib.h
     (inputs
       `(("xtrans" ,xtrans)
-        ("util-linux" ,util-linux)
+        ("util-linux" ,util-linux)))
-        ("libice" ,libice)))
     (native-inputs
       `(("pkg-config" ,pkg-config)))
     (home-page "http://www.x.org/wiki/")
@@ -1427,10 +1428,11 @@ tracking.")
           (base32
             "15291ddhyr54sribwbg8hxx2psgzm5gh0pgkw5yrf3zgvdsa67sm"))))
     (build-system gnu-build-system)
+    (propagated-inputs
+      `(("xf86dgaproto" ,xf86dgaproto)))
     (inputs
       `(("libx11" ,libx11)
-        ("libxext" ,libxext)
+        ("libxext" ,libxext)))
-        ("xf86dgaproto" ,xf86dgaproto)))
     (native-inputs
       `(("pkg-config" ,pkg-config)))
     (home-page "http://www.x.org/wiki/")
@@ -4733,14 +4735,14 @@ icccm: Both client and window-manager helpers for ICCCM.")
 (define-public xterm
   (package
     (name "xterm")
-    (version "303")
+    (version "304")
     (source (origin
               (method url-fetch)
-              (uri                                ; XXX: constant URL!
+              (uri (string-append "ftp://ftp.invisible-island.net/xterm/"
-               "http://invisible-island.net/datafiles/release/xterm.tar.gz")
+                                  "xterm-" version ".tgz"))
               (sha256
                (base32
-                "0n7hay16aam9kfn642ri0wj5yzilbjm3l8znxc2p5dx9pn3rkwla"))))
+                "19yp5phfzzgydc2yqka4p69ygvfzsd2aa98hbw086xyjlws3kbyk"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--enable-wide-chars" "--enable-256-color"

gnu/services.scm

@@ -26,7 +26,7 @@
             service-respawn?
             service-start
             service-stop
-            service-inputs
+            service-activate
             service-user-accounts
             service-user-groups
             service-pam-services))
@@ -47,16 +47,16 @@
                  (default '()))
   (respawn?      service-respawn?                 ; Boolean
                  (default #t))
-  (start         service-start)                   ; expression
+  (start         service-start)                   ; g-expression
-  (stop          service-stop                     ; expression
+  (stop          service-stop                     ; g-expression
                  (default #f))
-  (inputs        service-inputs                   ; list of inputs
-                 (default '()))
   (user-accounts service-user-accounts            ; list of <user-account>
                  (default '()))
   (user-groups   service-user-groups              ; list of <user-groups>
                  (default '()))
   (pam-services  service-pam-services             ; list of <pam-service>
-                 (default '())))
+                 (default '()))
+  (activate      service-activate                 ; gexp
+                 (default #f)))
 
 ;;; services.scm ends here.

gnu/services/avahi.scm

@@ -0,0 +1,108 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 services avahi)
+  #:use-module (gnu services)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages avahi)
+  #:use-module (guix monads)
+  #:use-module (guix gexp)
+  #:export (avahi-service))
+
+;;; Commentary:
+;;;
+;;; This module provides service definitions for the Avahi
+;;; "zero-configuration" tool set.
+;;;
+;;; Code:
+
+(define* (configuration-file #:key host-name publish?
+                             ipv4? ipv6? wide-area? domains-to-browse)
+  "Return an avahi-daemon configuration file."
+  (define (bool value)
+    (if value "yes\n" "no\n"))
+
+  (text-file "avahi-daemon.conf"
+             (string-append
+              "[server]\n"
+              (if host-name
+                  (string-append "host-name=" host-name "\n")
+                  "")
+
+              "browse-domains=" (string-join domains-to-browse)
+              "\n"
+              "use-ipv4=" (bool ipv4?)
+              "use-ipv6=" (bool ipv6?)
+              "[wide-area]\n"
+              "enable-wide-area=" (bool wide-area?)
+              "[publish]\n"
+              "disable-publishing=" (bool (not publish?)))))
+
+(define* (avahi-service #:key (avahi avahi)
+                        host-name
+                        (publish? #t)
+                        (ipv4? #t) (ipv6? #t)
+                        wide-area?
+                        (domains-to-browse '()))
+  "Return a service that runs @command{avahi-daemon}, a system-wide
+mDNS/DNS-SD responder that allows for service discovery and
+\"zero-configuration\" host name lookups.
+
+If @var{host-name} is different from @code{#f}, use that as the host name to
+publish for this machine; otherwise, use the machine's actual host name.
+
+When @var{publish?} is true, publishing of host names and services is allowed;
+in particular, avahi-daemon will publish the machine's host name and IP
+address via mDNS on the local network.
+
+When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled.
+
+Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6
+sockets."
+  (mlet %store-monad ((config (configuration-file #:host-name host-name
+                                                  #:publish? publish?
+                                                  #:ipv4? ipv4?
+                                                  #:ipv6? ipv6?
+                                                  #:wide-area? wide-area?
+                                                  #:domains-to-browse
+                                                  domains-to-browse)))
+    (return
+     (service
+      (documentation "Run the Avahi mDNS/DNS-SD responder.")
+      (provision '(avahi-daemon))
+      (requirement '(dbus-system networking))
+
+      (start #~(make-forkexec-constructor
+                (string-append #$avahi "/sbin/avahi-daemon")
+                "--syslog" "-f" #$config))
+      (stop #~(make-kill-destructor))
+      (activate #~(begin
+                    (use-modules (guix build utils))
+                    (mkdir-p "/var/run/avahi-daemon")))
+
+      (user-groups (list (user-group
+                          (name "avahi"))))
+      (user-accounts (list (user-account
+                            (name "avahi")
+                            (group "avahi")
+                            (comment "Avahi daemon user")
+                            (home-directory "/var/empty")
+                            (shell
+                             "/run/current-system/profile/sbin/nologin"))))))))
+
+;;; avahi.scm ends here

gnu/services/base.scm

@@ -24,11 +24,15 @@
   #:use-module ((gnu packages base)
                 #:select (glibc-final))
   #:use-module (gnu packages package-management)
+  #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 format)
-  #:export (host-name-service
+  #:export (root-file-system-service
+            file-system-service
+            user-processes-service
+            host-name-service
             mingetty-service
             nscd-service
             syslog-service
@@ -42,14 +46,148 @@
 ;;;
 ;;; Code:
 
+(define (root-file-system-service)
+  "Return a service whose sole purpose is to re-mount read-only the root file
+system upon shutdown (aka. cleanly \"umounting\" root.)
+
+This service must be the root of the service dependency graph so that its
+'stop' action is invoked when dmd is the only process left."
+  (with-monad %store-monad
+    (return
+     (service
+      (documentation "Take care of the root file system.")
+      (provision '(root-file-system))
+      (start #~(const #t))
+      (stop #~(lambda _
+                ;; Return #f if successfully stopped.
+                (sync)
+
+                (call-with-blocked-asyncs
+                 (lambda ()
+                   (let ((null (%make-void-port "w")))
+                     ;; Close 'dmd.log'.
+                     (display "closing log\n")
+                     ;; XXX: Ideally we'd use 'stop-logging', but that one
+                     ;; doesn't actually close the port as of dmd 0.1.
+                     (close-port (@@ (dmd comm) log-output-port))
+                     (set! (@@ (dmd comm) log-output-port) null)
+
+                     ;; Redirect the default output ports..
+                     (set-current-output-port null)
+                     (set-current-error-port null)
+
+                     ;; Close /dev/console.
+                     (for-each close-fdes '(0 1 2))
+
+                     ;; At this point, there are no open files left, so the
+                     ;; root file system can be re-mounted read-only.
+                     (mount #f "/" #f
+                            (logior MS_REMOUNT MS_RDONLY)
+                            #:update-mtab? #f)
+
+                     #f)))))
+      (respawn? #f)))))
+
+(define* (file-system-service device target type
+                              #:key (check? #t) options)
+  "Return a service that mounts DEVICE on TARGET as a file system TYPE with
+OPTIONS.  When CHECK? is true, check the file system before mounting it."
+  (with-monad %store-monad
+    (return
+     (service
+      (provision (list (symbol-append 'file-system- (string->symbol target))))
+      (requirement '(root-file-system))
+      (documentation "Check, mount, and unmount the given file system.")
+      (start #~(lambda args
+                 #$(if check?
+                       #~(check-file-system #$device #$type)
+                       #~#t)
+                 (mount #$device #$target #$type 0 #$options)
+                 #t))
+      (stop #~(lambda args
+                ;; Normally there are no processes left at this point, so
+                ;; TARGET can be safely unmounted.
+                (umount #$target)
+                #f))))))
+
+(define %do-not-kill-file
+  ;; Name of the file listing PIDs of processes that must survive when halting
+  ;; the system.  Typical example is user-space file systems.
+  "/etc/dmd/do-not-kill")
+
+(define* (user-processes-service requirements #:key (grace-delay 2))
+  "Return the service that is responsible for terminating all the processes so
+that the root file system can be re-mounted read-only, just before
+rebooting/halting.  Processes still running GRACE-DELAY seconds after SIGTERM
+has been sent are terminated with SIGKILL.
+
+The returned service will depend on 'root-file-system' and on all the services
+listed in REQUIREMENTS.
+
+All the services that spawn processes must depend on this one so that they are
+stopped before 'kill' is called."
+  (with-monad %store-monad
+    (return (service
+             (documentation "When stopped, terminate all user processes.")
+             (provision '(user-processes))
+             (requirement (cons 'root-file-system requirements))
+             (start #~(const #t))
+             (stop #~(lambda _
+                       (define (kill-except omit signal)
+                         ;; Kill all the processes with SIGNAL except those
+                         ;; listed in OMIT and the current process.
+                         (let ((omit (cons (getpid) omit)))
+                           (for-each (lambda (pid)
+                                       (unless (memv pid omit)
+                                         (false-if-exception
+                                          (kill pid signal))))
+                                     (processes))))
+
+                       (define omitted-pids
+                         ;; List of PIDs that must not be killed.
+                         (if (file-exists? #$%do-not-kill-file)
+                             (map string->number
+                                  (call-with-input-file #$%do-not-kill-file
+                                    (compose string-tokenize
+                                             (@ (ice-9 rdelim) read-string))))
+                             '()))
+
+                       ;; When this happens, all the processes have been
+                       ;; killed, including 'deco', so DMD-OUTPUT-PORT and
+                       ;; thus CURRENT-OUTPUT-PORT are dangling.
+                       (call-with-output-file "/dev/console"
+                         (lambda (port)
+                           (display "sending all processes the TERM signal\n"
+                                    port)))
+
+                       (if (null? omitted-pids)
+                           (begin
+                             ;; Easy: terminate all of them.
+                             (kill -1 SIGTERM)
+                             (sleep #$grace-delay)
+                             (kill -1 SIGKILL))
+                           (begin
+                             ;; Kill them all except OMITTED-PIDS.  XXX: We
+                             ;; would like to (kill -1 SIGSTOP) to get a fixed
+                             ;; list of processes, like 'killall5' does, but
+                             ;; that seems unreliable.
+                             (kill-except omitted-pids SIGTERM)
+                             (sleep #$grace-delay)
+                             (kill-except omitted-pids SIGKILL)
+                             (delete-file #$%do-not-kill-file)))
+
+                       (display "all processes have been terminated\n")
+                       #f))
+             (respawn? #f)))))
+
 (define (host-name-service name)
   "Return a service that sets the host name to NAME."
   (with-monad %store-monad
     (return (service
              (documentation "Initialize the machine's host name.")
              (provision '(host-name))
-             (start `(lambda _
+             (start #~(lambda _
-                       (sethostname ,name)))
+                        (sethostname #$name)))
              (respawn? #f)))))
 
 (define* (mingetty-service tty
@@ -57,8 +195,7 @@
                            (motd (text-file "motd" "Welcome.\n"))
                            (allow-empty-passwords? #t))
   "Return a service to run mingetty on TTY."
-  (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty"))
+  (mlet %store-monad ((motd motd))
-                      (motd         motd))
     (return
      (service
       (documentation (string-append "Run mingetty on " tty "."))
@@ -66,12 +203,12 @@
 
       ;; Since the login prompt shows the host name, wait for the 'host-name'
       ;; service to be done.
-      (requirement '(host-name))
+      (requirement '(user-processes host-name))
 
-      (start  `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
+      (start  #~(make-forkexec-constructor
-      (stop   `(make-kill-destructor))
+                 (string-append #$mingetty "/sbin/mingetty")
-      (inputs `(("mingetty" ,mingetty)
+                 "--noclear" #$tty))
-                ("motd" ,motd)))
+      (stop   #~(make-kill-destructor))
 
       (pam-services
        ;; Let 'login' be known to PAM.  All the mingetty services will have
@@ -83,16 +220,23 @@
 
 (define* (nscd-service #:key (glibc glibc-final))
   "Return a service that runs libc's name service cache daemon (nscd)."
-  (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
+  (with-monad %store-monad
     (return (service
              (documentation "Run libc's name service cache daemon (nscd).")
              (provision '(nscd))
-             (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
+             (requirement '(user-processes))
-                                                "--foreground"))
-             (stop  `(make-kill-destructor))
 
-             (respawn? #f)
+             (activate #~(begin
-             (inputs `(("glibc" ,glibc)))))))
+                           (use-modules (guix build utils))
+                           (mkdir-p "/var/run/nscd")))
+
+             (start
+              #~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd")
+                                           "-f" "/dev/null"
+                                           "--foreground"))
+             (stop #~(make-kill-destructor))
+
+             (respawn? #f)))))
 
 (define (syslog-service)
   "Return a service that runs 'syslogd' with reasonable default settings."
@@ -120,21 +264,22 @@
 ")
 
   (mlet %store-monad
-      ((syslog.conf (text-file "syslog.conf" contents))
+      ((syslog.conf (text-file "syslog.conf" contents)))
-       (syslogd     (package-file inetutils "libexec/syslogd")))
     (return
      (service
       (documentation "Run the syslog daemon (syslogd).")
       (provision '(syslogd))
-      (start `(make-forkexec-constructor ,syslogd "--no-detach"
+      (requirement '(user-processes))
-                                         "--rcfile" ,syslog.conf))
+      (start
-      (stop  `(make-kill-destructor))
+       #~(make-forkexec-constructor (string-append #$inetutils
-      (inputs `(("inetutils" ,inetutils)
+                                                   "/libexec/syslogd")
-                ("syslog.conf" ,syslog.conf)))))))
+                                    "--no-detach"
+                                    "--rcfile" #$syslog.conf))
+      (stop #~(make-kill-destructor))))))
 
 (define* (guix-build-accounts count #:key
+                              (group "guixbuild")
                               (first-uid 30001)
-                              (gid 30000)
                               (shadow shadow))
   "Return a list of COUNT user accounts for Guix build users, with UIDs
 starting at FIRST-UID, and under GID."
@@ -143,34 +288,32 @@ starting at FIRST-UID, and under GID."
                     (lambda (n)
                       (user-account
                        (name (format #f "guixbuilder~2,'0d" n))
-                       (password "!")
                        (uid (+ first-uid n -1))
-                       (gid gid)
+                       (group group)
                        (comment (format #f "Guix Build User ~2d" n))
                        (home-directory "/var/empty")
-                       (shell (package-file shadow "sbin/nologin"))
+                       (shell #~(string-append #$shadow "/sbin/nologin"))))
-                       (inputs `(("shadow" ,shadow)))))
                     1+
                     1))))
 
 (define* (guix-service #:key (guix guix) (builder-group "guixbuild")
-                       (build-user-gid 30000) (build-accounts 10))
+                       (build-accounts 10))
   "Return a service that runs the build daemon from GUIX, and has
 BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
-  (mlet %store-monad ((daemon   (package-file guix "bin/guix-daemon"))
+  (mlet %store-monad ((accounts (guix-build-accounts build-accounts
-                      (accounts (guix-build-accounts build-accounts
+                                                     #:group builder-group)))
-                                                     #:gid build-user-gid)))
     (return (service
              (provision '(guix-daemon))
-             (start `(make-forkexec-constructor ,daemon
+             (requirement '(user-processes))
-                                                "--build-users-group"
+             (start
-                                                ,builder-group))
+              #~(make-forkexec-constructor (string-append #$guix
-             (stop  `(make-kill-destructor))
+                                                          "/bin/guix-daemon")
-             (inputs `(("guix" ,guix)))
+                                           "--build-users-group"
+                                           #$builder-group))
+             (stop #~(make-kill-destructor))
              (user-accounts accounts)
              (user-groups (list (user-group
                                  (name builder-group)
-                                 (id build-user-gid)
                                  (members (map user-account-name
                                                user-accounts)))))))))
 

gnu/services/dbus.scm

@@ -0,0 +1,120 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 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 services dbus)
+  #:use-module (gnu services)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages glib)
+  #:use-module (guix monads)
+  #:use-module (guix gexp)
+  #:export (dbus-service))
+
+;;; Commentary:
+;;;
+;;; This module supports the configuration of the D-Bus message bus
+;;; (http://dbus.freedesktop.org/).  D-Bus is an inter-process communication
+;;; facility.  Its "system bus" is used to allow system services to
+;;; communicate and be notified of system-wide events.
+;;;
+;;; Code:
+
+(define (dbus-configuration-directory dbus services)
+  "Return a configuration directory for @var{dbus} that includes the
+@code{etc/dbus-1/system.d} directories of each package listed in
+@var{services}."
+  (define build
+    #~(begin
+        (use-modules (sxml simple))
+
+        (define (services->sxml services)
+          ;; Return the SXML 'includedir' clauses for DIRS.
+          `(busconfig
+            ,@(map (lambda (dir)
+                     `(includedir ,(string-append dir
+                                                  "/etc/dbus-1/system.d")))
+                   services)))
+
+        (mkdir #$output)
+        (copy-file (string-append #$dbus "/etc/dbus-1/system.conf")
+                   (string-append #$output "/system.conf"))
+
+        ;; The default 'system.conf' has an <includedir> clause for
+        ;; 'system.d', so create it.
+        (mkdir (string-append #$output "/system.d"))
+
+        ;; 'system-local.conf' is automatically included by the default
+        ;; 'system.conf', so this is where we stuff our own things.
+        (call-with-output-file (string-append #$output "/system-local.conf")
+          (lambda (port)
+            (sxml->xml (services->sxml (list #$@services))
+                       port)))))
+
+  (gexp->derivation "dbus-configuration" build))
+
+(define* (dbus-service services #:key (dbus dbus))
+  "Return a service that runs the system bus, using @var{dbus}, with support
+for @var{services}.
+
+@var{services} must be a list of packages that provide an
+@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
+and policy files.  For example, to allow avahi-daemon to use the system bus,
+@var{services} must be equal to @code{(list avahi)}."
+  (mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
+    (return
+     (service
+      (documentation "Run the D-Bus system daemon.")
+      (provision '(dbus-system))
+      (requirement '(user-processes))
+      (start #~(make-forkexec-constructor
+                (string-append #$dbus "/bin/dbus-daemon")
+                "--nofork"
+                (string-append "--config-file=" #$conf "/system.conf")))
+      (stop #~(make-kill-destructor))
+      (user-groups (list (user-group
+                          (name "messagebus"))))
+      (user-accounts (list (user-account
+                            (name "messagebus")
+                            (group "messagebus")
+                            (comment "D-Bus system bus user")
+                            (home-directory "/var/run/dbus")
+                            (shell
+                             "/run/current-system/profile/sbin/nologin"))))
+      (activate #~(begin
+                    (use-modules (guix build utils))
+
+                    (mkdir-p "/var/run/dbus")
+
+                    (let ((user (getpwnam "messagebus")))
+                      (chown "/var/run/dbus"
+                             (passwd:uid user) (passwd:gid user)))
+
+                    (unless (file-exists? "/etc/machine-id")
+                      (format #t "creating /etc/machine-id...~%")
+                      (let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
+                        ;; XXX: We can't use 'system' because the initrd's
+                        ;; guile system(3) only works when 'sh' is in $PATH.
+                        (let ((pid (primitive-fork)))
+                          (if (zero? pid)
+                              (call-with-output-file "/etc/machine-id"
+                                (lambda (port)
+                                  (close-fdes 1)
+                                  (dup2 (port->fdes port) 1)
+                                  (execl prog)))
+                              (waitpid pid)))))))))))
+
+;;; dbus.scm ends here

gnu/services/dmd.scm

@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services dmd)
+  #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (gnu services)
   #:use-module (ice-9 match)
@@ -29,52 +30,45 @@
 ;;;
 ;;; Code:
 
-(define (dmd-configuration-file services etc)
+(define (dmd-configuration-file services)
-  "Return the dmd configuration file for SERVICES, that initializes /etc from
+  "Return the dmd configuration file for SERVICES."
-ETC (the name of a directory in the store) on startup."
+  (define modules
-  (define config
+    ;; Extra modules visible to dmd.conf.
-    `(begin
+    '((guix build syscalls)
-       (use-modules (ice-9 ftw))
+      (guix build linux-initrd)
+      (guix build utils)))
 
-       (register-services
+  (mlet %store-monad ((modules  (imported-modules modules))
-        ,@(map (lambda (service)
+                      (compiled (compiled-modules modules)))
-                `(make <service>
+    (define config
-                   #:docstring ',(service-documentation service)
+      #~(begin
-                   #:provides ',(service-provision service)
+          (eval-when (expand load eval)
-                   #:requires ',(service-requirement service)
+            (set! %load-path (cons #$modules %load-path))
-                   #:respawn? ',(service-respawn? service)
+            (set! %load-compiled-path
-                   #:start ,(service-start service)
+                  (cons #$compiled %load-compiled-path)))
-                   #:stop ,(service-stop service)))
-               services))
 
-       ;; /etc is a mixture of static and dynamic settings.  Here is where we
+          (use-modules (ice-9 ftw)
-       ;; initialize it from the static part.
+                       (guix build syscalls)
-       (format #t "populating /etc from ~a...~%" ,etc)
+                       ((guix build linux-initrd)
-       (let ((rm-f (lambda (f)
+                        #:select (check-file-system)))
-                     (false-if-exception (delete-file f)))))
-         (rm-f "/etc/static")
-         (symlink ,etc "/etc/static")
-         (for-each (lambda (file)
-                     ;; TODO: Handle 'shadow' specially so that changed
-                     ;; password aren't lost.
-                     (let ((target (string-append "/etc/" file))
-                           (source (string-append "/etc/static/" file)))
-                       (rm-f target)
-                       (symlink source target)))
-                   (scandir ,etc
-                            (lambda (file)
-                              (not (member file '("." ".."))))))
 
-         ;; Prevent ETC from being GC'd.
+          (register-services
-         (rm-f "/var/guix/gcroots/etc-directory")
+           #$@(map (lambda (service)
-         (symlink ,etc "/var/guix/gcroots/etc-directory"))
+                     #~(make <service>
+                         #:docstring '#$(service-documentation service)
+                         #:provides '#$(service-provision service)
+                         #:requires '#$(service-requirement service)
+                         #:respawn? '#$(service-respawn? service)
+                         #:start #$(service-start service)
+                         #:stop #$(service-stop service)))
+                   services))
 
-       ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
+          ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
-       (setenv "PATH" "/run/current-system/bin")
+          (setenv "PATH" "/run/current-system/profile/bin")
 
-       (format #t "starting services...~%")
+          (format #t "starting services...~%")
-       (for-each start ',(append-map service-provision services))))
+          (for-each start '#$(append-map service-provision services))))
 
-  (text-file "dmd.conf" (object->string config)))
+    (gexp->file "dmd.conf" config)))
 
 ;;; dmd.scm ends here

gnu/services/networking.scm

@@ -20,6 +20,7 @@
   #:use-module (gnu services)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages linux)
+  #:use-module (guix gexp)
   #:use-module (guix monads)
   #:export (static-networking-service))
 
@@ -41,40 +42,41 @@ true, it must be a string specifying the default network gateway."
   ;; TODO: Eventually we should do this using Guile's networking procedures,
   ;; like 'configure-qemu-networking' does, but the patch that does this is
   ;; not yet in stock Guile.
-  (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
+  (with-monad %store-monad
-                      (route    (package-file net-tools "sbin/route")))
     (return
      (service
       (documentation
        (string-append "Set up networking on the '" interface
                       "' interface using a static IP address."))
       (provision '(networking))
-      (start `(lambda _
+      (start #~(lambda _
-                ;; Return #t if successfully started.
+                 ;; Return #t if successfully started.
-                (and (zero? (system* ,ifconfig ,interface ,ip "up"))
+                 (and (zero? (system* (string-append #$inetutils
-                     ,(if gateway
+                                                     "/bin/ifconfig")
-                          `(zero? (system* ,route "add" "-net" "default"
+                                      #$interface #$ip "up"))
-                                           "gw" ,gateway))
+                      #$(if gateway
-                          #t)
+                            #~(zero? (system* (string-append #$net-tools
-                     ,(if (pair? name-servers)
+                                                             "/sbin/route")
-                          `(call-with-output-file "/etc/resolv.conf"
+                                              "add" "-net" "default"
-                             (lambda (port)
+                                              "gw" #$gateway))
-                               (display
+                            #t)
-                                "# Generated by 'static-networking-service'.\n"
+                      #$(if (pair? name-servers)
-                                port)
+                            #~(call-with-output-file "/etc/resolv.conf"
-                               (for-each (lambda (server)
+                                (lambda (port)
-                                           (format port "nameserver ~a~%"
+                                  (display
-                                                   server))
+                                   "# Generated by 'static-networking-service'.\n"
-                                         ',name-servers)))
+                                   port)
-                          #t))))
+                                  (for-each (lambda (server)
-      (stop  `(lambda _
+                                              (format port "nameserver ~a~%"
+                                                      server))
+                                            '#$name-servers)))
+                            #t))))
+      (stop #~(lambda _
                 ;; Return #f is successfully stopped.
-                (not (and (system* ,ifconfig ,interface "down")
+                (not (and (system* (string-append #$inetutils "/bin/ifconfig")
-                          (system* ,route "del" "-net" "default")))))
+                                   #$interface "down")
-      (respawn? #f)
+                          (system* (string-append #$net-tools "/sbin/route")
-      (inputs `(("inetutils" ,inetutils)
+                                   "del" "-net" "default")))))
-                ,@(if gateway
+      (respawn? #f)))))
-                      `(("net-tools" ,net-tools))
-                      '())))))))
 
 ;;; networking.scm ends here

gnu/services/xorg.scm

@@ -27,6 +27,7 @@
   #:use-module (gnu packages gnustep)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)
+  #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix derivations)
   #:export (xorg-start-command
@@ -86,77 +87,42 @@ Section \"Screen\"
   Device \"Device-vesa\"
 EndSection"))
 
-  (mlet %store-monad ((guile-bin   (package-file guile "bin/guile"))
+  (mlet %store-monad ((config (xserver.conf)))
-                      (xorg-bin    (package-file xorg-server "bin/X"))
+    (define script
-                      (dri         (package-file mesa "lib/dri"))
-                      (xkbcomp-bin (package-file xkbcomp "bin"))
-                      (xkb-dir     (package-file xkeyboard-config
-                                                 "share/X11/xkb"))
-                      (config      (xserver.conf)))
-    (define builder
       ;; Write a small wrapper around the X server.
-      `(let ((out (assoc-ref %outputs "out")))
+      #~(begin
-         (call-with-output-file out
+          (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
-           (lambda (port)
+          (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
-             (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
-             (write '(begin
-                       (setenv "XORG_DRI_DRIVER_PATH" ,dri)
-                       (setenv "XKB_BINDIR" ,xkbcomp-bin)
 
-                       (apply execl
+          (apply execl (string-append #$xorg-server "/bin/X")
+                 "-ac" "-logverbose" "-verbose"
+                 "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
+                 "-config" #$config
+                 "-nolisten" "tcp" "-terminate"
 
-                              ,xorg-bin "-ac" "-logverbose" "-verbose"
+                 ;; Note: SLiM and other display managers add the
-                              "-xkbdir" ,xkb-dir
+                 ;; '-auth' flag by themselves.
-                              "-config" ,(derivation->output-path config)
+                 (cdr (command-line)))))
-                              "-nolisten" "tcp" "-terminate"
 
-                              ;; Note: SLiM and other display managers add the
+    (gexp->script "start-xorg" script)))
-                              ;; '-auth' flag by themselves.
-                              (cdr (command-line))))
-                    port)))
-         (chmod out #o555)
-         #t))
-
-    (mlet %store-monad ((inputs (lower-inputs
-                                 `(("xorg" ,xorg-server)
-                                   ("xkbcomp" ,xkbcomp)
-                                   ("xkeyboard-config" ,xkeyboard-config)
-                                   ("mesa" ,mesa)
-                                   ("guile" ,guile)
-                                   ("xorg.conf" ,config)))))
-      (derivation-expression "start-xorg" builder
-                             #:inputs inputs))))
 
 (define* (xinitrc #:key
                   (guile guile-final)
                   (ratpoison ratpoison)
                   (windowmaker windowmaker))
   "Return a system-wide xinitrc script that starts the specified X session."
-  (mlet %store-monad ((guile-bin     (package-file guile "bin/guile"))
+  (define builder
-                      (ratpoison-bin (package-file ratpoison "bin/ratpoison"))
+    #~(begin
-                      (wmaker-bin    (package-file windowmaker "bin/wmaker"))
+        (use-modules (ice-9 match))
-                      (inputs        (lower-inputs
-                                      `(("raptoison" ,ratpoison)
-                                        ("wmaker" ,windowmaker)))))
-    (define builder
-      `(let ((out (assoc-ref %outputs "out")))
-         (call-with-output-file out
-           (lambda (port)
-             (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
-             (write '(begin
-                       (use-modules (ice-9 match))
 
-                       ;; TODO: Check for ~/.xsession.
+        ;; TODO: Check for ~/.xsession.
-                       (match (command-line)
+        (match (command-line)
-                         ((_ "ratpoison")
+          ((_ "ratpoison")
-                          (execl ,ratpoison-bin))
+           (execl (string-append #$ratpoison "/bin/ratpoison")))
-                         (_
+          (_
-                          (execl ,wmaker-bin))))
+           (execl (string-append #$windowmaker "/bin/wmaker"))))))
-                    port)))
-         (chmod out #o555)
-         #t))
 
-    (derivation-expression "xinitrc" builder #:inputs inputs)))
+  (gexp->script "xinitrc" builder))
 
 (define* (slim-service #:key (slim slim)
                        (allow-empty-passwords? #t) auto-login?
@@ -173,7 +139,7 @@ When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
     (mlet %store-monad ((startx  (or startx (xorg-start-command)))
                         (xinitrc (xinitrc)))
       (text-file* "slim.cfg"  "
-default_path /run/current-system/bin
+default_path /run/current-system/profile/bin
 default_xserver " startx "
 xserver_arguments :0 vt7
 xauth_path " xauth "/bin/xauth
@@ -181,7 +147,7 @@ authfile /var/run/slim.auth
 
 # The login command.  '%session' is replaced by the chosen session name, one
 # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
-login_cmd  exec " xinitrc "%session
+login_cmd  exec " xinitrc " %session
 sessions   wmaker,ratpoison
 
 halt_cmd " dmd "/sbin/halt
@@ -190,25 +156,19 @@ reboot_cmd " dmd "/sbin/reboot
       (string-append "auto_login yes\ndefault_user " default-user)
       ""))))
 
-  (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
+  (mlet %store-monad ((slim.cfg (slim.cfg)))
-                      (bash-bin (package-file bash "bin/bash"))
-                      (slim.cfg (slim.cfg)))
     (return
      (service
       (documentation "Xorg display server")
       (provision '(xorg-server))
-      (requirement '(host-name))
+      (requirement '(user-processes host-name))
       (start
        ;; XXX: Work around the inability to specify env. vars. directly.
-       `(make-forkexec-constructor
+       #~(make-forkexec-constructor
-         ,bash-bin "-c"
+          (string-append #$bash "/bin/sh") "-c"
-         ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
+          (string-append "SLIM_CFGFILE=" #$slim.cfg
-                         " " slim-bin
+                         " " #$slim "/bin/slim" " -nodaemon")))
-                         " -nodaemon")))
+      (stop #~(make-kill-destructor))
-      (stop  `(make-kill-destructor))
-      (inputs `(("slim" ,slim)
-                ("slim.cfg" ,slim.cfg)
-                ("bash" ,bash)))
       (respawn? #t)
       (pam-services
        ;; Tell PAM about 'slim'.

gnu/system.scm

@@ -19,6 +19,7 @@
 (define-module (gnu system)
   #:use-module (guix store)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix derivations)
@@ -33,14 +34,17 @@
   #:use-module (gnu system shadow)
   #:use-module (gnu system linux)
   #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system file-systems)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (operating-system
             operating-system?
+
+            operating-system-bootloader
             operating-system-services
+            operating-system-user-services
             operating-system-packages
-            operating-system-bootloader-entries
             operating-system-host-name
             operating-system-kernel
             operating-system-initrd
@@ -49,10 +53,11 @@
             operating-system-packages
             operating-system-timezone
             operating-system-locale
-            operating-system-services
+            operating-system-file-systems
 
-            operating-system-profile-directory
+            operating-system-derivation
-            operating-system-derivation))
+            operating-system-profile
+            operating-system-grub.cfg))
 
 ;;; Commentary:
 ;;;
@@ -67,12 +72,10 @@
   operating-system?
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
-  (bootloader operating-system-bootloader         ; package
+  (bootloader operating-system-bootloader)        ; <grub-configuration>
-              (default grub))
+
-  (bootloader-entries operating-system-bootloader-entries ; list
+  (initrd operating-system-initrd                 ; (list fs) -> M derivation
-                      (default '()))
+          (default qemu-initrd))
-  (initrd operating-system-initrd                 ; monadic derivation
-          (default (gnu-system-initrd)))
 
   (host-name operating-system-host-name)          ; string
 
@@ -84,11 +87,10 @@
   (groups operating-system-groups                 ; list of user groups
           (default (list (user-group
                           (name "root")
-                          (id 0))
+                          (id 0)))))
-                         (user-group
+
-                          (name "users")
+  (skeletons operating-system-skeletons           ; list of name/monadic value
-                          (id 100)
+             (default (default-skeletons)))
-                          (members '("guest"))))))
 
   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
             (default (list coreutils              ; or just PACKAGE
@@ -104,9 +106,16 @@
   (timezone operating-system-timezone)            ; string
   (locale   operating-system-locale)              ; string
 
-  (services operating-system-services             ; list of monadic services
+  (services operating-system-user-services        ; list of monadic services
-            (default %base-services)))
+            (default %base-services))
 
+  (pam-services operating-system-pam-services     ; list of PAM services
+                (default (base-pam-services)))
+  (setuid-programs operating-system-setuid-programs
+                   (default %setuid-programs))    ; list of string-valued gexps
+
+  (sudoers operating-system-sudoers               ; /etc/sudoers contents
+           (default %sudoers-specification)))
 
 
 ;;;
@@ -119,122 +128,104 @@
   "Return a derivation that builds the union of INPUTS.  INPUTS is a list of
 input tuples."
   (define builder
-    '(begin
+    #~(begin
-       (use-modules (guix build union))
+        (use-modules (guix build union))
 
-       (setvbuf (current-output-port) _IOLBF)
+        (define inputs '#$inputs)
-       (setvbuf (current-error-port) _IOLBF)
 
-       (let ((output (assoc-ref %outputs "out"))
+        (setvbuf (current-output-port) _IOLBF)
-             (inputs (map cdr %build-inputs)))
+        (setvbuf (current-error-port) _IOLBF)
-         (format #t "building union `~a' with ~a packages...~%"
-                 output (length inputs))
-         (union-build output inputs))))
 
-  (mlet %store-monad
+        (format #t "building union `~a' with ~a packages...~%"
-      ((inputs (sequence %store-monad
+                #$output (length inputs))
-                         (map (match-lambda
+        (union-build #$output inputs)))
-                               ((or ((? package? p)) (? package? p))
-                                (mlet %store-monad
-                                    ((drv (package->derivation p system)))
-                                  (return `(,name ,drv))))
-                               (((? package? p) output)
-                                (mlet %store-monad
-                                    ((drv (package->derivation p system)))
-                                  (return `(,name ,drv ,output))))
-                               (x
-                                (return x)))
-                              inputs))))
-    (derivation-expression name builder
-                           #:system system
-                           #:inputs inputs
-                           #:modules '((guix build union))
-                           #:guile-for-build guile
-                           #:local-build? #t)))
 
-(define* (file-union files
+  (gexp->derivation name builder
-                     #:key (inputs '()) (name "file-union"))
+                    #:system system
+                    #:modules '((guix build union))
+                    #:guile-for-build guile
+                    #:local-build? #t))
+
+(define* (file-union name files)
   "Return a derivation that builds a directory containing all of FILES.  Each
 item in FILES must be a list where the first element is the file name to use
-in the new directory, and the second element is the target file.
+in the new directory, and the second element is a gexp denoting the target
-
+file."
-The subset of FILES corresponding to plain store files is automatically added
-as an inputs; additional inputs, such as derivations, are taken from INPUTS."
-  (mlet %store-monad ((inputs (lower-inputs inputs)))
-    (let* ((outputs (append-map (match-lambda
-                                 ((_ (? derivation? drv))
-                                  (list (derivation->output-path drv)))
-                                 ((_ (? derivation? drv) sub-drv ...)
-                                  (map (cut derivation->output-path drv <>)
-                                       sub-drv))
-                                 (_ '()))
-                                inputs))
-           (inputs   (append inputs
-                             (filter (match-lambda
-                                      ((_ file)
-                                       ;; Elements of FILES that are store
-                                       ;; files and that do not correspond to
-                                       ;; the output of INPUTS are considered
-                                       ;; inputs (still here?).
-                                       (and (direct-store-path? file)
-                                            (not (member file outputs)))))
-                                     files))))
-      (derivation-expression name
-                             `(let ((out (assoc-ref %outputs "out")))
-                                (mkdir out)
-                                (chdir out)
-                                ,@(map (match-lambda
-                                        ((name target)
-                                         `(symlink ,target ,name)))
-                                       files))
-
-                             #:inputs inputs
-                             #:local-build? #t))))
-
-(define (links inputs)
-  "Return a directory with symbolic links to all of INPUTS.  This is
-essentially useful when one wants to keep references to all of INPUTS, be they
-directories or regular files."
   (define builder
-    '(begin
+    #~(begin
-       (use-modules (srfi srfi-1))
+        (mkdir #$output)
+        (chdir #$output)
+        #$@(map (match-lambda
+                 ((target source)
+                  #~(symlink #$source #$target)))
+                files)))
 
-       (let ((out (assoc-ref %outputs "out")))
+  (gexp->derivation name builder))
-         (mkdir out)
-         (chdir out)
-         (fold (lambda (file number)
-                 (symlink file (number->string number))
-                 (+ 1 number))
-               0
-               (map cdr %build-inputs))
-         #t)))
 
-  (mlet %store-monad ((inputs (lower-inputs inputs)))
+
-    (derivation-expression "links" builder
+;;;
-                           #:inputs inputs
+;;; Services.
-                           #:local-build? #t)))
+;;;
+
+(define (other-file-system-services os)
+  "Return file system services for the file systems of OS that are not marked
+as 'needed-for-boot'."
+  (define file-systems
+    (remove (lambda (fs)
+              (or (file-system-needed-for-boot? fs)
+                  (string=? "/" (file-system-mount-point fs))))
+            (operating-system-file-systems os)))
+
+  (sequence %store-monad
+            (map (match-lambda
+                  (($ <file-system> device target type flags opts #f check?)
+                   (file-system-service device target type
+                                        #:check? check?
+                                        #:options opts)))
+                 file-systems)))
+
+(define (essential-services os)
+  "Return the list of essential services for OS.  These are special services
+that implement part of what's declared in OS are responsible for low-level
+bookkeeping."
+  (mlet* %store-monad ((root-fs   (root-file-system-service))
+                       (other-fs  (other-file-system-services os))
+                       (procs     (user-processes-service
+                                   (map (compose first service-provision)
+                                        other-fs)))
+                       (host-name (host-name-service
+                                   (operating-system-host-name os))))
+    (return (cons* host-name procs root-fs other-fs))))
+
+(define (operating-system-services os)
+  "Return all the services of OS, including \"internal\" services that do not
+explicitly appear in OS."
+  (mlet %store-monad
+      ((user      (sequence %store-monad (operating-system-user-services os)))
+       (essential (essential-services os)))
+    (return (append essential user))))
+
+
+;;;
+;;; /etc.
+;;;
 
 (define* (etc-directory #:key
                         (locale "C") (timezone "Europe/Paris")
-                        (accounts '())
+                        (skeletons '())
-                        (groups '())
                         (pam-services '())
-                        (profile "/var/run/current-system/profile"))
+                        (profile "/run/current-system/profile")
+                        (sudoers ""))
   "Return a derivation that builds the static part of the /etc directory."
   (mlet* %store-monad
-      ((services   (package-file net-base "etc/services"))
+      ((pam.d      (pam-services->directory pam-services))
-       (protocols  (package-file net-base "etc/protocols"))
+       (sudoers    (text-file "sudoers" sudoers))
-       (rpc        (package-file net-base "etc/rpc"))
-       (passwd     (passwd-file accounts))
-       (shadow     (passwd-file accounts #:shadow? #t))
-       (group      (group-file groups))
-       (pam.d      (pam-services->directory pam-services))
        (login.defs (text-file "login.defs" "# Empty for now.\n"))
        (shells     (text-file "shells"            ; used by xterm and others
                               "\
 /bin/sh
-/run/current-system/bin/sh
+/run/current-system/profile/bin/sh
-/run/current-system/bin/bash\n"))
+/run/current-system/profile/bin/bash\n"))
        (issue      (text-file "issue" "
 This is an alpha preview of the GNU system.  Welcome.
 
@@ -253,119 +244,259 @@ export LC_ALL=\"" locale "\"
 export TZ=\"" timezone "\"
 export TZDIR=\"" tzdata "/share/zoneinfo\"
 
-export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
+export PATH=/run/setuid-programs:/run/current-system/profile/sbin
+export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH
 export CPATH=$HOME/.guix-profile/include:" profile "/include
 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
 alias ls='ls -p --color'
 alias ll='ls -l'
 "))
+       (skel      (skeleton-directory skeletons)))
+    (file-union "etc"
+                `(("services" ,#~(string-append #$net-base "/etc/services"))
+                  ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
+                  ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
+                  ("pam.d" ,#~#$pam.d)
+                  ("login.defs" ,#~#$login.defs)
+                  ("issue" ,#~#$issue)
+                  ("skel" ,#~#$skel)
+                  ("shells" ,#~#$shells)
+                  ("profile" ,#~#$bashrc)
+                  ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
+                                                 #$timezone))
+                  ("sudoers" ,#~#$sudoers)))))
 
-       (tz-file  (package-file tzdata
+(define (operating-system-profile os)
-                               (string-append "share/zoneinfo/" timezone)))
-       (files -> `(("services" ,services)
-                   ("protocols" ,protocols)
-                   ("rpc" ,rpc)
-                   ("pam.d" ,(derivation->output-path pam.d))
-                   ("login.defs" ,login.defs)
-                   ("issue" ,issue)
-                   ("shells" ,shells)
-                   ("profile" ,(derivation->output-path bashrc))
-                   ("localtime" ,tz-file)
-                   ("passwd" ,passwd)
-                   ("shadow" ,shadow)
-                   ("group" ,group))))
-    (file-union files
-                #:inputs `(("net" ,net-base)
-                           ("pam.d" ,pam.d)
-                           ("bashrc" ,bashrc)
-                           ("tzdata" ,tzdata))
-                #:name "etc")))
-
-(define (operating-system-profile-derivation os)
   "Return a derivation that builds the default profile of OS."
   ;; TODO: Replace with a real profile with a manifest.
   (union (operating-system-packages os)
          #:name "default-profile"))
 
-(define (operating-system-profile-directory os)
+(define %root-account
-  "Return the directory name of the default profile of OS."
+  ;; Default root account.
-  (mlet %store-monad ((drv (operating-system-profile-derivation os)))
+  (user-account
-    (return (derivation->output-path drv))))
+   (name "root")
+   (password "")
+   (uid 0) (group "root")
+   (comment "System administrator")
+   (home-directory "/root")))
 
-(define (operating-system-derivation os)
+(define (operating-system-accounts os)
-  "Return a derivation that builds OS."
+  "Return the user accounts for OS, including an obligatory 'root' account."
+  (define users
+    ;; Make sure there's a root account.
+    (if (find (lambda (user)
+                (and=> (user-account-uid user) zero?))
+              (operating-system-users os))
+        (operating-system-users os)
+        (cons %root-account (operating-system-users os))))
+
+  (mlet %store-monad ((services (operating-system-services os)))
+    (return (append users
+                    (append-map service-user-accounts services)))))
+
+(define (operating-system-etc-directory os)
+  "Return that static part of the /etc directory of OS."
   (mlet* %store-monad
-      ((services (sequence %store-monad
+      ((services     (operating-system-services os))
-                           (cons (host-name-service
-                                  (operating-system-host-name os))
-                                 (operating-system-services os))))
        (pam-services ->
                      ;; Services known to PAM.
                      (delete-duplicates
-                      (cons %pam-other-services
+                      (append (operating-system-pam-services os)
-                            (append-map service-pam-services services))))
+                              (append-map service-pam-services services))))
+       (profile-drv (operating-system-profile os))
+       (skeletons   (operating-system-skeletons os)))
+   (etc-directory #:pam-services pam-services
+                  #:skeletons skeletons
+                  #:locale (operating-system-locale os)
+                  #:timezone (operating-system-timezone os)
+                  #:sudoers (operating-system-sudoers os)
+                  #:profile profile-drv)))
 
-       (bash-file (package-file bash "bin/bash"))
+(define %setuid-programs
-       (dmd-file  (package-file (@ (gnu packages admin) dmd) "bin/dmd"))
+  ;; Default set of setuid-root programs.
-       (accounts -> (cons (user-account
+  (let ((shadow (@ (gnu packages admin) shadow)))
-                            (name "root")
+    (list #~(string-append #$shadow "/bin/passwd")
-                            (password "")
+          #~(string-append #$shadow "/bin/su")
-                            (uid 0) (gid 0)
+          #~(string-append #$inetutils "/bin/ping")
-                            (comment "System administrator")
+          #~(string-append #$sudo "/bin/sudo"))))
-                            (home-directory "/root"))
-                          (append (operating-system-users os)
-                                  (append-map service-user-accounts
-                                              services))))
-       (groups   -> (append (operating-system-groups os)
-                            (append-map service-user-groups services)))
 
-       (profile-drv (operating-system-profile-derivation os))
+(define %sudoers-specification
-       (profile ->  (derivation->output-path profile-drv))
+  ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
-       (etc-drv     (etc-directory #:accounts accounts #:groups groups
+  ;; group can do anything.  See
-                                   #:pam-services pam-services
+  ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
-                                   #:locale (operating-system-locale os)
+  ;; TODO: Add a declarative API.
-                                   #:timezone (operating-system-timezone os)
+  "root ALL=(ALL) ALL
-                                   #:profile profile-drv))
+%wheel ALL=(ALL) ALL\n")
-       (etc     ->  (derivation->output-path etc-drv))
-       (dmd-conf  (dmd-configuration-file services etc))
 
+(define (user-group->gexp group)
+  "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
+'active-groups'."
+  #~(list #$(user-group-name group)
+          #$(user-group-password group)
+          #$(user-group-id group)))
 
-       (boot     (text-file "boot"
+(define (user-account->gexp account)
-                            (object->string
+  "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
-                             `(execl ,dmd-file "dmd"
+'activate-users'."
-                                     "--config" ,dmd-conf))))
+  #~`(#$(user-account-name account)
-       (kernel  ->  (operating-system-kernel os))
+      #$(user-account-uid account)
-       (kernel-dir  (package-file kernel))
+      #$(user-account-group account)
-       (initrd      (operating-system-initrd os))
+      #$(user-account-supplementary-groups account)
-       (initrd-file -> (string-append (derivation->output-path initrd)
+      #$(user-account-comment account)
-                                      "/initrd"))
+      #$(user-account-home-directory account)
+      ,#$(user-account-shell account)             ; this one is a gexp
+      #$(user-account-password account)))
+
+(define (operating-system-activation-script os)
+  "Return the activation script for OS---i.e., the code that \"activates\" the
+stateful part of OS, including user accounts and groups, special directories,
+etc."
+  (define %modules
+    '((guix build activation)
+      (guix build utils)
+      (guix build linux-initrd)))
+
+  (define (service-activations services)
+    ;; Return the activation scripts for SERVICES.
+    (let ((gexps (filter-map service-activate services)))
+      (sequence %store-monad (map (cut gexp->file "activate-service.scm" <>)
+                                  gexps))))
+
+  (mlet* %store-monad ((services (operating-system-services os))
+                       (actions  (service-activations services))
+                       (etc      (operating-system-etc-directory os))
+                       (modules  (imported-modules %modules))
+                       (compiled (compiled-modules %modules))
+                       (accounts (operating-system-accounts os)))
+    (define setuid-progs
+      (operating-system-setuid-programs os))
+
+    (define user-specs
+      (map user-account->gexp accounts))
+
+    (define groups
+      (append (operating-system-groups os)
+              (append-map service-user-groups services)))
+
+    (define group-specs
+      (map user-group->gexp groups))
+
+    (gexp->file "boot"
+                #~(begin
+                    (eval-when (expand load eval)
+                      ;; Make sure 'use-modules' below succeeds.
+                      (set! %load-path (cons #$modules %load-path))
+                      (set! %load-compiled-path
+                            (cons #$compiled %load-compiled-path)))
+
+                    (use-modules (guix build activation))
+
+                    ;; Populate /etc.
+                    (activate-etc #$etc)
+
+                    ;; Add users and user groups.
+                    (setenv "PATH"
+                            (string-append #$(@ (gnu packages admin) shadow)
+                                           "/sbin"))
+                    (activate-users+groups (list #$@user-specs)
+                                           (list #$@group-specs))
+
+                    ;; Activate setuid programs.
+                    (activate-setuid-programs (list #$@setuid-progs))
+
+                    ;; Run the services' activation snippets.
+                    ;; TODO: Use 'load-compiled'.
+                    (for-each primitive-load '#$actions)
+
+                    ;; Set up /run/current-system.
+                    (activate-current-system)))))
+
+(define (operating-system-boot-script os)
+  "Return the boot script for OS---i.e., the code started by the initrd once
+we're running in the final root."
+  (mlet* %store-monad ((services (operating-system-services os))
+                       (activate (operating-system-activation-script os))
+                       (dmd-conf (dmd-configuration-file services)))
+    (gexp->file "boot"
+                #~(begin
+                    ;; Activate the system.
+                    ;; TODO: Use 'load-compiled'.
+                    (primitive-load #$activate)
+
+                    ;; Keep track of the booted system.
+                    (false-if-exception (delete-file "/run/booted-system"))
+                    (symlink (readlink "/run/current-system")
+                             "/run/booted-system")
+
+                    ;; Close any remaining open file descriptors to be on the
+                    ;; safe side.  This must be the very last thing we do,
+                    ;; because Guile has internal FDs such as 'sleep_pipe'
+                    ;; that need to be alive.
+                    (let loop ((fd 3))
+                      (when (< fd 1024)
+                        (false-if-exception (close-fdes fd))
+                        (loop (+ 1 fd))))
+
+                    ;; Start dmd.
+                    (execl (string-append #$dmd "/bin/dmd")
+                           "dmd" "--config" #$dmd-conf)))))
+
+(define (operating-system-root-file-system os)
+  "Return the root file system of OS."
+  (find (match-lambda
+         (($ <file-system> _ "/") #t)
+         (_ #f))
+        (operating-system-file-systems os)))
+
+(define (operating-system-initrd-file os)
+  "Return a gexp denoting the initrd file of OS."
+  (define boot-file-systems
+    (filter (match-lambda
+             (($ <file-system> device "/")
+              #t)
+             (($ <file-system> device mount-point type flags options boot?)
+              boot?))
+            (operating-system-file-systems os)))
+
+  (mlet %store-monad
+      ((initrd ((operating-system-initrd os) boot-file-systems)))
+    (return #~(string-append #$initrd "/initrd"))))
+
+(define (operating-system-grub.cfg os)
+  "Return the GRUB configuration file for OS."
+  (mlet* %store-monad
+      ((system      (operating-system-derivation os))
+       (root-fs ->  (operating-system-root-file-system os))
+       (kernel ->   (operating-system-kernel os))
        (entries ->  (list (menu-entry
                            (label (string-append
                                    "GNU system with "
                                    (package-full-name kernel)
                                    " (technology preview)"))
                            (linux kernel)
-                           (linux-arguments `("--root=/dev/sda1"
+                           (linux-arguments
-                                              ,(string-append "--load=" boot)))
+                            (list (string-append "--root="
-                           (initrd initrd-file))))
+                                                 (file-system-device root-fs))
-       (grub.cfg (grub-configuration-file entries))
+                                  #~(string-append "--system=" #$system)
-       (extras   (links (delete-duplicates
+                                  #~(string-append "--load=" #$system
-                         (append (append-map service-inputs services)
+                                                   "/boot")))
-                                 (append-map user-account-inputs accounts))))))
+                           (initrd #~(string-append #$system "/initrd"))))))
-    (file-union `(("boot" ,boot)
+    (grub-configuration-file (operating-system-bootloader os) entries)))
-                  ("kernel" ,kernel-dir)
+
-                  ("initrd" ,initrd-file)
+(define (operating-system-derivation os)
-                  ("dmd.conf" ,dmd-conf)
+  "Return a derivation that builds OS."
-                  ("profile" ,profile)
+  (mlet* %store-monad
-                  ("grub.cfg" ,grub.cfg)
+      ((profile     (operating-system-profile os))
-                  ("etc" ,etc)
+       (etc         (operating-system-etc-directory os))
-                  ("system-inputs" ,(derivation->output-path extras)))
+       (boot        (operating-system-boot-script os))
-                #:inputs `(("kernel" ,kernel)
+       (kernel  ->  (operating-system-kernel os))
-                           ("initrd" ,initrd)
+       (initrd      (operating-system-initrd-file os)))
-                           ("bash" ,bash)
+    (file-union "system"
-                           ("profile" ,profile-drv)
+                `(("boot" ,#~#$boot)
-                           ("etc" ,etc-drv)
+                  ("kernel" ,#~#$kernel)
-                           ("system-inputs" ,extras))
+                  ("initrd" ,initrd)
-                #:name "system")))
+                  ("profile" ,#~#$profile)
+                  ("etc" ,#~#$etc)))))
 
 ;;; system.scm ends here

gnu/system/file-systems.scm

@@ -0,0 +1,72 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014 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 file-systems)
+  #:use-module (guix records)
+  #:export (<file-system>
+            file-system
+            file-system?
+            file-system-device
+            file-system-mount-point
+            file-system-type
+            file-system-needed-for-boot?
+            file-system-flags
+            file-system-options
+
+            %fuse-control-file-system
+            %binary-format-file-system))
+
+;;; Commentary:
+;;;
+;;; Declaring file systems to be mounted.
+;;;
+;;; Code:
+
+;; File system declaration.
+(define-record-type* <file-system> file-system
+  make-file-system
+  file-system?
+  (device           file-system-device)           ; string
+  (mount-point      file-system-mount-point)      ; string
+  (type             file-system-type)             ; string
+  (flags            file-system-flags             ; list of symbols
+                    (default '()))
+  (options          file-system-options           ; string or #f
+                    (default #f))
+  (needed-for-boot? file-system-needed-for-boot?  ; Boolean
+                    (default #f))
+  (check?           file-system-check?            ; Boolean
+                    (default #t)))
+
+(define %fuse-control-file-system
+  ;; Control file system for Linux' file systems in user-space (FUSE).
+  (file-system
+    (device "fusectl")
+    (mount-point "/sys/fs/fuse/connections")
+    (type "fusectl")
+    (check? #f)))
+
+(define %binary-format-file-system
+  ;; Support for arbitrary executable binary format.
+  (file-system
+    (device "binfmt_misc")
+    (mount-point "/proc/sys/fs/binfmt_misc")
+    (type "binfmt_misc")
+    (check? #f)))
+
+;;; file-systems.scm ends here

gnu/system/grub.scm

@@ -22,10 +22,16 @@
   #:use-module (guix derivations)
   #:use-module (guix records)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:export (menu-entry
+  #:export (grub-configuration
+            grub-configuration?
+            grub-configuration-device
+
+            menu-entry
             menu-entry?
+
             grub-configuration-file))
 
 ;;; Commentary:
@@ -34,51 +40,61 @@
 ;;;
 ;;; Code:
 
+(define-record-type* <grub-configuration>
+  grub-configuration make-grub-configuration
+  grub-configuration?
+  (grub            grub-configuration-grub           ; package
+                   (default (@ (gnu packages grub) grub)))
+  (device          grub-configuration-device)        ; string
+  (menu-entries    grub-configuration-menu-entries   ; list
+                   (default '()))
+  (default-entry   grub-configuration-default-entry  ; integer
+                   (default 1))
+  (timeout         grub-configuration-timeout        ; integer
+                   (default 5)))
+
 (define-record-type* <menu-entry>
   menu-entry make-menu-entry
   menu-entry?
   (label           menu-entry-label)
   (linux           menu-entry-linux)
   (linux-arguments menu-entry-linux-arguments
-                   (default '()))
+                   (default '()))          ; list of string-valued gexps
-  (initrd          menu-entry-initrd))            ; file name of the initrd
+  (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp
 
-(define* (grub-configuration-file entries
+(define* (grub-configuration-file config entries
-                                  #:key (default-entry 1) (timeout 5)
+                                  #:key (system (%current-system)))
-                                  (system (%current-system)))
+  "Return the GRUB configuration file corresponding to CONFIG, a
-  "Return the GRUB configuration file for ENTRIES, a list of
+<grub-configuration> object."
-<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
+  (define all-entries
-  (define (prologue kernel)
+    (append entries (grub-configuration-menu-entries config)))
-    (format #f "
-set default=~a
-set timeout=~a
-search.file ~a~%"
-            default-entry timeout kernel))
 
-  (define (bzImage)
+  (define entry->gexp
-    (any (match-lambda
-          (($ <menu-entry> _ linux)
-           (package-file linux "bzImage"
-                         #:system system)))
-         entries))
-
-  (define entry->text
     (match-lambda
      (($ <menu-entry> label linux arguments initrd)
-      (mlet %store-monad ((linux  (package-file linux "bzImage"
+      #~(format port "menuentry ~s {
-                                                #:system system)))
+  linux ~a/bzImage ~a
-        (return (format #f "menuentry ~s {
-  linux ~a ~a
   initrd ~a
 }~%"
-                        label
+                #$label
-                        linux (string-join arguments) initrd))))))
+                #$linux (string-join (list #$@arguments))
+                #$initrd))))
 
-  (mlet %store-monad ((kernel (bzImage))
+  (define builder
-                      (body   (sequence %store-monad
+    #~(call-with-output-file #$output
-                                        (map entry->text entries))))
+        (lambda (port)
-    (text-file "grub.cfg"
+          (format port "
-               (string-append (prologue kernel)
+set default=~a
-                              (string-concatenate body)))))
+set timeout=~a
+search.file ~a/bzImage~%"
+                  #$(grub-configuration-default-entry config)
+                  #$(grub-configuration-timeout config)
+                  #$(any (match-lambda
+                          (($ <menu-entry> _ linux)
+                           linux))
+                         all-entries))
+          #$@(map entry->gexp all-entries))))
+
+  (gexp->derivation "grub.cfg" builder))
 
 ;;; grub.scm ends here

gnu/system/linux-initrd.scm

@@ -18,19 +18,24 @@
 
 (define-module (gnu system linux-initrd)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (guix utils)
   #:use-module ((guix store)
                 #:select (%store-prefix))
+  #:use-module ((guix derivations)
+                #:select (derivation->output-path))
   #:use-module (gnu packages cpio)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages guile)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
+  #:use-module (gnu system file-systems)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
   #:export (expression->initrd
-            qemu-initrd
+            qemu-initrd))
-            gnu-system-initrd))
 
 
 ;;; Commentary:
@@ -49,12 +54,14 @@
                              (name "guile-initrd")
                              (system (%current-system))
                              (modules '())
+                             (to-copy '())
                              (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.  MODULES is a
+of `.ko' file names to be copied from LINUX into the initrd.  TO-COPY is a
-list of Guile module names to be embedded in the initrd."
+list of additional derivations or packages to copy to the initrd.  MODULES is
+a list of Guile module names to be embedded in the initrd."
 
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
@@ -63,150 +70,157 @@ list of Guile module names to be embedded in the initrd."
     ;; Return a regexp that matches STR exactly.
     (string-append "^" (regexp-quote str) "$"))
 
-  (define builder
+  (mlet* %store-monad ((source   (imported-modules modules))
-    `(begin
+                       (compiled (compiled-modules modules)))
-       (use-modules (guix build utils)
+    (define builder
-                    (ice-9 pretty-print)
+      ;; TODO: Move most of this code to (guix build linux-initrd).
-                    (ice-9 popen)
+      #~(begin
-                    (ice-9 match)
+          (use-modules (guix build utils)
-                    (ice-9 ftw)
+                       (ice-9 pretty-print)
-                    (srfi srfi-26)
+                       (ice-9 popen)
-                    (system base compile)
+                       (ice-9 match)
-                    (rnrs bytevectors)
+                       (ice-9 ftw)
-                    ((system foreign) #:select (sizeof)))
+                       (srfi srfi-26)
+                       (system base compile)
+                       (rnrs bytevectors)
+                       ((system foreign) #:select (sizeof)))
 
-       (let ((guile   (assoc-ref %build-inputs "guile"))
+          (let ((cpio    (string-append #$cpio "/bin/cpio"))
-             (cpio    (string-append (assoc-ref %build-inputs "cpio")
+                (gzip    (string-append #$gzip "/bin/gzip"))
-                                     "/bin/cpio"))
+                (modules #$source)
-             (gzip    (string-append (assoc-ref %build-inputs "gzip")
+                (gos     #$compiled)
-                                     "/bin/gzip"))
+                (scm-dir (string-append "share/guile/" (effective-version)))
-             (modules (assoc-ref %build-inputs "modules"))
+                (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a"
-             (gos     (assoc-ref %build-inputs "modules/compiled"))
+                                 (effective-version)
-             (scm-dir (string-append "share/guile/" (effective-version)))
+                                 (if (eq? (native-endianness) (endianness little))
-             (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a"
+                                     "LE"
-                              (effective-version)
+                                     "BE")
-                              (if (eq? (native-endianness) (endianness little))
+                                 (sizeof '*)
-                                  "LE"
+                                 (effective-version))))
-                                  "BE")
+            (mkdir #$output)
-                              (sizeof '*)
+            (mkdir "contents")
-                              (effective-version)))
+            (with-directory-excursion "contents"
-             (out     (assoc-ref %outputs "out")))
+              (copy-recursively #$guile ".")
-         (mkdir out)
+              (call-with-output-file "init"
-         (mkdir "contents")
+                (lambda (p)
-         (with-directory-excursion "contents"
+                  (format p "#!/bin/guile -ds~%!#~%" #$guile)
-           (copy-recursively guile ".")
+                  (pretty-print '#$exp p)))
-           (call-with-output-file "init"
+              (chmod "init" #o555)
-             (lambda (p)
+              (chmod "bin/guile" #o555)
-               (format p "#!/bin/guile -ds~%!#~%" guile)
-               (pretty-print ',exp p)))
-           (chmod "init" #o555)
-           (chmod "bin/guile" #o555)
 
-           ;; Copy Guile modules.
+              ;; Copy Guile modules.
-           (chmod scm-dir #o777)
+              (chmod scm-dir #o777)
-           (copy-recursively modules scm-dir
+              (copy-recursively modules scm-dir
-                             #:follow-symlinks? #t)
+                                #:follow-symlinks? #t)
-           (copy-recursively gos (string-append "lib/guile/"
+              (copy-recursively gos (string-append "lib/guile/"
-                                                (effective-version) "/ccache")
+                                                   (effective-version) "/ccache")
-                             #:follow-symlinks? #t)
+                                #:follow-symlinks? #t)
 
-           ;; Compile `init'.
+              ;; Compile `init'.
-           (mkdir-p go-dir)
+              (mkdir-p go-dir)
-           (set! %load-path (cons modules %load-path))
+              (set! %load-path (cons modules %load-path))
-           (set! %load-compiled-path (cons gos %load-compiled-path))
+              (set! %load-compiled-path (cons gos %load-compiled-path))
-           (compile-file "init"
+              (compile-file "init"
-                         #:opts %auto-compilation-options
+                            #:opts %auto-compilation-options
-                         #:output-file (string-append go-dir "/init.go"))
+                            #:output-file (string-append go-dir "/init.go"))
 
-           ;; Copy Linux modules.
+              ;; Copy Linux modules.
-           (let* ((linux      (assoc-ref %build-inputs "linux"))
+              (let* ((linux      #$linux)
-                  (module-dir (and linux
+                     (module-dir (and linux
-                                   (string-append linux "/lib/modules"))))
+                                      (string-append linux "/lib/modules"))))
-             (mkdir "modules")
+                (mkdir "modules")
-             ,@(map (lambda (module)
+                #$@(map (lambda (module)
-                      `(match (find-files module-dir
+                          #~(match (find-files module-dir
-                                          ,(string->regexp module))
+                                               #$(string->regexp module))
-                         ((file)
+                              ((file)
-                          (format #t "copying '~a'...~%" file)
+                               (format #t "copying '~a'...~%" file)
-                          (copy-file file (string-append "modules/"
+                               (copy-file file (string-append "modules/"
-                                                         ,module)))
+                                                              #$module)))
-                         (()
+                              (()
-                          (error "module not found" ,module module-dir))
+                               (error "module not found" #$module module-dir))
-                         ((_ ...)
+                              ((_ ...)
-                          (error "several modules by that name"
+                               (error "several modules by that name"
-                                 ,module module-dir))))
+                                      #$module module-dir))))
-                    linux-modules))
+                        linux-modules))
 
-           ;; Reset the timestamps of all the files that will make it in the
+              (let ((store   #$(string-append "." (%store-prefix)))
-           ;; initrd.
+                    (to-copy '#$to-copy))
-           (for-each (cut utime <> 0 0 0 0)
+                (unless (null? to-copy)
-                     (find-files "." ".*"))
+                  (mkdir-p store))
+                ;; XXX: Should we do export-references-graph?
+                (for-each (lambda (input)
+                            (let ((target
+                                   (string-append store "/"
+                                                  (basename input))))
+                              (copy-recursively input target)))
+                          to-copy))
 
-           (system* cpio "--version")
+              ;; Reset the timestamps of all the files that will make it in the
-           (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
+              ;; initrd.
-                                   "-O" (string-append out "/initrd")
+              (for-each (cut utime <> 0 0 0 0)
-                                   "-H" "newc" "--null")))
+                        (find-files "." ".*"))
-             (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
+              (system* cpio "--version")
-             ;; directory entries before the files that are inside of it: "The
+              (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
-             ;; Linux kernel cpio extractor won't create files in a directory
+                                      "-O" (string-append #$output "/initrd")
-             ;; that doesn't exist, so the directory entries must go before
+                                      "-H" "newc" "--null")))
-             ;; the files that go in those directories."
+                (define print0
-             (file-system-fold (const #t)
+                  (let ((len (string-length "./")))
-                               (lambda (file stat result) ; leaf
+                    (lambda (file)
-                                 (print0 file))
+                      (format pipe "~a\0" (string-drop file len)))))
-                               (lambda (dir stat result) ; down
-                                 (unless (string=? dir ".")
-                                   (print0 dir)))
-                               (const #f)         ; up
-                               (const #f)         ; skip
-                               (const #f)
-                               #f
-                               ".")
 
-             (and (zero? (close-pipe pipe))
+                ;; Note: as per `ramfs-rootfs-initramfs.txt', always add
-                  (with-directory-excursion out
+                ;; directory entries before the files that are inside of it: "The
-                    (and (zero? (system* gzip "--best" "initrd"))
+                ;; Linux kernel cpio extractor won't create files in a directory
-                         (rename-file "initrd.gz" "initrd")))))))))
+                ;; 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
+                                  ".")
 
-  (mlet* %store-monad
+                (and (zero? (close-pipe pipe))
-      ((source   (imported-modules modules))
+                     (with-directory-excursion #$output
-       (compiled (compiled-modules modules))
+                       (and (zero? (system* gzip "--best" "initrd"))
-       (inputs   (lower-inputs
+                            (rename-file "initrd.gz" "initrd")))))))))
-                  `(("guile" ,guile)
-                    ("cpio" ,cpio)
-                    ("gzip" ,gzip)
-                    ("modules" ,source)
-                    ("modules/compiled" ,compiled)
-                    ,@(if linux
-                          `(("linux" ,linux))
-                          '())))))
-   (derivation-expression name builder
-                          #:modules '((guix build utils))
-                          #:inputs inputs)))
 
-(define* (qemu-initrd #:key
+   (gexp->derivation name builder
+                     #:modules '((guix build utils)))))
+
+(define (file-system->spec fs)
+  "Return a list corresponding to file-system FS that can be passed to the
+initrd code."
+  (match fs
+    (($ <file-system> device mount-point type flags options _ check?)
+     (list device mount-point type flags options check?))))
+
+(define* (qemu-initrd file-systems
+                      #:key
                       guile-modules-in-chroot?
-                      volatile-root?
+                      (qemu-networking? #t)
-                      (mounts `((cifs "/store" ,(%store-prefix))
+                      volatile-root?)
-                                (cifs "/xchg" "/xchg"))))
   "Return a monadic derivation that builds an initrd for use in a QEMU guest
-where the store is shared with the host.  MOUNTS is a list of file systems to
+where the store is shared with the host.  FILE-SYSTEMS is a list of
-be mounted atop the root file system, where each item has the form:
+file-systems to be mounted by the initrd, possibly in addition to the root
+file system specified on the kernel command line via '--root'.
 
-    (FILE-SYSTEM-TYPE SOURCE TARGET)
+When QEMU-NETWORKING? is true, set up networking with the standard QEMU
+parameters.
+
+When VOLATILE-ROOT? is true, the root file system is writable but any changes
+to it are lost.
 
 When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
 the new root.  This is necessary is the file specified as '--load' needs
 access to these modules (which is the case if it wants to even just print an
-exception and backtrace!).
+exception and backtrace!)."
-
-When VOLATILE-ROOT? is true, the root file system is writable but any changes
-to it are lost."
   (define cifs-modules
     ;; Modules needed to mount CIFS file systems.
     '("md4.ko" "ecb.ko" "cifs.ko"))
@@ -215,35 +229,56 @@ to it are lost."
     ;; Modules for the 9p paravirtualized file system.
     '("9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
 
+  (define (file-system-type-predicate type)
+    (lambda (fs)
+      (string=? (file-system-type fs) type)))
+
   (define linux-modules
     ;; Modules added to the initrd and loaded from the initrd.
     `("virtio.ko" "virtio_ring.ko" "virtio_pci.ko"
       "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko"
-      ,@(if (assoc-ref mounts 'cifs)
+      ,@(if (find (file-system-type-predicate "cifs") file-systems)
             cifs-modules
             '())
-      ,@(if (assoc-ref mounts '9p)
+      ,@(if (find (file-system-type-predicate "9p") file-systems)
             virtio-9p-modules
+            '())
+      ,@(if volatile-root?
+            '("fuse.ko")
+            '())))
+
+  (define helper-packages
+    ;; Packages to be copied on the initrd.
+    `(,@(if (find (lambda (fs)
+                    (string-prefix? "ext" (file-system-type fs)))
+                  file-systems)
+            (list e2fsck/static)
+            '())
+      ,@(if volatile-root?
+            (list unionfs-fuse/static)
             '())))
 
   (expression->initrd
-   `(begin
+   #~(begin
-      (use-modules (guix build linux-initrd))
+       (use-modules (guix build linux-initrd)
+                    (guix build utils)
+                    (srfi srfi-26))
 
-      (boot-system #:mounts ',mounts
+       (with-output-to-port (%make-void-port "w")
-                   #:linux-modules ',linux-modules
+         (lambda ()
-                   #:qemu-guest-networking? #t
+           (set-path-environment-variable "PATH" '("bin" "sbin")
-                   #:guile-modules-in-chroot? ',guile-modules-in-chroot?
+                                          '#$helper-packages)))
-                   #:volatile-root? ',volatile-root?))
+
+       (boot-system #:mounts '#$(map file-system->spec file-systems)
+                    #:linux-modules '#$linux-modules
+                    #:qemu-guest-networking? #$qemu-networking?
+                    #:guile-modules-in-chroot? '#$guile-modules-in-chroot?
+                    #:volatile-root? '#$volatile-root?))
    #:name "qemu-initrd"
    #:modules '((guix build utils)
                (guix build linux-initrd))
+   #:to-copy helper-packages
    #:linux linux-libre
    #:linux-modules linux-modules))
 
-(define (gnu-system-initrd)
-  "Initrd for the GNU system itself, with nothing QEMU-specific."
-  (qemu-initrd #:guile-modules-in-chroot? #f
-               #:mounts '()))
-
 ;;; linux-initrd.scm ends here

gnu/system/linux.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
   #:use-module (guix records)
   #:use-module (guix derivations)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -28,8 +29,8 @@
   #:export (pam-service
             pam-entry
             pam-services->directory
-            %pam-other-services
+            unix-pam-service
-            unix-pam-service))
+            base-pam-services))
 
 ;;; Commentary:
 ;;;
@@ -58,58 +59,56 @@
 (define-record-type* <pam-entry> pam-entry
   make-pam-entry
   pam-entry?
-  (control    pam-entry-control)                  ; string
+  (control    pam-entry-control)         ; string
-  (module     pam-entry-module)                   ; file name
+  (module     pam-entry-module)          ; file name
-  (arguments  pam-entry-arguments                 ; list of strings
+  (arguments  pam-entry-arguments        ; list of string-valued g-expressions
               (default '())))
 
 (define (pam-service->configuration service)
-  "Return the configuration string for SERVICE, to be dumped in
+  "Return the derivation building the configuration file for SERVICE, to be
-/etc/pam.d/NAME, where NAME is the name of SERVICE."
+dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
-  (define (entry->string type entry)
+  (define (entry->gexp type entry)
     (match entry
       (($ <pam-entry> control module (arguments ...))
-       (string-append type "  "
+       #~(format #t "~a ~a ~a ~a~%"
-                      control " " module " "
+                 #$type #$control #$module
-                      (string-join arguments)
+                 (string-join (list #$@arguments))))))
-                      "\n"))))
 
   (match service
     (($ <pam-service> name account auth password session)
-     (string-concatenate
+     (define builder
-      (append (map (cut entry->string "account" <>) account)
+       #~(begin
-              (map (cut entry->string "auth" <>) auth)
+           (with-output-to-file #$output
-              (map (cut entry->string "password" <>) password)
+             (lambda ()
-              (map (cut entry->string "session" <>) session))))))
+               #$@(append (map (cut entry->gexp "account" <>) account)
+                          (map (cut entry->gexp "auth" <>) auth)
+                          (map (cut entry->gexp "password" <>) password)
+                          (map (cut entry->gexp "session" <>) session))
+               #t))))
+
+     (gexp->derivation name builder))))
 
 (define (pam-services->directory services)
   "Return the derivation to build the configuration directory to be used as
 /etc/pam.d for SERVICES."
   (mlet %store-monad
       ((names -> (map pam-service-name services))
-       (files (mapm %store-monad
+       (files (sequence %store-monad
-                    (match-lambda
+                        (map pam-service->configuration
-                     ((and service ($ <pam-service> name))
+                             ;; XXX: Eventually, SERVICES may be a list of
-                      (let ((config (pam-service->configuration service)))
+                             ;; monadic values instead of plain values.
-                        (text-file (string-append name ".pam") config))))
+                             services))))
-
-                    ;; XXX: Eventually, SERVICES may be a list of monadic
-                    ;; values instead of plain values.
-                    (map return services))))
     (define builder
-      '(begin
+      #~(begin
-         (use-modules (ice-9 match))
+          (use-modules (ice-9 match))
 
-         (let ((out (assoc-ref %outputs "out")))
+          (mkdir #$output)
-           (mkdir out)
+          (for-each (match-lambda
-           (for-each (match-lambda
+                     ((name file)
-                      ((name . file)
+                      (symlink file (string-append #$output "/" name))))
-                       (symlink file (string-append out "/" name))))
+                    '#$(zip names files))))
-                     %build-inputs)
-           #t)))
 
-    (derivation-expression "pam.d" builder
+    (gexp->derivation "pam.d" builder)))
-                           #:inputs (zip names files))))
 
 (define %pam-other-services
   ;; The "other" PAM configuration, which denies everything (see
@@ -149,7 +148,19 @@ should be the name of a file used as the message-of-the-day."
                             (pam-entry
                              (control "optional")
                              (module "pam_motd.so")
-                             (arguments (list (string-append "motd=" motd)))))
+                             (arguments
+                              (list #~(string-append "motd=" #$motd)))))
                       (list unix))))))))
 
+(define* (base-pam-services #:key allow-empty-passwords?)
+  "Return the list of basic PAM services everyone would want."
+  (cons %pam-other-services
+        (map (cut unix-pam-service <>
+                  #:allow-empty-passwords? allow-empty-passwords?)
+             '("su" "passwd" "sudo"
+               "useradd" "userdel" "usermod"
+               "groupadd" "groupdel" "groupmod"
+               ;; TODO: Add other Shadow programs?
+               ))))
+
 ;;; linux.scm ends here

gnu/system/shadow.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,25 +17,23 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu system shadow)
-  #:use-module (guix store)
   #:use-module (guix records)
-  #:use-module (guix packages)
+  #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module ((gnu packages admin)
                 #:select (shadow))
   #:use-module (gnu packages bash)
-  #:use-module (srfi srfi-1)
+  #:use-module (gnu packages guile-wm)
-  #:use-module (ice-9 match)
   #:export (user-account
             user-account?
             user-account-name
-            user-account-pass
+            user-account-password
             user-account-uid
-            user-account-gid
+            user-account-group
+            user-account-supplementary-groups
             user-account-comment
             user-account-home-directory
             user-account-shell
-            user-account-inputs
 
             user-group
             user-group?
@@ -44,9 +42,8 @@
             user-group-id
             user-group-members
 
-            passwd-file
+            default-skeletons
-            group-file
+            skeleton-directory))
-            guix-build-accounts))
 
 ;;; Commentary:
 ;;;
@@ -58,68 +55,66 @@
   user-account make-user-account
   user-account?
   (name           user-account-name)
-  (password       user-account-pass (default ""))
+  (password       user-account-password (default #f))
-  (uid            user-account-uid)
+  (uid            user-account-uid (default #f))
-  (gid            user-account-gid)
+  (group          user-account-group)             ; number | string
+  (supplementary-groups user-account-supplementary-groups
+                        (default '()))            ; list of strings
   (comment        user-account-comment (default ""))
   (home-directory user-account-home-directory)
-  (shell          user-account-shell              ; monadic value
+  (shell          user-account-shell              ; gexp
-                  (default (package-file bash "bin/bash")))
+                  (default #~(string-append #$bash "/bin/bash"))))
-  (inputs         user-account-inputs (default `(("bash" ,bash)))))
 
 (define-record-type* <user-group>
   user-group make-user-group
   user-group?
   (name           user-group-name)
   (password       user-group-password (default #f))
-  (id             user-group-id)
+  (id             user-group-id (default #f))
   (members        user-group-members (default '())))
 
-(define (group-file groups)
+(define (default-skeletons)
-  "Return a /etc/group file for GROUPS, a list of <user-group> objects."
+  "Return the default skeleton files for /etc/skel.  These files are copied by
-  (define contents
+'useradd' in the home directory of newly created user accounts."
-    (let loop ((groups groups)
+  (define copy-guile-wm
-               (result '()))
+    #~(begin
-      (match groups
+        (use-modules (guix build utils))
-        ((($ <user-group> name _ gid (users ...)) rest ...)
+        (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
-         ;; XXX: Ignore the group password.
+                   #$output)))
-         (loop rest
-               (cons (string-append name "::" (number->string gid)
-                                    ":" (string-join users ","))
-                     result)))
-        (()
-         (string-join (reverse result) "\n" 'suffix)))))
 
-  (text-file "group" contents))
+  (mlet %store-monad ((bashrc (text-file "bashrc" "\
+# Allow non-login shells such as an xterm to get things right.
+test -f /etc/profile && source /etc/profile\n"))
+                      (guile-wm (gexp->derivation "guile-wm" copy-guile-wm
+                                                  #:modules
+                                                  '((guix build utils))))
+                      (xdefaults (text-file "Xdefaults" "\
+XTerm*utf8: always
+XTerm*metaSendsEscape: true\n"))
+                      (gdbinit   (text-file "gdbinit" "\
+# Tell GDB where to look for separate debugging files.
+set debug-file-directory ~/.guix-profile/lib/debug\n")))
+    (return `((".bashrc" ,bashrc)
+              (".Xdefaults" ,xdefaults)
+              (".guile-wm" ,guile-wm)
+              (".gdbinit" ,gdbinit)))))
 
-(define* (passwd-file accounts #:key shadow?)
+(define (skeleton-directory skeletons)
-  "Return a password file for ACCOUNTS, a list of <user-account> objects.  If
+  "Return a directory containing SKELETONS, a list of name/derivation pairs."
-SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd
+  (gexp->derivation "skel"
-file."
+                    #~(begin
-  ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
+                        (use-modules (ice-9 match))
-  (define (contents)
-    (with-monad %store-monad
-      (let loop ((accounts accounts)
-                 (result   '()))
-        (match accounts
-          ((($ <user-account> name pass uid gid comment home-dir mshell)
-            rest ...)
-           (mlet %store-monad ((shell mshell))
-             (loop rest
-                   (cons (if shadow?
-                             (string-append name
-                                            ":"    ; XXX: use (crypt PASS …)?
-                                            ":::::::")
-                             (string-append name
-                                            ":" "x"
-                                            ":" (number->string uid)
-                                            ":" (number->string gid)
-                                            ":" comment ":" home-dir ":" shell))
-                         result))))
-          (()
-           (return (string-join (reverse result) "\n" 'suffix)))))))
 
-  (mlet %store-monad ((contents (contents)))
+                        (mkdir #$output)
-    (text-file (if shadow? "shadow" "passwd") contents)))
+                        (chdir #$output)
+
+                        ;; Note: copy the skeletons instead of symlinking
+                        ;; them like 'file-union' does, because 'useradd'
+                        ;; would just copy the symlinks as is.
+                        (for-each (match-lambda
+                                   ((target source)
+                                    (copy-file source target)))
+                                  '#$skeletons)
+                        #t)))
 
 ;;; shadow.scm ends here

gnu/system/vm.scm

@@ -19,6 +19,7 @@
 (define-module (gnu system vm)
   #:use-module (guix config)
   #:use-module (guix store)
+  #:use-module (guix gexp)
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix monads)
@@ -41,6 +42,7 @@
   #:use-module (gnu system linux)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu system grub)
+  #:use-module (gnu system file-systems)
   #:use-module (gnu system)
   #:use-module (gnu services)
 
@@ -52,7 +54,8 @@
             qemu-image
             system-qemu-image
             system-qemu-image/shared-store
-            system-qemu-image/shared-store-script))
+            system-qemu-image/shared-store-script
+            system-disk-image))
 
 
 ;;; Commentary:
@@ -81,19 +84,34 @@ input tuple.  The output file name is when building for SYSTEM."
       ((input (and (? string?) (? store-path?) file))
        (return `(,input . ,file))))))
 
-;; An alias to circumvent name clashes.
+(define %linux-vm-file-systems
-(define %imported-modules imported-modules)
+  ;; File systems mounted for 'derivation-in-linux-vm'.  The store and /xchg
+  ;; directory are shared with the host over 9p.
+  (list (file-system
+          (mount-point (%store-prefix))
+          (device "store")
+          (type "9p")
+          (needed-for-boot? #t)
+          (options "trans=virtio")
+          (check? #f))
+        (file-system
+          (mount-point "/xchg")
+          (device "xchg")
+          (type "9p")
+          (needed-for-boot? #t)
+          (options "trans=virtio")
+          (check? #f))))
 
 (define* (expression->derivation-in-linux-vm name exp
                                              #:key
                                              (system (%current-system))
-                                             (inputs '())
                                              (linux linux-libre)
                                              initrd
                                              (qemu qemu-headless)
                                              (env-vars '())
-                                             (imported-modules
+                                             (modules
                                               '((guix build vm)
+                                                (guix build install)
                                                 (guix build linux-initrd)
                                                 (guix build utils)))
                                              (guile-for-build
@@ -102,222 +120,240 @@ input tuple.  The output file name is when building for SYSTEM."
                                              (make-disk-image? #f)
                                              (references-graphs #f)
                                              (memory-size 256)
+                                             (disk-image-format "qcow2")
                                              (disk-image-size
                                               (* 100 (expt 2 20))))
   "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
-derivation).  In the virtual machine, EXP has access to all of INPUTS from the
+derivation).  In the virtual machine, EXP has access to all its 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.  The virtual machine
 runs with MEMORY-SIZE MiB of memory.
 
-When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
+When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
-DISK-IMAGE-SIZE bytes and return it.
+DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
+return it.
 
-IMPORTED-MODULES is the set of modules imported in the execution environment
+MODULES is the set of modules imported in the execution environment of EXP.
-of EXP.
 
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs, as for `derivation'.  The files containing the reference graphs are
 made available under the /xchg CIFS share."
-  ;; FIXME: Add #:modules parameter, for the 'use-modules' form.
-
-  (define input-alist
-    (map input->name+output inputs))
-
-  (define builder
-    ;; Code that launches the VM that evaluates EXP.
-    `(let ()
-       (use-modules (guix build utils)
-                    (guix build vm))
-
-       (let ((linux   (string-append (assoc-ref %build-inputs "linux")
-                                     "/bzImage"))
-             (initrd  (string-append (assoc-ref %build-inputs "initrd")
-                                     "/initrd"))
-             (loader  (assoc-ref %build-inputs "loader"))
-             (graphs  ',(match references-graphs
-                          (((graph-files . _) ...) graph-files)
-                          (_ #f))))
-
-         (set-path-environment-variable "PATH" '("bin")
-                                        (map cdr %build-inputs))
-
-         (load-in-linux-vm loader
-                           #:output (assoc-ref %outputs "out")
-                           #:linux linux #:initrd initrd
-                           #:memory-size ,memory-size
-                           #:make-disk-image? ,make-disk-image?
-                           #:disk-image-size ,disk-image-size
-                           #:references-graphs graphs))))
-
   (mlet* %store-monad
-      ((input-alist  (sequence %store-monad input-alist))
+      ((module-dir   (imported-modules modules))
-       (module-dir   (%imported-modules imported-modules))
+       (compiled     (compiled-modules modules))
-       (compiled     (compiled-modules imported-modules))
+       (user-builder (gexp->file "builder-in-linux-vm" exp))
-       (exp* ->      `(let ((%build-inputs ',input-alist))
+       (loader       (gexp->file "linux-vm-loader"
-                        ,exp))
+                                 #~(begin
-       (user-builder (text-file "builder-in-linux-vm"
+                                     (set! %load-path
-                                (object->string exp*)))
+                                           (cons #$module-dir %load-path))
-       (loader       (text-file* "linux-vm-loader" ; XXX: use 'sexp-file'
+                                     (set! %load-compiled-path
-                                 "(begin (set! %load-path (cons \""
+                                           (cons #$compiled
-                                 module-dir "\" %load-path)) "
+                                                 %load-compiled-path))
-                                 "(set! %load-compiled-path (cons \""
+                                     (primitive-load #$user-builder))))
-                                 compiled "\" %load-compiled-path))"
-                                 "(primitive-load \"" user-builder "\"))"))
        (coreutils -> (car (assoc-ref %final-inputs "coreutils")))
        (initrd       (if initrd                   ; use the default initrd?
                          (return initrd)
-                         (qemu-initrd #:guile-modules-in-chroot? #t
+                         (qemu-initrd %linux-vm-file-systems
-                                      #:mounts `((9p "store" ,(%store-prefix))
+                                      #:guile-modules-in-chroot? #t))))
-                                                 (9p "xchg" "/xchg")))))
+
-       (inputs       (lower-inputs `(("qemu" ,qemu)
+    (define builder
-                                     ("linux" ,linux)
+      ;; Code that launches the VM that evaluates EXP.
-                                     ("initrd" ,initrd)
+      #~(begin
-                                     ("coreutils" ,coreutils)
+          (use-modules (guix build utils)
-                                     ("builder" ,user-builder)
+                       (guix build vm))
-                                     ("loader" ,loader)
+
-                                     ,@inputs))))
+          (let ((inputs  '#$(list qemu coreutils))
-    (derivation-expression name builder
+                (linux   (string-append #$linux "/bzImage"))
-                           ;; TODO: Require the "kvm" feature.
+                (initrd  (string-append #$initrd "/initrd"))
-                           #:system system
+                (loader  #$loader)
-                           #:inputs inputs
+                (graphs  '#$(match references-graphs
-                           #:env-vars env-vars
+                              (((graph-files . _) ...) graph-files)
-                           #:modules (delete-duplicates
+                              (_ #f))))
-                                      `((guix build utils)
+
-                                        (guix build vm)
+            (set-path-environment-variable "PATH" '("bin") inputs)
-                                        (guix build linux-initrd)
+
-                                        ,@imported-modules))
+            (load-in-linux-vm loader
-                           #:guile-for-build guile-for-build
+                              #:output #$output
-                           #:references-graphs references-graphs)))
+                              #:linux linux #:initrd initrd
+                              #:memory-size #$memory-size
+                              #:make-disk-image? #$make-disk-image?
+                              #:disk-image-format #$disk-image-format
+                              #:disk-image-size #$disk-image-size
+                              #:references-graphs graphs))))
+
+    (gexp->derivation name builder
+                      ;; TODO: Require the "kvm" feature.
+                      #:system system
+                      #:env-vars env-vars
+                      #:modules modules
+                      #:guile-for-build guile-for-build
+                      #:references-graphs references-graphs)))
 
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
+                     (qemu qemu-headless)
                      (disk-image-size (* 100 (expt 2 20)))
+                     (disk-image-format "qcow2")
+                     (file-system-type "ext4")
                      grub-configuration
-                     (initialize-store? #f)
+                     (register-closures? #t)
-                     (populate #f)
                      (inputs '())
-                     (inputs-to-copy '()))
+                     copy-inputs?)
-  "Return a bootable, stand-alone QEMU image.  The returned image is a full
+  "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
-disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its
+'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.  The
-configuration file (GRUB-CONFIGURATION must be the name of a file in the VM.)
+returned image is a full disk image, with a GRUB installation that uses
+GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the
+name of a file in the VM.)
 
-INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
+INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
-into the image being built.  When INITIALIZE-STORE? is true, initialize the
+all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
-store database in the image so that Guix can be used in the image.
+register INPUTS in the store database of the image so that Guix can be used in
-
+the image."
-POPULATE is a list of directives stating directories or symlinks to be created
-in the disk image partition.  It is evaluated once the image has been
-populated with INPUTS-TO-COPY.  It can be used to provide additional files,
-such as /etc files."
   (mlet %store-monad
-      ((graph (sequence %store-monad
+      ((graph (sequence %store-monad (map input->name+output inputs))))
-                        (map input->name+output inputs-to-copy))))
    (expression->derivation-in-linux-vm
-    "qemu-image"
+    name
-    `(let ()
+    #~(begin
-       (use-modules (guix build vm)
+        (use-modules (guix build vm)
-                    (guix build utils))
+                     (guix build utils))
 
-       (set-path-environment-variable "PATH" '("bin" "sbin")
+        (let ((inputs
-                                      (map cdr %build-inputs))
+               '#$(append (list qemu parted grub e2fsprogs util-linux)
+                          (map (compose car (cut assoc-ref %final-inputs <>))
+                               '("sed" "grep" "coreutils" "findutils" "gawk"))
+                          (if register-closures? (list guix) '())))
 
-       (let ((graphs ',(match inputs-to-copy
+              ;; This variable is unused but allows us to add INPUTS-TO-COPY
-                         (((names . _) ...)
+              ;; as inputs.
-                          names))))
+              (to-register
-         (initialize-hard-disk #:grub.cfg ,grub-configuration
+                '#$(map (match-lambda
-                               #:closures-to-copy graphs
+                         ((name thing) thing)
-                               #:disk-image-size ,disk-image-size
+                         ((name thing output) `(,thing ,output)))
-                               #:initialize-store? ,initialize-store?
+                        inputs)))
-                               #:directives ',populate)
+
-         (reboot)))
+          (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+          (let ((graphs '#$(match inputs
+                             (((names . _) ...)
+                              names))))
+            (initialize-hard-disk "/dev/vda"
+                                  #:grub.cfg #$grub-configuration
+                                  #:closures graphs
+                                  #:copy-closures? #$copy-inputs?
+                                  #:register-closures? #$register-closures?
+                                  #:disk-image-size #$disk-image-size
+                                  #:file-system-type #$file-system-type)
+            (reboot))))
     #:system system
-    #:inputs `(("parted" ,parted)
-               ("grub" ,grub)
-               ("e2fsprogs" ,e2fsprogs)
-
-               ;; 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)
-
-               ,@(if initialize-store?
-                     `(("guix" ,guix))
-                     '())
-
-               ,@inputs-to-copy)
     #:make-disk-image? #t
     #:disk-image-size disk-image-size
+    #:disk-image-format disk-image-format
     #:references-graphs graph)))
 
 
 ;;;
-;;; Stand-alone VM image.
+;;; VM and disk images.
 ;;;
 
-(define (operating-system-build-gid os)
+(define* (system-disk-image os
-  "Return as a monadic value the group id for build users of OS, or #f."
+                            #:key
-  (anym %store-monad
+                            (file-system-type "ext4")
-        (lambda (service)
+                            (disk-image-size (* 900 (expt 2 20)))
-          (and (equal? '(guix-daemon)
+                            (volatile? #t))
-                       (service-provision service))
+  "Return the derivation of a disk image of DISK-IMAGE-SIZE bytes of the
-               (match (service-user-groups service)
+system described by OS.  Said image can be copied on a USB stick as is.  When
-                 ((group)
+VOLATILE? is true, the root file system is made volatile; this is useful
-                  (user-group-id group)))))
+to USB sticks meant to be read-only."
-        (operating-system-services os)))
+  (define file-systems-to-keep
+    (remove (lambda (fs)
+              (string=? (file-system-mount-point fs) "/"))
+            (operating-system-file-systems os)))
 
-(define (operating-system-default-contents os)
+  (let ((os (operating-system (inherit os)
-  "Return a list of directives suitable for 'system-qemu-image' describing the
+              ;; Since this is meant to be used on real hardware, don't set up
-basic contents of the root file system of OS."
+              ;; QEMU networking.
-  (define (user-directories user)
+              (initrd (cut qemu-initrd <>
-    (let ((home (user-account-home-directory user))
+                           #:volatile-root? volatile?
-          ;; XXX: Deal with automatically allocated ids.
+                           #:qemu-networking? #f))
-          (uid  (or (user-account-uid user) 0))
-          (gid  (or (user-account-gid user) 0))
-          (root (string-append "/var/guix/profiles/per-user/"
-                               (user-account-name user))))
-      `((directory ,root ,uid ,gid)
-        (directory ,home ,uid ,gid))))
 
-  (mlet* %store-monad ((os-drv    (operating-system-derivation os))
+              ;; Force our own root file system.
-                       (os-dir -> (derivation->output-path os-drv))
+              (file-systems (cons (file-system
-                       (build-gid (operating-system-build-gid os))
+                                    (mount-point "/")
-                       (profile   (operating-system-profile-directory os)))
+                                    (device "/dev/sda1")
-    (return `((directory ,(%store-prefix) 0 ,(or build-gid 0))
+                                    (type file-system-type))
-              (directory "/etc")
+                                  file-systems-to-keep)))))
-              (directory "/var/log")                     ; for dmd
-              (directory "/var/run/nscd")
-              (directory "/var/guix/gcroots")
-              ("/var/guix/gcroots/system" -> ,os-dir)
-              (directory "/run")
-              ("/run/current-system" -> ,profile)
-              (directory "/bin")
-              ("/bin/sh" -> "/run/current-system/bin/bash")
-              (directory "/tmp")
-              (directory "/var/guix/profiles/per-user/root" 0 0)
 
-              (directory "/root" 0 0)             ; an exception
+    (mlet* %store-monad ((os-drv   (operating-system-derivation os))
-              ,@(append-map user-directories
+                         (grub.cfg (operating-system-grub.cfg os)))
-                            (operating-system-users os))))))
+      (qemu-image #:grub-configuration grub.cfg
+                  #:disk-image-size disk-image-size
+                  #:disk-image-format "raw"
+                  #:file-system-type file-system-type
+                  #:copy-inputs? #t
+                  #:register-closures? #t
+                  #:inputs `(("system" ,os-drv)
+                             ("grub.cfg" ,grub.cfg))))))
 
 (define* (system-qemu-image os
-                            #:key (disk-image-size (* 900 (expt 2 20))))
+                            #:key
-  "Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU
+                            (file-system-type "ext4")
-system as described by OS."
+                            (disk-image-size (* 900 (expt 2 20))))
-  (mlet* %store-monad
+  "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes
-      ((os-drv      (operating-system-derivation os))
+of the GNU system as described by OS."
-       (os-dir   -> (derivation->output-path os-drv))
+  (define file-systems-to-keep
-       (grub.cfg -> (string-append os-dir "/grub.cfg"))
+    ;; Keep only file systems other than root and not normally bound to real
-       (populate    (operating-system-default-contents os)))
+    ;; devices.
-    (qemu-image  #:grub-configuration grub.cfg
+    (remove (lambda (fs)
-                 #:populate populate
+              (let ((target (file-system-mount-point fs))
-                 #:disk-image-size disk-image-size
+                    (source (file-system-device fs)))
-                 #:initialize-store? #t
+                (or (string=? target "/")
-                 #:inputs-to-copy `(("system" ,os-drv)))))
+                    (string-prefix? "/dev/" source))))
+            (operating-system-file-systems os)))
+
+  (let ((os (operating-system (inherit os)
+              ;; Force our own root file system.
+              (file-systems (cons (file-system
+                                    (mount-point "/")
+                                    (device "/dev/sda1")
+                                    (type file-system-type))
+                                  file-systems-to-keep)))))
+    (mlet* %store-monad
+        ((os-drv      (operating-system-derivation os))
+         (grub.cfg    (operating-system-grub.cfg os)))
+      (qemu-image  #:grub-configuration grub.cfg
+                   #:disk-image-size disk-image-size
+                   #:file-system-type file-system-type
+                   #:inputs `(("system" ,os-drv)
+                              ("grub.cfg" ,grub.cfg))
+                   #:copy-inputs? #t))))
+
+(define (virtualized-operating-system os)
+  "Return an operating system based on OS suitable for use in a virtualized
+environment with the store shared with the host."
+  (operating-system (inherit os)
+    (initrd (cut qemu-initrd <> #:volatile-root? #t))
+    (file-systems (cons* (file-system
+                           (mount-point "/")
+                           (device "/dev/vda1")
+                           (type "ext4"))
+                         (file-system
+                           (mount-point (%store-prefix))
+                           (device "store")
+                           (type "9p")
+                           (needed-for-boot? #t)
+                           (options "trans=virtio")
+                           (check? #f))
+
+                         ;; Remove file systems that conflict with those
+                         ;; above, or that are normally bound to real devices.
+                         (remove (lambda (fs)
+                                   (let ((target (file-system-mount-point fs))
+                                         (source (file-system-device fs)))
+                                     (or (string=? target (%store-prefix))
+                                         (string=? target "/")
+                                         (string-prefix? "/dev/" source))))
+                                 (operating-system-file-systems os))))))
 
 (define* (system-qemu-image/shared-store
           os
@@ -326,13 +362,14 @@ system as described by OS."
 with the host."
   (mlet* %store-monad
       ((os-drv      (operating-system-derivation os))
-       (os-dir   -> (derivation->output-path os-drv))
+       (grub.cfg    (operating-system-grub.cfg os)))
-       (grub.cfg -> (string-append os-dir "/grub.cfg"))
-       (populate    (operating-system-default-contents os)))
-    ;; TODO: Initialize the database so Guix can be used in the guest.
     (qemu-image #:grub-configuration grub.cfg
-                #:populate populate
+                #:disk-image-size disk-image-size
-                #:disk-image-size disk-image-size)))
+                #:inputs `(("system" ,os-drv))
+
+                ;; XXX: Passing #t here is too slow, so let it off by default.
+                #:register-closures? #f
+                #:copy-inputs? #f)))
 
 (define* (system-qemu-image/shared-store-script
           os
@@ -341,47 +378,28 @@ with the host."
           (graphic? #t))
   "Return a derivation that builds a script to run a virtual machine image of
 OS that shares its store with the host."
-  (let* ((initrd (qemu-initrd #:mounts `((9p "store" ,(%store-prefix)))
+  (mlet* %store-monad
-                              #:volatile-root? #t))
+      ((os ->  (virtualized-operating-system os))
-         (os     (operating-system (inherit os) (initrd initrd))))
+       (os-drv (operating-system-derivation os))
+       (image  (system-qemu-image/shared-store os)))
     (define builder
-      (mlet %store-monad ((image  (system-qemu-image/shared-store os))
+      #~(call-with-output-file #$output
-                          (qemu   (package-file qemu
+          (lambda (port)
-                                                "bin/qemu-system-x86_64"))
+            (display
-                          (bash   (package-file bash "bin/sh"))
+             (string-append "#!" #$bash "/bin/sh
-                          (kernel (package-file (operating-system-kernel os)
+exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=virtio \
-                                                "bzImage"))
+  -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \
-                          (initrd initrd)
-                          (os-drv (operating-system-derivation os)))
-        (return `(let ((out (assoc-ref %outputs "out")))
-                   (call-with-output-file out
-                     (lambda (port)
-                       (display
-                        (string-append "#!" ,bash "
-exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
-  -virtfs local,path=" ,(%store-prefix) ",security_model=none,mount_tag=store \
   -net user \
-  -kernel " ,kernel " -initrd "
+  -kernel " #$(operating-system-kernel os) "/bzImage \
-  ,(string-append (derivation->output-path initrd) "/initrd") " \
+  -initrd " #$os-drv "/initrd \
--append \"" ,(if graphic? "" "console=ttyS0 ")
+-append \"" #$(if graphic? "" "console=ttyS0 ")
-"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \
+  "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
-  -drive file=" ,(derivation->output-path image)
+  -serial stdio \
+  -drive file=" #$image
   ",if=virtio,cache=writeback,werror=report,readonly\n")
-                        port)))
+             port)
-                   (chmod out #o555)
+            (chmod port #o555))))
-                   #t))))
 
-    (mlet %store-monad ((image   (system-qemu-image/shared-store os))
+    (gexp->derivation "run-vm.sh" builder)))
-                        (initrd  initrd)
-                        (qemu    (package->derivation qemu))
-                        (bash    (package->derivation bash))
-                        (os      (operating-system-derivation os))
-                        (builder builder))
-      (derivation-expression "run-vm.sh" builder
-                             #:inputs `(("qemu" ,qemu)
-                                        ("image" ,image)
-                                        ("bash" ,bash)
-                                        ("initrd" ,initrd)
-                                        ("os" ,os))))))
 
 ;;; vm.scm ends here

guix.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,8 +26,10 @@
       '(base32
         build-system
         derivations
-        ftp-client
         download
+        ftp-client
+        gexp
+        monads
         packages
         store
         utils))

guix/build/activation.scm

@@ -0,0 +1,219 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build activation)
+  #:use-module (guix build utils)
+  #:use-module (guix build linux-initrd)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (activate-users+groups
+            activate-etc
+            activate-setuid-programs
+            activate-current-system))
+
+;;; Commentary:
+;;;
+;;; This module provides "activation" helpers.  Activation is the process that
+;;; consists in setting up system-wide files and directories so that an
+;;; 'operating-system' configuration becomes active.
+;;;
+;;; Code:
+
+(define* (add-group name #:key gid password
+                    (log-port (current-error-port)))
+  "Add NAME as a user group, with the given numeric GID if specified."
+  ;; Use 'groupadd' from the Shadow package.
+  (format log-port "adding group '~a'...~%" name)
+  (let ((args `(,@(if gid `("-g" ,(number->string gid)) '())
+                ,@(if password `("-p" ,password) '())
+                ,name)))
+    (zero? (apply system* "groupadd" args))))
+
+(define* (add-user name group
+                   #:key uid comment home shell password
+                   (supplementary-groups '())
+                   (log-port (current-error-port)))
+  "Create an account for user NAME part of GROUP, with the specified
+properties.  Return #t on success."
+  (format log-port "adding user '~a'...~%" name)
+
+  (if (and uid (zero? uid))
+
+      ;; 'useradd' fails with "Cannot determine your user name" if the root
+      ;; account doesn't exist.  Thus, for bootstrapping purposes, create that
+      ;; one manually.
+      (begin
+        (call-with-output-file "/etc/shadow"
+          (cut format <> "~a::::::::~%" name))
+        (call-with-output-file "/etc/passwd"
+          (cut format <> "~a:x:~a:~a:~a:~a:~a~%"
+               name "0" "0" comment home shell))
+        (chmod "/etc/shadow" #o600)
+        #t)
+
+      ;; Use 'useradd' from the Shadow package.
+      (let ((args `(,@(if uid `("-u" ,(number->string uid)) '())
+                    "-g" ,(if (number? group) (number->string group) group)
+                    ,@(if (pair? supplementary-groups)
+                          `("-G" ,(string-join supplementary-groups ","))
+                          '())
+                    ,@(if comment `("-c" ,comment) '())
+                    ,@(if home
+                          (if (file-exists? home)
+                              `("-d" ,home)     ; avoid warning from 'useradd'
+                              `("-d" ,home "--create-home"))
+                          '())
+                    ,@(if shell `("-s" ,shell) '())
+                    ,@(if password `("-p" ,password) '())
+                    ,name)))
+        (zero? (apply system* "useradd" args)))))
+
+(define (activate-users+groups users groups)
+  "Make sure the accounts listed in USERS and the user groups listed in GROUPS
+are all available.
+
+Each item in USERS is a list of all the characteristics of a user account;
+each item in GROUPS is a tuple with the group name, group password or #f, and
+numeric gid or #f."
+  (define (touch file)
+    (call-with-output-file file (const #t)))
+
+  (define activate-user
+    (match-lambda
+     ((name uid group supplementary-groups comment home shell password)
+      (unless (false-if-exception (getpwnam name))
+        (let ((profile-dir (string-append "/var/guix/profiles/per-user/"
+                                          name)))
+          (add-user name group
+                    #:uid uid
+                    #:supplementary-groups supplementary-groups
+                    #:comment comment
+                    #:home home
+                    #:shell shell
+                    #:password password)
+
+          ;; Create the profile directory for the new account.
+          (let ((pw (getpwnam name)))
+            (mkdir-p profile-dir)
+            (chown profile-dir (passwd:uid pw) (passwd:gid pw))))))))
+
+  ;; 'groupadd' aborts if the file doesn't already exist.
+  (touch "/etc/group")
+
+  ;; Create the root account so we can use 'useradd' and 'groupadd'.
+  (activate-user (find (match-lambda
+                        ((name (? zero?) _ ...) #t)
+                        (_ #f))
+                       users))
+
+  ;; Then create the groups.
+  (for-each (match-lambda
+             ((name password gid)
+              (add-group name #:gid gid #:password password)))
+            groups)
+
+  ;; Finally create the other user accounts.
+  (for-each activate-user users))
+
+(define (activate-etc etc)
+  "Install ETC, a directory in the store, as the source of static files for
+/etc."
+
+  ;; /etc is a mixture of static and dynamic settings.  Here is where we
+  ;; initialize it from the static part.
+
+  (format #t "populating /etc from ~a...~%" etc)
+  (let ((rm-f (lambda (f)
+                (false-if-exception (delete-file f)))))
+    (rm-f "/etc/static")
+    (symlink etc "/etc/static")
+    (for-each (lambda (file)
+                ;; TODO: Handle 'shadow' specially so that changed
+                ;; password aren't lost.
+                (let ((target (string-append "/etc/" file))
+                      (source (string-append "/etc/static/" file)))
+                  (rm-f target)
+                  (symlink source target)))
+              (scandir etc
+                       (lambda (file)
+                         (not (member file '("." ".."))))
+
+                       ;; The default is 'string-locale<?', but we don't have
+                       ;; it when run from the initrd's statically-linked
+                       ;; Guile.
+                       string<?))
+
+    ;; Prevent ETC from being GC'd.
+    (rm-f "/var/guix/gcroots/etc-directory")
+    (symlink etc "/var/guix/gcroots/etc-directory")))
+
+(define %setuid-directory
+  ;; Place where setuid programs are stored.
+  "/run/setuid-programs")
+
+(define (activate-setuid-programs programs)
+  "Turn PROGRAMS, a list of file names, into setuid programs stored under
+%SETUID-DIRECTORY."
+  (define (make-setuid-program prog)
+    (let ((target (string-append %setuid-directory
+                                 "/" (basename prog))))
+      (catch 'system-error
+        (lambda ()
+          (link prog target))
+        (lambda args
+          ;; Perhaps PROG and TARGET live in a different file system, so copy
+          ;; PROG.
+          (copy-file prog target)))
+      (chown target 0 0)
+      (chmod target #o6555)))
+
+  (format #t "setting up setuid programs in '~a'...~%"
+          %setuid-directory)
+  (if (file-exists? %setuid-directory)
+      (for-each (compose delete-file
+                         (cut string-append %setuid-directory "/" <>))
+                (scandir %setuid-directory
+                         (lambda (file)
+                           (not (member file '("." ".."))))
+                         string<?))
+      (mkdir-p %setuid-directory))
+
+  (for-each make-setuid-program programs))
+
+(define %current-system
+  ;; The system that is current (a symlink.)  This is not necessarily the same
+  ;; as the system we booted (aka. /run/booted-system) because we can re-build
+  ;; a new system configuration and activate it, without rebooting.
+  "/run/current-system")
+
+(define (boot-time-system)
+  "Return the '--system' argument passed on the kernel command line."
+  (find-long-option "--system" (linux-command-line)))
+
+(define* (activate-current-system #:optional (system (boot-time-system)))
+  "Atomically make SYSTEM the current system."
+  (format #t "making '~a' the current system...~%" system)
+
+  ;; Atomically make SYSTEM current.
+  (let ((new (string-append %current-system ".new")))
+    (symlink system new)
+    (rename-file new %current-system)))
+
+;;; activation.scm ends here

guix/build/cmake-build-system.scm

@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -48,6 +49,10 @@
 
     (let ((args `(,srcdir
                   ,(string-append "-DCMAKE_INSTALL_PREFIX=" out)
+                  ;; add input libraries to rpath
+                  "-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE"
+                  ;; add (other) libraries of the project itself to rpath
+                  ,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib")
                   ,@configure-flags)))
       (setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
       (setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH"))

guix/build/download.scm

@@ -167,8 +167,6 @@ which is not available during bootstrap."
 
           ;; Buffer input and output on this port.
           (setvbuf s _IOFBF)
-          ;; Enlarge the receive buffer.
-          (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
 
           (if (eq? 'https (uri-scheme uri))
               (tls-wrap s)
@@ -307,7 +305,10 @@ on success."
                uri)
        #f)))
 
-  (setvbuf (current-output-port) _IOLBF)
+  ;; Make this unbuffered so 'progress-proc' works as expected.  _IOLBF means
+  ;; '\n', not '\r', so it's not appropriate here.
+  (setvbuf (current-output-port) _IONBF)
+
   (setvbuf (current-error-port) _IOLBF)
 
   (let try ((uri uri))

guix/build/git.scm

@@ -31,6 +31,11 @@
                     #:key (git-command "git"))
   "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
 identifier.  Return #t on success, #f otherwise."
+
+  ;; Disable TLS certificate verification.  The hash of the checkout is known
+  ;; in advance anyway.
+  (setenv "GIT_SSL_NO_VERIFY" "true")
+
   (and (zero? (system* git-command "clone" url directory))
        (with-directory-excursion directory
          (system* git-command "tag" "-l")

guix/build/gnome.scm

@@ -1,31 +0,0 @@
-;;; 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 (guix build gnome)
-  #:export (gir-directory))
-
-;;; Commentary:
-;;;
-;;; Tools commonly used when building GNOME programs.
-;;;
-;;; Code:
-
-(define (gir-directory inputs pkg-name)
-  "Return the GIR directory name for PKG-NAME found from INPUTS."
-  (string-append (assoc-ref inputs pkg-name)
-                 "/share/gir-1.0"))

guix/build/install.scm

@@ -0,0 +1,122 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build install)
+  #:use-module (guix build utils)
+  #:use-module (guix build install)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:export (install-grub
+            populate-root-file-system
+            reset-timestamps
+            register-closure))
+
+;;; Commentary:
+;;;
+;;; This module supports the installation of the GNU system on a hard disk.
+;;; It is meant to be used both in a build environment (in derivations that
+;;; build VM images), and on the bare metal (when really installing the
+;;; system.)
+;;;
+;;; Code:
+
+(define* (install-grub grub.cfg device mount-point)
+  "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
+MOUNT-POINT."
+  (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
+         (pivot  (string-append target ".new")))
+    (mkdir-p (dirname target))
+
+    ;; Copy GRUB.CFG instead of just symlinking it since it's not a GC root.
+    ;; Do that atomically.
+    (copy-file grub.cfg pivot)
+    (rename-file pivot target)
+
+    (unless (zero? (system* "grub-install" "--no-floppy"
+                            "--boot-directory"
+                            (string-append mount-point "/boot")
+                            device))
+      (error "failed to install GRUB"))))
+
+(define (evaluate-populate-directive directive target)
+  "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
+directory TARGET."
+  (let loop ((directive directive))
+    (match directive
+      (('directory name)
+       (mkdir-p (string-append target name)))
+      (('directory name uid gid)
+       (let ((dir (string-append target name)))
+         (mkdir-p dir)
+         (chown dir uid gid)))
+      (('directory name uid gid mode)
+       (loop `(directory ,name ,uid ,gid))
+       (chmod (string-append target name) mode))
+      ((new '-> old)
+       (symlink old (string-append target new))))))
+
+(define (directives store)
+  "Return a list of directives to populate the root file system that will host
+STORE."
+  `((directory ,store 0 0)
+    (directory "/etc")
+    (directory "/var/log")                          ; for dmd
+    (directory "/var/guix/gcroots")
+    (directory "/var/empty")                        ; for no-login accounts
+    (directory "/var/run")
+    (directory "/run")
+    ("/var/guix/gcroots/booted-system" -> "/run/booted-system")
+    ("/var/guix/gcroots/current-system" -> "/run/current-system")
+    (directory "/bin")
+    ("/bin/sh" -> "/run/current-system/profile/bin/bash")
+    (directory "/tmp" 0 0 #o1777)                 ; sticky bit
+    (directory "/var/guix/profiles/per-user/root" 0 0)
+
+    (directory "/root" 0 0)                       ; an exception
+    (directory "/home" 0 0)))
+
+(define (populate-root-file-system target)
+  "Make the essential non-store files and directories on TARGET.  This
+includes /etc, /var, /run, /bin/sh, etc."
+  (for-each (cut evaluate-populate-directive <> target)
+            (directives (%store-directory))))
+
+(define (reset-timestamps directory)
+  "Reset the timestamps of all the files under DIRECTORY, so that they appear
+as created and modified at the Epoch."
+  (display "clearing file timestamps...\n")
+  (for-each (lambda (file)
+              (let ((s (lstat file)))
+                ;; XXX: Guile uses libc's 'utime' function (not 'futime'), so
+                ;; the timestamp of symlinks cannot be changed, and there are
+                ;; symlinks here pointing to /gnu/store, which is the host,
+                ;; read-only store.
+                (unless (eq? (stat:type s) 'symlink)
+                  (utime file 0 0 0 0))))
+            (find-files directory "")))
+
+(define (register-closure store closure)
+  "Register CLOSURE in STORE, where STORE is the directory name of the target
+store and CLOSURE is the name of a file containing a reference graph as used
+by 'guix-register'.  As a side effect, this resets timestamps on store files."
+  (let ((status (system* "guix-register" "--prefix" store
+                         closure)))
+    (unless (zero? status)
+      (error "failed to register store items" closure))))
+
+;;; install.scm ends here

guix/build/linux-initrd.scm

@@ -28,10 +28,11 @@
   #:use-module (guix build utils)
   #:export (mount-essential-file-systems
             linux-command-line
+            find-long-option
             make-essential-device-nodes
             configure-qemu-networking
-            mount-qemu-smb-share
+            check-file-system
-            mount-qemu-9p
+            mount-file-system
             bind-mount
             load-linux-module*
             device-number
@@ -63,12 +64,30 @@
     (mkdir (scope "sys")))
   (mount "none" (scope "sys") "sysfs"))
 
+(define (move-essential-file-systems root)
+  "Move currently mounted essential file systems to ROOT."
+  (for-each (lambda (dir)
+              (let ((target (string-append root dir)))
+                (unless (file-exists? target)
+                  (mkdir target))
+                (mount dir target "" MS_MOVE)))
+            '("/proc" "/sys")))
+
 (define (linux-command-line)
   "Return the Linux kernel command line as a list of strings."
   (string-tokenize
    (call-with-input-file "/proc/cmdline"
      get-string-all)))
 
+(define (find-long-option option arguments)
+  "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\".
+Return the value associated with OPTION, or #f on failure."
+  (let ((opt (string-append option "=")))
+    (and=> (find (cut string-prefix? opt <>)
+                 arguments)
+           (lambda (arg)
+             (substring arg (+ 1 (string-index arg #\=)))))))
+
 (define* (make-essential-device-nodes #:key (root "/"))
   "Make essential device nodes under ROOT/dev."
   ;; The hand-made udev!
@@ -115,6 +134,10 @@
                   (device-number 4 n))
            (loop (+ 1 n)))))
 
+  ;; Serial line.
+  (mknod (scope "dev/ttyS0") 'char-special #o660
+         (device-number 4 64))
+
   ;; Pseudo ttys.
   (mknod (scope "dev/ptmx") 'char-special #o666
          (device-number 5 2))
@@ -143,7 +166,18 @@
   (symlink "/proc/self/fd" (scope "dev/fd"))
   (symlink "/proc/self/fd/0" (scope "dev/stdin"))
   (symlink "/proc/self/fd/1" (scope "dev/stdout"))
-  (symlink "/proc/self/fd/2" (scope "dev/stderr")))
+  (symlink "/proc/self/fd/2" (scope "dev/stderr"))
+
+  ;; Loopback devices.
+  (let loop ((i 0))
+    (when (< i 8)
+      (mknod (scope (string-append "dev/loop" (number->string i)))
+             'block-special #o660
+             (device-number 7 i))
+      (loop (+ 1 i))))
+
+  ;; File systems in user space (FUSE).
+  (mknod (scope "dev/fuse") 'char-special #o666 (device-number 10 229)))
 
 (define %host-qemu-ipv4-address
   (inet-pton AF_INET "10.0.2.10"))
@@ -167,33 +201,13 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
 
     (logand (network-interface-flags sock interface) IFF_UP)))
 
-(define (mount-qemu-smb-share share mount-point)
+;; Linux mount flags, from libc's <sys/mount.h>.
-  "Mount QEMU's CIFS/SMB SHARE at MOUNT-POINT.
+(define MS_RDONLY 1)
-
+(define MS_BIND 4096)
-Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
+(define MS_MOVE 8192)
-`qemu-with-multiple-smb-shares' package exports the /xchg and /store shares
- (the latter allows the store to be shared between the host and guest.)"
-
-  (format #t "mounting QEMU's SMB share `~a'...\n" share)
-  (let ((server "10.0.2.4"))
-    (mount (string-append "//" server share) mount-point "cifs" 0
-           (string->pointer "guest,sec=none"))))
-
-(define (mount-qemu-9p source mount-point)
-  "Mount QEMU's 9p file system from SOURCE at MOUNT-POINT.
-
-This uses the 'virtio' transport, which requires the various virtio Linux
-modules to be loaded."
-
-  (format #t "mounting QEMU's 9p share '~a'...\n" source)
-  (let ((server "10.0.2.4"))
-    (mount source mount-point "9p" 0
-           (string->pointer "trans=virtio"))))
 
 (define (bind-mount source target)
   "Bind-mount SOURCE at TARGET."
-  (define MS_BIND 4096)                           ; from libc's <sys/mount.h>
-
   (mount source target "" MS_BIND))
 
 (define (load-linux-module* file)
@@ -208,6 +222,165 @@ modules to be loaded."
 the last argument of `mknod'."
   (+ (* major 256) minor))
 
+(define (pidof program)
+  "Return the PID of the first presumed instance of PROGRAM."
+  (let ((program (basename program)))
+    (find (lambda (pid)
+            (let ((exe (format #f "/proc/~a/exe" pid)))
+              (and=> (false-if-exception (readlink exe))
+                     (compose (cut string=? program <>) basename))))
+          (filter-map string->number (scandir "/proc")))))
+
+(define* (mount-root-file-system root type
+                                 #:key volatile-root? (unionfs "unionfs"))
+  "Mount the root file system of type TYPE at device ROOT.  If VOLATILE-ROOT?
+is true, mount ROOT read-only and make it a union with a writable tmpfs using
+UNIONFS."
+  (define (mark-as-not-killable pid)
+    ;; Tell the 'user-processes' dmd service that PID must be kept alive when
+    ;; shutting down.
+    (mkdir-p "/root/etc/dmd")
+    (let ((port (open-file "/root/etc/dmd/do-not-kill" "a")))
+      (chmod port #o600)
+      (write pid port)
+      (newline port)
+      (close-port port)))
+
+  (catch #t
+    (lambda ()
+      (if volatile-root?
+          (begin
+            (mkdir-p "/real-root")
+            (mount root "/real-root" type MS_RDONLY)
+            (mkdir-p "/rw-root")
+            (mount "none" "/rw-root" "tmpfs")
+
+            ;; We want read-write /dev nodes.
+            (make-essential-device-nodes #:root "/rw-root")
+
+            ;; Make /root a union of the tmpfs and the actual root.
+            (unless (zero? (system* unionfs "-o"
+                                    "cow,allow_other,use_ino,suid,dev"
+                                    "/rw-root=RW:/real-root=RO"
+                                    "/root"))
+              (error "unionfs failed"))
+
+            ;; Make sure unionfs remains alive till the end.  Because
+            ;; 'fuse_daemonize' doesn't tell the PID of the forked daemon, we
+            ;; have to resort to 'pidof' here.
+            (mark-as-not-killable (pidof unionfs)))
+          (begin
+            (check-file-system root type)
+            (mount root "/root" type))))
+    (lambda args
+      (format (current-error-port) "exception while mounting '~a': ~s~%"
+              root args)
+      (start-repl)))
+
+  (copy-file "/proc/mounts" "/root/etc/mtab"))
+
+(define (check-file-system device type)
+  "Run a file system check of TYPE on DEVICE."
+  (define fsck
+    (string-append "fsck." type))
+
+  (let ((status (system* fsck "-v" "-p" device)))
+    (match (status:exit-val status)
+      (0
+       #t)
+      (1
+       (format (current-error-port) "'~a' corrected errors on ~a; continuing~%"
+               fsck device))
+      (2
+       (format (current-error-port) "'~a' corrected errors on ~a; rebooting~%"
+               fsck device)
+       (sleep 3)
+       (reboot))
+      (code
+       (format (current-error-port) "'~a' exited with code ~a on ~a; spawning REPL~%"
+               fsck code device)
+       (start-repl)))))
+
+(define* (mount-file-system spec #:key (root "/root"))
+  "Mount the file system described by SPEC under ROOT.  SPEC must have the
+form:
+
+  (DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
+
+DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
+FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
+run a file system check."
+  (define flags->bit-mask
+    (match-lambda
+     (('read-only rest ...)
+      (or MS_RDONLY (flags->bit-mask rest)))
+     (('bind-mount rest ...)
+      (or MS_BIND (flags->bit-mask rest)))
+     (()
+      0)))
+
+  (match spec
+    ((source mount-point type (flags ...) options check?)
+     (let ((mount-point (string-append root "/" mount-point)))
+       (when check?
+         (check-file-system source type))
+       (mkdir-p mount-point)
+       (mount source mount-point type (flags->bit-mask flags)
+              (if options
+                  (string->pointer options)
+                  %null-pointer))
+
+       ;; Update /etc/mtab.
+       (mkdir-p (string-append root "/etc"))
+       (let ((port (open-file (string-append root "/etc/mtab") "a")))
+         (format port "~a ~a ~a ~a 0 0~%"
+                 source mount-point type options)
+         (close-port port))))))
+
+(define (switch-root root)
+  "Switch to ROOT as the root file system, in a way similar to what
+util-linux' switch_root(8) does."
+  (move-essential-file-systems root)
+  (chdir root)
+
+  ;; Since we're about to 'rm -rf /', try to make sure we're on an initrd.
+  ;; TODO: Use 'statfs' to check the fs type, like klibc does.
+  (when (or (not (file-exists? "/init")) (directory-exists? "/home"))
+    (format (current-error-port)
+            "The root file system is probably not an initrd; \
+bailing out.~%root contents: ~s~%" (scandir "/"))
+    (force-output (current-error-port))
+    (exit 1))
+
+  ;; Delete files from the old root, without crossing mount points (assuming
+  ;; there are no mount points in sub-directories.)  That means we're leaving
+  ;; the empty ROOT directory behind us, but that's OK.
+  (let ((root-device (stat:dev (stat "/"))))
+    (for-each (lambda (file)
+                (unless (member file '("." ".."))
+                  (let* ((file   (string-append "/" file))
+                         (device (stat:dev (lstat file))))
+                    (when (= device root-device)
+                      (delete-file-recursively file)))))
+              (scandir "/")))
+
+  ;; Make ROOT the new root.
+  (mount root "/" "" MS_MOVE)
+  (chroot ".")
+  (chdir "/")
+
+  (when (file-exists? "/dev/console")
+    ;; Close the standard file descriptors since they refer to the old
+    ;; /dev/console, and reopen them.
+    (let ((console (open-file "/dev/console" "r+b0")))
+      (for-each close-fdes '(0 1 2))
+
+      (dup2 (fileno console) 0)
+      (dup2 (fileno console) 1)
+      (dup2 (fileno console) 2)
+
+      (close-port console))))
+
 (define* (boot-system #:key
                       (linux-modules '())
                       qemu-guest-networking?
@@ -220,9 +393,10 @@ QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS,
 and finally booting into the new root if any.  The initrd supports kernel
 command-line options '--load', '--root', and '--repl'.
 
-MOUNTS must be a list of elements of the form:
+Mount the root file system, specified by the '--root' command-line argument,
+if any.
 
-  (FILE-SYSTEM-TYPE SOURCE TARGET)
+MOUNTS must be a list suitable for 'mount-file-system'.
 
 When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
 the new root.
@@ -238,21 +412,25 @@ to it are lost."
             (resolve (string-append "/root" target)))
           file)))
 
-  (define MS_RDONLY 1)
+  (define root-mount-point?
+    (match-lambda
+     ((device "/" _ ...) #t)
+     (_ #f)))
+
+  (define root-fs-type
+    (or (any (match-lambda
+              ((device "/" type _ ...) type)
+              (_ #f))
+             mounts)
+        "ext4"))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
   (mount-essential-file-systems)
   (let* ((args    (linux-command-line))
-         (option  (lambda (opt)
+         (to-load (find-long-option "--load" args))
-                    (let ((opt (string-append opt "=")))
+         (root    (find-long-option "--root" args)))
-                      (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)
       (start-repl))
@@ -273,55 +451,17 @@ to it are lost."
     (unless (file-exists? "/root")
       (mkdir "/root"))
     (if root
-        (catch #t
+        (mount-root-file-system root root-fs-type
-          (lambda ()
+                                #:volatile-root? volatile-root?)
-            (if volatile-root?
-                (begin
-                  ;; XXX: For lack of a union file system...
-                  (mkdir-p "/real-root")
-                  (mount root "/real-root" "ext3" MS_RDONLY)
-                  (mount "none" "/root" "tmpfs")
-
-                  ;; XXX: 'copy-recursively' cannot deal with device nodes, so
-                  ;; explicitly avoid /dev.
-                  (for-each (lambda (file)
-                              (unless (string=? "dev" file)
-                                (copy-recursively (string-append "/real-root/"
-                                                                 file)
-                                                  (string-append "/root/"
-                                                                 file)
-                                                  #:log (%make-void-port
-                                                         "w"))))
-                            (scandir "/real-root"
-                                     (lambda (file)
-                                       (not (member file '("." ".."))))))
-
-                  ;; TODO: Unmount /real-root.
-                  )
-                (mount root "/root" "ext3")))
-          (lambda args
-            (format (current-error-port) "exception while mounting '~a': ~s~%"
-                    root args)
-            (start-repl)))
         (mount "none" "/root" "tmpfs"))
 
-    (mount-essential-file-systems #:root "/root")
-
     (unless (file-exists? "/root/dev")
       (mkdir "/root/dev")
       (make-essential-device-nodes #:root "/root"))
 
     ;; Mount the specified file systems.
-    (for-each (match-lambda
+    (for-each mount-file-system
-               (('cifs source target)
+              (remove root-mount-point? mounts))
-                (let ((target (string-append "/root/" target)))
-                  (mkdir-p target)
-                  (mount-qemu-smb-share source target)))
-               (('9p source target)
-                (let ((target (string-append "/root/" target)))
-                  (mkdir-p target)
-                  (mount-qemu-9p source target))))
-              mounts)
 
     (when guile-modules-in-chroot?
       ;; Copy the directories that contain .scm and .go files so that the
@@ -338,9 +478,8 @@ to it are lost."
 
     (if to-load
         (begin
+          (switch-root "/root")
           (format #t "loading '~a'...\n" to-load)
-          (chdir "/root")
-          (chroot "/root")
 
           ;; Obviously this has to be done each time we boot.  Do it from here
           ;; so that statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3)
@@ -351,10 +490,12 @@ to it are lost."
           (catch #t
             (lambda ()
               (primitive-load to-load))
+            (lambda args
+              (start-repl))
             (lambda args
               (format (current-error-port) "'~a' raised an exception: ~s~%"
                       to-load args)
-              (start-repl)))
+              (display-backtrace (make-stack #t) (current-error-port))))
           (format (current-error-port)
                   "boot program '~a' terminated, rebooting~%"
                   to-load)

guix/build/syscalls.scm

@@ -0,0 +1,183 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build syscalls)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:export (errno
+            MS_RDONLY
+            MS_REMOUNT
+            MS_BIND
+            MS_MOVE
+            mount
+            umount
+            processes))
+
+;;; Commentary:
+;;;
+;;; This module provides bindings to libc's syscall wrappers.  It uses the
+;;; FFI, and thus requires a dynamically-linked Guile.  (For statically-linked
+;;; Guile, we instead apply 'guile-linux-syscalls.patch'.)
+;;;
+;;; Code:
+
+(define %libc-errno-pointer
+  ;; Glibc's 'errno' pointer.
+  (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link))))
+    (and errno-loc
+         (let ((proc (pointer->procedure '* errno-loc '())))
+           (proc)))))
+
+(define errno
+  (if %libc-errno-pointer
+      (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
+        (lambda ()
+          "Return the current errno."
+          ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
+          ;; In particular, that means that no async must be running here.
+
+          ;; Use one of the fixed-size native-ref procedures because they are
+          ;; optimized down to a single VM instruction, which reduces the risk
+          ;; that we fiddle with 'errno' (needed on Guile 2.0.5, libc 2.11.)
+          (let-syntax ((ref (lambda (s)
+                              (syntax-case s ()
+                                ((_ bv)
+                                 (case (sizeof int)
+                                   ((4)
+                                    #'(bytevector-s32-native-ref bv 0))
+                                   ((8)
+                                    #'(bytevector-s64-native-ref bv 0))
+                                   (else
+                                    (error "unsupported 'int' size"
+                                           (sizeof int)))))))))
+            (ref bv))))
+      (lambda () 0)))
+
+(define (augment-mtab source target type options)
+  "Augment /etc/mtab with information about the given mount point."
+  (let ((port (open-file "/etc/mtab" "a")))
+    (format port "~a ~a ~a ~a 0 0~%"
+            source target type (or options "rw"))
+    (close-port port)))
+
+(define (read-mtab port)
+  "Read an mtab-formatted file from PORT, returning a list of tuples."
+  (let loop ((result '()))
+    (let ((line (read-line port)))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (cons (string-tokenize line) result))))))
+
+(define (remove-from-mtab target)
+  "Remove mount point TARGET from /etc/mtab."
+  (define entries
+    (remove (match-lambda
+             ((device mount-point type options freq passno)
+              (string=? target mount-point))
+             (_ #f))
+            (call-with-input-file "/etc/fstab" read-mtab)))
+
+  (call-with-output-file "/etc/fstab"
+    (lambda (port)
+      (for-each (match-lambda
+                 ((device mount-point type options freq passno)
+                  (format port "~a ~a ~a ~a ~a ~a~%"
+                          device mount-point type options freq passno)))
+                entries))))
+
+;; Linux mount flags, from libc's <sys/mount.h>.
+(define MS_RDONLY      1)
+(define MS_REMOUNT    32)
+(define MS_BIND     4096)
+(define MS_MOVE     8192)
+
+(define mount
+  (let* ((ptr  (dynamic-func "mount" (dynamic-link)))
+         (proc (pointer->procedure int ptr `(* * * ,unsigned-long *))))
+    (lambda* (source target type #:optional (flags 0) options
+                     #:key (update-mtab? #t))
+      "Mount device SOURCE on TARGET as a file system TYPE.  Optionally, FLAGS
+may be a bitwise-or of the MS_* <sys/mount.h> constants, and OPTIONS may be a
+string.  When FLAGS contains MS_REMOUNT, SOURCE and TYPE are ignored.  When
+UPDATE-MTAB? is true, update /etc/mtab.  Raise a 'system-error' exception on
+error."
+      (let ((ret (proc (if source
+                           (string->pointer source)
+                           %null-pointer)
+                       (string->pointer target)
+                       (if type
+                           (string->pointer type)
+                           %null-pointer)
+                       flags
+                       (if options
+                           (string->pointer options)
+                           %null-pointer)))
+            (err (errno)))
+        (unless (zero? ret)
+          (throw 'system-error "mount" "mount ~S on ~S: ~A"
+                 (list source target (strerror err))
+                 (list err)))
+        (when update-mtab?
+          (augment-mtab source target type options))))))
+
+(define umount
+  (let* ((ptr  (dynamic-func "umount2" (dynamic-link)))
+         (proc (pointer->procedure int ptr `(* ,int))))
+    (lambda* (target #:optional (flags 0)
+                     #:key (update-mtab? #t))
+      "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
+constants from <sys/mount.h>."
+      (let ((ret (proc (string->pointer target) flags))
+            (err (errno)))
+        (unless (zero? ret)
+          (throw 'system-error "umount" "~S: ~A"
+                 (list target (strerror err))
+                 (list err)))
+        (when update-mtab?
+          (remove-from-mtab target))))))
+
+(define (kernel? pid)
+  "Return #t if PID designates a \"kernel thread\" rather than a normal
+user-land process."
+  (let ((stat (call-with-input-file (format #f "/proc/~a/stat" pid)
+                (compose string-tokenize read-string))))
+    ;; See proc.txt in Linux's documentation for the list of fields.
+    (match stat
+      ((pid tcomm state ppid pgrp sid tty_nr tty_pgrp flags min_flt
+            cmin_flt maj_flt cmaj_flt utime stime cutime cstime
+            priority nice num_thread it_real_value start_time
+            vsize rss rsslim
+            (= string->number start_code) (= string->number end_code) _ ...)
+       ;; Got this obscure trick from sysvinit's 'killall5' program.
+       (and (zero? start_code) (zero? end_code))))))
+
+(define (processes)
+  "Return the list of live processes."
+  (sort (filter-map (lambda (file)
+                      (let ((pid (string->number file)))
+                        (and pid
+                             (not (kernel? pid))
+                             pid)))
+                    (scandir "/proc"))
+        <))
+
+;;; syscalls.scm ends here