summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-22 00:27:57 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-22 00:27:57 +0100
commitb2bfa32d253337a48f3bc0260982cbb945b345a3 (patch)
treea75ae018b5c7608414bf50bd6e55683eb0c44f7a
parent99662b8dbf420d0112f83b7daddcecfb1bcb9bad (diff)
parent2096ef47aad57a9988c8fdfaa46a70770a0e0b12 (diff)
downloadpatches-b2bfa32d253337a48f3bc0260982cbb945b345a3.tar
patches-b2bfa32d253337a48f3bc0260982cbb945b345a3.tar.gz
Merge branch 'master' into core-updates
Conflicts: gnu-system.am
-rw-r--r--.gitignore4
-rw-r--r--AUTHORS2
-rw-r--r--Makefile.am3
-rw-r--r--doc/guix.texi170
-rw-r--r--gnu-system.am36
-rw-r--r--gnu/packages/admin.scm11
-rw-r--r--gnu/packages/apl.scm4
-rw-r--r--gnu/packages/asciidoc.scm52
-rw-r--r--gnu/packages/boost.scm89
-rw-r--r--gnu/packages/calcurse.scm49
-rw-r--r--gnu/packages/curl.scm23
-rw-r--r--gnu/packages/dc.scm8
-rw-r--r--gnu/packages/elf.scm4
-rw-r--r--gnu/packages/emacs.scm10
-rw-r--r--gnu/packages/file.scm4
-rw-r--r--gnu/packages/fonts.scm67
-rw-r--r--gnu/packages/gdb.scm7
-rw-r--r--gnu/packages/giflib.scm76
-rw-r--r--gnu/packages/global.scm4
-rw-r--r--gnu/packages/gnome.scm27
-rw-r--r--gnu/packages/gnu-pw-mgr.scm7
-rw-r--r--gnu/packages/gnunet.scm128
-rw-r--r--gnu/packages/gnupg.scm45
-rw-r--r--gnu/packages/gnutls.scm14
-rw-r--r--gnu/packages/gstreamer.scm7
-rw-r--r--gnu/packages/gtk.scm19
-rw-r--r--gnu/packages/guile-wm.scm6
-rw-r--r--gnu/packages/gxmessage.scm50
-rw-r--r--gnu/packages/hurd.scm88
-rw-r--r--gnu/packages/icu4c.scm6
-rw-r--r--gnu/packages/imagemagick.scm4
-rw-r--r--gnu/packages/inkscape.scm79
-rw-r--r--gnu/packages/libwebsockets.scm83
-rw-r--r--gnu/packages/lightning.scm4
-rw-r--r--gnu/packages/linux-initrd.scm403
-rw-r--r--gnu/packages/linux.scm88
-rw-r--r--gnu/packages/lout.scm8
-rw-r--r--gnu/packages/lua.scm25
-rw-r--r--gnu/packages/mail.scm54
-rw-r--r--gnu/packages/maths.scm141
-rw-r--r--gnu/packages/moe.scm52
-rw-r--r--gnu/packages/mp3.scm3
-rw-r--r--gnu/packages/openssl.scm4
-rw-r--r--gnu/packages/parallel.scm4
-rw-r--r--gnu/packages/patches/bigloo-gc-shebangs.patch4
-rw-r--r--gnu/packages/patches/curl-fix-test172.patch12
-rw-r--r--gnu/packages/patches/dmd-tests-longer-sleeps.patch52
-rw-r--r--gnu/packages/patches/gdb-loongson-madd-fix.patch44
-rw-r--r--gnu/packages/patches/gnunet-fix-scheduler.patch13
-rw-r--r--gnu/packages/patches/gnunet-fix-tests.patch58
-rw-r--r--gnu/packages/patches/inkscape-stray-comma.patch13
-rw-r--r--gnu/packages/patches/mpc123-initialize-ao.patch19
-rw-r--r--gnu/packages/patches/patchelf-page-size.patch69
-rw-r--r--gnu/packages/patches/ratpoison-shell.patch91
-rw-r--r--gnu/packages/patches/slim-config.patch27
-rw-r--r--gnu/packages/patches/slim-session.patch17
-rw-r--r--gnu/packages/patches/slim-sigusr1.patch33
-rw-r--r--gnu/packages/python.scm20
-rw-r--r--gnu/packages/qemu.scm6
-rw-r--r--gnu/packages/ratpoison.scm4
-rw-r--r--gnu/packages/scheme.scm9
-rw-r--r--gnu/packages/sdl.scm11
-rw-r--r--gnu/packages/search.scm58
-rw-r--r--gnu/packages/shishi.scm7
-rw-r--r--gnu/packages/slim.scm32
-rw-r--r--gnu/packages/ssh.scm6
-rw-r--r--gnu/packages/stalonetray.scm48
-rw-r--r--gnu/packages/texinfo.scm14
-rw-r--r--gnu/packages/tor.scm4
-rw-r--r--gnu/packages/xorg.scm55
-rw-r--r--gnu/services.scm62
-rw-r--r--gnu/services/base.scm (renamed from gnu/system/dmd.scm)183
-rw-r--r--gnu/services/dmd.scm77
-rw-r--r--gnu/services/networking.scm80
-rw-r--r--gnu/services/xorg.scm186
-rw-r--r--gnu/system.scm93
-rw-r--r--gnu/system/grub.scm7
-rw-r--r--gnu/system/linux-initrd.scm248
-rw-r--r--gnu/system/vm.scm203
-rw-r--r--guix/build/download.scm17
-rw-r--r--guix/build/git.scm45
-rw-r--r--guix/build/linux-initrd.scm197
-rw-r--r--guix/build/union.scm37
-rw-r--r--guix/derivations.scm73
-rw-r--r--guix/download.scm7
-rw-r--r--guix/git-download.scm89
-rw-r--r--guix/monads.scm67
-rw-r--r--guix/nar.scm16
-rw-r--r--guix/packages.scm4
-rw-r--r--guix/scripts/archive.scm147
-rw-r--r--guix/scripts/build.scm198
-rw-r--r--guix/scripts/hash.scm33
-rw-r--r--guix/scripts/offload.scm51
-rw-r--r--guix/scripts/system.scm148
-rw-r--r--guix/store.scm10
-rw-r--r--guix/ui.scm6
-rw-r--r--nix/nix-daemon/guix-daemon.cc33
-rw-r--r--po/Makevars2
-rw-r--r--po/POTFILES.in1
-rw-r--r--pre-inst-env.in5
-rw-r--r--test-env.in7
-rw-r--r--tests/derivations.scm70
-rw-r--r--tests/guix-hash.sh22
-rw-r--r--tests/monads.scm26
-rw-r--r--tests/nar.scm34
-rw-r--r--tests/store.scm19
106 files changed, 4056 insertions, 1145 deletions
diff --git a/.gitignore b/.gitignore
index 10b18daa5e..7cc6751c7e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -46,8 +46,8 @@ config.cache
/doc/guix.pdf
/doc/stamp-vti
/doc/version.texi
-/gnu/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz
-/gnu/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz
+/gnu/packages/bootstrap/x86_64-linux/guile-2.0.9.tar.xz
+/gnu/packages/bootstrap/i686-linux/guile-2.0.9.tar.xz
/gnu/packages/bootstrap/mips64el-linux/guile-2.0.9.tar.xz
/guix/config.scm
/nix/nix-daemon/nix-daemon.cc
diff --git a/AUTHORS b/AUTHORS
index 6ec176cb9b..705a43128e 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -13,8 +13,10 @@ alphabetical order):
John Darrington <john@darrington.wattle.id.au>
Andreas Enge <andreas@enge.fr>
Guy Grant <gzg@riseup.net>
+ Raimon Grau <raimonster@gmail.com>
Nikita Karetnikov <nikita@karetnikov.org>
Aljosha Papsch <misc@rpapsch.de>
+ Manolis Ragkousis <manolis837@gmail.com>
Cyril Roelandt <tipecaml@gmail.com>
Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
Sree Harsha Totakura <sreeharsha@totakura.in>
diff --git a/Makefile.am b/Makefile.am
index 16b28eb181..56cb6d2354 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -34,6 +34,7 @@ MODULES = \
guix/pki.scm \
guix/utils.scm \
guix/download.scm \
+ guix/git-download.scm \
guix/monads.scm \
guix/profiles.scm \
guix/serialization.scm \
@@ -54,6 +55,7 @@ MODULES = \
guix/ui.scm \
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 \
@@ -77,6 +79,7 @@ MODULES = \
guix/scripts/substitute-binary.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
+ guix/scripts/system.scm \
guix.scm \
$(GNU_SYSTEM_MODULES)
diff --git a/doc/guix.texi b/doc/guix.texi
index 91fa07f1a8..78736fadf2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -502,6 +502,30 @@ the daemon makes the new file a hard link to the other file. This
slightly increases the input/output load at the end of a build process.
This option disables this.
+@item --gc-keep-outputs[=yes|no]
+Tell whether the garbage collector (GC) must keep outputs of live
+derivations.
+
+When set to ``yes'', the GC will keep the outputs of any live derivation
+available in the store---the @code{.drv} files. The default is ``no'',
+meaning that derivation outputs are kept only if they are GC roots.
+
+@item --gc-keep-derivations[=yes|no]
+Tell whether the garbage collector (GC) must keep derivations
+corresponding to live outputs.
+
+When set to ``yes'', as is the case by default, the GC keeps
+derivations---i.e., @code{.drv} files---as long as at least one of their
+outputs is live. This allows users to keep track of the origins of
+items in their store. Setting it to ``no'' saves a bit of disk space.
+
+Note that when both @code{--gc-keep-derivations} and
+@code{--gc-keep-outputs} are used, the effect is to keep all the build
+prerequisites (the sources, compiler, libraries, and other build-time
+tools) of live objects in the store, regardless of whether these
+prerequisites are live. This is convenient for developers since it
+saves rebuilds or downloads.
+
@item --impersonate-linux-2.6
On Linux-based systems, impersonate Linux 2.6. This means that the
kernel's @code{uname} system call will report 2.6 as the release number.
@@ -1071,11 +1095,19 @@ the target machine's store. The @code{--missing} option can help figure
out which items are missing from the target's store.
Archives are stored in the ``Nix archive'' or ``Nar'' format, which is
-comparable in spirit to `tar'. When exporting, the daemon digitally
-signs the contents of the archive, and that digital signature is
-appended. When importing, the daemon verifies the signature and rejects
-the import in case of an invalid signature or if the signing key is not
-authorized.
+comparable in spirit to `tar', but with a few noteworthy differences
+that make it more appropriate for our purposes. First, rather than
+recording all Unix meta-data for each file, the Nar format only mentions
+the file type (regular, directory, or symbolic link); Unix permissions
+and owner/group are dismissed. Second, the order in which directory
+entries are stored always follows the order of file names according to
+the C locale collation order. This makes archive production fully
+deterministic.
+
+When exporting, the daemon digitally signs the contents of the archive,
+and that digital signature is appended. When importing, the daemon
+verifies the signature and rejects the import in case of an invalid
+signature or if the signing key is not authorized.
@c FIXME: Add xref to daemon doc about signatures.
The main options are:
@@ -1454,15 +1486,18 @@ a derivation is the @code{derivation} procedure:
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
- [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @
+ [#:recursive? #f] [#:inputs '()] [#:env-vars '()] @
[#:system (%current-system)] [#:references-graphs #f] @
[#:local-build? #f]
Build a derivation with the given arguments, and return the resulting
@code{<derivation>} object.
-When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
+When @var{hash} and @var{hash-algo} are given, a
@dfn{fixed-output derivation} is created---i.e., one whose result is
-known in advance, such as a file download.
+known in advance, such as a file download. If, in addition,
+@var{recursive?} is true, then that fixed output may be an executable
+file or a directory and @var{hash} must be the hash of an archive
+containing this output.
When @var{references-graphs} is true, it must be a list of file
name/store path pairs. In that case, the reference graph of each store
@@ -1502,7 +1537,7 @@ the caller to directly pass a Guile expression as the build script:
@var{name} @var{exp} @
[#:system (%current-system)] [#:inputs '()] @
[#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
- [#:env-vars '()] [#:modules '()] @
+ [#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:references-graphs #f] [#:local-build? #f] [#:guile-for-build #f]
Return a derivation that executes Scheme expression @var{exp} as a
builder for derivation @var{name}. @var{inputs} must be a list of
@@ -1590,23 +1625,22 @@ in a monad---values that carry this additional context---are called
Consider this ``normal'' procedure:
@example
-(define (profile.sh store)
- ;; Return the name of a shell script in the store that
- ;; initializes the 'PATH' environment variable.
- (let* ((drv (package-derivation store coreutils))
- (out (derivation->output-path drv)))
- (add-text-to-store store "profile.sh"
- (format #f "export PATH=~a/bin" out))))
+(define (sh-symlink store)
+ ;; Return a derivation that symlinks the 'bash' executable.
+ (let* ((drv (package-derivation store bash))
+ (out (derivation->output-path drv))
+ (sh (string-append out "/bin/bash")))
+ (build-expression->derivation store "sh"
+ `(symlink ,sh %output))))
@end example
Using @code{(guix monads)}, it may be rewritten as a monadic function:
@example
-(define (profile.sh)
+(define (sh-symlink)
;; Same, but return a monadic value.
- (mlet %store-monad ((bin (package-file coreutils "bin")))
- (text-file "profile.sh"
- (string-append "export PATH=" bin))))
+ (mlet %store-monad ((sh (package-file bash "bin")))
+ (derivation-expression "sh" `(symlink ,sh %output))))
@end example
There are two things to note in the second version: the @code{store}
@@ -1672,7 +1706,32 @@ open store connection.
@deffn {Monadic Procedure} text-file @var{name} @var{text}
Return as a monadic value the absolute file name in the store of the file
-containing @var{text}.
+containing @var{text}, a string.
+@end deffn
+
+@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{}
+Return as a monadic value a derivation that builds a text file
+containing all of @var{text}. @var{text} may list, in addition to
+strings, packages, derivations, and store file names; the resulting
+store file holds references to all these.
+
+This variant should be preferred over @code{text-file} anytime the file
+to create will reference items from the store. This is typically the
+case when building a configuration file that embeds store file names,
+like this:
+
+@example
+(define (profile.sh)
+ ;; Return the name of a shell script in the store that
+ ;; initializes the 'PATH' environment variable.
+ (text-file* "profile.sh"
+ "export PATH=" coreutils "/bin:"
+ grep "/bin:" sed "/bin\n"))
+@end example
+
+In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file
+will references @var{coreutils}, @var{grep}, and @var{sed}, thereby
+preventing them from being garbage-collected during its lifetime.
@end deffn
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
@@ -1910,6 +1969,19 @@ If the @option{--format} option is not specified, @command{guix hash}
will output the hash in @code{nix-base32}. This representation is used
in the definitions of packages.
+@item --recursive
+@itemx -r
+Compute the hash on @var{file} recursively.
+
+In this case, the hash is computed on an archive containing @var{file},
+including its children if it is a directory. Some of @var{file}'s
+meta-data is part of the archive; for instance, when @var{file} is a
+regular file, the hash is different depending on whether @var{file} is
+executable or not. Meta-data such as time stamps has no impact on the
+hash (@pxref{Invoking guix archive}).
+@c FIXME: Replace xref above with xref to an ``Archive'' section when
+@c it exists.
+
@end table
@node Invoking guix refresh
@@ -2499,8 +2571,9 @@ instantiated. Then we show how this mechanism can be extended, for
instance to support new system services.
@menu
-* Using the Configuration System:: Customizing your GNU system.
-* Defining Services:: Adding new service definitions.
+* Using the Configuration System:: Customizing your GNU system.
+* Invoking guix system:: Instantiating a system configuration.
+* Defining Services:: Adding new service definitions.
@end menu
@node Using the Configuration System
@@ -2513,9 +2586,9 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
@findex operating-system
@lisp
-(use-modules (gnu system)
+(use-modules (gnu services base) ; for '%base-services'
+ (gnu services ssh) ; for 'lsh-service'
(gnu system shadow) ; for 'user-account'
- (gnu system service) ; for 'lsh-service'
(gnu packages base) ; Coreutils, grep, etc.
(gnu packages bash) ; Bash
(gnu packages admin) ; dmd, Inetutils
@@ -2542,7 +2615,7 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
procps psmisc
zile less))
(services (cons (lsh-service #:port 2222 #:allow-root-login? #t)
- %standard-services))))
+ %base-services))))
@end lisp
This example should be self-describing. The @code{packages} field lists
@@ -2552,9 +2625,10 @@ visible on the system, for all user accounts---i.e., in every user's
@code{PATH} environment variable---in addition to the per-user profiles
(@pxref{Invoking guix package}).
+@vindex %base-services
The @code{services} field lists @dfn{system services} to be made
-available when the system starts. The @var{%standard-services} list,
-from the @code{(gnu system)} module, provides the basic services one
+available when the system starts. The @var{%base-services} list,
+from the @code{(gnu services base)} module, provides the basic services one
would expect from a GNU system: a login service (mingetty) on each tty,
syslogd, libc's name service cache daemon (nscd), etc.
@@ -2566,13 +2640,12 @@ daemon listening on port 2222, and allowing remote @code{root} logins
right command-line options, possibly with supporting configuration files
generated as needed (@pxref{Defining Services}).
-@c TODO: update when that command exists
Assuming the above snippet is stored in the @file{my-system-config.scm}
-file, the (yet unwritten!) @command{guix system --boot
-my-system-config.scm} command instantiates that configuration, and makes
-it the default GRUB boot entry. The normal way to change the system's
-configuration is by updating this file and re-running the @command{guix
-system} command.
+file, the @command{guix system boot my-system-config.scm} command
+instantiates that configuration, and makes it the default GRUB boot
+entry (@pxref{Invoking guix system}). The normal way to change the
+system's configuration is by updating this file and re-running the
+@command{guix system} command.
At the Scheme level, the bulk of an @code{operating-system} declaration
is instantiated with the following monadic procedure (@pxref{The Store
@@ -2587,11 +2660,38 @@ the packages, configuration files, and other supporting files needed to
instantiate @var{os}.
@end deffn
+@node Invoking guix system
+@subsection Invoking @code{guix system}
+
+Once you have written an operating system declaration, as seen in the
+previous section, it can be @dfn{instantiated} using the @command{guix
+system} command. The synopsis is:
+
+@example
+guix system @var{options}@dots{} @var{action} @var{file}
+@end example
+
+@var{file} must be the name of a file containing an
+@code{operating-system} declaration. @var{action} specifies how the
+operating system is instantiate. Currently only one value is supported:
+
+@table @code
+@item vm
+@cindex virtual machine
+Build a virtual machine that contain the operating system declared in
+@var{file}, and return a script to run that virtual machine (VM).
+
+The VM shares its store with the host system.
+@end table
+
+@var{options} can contain any of the common build options provided by
+@command{guix build} (@pxref{Invoking guix build}).
+
@node Defining Services
@subsection Defining Services
-The @code{(gnu system dmd)} module defines several procedures that allow
+The @code{(gnu services @dots{})} modules define several procedures that allow
users to declare the operating system's services (@pxref{Using the
Configuration System}). These procedures are @emph{monadic
procedures}---i.e., procedures that return a monadic value in the store
diff --git a/gnu-system.am b/gnu-system.am
index d993571a1a..29103f9360 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -29,6 +29,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/algebra.scm \
gnu/packages/apl.scm \
gnu/packages/apr.scm \
+ gnu/packages/asciidoc.scm \
gnu/packages/aspell.scm \
gnu/packages/attr.scm \
gnu/packages/autogen.scm \
@@ -39,7 +40,9 @@ GNU_SYSTEM_MODULES = \
gnu/packages/bdb.scm \
gnu/packages/bdw-gc.scm \
gnu/packages/bison.scm \
+ gnu/packages/boost.scm \
gnu/packages/bootstrap.scm \
+ gnu/packages/calcurse.scm \
gnu/packages/cdrom.scm \
gnu/packages/cflow.scm \
gnu/packages/check.scm \
@@ -68,7 +71,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/fonts.scm \
gnu/packages/fontutils.scm \
gnu/packages/freeipmi.scm \
- gnu/packages/games.scm \
+ gnu/packages/games.scm \
gnu/packages/gawk.scm \
gnu/packages/gcal.scm \
gnu/packages/gcc.scm \
@@ -78,6 +81,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/geeqie.scm \
gnu/packages/gettext.scm \
gnu/packages/ghostscript.scm \
+ gnu/packages/giflib.scm \
gnu/packages/gkrellm.scm \
gnu/packages/gl.scm \
gnu/packages/glib.scm \
@@ -100,12 +104,15 @@ GNU_SYSTEM_MODULES = \
gnu/packages/guile.scm \
gnu/packages/guile-wm.scm \
gnu/packages/gv.scm \
+ gnu/packages/gxmessage.scm \
gnu/packages/help2man.scm \
gnu/packages/hugs.scm \
+ gnu/packages/hurd.scm \
gnu/packages/icu4c.scm \
gnu/packages/idutils.scm \
gnu/packages/imagemagick.scm \
gnu/packages/indent.scm \
+ gnu/packages/inkscape.scm \
gnu/packages/irssi.scm \
gnu/packages/iso-codes.scm \
gnu/packages/kde.scm \
@@ -125,9 +132,9 @@ GNU_SYSTEM_MODULES = \
gnu/packages/libunistring.scm \
gnu/packages/libusb.scm \
gnu/packages/libunwind.scm \
+ gnu/packages/libwebsockets.scm \
gnu/packages/lightning.scm \
gnu/packages/linux.scm \
- gnu/packages/linux-initrd.scm \
gnu/packages/lout.scm \
gnu/packages/lsh.scm \
gnu/packages/lsof.scm \
@@ -138,6 +145,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/make-bootstrap.scm \
gnu/packages/maths.scm \
gnu/packages/mit-krb5.scm \
+ gnu/packages/moe.scm \
gnu/packages/mp3.scm \
gnu/packages/multiprecision.scm \
gnu/packages/mtools.scm \
@@ -179,6 +187,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/scheme.scm \
gnu/packages/screen.scm \
gnu/packages/sdl.scm \
+ gnu/packages/search.scm \
gnu/packages/serveez.scm \
gnu/packages/shishi.scm \
gnu/packages/skribilo.scm \
@@ -186,6 +195,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/smalltalk.scm \
gnu/packages/sqlite.scm \
gnu/packages/ssh.scm \
+ gnu/packages/stalonetray.scm \
gnu/packages/swig.scm \
gnu/packages/tcl.scm \
gnu/packages/tcsh.scm \
@@ -203,7 +213,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/vpn.scm \
gnu/packages/w3m.scm \
gnu/packages/wdiff.scm \
- gnu/packages/web.scm \
+ gnu/packages/web.scm \
gnu/packages/wget.scm \
gnu/packages/which.scm \
gnu/packages/wordnet.scm \
@@ -216,10 +226,16 @@ GNU_SYSTEM_MODULES = \
gnu/packages/zile.scm \
gnu/packages/zip.scm \
\
+ gnu/services.scm \
+ gnu/services/base.scm \
+ gnu/services/dmd.scm \
+ gnu/services/networking.scm \
+ gnu/services/xorg.scm \
+ \
gnu/system.scm \
- gnu/system/dmd.scm \
gnu/system/grub.scm \
gnu/system/linux.scm \
+ gnu/system/linux-initrd.scm \
gnu/system/shadow.scm \
gnu/system/vm.scm
@@ -236,9 +252,11 @@ dist_patch_DATA = \
gnu/packages/patches/cmake-fix-tests.patch \
gnu/packages/patches/coreutils-dummy-man.patch \
gnu/packages/patches/cpio-gets-undeclared.patch \
+ gnu/packages/patches/curl-fix-test172.patch \
gnu/packages/patches/dbus-localstatedir.patch \
gnu/packages/patches/diffutils-gets-undeclared.patch \
gnu/packages/patches/dmd-getpw.patch \
+ gnu/packages/patches/dmd-tests-longer-sleeps.patch \
gnu/packages/patches/emacs-configure-sh.patch \
gnu/packages/patches/findutils-absolute-paths.patch \
gnu/packages/patches/flac-fix-memcmp-not-declared.patch \
@@ -246,13 +264,14 @@ dist_patch_DATA = \
gnu/packages/patches/gawk-shell.patch \
gnu/packages/patches/gcc-cross-environment-variables.patch \
gnu/packages/patches/gd-mips64-deplibs-fix.patch \
- gnu/packages/patches/gdb-loongson-madd-fix.patch \
gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \
gnu/packages/patches/glib-tests-newnet.patch \
gnu/packages/patches/glib-tests-prlimit.patch \
gnu/packages/patches/glibc-bootstrap-system.patch \
gnu/packages/patches/glibc-ldd-x86_64.patch \
+ gnu/packages/patches/gnunet-fix-scheduler.patch \
+ gnu/packages/patches/gnunet-fix-tests.patch \
gnu/packages/patches/gobject-introspection-cc.patch \
gnu/packages/patches/grub-gets-undeclared.patch \
gnu/packages/patches/gstreamer-0.10-bison3.patch \
@@ -265,6 +284,7 @@ dist_patch_DATA = \
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
gnu/packages/patches/gtkglext-remove-pangox-dependency.patch \
gnu/packages/patches/hop-bigloo-4.0b.patch \
+ gnu/packages/patches/inkscape-stray-comma.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libffi-mips-n32-fix.patch \
gnu/packages/patches/liboop-mips64-deplibs-fix.patch \
@@ -278,6 +298,8 @@ dist_patch_DATA = \
gnu/packages/patches/make-impure-dirs.patch \
gnu/packages/patches/mcron-install.patch \
gnu/packages/patches/mit-krb5-init-fix.patch \
+ gnu/packages/patches/mpc123-initialize-ao.patch \
+ gnu/packages/patches/patchelf-page-size.patch \
gnu/packages/patches/perl-no-sys-dirs.patch \
gnu/packages/patches/plotutils-libpng-jmpbuf.patch \
gnu/packages/patches/procps-make-3.82.patch \
@@ -287,9 +309,13 @@ dist_patch_DATA = \
gnu/packages/patches/qemu-make-4.0.patch \
gnu/packages/patches/qemu-multiple-smb-shares.patch \
gnu/packages/patches/qt4-tests.patch \
+ gnu/packages/patches/ratpoison-shell.patch \
gnu/packages/patches/readline-link-ncurses.patch \
gnu/packages/patches/ripperx-libm.patch \
gnu/packages/patches/scheme48-tests.patch \
+ gnu/packages/patches/slim-session.patch \
+ gnu/packages/patches/slim-config.patch \
+ gnu/packages/patches/slim-sigusr1.patch \
gnu/packages/patches/tcsh-fix-autotest.patch \
gnu/packages/patches/teckit-cstdio.patch \
gnu/packages/patches/valgrind-glibc.patch \
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index dfbf20d56f..6998996523 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -49,7 +49,8 @@
(sha256
(base32
"07mddw0p62fcphwjzgb6rfa0pjz5sy6jzbha0sm2vc3rqf459jxg"))
- (patches (list (search-patch "dmd-getpw.patch")))))
+ (patches (list (search-patch "dmd-getpw.patch")
+ (search-patch "dmd-tests-longer-sleeps.patch")))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--localstatedir=/var")))
@@ -349,14 +350,14 @@ connection alive.")
(define-public isc-dhcp
(package
(name "isc-dhcp")
- (version "4.3.0a1")
+ (version "4.3.0")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.isc.org/isc/dhcp/"
version "/dhcp-" version ".tar.gz"))
(sha256
(base32
- "0001n26m4488nl95h53wg60sywbli4d246vz2h8lpv70jlrq9q1p"))))
+ "12mydvj6x3zcl3gla06bywfkkrgg03g66fijs94mwb7kbiym3dm7"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
@@ -383,9 +384,9 @@ connection alive.")
(system* "tar" "xf" "bind.tar.gz")
(for-each patch-shebang
- (find-files "bind-9.9.5b1" ".*"))
+ (find-files "bind-9.9.5" ".*"))
(zero? (system* "tar" "cf" "bind.tar.gz"
- "bind-9.9.5b1"))))
+ "bind-9.9.5"))))
(alist-cons-after
'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)
diff --git a/gnu/packages/apl.scm b/gnu/packages/apl.scm
index a2ef71f37f..17da73bd92 100644
--- a/gnu/packages/apl.scm
+++ b/gnu/packages/apl.scm
@@ -28,14 +28,14 @@
(define-public apl
(package
(name "apl")
- (version "1.1")
+ (version "1.2")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
(sha256
(base32
- "1myinxa0m3y4fanpxflfakfk3m1s8641wdlbwbs0vg5yp10xm0m3"))))
+ "0v9jn4hrg4w3hyw4lsj8cys9aqsmrc1x4k0g5f67psgzgd45a4xb"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/apl/")
(inputs
diff --git a/gnu/packages/asciidoc.scm b/gnu/packages/asciidoc.scm
new file mode 100644
index 0000000000..5bc5cfa7f9
--- /dev/null
+++ b/gnu/packages/asciidoc.scm
@@ -0,0 +1,52 @@
+;;; 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 asciidoc)
+ #:use-module (guix licenses)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (gnu packages python)
+ #:use-module (guix build-system gnu)
+ #:autoload (gnu packages zip) (unzip))
+
+(define-public asciidoc
+ (package
+ (name "asciidoc")
+ (version "8.6.9")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/asciidoc/asciidoc-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1w71nk527lq504njmaf0vzr93pgahkgzzxzglrq6bay8cw2rvnvq"))))
+ (build-system gnu-build-system)
+ (arguments '(#:tests? #f)) ; no 'check' target
+ (inputs `(("python" ,python-2)))
+ (home-page "http://www.methods.co.nz/asciidoc/")
+ (synopsis "Text-based document generation system")
+ (description
+ "AsciiDoc is a text document format for writing notes, documentation,
+articles, books, ebooks, slideshows, web pages, man pages and blogs.
+AsciiDoc files can be translated to many formats including HTML, PDF,
+EPUB, man page.
+
+AsciiDoc is highly configurable: both the AsciiDoc source file syntax and
+the backend output markups (which can be almost any type of SGML/XML
+markup) can be customized and extended by the user.")
+ (license gpl2+)))
diff --git a/gnu/packages/boost.scm b/gnu/packages/boost.scm
new file mode 100644
index 0000000000..73b377e384
--- /dev/null
+++ b/gnu/packages/boost.scm
@@ -0,0 +1,89 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 John Darrington <jmd@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 boost)
+ #: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 python)
+ #:use-module (gnu packages tcsh)
+ #:use-module (gnu packages perl))
+
+(define-public boost
+ (package
+ (name "boost")
+ (version "1.55.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "mirror://sourceforge/boost/boost_"
+ (string-map (lambda (x) (if (eq? x #\.) #\_ x)) version)
+ ".tar.bz2"))
+ (sha256
+ (base32
+ "0lkv5dzssbl5fmh2nkaszi8x9qbj80pr4acf9i26sj3rvlih1w7z"))))
+ (build-system gnu-build-system)
+ (native-inputs
+ `(("perl" ,perl)
+ ("python" ,python-2)
+ ("tcsh" ,tcsh)))
+ (arguments
+ `(#:phases
+ (alist-replace
+ 'configure
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((out (assoc-ref outputs "out")))
+ (substitute* '("libs/config/configure"
+ "libs/spirit/classic/phoenix/test/runtest.sh"
+ "tools/build/v2/doc/bjam.qbk"
+ "tools/build/v2/engine/execunix.c"
+ "tools/build/v2/engine/Jambase"
+ "tools/build/v2/engine/jambase.c")
+ (("/bin/sh") (which "sh")))
+
+ (setenv "SHELL" (which "sh"))
+ (setenv "CONFIG_SHELL" (which "sh"))
+
+ (zero? (system* "./bootstrap.sh"
+ (string-append "--prefix=" out)
+ "--with-toolset=gcc"))))
+ (alist-replace
+ 'build
+ (lambda _
+ (zero? (system* "./b2" "threading=multi" "link=shared")))
+
+ (alist-replace
+ 'check
+ (lambda _ #t)
+
+ (alist-replace
+ 'install
+ (lambda _
+ (zero? (system* "./b2" "install" "threading=multi" "link=shared")))
+ %standard-phases))))))
+
+ (home-page "http://boost.org")
+ (synopsis "Peer-reviewed portable C++ source libraries")
+ (description
+ "A collection of libraries intended to be widely useful, and usable
+across a broad spectrum of applications.")
+ (license (license:x11-style "http://www.boost.org/LICENSE_1_0.txt"
+ "Some components have other similar licences."))))
diff --git a/gnu/packages/calcurse.scm b/gnu/packages/calcurse.scm
new file mode 100644
index 0000000000..84dab0c53c
--- /dev/null
+++ b/gnu/packages/calcurse.scm
@@ -0,0 +1,49 @@
+;;; 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 autogen)
+ #:use-module (guix packages)
+ #:use-module (guix licenses)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages ncurses))
+
+(define-public calcurse
+ (package
+ (name "calcurse")
+ (version "3.1.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://calcurse.org/files/calcurse-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1qwhffwhfg7bjxrviwlcrhnfw0976d39da8kfspq6dgd9nqv68a1"))))
+ (build-system gnu-build-system)
+ (inputs `(("ncurses" ,ncurses)))
+ (home-page "http://www.calcurse.org")
+ (synopsis "Text-based calendar and scheduling")
+ (description
+ "Calcurse is a text-based calendar and scheduling application. It helps
+keep track of events, appointments and everyday tasks. A configurable
+notification system reminds user of upcoming deadlines, and the curses based
+interface can be customized to suit user needs. All of the commands are
+documented within an online help system.")
+ (license bsd-2)))
diff --git a/gnu/packages/curl.scm b/gnu/packages/curl.scm
index 7072ed3878..7309da61e6 100644
--- a/gnu/packages/curl.scm
+++ b/gnu/packages/curl.scm
@@ -22,6 +22,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gnutls)
#:use-module (gnu packages groff)
@@ -30,19 +31,24 @@
#:use-module (gnu packages openldap)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages python)
#:use-module (gnu packages ssh))
(define-public curl
(package
(name "curl")
- (version "7.28.1")
+ (version "7.35.0")
(source (origin
(method url-fetch)
(uri (string-append "http://curl.haxx.se/download/curl-"
version ".tar.lzma"))
(sha256
(base32
- "13bhfs41yf60ys2hrikqxjwfzaj0gm91kqzsgc5fr4grzmpm38nx"))))
+ "14w5cwh6b1426lxkq6kp6h4vxryr4n7wfrrwhny1r4123q7n8ab9"))
+ (patches
+ ;; This patch fixes testcase 172 which uses a hardcoded cookie
+ ;; expiration value which is expired as of Feb 1, 2014.
+ (list (search-patch "curl-fix-test172.patch")))))
(build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls)
("gss" ,gss)
@@ -54,9 +60,18 @@
`(("perl" ,perl)
;; to enable the --manual option and make test 1026 pass
("groff" ,groff)
- ("pkg-config" ,pkg-config)))
+ ("pkg-config" ,pkg-config)
+ ("python" ,python-2)))
(arguments
- `(#:configure-flags '("--with-gnutls" "--with-gssapi")))
+ `(#:configure-flags '("--with-gnutls" "--with-gssapi")
+ ;; Add a phase to patch '/bin/sh' occurances in tests/runtests.pl
+ #:phases
+ (alist-cons-before
+ 'check 'patch-runtests
+ (lambda _
+ (substitute* "tests/runtests.pl"
+ (("/bin/sh") (which "sh"))))
+ %standard-phases)))
(synopsis "curl, command line tool for transferring data with URL syntax")
(description
"curl is a command line tool for transferring data with URL syntax,
diff --git a/gnu/packages/dc.scm b/gnu/packages/dc.scm
index 75ed5f4af7..0cb7c5b4f0 100644
--- a/gnu/packages/dc.scm
+++ b/gnu/packages/dc.scm
@@ -28,19 +28,19 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses)
- #:renamer (symbol-prefix-proc 'license:)))
+ #:renamer (symbol-prefix-proc 'license:)))
(define-public ncdc
(package
(name "ncdc")
- (version "1.18.1")
+ (version "1.19")
(source
(origin
(method url-fetch)
(uri (string-append "http://dev.yorhel.nl/download/ncdc-" version
- ".tar.gz"))
+ ".tar.gz"))
(sha256 (base32
- "11c6z9c3vv2vg01q02r53m28q3cx6x66j1l63f1mbk1crlqpf9fc"))))
+ "1wgvqwfxq9kc729h2r528n55821w87sfbm4h21mr6pvkpfw30hf2"))))
(build-system gnu-build-system)
(inputs
`(("bzip2" ,bzip2)
diff --git a/gnu/packages/elf.scm b/gnu/packages/elf.scm
index 1df9956f87..45714be70e 100644
--- a/gnu/packages/elf.scm
+++ b/gnu/packages/elf.scm
@@ -21,6 +21,7 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:select (gpl3+ lgpl3+ lgpl2.0+))
+ #:use-module (gnu packages)
#:use-module (gnu packages m4)
#:use-module (gnu packages compression))
@@ -92,7 +93,8 @@
"/patchelf-" version ".tar.bz2"))
(sha256
(base32
- "00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw"))))
+ "00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw"))
+ (patches (list (search-patch "patchelf-page-size.patch")))))
(build-system gnu-build-system)
(home-page "http://nixos.org/patchelf.html")
(synopsis "Modify the dynamic linker and RPATH of ELF executables")
diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm
index cecfd6025d..87c4e894c5 100644
--- a/gnu/packages/emacs.scm
+++ b/gnu/packages/emacs.scm
@@ -33,6 +33,8 @@
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages libtiff)
#:use-module (gnu packages libpng)
+ #:use-module (gnu packages giflib)
+ #:use-module (gnu packages linux)
#:use-module ((gnu packages compression)
#:renamer (symbol-prefix-proc 'compression:))
#:use-module (gnu packages xml)
@@ -54,8 +56,7 @@
(arguments
'(#:configure-flags
(list (string-append "--with-crt-dir=" (assoc-ref %build-inputs "libc")
- "/lib")
- "--with-gif=no") ; XXX: add libungif
+ "/lib"))
#:phases (alist-cons-before
'configure 'fix-/bin/pwd
(lambda _
@@ -73,7 +74,7 @@
("gtk+" ,gtk+-2)
("libXft" ,libxft)
("libtiff" ,libtiff)
- ;; ("libungif" ,libungif)
+ ("giflib" ,giflib)
("libjpeg" ,libjpeg-8)
;; When looking for libpng `configure' links with `-lpng -lz', so we
@@ -83,6 +84,9 @@
("libXpm" ,libxpm)
("libxml2" ,libxml2)
+ ("libice" ,libice)
+ ("libsm" ,libsm)
+ ("alsa-lib" ,alsa-lib)
("dbus" ,dbus)))
(native-inputs
`(("pkg-config" ,pkg-config)
diff --git a/gnu/packages/file.scm b/gnu/packages/file.scm
index 63a9df4a9a..707d03ffd9 100644
--- a/gnu/packages/file.scm
+++ b/gnu/packages/file.scm
@@ -26,13 +26,13 @@
(define-public file
(package
(name "file")
- (version "5.12")
+ (version "5.16")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.astron.com/pub/file/file-"
version ".tar.gz"))
(sha256 (base32
- "08ix4xrvan0k80n0l5lqfmc4azjv5lyhvhwdxny4r09j5smhv78r"))))
+ "0qcj72mp8fzvh29h70mksxynax9mk5c6p8gzqw5qlyn34rvsrg28"))))
(build-system gnu-build-system)
(native-inputs
;; This package depends upon a native install of itself.
diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm
index c367a46e4a..8ec59e4d0e 100644
--- a/gnu/packages/fonts.scm
+++ b/gnu/packages/fonts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,6 +27,72 @@
#:select (tar))
#:use-module (gnu packages compression))
+(define-public ttf-dejavu
+ (package
+ (name "ttf-dejavu")
+ (version "2.34")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/dejavu/"
+ version "/dejavu-fonts-ttf-"
+ version ".tar.bz2"))
+ (sha256
+ (base32
+ "0pgb0a3ngamidacmrvasg51ck3gp8gn93w6sf1s8snwzx4x2r9yh"))))
+ (build-system trivial-build-system)
+ (arguments
+ `(#:modules ((guix build utils))
+ #:builder (begin
+ (use-modules (guix build utils))
+
+ (let ((tar (string-append (assoc-ref %build-inputs
+ "tar")
+ "/bin/tar"))
+ (PATH (string-append (assoc-ref %build-inputs
+ "bzip2")
+ "/bin"))
+ (font-dir (string-append
+ %output "/share/fonts/truetype"))
+ (conf-dir (string-append
+ %output "/share/fontconfig/conf.avail"))
+ (doc-dir (string-append
+ %output "/share/doc/" ,name "-" ,version)))
+ (setenv "PATH" PATH)
+ (system* tar "xvf" (assoc-ref %build-inputs "source"))
+
+ (mkdir-p font-dir)
+ (mkdir-p conf-dir)
+ (mkdir-p doc-dir)
+ (chdir (string-append "dejavu-fonts-ttf-" ,version))
+ (for-each (lambda (ttf)
+ (copy-file ttf
+ (string-append font-dir "/"
+ (basename ttf))))
+ (find-files "ttf" "\\.ttf$"))
+ (for-each (lambda (conf)
+ (copy-file conf
+ (string-append conf-dir "/"
+ (basename conf))))
+ (find-files "fontconfig" "\\.conf$"))
+ (for-each (lambda (doc)
+ (copy-file doc
+ (string-append doc-dir "/"
+ (basename doc))))
+ (find-files "." "\\.txt$|^[A-Z][A-Z]*$"))))))
+ (native-inputs `(("source" ,source)
+ ("tar" ,tar)
+ ("bzip2" ,bzip2)))
+ (home-page "http://dejavu-fonts.org/")
+ (synopsis "Vera font family derivate with additional characters")
+ (description "DejaVu provides an expanded version of the Vera font family
+aiming for quality and broader Unicode coverage while retaining the original
+Vera style. DejaVu currently works towards conformance with the Multilingual
+European Standards (MES-1 and MES-2) for Unicode coverage. The DejaVu fonts
+provide serif, sans and monospaced variants.")
+ (license
+ (license:x11-style
+ "http://dejavu-fonts.org/"))))
+
(define-public ttf-bitstream-vera
(package
(name "ttf-bitstream-vera")
diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm
index 5a863e54aa..7a780d8ea2 100644
--- a/gnu/packages/gdb.scm
+++ b/gnu/packages/gdb.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.
;;;
@@ -33,15 +33,14 @@
(define-public gdb
(package
(name "gdb")
- (version "7.6.2")
+ (version "7.7")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gdb/gdb-"
version ".tar.bz2"))
(sha256
(base32
- "1s6hjqmq7xz10hqx45dgrpfh5mla578shn3zxgnrsv66w4n0wsig"))
- (patches (list (search-patch "gdb-loongson-madd-fix.patch")))))
+ "08vcb97j1b7vxwq6088wb6s3g3bm8iwikd922y0xsgbbxv3d2104"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
diff --git a/gnu/packages/giflib.scm b/gnu/packages/giflib.scm
new file mode 100644
index 0000000000..849586ed71
--- /dev/null
+++ b/gnu/packages/giflib.scm
@@ -0,0 +1,76 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages giflib)
+ #:use-module (guix licenses)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (srfi srfi-1)
+ #:use-module (gnu packages xorg)
+ #:use-module (gnu packages perl))
+
+(define-public giflib
+ (package
+ (name "giflib")
+ (version "4.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/giflib/giflib-"
+ (first (string-split version #\.))
+ ".x/giflib-" version ".tar.bz2"))
+ (sha256
+ (base32 "0rmp7ipzk42r841bggd7bfqk4p8qsssbp4wcck4qnz7p4rkxbj0a"))))
+ (build-system gnu-build-system)
+ (outputs '("bin" ; utility programs
+ "out")) ; library
+ (inputs `(("libx11" ,libx11)
+ ("libice" ,libice)
+ ("libsm" ,libsm)
+ ("perl" ,perl)))
+ (arguments
+ `(#:phases (alist-cons-after
+ 'unpack 'disable-html-doc-gen
+ (lambda _
+ (substitute* "doc/Makefile.in"
+ (("^all: allhtml manpages") "")))
+ (alist-cons-after
+ 'install 'install-manpages
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((bin (assoc-ref outputs "bin"))
+ (man1dir (string-append bin "/share/man/man1")))
+ (mkdir-p man1dir)
+ (for-each (lambda (file)
+ (let ((base (basename file)))
+ (format #t "installing `~a' to `~a'~%"
+ base man1dir)
+ (copy-file file
+ (string-append
+ man1dir "/" base))))
+ (find-files "doc" "\\.1"))))
+ %standard-phases))))
+ (synopsis "Tools and library for working with GIF images")
+ (description
+ "giflib is a library for reading and writing GIF images. It is API and
+ABI compatible with libungif which was in wide use while the LZW compression
+algorithm was patented. Tools are also included to convert, manipulate,
+compose, and analyze GIF images.")
+ (home-page "http://giflib.sourceforge.net/")
+ (license x11)))
+
+;;; giflib.scm ends here
diff --git a/gnu/packages/global.scm b/gnu/packages/global.scm
index 6244e2461e..01674f69c6 100644
--- a/gnu/packages/global.scm
+++ b/gnu/packages/global.scm
@@ -28,14 +28,14 @@
(define-public global ; a global variable
(package
(name "global")
- (version "6.2.9")
+ (version "6.2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/global/global-"
version ".tar.gz"))
(sha256
(base32
- "00y38kp0zbpjl9c9phldy7j2ihqc54qn4cdgk0azbjdsv75k3n6q"))))
+ "15nvz8g9b3s4i4fsa9ynrr8y517nfpy62agcvsl9rlz3j23b5b7f"))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)
("libtool" ,libtool)))
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
index 90683f3635..5d17b019fd 100644
--- a/gnu/packages/gnome.scm
+++ b/gnu/packages/gnome.scm
@@ -496,3 +496,30 @@ the API")
additional GDK objects which support OpenGL rendering in GTK+ and GtkWidget
API add-ons to make GTK+ widgets OpenGL-capable.")
(license lgpl2.1+)))
+
+(define-public glade3
+ (package
+ (name "glade")
+ (version "3.8.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnome/sources/" name "/"
+ (substring version 0 (string-rindex version #\.)) "/"
+ name "3-" version ".tar.xz"))
+ (sha256
+ (base32 "021xgq2l18w3rvwms9aq2idm0fk66vwb4f777gs0qh3ap5shgbn7"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("gtk+" ,gtk+-2)
+ ("libxml2" ,libxml2)))
+ (native-inputs
+ `(("intltool" ,intltool)
+ ("python" ,python)
+ ("pkg-config" ,pkg-config)))
+ (home-page "https://glade.gnome.org")
+ (synopsis "GTK+ rapid application development tool")
+ (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+)))
diff --git a/gnu/packages/gnu-pw-mgr.scm b/gnu/packages/gnu-pw-mgr.scm
index d8340d6712..3b66cde018 100644
--- a/gnu/packages/gnu-pw-mgr.scm
+++ b/gnu/packages/gnu-pw-mgr.scm
@@ -27,15 +27,16 @@
(define-public gnu-pw-mgr
(package
(name "gnu-pw-mgr")
- (version "1.0")
+ (version "1.1")
(source
(origin
(method url-fetch)
- (uri (string-append "mirror://gnu/gnu-pw-mgr/gnu-pw-mgr-"
+ (uri (string-append "mirror://gnu/gnu-pw-mgr/gpw-"
+ version "/gnu-pw-mgr-"
version ".tar.gz"))
(sha256
(base32
- "0sn9gzngqkrv74iwxzn5ldqx3w73w9paldcdh8rsv9yvgarv2bm4"))))
+ "1nqkwjsdcif51d1s4dizr1ifx0qpmkjzvi375vc27dwbav4dwalx"))))
(build-system gnu-build-system)
(inputs `(("which" ,which)))
(home-page "http://www.gnu.org/software/gnu-pw-mgr/")
diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm
index 52a434a61c..7f7a6fd6f9 100644
--- a/gnu/packages/gnunet.scm
+++ b/gnu/packages/gnunet.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,6 +18,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages gnunet)
+ #:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
@@ -25,11 +27,19 @@
#:use-module (gnu packages glib)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gnutls)
+ #:use-module (gnu packages groff)
#:use-module (gnu packages gstreamer)
+ #:use-module (gnu packages libidn)
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages libtiff)
+ #:use-module (gnu packages libunistring)
+ #:use-module (gnu packages maths)
#:use-module (gnu packages openssl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages pulseaudio)
+ #:use-module (gnu packages python)
+ #:use-module (gnu packages sqlite)
#:use-module (gnu packages video)
#:use-module (gnu packages xiph)
#:use-module ((guix licenses)
@@ -123,3 +133,119 @@ also features security features such as basic and digest authentication
and support for SSL3 and TLS.")
(license license:lgpl2.1+)
(home-page "http://www.gnu.org/software/libmicrohttpd/")))
+
+(define-public gnurl
+ (package
+ (name "gnurl")
+ (version "7.35.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "https://gnunet.org/sites/default/files/gnurl-"
+ version ".tar.bz2"))
+ (sha256
+ (base32 "0dzj22f5z6ppjj1aq1bml64iwbzzcd8w1qy3bgpk6gnzqslsxknf"))))
+ (build-system gnu-build-system)
+ (inputs `(("gnutls" ,gnutls)
+ ("libidn" ,libidn)
+ ("zlib" ,zlib)))
+ (native-inputs
+ `(("groff" ,groff)
+ ("perl" ,perl)
+ ("pkg-config" ,pkg-config)
+ ("python" ,python-2)))
+ (arguments
+ `(#:configure-flags '("--enable-ipv6" "--with-gnutls" "--without-libssh2"
+ "--without-libmetalink" "--without-winidn"
+ "--without-librtmp" "--without-nghttp2"
+ "--without-nss" "--without-cyassl"
+ "--without-polarssl" "--without-ssl"
+ "--without-winssl" "--without-darwinssl"
+ "--disable-sspi" "--disable-ntlm-wb"
+ "--disable-ldap" "--disable-rtsp" "--disable-dict"
+ "--disable-telnet" "--disable-tftp" "--disable-pop3"
+ "--disable-imap" "--disable-smtp" "--disable-gopher"
+ "--disable-file" "--disable-ftp")
+ #:test-target "test"
+ #:parallel-tests? #f
+ ;; We have to patch runtests.pl in tests/ directory
+ #:phases
+ (alist-cons-before
+ 'check 'patch-runtests
+ (lambda _
+ (substitute* "tests/runtests.pl"
+ (("/bin/sh") (which "sh"))))
+ %standard-phases)))
+ (synopsis "Microfork of cURL with support for the HTTP/HTTPS/GnuTLS subset of cURL")
+ (description
+ "Gnurl is a microfork of cURL, a command line tool for transferring data
+with URL syntax. While cURL supports many crypto backends, libgnurl only
+supports HTTPS, HTTPS and GnuTLS.")
+ (license (license:bsd-style "file://COPYING"
+ "See COPYING in the distribution."))
+ (home-page "https://gnunet.org/gnurl")))
+
+(define-public gnunet
+ (package
+ (name "gnunet")
+ (version "0.10.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/gnunet/gnunet-" version
+ ".tar.gz"))
+ (sha256 (base32
+ "0zqpc47kywhjrpphl0palz849khv00ra2gjrfkysp6p0gfsbvd0i"))
+ (patches
+ (list
+ ;; Patch to fix serious bug in scheduler; upstream commit: #31747
+ (search-patch "gnunet-fix-scheduler.patch")
+ ;; Patch to fix bugs in testcases:
+ ;; * Disable peerinfo-tool tests as they depend on reverse DNS lookups
+ ;; * Allow revocation and integration-tests testcases to run on
+ ;; loopback; upstream: #32130, #32326
+ ;; * Skip GNS testcases requiring DNS lookups; upstream: #32118
+ (search-patch "gnunet-fix-tests.patch")))
+ (patch-flags '("-p0"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("glpk" ,glpk)
+ ("gnurl" ,gnurl)
+ ("gnutls" ,gnutls)
+ ("libextractor" ,libextractor)
+ ("libgcrypt" ,libgcrypt)
+ ("libidn" ,libidn)
+ ("libmicrohttpd" ,libmicrohttpd)
+ ("libtool" ,libtool)
+ ("libunistring" ,libunistring)
+ ("openssl" ,openssl)
+ ("opus" ,opus)
+ ("pulseaudio", pulseaudio)
+ ("sqlite" ,sqlite)
+ ("zlib" ,zlib)))
+ (native-inputs
+ `(("pkg-config" ,pkg-config)
+ ("python" ,python-2)))
+ (arguments
+ '(#:phases
+ ;; swap check and install phases and set paths to installed binaries
+ (alist-cons-before
+ 'check 'set-path-for-check
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((out (assoc-ref outputs "out")))
+ (setenv "GNUNET_PREFIX" out)
+ (setenv "PATH" (string-append (getenv "PATH") ":" out "/bin"))))
+ (alist-cons-after
+ 'install 'check
+ (assoc-ref %standard-phases 'check)
+ (alist-delete
+ 'check
+ %standard-phases)))))
+ (synopsis "Anonymous peer-to-peer file-sharing framework")
+ (description
+ "GNUnet is a framework for secure, peer-to-peer networking. It works in a
+decentralized manner and does not rely on any notion of trusted services. One
+service implemented on it is censorship-resistant file-sharing. Communication
+is encrypted and anonymity is provided by making messages originating from a
+peer indistinguishable from those that the peer is routing.")
+ (license license:gpl3+)
+ (home-page "https://gnunet.org/")))
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index 0be19c6177..e06865d196 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -1,6 +1,7 @@
;;; 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 © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -61,14 +62,14 @@ Daemon and possibly more in the future.")
(define-public libgcrypt
(package
(name "libgcrypt")
- (version "1.6.0")
+ (version "1.6.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
version ".tar.bz2"))
(sha256
(base32
- "024plbybsmnxbp39hs92lp6dzvkz2cb70nv69qrwr55d02350bb6"))))
+ "0w10vhpj1r5nq7qm6jp21p1v1vhf37701cw8yilygzzqd7mfzhx1"))))
(build-system gnu-build-system)
(propagated-inputs
`(("libgpg-error" ,libgpg-error)))
@@ -221,10 +222,12 @@ components), libgpg-error (centralized GnuPG error values), and libskba
(base32
"15h429h6pd67iiv580bjmwbkadpxsdppw0xrqpcm4dvm24jc271d"))))
(build-system gnu-build-system)
+ (propagated-inputs
+ ;; Needs to be propagated because gpgme.h includes gpg-error.h.
+ `(("libgpg-error" ,libgpg-error)))
(inputs
`(("gnupg" ,gnupg)
- ("libassuan" ,libassuan)
- ("libgpg-error" ,libgpg-error)))
+ ("libassuan" ,libassuan)))
(home-page "http://www.gnupg.org/related_software/gpgme/")
(synopsis "library providing simplified access to GnuPG functionality")
(description
@@ -418,3 +421,37 @@ including tools for signing keys, keyring analysis, and party preparation.
"Pinentry provides a console and a GTK+ GUI that allows users to
enter a passphrase when `gpg' or `gpg2' is run and needs it.")
(license gpl2+)))
+
+(define-public paperkey
+ (package
+ (name "paperkey")
+ (version "1.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://www.jabberwocky.com/"
+ "software/paperkey/paperkey-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1yybj8bj68v4lxwpn596b6ismh2fyixw5vlqqg26byrn4d9dfmsv"))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:phases
+ (alist-replace
+ 'check
+ (lambda* (#:key #:allow-other-keys #:rest args)
+ (let ((check (assoc-ref %standard-phases 'check)))
+ (substitute* '("checks/roundtrip.sh"
+ "checks/roundtrip-raw.sh")
+ (("/bin/echo") "echo"))
+ (apply check args)))
+ %standard-phases)))
+ (home-page "http://www.jabberwocky.com/software/paperkey/")
+ (synopsis "Backup OpenPGP keys to paper")
+ (description
+ "Paperkey extracts the secret bytes from an OpenPGP (GnuPG, PGP, etc) key
+for printing with paper and ink, which have amazingly long retention
+qualities. To reconstruct a secret key, you re-enter those
+bytes (whether by hand, OCR, QR code, or the like) and paperkey can use
+them to transform your existing public key into a secret key.")
+ (license gpl2+)))
diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm
index 79cebe637d..915f6f8c8f 100644
--- a/gnu/packages/gnutls.scm
+++ b/gnu/packages/gnutls.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,8 @@
#:use-module (gnu packages perl)
#:use-module (gnu packages which)
#:use-module (gnu packages texinfo)
- #:use-module (gnu packages pkg-config))
+ #:use-module (gnu packages pkg-config)
+ #:use-module (srfi srfi-1))
(define-public libtasn1
(package
@@ -61,17 +63,19 @@ specifications.")
(define-public gnutls
(package
(name "gnutls")
- (version "3.2.4")
+ (version "3.2.11")
(source (origin
(method url-fetch)
(uri
;; Note: Releases are no longer on ftp.gnu.org since the
;; schism (after version 3.1.5).
- (string-append "mirror://gnupg/gnutls/v3.2/gnutls-"
- version ".tar.xz"))
+ (string-append "mirror://gnupg/gnutls/v"
+ (string-join (take (string-split version #\.) 2)
+ ".")
+ "/gnutls-" version ".tar.xz"))
(sha256
(base32
- "0zvhzy87v9dfxfvmg1pl951kw55rp647cqdza8942fxq7spp158i"))))
+ "1hgk3k8f6wqijca3bsjbfn8pzyfva509y4j2vaxhm4ynfa5cai5q"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm
index 6ebd8c399b..c68d756d1e 100644
--- a/gnu/packages/gstreamer.scm
+++ b/gnu/packages/gstreamer.scm
@@ -43,6 +43,10 @@
(base32
"0c0irk85jd2cihm5pmf4zxhlpg08qpxjcqv1l9qn2n3h2gsaj2lf"))))
(build-system gnu-build-system)
+ (arguments
+ ;; XXX: Temporarily disable tests to work around 'gst/gstbus' test
+ ;; failure: <https://bugzilla.gnome.org/show_bug.cgi?id=724073>.
+ '(#:tests? #f))
(inputs `(("glib" ,glib)))
(native-inputs
`(("bison" ,bison)
@@ -51,8 +55,7 @@
("pkg-config" ,pkg-config)
("python-wrapper" ,python-wrapper)))
(home-page "http://gstreamer.freedesktop.org/")
- (synopsis
- "Multimedia library")
+ (synopsis "Multimedia library")
(description
"GStreamer is a library for constructing graphs of media-handling
components. The applications it supports range from simple Ogg/Vorbis
diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm
index fcfbcc47ce..2a01f891b2 100644
--- a/gnu/packages/gtk.scm
+++ b/gnu/packages/gtk.scm
@@ -590,3 +590,22 @@ are easily extensible via inheritance. You can create user interfaces either
in code or with the Glade User Interface designer, using libglademm. There's
extensive documentation, including API reference and a tutorial.")
(license license:lgpl2.1+)))
+
+
+(define-public gtkmm-2
+ (package (inherit gtkmm)
+ (version "2.24.2")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnome/sources/gtkmm/"
+ (string-take version 4) "/gtkmm-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "0gcm91sc1a05c56kzh74l370ggj0zz8nmmjvjaaxgmhdq8lpl369"))))
+ (propagated-inputs
+ `(("pangomm" ,pangomm)
+ ("cairomm" ,cairomm)
+ ("atkmm" ,atkmm)
+ ("gtk+" ,gtk+-2)
+ ("glibmm" ,glibmm)))))
diff --git a/gnu/packages/guile-wm.scm b/gnu/packages/guile-wm.scm
index 1dc9f3f50a..b05974c8ae 100644
--- a/gnu/packages/guile-wm.scm
+++ b/gnu/packages/guile-wm.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.
;;;
@@ -73,14 +73,14 @@ dependencies.")
(define-public guile-wm
(package
(name "guile-wm")
- (version "0.2")
+ (version "1.0")
(source (origin
(method url-fetch)
(uri (string-append "http://www.markwitmer.com/dist/guile-wm-"
version ".tar.gz"))
(sha256
(base32
- "0vv6avpkl6lgrhy2a16z470fqjhvzi4r93qwl87xw9v5dvldf08p"))))
+ "1l9qcz236jxvryndimjy62cf8zxf8i3f8vg3zpqqjhw15j9mdk3r"))))
(build-system gnu-build-system)
(arguments '(;; The '.scm' files go to $(datadir), so set that to the
;; standard value.
diff --git a/gnu/packages/gxmessage.scm b/gnu/packages/gxmessage.scm
new file mode 100644
index 0000000000..425659274c
--- /dev/null
+++ b/gnu/packages/gxmessage.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 John Darrington <jmd@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 gxmessage)
+ #:use-module (guix licenses)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages gtk)
+ #:use-module (gnu packages))
+
+(define-public gxmessage
+ (package
+ (name "gxmessage")
+ (version "2.20.0")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/gxmessage/gxmessage-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "1nq8r321x3rzcdkjlvj61i9x7smslnis7b05b39xqcjc9xyg4hv0"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("gtk+" ,gtk+-2)))
+ (native-inputs
+ `(("intltool" ,intltool)
+ ("pkg-config" ,pkg-config)))
+ (home-page "http://www.gnu.org/software/gxmessage/")
+ (synopsis "Open popup message window with buttons for return")
+ (description "GNU gxmessage is a program that pops up dialog windows, which display
+a message to the user and waits for their action. The program then exits
+with an exit code corresponding to the response.")
+ (license gpl3+)))
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
new file mode 100644
index 0000000000..3edccbdd1c
--- /dev/null
+++ b/gnu/packages/hurd.scm
@@ -0,0 +1,88 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages hurd)
+ #:use-module (guix licenses)
+ #:use-module (guix download)
+ #:use-module (guix packages)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages flex)
+ #:use-module (gnu packages bison))
+
+(define-public gnumach-headers
+ (package
+ (name "gnumach-headers")
+ (version "1.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/gnumach/gnumach-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0r371wsm7imx356p0xsls5hifb1gf9y90rm1phr0qkahbmfk9hlv"))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:phases (alist-replace
+ 'install
+ (lambda _
+ (zero?
+ (system* "make" "install-data")))
+ (alist-delete
+ 'build
+ %standard-phases))
+
+ ;; GNU Mach supports only IA32 currently, so cheat so that we can at
+ ;; least install its headers.
+ #:configure-flags '("--build=i686-pc-gnu")
+
+ #:tests? #f))
+ (home-page "https://www.gnu.org/software/hurd/microkernel/mach/gnumach.html")
+ (synopsis "GNU Mach kernel headers")
+ (description
+ "Headers of the GNU Mach kernel.")
+ (license gpl2+)))
+
+(define-public mig
+ (package
+ (name "mig")
+ (version "1.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/mig/mig-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1jgzggnbp22sa8z5dilm43zy12vlf1pjxfb3kh13xrfhcay0l97b"))))
+ (build-system gnu-build-system)
+ (inputs `(("gnumach-headers" ,gnumach-headers)))
+ (native-inputs
+ `(("flex" ,flex)
+ ("bison" ,bison)))
+ (arguments `(#:tests? #f))
+ (home-page "http://www.gnu.org/software/hurd/microkernel/mach/mig/gnu_mig.html")
+ (synopsis "Mach 3.0 interface generator for the Hurd")
+ (description
+ "GNU MIG is the GNU distribution of the Mach 3.0 interface generator
+MIG, as maintained by the GNU Hurd developers for the GNU project.
+You need this tool to compile the GNU Mach and GNU Hurd distributions,
+and to compile the GNU C library for the Hurd. Also,you will need it
+for other software in the GNU system that uses Mach-based inter-process
+communication.")
+ (license gpl2+)))
diff --git a/gnu/packages/icu4c.scm b/gnu/packages/icu4c.scm
index 6129662436..aea5d2fae5 100644
--- a/gnu/packages/icu4c.scm
+++ b/gnu/packages/icu4c.scm
@@ -28,7 +28,7 @@
(define-public icu4c
(package
(name "icu4c")
- (version "50.1.1")
+ (version "52.1")
(source (origin
(method url-fetch)
(uri (string-append "http://download.icu-project.org/files/icu4c/"
@@ -37,7 +37,7 @@
(string-map (lambda (x) (if (char=? x #\.) #\_ x)) version)
"-src.tgz"))
(sha256 (base32
- "13yz0kk6zsgj94idnlr3vbg8iph5z4ly4b4xrd5wfja7q3ijdx56"))))
+ "14l0kl17nirc34frcybzg0snknaks23abhdxkmsqg3k9sil5wk9g"))))
(build-system gnu-build-system)
(inputs
`(("patchelf" ,patchelf)
@@ -61,7 +61,7 @@
(lambda* (#:key #:allow-other-keys #:rest args)
(let ((configure (assoc-ref %standard-phases 'configure)))
;; patch out two occurrences of /bin/sh from configure script
- ;; that might have disappeared in a release later than 50.1.1
+ ;; that might have disappeared in a release later than 52.1
(substitute* "configure"
(("`/bin/sh")
(string-append "`" (which "bash"))))
diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm
index 0d574731f9..a1713273e9 100644
--- a/gnu/packages/imagemagick.scm
+++ b/gnu/packages/imagemagick.scm
@@ -37,14 +37,14 @@
(define-public imagemagick
(package
(name "imagemagick")
- (version "6.8.7-9")
+ (version "6.8.8-4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz"))
(sha256
(base32
- "0625hqddc93qjd5923yivy74jyagk3n2bi2kjgykn86g7kxh7fcd"))))
+ "0bfxhfymkdbvardlr0nbjfmv53m47lcl9kkycipk4hxawfs927jr"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-cons-before
diff --git a/gnu/packages/inkscape.scm b/gnu/packages/inkscape.scm
new file mode 100644
index 0000000000..6b8669f373
--- /dev/null
+++ b/gnu/packages/inkscape.scm
@@ -0,0 +1,79 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 John Darrington <jmd@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 inkscape)
+ #: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 aspell)
+ #:use-module (gnu packages bdw-gc)
+ #:use-module (gnu packages boost)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu packages gtk)
+ #:use-module (gnu packages maths)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages pdf)
+ #:use-module (gnu packages popt)
+ #:use-module (gnu packages python)
+ #:use-module (gnu packages xml)
+ #:use-module (gnu packages ghostscript)
+ #:use-module (gnu packages fontutils)
+ #:use-module (gnu packages libpng)
+ #:use-module (gnu packages pkg-config))
+
+(define-public inkscape
+ (package
+ (name "inkscape")
+ (version "0.48.4")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/inkscape/inkscape-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0nhxsgrgsx6zrgpkd1akxjvmdqjp8ccnsvlwxh62l0brg84fw6bf"))
+ (patches (list (search-patch "inkscape-stray-comma.patch")))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("aspell" ,aspell)
+ ("gtkmm" ,gtkmm-2)
+ ("gtk" ,gtk+-2)
+ ("gsl" ,gsl)
+ ("poppler" ,poppler)
+ ("libpng" ,libpng)
+ ("libxml2" ,libxml2)
+ ("libxslt" ,libxslt)
+ ("libgc" ,libgc)
+ ("freetype" ,freetype)
+ ("popt" ,popt)
+ ("python" ,python-2)
+ ("lcms" ,lcms)
+ ("boost" ,boost)))
+ (native-inputs
+ `(("intltool" ,intltool)
+ ("perl" ,perl)
+ ("pkg-config" ,pkg-config)))
+ (home-page "http://inkscape.org/")
+ (synopsis "Vector graphics editor")
+ (description "Inkscape is a vector graphics editor. What sets Inkscape
+apart is its use of Scalable Vector Graphics (SVG), an XML-based W3C standard,
+as the native format.")
+ (license license:gpl2+)))
diff --git a/gnu/packages/libwebsockets.scm b/gnu/packages/libwebsockets.scm
new file mode 100644
index 0000000000..3f900aef72
--- /dev/null
+++ b/gnu/packages/libwebsockets.scm
@@ -0,0 +1,83 @@
+;;; 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 libwebsockets)
+ #:use-module (guix packages)
+ #:use-module (guix git-download)
+ #:use-module (guix build-system gnu)
+ #:use-module ((guix licenses)
+ #:select (lgpl2.1))
+ #:use-module (gnu packages autotools)
+ #:use-module ((gnu packages compression) #:select (zlib))
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages openssl))
+
+(define-public libwebsockets
+ (package
+ (name "libwebsockets")
+ (version "1.2")
+ (source (origin
+ ;; The project does not publish tarballs, so we have to take
+ ;; things from Git.
+ (method git-fetch)
+ (uri (git-reference
+ (url "git://git.libwebsockets.org/libwebsockets")
+ (commit (string-append "v" version
+ "-chrome26-firefox18"))))
+ (sha256
+ (base32
+ "1293hbz8qj4p27m1qjf8dn97r10xjyiwdpq491m87zi025s558cl"))
+ (file-name (string-append name "-" version))))
+
+ ;; The package has both CMake and GNU build systems, but the latter is
+ ;; apparently better supported (CMake-generated makefiles lack an
+ ;; 'install' target, for instance.)
+ (build-system gnu-build-system)
+
+ (arguments
+ '(#:phases (alist-replace
+ 'unpack
+ ;; FIXME: Remove this when gnu-build-system handles that
+ ;; case correctly.
+ (lambda* (#:key source #:allow-other-keys)
+ (mkdir "source")
+ (chdir "source")
+ (copy-recursively source ".")
+ #t)
+
+ (alist-cons-before
+ 'configure 'bootstrap
+ (lambda _
+ (chmod "libwebsockets-api-doc.html" #o666)
+ (zero? (system* "./autogen.sh")))
+ %standard-phases))))
+ (native-inputs `(("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("libtool" ,libtool "bin")
+ ("perl" ,perl))) ; to build the HTML doc
+ (inputs `(("zlib" ,zlib)
+ ("openssl" ,openssl)))
+ (synopsis "WebSockets library written in C")
+ (description
+ "libwebsockets is a library that allows C programs to establish client
+and server WebSockets connections---a protocol layered above HTTP that allows
+for efficient socket-like bidirectional reliable communication channels.")
+ (home-page "http://libwebsockets.org/")
+
+ ;; This is LGPLv2.1-only with extra exceptions specified in 'LICENSE'.
+ (license lgpl2.1)))
diff --git a/gnu/packages/lightning.scm b/gnu/packages/lightning.scm
index 8ec433e0b8..75681bf866 100644
--- a/gnu/packages/lightning.scm
+++ b/gnu/packages/lightning.scm
@@ -25,14 +25,14 @@
(define-public lightning
(package
(name "lightning")
- (version "2.0.2")
+ (version "2.0.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/lightning/lightning-"
version ".tar.gz"))
(sha256
(base32
- "100ya7dx12403gimif7p2q7ahd8vxqrxpxqzqr1zqci825nb0b43"))))
+ "1mbbqia7ypvyrl15b15h0wxqbr153j7vlapjsv57lid88rr7c7ia"))))
(build-system gnu-build-system)
(synopsis "Library for generating assembly code at runtime")
(description
diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
deleted file mode 100644
index 0134e89da8..0000000000
--- a/gnu/packages/linux-initrd.scm
+++ /dev/null
@@ -1,403 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (gnu packages linux-initrd)
- #:use-module (guix utils)
- #:use-module (guix licenses)
- #:use-module (guix build-system)
- #:use-module ((guix derivations)
- #:select (imported-modules compiled-modules %guile-for-build))
- #:use-module (gnu packages)
- #: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 (guix packages)
- #:use-module (guix download)
- #:use-module (guix build-system trivial))
-
-
-;;; Commentary:
-;;;
-;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
-;;; particular initrd's that run Guile.
-;;;
-;;; Code:
-
-
-(define-syntax-rule (raw-build-system (store system name inputs) body ...)
- "Lift BODY to a package build system."
- ;; TODO: Generalize.
- (build-system
- (name "raw")
- (description "Raw build system")
- (build (lambda* (store name source inputs #:key system #:allow-other-keys)
- (parameterize ((%guile-for-build (package-derivation store
- guile-2.0)))
- body ...)))))
-
-(define (module-package modules)
- "Return a package that contains all of MODULES, a list of Guile module
-names."
- (package
- (name "guile-modules")
- (version "0")
- (source #f)
- (build-system (raw-build-system (store system name inputs)
- (imported-modules store modules
- #:name name
- #:system system)))
- (synopsis "Set of Guile modules")
- (description synopsis)
- (license gpl3+)
- (home-page "http://www.gnu.org/software/guix/")))
-
-(define (compiled-module-package modules)
- "Return a package that contains the .go files corresponding to MODULES, a
-list of Guile module names."
- (package
- (name "guile-compiled-modules")
- (version "0")
- (source #f)
- (build-system (raw-build-system (store system name inputs)
- (compiled-modules store modules
- #:name name
- #:system system)))
- (synopsis "Set of compiled Guile modules")
- (description synopsis)
- (license gpl3+)
- (home-page "http://www.gnu.org/software/guix/")))
-
-(define* (expression->initrd exp
- #:key
- (guile %guile-static-stripped)
- (cpio cpio)
- (gzip gzip)
- (name "guile-initrd")
- (system (%current-system))
- (modules '())
- (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
-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'.
-
- (define builder
- `(begin
- (use-modules (guix build utils)
- (ice-9 pretty-print)
- (ice-9 popen)
- (ice-9 match)
- (ice-9 ftw)
- (srfi srfi-26)
- (system base compile)
- (rnrs bytevectors)
- ((system foreign) #:select (sizeof)))
-
- (let ((guile (assoc-ref %build-inputs "guile"))
- (cpio (string-append (assoc-ref %build-inputs "cpio")
- "/bin/cpio"))
- (gzip (string-append (assoc-ref %build-inputs "gzip")
- "/bin/gzip"))
- (modules (assoc-ref %build-inputs "modules"))
- (gos (assoc-ref %build-inputs "modules/compiled"))
- (scm-dir (string-append "share/guile/" (effective-version)))
- (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
- (effective-version)
- (if (eq? (native-endianness) (endianness little))
- "LE"
- "BE")
- (sizeof '*)
- (effective-version)))
- (out (assoc-ref %outputs "out")))
- (mkdir out)
- (mkdir "contents")
- (with-directory-excursion "contents"
- (copy-recursively guile ".")
- (call-with-output-file "init"
- (lambda (p)
- (format p "#!/bin/guile -ds~%!#~%" guile)
- (pretty-print ',exp p)))
- (chmod "init" #o555)
- (chmod "bin/guile" #o555)
-
- ;; Copy Guile modules.
- (chmod scm-dir #o777)
- (copy-recursively modules scm-dir
- #:follow-symlinks? #t)
- (copy-recursively gos (string-append "lib/guile/"
- (effective-version) "/ccache")
- #:follow-symlinks? #t)
-
- ;; Compile `init'.
- (mkdir-p go-dir)
- (set! %load-path (cons modules %load-path))
- (set! %load-compiled-path (cons gos %load-compiled-path))
- (compile-file "init"
- #:opts %auto-compilation-options
- #:output-file (string-append go-dir "/init.go"))
-
- ;; Copy Linux modules.
- (let* ((linux (assoc-ref %build-inputs "linux"))
- (module-dir (and linux
- (string-append linux "/lib/modules"))))
- (mkdir "modules")
- ,@(map (lambda (module)
- `(match (find-files module-dir ,module)
- ((file)
- (format #t "copying '~a'...~%" file)
- (copy-file file (string-append "modules/"
- ,module)))
- (()
- (error "module not found" ,module module-dir))
- ((_ ...)
- (error "several modules by that name"
- ,module module-dir))))
- linux-modules))
-
- ;; Reset the timestamps of all the files that will make it in the
- ;; initrd.
- (for-each (cut utime <> 0 0 0 0)
- (find-files "." ".*"))
-
- (system* cpio "--version")
- (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
- "-O" (string-append out "/initrd")
- "-H" "newc" "--null")))
- (define print0
- (let ((len (string-length "./")))
- (lambda (file)
- (format pipe "~a\0" (string-drop file len)))))
-
- ;; Note: as per `ramfs-rootfs-initramfs.txt', always add
- ;; directory entries before the files that are inside of it: "The
- ;; Linux kernel cpio extractor won't create files in a directory
- ;; that doesn't exist, so the directory entries must go before
- ;; the files that go in those directories."
- (file-system-fold (const #t)
- (lambda (file stat result) ; leaf
- (print0 file))
- (lambda (dir stat result) ; down
- (unless (string=? dir ".")
- (print0 dir)))
- (const #f) ; up
- (const #f) ; skip
- (const #f)
- #f
- ".")
-
- (and (zero? (close-pipe pipe))
- (with-directory-excursion out
- (and (zero? (system* gzip "--best" "initrd"))
- (rename-file "initrd.gz" "initrd")))))))))
-
- (package
- (name name)
- (version "0")
- (source #f)
- (build-system trivial-build-system)
- (arguments `(#:modules ((guix build utils))
- #:builder ,builder))
- (inputs `(("guile" ,guile)
- ("cpio" ,cpio)
- ("gzip" ,gzip)
- ("modules" ,(module-package modules))
- ("modules/compiled" ,(compiled-module-package modules))
- ,@(if linux
- `(("linux" ,linux))
- '())))
- (synopsis "An initial RAM disk (initrd) for the Linux kernel")
- (description
- "An initial RAM disk (initrd), really a gzipped cpio archive, for use by
-the Linux kernel.")
- (license gpl3+)
- (home-page "http://www.gnu.org/software/guix/")))
-
-(define-public qemu-initrd
- (expression->initrd
- '(begin
- (use-modules (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match)
- ((system base compile) #:select (compile-file))
- (guix build utils)
- (guix build linux-initrd))
-
- (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)
- (let ((opt (string-append opt "=")))
- (and=> (find (cut string-prefix? opt <>)
- args)
- (lambda (arg)
- (substring arg (+ 1 (string-index arg #\=))))))))
- (to-load (option "--load"))
- (root (option "--root")))
-
- (when (member "--repl" args)
- ((@ (system repl repl) start-repl)))
-
- (display "loading CIFS and companion modules...\n")
- (for-each (compose load-linux-module*
- (cut string-append "/modules/" <>))
- (list "md4.ko" "ecb.ko" "cifs.ko"))
-
- (unless (configure-qemu-networking)
- (display "network interface is DOWN\n"))
-
- ;; Make /dev nodes.
- (make-essential-device-nodes)
-
- ;; Prepare the real root file system under /root.
- (unless (file-exists? "/root")
- (mkdir "/root"))
- (if root
- (mount root "/root" "ext3")
- (mount "none" "/root" "tmpfs"))
- (mount-essential-file-systems #:root "/root")
-
- (mkdir "/root/xchg")
- (mkdir-p "/root/nix/store")
-
- (unless (file-exists? "/root/dev")
- (mkdir "/root/dev")
- (make-essential-device-nodes #:root "/root"))
-
- ;; Mount the host's store and exchange directory.
- (mount-qemu-smb-share "/store" "/root/nix/store")
- (mount-qemu-smb-share "/xchg" "/root/xchg")
-
- ;; Copy the directories that contain .scm and .go files so that the
- ;; child process in the chroot can load modules (we would bind-mount
- ;; them but for some reason that fails with EINVAL -- XXX).
- (mkdir "/root/share")
- (mkdir "/root/lib")
- (mount "none" "/root/share" "tmpfs")
- (mount "none" "/root/lib" "tmpfs")
- (copy-recursively "/share" "/root/share"
- #:log (%make-void-port "w"))
- (copy-recursively "/lib" "/root/lib"
- #:log (%make-void-port "w"))
-
-
- (if to-load
- (begin
- (format #t "loading boot file '~a'...\n" to-load)
- (compile-file (string-append "/root/" to-load)
- #:output-file "/root/loader.go"
- #:opts %auto-compilation-options)
- (match (primitive-fork)
- (0
- (chroot "/root")
- (load-compiled "/loader.go")
-
- ;; TODO: Remove /lib, /share, and /loader.go.
- )
- (pid
- (format #t "boot file loaded under PID ~a~%" pid)
- (let ((status (waitpid pid)))
- (reboot)))))
- (begin
- (display "no boot file passed via '--load'\n")
- (display "entering a warm and cozy REPL\n")
- ((@ (system repl repl) start-repl))))))
- #:name "qemu-initrd"
- #:modules '((guix build utils)
- (guix build linux-initrd))
- #:linux linux-libre
- #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
-
-(define-public gnu-system-initrd
- ;; Initrd for the GNU system itself, with nothing QEMU-specific.
- (expression->initrd
- '(begin
- (use-modules (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match)
- (guix build utils)
- (guix build linux-initrd))
-
- (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)
- (let ((opt (string-append opt "=")))
- (and=> (find (cut string-prefix? opt <>)
- args)
- (lambda (arg)
- (substring arg (+ 1 (string-index arg #\=))))))))
- (to-load (option "--load"))
- (root (option "--root")))
-
- (when (member "--repl" args)
- ((@ (system repl repl) start-repl)))
-
- ;; Make /dev nodes.
- (make-essential-device-nodes)
-
- ;; Prepare the real root file system under /root.
- (mkdir-p "/root")
- (if root
- ;; Assume ROOT has a usable /dev tree.
- (mount root "/root" "ext3")
- (begin
- (mount "none" "/root" "tmpfs")
- (make-essential-device-nodes #:root "/root")))
-
- (mount-essential-file-systems #:root "/root")
-
- (mkdir-p "/root/tmp")
- (mount "none" "/root/tmp" "tmpfs")
-
- ;; XXX: We don't copy our fellow Guile modules to /root (see
- ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can
- ;; happen if it throws, to display the exception!), then we're
- ;; screwed. Hopefully TO-LOAD is a simple expression that just does
- ;; '(execlp ...)'.
-
- (if to-load
- (begin
- (format #t "loading '~a'...\n" to-load)
- (chroot "/root")
- (primitive-load to-load)
- (format (current-error-port)
- "boot program '~a' terminated, rebooting~%"
- to-load)
- (sleep 2)
- (reboot))
- (begin
- (display "no init file passed via '--exec'\n")
- (display "entering a warm and cozy REPL\n")
- ((@ (system repl repl) start-repl))))))
- #:name "qemu-system-initrd"
- #:modules '((guix build linux-initrd)
- (guix build utils))
- #:linux linux-libre))
-
-;;; linux-initrd.scm ends here
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 5e80a5837d..3fca5dfaf9 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -30,6 +30,7 @@
#:use-module (gnu packages bdb)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages python)
#:use-module (gnu packages algebra)
#:use-module (gnu packages gettext)
#:use-module (gnu packages pulseaudio)
@@ -38,7 +39,8 @@
#:use-module (gnu packages autotools)
#:use-module (guix packages)
#:use-module (guix download)
- #:use-module (guix build-system gnu))
+ #:use-module (guix build-system gnu)
+ #:use-module (guix build-system python))
(define-public (system->linux-architecture arch)
"Return the Linux architecture name for ARCH, a Guix system name such as
@@ -146,7 +148,7 @@
(license gpl2+)))
(define-public linux-libre
- (let* ((version "3.12")
+ (let* ((version "3.13")
(build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-))))
@@ -161,7 +163,24 @@
(format #t "enabling additional modules...~%")
(substitute* ".config"
(("^# CONFIG_CIFS.*$")
- "CONFIG_CIFS=m\n"))
+ "CONFIG_CIFS=m\n")
+ (("^# CONFIG_([[:graph:]]*)VIRTIO([[:graph:]]*) .*$"
+ _ before after)
+ (string-append "CONFIG_" before "VIRTIO"
+ after "=m\n")))
+
+ ;; XXX: For some reason, some virtio modules need to be
+ ;; explicitly added.
+ (let ((port (open-file ".config" "a")))
+ (display (string-append "CONFIG_NET_9P_VIRTIO=m\n"
+ "CONFIG_NET_9P=m\n"
+ "CONFIG_9P_FS=m\n"
+ "CONFIG_VIRTIO_NET=m\n"
+ "CONFIG_VIRTIO_BLK=m\n"
+ "CONFIG_VIRTIO_BALLOON=m\n")
+ port)
+ (close-port port))
+
(zero? (system* "make" "oldconfig")))
;; Call the default `build' phase so `-j' is correctly
@@ -192,7 +211,7 @@
(uri (linux-libre-urls version))
(sha256
(base32
- "0drjxm9h2k9bik2mhrqqqi6cm5rn2db647wf0zvb58xldj0zmhb6"))))
+ "15pdizzxnnvpxmdb1lbi01kpingmdvj17b01vzbyjymi4vwfws3f"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)
@@ -840,3 +859,64 @@ settings.")
"Aumix adjusts an audio mixer from X, the console, a terminal,
the command line or a script.")
(license gpl2+)))
+
+(define-public iotop
+ (package
+ (name "iotop")
+ (version "0.6")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://guichaz.free.fr/iotop/files/iotop-"
+ version ".tar.gz"))
+ (sha256 (base32
+ "1kp8mqg2pbxq4xzpianypadfxcsyfgwcaqgqia6h9fsq6zyh4z0s"))))
+ (build-system python-build-system)
+ (arguments
+ ;; The setup.py script expects python-2.
+ `(#:python ,python-2
+ ;; There are currently no checks in the package.
+ #:tests? #f))
+ (native-inputs `(("python" ,python-2)))
+ (home-page "http://guichaz.free.fr/iotop/")
+ (synopsis
+ "Displays the IO activity of running processes")
+ (description
+ "Iotop is a Python program with a top like user interface to show the
+processes currently causing I/O.")
+ (license gpl2+)))
+
+(define-public fuse
+ (package
+ (name "fuse")
+ (version "2.9.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/fuse/fuse-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("util-linux" ,util-linux)))
+ (arguments
+ '(#:configure-flags (list (string-append "MOUNT_FUSE_PATH="
+ (assoc-ref %outputs "out")
+ "/sbin")
+ (string-append "INIT_D_PATH="
+ (assoc-ref %outputs "out")
+ "/etc/init.d")
+ (string-append "UDEV_RULES_PATH="
+ (assoc-ref %outputs "out")
+ "/etc/udev"))))
+ (home-page "http://fuse.sourceforge.net/")
+ (synopsis "Support file systems implemented in user space")
+ (description
+ "As a consequence of its monolithic design, file system code for Linux
+normally goes into the kernel itself---which is not only a robustness issue,
+but also an impediment to system extensibility. FUSE, for \"file systems in
+user space\", is a kernel module and user-space library that tries to address
+part of this problem by allowing users to run file system implementations as
+user-space processes.")
+ (license (list lgpl2.1 ; library
+ gpl2+)))) ; command-line utilities
diff --git a/gnu/packages/lout.scm b/gnu/packages/lout.scm
index 76cb8a753b..1121f1674b 100644
--- a/gnu/packages/lout.scm
+++ b/gnu/packages/lout.scm
@@ -37,14 +37,14 @@
(("^LOUTLIBDIR[[:blank:]]*=.*$")
(string-append "LOUTLIBDIR = " out "/lib/lout\n"))
(("^LOUTDOCDIR[[:blank:]]*=.*$")
- (string-append "LOUTDOCDIR = " doc "/doc/lout\n"))
+ (string-append "LOUTDOCDIR = " doc "/share/doc/lout\n"))
(("^MANDIR[[:blank:]]*=.*$")
(string-append "MANDIR = " out "/man\n")))
(mkdir out)
(mkdir (string-append out "/bin"))
(mkdir (string-append out "/lib"))
(mkdir (string-append out "/man"))
- (mkdir-p (string-append doc "/doc/lout")))))
+ (mkdir-p (string-append doc "/share/doc/lout")))))
(install-man-phase
'(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "make" "installman"))))
@@ -60,7 +60,7 @@
(every (lambda (doc)
(format #t "doc: building `~a'...~%" doc)
(with-directory-excursion doc
- (let ((file (string-append out "/doc/lout/"
+ (let ((file (string-append out "/share/doc/lout/"
doc ".ps")))
(and (or (file-exists? "outfile.ps")
(zero? (system* "lout" "-r4" "-o"
@@ -72,7 +72,7 @@
"-dPDFSETTINGS=/prepress"
"-sPAPERSIZE=a4"
file
- (string-append out "/doc/lout/"
+ (string-append out "/share/doc/lout/"
doc ".pdf")))))))
'("design" "expert" "slides" "user")))))
(package
diff --git a/gnu/packages/lua.scm b/gnu/packages/lua.scm
index 14fc28ced0..81caa263ad 100644
--- a/gnu/packages/lua.scm
+++ b/gnu/packages/lua.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2014 Raimon Grau <raimonster@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -61,3 +62,27 @@ runs by interpreting bytecode for a register-based virtual machine, and has
automatic memory management with incremental garbage collection, making it ideal
for configuration, scripting, and rapid prototyping.")
(license x11)))
+
+(define-public luajit
+ (package
+ (name "luajit")
+ (version "2.0.2")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://luajit.org/download/LuaJIT-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "0f3cykihfdn3gi6na9p0xjd4jnv26z18m441n5vyg42q9abh4ln0"))))
+ (build-system gnu-build-system)
+ (arguments
+ '(#:tests? #f ;luajit is distributed without tests
+ #:phases (alist-delete 'configure %standard-phases)
+ #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
+ (home-page "http://www.luajit.org/")
+ (synopsis "Just in time compiler for Lua programming language version 5.1")
+ (description
+ "LuaJIT is a Just-In-Time Compiler (JIT) for the Lua
+programming language. Lua is a powerful, dynamic and light-weight programming
+language. It may be embedded or used as a general-purpose, stand-alone
+language.")
+ (license x11)))
diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm
index bdb3d52070..703762eed3 100644
--- a/gnu/packages/mail.scm
+++ b/gnu/packages/mail.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,11 +34,15 @@
#:use-module (gnu packages perl)
#:use-module (gnu packages readline)
#:use-module (gnu packages texinfo)
+ #:use-module (gnu packages compression)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu packages pkg-config)
#:use-module ((guix licenses)
- #:select (gpl2+ gpl3+ lgpl3+))
+ #:select (gpl2+ gpl3+ lgpl2.1+ lgpl3+))
#:use-module (guix packages)
#:use-module (guix download)
- #:use-module (guix build-system gnu))
+ #:use-module (guix build-system gnu)
+ #:use-module (srfi srfi-1))
(define-public mailutils
(package
@@ -162,3 +167,48 @@ aliasing facilities to work just as they would on normal mail.")
"Mutt is a small but very powerful text-based mail client for Unix
operating systems.")
(license gpl2+)))
+
+(define-public gmime
+ (package
+ (name "gmime")
+ (version "2.6.19")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnome/sources/gmime/"
+ (string-join (take (string-split version #\.)
+ 2)
+ ".")
+ "/gmime-" version ".tar.xz"))
+ (sha256
+ (base32
+ "0jm1fgbjgh496rsc0il2y46qd4bqq2ln9168p4zzh68mk4ml1yxg"))))
+ (build-system gnu-build-system)
+ (native-inputs
+ `(("pkg-config" ,pkg-config)
+ ("gnupg" ,gnupg))) ; for tests only
+ (inputs `(("glib" ,glib)
+ ("gpgme" ,gpgme)
+ ("zlib" ,zlib)))
+ (arguments
+ `(#:phases
+ (alist-cons-after
+ 'unpack 'patch-paths-in-tests
+ (lambda _
+ ;; The test programs run several programs using 'system'
+ ;; with hard-coded paths. Here we patch them all. We also
+ ;; change "gpg" to "gpg2".
+ (substitute* (find-files "tests" "\\.c$")
+ (("(system *\\(\")(/[^ ]*)" all pre prog-path)
+ (let* ((base (basename prog-path))
+ (prog (which (if (string=? base "gpg") "gpg2" base))))
+ (string-append pre (or prog (error "not found: " base)))))))
+ %standard-phases)))
+ (home-page "http://spruce.sourceforge.net/gmime/")
+ (synopsis "MIME message parser and creator library")
+ (description
+ "GMime provides a core library and set of utilities which may be used for
+the creation and parsing of messages using the Multipurpose Internet Mail
+Extension (MIME).")
+ (license (list lgpl2.1+ gpl2+ gpl3+))))
+
+;;; mail.scm ends here
diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm
index 640d502783..fe87e6d25a 100644
--- a/gnu/packages/maths.scm
+++ b/gnu/packages/maths.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,15 +27,25 @@
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (gnu packages compression)
+ #:use-module (gnu packages curl)
+ #:use-module (gnu packages fltk)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gcc)
+ #:use-module (gnu packages gd)
+ #:use-module (gnu packages ghostscript)
#:use-module (gnu packages gtk)
+ #:use-module (gnu packages less)
+ #:use-module (gnu packages xorg)
+ #:use-module (gnu packages gl)
#: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 python)
#:use-module (gnu packages readline)
+ #:use-module (gnu packages texinfo)
+ #:use-module (gnu packages texlive)
#:use-module (gnu packages xml))
(define-public units
@@ -163,7 +174,7 @@ output in text, PostScript, PDF or HTML.")
(define-public lapack
(package
(name "lapack")
- (version "3.4.2")
+ (version "3.5.0")
(source
(origin
(method url-fetch)
@@ -171,16 +182,7 @@ output in text, PostScript, PDF or HTML.")
version ".tgz"))
(sha256
(base32
- "1w7sf8888m7fi2kyx1fzgbm22193l8c2d53m8q1ibhvfy6m5v9k0"))
- (snippet
- ;; Remove non-free files.
- ;; See <http://icl.cs.utk.edu/lapack-forum/archives/lapack/msg01383.html>.
- '(for-each (lambda (file)
- (format #t "removing '~a'~%" file)
- (delete-file file))
- '("lapacke/example/example_DGESV_rowmajor.c"
- "lapacke/example/example_ZGESV_rowmajor.c"
- "DOCS/psfig.tex")))))
+ "0lk3f97i9imqascnlf6wr5mjpyxqcdj73pgj97dj2mgvyg9z1n4s"))))
(build-system cmake-build-system)
(home-page "http://www.netlib.org/lapack/")
(inputs `(("fortran" ,gfortran-4.8)
@@ -202,3 +204,120 @@ output in text, PostScript, PDF or HTML.")
problems in numerical linear algebra.")
(license (license:bsd-style "file://LICENSE"
"See LICENSE in the distribution."))))
+
+(define-public gnuplot
+ (package
+ (name "gnuplot")
+ (version "4.6.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/gnuplot/gnuplot/"
+ version "/gnuplot-" version ".tar.gz"))
+ (sha256
+ (base32
+ "1xd7gqdhlk7k1p9yyqf9vkk811nadc7m4si0q3nb6cpv4pxglpyz"))))
+ (build-system gnu-build-system)
+ (inputs `(("readline" ,readline)
+ ("cairo" ,cairo)
+ ("pango" ,pango)
+ ("gd" ,gd)))
+ (native-inputs `(("texlive" ,texlive)
+ ("pkg-config" ,pkg-config)))
+ (home-page "http://www.gnuplot.info")
+ (synopsis "Command-line driven graphing utility")
+ (description "Gnuplot is a portable command-line driven graphing
+utility. It was originally created to allow scientists and students to
+visualize mathematical functions and data interactively, but has grown to
+support many non-interactive uses such as web scripting. It is also used as a
+plotting engine by third-party applications like Octave.")
+ ;; X11 Style with the additional restriction that derived works may only be
+ ;; distributed as patches to the original.
+ (license (license:fsf-free
+ "http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright"))))
+
+(define-public hdf5
+ (package
+ (name "hdf5")
+ (version "1.8.12")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://www.hdfgroup.org/ftp/HDF5/current/src/hdf5-"
+ version ".tar.bz2"))
+ (sha256
+ (base32 "0f9n0v3p3lwc7564791a39c6cn1d3dbrn7d1j3ikqsi27a8hy23d"))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:phases
+ (alist-replace
+ 'configure
+ (lambda* (#:key target system outputs #:allow-other-keys #:rest args)
+ (let ((configure (assoc-ref %standard-phases 'configure)))
+ (substitute* "configure"
+ (("/bin/mv") "mv"))
+ (apply configure args)))
+ %standard-phases)))
+ (outputs '("out" "bin" "lib" "include"))
+ (home-page "http://www.hdfgroup.org")
+ (synopsis "Management suite for extremely large and complex data")
+ (description "HDF5 is a suite that makes possible the management of
+extremely large and complex data collections.")
+ (license (license:x11-style "http://www.hdfgroup.org/ftp/HDF5/current/src/unpacked/COPYING"))))
+
+
+;; For a fully featured Octave, users are strongly recommended also to install
+;; the following packages: texinfo, less, ghostscript, gnuplot.
+(define-public octave
+ (package
+ (name "octave")
+ (version "3.8.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/octave/octave-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0ks9pr154syw0vb3jn6xsnrkkrbvf9y7i7gaxa28rz6ngxbxvq9l"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("lapack" ,lapack)
+ ("readline" ,readline)
+ ("glpk" ,glpk)
+ ("curl" ,curl)
+ ("pcre" ,pcre)
+ ("fltk" ,fltk)
+ ("fontconfig" ,fontconfig)
+ ("freetype" ,freetype)
+ ("hdf5-lib" ,hdf5 "lib")
+ ("hdf5-include" ,hdf5 "include")
+ ("libxft" ,libxft)
+ ("mesa" ,mesa)
+ ("zlib" ,zlib)))
+ (native-inputs
+ `(("gfortran" ,gfortran-4.8)
+ ("pkg-config" ,pkg-config)
+ ("perl" ,perl)
+ ;; The following inputs are not actually used in the build process. However, the
+ ;; ./configure gratuitously tests for their existence and assumes that programs not
+ ;; present at build time are also not, and can never be, available at run time!
+ ;; If these inputs are therefore not present, support for them will be built out.
+ ;; However, Octave will still run without them, albeit without the features they
+ ;; provide.
+ ("less" ,less)
+ ("texinfo" ,texinfo)
+ ("ghostscript" ,ghostscript)
+ ("gnuplot" ,gnuplot)))
+ (arguments
+ `(#:configure-flags (list (string-append "--with-shell="
+ (assoc-ref %build-inputs "bash")
+ "/bin/sh"))))
+ (home-page "http://www.gnu.org/software/octave/")
+ (synopsis "High-level language for numerical computation")
+ (description "GNU Octave is a high-level interpreted language that is specialized
+for numerical computations. It can be used for both linear and non-linear
+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+)))
diff --git a/gnu/packages/moe.scm b/gnu/packages/moe.scm
new file mode 100644
index 0000000000..0dead5fe0c
--- /dev/null
+++ b/gnu/packages/moe.scm
@@ -0,0 +1,52 @@
+;;; 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 moe)
+ #:use-module (guix licenses)
+ #:use-module (gnu packages ncurses)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu))
+
+(define-public moe
+ (package
+ (name "moe")
+ (version "1.5")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/moe/moe-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0hqag8022x68jmii1v6n7jb4fhp9icjkapgcpd2j3p9nzc8xch7s"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("ncurses" ,ncurses)))
+ (home-page "https://www.gnu.org/software/moe/moe.html")
+ (synopsis "Modeless, multiple-buffer, user-friendly 8-bit text editor")
+ (description
+ "GNU Moe is a powerful-but-simple-to-use text editor. It works in a
+modeless manner, and features an intuitive set of key-bindings that
+assign a degree of severity to each key; for example, key
+combinations with the Alt key are for harmless commands like cursor
+movements while combinations with the Control key are for commands
+that will modify the text. Moe features multiple windows, unlimited
+undo/redo, unlimited line length, global search and replace, and
+more.")
+ (license gpl3+)))
diff --git a/gnu/packages/mp3.scm b/gnu/packages/mp3.scm
index 7e324703a6..c64efe4c03 100644
--- a/gnu/packages/mp3.scm
+++ b/gnu/packages/mp3.scm
@@ -298,7 +298,8 @@ format.")
version "/mpc123-" version ".tar.gz"))
(sha256
(base32
- "0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1"))))
+ "0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1"))
+ (patches (list (search-patch "mpc123-initialize-ao.patch")))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace
diff --git a/gnu/packages/openssl.scm b/gnu/packages/openssl.scm
index 438e76fd71..c0f8b6ff88 100644
--- a/gnu/packages/openssl.scm
+++ b/gnu/packages/openssl.scm
@@ -27,13 +27,13 @@
(define-public openssl
(package
(name "openssl")
- (version "1.0.1c")
+ (version "1.0.1f")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
".tar.gz"))
(sha256 (base32
- "1gjy6a7d8nszi9wq8jdzx3cffn0nss23h3cw2ywlw4cb9v6v77ia"))))
+ "0nnbr70dg67raqsqvlypzxa1v5xsv9gp91f9pavyckfn2w5sihkc"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(arguments
diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm
index 9ce24a3cbf..684ef1821e 100644
--- a/gnu/packages/parallel.scm
+++ b/gnu/packages/parallel.scm
@@ -27,7 +27,7 @@
(define-public parallel
(package
(name "parallel")
- (version "20131222")
+ (version "20140122")
(source
(origin
(method url-fetch)
@@ -35,7 +35,7 @@
version ".tar.bz2"))
(sha256
(base32
- "08ggxb4id263623mr14clafsdl1n1zhfx13z3mn6kqbd4d6vwwk7"))))
+ "17y72p7qwr7n0qy9nzxwhcn3q47829fd0d69gql2x6szlsxkk0xi"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.gnu.org/software/parallel/")
diff --git a/gnu/packages/patches/bigloo-gc-shebangs.patch b/gnu/packages/patches/bigloo-gc-shebangs.patch
index 9ead2ba979..367708610a 100644
--- a/gnu/packages/patches/bigloo-gc-shebangs.patch
+++ b/gnu/packages/patches/bigloo-gc-shebangs.patch
@@ -1,7 +1,7 @@
Patch shebangs in source that gets unpacked by `configure'.
---- bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:45:20.000000000 +0200
-+++ bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:46:36.000000000 +0200
+--- bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:03.000000000 +0100
++++ bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:36.000000000 +0100
@@ -29,10 +29,12 @@ fi
# untar the two versions of the GC
diff --git a/gnu/packages/patches/curl-fix-test172.patch b/gnu/packages/patches/curl-fix-test172.patch
new file mode 100644
index 0000000000..cc2c2705e7
--- /dev/null
+++ b/gnu/packages/patches/curl-fix-test172.patch
@@ -0,0 +1,12 @@
+diff --git a/tests/data/test172 b/tests/data/test172
+index b3efae9..3d53418 100644
+--- a/tests/data/test172
++++ b/tests/data/test172
+@@ -36,7 +36,7 @@ http://%HOSTIP:%HTTPPORT/we/want/172 -b log/jar172.txt -b "tool=curl; name=fool"
+
+ .%HOSTIP TRUE /silly/ FALSE 0 ismatch this
+ .%HOSTIP TRUE / FALSE 0 partmatch present
+-%HOSTIP FALSE /we/want/ FALSE 1391252187 nodomain value
++%HOSTIP FALSE /we/want/ FALSE 2139150993 nodomain value
+ </file>
+ </client>
diff --git a/gnu/packages/patches/dmd-tests-longer-sleeps.patch b/gnu/packages/patches/dmd-tests-longer-sleeps.patch
new file mode 100644
index 0000000000..708000f351
--- /dev/null
+++ b/gnu/packages/patches/dmd-tests-longer-sleeps.patch
@@ -0,0 +1,52 @@
+Increase sleep times in tests, for slower machines.
+
+Patch by Mark H Weaver <mhw@netris.org>.
+
+--- dmd/tests/basic.sh 2013-11-30 17:22:00.000000000 -0500
++++ dmd/tests/basic.sh 2014-02-16 02:18:34.036376953 -0500
+@@ -46,7 +46,7 @@
+ dmd -I -s "$socket" -c "$conf" -l "$log" &
+ dmd_pid=$!
+
+-sleep 1 # XXX: wait till it's up
++sleep 3 # XXX: wait till it's up
+ kill -0 $dmd_pid
+ test -S "$socket"
+ $deco status dmd | grep -E '(Start.*dmd|Stop.*test)'
+--- dmd/tests/respawn.sh 2013-12-01 16:50:37.000000000 -0500
++++ dmd/tests/respawn.sh 2014-02-16 02:19:16.958251953 -0500
+@@ -39,7 +39,7 @@
+ i=0
+ while ! test -f "$1" && test $i -lt 20
+ do
+- sleep 0.3
++ sleep 1
+ i=`expr $i + 1`
+ done
+ test -f "$1"
+@@ -65,14 +65,14 @@
+ #:provides '(test1)
+ #:start (make-forkexec-constructor
+ "$SHELL" "-c"
+- "echo \$\$ > $service1_pid ; while true ; do sleep 1 ; done")
++ "echo \$\$ > $service1_pid ; while true ; do sleep 3 ; done")
+ #:stop (make-kill-destructor)
+ #:respawn? #t)
+ (make <service>
+ #:provides '(test2)
+ #:start (make-forkexec-constructor
+ "$SHELL" "-c"
+- "echo \$\$ > $service2_pid ; while true ; do sleep 1 ; done")
++ "echo \$\$ > $service2_pid ; while true ; do sleep 3 ; done")
+ #:stop (make-kill-destructor)
+ #:respawn? #t))
+ (start 'test1)
+@@ -82,7 +82,7 @@
+ dmd -I -s "$socket" -c "$conf" -l "$log" &
+ dmd_pid=$!
+
+-sleep 1 # XXX: wait till it's up
++sleep 3 # XXX: wait till it's up
+ kill -0 $dmd_pid
+ test -S "$socket"
+ $deco status test1 | grep started
diff --git a/gnu/packages/patches/gdb-loongson-madd-fix.patch b/gnu/packages/patches/gdb-loongson-madd-fix.patch
deleted file mode 100644
index 0d50dd2dd4..0000000000
--- a/gnu/packages/patches/gdb-loongson-madd-fix.patch
+++ /dev/null
@@ -1,44 +0,0 @@
-Fix the Loongson 2F specific fused multiply-add instructions on paired singles to
-use the encoding recognized by the processor, as opposed to the mistaken english
-Loongson 2F documentation.
-
-Patch by Mark H Weaver <mhw@netris.org>.
-
---- gdb/opcodes/mips-opc.c.orig 2013-02-09 05:24:18.000000000 -0500
-+++ gdb/opcodes/mips-opc.c 2013-10-27 23:35:20.191997541 -0400
-@@ -956,7 +956,7 @@
- {"madd.s", "D,S,T", 0x4600001c, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE },
- {"madd.ps", "D,R,S,T", 0x4c000026, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
- {"madd.ps", "D,S,T", 0x45600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
--{"madd.ps", "D,S,T", 0x71600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
-+{"madd.ps", "D,S,T", 0x72c00018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
- {"madd", "s,t", 0x0000001c, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 },
- {"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 },
- {"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|WR_HILO|IS_M, 0, G1 },
-@@ -1084,7 +1084,7 @@
- {"msub.s", "D,S,T", 0x4600001d, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE },
- {"msub.ps", "D,R,S,T", 0x4c00002e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
- {"msub.ps", "D,S,T", 0x45600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
--{"msub.ps", "D,S,T", 0x71600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
-+{"msub.ps", "D,S,T", 0x72c00019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
- {"msub", "s,t", 0x0000001e, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 },
- {"msub", "s,t", 0x70000004, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 },
- {"msub", "7,s,t", 0x70000004, 0xfc00e7ff, MOD_a|RD_s|RD_t, 0, D32 },
-@@ -1218,7 +1218,7 @@
- {"nmadd.s", "D,S,T", 0x7200001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F },
- {"nmadd.ps","D,R,S,T", 0x4c000036, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
- {"nmadd.ps", "D,S,T", 0x4560001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
--{"nmadd.ps", "D,S,T", 0x7160001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
-+{"nmadd.ps", "D,S,T", 0x72c0001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
- {"nmsub.d", "D,R,S,T", 0x4c000039, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I4_33 },
- {"nmsub.d", "D,S,T", 0x4620001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
- {"nmsub.d", "D,S,T", 0x7220001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
-@@ -1227,7 +1227,7 @@
- {"nmsub.s", "D,S,T", 0x7200001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F },
- {"nmsub.ps","D,R,S,T", 0x4c00003e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
- {"nmsub.ps", "D,S,T", 0x4560001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
--{"nmsub.ps", "D,S,T", 0x7160001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
-+{"nmsub.ps", "D,S,T", 0x72c0001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
- /* nop is at the start of the table. */
- {"nor", "d,v,t", 0x00000027, 0xfc0007ff, WR_d|RD_s|RD_t, 0, I1 },
- {"nor", "t,r,I", 0, (int) M_NOR_I, INSN_MACRO, 0, I1 },
diff --git a/gnu/packages/patches/gnunet-fix-scheduler.patch b/gnu/packages/patches/gnunet-fix-scheduler.patch
new file mode 100644
index 0000000000..1e0aef2a1a
--- /dev/null
+++ b/gnu/packages/patches/gnunet-fix-scheduler.patch
@@ -0,0 +1,13 @@
+Index: src/util/scheduler.c
+===================================================================
+--- src/util/scheduler.c (revision 31745)
++++ src/util/scheduler.c (working copy)
+@@ -1599,7 +1599,7 @@
+ int real_fd;
+
+ GNUNET_DISK_internal_file_handle_ (fd, &real_fd, sizeof (int));
+- GNUNET_assert (real_fd > 0);
++ GNUNET_assert (real_fd >= 0);
+ return add_without_sets (
+ delay, priority,
+ on_read ? real_fd : -1,
diff --git a/gnu/packages/patches/gnunet-fix-tests.patch b/gnu/packages/patches/gnunet-fix-tests.patch
new file mode 100644
index 0000000000..4276db5a7c
--- /dev/null
+++ b/gnu/packages/patches/gnunet-fix-tests.patch
@@ -0,0 +1,58 @@
+diff -ru a/src/peerinfo-tool/Makefile.in b/src/peerinfo-tool/Makefile.in
+--- src/peerinfo-tool/Makefile.in 2013-12-24 13:55:04.000000000 +0100
++++ src/peerinfo-tool/Makefile.in 2014-01-30 13:07:52.275965484 +0100
+@@ -335,9 +335,6 @@
+ $(top_builddir)/src/statistics/libgnunetstatistics.la \
+ $(top_builddir)/src/util/libgnunetutil.la
+
+-@HAVE_PYTHON_TRUE@check_SCRIPTS = \
+-@HAVE_PYTHON_TRUE@ test_gnunet_peerinfo.py
+-
+ @ENABLE_TEST_RUN_TRUE@TESTS = $(check_SCRIPTS)
+ do_subst = $(SED) -e 's,[@]PYTHON[@],$(PYTHON),g'
+ EXTRA_DIST = \
+diff -ru a/src/revocation/test_revocation.conf b/src/revocation/test_revocation.conf
+--- src/revocation/test_revocation.conf 2013-12-21 18:57:06.000000000 +0100
++++ src/revocation/test_revocation.conf 2014-01-30 15:00:02.841340556 +0100
+@@ -20,6 +20,9 @@
+ [transport-udp]
+ BROADCAST = NO
+
++[nat]
++RETURN_LOCAL_ADDRESSES = YES
++
+ [peerinfo]
+ USE_INCLUDED_HELLOS = NO
+
+Index: src/gns/test_gns_cname_lookup.sh
+===================================================================
+--- src/gns/test_gns_cname_lookup.sh (revision 32117)
++++ src/gns/test_gns_cname_lookup.sh (revision 32118)
+@@ -13,6 +13,15 @@
+ exit 77
+ fi
+
++# permissive DNS resolver we will use for the test
++DNS_RESOLVER="8.8.8.8"
++if ! nslookup gnunet.org $DNS_RESOLVER &> /dev/null
++then
++ echo "Cannot reach DNS, skipping test"
++ exit 77
++fi
++
++
+ rm -rf /tmp/test-gnunet-gns-peer-1/
+
+ TEST_DOMAIN_PLUS="www.gnu"
+Index: src/integration-tests/confs/test_defaults.conf
+===================================================================
+--- src/integration-tests/confs/test_defaults.conf (revision 32320)
++++ src/integration-tests/confs/test_defaults.conf (working copy)
+@@ -17,6 +17,7 @@
+ EXTERNAL_ADDRESS = 127.0.0.1
+ INTERNAL_ADDRESS = 127.0.0.1
+ BINDTO = 127.0.0.1
++RETURN_LOCAL_ADDRESSES = YES
+
+ [hostlist]
+ SERVERS =
diff --git a/gnu/packages/patches/inkscape-stray-comma.patch b/gnu/packages/patches/inkscape-stray-comma.patch
new file mode 100644
index 0000000000..0b000d9e30
--- /dev/null
+++ b/gnu/packages/patches/inkscape-stray-comma.patch
@@ -0,0 +1,13 @@
+This is verbatim from Upstream: http://bazaar.launchpad.net/~inkscape.dev/inkscape/RELEASE_0_48_BRANCH/diff/9943
+--- a/src/widgets/desktop-widget.h 2011-06-06 06:43:00 +0000
++++ b/src/widgets/desktop-widget.h 2013-01-05 14:34:09 +0000
+@@ -239,7 +239,7 @@
+ private:
+ GtkWidget *tool_toolbox;
+ GtkWidget *aux_toolbox;
+- GtkWidget *commands_toolbox,;
++ GtkWidget *commands_toolbox;
+ GtkWidget *snap_toolbox;
+
+ static void init(SPDesktopWidget *widget);
+
diff --git a/gnu/packages/patches/mpc123-initialize-ao.patch b/gnu/packages/patches/mpc123-initialize-ao.patch
new file mode 100644
index 0000000000..85e461f896
--- /dev/null
+++ b/gnu/packages/patches/mpc123-initialize-ao.patch
@@ -0,0 +1,19 @@
+Description: Zero ao_sample_format structure to cope with libao 1.0.0
+Author: Colin Watson <cjwatson@debian.org>
+Bug-Debian: http://bugs.debian.org/591396
+Bug-Ubuntu: https://bugs.launchpad.net/bugs/710268
+Forwarded: no
+Last-Update: 2013-05-07
+
+Index: b/ao.c
+===================================================================
+--- a/ao.c
++++ b/ao.c
+@@ -123,6 +123,7 @@
+
+ /* initialize ao_format struct */
+ /* XXX VERY WRONG */
++ memset(&ao_fmt, 0, sizeof(ao_fmt));
+ ao_fmt.bits=16; /*tmp_stream_info.average_bitrate;*/
+ ao_fmt.rate=streaminfo->sample_freq;
+ ao_fmt.channels=streaminfo->channels;
diff --git a/gnu/packages/patches/patchelf-page-size.patch b/gnu/packages/patches/patchelf-page-size.patch
new file mode 100644
index 0000000000..2528b604e5
--- /dev/null
+++ b/gnu/packages/patches/patchelf-page-size.patch
@@ -0,0 +1,69 @@
+Improve the determination of pageSize in patchelf.cc.
+
+Patch by Mark H Weaver <mhw@netris.org>.
+
+--- patchelf/src/patchelf.cc.orig 1969-12-31 19:00:01.000000000 -0500
++++ patchelf/src/patchelf.cc 2014-02-16 20:15:06.283203125 -0500
+@@ -21,11 +21,19 @@
+ using namespace std;
+
+
+-#ifdef MIPSEL
+-/* The lemote fuloong 2f kernel defconfig sets a page size of 16KB */
+-const unsigned int pageSize = 4096*4;
+-#else
++/* Note that some platforms support multiple page sizes. Therefore,
++ it is not enough to query the current page size. 'pageSize' must
++ be the maximum architectural page size for the platform, which is
++ typically defined in the corresponding ABI document.
++
++ XXX FIXME: This won't work when we're cross-compiling. */
++
++#if defined __MIPSEL__ || defined __MIPSEB__ || defined __aarch64__
++const unsigned int pageSize = 65536;
++#elif defined __x86_64__ || defined __i386__ || defined __arm__
+ const unsigned int pageSize = 4096;
++#else
++# error maximum architectural page size unknown for this platform
+ #endif
+
+
+--- patchelf/tests/no-rpath.sh.orig 1969-12-31 19:00:01.000000000 -0500
++++ patchelf/tests/no-rpath.sh 2014-02-16 20:44:12.036376953 -0500
+@@ -1,22 +1,22 @@
+ #! /bin/sh -e
+
+-rm -rf scratch
+-mkdir -p scratch
++if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then
++ rm -rf scratch
++ mkdir -p scratch
+
+-cp no-rpath scratch/
++ cp no-rpath scratch/
+
+-oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
+-if test -n "$oldRPath"; then exit 1; fi
+-../src/patchelf \
+- --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \
+- --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath
++ oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
++ if test -n "$oldRPath"; then exit 1; fi
++ ../src/patchelf \
++ --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \
++ --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath
+
+-newRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
+-if ! echo "$newRPath" | grep -q '/foo:/bar'; then
+- echo "incomplete RPATH"
+- exit 1
+-fi
++ newRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
++ if ! echo "$newRPath" | grep -q '/foo:/bar'; then
++ echo "incomplete RPATH"
++ exit 1
++ fi
+
+-if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then
+ cd scratch && ./no-rpath
+ fi
diff --git a/gnu/packages/patches/ratpoison-shell.patch b/gnu/packages/patches/ratpoison-shell.patch
new file mode 100644
index 0000000000..63d265a382
--- /dev/null
+++ b/gnu/packages/patches/ratpoison-shell.patch
@@ -0,0 +1,91 @@
+Use $SHELL instead of hardcoding /bin/sh in ratpoison.
+
+Patch by Mark H Weaver <mhw@netris.org>.
+
+--- ratpoison/src/actions.c.orig 2013-04-06 21:37:43.000000000 -0400
++++ ratpoison/src/actions.c 2014-02-13 00:34:10.992553710 -0500
+@@ -19,6 +19,7 @@
+ */
+
+ #include <unistd.h>
++#include <stdlib.h>
+ #include <ctype.h> /* for isspace */
+ #include <sys/wait.h>
+ #include <X11/keysym.h>
+@@ -223,12 +223,12 @@
+ add_command ("escape", cmd_escape, 1, 1, 1,
+ "Key: ", arg_KEY);
+ add_command ("exec", cmd_exec, 1, 1, 1,
+- "/bin/sh -c ", arg_SHELLCMD);
++ "$SHELL -c ", arg_SHELLCMD);
+ add_command ("execa", cmd_execa, 1, 1, 1,
+- "/bin/sh -c ", arg_SHELLCMD);
++ "$SHELL -c ", arg_SHELLCMD);
+ add_command ("execf", cmd_execf, 2, 2, 2,
+ "frame to execute in:", arg_FRAME,
+- "/bin/sh -c ", arg_SHELLCMD);
++ "$SHELL -c ", arg_SHELLCMD);
+ add_command ("fdump", cmd_fdump, 1, 0, 0,
+ "", arg_NUMBER);
+ add_command ("focus", cmd_next_frame, 0, 0, 0);
+@@ -359,7 +359,7 @@
+ add_command ("unsetenv", cmd_unsetenv, 1, 1, 1,
+ "Variable: ", arg_STRING);
+ add_command ("verbexec", cmd_verbexec, 1, 1, 1,
+- "/bin/sh -c ", arg_SHELLCMD);
++ "$SHELL -c ", arg_SHELLCMD);
+ add_command ("version", cmd_version, 0, 0, 0);
+ add_command ("vsplit", cmd_v_split, 1, 0, 0,
+ "Split: ", arg_STRING);
+@@ -2627,6 +2627,9 @@
+ pid = fork();
+ if (pid == 0)
+ {
++ char *shell_path;
++ char *shell_name;
++
+ /* Some process setup to make sure the spawned process runs
+ in its own session. */
+ putenv(current_screen()->display_string);
+@@ -2641,7 +2644,18 @@
+ /* raw means don't run it through sh. */
+ if (raw)
+ execl (cmd, cmd, NULL);
+- execl("/bin/sh", "sh", "-c", cmd, NULL);
++
++ shell_path = getenv ("SHELL");
++ if (shell_path == NULL)
++ shell_path = "/bin/sh";
++
++ shell_name = strrchr (shell_path, '/');
++ if (shell_name == NULL)
++ shell_name = shell_path;
++ else
++ shell_name++;
++
++ execl(shell_path, shell_name, "-c", cmd, NULL);
+ _exit(EXIT_FAILURE);
+ }
+
+--- ratpoison/src/events.c.orig 2013-04-06 20:05:48.000000000 -0400
++++ ratpoison/src/events.c 2014-02-13 00:34:39.327758789 -0500
+@@ -920,7 +920,7 @@
+ {
+ /* Report any child that didn't return 0. */
+ if (cur->status != 0)
+- marked_message_printf (0,0, "/bin/sh -c \"%s\" finished (%d)",
++ marked_message_printf (0,0, "$SHELL -c \"%s\" finished (%d)",
+ cur->cmd, cur->status);
+ list_del (&cur->node);
+ free (cur->cmd);
+--- ratpoison/src/messages.h.orig 2012-07-20 20:25:33.000000000 -0400
++++ ratpoison/src/messages.h 2014-02-13 00:34:28.608398437 -0500
+@@ -41,7 +41,7 @@
+
+ #define MESSAGE_PROMPT_SWITCH_TO_WINDOW "Switch to window: "
+ #define MESSAGE_PROMPT_NEW_WINDOW_NAME "Set window's title to: "
+-#define MESSAGE_PROMPT_SHELL_COMMAND "/bin/sh -c "
++#define MESSAGE_PROMPT_SHELL_COMMAND "$SHELL -c "
+ #define MESSAGE_PROMPT_COMMAND ":"
+ #define MESSAGE_PROMPT_SWITCH_WM "Switch to wm: "
+ #define MESSAGE_PROMPT_XTERM_COMMAND MESSAGE_PROMPT_SHELL_COMMAND TERM_PROG " -e "
diff --git a/gnu/packages/patches/slim-config.patch b/gnu/packages/patches/slim-config.patch
new file mode 100644
index 0000000000..5e6135d75c
--- /dev/null
+++ b/gnu/packages/patches/slim-config.patch
@@ -0,0 +1,27 @@
+Allow the configuration file and theme directory to be specified at run time.
+Patch by Eelco Dolstra, from Nixpkgs.
+
+--- slim-1.3.6/app.cpp 2013-10-02 00:38:05.000000000 +0200
++++ slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200
+@@ -200,7 +200,9 @@
+
+ /* Read configuration and theme */
+ cfg = new Cfg;
+- cfg->readConf(CFGFILE);
++ char *cfgfile = getenv("SLIM_CFGFILE");
++ if (!cfgfile) cfgfile = CFGFILE;
++ cfg->readConf(cfgfile);
+ string themebase = "";
+ string themefile = "";
+ string themedir = "";
+@@ -208,7 +210,9 @@
+ if (testing) {
+ themeName = testtheme;
+ } else {
+- themebase = string(THEMESDIR) + "/";
++ char *themesdir = getenv("SLIM_THEMESDIR");
++ if (!themesdir) themesdir = THEMESDIR;
++ themebase = string(themesdir) + "/";
+ themeName = cfg->getOption("current_theme");
+ string::size_type pos;
+ if ((pos = themeName.find(",")) != string::npos) {
diff --git a/gnu/packages/patches/slim-session.patch b/gnu/packages/patches/slim-session.patch
new file mode 100644
index 0000000000..b85d3f7dd0
--- /dev/null
+++ b/gnu/packages/patches/slim-session.patch
@@ -0,0 +1,17 @@
+Exit after the user's session has finished. This works around slim's broken
+PAM session handling (see
+http://developer.berlios.de/bugs/?func=detailbug&bug_id=19102&group_id=2663).
+
+Patch by Eelco Dolstra, from Nixpkgs.
+
+--- slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200
++++ slim-1.3.6/app.cpp 2013-10-15 13:00:10.141210784 +0200
+@@ -816,7 +822,7 @@
+ StopServer();
+ RemoveLock();
+ while (waitpid(-1, NULL, WNOHANG) > 0); /* Collects all dead childrens */
+- Run();
++ exit(OK_EXIT);
+ }
+
+ void App::KillAllClients(Bool top) {
diff --git a/gnu/packages/patches/slim-sigusr1.patch b/gnu/packages/patches/slim-sigusr1.patch
new file mode 100644
index 0000000000..344b02933e
--- /dev/null
+++ b/gnu/packages/patches/slim-sigusr1.patch
@@ -0,0 +1,33 @@
+This patch fixes SLiM so it really waits for the X server to be ready
+before attempting to connect to it. Indeed, the X server notices that
+its parent process has a handler for SIGUSR1, and consequently sends it
+SIGUSR1 when it's ready to accept connections.
+
+The problem was that SLiM doesn't pay attention to SIGUSR1. So in practice,
+if X starts slowly, then SLiM gets ECONNREFUSED a couple of time on
+/tmp/.X11-unix/X0, then goes on trying to connect to localhost:6000,
+where nobody answers; eventually, it times out and tries again on
+/tmp/.X11-unix/X0, and finally it shows up on the screen.
+
+Patch by L. Courtès.
+
+--- slim-1.3.6/app.cpp 2014-02-05 15:27:20.000000000 +0100
++++ slim-1.3.6/app.cpp 2014-02-09 22:42:04.000000000 +0100
+@@ -119,7 +119,9 @@ void CatchSignal(int sig) {
+ exit(ERR_EXIT);
+ }
+
++static volatile int got_sigusr1 = 0;
+ void User1Signal(int sig) {
++ got_sigusr1 = 1;
+ signal(sig, User1Signal);
+ }
+
+@@ -884,6 +886,7 @@ int App::WaitForServer() {
+ int ncycles = 120;
+ int cycles;
+
++ while (!got_sigusr1);
+ for(cycles = 0; cycles < ncycles; cycles++) {
+ if((Dpy = XOpenDisplay(DisplayName))) {
+ XSetIOErrorHandler(xioerror);
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index b5070e7fda..44e3c14aa2 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; 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.
@@ -323,24 +323,28 @@ datetime module, available in Python 2.3+.")
(define-public python2-pysqlite
(package
(name "python2-pysqlite")
- (version "2.6.3")
+ (version "2.6.3a") ; see below
(source
(origin
(method url-fetch)
- (uri (string-append "http://pysqlite.googlecode.com/files/pysqlite-"
- version ".tar.gz"))
+ ;; During the switch from code.google.com to pypi.python.org, the 2.6.3
+ ;; tarball was modified, but the version number was kept:
+ ;; <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00077.html>.
+ ;; Here we want to refer to the pypi-hosted 2.6.3 tarball.
+ (uri (string-append
+ "https://pypi.python.org/packages/source/p/pysqlite/pysqlite-"
+ "2.6.3" ".tar.gz"))
(sha256
(base32
- "0nsqqfp072rgqbls100rdvbzkjkin7li3kprhfxlfqvzf608hlqd"))))
+ "13djzgnbi71znjjyaw4nybg6smilgszcid646j5qav7mdchkb77y"))))
(build-system python-build-system)
(inputs
`(("sqlite" ,sqlite)))
(arguments
`(#:python ,python-2 ; incompatible with Python 3
#:tests? #f)) ; no test target
- (home-page "http://labix.org/python-dateutil")
- (synopsis
- "SQLite bindings for Python.")
+ (home-page "https://pypi.python.org/pypi/pysqlite")
+ (synopsis "SQLite bindings for Python")
(description
"Pysqlite provides SQLite bindings for Python that comply to the
Database API 2.0T.")
diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm
index 4212d74821..e0b9e4aeb1 100644
--- a/gnu/packages/qemu.scm
+++ b/gnu/packages/qemu.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.
;;;
@@ -73,6 +73,7 @@
(zero?
(system* "./configure"
(string-append "--cc=" (which "gcc"))
+ "--disable-debug-info" ; save build space
(string-append "--prefix=" out)
(string-append "--smbd=" samba
"/sbin/smbd")))))
@@ -132,6 +133,9 @@ server and embedded PowerPC, and S390 guests.")
(define-public qemu/smb-shares
;; A patched QEMU where `-net smb' yields two shares instead of one: one for
;; the store, and another one for exchanges with the host.
+
+ ;; TODO: Use 9p/-virtfs instead of this SMB hack:
+ ;; <http://wiki.qemu.org/Documentation/9psetup>.
(package (inherit qemu-headless)
(name "qemu-with-multiple-smb-shares")
(source (origin (inherit (package-source qemu-headless))
diff --git a/gnu/packages/ratpoison.scm b/gnu/packages/ratpoison.scm
index fb1bfd8516..aabd1d330c 100644
--- a/gnu/packages/ratpoison.scm
+++ b/gnu/packages/ratpoison.scm
@@ -21,6 +21,7 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:select (gpl2+))
+ #:use-module (gnu packages)
#:use-module (gnu packages xorg)
#:use-module (gnu packages perl)
#:use-module (gnu packages readline)
@@ -37,7 +38,8 @@
version ".tar.xz"))
(sha256
(base32
- "0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr"))))
+ "0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr"))
+ (patches (list (search-patch "ratpoison-shell.patch")))))
(build-system gnu-build-system)
(inputs
`(("libXi" ,libxi)
diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm
index 4dcd46305d..3d9e3b54dc 100644
--- a/gnu/packages/scheme.scm
+++ b/gnu/packages/scheme.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.
;;;
@@ -116,14 +116,14 @@ features an integrated Emacs-like editor and a large runtime library.")
(define-public bigloo
(package
(name "bigloo")
- (version "4.0b")
+ (version "4.1a")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo"
version ".tar.gz"))
(sha256
(base32
- "1fck2h48f0bvh8fl437cagmp0syfxy9lqacy1zwsis20fc76jvzi"))
+ "170q7nh08n4v20xl81fxb0xcdxphqqacfa643hsa8i2ar6pki04c"))
(patches (list (search-patch "bigloo-gc-shebangs.patch")))))
(build-system gnu-build-system)
(arguments
@@ -163,6 +163,9 @@ features an integrated Emacs-like editor and a large runtime library.")
(zero?
(system* "./configure"
(string-append "--prefix=" out)
+ ;; FIXME: Currently fails, see
+ ;; <http://article.gmane.org/gmane.lisp.scheme.bigloo/6126>.
+ ;; "--customgc=no" ; use our libgc
(string-append"--mv=" (which "mv"))
(string-append "--rm=" (which "rm"))))))
(alist-cons-after
diff --git a/gnu/packages/sdl.scm b/gnu/packages/sdl.scm
index 25ae1b0721..d86ecde38e 100644
--- a/gnu/packages/sdl.scm
+++ b/gnu/packages/sdl.scm
@@ -55,14 +55,21 @@
(base32
"005d993xcac8236fpvd1iawkz4wqjybkpn8dbwaliqz5jfkidlyn"))))
(build-system gnu-build-system)
- (arguments '(#:tests? #f)) ; no check target
+ (arguments
+ '(;; Explicitly link against Xext because SDL tries to dlopen it and
+ ;; doesn't go very far otherwise (see
+ ;; <https://lists.gnu.org/archive/html/guix-devel/2013-11/msg00088.html>
+ ;; for details.)
+ #:configure-flags '("LDFLAGS=-lXext")
+
+ #:tests? #f)) ; no check target
(propagated-inputs
;; SDL headers include X11 headers.
`(("libx11" ,libx11)))
+ (native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("libxrandr" ,libxrandr)
("mesa" ,mesa)
("alsa-lib" ,alsa-lib)
- ("pkg-config" ,pkg-config)
("pulseaudio" ,pulseaudio)))
(synopsis "Cross platform game development library")
(description "Simple DirectMedia Layer is a cross-platform development
diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm
new file mode 100644
index 0000000000..282893d2e6
--- /dev/null
+++ b/gnu/packages/search.scm
@@ -0,0 +1,58 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages search)
+ #:use-module ((guix licenses)
+ #:select (gpl2+ bsd-3 x11))
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages compression)
+ #:use-module (gnu packages linux)
+ #:export (xapian))
+
+(define-public xapian
+ (package
+ (name "xapian")
+ (version "1.2.17")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://oligarchy.co.uk/xapian/" version
+ "/xapian-core-" version ".tar.xz"))
+ (sha256
+ (base32 "1pn65h06c23imck2pb42zhrrngch3clk39wl2bjwyqhfyfq4b7g7"))))
+ (build-system gnu-build-system)
+ (inputs `(("zlib" ,zlib)
+ ("util-linux" ,util-linux)))
+ (arguments
+ `(#:phases (alist-cons-after
+ 'unpack 'patch-remotetcp-harness
+ (lambda _
+ (substitute* "tests/harness/backendmanager_remotetcp.cc"
+ (("/bin/sh") (which "bash"))))
+ %standard-phases)))
+ (synopsis "Search Engine Library")
+ (description
+ "Xapian is a highly adaptable toolkit which allows developers to easily
+add advanced indexing and search facilities to their own applications. It
+supports the Probabilistic Information Retrieval model and also supports a
+rich set of boolean query operators.")
+ (home-page "http://xapian.org/")
+ (license (list gpl2+ bsd-3 x11))))
+
+;;; search.scm ends here
diff --git a/gnu/packages/shishi.scm b/gnu/packages/shishi.scm
index 0523a4eef5..47e7802213 100644
--- a/gnu/packages/shishi.scm
+++ b/gnu/packages/shishi.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,9 @@
#:use-module (gnu packages)
#:use-module (gnu packages gnutls)
#:use-module (gnu packages gnupg)
+ #:use-module (gnu packages libidn)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages pkg-config)
#:use-module (gnu packages compression)
#:use-module (guix packages)
#:use-module (guix download)
@@ -40,8 +44,11 @@
(base32
"032qf72cpjdfffq1yq54gz3ahgqf2ijca4vl31sfabmjzq9q370d"))))
(build-system gnu-build-system)
+ (native-inputs `(("pkg-config" ,pkg-config)))
(inputs
`(("gnutls" ,gnutls)
+ ("libidn" ,libidn)
+ ("linux-pam" ,linux-pam)
("zlib" ,zlib)
;; libgcrypt 1.6 fails because of the following test:
;; #include <gcrypt.h>
diff --git a/gnu/packages/slim.scm b/gnu/packages/slim.scm
index fd2c73c772..f25b070f3c 100644
--- a/gnu/packages/slim.scm
+++ b/gnu/packages/slim.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Guy Grant <gzg@riseup.net>
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix packages)
+ #:use-module (gnu packages)
#:use-module (gnu packages gl)
#:use-module (gnu packages xorg)
#:use-module (gnu packages libpng)
@@ -34,13 +36,18 @@
(define-public slim
(package
(name "slim")
- (version "1.3.3")
+ (version "1.3.6")
(source (origin
(method url-fetch)
- (uri (string-append "mirror://sourceforge/project/slim.berlios/slim-"
+ ;; Used to be available from
+ ;; mirror://sourceforge/project/slim.berlios/.
+ (uri (string-append "http://download.berlios.de/slim/slim-"
version ".tar.gz"))
(sha256
- (base32 "1fdvipj3658s8dm78djmfr8xhg6l8rr7kc4qcb34bjrnkkclhln1"))))
+ (base32 "1pqhk22jb4aja4hkrm7rjgbgzjyh7i4zswdgf5nw862l2znzxpi1"))
+ (patches (map search-patch
+ (list "slim-config.patch" "slim-session.patch"
+ "slim-sigusr1.patch")))))
(build-system cmake-build-system)
(inputs `(("linux-pam" ,linux-pam)
("libpng" ,libpng)
@@ -62,12 +69,23 @@
(lambda _
(substitute* "CMakeLists.txt"
(("/etc")
- (string-append
- (assoc-ref %outputs "out") "/etc"))))
+ (string-append (assoc-ref %outputs "out") "/etc"))
+ (("install.*systemd.*")
+ ;; The build system's logic here is: if "Linux", then
+ ;; "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://www.slim.berlios.de/")
+ (home-page "http://slim.berlios.de/")
(synopsis "Desktop-independent graphcal login manager for X11")
(description
"SLiM is a Desktop-independent graphical login manager for X11, derived
diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm
index 7589408e47..41ceeb6cef 100644
--- a/gnu/packages/ssh.scm
+++ b/gnu/packages/ssh.scm
@@ -120,14 +120,14 @@ a server that supports the SSH-2 protocol.")
(define-public openssh
(package
(name "openssh")
- (version "6.1p1")
+ (version "6.5p1")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh-"
version ".tar.gz"))
(sha256 (base32
- "04f4l4vx6f964v5qjm03nhyixdc3llc90z6cj70r0bl5q3v5ghfi"))))
+ "09wh7mi65aahyxd2xvq1makckhd5laid8c0pb8njaidrbpamw6d1"))))
(build-system gnu-build-system)
(inputs `(("groff" ,groff)
("openssl" ,openssl)
@@ -150,7 +150,7 @@ a server that supports the SSH-2 protocol.")
(let ((check (assoc-ref %standard-phases 'check)))
;; remove tests that require the user sshd
(substitute* "regress/Makefile"
- (("t9 t-exec") "t9"))
+ (("t10 t-exec") "t10"))
(apply check args)))
(alist-replace
'install
diff --git a/gnu/packages/stalonetray.scm b/gnu/packages/stalonetray.scm
new file mode 100644
index 0000000000..5a53cd832e
--- /dev/null
+++ b/gnu/packages/stalonetray.scm
@@ -0,0 +1,48 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Raimon Grau <raimonster@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages stalonetray)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module ((guix licenses) #:select (gpl2+))
+ #:use-module (gnu packages xorg))
+
+(define-public stalonetray
+ (package
+ (name "stalonetray")
+ (version "0.8.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "mirror://sourceforge/stalonetray/stalonetray-"
+ version "/stalonetray-" version ".tar.bz2"))
+ (sha256
+ (base32
+ "1wp8pnlv34w7xizj1vivnc3fkwqq4qgb9dbrsg15598iw85gi8ll"))))
+ (inputs `(("libx11" ,libx11)))
+ (build-system gnu-build-system)
+ (home-page "stalonetray")
+ (synopsis "Standalone freedesktop.org and KDE systray implementation")
+ (description
+ "Stalonetray is a stand-alone freedesktop.org and KDE system
+tray (notification area) for X Window System/X11 (e.g. X.Org or XFree86). It
+has full XEMBED support and minimal dependencies: an X11 lib only. Stalonetray
+works with virtually any EWMH-compliant window manager.")
+ (license gpl2+)))
diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm
index 7c753a7cf6..0f21ec3211 100644
--- a/gnu/packages/texinfo.scm
+++ b/gnu/packages/texinfo.scm
@@ -50,3 +50,17 @@ package includes both the tools necessary to produce Info documents from
their source and the command-line Info reader. The emphasis of the language
is on expressing the content semantically, avoiding physical markup commands.")
(license gpl3+)))
+
+(define-public texinfo-4
+ (package (inherit texinfo)
+ (version "4.13a")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "mirror://gnu/texinfo/texinfo-"
+ version
+ ".tar.lzma"))
+ (sha256
+ (base32
+ "1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d"))))
+ (inputs `(("ncurses" ,ncurses) ("xz" ,xz)))))
diff --git a/gnu/packages/tor.scm b/gnu/packages/tor.scm
index adcd11f40e..772b2a3c17 100644
--- a/gnu/packages/tor.scm
+++ b/gnu/packages/tor.scm
@@ -31,14 +31,14 @@
(define-public tor
(package
(name "tor")
- (version "0.2.4.19")
+ (version "0.2.4.20")
(source (origin
(method url-fetch)
(uri (string-append "https://www.torproject.org/dist/tor-"
version ".tar.gz"))
(sha256
(base32
- "08g1g6wkvg1a5hpjbjzr31sabqp65h9hrkjar4lif5pmqdw898jk"))))
+ "17sd54pfz1w2x5bd0j83vac8d1lazy9wdm9liijqzyfbrd3igifc"))))
(build-system gnu-build-system)
(inputs
`(("zlib" ,zlib)
diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm
index 6c17170eef..abcbfba88a 100644
--- a/gnu/packages/xorg.scm
+++ b/gnu/packages/xorg.scm
@@ -38,7 +38,8 @@
#: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 xml)
+ #:use-module (gnu packages ncurses))
@@ -4377,7 +4378,10 @@ tracking.")
; the compiled keyboard maps go?
(string-append "--with-xkb-bin-directory="
(assoc-ref %build-inputs "xkbcomp")
- "/bin"))
+ "/bin")
+
+ ;; For the log file, etc.
+ "--localstatedir=/var")
#:phases
(alist-replace
'configure
@@ -4385,6 +4389,12 @@ tracking.")
(let ((configure (assoc-ref %standard-phases 'configure)))
(substitute* (find-files "." "\\.c$")
(("/bin/sh") (which "sh")))
+
+ ;; Don't try to 'mkdir /var'.
+ (substitute* "hw/xfree86/Makefile.in"
+ (("mkdir(.*)logdir.*")
+ "true\n"))
+
(apply configure args)))
%standard-phases)))
(home-page "http://www.x.org/wiki/")
@@ -4700,3 +4710,44 @@ icccm: Both client and window-manager helpers for ICCCM.")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
(license license:x11)))
+
+(define-public xterm
+ (package
+ (name "xterm")
+ (version "301")
+ (source (origin
+ (method url-fetch)
+ (uri ; XXX: constant URL!
+ "http://invisible-island.net/datafiles/release/xterm.tar.gz")
+ (sha256
+ (base32
+ "040rarvv18zg0lk7qy0m3n7gv10mh40jic708wvng01z4rlbpfhz"))))
+ (build-system gnu-build-system)
+ (arguments
+ '(#:configure-flags '("--enable-wide-chars" "--enable-256-color"
+ "--enable-load-vt-fonts" "--enable-i18n"
+ "--enable-doublechars" "--enable-luit"
+ "--enable-mini-luit")
+ #:tests? #f))
+ (native-inputs
+ `(("pkg-config" ,pkg-config)))
+ (inputs
+ `(("luit" ,luit)
+ ("libXft" ,libxft)
+ ("fontconfig" ,fontconfig)
+ ("freetype" ,freetype)
+ ("ncurses" ,ncurses)
+ ("libICE" ,libice)
+ ("libSM" ,libsm)
+ ("libX11" ,libx11)
+ ("libXext" ,libxext)
+ ("libXt" ,libxt)
+ ("xproto" ,xproto)
+ ("libXaw" ,libxaw)))
+ (home-page "http://invisible-island.net/xterm")
+ (synopsis "Terminal emulator for the X Window System")
+ (description
+ "The xterm program is a terminal emulator for the X Window System. It
+provides DEC VT102/VT220 (VTxxx) and Tektronix 4014 compatible terminals for
+programs that cannot use the window system directly.")
+ (license license:x11)))
diff --git a/gnu/services.scm b/gnu/services.scm
new file mode 100644
index 0000000000..eccde4e9a3
--- /dev/null
+++ b/gnu/services.scm
@@ -0,0 +1,62 @@
+;;; 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 services)
+ #:use-module (guix records)
+ #:export (service?
+ service
+ service-documentation
+ service-provision
+ service-requirement
+ service-respawn?
+ service-start
+ service-stop
+ service-inputs
+ service-user-accounts
+ service-user-groups
+ service-pam-services))
+
+;;; Commentary:
+;;;
+;;; System services as cajoled by dmd.
+;;;
+;;; Code:
+
+(define-record-type* <service>
+ service make-service
+ service?
+ (documentation service-documentation ; string
+ (default "[No documentation.]"))
+ (provision service-provision) ; list of symbols
+ (requirement service-requirement ; list of symbols
+ (default '()))
+ (respawn? service-respawn? ; Boolean
+ (default #t))
+ (start service-start) ; expression
+ (stop service-stop ; 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 '())))
+
+;;; services.scm ends here.
diff --git a/gnu/system/dmd.scm b/gnu/services/base.scm
index 2143b00426..d6c1707c6a 100644
--- a/gnu/system/dmd.scm
+++ b/gnu/services/base.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.
;;;
@@ -16,75 +16,32 @@
;;; 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 dmd)
- #:use-module (guix store)
- #:use-module (guix packages)
- #:use-module (guix derivations)
- #:use-module (guix records)
+(define-module (gnu services base)
+ #:use-module (gnu services)
+ #:use-module (gnu system shadow) ; 'user-account', etc.
+ #:use-module (gnu system linux) ; 'pam-service', etc.
+ #:use-module (gnu packages admin)
#:use-module ((gnu packages base)
#:select (glibc-final))
- #:use-module ((gnu packages admin)
- #:select (mingetty inetutils shadow))
- #:use-module ((gnu packages package-management)
- #:select (guix))
- #:use-module ((gnu packages linux)
- #:select (net-tools))
- #:use-module (gnu system shadow) ; for user accounts/groups
- #:use-module (gnu system linux) ; for PAM services
- #:use-module (ice-9 match)
- #:use-module (ice-9 format)
+ #:use-module (gnu packages package-management)
+ #:use-module (guix monads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
- #:use-module (guix monads)
- #:export (service?
- service
- service-provision
- service-requirement
- service-respawn?
- service-start
- service-stop
- service-inputs
- service-user-accounts
- service-user-groups
- service-pam-services
-
- host-name-service
- syslog-service
+ #:use-module (ice-9 format)
+ #:export (host-name-service
mingetty-service
nscd-service
+ syslog-service
guix-service
- static-networking-service
-
- dmd-configuration-file))
+ %base-services))
;;; Commentary:
;;;
-;;; System services as cajoled by dmd.
+;;; Base system services---i.e., services that 99% of the users will want to
+;;; use.
;;;
;;; Code:
-(define-record-type* <service>
- service make-service
- service?
- (documentation service-documentation ; string
- (default "[No documentation.]"))
- (provision service-provision) ; list of symbols
- (requirement service-requirement ; list of symbols
- (default '()))
- (respawn? service-respawn? ; Boolean
- (default #t))
- (start service-start) ; expression
- (stop service-stop ; 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 '())))
-
(define (host-name-service name)
"Return a service that sets the host name to NAME."
(with-monad %store-monad
@@ -217,100 +174,18 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
(members (map user-account-name
user-accounts)))))))))
-(define* (static-networking-service interface ip
- #:key
- gateway
- (name-servers '())
- (inetutils inetutils)
- (net-tools net-tools))
- "Return a service that starts INTERFACE with address IP. If GATEWAY is
-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"))
- (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 _
- ;; Return #t if successfully started.
- (and (zero? (system* ,ifconfig ,interface ,ip "up"))
- ,(if gateway
- `(zero? (system* ,route "add" "-net" "default"
- "gw" ,gateway))
- #t)
- ,(if (pair? name-servers)
- `(call-with-output-file "/etc/resolv.conf"
- (lambda (port)
- (display
- "# Generated by 'static-networking-service'.\n"
- port)
- (for-each (lambda (server)
- (format port "nameserver ~a~%"
- server))
- ',name-servers)))
- #t))))
- (stop `(lambda _
- ;; Return #f is successfully stopped.
- (not (and (system* ,ifconfig ,interface "down")
- (system* ,route "del" "-net" "default")))))
- (respawn? #f)
- (inputs `(("inetutils" ,inetutils)
- ,@(if gateway
- `(("net-tools" ,net-tools))
- '())))))))
-
-
-(define (dmd-configuration-file services etc)
- "Return the dmd configuration file for SERVICES, that initializes /etc from
-ETC on startup."
- (define config
- `(begin
- (use-modules (ice-9 ftw))
-
- (register-services
- ,@(map (match-lambda
- (($ <service> documentation provision requirement
- respawn? start stop)
- `(make <service>
- #:docstring ,documentation
- #:provides ',provision
- #:requires ',requirement
- #:respawn? ,respawn?
- #:start ,start
- #:stop ,stop)))
- services))
-
- ;; /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 '("." ".."))))))
-
- ;; Prevent ETC from being GC'd.
- (rm-f "/var/nix/gcroots/etc-directory")
- (symlink ,etc "/var/nix/gcroots/etc-directory"))
-
- (format #t "starting services...~%")
- (for-each start ',(append-map service-provision services))))
-
- (text-file "dmd.conf" (object->string config)))
-
-;;; dmd.scm ends here
+(define %base-services
+ ;; Convenience variable holding the basic services.
+ (let ((motd (text-file "motd" "
+This is the GNU operating system, welcome!\n\n")))
+ (list (mingetty-service "tty1" #:motd motd)
+ (mingetty-service "tty2" #:motd motd)
+ (mingetty-service "tty3" #:motd motd)
+ (mingetty-service "tty4" #:motd motd)
+ (mingetty-service "tty5" #:motd motd)
+ (mingetty-service "tty6" #:motd motd)
+ (syslog-service)
+ (guix-service)
+ (nscd-service))))
+
+;;; base.scm ends here
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
new file mode 100644
index 0000000000..21719118eb
--- /dev/null
+++ b/gnu/services/dmd.scm
@@ -0,0 +1,77 @@
+;;; 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 services dmd)
+ #:use-module (guix monads)
+ #:use-module (gnu services)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:export (dmd-configuration-file))
+
+;;; Commentary:
+;;;
+;;; Instantiating system services as a dmd configuration file.
+;;;
+;;; Code:
+
+(define (dmd-configuration-file services etc)
+ "Return the dmd configuration file for SERVICES, that initializes /etc from
+ETC (the name of a directory in the store) on startup."
+ (define config
+ `(begin
+ (use-modules (ice-9 ftw))
+
+ (register-services
+ ,@(map (lambda (service)
+ `(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))
+
+ ;; /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 '("." ".."))))))
+
+ ;; Prevent ETC from being GC'd.
+ (rm-f "/var/nix/gcroots/etc-directory")
+ (symlink ,etc "/var/nix/gcroots/etc-directory"))
+
+ (format #t "starting services...~%")
+ (for-each start ',(append-map service-provision services))))
+
+ (text-file "dmd.conf" (object->string config)))
+
+;;; dmd.scm ends here
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
new file mode 100644
index 0000000000..317800db50
--- /dev/null
+++ b/gnu/services/networking.scm
@@ -0,0 +1,80 @@
+;;; 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 services networking)
+ #:use-module (gnu services)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages linux)
+ #:use-module (guix monads)
+ #:export (static-networking-service))
+
+;;; Commentary:
+;;;
+;;; Networking services.
+;;;
+;;; Code:
+
+(define* (static-networking-service interface ip
+ #:key
+ gateway
+ (name-servers '())
+ (inetutils inetutils)
+ (net-tools net-tools))
+ "Return a service that starts INTERFACE with address IP. If GATEWAY is
+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"))
+ (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 _
+ ;; Return #t if successfully started.
+ (and (zero? (system* ,ifconfig ,interface ,ip "up"))
+ ,(if gateway
+ `(zero? (system* ,route "add" "-net" "default"
+ "gw" ,gateway))
+ #t)
+ ,(if (pair? name-servers)
+ `(call-with-output-file "/etc/resolv.conf"
+ (lambda (port)
+ (display
+ "# Generated by 'static-networking-service'.\n"
+ port)
+ (for-each (lambda (server)
+ (format port "nameserver ~a~%"
+ server))
+ ',name-servers)))
+ #t))))
+ (stop `(lambda _
+ ;; Return #f is successfully stopped.
+ (not (and (system* ,ifconfig ,interface "down")
+ (system* ,route "del" "-net" "default")))))
+ (respawn? #f)
+ (inputs `(("inetutils" ,inetutils)
+ ,@(if gateway
+ `(("net-tools" ,net-tools))
+ '())))))))
+
+;;; networking.scm ends here
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
new file mode 100644
index 0000000000..702be27714
--- /dev/null
+++ b/gnu/services/xorg.scm
@@ -0,0 +1,186 @@
+;;; 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 services xorg)
+ #:use-module (gnu services)
+ #:use-module (gnu system linux) ; 'pam-service'
+ #:use-module ((gnu packages base) #:select (guile-final))
+ #:use-module (gnu packages xorg)
+ #:use-module (gnu packages gl)
+ #:use-module (gnu packages slim)
+ #:use-module (gnu packages ratpoison)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages bash)
+ #:use-module (guix monads)
+ #:use-module (guix derivations)
+ #:export (xorg-start-command
+ slim-service))
+
+;;; Commentary:
+;;;
+;;; Services that relate to the X Window System.
+;;;
+;;; Code:
+
+(define* (xorg-start-command #:key
+ (guile guile-final)
+ (xorg-server xorg-server))
+ "Return a derivation that builds a GUILE script to start the X server from
+XORG-SERVER. Usually the X server is started by a login manager."
+
+ (define (xserver.conf)
+ (text-file* "xserver.conf" "
+Section \"Files\"
+ FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\"
+ ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
+ ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
+ ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
+ ModulePath \"" xorg-server "/lib/xorg/modules\"
+ ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
+ ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
+EndSection
+
+Section \"ServerFlags\"
+ Option \"AllowMouseOpenFail\" \"on""
+EndSection
+
+Section \"Monitor\"
+ Identifier \"Monitor[0]\"
+EndSection
+
+Section \"InputClass\"
+ Identifier \"Generic keyboard\"
+ MatchIsKeyboard \"on\"
+ Option \"XkbRules\" \"base\"
+ Option \"XkbModel\" \"pc104\"
+EndSection
+
+Section \"ServerLayout\"
+ Identifier \"Layout\"
+ Screen \"Screen-vesa\"
+EndSection
+
+Section \"Device\"
+ Identifier \"Device-vesa\"
+ Driver \"vesa\"
+EndSection
+
+Section \"Screen\"
+ Identifier \"Screen-vesa\"
+ Device \"Device-vesa\"
+EndSection"))
+
+ (mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
+ (xorg-bin (package-file xorg-server "bin/X"))
+ (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")))
+ (call-with-output-file out
+ (lambda (port)
+ (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
+ (write '(begin
+ (setenv "XORG_DRI_DRIVER_PATH" ,dri)
+ (setenv "XKB_BINDIR" ,xkbcomp-bin)
+
+ (apply execl
+
+ ,xorg-bin "-ac" "-logverbose" "-verbose"
+ "-xkbdir" ,xkb-dir
+ "-config" ,(derivation->output-path config)
+ "-nolisten" "tcp" "-terminate"
+
+ ;; Note: SLiM and other display managers add the
+ ;; '-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* (slim-service #:key (slim slim)
+ (allow-empty-passwords? #t) auto-login?
+ (default-user "")
+ (xauth xauth) (dmd dmd) (bash bash)
+ startx)
+ "Return a service that spawns the SLiM graphical login manager, which in
+turn start the X display server with STARTX, a command as returned by
+'xorg-start-command'.
+
+When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password.
+When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
+ (define (slim.cfg)
+ ;; TODO: Run "bash -login ~/.xinitrc %session".
+ (mlet %store-monad ((startx (or startx (xorg-start-command))))
+ (text-file* "slim.cfg" "
+default_path /run/current-system/bin
+default_xserver " startx "
+xserver_arguments :0 vt7
+xauth_path " xauth "/bin/xauth
+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 " ratpoison "/bin/ratpoison
+
+halt_cmd " dmd "/sbin/halt
+reboot_cmd " dmd "/sbin/reboot
+" (if auto-login?
+ (string-append "auto_login yes\ndefault_user " default-user)
+ ""))))
+
+ (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
+ (bash-bin (package-file bash "bin/bash"))
+ (slim.cfg (slim.cfg)))
+ (return
+ (service
+ (documentation "Xorg display server")
+ (provision '(xorg-server))
+ (requirement '(host-name))
+ (start
+ ;; XXX: Work around the inability to specify env. vars. directly.
+ `(make-forkexec-constructor
+ ,bash-bin "-c"
+ ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
+ " " slim-bin
+ " -nodaemon")))
+ (stop `(make-kill-destructor))
+ (inputs `(("slim" ,slim)
+ ("slim.cfg" ,slim.cfg)
+ ("bash" ,bash)))
+ (respawn? #t)
+ (pam-services
+ ;; Tell PAM about 'slim'.
+ (list (unix-pam-service
+ "slim"
+ #:allow-empty-passwords? allow-empty-passwords?)))))))
+
+;;; xorg.scm ends here
diff --git a/gnu/system.scm b/gnu/system.scm
index 1b5ce7afc5..96f721330f 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -22,15 +22,17 @@
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix derivations)
- #:use-module (gnu packages linux-initrd)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages admin)
#:use-module (gnu packages package-management)
- #:use-module (gnu system dmd)
+ #:use-module (gnu services)
+ #:use-module (gnu services dmd)
+ #:use-module (gnu services base)
#:use-module (gnu system grub)
#:use-module (gnu system shadow)
#:use-module (gnu system linux)
+ #:use-module (gnu system linux-initrd)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -38,7 +40,18 @@
operating-system?
operating-system-services
operating-system-packages
+ operating-system-bootloader-entries
+ operating-system-host-name
+ operating-system-kernel
+ operating-system-initrd
+ operating-system-users
+ operating-system-groups
+ operating-system-packages
+ operating-system-timezone
+ operating-system-locale
+ operating-system-services
+ operating-system-profile-directory
operating-system-derivation))
;;; Commentary:
@@ -58,8 +71,8 @@
(default grub))
(bootloader-entries operating-system-bootloader-entries ; list
(default '()))
- (initrd operating-system-initrd
- (default gnu-system-initrd))
+ (initrd operating-system-initrd ; monadic derivation
+ (default (gnu-system-initrd)))
(host-name operating-system-host-name) ; string
@@ -92,23 +105,7 @@
(locale operating-system-locale) ; string
(services operating-system-services ; list of monadic services
- (default
- (let ((motd (text-file "motd" "
-This is the GNU operating system, welcome!\n\n")))
- (list (mingetty-service "tty1" #:motd motd)
- (mingetty-service "tty2" #:motd motd)
- (mingetty-service "tty3" #:motd motd)
- (mingetty-service "tty4" #:motd motd)
- (mingetty-service "tty5" #:motd motd)
- (mingetty-service "tty6" #:motd motd)
- (syslog-service)
- (guix-service)
- (nscd-service)
-
- ;; QEMU networking settings.
- (static-networking-service "eth0" "10.0.2.10"
- #:name-servers '("10.0.2.3")
- #:gateway "10.0.2.2"))))))
+ (default %base-services)))
@@ -233,6 +230,11 @@ directories or regular files."
(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/bin/bash\n"))
(issue (text-file "issue" "
This is an alpha preview of the GNU system. Welcome.
@@ -243,40 +245,53 @@ GNU dmd (http://www.gnu.org/software/dmd/).
You can log in as 'guest' or 'root' with no password.
"))
- ;; Assume TZDATA is installed---e.g., as part of the system packages.
- ;; Users can choose not to have it.
- (tzdir (package-file tzdata "share/zoneinfo"))
-
;; TODO: Generate bashrc from packages' search-paths.
- (bashrc (text-file "bashrc" (string-append "
+ (bashrc (text-file* "bashrc" "
export PS1='\\u@\\h\\$ '
export LC_ALL=\"" locale "\"
export TZ=\"" timezone "\"
-export TZDIR=\"" tzdir "\"
+export TZDIR=\"" tzdata "/share/zoneinfo\"
export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
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'
-")))
+"))
+ (tz-file (package-file tzdata
+ (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)
- ("profile" ,bashrc)
+ ("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))
+ ("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)
+ "Return the directory name of the default profile of OS."
+ (mlet %store-monad ((drv (operating-system-profile-derivation os)))
+ (return (derivation->output-path drv))))
+
(define (operating-system-derivation os)
"Return a derivation that builds OS."
(mlet* %store-monad
@@ -297,23 +312,20 @@ alias ll='ls -l'
(password "")
(uid 0) (gid 0)
(comment "System administrator")
- (home-directory "/"))
+ (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)))
- (packages -> (operating-system-packages os))
- ;; TODO: Replace with a real profile with a manifest.
- (profile-drv (union packages
- #:name "default-profile"))
+ (profile-drv (operating-system-profile-derivation os))
(profile -> (derivation->output-path profile-drv))
(etc-drv (etc-directory #:accounts accounts #:groups groups
#:pam-services pam-services
#:locale (operating-system-locale os)
#:timezone (operating-system-timezone os)
- #:profile profile))
+ #:profile profile-drv))
(etc -> (derivation->output-path etc-drv))
(dmd-conf (dmd-configuration-file services etc))
@@ -324,17 +336,18 @@ alias ll='ls -l'
"--config" ,dmd-conf))))
(kernel -> (operating-system-kernel os))
(kernel-dir (package-file kernel))
- (initrd -> (operating-system-initrd os))
- (initrd-file (package-file initrd))
+ (initrd (operating-system-initrd os))
+ (initrd-file -> (string-append (derivation->output-path initrd)
+ "/initrd"))
(entries -> (list (menu-entry
(label (string-append
"GNU system with "
(package-full-name kernel)
" (technology preview)"))
(linux kernel)
- (linux-arguments `("--root=/dev/vda1"
+ (linux-arguments `("--root=/dev/sda1"
,(string-append "--load=" boot)))
- (initrd initrd))))
+ (initrd initrd-file))))
(grub.cfg (grub-configuration-file entries))
(extras (links (delete-duplicates
(append (append-map service-inputs services)
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 86fa9b504d..5dc0b85ff2 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.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.
;;;
@@ -41,7 +41,7 @@
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '()))
- (initrd menu-entry-initrd))
+ (initrd menu-entry-initrd)) ; file name of the initrd
(define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5)
@@ -66,10 +66,7 @@ search.file ~a~%"
(match-lambda
(($ <menu-entry> label linux arguments initrd)
(mlet %store-monad ((linux (package-file linux "bzImage"
- #:system system))
- (initrd (package-file initrd "initrd"
#:system system)))
- ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
(return (format #f "menuentry ~s {
linux ~a ~a
initrd ~a
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
new file mode 100644
index 0000000000..9520473d01
--- /dev/null
+++ b/gnu/system/linux-initrd.scm
@@ -0,0 +1,248 @@
+;;; 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 linux-initrd)
+ #:use-module (guix monads)
+ #:use-module (guix utils)
+ #:use-module ((guix store)
+ #:select (%store-prefix))
+ #: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 (ice-9 regex)
+ #:export (expression->initrd
+ qemu-initrd
+ gnu-system-initrd))
+
+
+;;; Commentary:
+;;;
+;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
+;;; particular initrd's that run Guile.
+;;;
+;;; Code:
+
+
+(define* (expression->initrd exp
+ #:key
+ (guile %guile-static-stripped)
+ (cpio cpio)
+ (gzip gzip)
+ (name "guile-initrd")
+ (system (%current-system))
+ (modules '())
+ (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
+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'.
+
+ (define (string->regexp str)
+ ;; Return a regexp that matches STR exactly.
+ (string-append "^" (regexp-quote str) "$"))
+
+ (define builder
+ `(begin
+ (use-modules (guix build utils)
+ (ice-9 pretty-print)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 ftw)
+ (srfi srfi-26)
+ (system base compile)
+ (rnrs bytevectors)
+ ((system foreign) #:select (sizeof)))
+
+ (let ((guile (assoc-ref %build-inputs "guile"))
+ (cpio (string-append (assoc-ref %build-inputs "cpio")
+ "/bin/cpio"))
+ (gzip (string-append (assoc-ref %build-inputs "gzip")
+ "/bin/gzip"))
+ (modules (assoc-ref %build-inputs "modules"))
+ (gos (assoc-ref %build-inputs "modules/compiled"))
+ (scm-dir (string-append "share/guile/" (effective-version)))
+ (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
+ (effective-version)
+ (if (eq? (native-endianness) (endianness little))
+ "LE"
+ "BE")
+ (sizeof '*)
+ (effective-version)))
+ (out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (mkdir "contents")
+ (with-directory-excursion "contents"
+ (copy-recursively guile ".")
+ (call-with-output-file "init"
+ (lambda (p)
+ (format p "#!/bin/guile -ds~%!#~%" guile)
+ (pretty-print ',exp p)))
+ (chmod "init" #o555)
+ (chmod "bin/guile" #o555)
+
+ ;; Copy Guile modules.
+ (chmod scm-dir #o777)
+ (copy-recursively modules scm-dir
+ #:follow-symlinks? #t)
+ (copy-recursively gos (string-append "lib/guile/"
+ (effective-version) "/ccache")
+ #:follow-symlinks? #t)
+
+ ;; Compile `init'.
+ (mkdir-p go-dir)
+ (set! %load-path (cons modules %load-path))
+ (set! %load-compiled-path (cons gos %load-compiled-path))
+ (compile-file "init"
+ #:opts %auto-compilation-options
+ #:output-file (string-append go-dir "/init.go"))
+
+ ;; Copy Linux modules.
+ (let* ((linux (assoc-ref %build-inputs "linux"))
+ (module-dir (and linux
+ (string-append linux "/lib/modules"))))
+ (mkdir "modules")
+ ,@(map (lambda (module)
+ `(match (find-files module-dir
+ ,(string->regexp module))
+ ((file)
+ (format #t "copying '~a'...~%" file)
+ (copy-file file (string-append "modules/"
+ ,module)))
+ (()
+ (error "module not found" ,module module-dir))
+ ((_ ...)
+ (error "several modules by that name"
+ ,module module-dir))))
+ linux-modules))
+
+ ;; Reset the timestamps of all the files that will make it in the
+ ;; initrd.
+ (for-each (cut utime <> 0 0 0 0)
+ (find-files "." ".*"))
+
+ (system* cpio "--version")
+ (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
+ "-O" (string-append out "/initrd")
+ "-H" "newc" "--null")))
+ (define print0
+ (let ((len (string-length "./")))
+ (lambda (file)
+ (format pipe "~a\0" (string-drop file len)))))
+
+ ;; Note: as per `ramfs-rootfs-initramfs.txt', always add
+ ;; directory entries before the files that are inside of it: "The
+ ;; Linux kernel cpio extractor won't create files in a directory
+ ;; that doesn't exist, so the directory entries must go before
+ ;; the files that go in those directories."
+ (file-system-fold (const #t)
+ (lambda (file stat result) ; leaf
+ (print0 file))
+ (lambda (dir stat result) ; down
+ (unless (string=? dir ".")
+ (print0 dir)))
+ (const #f) ; up
+ (const #f) ; skip
+ (const #f)
+ #f
+ ".")
+
+ (and (zero? (close-pipe pipe))
+ (with-directory-excursion out
+ (and (zero? (system* gzip "--best" "initrd"))
+ (rename-file "initrd.gz" "initrd")))))))))
+
+ (mlet* %store-monad
+ ((source (imported-modules modules))
+ (compiled (compiled-modules modules))
+ (inputs (lower-inputs
+ `(("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
+ guile-modules-in-chroot?
+ volatile-root?
+ (mounts `((cifs "/store" ,(%store-prefix))
+ (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
+be mounted atop the root file system, where each item has the form:
+
+ (FILE-SYSTEM-TYPE SOURCE TARGET)
+
+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!).
+
+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"))
+
+ (define virtio-9p-modules
+ ;; Modules for the 9p paravirtualized file system.
+ '("9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
+
+ (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)
+ cifs-modules
+ '())
+ ,@(if (assoc-ref mounts '9p)
+ virtio-9p-modules
+ '())))
+
+ (expression->initrd
+ `(begin
+ (use-modules (guix build linux-initrd))
+
+ (boot-system #:mounts ',mounts
+ #:linux-modules ',linux-modules
+ #:qemu-guest-networking? #t
+ #:guile-modules-in-chroot? ',guile-modules-in-chroot?
+ #:volatile-root? ',volatile-root?))
+ #:name "qemu-initrd"
+ #:modules '((guix build utils)
+ (guix build linux-initrd))
+ #: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))
+
+;;; linux-initrd.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e75c09d859..b8b0274f1f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.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.
;;;
@@ -35,7 +35,6 @@
#:use-module (gnu packages zile)
#:use-module (gnu packages grub)
#:use-module (gnu packages linux)
- #:use-module (gnu packages linux-initrd)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
@@ -43,9 +42,10 @@
#:use-module (gnu system shadow)
#:use-module (gnu system linux)
+ #:use-module (gnu system linux-initrd)
#:use-module (gnu system grub)
- #:use-module (gnu system dmd)
#:use-module (gnu system)
+ #:use-module (gnu services)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -53,7 +53,9 @@
#:export (expression->derivation-in-linux-vm
qemu-image
- system-qemu-image))
+ system-qemu-image
+ system-qemu-image/shared-store
+ system-qemu-image/shared-store-script))
;;; Commentary:
@@ -67,7 +69,7 @@
(system (%current-system))
(inputs '())
(linux linux-libre)
- (initrd qemu-initrd)
+ initrd
(qemu qemu/smb-shares)
(env-vars '())
(modules '())
@@ -78,10 +80,10 @@
(references-graphs #f)
(disk-image-size
(* 100 (expt 2 20))))
- "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the
-virtual machine, EXP has access to all of INPUTS from the store; it should put
-its output files in the `/xchg' directory, which is copied to the derivation's
-output when the VM terminates.
+ "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
+store; it should put its output files in the `/xchg' directory, which is
+copied to the derivation's output when the VM terminates.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
DISK-IMAGE-SIZE bytes and return it.
@@ -154,7 +156,7 @@ made available under the /xchg CIFS share."
(#f '())))
(and (zero?
- (system* qemu "-nographic" "-no-reboot"
+ (system* qemu "-enable-kvm" "-nographic" "-no-reboot"
"-net" "nic,model=e1000"
"-net" (string-append "user,smb=" (getcwd))
"-kernel" linux
@@ -178,6 +180,9 @@ made available under the /xchg CIFS share."
(user-builder (text-file "builder-in-linux-vm"
(object->string exp*)))
(coreutils -> (car (assoc-ref %final-inputs "coreutils")))
+ (initrd (if initrd ; use the default initrd?
+ (return initrd)
+ (qemu-initrd #:guile-modules-in-chroot? #t)))
(inputs (lower-inputs `(("qemu" ,qemu)
("linux" ,linux)
("initrd" ,initrd)
@@ -185,6 +190,7 @@ made available under the /xchg CIFS share."
("builder" ,user-builder)
,@inputs))))
(derivation-expression name builder
+ ;; TODO: Require the "kvm" feature.
#:system system
#:inputs inputs
#:env-vars env-vars
@@ -290,18 +296,18 @@ such as /etc files."
(assoc-ref %build-inputs "gawk") "/bin"))
(display "creating partition table...\n")
- (and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
+ (and (zero? (system* parted "/dev/sda" "mklabel" "msdos"
"mkpart" "primary" "ext2" "1MiB"
,(format #f "~aB"
(- disk-image-size
(* 5 (expt 2 20))))))
(begin
(display "creating ext3 partition...\n")
- (and (zero? (system* mkfs "-F" "/dev/vda1"))
+ (and (zero? (system* mkfs "-F" "/dev/sda1"))
(let ((store (string-append "/fs" ,%store-directory)))
(display "mounting partition...\n")
(mkdir "/fs")
- (mount "/dev/vda1" "/fs" "ext3")
+ (mount "/dev/sda1" "/fs" "ext3")
(mkdir-p "/fs/boot/grub")
(symlink grub.cfg "/fs/boot/grub/grub.cfg")
@@ -319,8 +325,9 @@ such as /etc files."
;; Optionally, register the inputs in the image's store.
(let* ((guix (assoc-ref %build-inputs "guix"))
- (register (string-append guix
- "/sbin/guix-register")))
+ (register (and guix
+ (string-append guix
+ "/sbin/guix-register"))))
,@(if initialize-store?
(match inputs-to-copy
(((graph-files . _) ...)
@@ -375,7 +382,7 @@ such as /etc files."
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
- "/dev/vda"))
+ "/dev/sda"))
(zero? (system* umount "/fs"))
(reboot))))))))
#:system system
@@ -407,37 +414,52 @@ such as /etc files."
;;; Stand-alone VM image.
;;;
-(define %demo-operating-system
- (operating-system
- (host-name "gnu")
- (timezone "Europe/Paris")
- (locale "en_US.UTF-8")
- (users (list (user-account
- (name "guest")
- (password "")
- (uid 1000) (gid 100)
- (comment "Guest of GNU")
- (home-directory "/home/guest"))))
- (packages (list coreutils
- bash
- guile-2.0
- dmd
- gcc-final
- ld-wrapper ; must come before BINUTILS
- binutils-final
- glibc-final
- inetutils
- findutils
- grep
- sed
- procps
- psmisc
- zile
- less
- tzdata
- guix))))
-
-(define* (system-qemu-image #:optional (os %demo-operating-system)
+(define (operating-system-build-gid os)
+ "Return as a monadic value the group id for build users of OS, or #f."
+ (anym %store-monad
+ (lambda (service)
+ (and (equal? '(guix-daemon)
+ (service-provision service))
+ (match (service-user-groups service)
+ ((group)
+ (user-group-id group)))))
+ (operating-system-services os)))
+
+(define (operating-system-default-contents os)
+ "Return a list of directives suitable for 'system-qemu-image' describing the
+basic contents of the root file system of OS."
+ (define (user-directories user)
+ (let ((home (user-account-home-directory user))
+ ;; XXX: Deal with automatically allocated ids.
+ (uid (or (user-account-uid user) 0))
+ (gid (or (user-account-gid user) 0))
+ (root (string-append "/var/nix/profiles/per-user/"
+ (user-account-name user))))
+ `((directory ,root ,uid ,gid)
+ (directory ,home ,uid ,gid))))
+
+ (mlet* %store-monad ((os-drv (operating-system-derivation os))
+ (os-dir -> (derivation->output-path os-drv))
+ (build-gid (operating-system-build-gid os))
+ (profile (operating-system-profile-directory os)))
+ (return `((directory "/nix/store" 0 ,(or build-gid 0))
+ (directory "/etc")
+ (directory "/var/log") ; for dmd
+ (directory "/var/run/nscd")
+ (directory "/var/nix/gcroots")
+ ("/var/nix/gcroots/system" -> ,os-dir)
+ (directory "/run")
+ ("/run/current-system" -> ,profile)
+ (directory "/bin")
+ ("/bin/sh" -> "/run/current-system/bin/bash")
+ (directory "/tmp")
+ (directory "/var/nix/profiles/per-user/root" 0 0)
+
+ (directory "/root" 0 0) ; an exception
+ ,@(append-map user-directories
+ (operating-system-users os))))))
+
+(define* (system-qemu-image os
#:key (disk-image-size (* 900 (expt 2 20))))
"Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU
system as described by OS."
@@ -445,29 +467,78 @@ system as described by OS."
((os-drv (operating-system-derivation os))
(os-dir -> (derivation->output-path os-drv))
(grub.cfg -> (string-append os-dir "/grub.cfg"))
- (build-user-gid (anym %store-monad ; XXX
- (lambda (service)
- (and (equal? '(guix-daemon)
- (service-provision service))
- (match (service-user-groups service)
- ((group)
- (user-group-id group)))))
- (operating-system-services os)))
- (populate -> `((directory "/nix/store" 0 ,build-user-gid)
- (directory "/etc")
- (directory "/var/log") ; for dmd
- (directory "/var/run/nscd")
- (directory "/var/nix/gcroots")
- ("/var/nix/gcroots/system" -> ,os-dir)
- (directory "/tmp")
- (directory "/var/nix/profiles/per-user/root" 0 0)
- (directory "/var/nix/profiles/per-user/guest"
- 1000 100)
- (directory "/home/guest" 1000 100))))
+ (populate (operating-system-default-contents os)))
(qemu-image #:grub-configuration grub.cfg
#:populate populate
#:disk-image-size disk-image-size
#:initialize-store? #t
#:inputs-to-copy `(("system" ,os-drv)))))
+(define* (system-qemu-image/shared-store
+ os
+ #:key (disk-image-size (* 15 (expt 2 20))))
+ "Return a derivation that builds a QEMU image of OS that shares its store
+with the host."
+ (mlet* %store-monad
+ ((os-drv (operating-system-derivation os))
+ (os-dir -> (derivation->output-path os-drv))
+ (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)))
+
+(define* (system-qemu-image/shared-store-script
+ os
+ #:key
+ (qemu (package (inherit qemu)
+ ;; FIXME/TODO: Use 9p instead of this hack.
+ (source (package-source qemu/smb-shares))))
+ (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 `((cifs "/store" ,(%store-prefix)))
+ #:volatile-root? #t))
+ (os (operating-system (inherit os) (initrd initrd))))
+ (define builder
+ (mlet %store-monad ((image (system-qemu-image/shared-store os))
+ (qemu (package-file qemu
+ "bin/qemu-system-x86_64"))
+ (bash (package-file bash "bin/sh"))
+ (kernel (package-file (operating-system-kernel os)
+ "bzImage"))
+ (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 "
+# TODO: -virtfs local,path=XXX,security_model=none,mount_tag=store
+exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
+ -net user,smb=$PWD \
+ -kernel " ,kernel " -initrd "
+ ,(string-append (derivation->output-path initrd) "/initrd") " \
+-append \"" ,(if graphic? "" "console=ttyS0 ")
+"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \
+ -drive file=" ,(derivation->output-path image)
+ ",if=virtio,cache=writeback,werror=report,readonly\n")
+ port)))
+ (chmod out #o555)
+ #t))))
+
+ (mlet %store-monad ((image (system-qemu-image/shared-store os))
+ (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
diff --git a/guix/build/download.scm b/guix/build/download.scm
index ac2086d96e..f9715e10f7 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.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.
;;;
@@ -201,6 +201,12 @@ which is not available during bootstrap."
(string>? (micro-version) "7")
(string>? (version) "2.0.7")))
+ (define headers
+ ;; Some web sites, such as http://dist.schmorp.de, would block you if
+ ;; there's no 'User-Agent' header, presumably on the assumption that
+ ;; you're a spammer. So work around that.
+ '((User-Agent . "GNU Guile")))
+
(let*-values (((connection)
(open-connection-for-uri uri))
((resp bv-or-port)
@@ -210,11 +216,14 @@ which is not available during bootstrap."
;; version. So keep this compatibility hack for now.
(if post-2.0.7?
(http-get uri #:port connection #:decode-body? #f
- #:streaming? #t)
+ #:streaming? #t
+ #:headers headers)
(if (module-defined? (resolve-interface '(web client))
'http-get*)
- (http-get* uri #:port connection #:decode-body? #f)
- (http-get uri #:port connection #:decode-body? #f))))
+ (http-get* uri #:port connection #:decode-body? #f
+ #:headers headers)
+ (http-get uri #:port connection #:decode-body? #f
+ #:extra-headers headers))))
((code)
(response-code resp))
((size)
diff --git a/guix/build/git.scm b/guix/build/git.scm
new file mode 100644
index 0000000000..4245594c38
--- /dev/null
+++ b/guix/build/git.scm
@@ -0,0 +1,45 @@
+;;; 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 git)
+ #:use-module (guix build utils)
+ #:export (git-fetch))
+
+;;; Commentary:
+;;;
+;;; This is the build-side support code of (guix git-download). It allows a
+;;; Git repository to be cloned and checked out at a specific commit.
+;;;
+;;; Code:
+
+(define* (git-fetch url commit directory
+ #:key (git-command "git"))
+ "Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit
+identifier. Return #t on success, #f otherwise."
+ (and (zero? (system* git-command "clone" url directory))
+ (with-directory-excursion directory
+ (system* git-command "tag" "-l")
+ (and (zero? (system* git-command "checkout" commit))
+ (begin
+ ;; The contents of '.git' vary as a function of the current
+ ;; status of the Git repo. Since we want a fixed output, this
+ ;; directory needs to be taken out.
+ (delete-file-recursively ".git")
+ #t)))))
+
+;;; git.scm ends here
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index ae18a16e11..80ce679496 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -19,14 +19,23 @@
(define-module (guix build linux-initrd)
#:use-module (rnrs io ports)
#:use-module (system foreign)
+ #:autoload (system repl repl) (start-repl)
+ #:autoload (system base compile) (compile-file)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 ftw)
+ #:use-module (guix build utils)
#:export (mount-essential-file-systems
linux-command-line
make-essential-device-nodes
configure-qemu-networking
mount-qemu-smb-share
+ mount-qemu-9p
bind-mount
load-linux-module*
- device-number))
+ device-number
+ boot-system))
;;; Commentary:
;;;
@@ -74,10 +83,26 @@
(unless (file-exists? (scope "dev"))
(mkdir (scope "dev")))
- ;; Make the device nodes for QEMU's hard disk and partitions.
- (mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0))
- (mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1))
- (mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2))
+ ;; Make the device nodes for SCSI disks.
+ (mknod (scope "dev/sda") 'block-special #o644 (device-number 8 0))
+ (mknod (scope "dev/sda1") 'block-special #o644 (device-number 8 1))
+ (mknod (scope "dev/sda2") 'block-special #o644 (device-number 8 2))
+
+ ;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
+ (mknod (scope "dev/vda") 'block-special #o644 (device-number 252 0))
+ (mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1))
+ (mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2))
+
+ ;; Memory (used by Xorg's VESA driver.)
+ (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
+ (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
+
+ ;; Inputs (used by Xorg.)
+ (unless (file-exists? (scope "dev/input"))
+ (mkdir (scope "dev/input")))
+ (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
+ (mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
+ (mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
;; TTYs.
(mknod (scope "dev/tty") 'char-special #o600
@@ -133,6 +158,17 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
(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>
@@ -151,4 +187,155 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
the last argument of `mknod'."
(+ (* major 256) minor))
+(define* (boot-system #:key
+ (linux-modules '())
+ qemu-guest-networking?
+ guile-modules-in-chroot?
+ volatile-root?
+ (mounts '()))
+ "This procedure is meant to be called from an initrd. Boot a system by
+first loading LINUX-MODULES, then setting up QEMU guest networking if
+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:
+
+ (FILE-SYSTEM-TYPE SOURCE TARGET)
+
+When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
+the new root.
+
+When VOLATILE-ROOT? is true, the root file system is writable but any changes
+to it are lost."
+ (define (resolve file)
+ ;; If FILE is a symlink to an absolute file name, resolve it as if we were
+ ;; under /root.
+ (let ((st (lstat file)))
+ (if (eq? 'symlink (stat:type st))
+ (let ((target (readlink file)))
+ (resolve (string-append "/root" target)))
+ file)))
+
+ (define MS_RDONLY 1)
+
+ (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)
+ (let ((opt (string-append opt "=")))
+ (and=> (find (cut string-prefix? opt <>)
+ args)
+ (lambda (arg)
+ (substring arg (+ 1 (string-index arg #\=))))))))
+ (to-load (option "--load"))
+ (root (option "--root")))
+
+ (when (member "--repl" args)
+ (start-repl))
+
+ (display "loading kernel modules...\n")
+ (for-each (compose load-linux-module*
+ (cut string-append "/modules/" <>))
+ linux-modules)
+
+ (when qemu-guest-networking?
+ (unless (configure-qemu-networking)
+ (display "network interface is DOWN\n")))
+
+ ;; Make /dev nodes.
+ (make-essential-device-nodes)
+
+ ;; Prepare the real root file system under /root.
+ (unless (file-exists? "/root")
+ (mkdir "/root"))
+ (if root
+ (catch #t
+ (lambda ()
+ (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
+ (('cifs source target)
+ (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
+ ;; child process in the chroot can load modules (we would bind-mount
+ ;; them but for some reason that fails with EINVAL -- XXX).
+ (mkdir-p "/root/share")
+ (mkdir-p "/root/lib")
+ (mount "none" "/root/share" "tmpfs")
+ (mount "none" "/root/lib" "tmpfs")
+ (copy-recursively "/share" "/root/share"
+ #:log (%make-void-port "w"))
+ (copy-recursively "/lib" "/root/lib"
+ #:log (%make-void-port "w")))
+
+ (if to-load
+ (begin
+ (format #t "loading '~a'...\n" to-load)
+ (chdir "/root")
+ (chroot "/root")
+ ;; TODO: Remove /lib, /share, and /loader.go.
+ (catch #t
+ (lambda ()
+ (primitive-load to-load))
+ (lambda args
+ (format (current-error-port) "'~a' raised an exception: ~s~%"
+ to-load args)
+ (start-repl)))
+ (format (current-error-port)
+ "boot program '~a' terminated, rebooting~%"
+ to-load)
+ (sleep 2)
+ (reboot))
+ (begin
+ (display "no boot file passed via '--load'\n")
+ (display "entering a warm and cozy REPL\n")
+ (start-repl)))))
+
;;; linux-initrd.scm ends here
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 1b09da45c7..6e2b296d81 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.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.
;;;
@@ -103,21 +103,26 @@ single leaf."
(leaf leaf))))
(define (file=? file1 file2)
- "Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise."
- (and (= (stat:size (stat file1)) (stat:size (stat file2)))
- (call-with-input-file file1
- (lambda (port1)
- (call-with-input-file file2
- (lambda (port2)
- (define len 8192)
- (define buf1 (make-bytevector len))
- (define buf2 (make-bytevector len))
- (let loop ()
- (let ((n1 (get-bytevector-n! port1 buf1 0 len))
- (n2 (get-bytevector-n! port2 buf2 0 len)))
- (and (equal? n1 n2)
- (or (eof-object? n1)
- (loop)))))))))))
+ "Return #t if FILE1 and FILE2 are regular files and their contents are
+identical, #f otherwise."
+ (let ((st1 (stat file1))
+ (st2 (stat file2)))
+ (and (eq? (stat:type st1) 'regular)
+ (eq? (stat:type st2) 'regular)
+ (= (stat:size st1) (stat:size st2))
+ (call-with-input-file file1
+ (lambda (port1)
+ (call-with-input-file file2
+ (lambda (port2)
+ (define len 8192)
+ (define buf1 (make-bytevector len))
+ (define buf2 (make-bytevector len))
+ (let loop ()
+ (let ((n1 (get-bytevector-n! port1 buf1 0 len))
+ (n2 (get-bytevector-n! port2 buf2 0 len)))
+ (and (equal? n1 n2)
+ (or (eof-object? n1)
+ (loop))))))))))))
(define* (union-build output directories
#:key (log-port (current-error-port)))
diff --git a/guix/derivations.scm b/guix/derivations.scm
index ae68bb1194..b47ab93759 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -47,6 +47,7 @@
derivation-output-path
derivation-output-hash-algo
derivation-output-hash
+ derivation-output-recursive?
<derivation-input>
derivation-input?
@@ -91,11 +92,12 @@
(file-name derivation-file-name)) ; the .drv file name
(define-record-type <derivation-output>
- (make-derivation-output path hash-algo hash)
+ (make-derivation-output path hash-algo hash recursive?)
derivation-output?
(path derivation-output-path) ; store path
(hash-algo derivation-output-hash-algo) ; symbol | #f
- (hash derivation-output-hash)) ; bytevector | #f
+ (hash derivation-output-hash) ; bytevector | #f
+ (recursive? derivation-output-recursive?)) ; Boolean
(define-record-type <derivation-input>
(make-derivation-input path sub-derivations)
@@ -241,14 +243,19 @@ that second value is the empty list."
(match output
((name path "" "")
(alist-cons name
- (make-derivation-output path #f #f)
+ (make-derivation-output path #f #f #f)
result))
((name path hash-algo hash)
;; fixed-output
- (let ((algo (string->symbol hash-algo))
- (hash (base16-string->bytevector hash)))
+ (let* ((rec? (string-prefix? "r:" hash-algo))
+ (algo (string->symbol
+ (if rec?
+ (string-drop hash-algo 2)
+ hash-algo)))
+ (hash (base16-string->bytevector hash)))
(alist-cons name
- (make-derivation-output path algo hash)
+ (make-derivation-output path algo
+ hash rec?)
result)))))
'()
x))
@@ -368,9 +375,12 @@ that form."
(define (write-output output port)
(match output
- ((name . ($ <derivation-output> path hash-algo hash))
+ ((name . ($ <derivation-output> path hash-algo hash recursive?))
(write-tuple (list name path
- (or (and=> hash-algo symbol->string) "")
+ (if hash-algo
+ (string-append (if recursive? "r:" "")
+ (symbol->string hash-algo))
+ "")
(or (and=> hash bytevector->base16-string)
""))
write
@@ -476,11 +486,14 @@ in SIZE bytes."
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
(match drv
(($ <derivation> ((_ . ($ <derivation-output> path
- (? symbol? hash-algo) (? bytevector? hash)))))
+ (? symbol? hash-algo) (? bytevector? hash)
+ (? boolean? recursive?)))))
;; A fixed-output derivation.
(sha256
(string->utf8
- (string-append "fixed:out:" (symbol->string hash-algo)
+ (string-append "fixed:out:"
+ (if recursive? "r:" "")
+ (symbol->string hash-algo)
":" (bytevector->base16-string hash)
":" path))))
(($ <derivation> outputs inputs sources
@@ -527,17 +540,33 @@ the derivation called NAME with hash HASH."
name
(string-append name "-" output))))
+(define (fixed-output-path output hash-algo hash recursive? name)
+ "Return an output path for the fixed output OUTPUT defined by HASH of type
+HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
+'add-to-store'."
+ (if (and recursive? (eq? hash-algo 'sha256))
+ (store-path "source" hash name)
+ (let ((tag (string-append "fixed:" output ":"
+ (if recursive? "r:" "")
+ (symbol->string hash-algo) ":"
+ (bytevector->base16-string hash) ":")))
+ (store-path (string-append "output:" output)
+ (sha256 (string->utf8 tag))
+ name))))
+
(define* (derivation store name builder args
#:key
(system (%current-system)) (env-vars '())
(inputs '()) (outputs '("out"))
- hash hash-algo hash-mode
+ hash hash-algo recursive?
references-graphs
local-build?)
"Build a derivation with the given arguments, and return the resulting
-<derivation> object. When HASH, HASH-ALGO, and HASH-MODE are given, a
+<derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in
-advance, such as a file download.
+advance, such as a file download. If, in addition, RECURSIVE? is true, then
+that fixed output may be an executable file or a directory and HASH must be
+the hash of an archive containing this output.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs. In that case, the reference graph of each store path is exported in
@@ -555,12 +584,16 @@ derivations where the costs of data transfers would outweigh the benefits."
(let* ((drv-hash (derivation-hash drv))
(outputs (map (match-lambda
((output-name . ($ <derivation-output>
- _ algo hash))
- (let ((path (output-path output-name
- drv-hash name)))
+ _ algo hash rec?))
+ (let ((path (if hash
+ (fixed-output-path output-name
+ algo hash
+ rec? name)
+ (output-path output-name
+ drv-hash name))))
(cons output-name
(make-derivation-output path algo
- hash)))))
+ hash rec?)))))
outputs)))
(make-derivation outputs inputs sources system builder args
(map (match-lambda
@@ -618,7 +651,8 @@ derivations where the costs of data transfers would outweigh the benefits."
(let* ((outputs (map (lambda (name)
;; Return outputs with an empty path.
(cons name
- (make-derivation-output "" hash-algo hash)))
+ (make-derivation-output "" hash-algo
+ hash recursive?)))
outputs))
(inputs (map (match-lambda
(((? derivation? drv))
@@ -911,7 +945,7 @@ they can refer to each other."
(system (%current-system))
(inputs '())
(outputs '("out"))
- hash hash-algo
+ hash hash-algo recursive?
(env-vars '())
(modules '())
guile-for-build
@@ -1058,6 +1092,7 @@ LOCAL-BUILD?."
env-vars)
#:hash hash #:hash-algo hash-algo
+ #:recursive? recursive?
#:outputs outputs
#:references-graphs references-graphs
#:local-build? local-build?)))
diff --git a/guix/download.scm b/guix/download.scm
index 8a3e9fd06a..2cc8a4a5b8 100644
--- a/guix/download.scm
+++ b/guix/download.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>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
@@ -108,7 +108,10 @@
"ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/"
"http://apache.belnet.be/"
"http://mirrors.ircam.fr/pub/apache/"
- "http://apache-mirror.rbc.ru/pub/apache/")
+ "http://apache-mirror.rbc.ru/pub/apache/"
+
+ ;; As a last resort, try the archive.
+ "http://archive.apache.org/dist/")
(xorg ; from http://www.x.org/wiki/Releases/Download
"http://www.x.org/releases/" ; main mirrors
"ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America
diff --git a/guix/git-download.scm b/guix/git-download.scm
new file mode 100644
index 0000000000..472bf756ce
--- /dev/null
+++ b/guix/git-download.scm
@@ -0,0 +1,89 @@
+;;; 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 git-download)
+ #:use-module (guix records)
+ #:use-module (guix derivations)
+ #:use-module (guix packages)
+ #:use-module (ice-9 match)
+ #:export (git-reference
+ git-reference?
+ git-reference-url
+ git-reference-commit
+
+ git-fetch))
+
+;;; Commentary:
+;;;
+;;; An <origin> method that fetches a specific commit from a Git repository.
+;;; The repository URL and commit hash are specified with a <git-reference>
+;;; object.
+;;;
+;;; Code:
+
+(define-record-type* <git-reference>
+ git-reference make-git-reference
+ git-reference?
+ (url git-reference-url)
+ (commit git-reference-commit))
+
+(define* (git-fetch store ref hash-algo hash
+ #:optional name
+ #:key (system (%current-system)) guile git)
+ "Return a fixed-output derivation in STORE that fetches REF, a
+<git-reference> object. The output is expected to have recursive hash HASH of
+type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if
+#f."
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages base)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system)))))
+
+ (define git-for-build
+ (match git
+ ((? package?)
+ (package-derivation store git system))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages version-control)))
+ (git (module-ref distro 'git)))
+ (package-derivation store git system)))))
+
+ (let* ((command (string-append (derivation->output-path git-for-build)
+ "/bin/git"))
+ (builder `(begin
+ (use-modules (guix build git))
+ (git-fetch ',(git-reference-url ref)
+ ',(git-reference-commit ref)
+ %output
+ #:git-command ',command))))
+ (build-expression->derivation store (or name "git-checkout") builder
+ #:system system
+ #:local-build? #t
+ #:inputs `(("git" ,git-for-build))
+ #:hash-algo hash-algo
+ #:hash hash
+ #:recursive? #t
+ #:modules '((guix build git)
+ (guix build utils))
+ #:guile-for-build guile-for-build)))
+
+;;; git-download.scm ends here
diff --git a/guix/monads.scm b/guix/monads.scm
index 410fdbecb2..db8b645402 100644
--- a/guix/monads.scm
+++ b/guix/monads.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,6 +23,7 @@
#:use-module ((system syntax)
#:select (syntax-local-binding))
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:export (;; Monads.
@@ -53,11 +54,14 @@
store-lift
run-with-store
text-file
+ text-file*
package-file
package->derivation
built-derivations
derivation-expression
- lower-inputs))
+ lower-inputs)
+ #:replace (imported-modules
+ compiled-modules))
;;; Commentary:
;;;
@@ -303,14 +307,63 @@ in the store monad."
(define* (text-file name text)
"Return as a monadic value the absolute file name in the store of the file
-containing TEXT."
+containing TEXT, a string."
(lambda (store)
(add-text-to-store store name text '())))
+(define* (text-file* name #:rest text)
+ "Return as a monadic value a derivation that builds a text file containing
+all of TEXT. TEXT may list, in addition to strings, packages, derivations,
+and store file names; the resulting store file holds references to all these."
+ (define inputs
+ ;; Transform packages and derivations from TEXT into a valid input list.
+ (filter-map (match-lambda
+ ((? package? p) `("x" ,p))
+ ((? derivation? d) `("x" ,d))
+ ((x ...) `("x" ,@x))
+ ((? string? s)
+ (and (direct-store-path? s) `("x" ,s)))
+ (x x))
+ text))
+
+ (define (computed-text text inputs)
+ ;; Using the lowered INPUTS, return TEXT with derivations replaced with
+ ;; their output file name.
+ (define (real-string? s)
+ (and (string? s) (not (direct-store-path? s))))
+
+ (let loop ((inputs inputs)
+ (text text)
+ (result '()))
+ (match text
+ (()
+ (string-concatenate-reverse result))
+ (((? real-string? head) rest ...)
+ (loop inputs rest (cons head result)))
+ ((_ rest ...)
+ (match inputs
+ (((_ (? derivation? drv) sub-drv ...) inputs ...)
+ (loop inputs rest
+ (cons (apply derivation->output-path drv
+ sub-drv)
+ result)))
+ (((_ file) inputs ...)
+ ;; FILE is the result of 'add-text-to-store' or so.
+ (loop inputs rest (cons file result))))))))
+
+ (define (builder inputs)
+ `(call-with-output-file (assoc-ref %outputs "out")
+ (lambda (port)
+ (display ,(computed-text text inputs) port))))
+
+ (mlet %store-monad ((inputs (lower-inputs inputs)))
+ (derivation-expression name (builder inputs)
+ #:inputs inputs)))
+
(define* (package-file package
#:optional file
#:key (system (%current-system)) (output "out"))
- "Return as a monadic value in the absolute file name of FILE within the
+ "Return as a monadic value the absolute file name of FILE within the
OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
OUTPUT directory of PACKAGE."
(lambda (store)
@@ -342,6 +395,12 @@ input list as a monadic value."
(define package->derivation
(store-lift package-derivation))
+(define imported-modules
+ (store-lift (@ (guix derivations) imported-modules)))
+
+(define compiled-modules
+ (store-lift (@ (guix derivations) compiled-modules)))
+
(define built-derivations
(store-lift build-derivations))
diff --git a/guix/nar.scm b/guix/nar.scm
index 4bc2deb229..5bf174554c 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -112,7 +112,8 @@
(write-long-long size p)
(call-with-binary-input-file file
;; Use `sendfile' when available (Guile 2.0.8+).
- (if (compile-time-value (defined? 'sendfile))
+ (if (and (compile-time-value (defined? 'sendfile))
+ (file-port? p))
(cut sendfile p <> size 0)
(cut dump <> p size)))
(write-padding size p))
@@ -176,8 +177,13 @@ sub-directories of FILE as needed."
((directory)
(write-string "type" p)
(write-string "directory" p)
- (let ((entries (remove (cut member <> '("." ".."))
- (scandir f))))
+ (let* ((select? (negate (cut member <> '("." ".."))))
+
+ ;; 'scandir' defaults to 'string-locale<?' to sort files, but
+ ;; this happens to be case-insensitive (at least in 'en_US'
+ ;; locale on libc 2.18.) Conversely, we want files to be
+ ;; sorted in a case-sensitive fashion.
+ (entries (scandir f select? string<?)))
(for-each (lambda (e)
(let ((f (string-append f "/" e)))
(write-string "entry" p)
@@ -194,8 +200,8 @@ sub-directories of FILE as needed."
(write-string "target" p)
(write-string (readlink f) p))
(else
- (raise (condition (&message (message "ENOSYS"))
- (&nar-error)))))
+ (raise (condition (&message (message "unsupported file type"))
+ (&nar-error (file f) (port port))))))
(write-string ")" p))))
(define (restore-file port file)
diff --git a/guix/packages.scm b/guix/packages.scm
index daf431f5e4..d345900f79 100644
--- a/guix/packages.scm
+++ b/guix/packages.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.
;;;
@@ -106,7 +106,7 @@
origin make-origin
origin?
(uri origin-uri) ; string
- (method origin-method) ; symbol
+ (method origin-method) ; procedure
(sha256 origin-sha256) ; bytevector
(file-name origin-file-name (default #f)) ; optional file name
(patches origin-patches (default '())) ; list of file names
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 32690c6b45..4788468584 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -71,17 +71,10 @@ Export/import one or more packages from/to the store.\n"))
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
(display (_ "
--target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
- (display (_ "
- -n, --dry-run do not build the derivations"))
- (display (_ "
- --fallback fall back to building when the substituter fails"))
- (display (_ "
- --no-substitutes build instead of resorting to pre-built substitutes"))
- (display (_ "
- --max-silent-time=SECONDS
- mark the build as failed after SECONDS of silence"))
- (display (_ "
- -c, --cores=N allow the use of up to N CPU cores for the build"))
+
+ (newline)
+ (show-build-options-help)
+
(newline)
(display (_ "
-h, --help display this help and exit"))
@@ -92,81 +85,60 @@ Export/import one or more packages from/to the store.\n"))
(define %options
;; Specifications of the command-line options.
- (list (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix build")))
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix build")))
- (option '("export") #f #f
- (lambda (opt name arg result)
- (alist-cons 'export #t result)))
- (option '("import") #f #f
- (lambda (opt name arg result)
- (alist-cons 'import #t result)))
- (option '("missing") #f #f
- (lambda (opt name arg result)
- (alist-cons 'missing #t result)))
- (option '("generate-key") #f #t
- (lambda (opt name arg result)
- (catch 'gcry-error
- (lambda ()
- (let ((params
- (string->canonical-sexp
- (or arg "(genkey (rsa (nbits 4:4096)))"))))
- (alist-cons 'generate-key params result)))
- (lambda args
- (leave (_ "invalid key generation parameters: ~s~%")
- arg)))))
- (option '("authorize") #f #f
- (lambda (opt name arg result)
- (alist-cons 'authorize #t result)))
+ (option '("export") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'export #t result)))
+ (option '("import") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'import #t result)))
+ (option '("missing") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'missing #t result)))
+ (option '("generate-key") #f #t
+ (lambda (opt name arg result)
+ (catch 'gcry-error
+ (lambda ()
+ (let ((params
+ (string->canonical-sexp
+ (or arg "(genkey (rsa (nbits 4:4096)))"))))
+ (alist-cons 'generate-key params result)))
+ (lambda args
+ (leave (_ "invalid key generation parameters: ~s~%")
+ arg)))))
+ (option '("authorize") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'authorize #t result)))
- (option '(#\S "source") #f #f
- (lambda (opt name arg result)
- (alist-cons 'source? #t result)))
- (option '(#\s "system") #t #f
- (lambda (opt name arg result)
- (alist-cons 'system arg
- (alist-delete 'system result eq?))))
- (option '("target") #t #f
- (lambda (opt name arg result)
- (alist-cons 'target arg
- (alist-delete 'target result eq?))))
- (option '(#\e "expression") #t #f
- (lambda (opt name arg result)
- (alist-cons 'expression arg result)))
- (option '(#\c "cores") #t #f
- (lambda (opt name arg result)
- (let ((c (false-if-exception (string->number arg))))
- (if c
- (alist-cons 'cores c result)
- (leave (_ "~a: not a number~%") arg)))))
- (option '(#\n "dry-run") #f #f
- (lambda (opt name arg result)
- (alist-cons 'dry-run? #t result)))
- (option '("fallback") #f #f
- (lambda (opt name arg result)
- (alist-cons 'fallback? #t
- (alist-delete 'fallback? result))))
- (option '("no-substitutes") #f #f
- (lambda (opt name arg result)
- (alist-cons 'substitutes? #f
- (alist-delete 'substitutes? result))))
- (option '("max-silent-time") #t #f
- (lambda (opt name arg result)
- (alist-cons 'max-silent-time (string->number* arg)
- result)))
- (option '(#\r "root") #t #f
- (lambda (opt name arg result)
- (alist-cons 'gc-root arg result)))
- (option '("verbosity") #t #f
- (lambda (opt name arg result)
- (let ((level (string->number arg)))
- (alist-cons 'verbosity level
- (alist-delete 'verbosity result)))))))
+ (option '(#\S "source") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'source? #t result)))
+ (option '(#\s "system") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'system arg
+ (alist-delete 'system result eq?))))
+ (option '("target") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'target arg
+ (alist-delete 'target result eq?))))
+ (option '(#\e "expression") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'expression arg result)))
+ (option '(#\n "dry-run") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'dry-run? #t result)))
+ (option '(#\r "root") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'gc-root arg result)))
+
+ %standard-build-options))
(define (options->derivations+files store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -219,16 +191,11 @@ build and a list of store files to transfer."
resulting archive to the standard output port."
(let-values (((drv files)
(options->derivations+files store opts)))
+ (set-build-options-from-command-line store opts)
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?))
- (set-build-options store
- #:build-cores (or (assoc-ref opts 'cores) 0)
- #:fallback? (assoc-ref opts 'fallback?)
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:max-silent-time (assoc-ref opts 'max-silent-time))
-
(if (or (assoc-ref opts 'dry-run?)
(build-derivations store drv))
(export-paths store files (current-output-port))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 7cb3710853..4a00505022 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -34,6 +34,11 @@
#:use-module (srfi srfi-37)
#:autoload (gnu packages) (find-best-packages-by-name)
#:export (derivation-from-expression
+
+ %standard-build-options
+ set-build-options-from-command-line
+ show-build-options-help
+
guix-build))
(define (derivation-from-expression store str package-derivation
@@ -101,30 +106,13 @@ present, return the preferred newest version."
;;;
-;;; Command-line options.
+;;; Standard command-line build options.
;;;
-(define %default-options
- ;; Alist of default option values.
- `((system . ,(%current-system))
- (substitutes? . #t)
- (build-hook? . #t)
- (max-silent-time . 3600)
- (verbosity . 0)))
-
-(define (show-help)
- (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
-Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
- (display (_ "
- -e, --expression=EXPR build the package or derivation EXPR evaluates to"))
- (display (_ "
- -S, --source build the packages' source derivations"))
- (display (_ "
- -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
- (display (_ "
- --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
- (display (_ "
- -d, --derivations return the derivation paths of the given packages"))
+(define (show-build-options-help)
+ "Display on the current output port help about the standard command-line
+options handled by 'set-build-options-from-command-line', and listed in
+'%standard-build-options'."
(display (_ "
-K, --keep-failed keep build tree of failed builds"))
(display (_ "
@@ -139,61 +127,28 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
(display (_ "
- -c, --cores=N allow the use of up to N CPU cores for the build"))
- (display (_ "
- -r, --root=FILE make FILE a symlink to the result, and register it
- as a garbage collector root"))
- (display (_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
(display (_ "
- --log-file return the log file names for the given derivations"))
- (newline)
- (display (_ "
- -h, --help display this help and exit"))
- (display (_ "
- -V, --version display version information and exit"))
- (newline)
- (show-bug-report-information))
+ -c, --cores=N allow the use of up to N CPU cores for the build")))
-(define %options
- ;; Specifications of the command-line options.
- (list (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix build")))
+(define (set-build-options-from-command-line store opts)
+ "Given OPTS, an alist as returned by 'args-fold' given
+'%standard-build-options', set the corresponding build options on STORE."
+ ;; TODO: Add more options.
+ (set-build-options store
+ #:keep-failed? (assoc-ref opts 'keep-failed?)
+ #:build-cores (or (assoc-ref opts 'cores) 0)
+ #:fallback? (assoc-ref opts 'fallback?)
+ #:use-substitutes? (assoc-ref opts 'substitutes?)
+ #:use-build-hook? (assoc-ref opts 'build-hook?)
+ #:max-silent-time (assoc-ref opts 'max-silent-time)
+ #:verbosity (assoc-ref opts 'verbosity)))
- (option '(#\S "source") #f #f
- (lambda (opt name arg result)
- (alist-cons 'source? #t result)))
- (option '(#\s "system") #t #f
- (lambda (opt name arg result)
- (alist-cons 'system arg
- (alist-delete 'system result eq?))))
- (option '("target") #t #f
- (lambda (opt name arg result)
- (alist-cons 'target arg
- (alist-delete 'target result eq?))))
- (option '(#\d "derivations") #f #f
- (lambda (opt name arg result)
- (alist-cons 'derivations-only? #t result)))
- (option '(#\e "expression") #t #f
- (lambda (opt name arg result)
- (alist-cons 'expression arg result)))
- (option '(#\K "keep-failed") #f #f
+(define %standard-build-options
+ ;; List of standard command-line options for tools that build something.
+ (list (option '(#\K "keep-failed") #f #f
(lambda (opt name arg result)
(alist-cons 'keep-failed? #t result)))
- (option '(#\c "cores") #t #f
- (lambda (opt name arg result)
- (let ((c (false-if-exception (string->number arg))))
- (if c
- (alist-cons 'cores c result)
- (leave (_ "~a: not a number~%") arg)))))
- (option '(#\n "dry-run") #f #f
- (lambda (opt name arg result)
- (alist-cons 'dry-run? #t result)))
(option '("fallback") #f #f
(lambda (opt name arg result)
(alist-cons 'fallback? #t
@@ -210,17 +165,97 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(lambda (opt name arg result)
(alist-cons 'max-silent-time (string->number* arg)
result)))
- (option '(#\r "root") #t #f
- (lambda (opt name arg result)
- (alist-cons 'gc-root arg result)))
(option '("verbosity") #t #f
(lambda (opt name arg result)
(let ((level (string->number arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))
- (option '("log-file") #f #f
+ (option '(#\c "cores") #t #f
(lambda (opt name arg result)
- (alist-cons 'log-file? #t result)))))
+ (let ((c (false-if-exception (string->number arg))))
+ (if c
+ (alist-cons 'cores c result)
+ (leave (_ "~a: not a number~%") arg)))))))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ ;; Alist of default option values.
+ `((system . ,(%current-system))
+ (substitutes? . #t)
+ (build-hook? . #t)
+ (max-silent-time . 3600)
+ (verbosity . 0)))
+
+(define (show-help)
+ (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
+Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
+ (display (_ "
+ -e, --expression=EXPR build the package or derivation EXPR evaluates to"))
+ (display (_ "
+ -S, --source build the packages' source derivations"))
+ (display (_ "
+ -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
+ (display (_ "
+ --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
+ (display (_ "
+ -d, --derivations return the derivation paths of the given packages"))
+ (display (_ "
+ -r, --root=FILE make FILE a symlink to the result, and register it
+ as a garbage collector root"))
+ (display (_ "
+ --log-file return the log file names for the given derivations"))
+ (newline)
+ (show-build-options-help)
+ (newline)
+ (display (_ "
+ -h, --help display this help and exit"))
+ (display (_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specifications of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix build")))
+
+ (option '(#\S "source") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'source? #t result)))
+ (option '(#\s "system") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'system arg
+ (alist-delete 'system result eq?))))
+ (option '("target") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'target arg
+ (alist-delete 'target result eq?))))
+ (option '(#\d "derivations") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'derivations-only? #t result)))
+ (option '(#\e "expression") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'expression arg result)))
+ (option '(#\n "dry-run") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'dry-run? #t result)))
+ (option '(#\r "root") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'gc-root arg result)))
+ (option '("log-file") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'log-file? #t result)))
+
+ %standard-build-options))
(define (options->derivations store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -279,21 +314,12 @@ build."
(_ #f))
opts)))
+ (set-build-options-from-command-line store opts)
(unless (assoc-ref opts 'log-file?)
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?)))
- ;; TODO: Add more options.
- (set-build-options store
- #:keep-failed? (assoc-ref opts 'keep-failed?)
- #:build-cores (or (assoc-ref opts 'cores) 0)
- #:fallback? (assoc-ref opts 'fallback?)
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:use-build-hook? (assoc-ref opts 'build-hook?)
- #:max-silent-time (assoc-ref opts 'max-silent-time)
- #:verbosity (assoc-ref opts 'verbosity))
-
(cond ((assoc-ref opts 'log-file?)
(for-each (lambda (file)
(let ((log (log-file store file)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index ca3928b8e3..ea8c2ada6b 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.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>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
@@ -20,12 +20,14 @@
(define-module (guix scripts hash)
#:use-module (guix base32)
#:use-module (guix hash)
+ #:use-module (guix nar)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (rnrs io ports)
#:use-module (rnrs files)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:export (guix-hash))
@@ -43,10 +45,12 @@
(display (_ "Usage: guix hash [OPTION] FILE
Return the cryptographic hash of FILE.
-Supported formats: 'nix-base32' (default), 'base32', and 'base16'
-('hex' and 'hexadecimal' can be used as well).\n"))
+Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex'
+and 'hexadecimal' can be used as well).\n"))
(format #t (_ "
-f, --format=FMT write the hash in the given format"))
+ (format #t (_ "
+ -r, --recursive compute the hash on FILE recursively"))
(newline)
(display (_ "
-h, --help display this help and exit"))
@@ -73,6 +77,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(alist-cons 'format fmt-proc
(alist-delete 'format result))))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive? #t result)))
(option '(#\h "help") #f #f
(lambda args
@@ -99,11 +106,6 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(alist-cons 'argument arg result))
%default-options))
- (define (eof->null x)
- (if (eof-object? x)
- #vu8()
- x))
-
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@@ -112,13 +114,22 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(reverse opts)))
(fmt (assq-ref opts 'format)))
+ (define (file-hash file)
+ ;; Compute the hash of FILE.
+ ;; Catch and gracefully report possible '&nar-error' conditions.
+ (with-error-handling
+ (if (assoc-ref opts 'recursive?)
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file file port)
+ (flush-output-port port)
+ (get-hash))
+ (call-with-input-file file port-sha256))))
+
(match args
((file)
(catch 'system-error
(lambda ()
- (format #t "~a~%"
- (call-with-input-file file
- (compose fmt sha256 eof->null get-bytevector-all))))
+ (format #t "~a~%" (fmt (file-hash file))))
(lambda args
(leave (_ "~a~%")
(strerror (system-error-errno args))))))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index d919ede3c7..00a145e5e9 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -108,7 +108,7 @@ determined."
(save-module-excursion
(lambda ()
(set-current-module %user-module)
- (primitive-load %machine-file))))
+ (primitive-load file))))
(lambda args
(match args
(('system-error . _)
@@ -117,10 +117,10 @@ determined."
(if (= ENOENT err)
'()
(leave (_ "failed to open machine file '~a': ~a~%")
- %machine-file (strerror err)))))
+ file (strerror err)))))
(_
(leave (_ "failed to load machine file '~a': ~s~%")
- %machine-file args))))))
+ file args))))))
(define (open-ssh-gateway machine)
"Initiate an SSH connection gateway to MACHINE, and return the PID of the
@@ -170,9 +170,9 @@ running lsh gateway upon success, or #f on failure."
(define* (offload drv machine
#:key print-build-trace? (max-silent-time 3600)
- (build-timeout 7200))
+ (build-timeout 7200) (log-port (current-output-port)))
"Perform DRV on MACHINE, assuming DRV and its prerequisites are available
-there. Return a read pipe from where to read the build log."
+there, and write the build log to LOG-PORT. Return the exit status."
(format (current-error-port) "offloading '~a' to '~a'...~%"
(derivation-file-name drv) (build-machine-name machine))
(format (current-error-port) "@ build-remote ~a ~a~%"
@@ -185,7 +185,13 @@ there. Return a read pipe from where to read the build log."
,(format #f "--max-silent-time=~a"
max-silent-time)
,(derivation-file-name drv)))))
- pipe))
+ (let loop ((line (read-line pipe)))
+ (unless (eof-object? line)
+ (display line log-port)
+ (newline log-port)
+ (loop (read-line pipe))))
+
+ (close-pipe pipe)))
(define (send-files files machine)
"Send the subset of FILES that's missing to MACHINE's store. Return #t on
@@ -291,20 +297,25 @@ success, #f otherwise."
(outputs (string-tokenize (read-line))))
(when (send-files (cons (derivation-file-name drv) inputs)
machine)
- (let ((log (offload drv machine
- #:print-build-trace? print-build-trace?
- #:max-silent-time max-silent-time
- #:build-timeout build-timeout)))
- (let loop ((line (read-line log)))
- (if (eof-object? line)
- (close-pipe log)
- (begin
- (display line) (newline)
- (loop (read-line log))))))
- (retrieve-files outputs machine)))
- (format (current-error-port) "done with offloaded '~a'~%"
- (derivation-file-name drv))
- (kill pid SIGTERM))
+ (let ((status (offload drv machine
+ #:print-build-trace? print-build-trace?
+ #:max-silent-time max-silent-time
+ #:build-timeout build-timeout)))
+ (kill pid SIGTERM)
+ (if (zero? status)
+ (begin
+ (retrieve-files outputs machine)
+ (format (current-error-port)
+ "done with offloaded '~a'~%"
+ (derivation-file-name drv)))
+ (begin
+ (format (current-error-port)
+ "derivation '~a' offloaded to '~a' failed \
+with exit code ~a~%"
+ (derivation-file-name drv)
+ (build-machine-name machine)
+ (status:exit-val status))
+ (primitive-exit (status:exit-val status))))))))
(#f
(display "# decline\n")))
(display "# decline\n"))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
new file mode 100644
index 0000000000..7799ccbc47
--- /dev/null
+++ b/guix/scripts/system.scm
@@ -0,0 +1,148 @@
+;;; 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 scripts system)
+ #:use-module (guix ui)
+ #:use-module (guix store)
+ #:use-module (guix derivations)
+ #:use-module (guix packages)
+ #:use-module (guix utils)
+ #:use-module (guix monads)
+ #:use-module (guix scripts build)
+ #:use-module (gnu system vm)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:export (guix-system))
+
+(define %user-module
+ ;; Module in which the machine description file is loaded.
+ (let ((module (make-fresh-user-module)))
+ (for-each (lambda (iface)
+ (module-use! module (resolve-interface iface)))
+ '((gnu system)
+ (gnu services)
+ (gnu system shadow)))
+ module))
+
+(define (read-operating-system file)
+ "Read the operating-system declaration from FILE and return it."
+ ;; TODO: Factorize.
+ (catch #t
+ (lambda ()
+ ;; Avoid ABI incompatibility with the <operating-system> record.
+ (set! %fresh-auto-compile #t)
+
+ (save-module-excursion
+ (lambda ()
+ (set-current-module %user-module)
+ (primitive-load file))))
+ (lambda args
+ (match args
+ (('system-error . _)
+ (let ((err (system-error-errno args)))
+ (leave (_ "failed to open operating system file '~a': ~a~%")
+ file (strerror err))))
+ (_
+ (leave (_ "failed to load machine file '~a': ~s~%")
+ file args))))))
+
+
+;;;
+;;; Options.
+;;;
+
+(define (show-help)
+ (display (_ "Usage: guix system [OPTION] ACTION FILE
+Build the operating system declared in FILE according to ACTION.\n"))
+ (display (_ "Currently the only valid value for ACTION is 'vm', which builds
+a virtual machine of the given operating system.\n"))
+ (show-build-options-help)
+ (newline)
+ (display (_ "
+ -h, --help display this help and exit"))
+ (display (_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specifications of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix system")))
+ (option '(#\n "dry-run") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'dry-run? #t result)))
+ %standard-build-options))
+
+(define %default-options
+ ;; Alist of default option values.
+ `((system . ,(%current-system))
+ (substitutes? . #t)
+ (build-hook? . #t)
+ (max-silent-time . 3600)
+ (verbosity . 0)))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-system . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (if (assoc-ref result 'action)
+ (let ((previous (assoc-ref result 'argument)))
+ (if previous
+ (leave (_ "~a: extraneous argument~%") previous)
+ (alist-cons 'argument arg result)))
+ (let ((action (string->symbol arg)))
+ (case action
+ ((vm) (alist-cons 'action action result))
+ (else (leave (_ "~a: unknown action~%")
+ action))))))
+ %default-options))
+
+ (with-error-handling
+ (let* ((opts (parse-options))
+ (file (assoc-ref opts 'argument))
+ (os (if file
+ (read-operating-system file)
+ (leave (_ "no configuration file specified~%"))))
+ (mdrv (system-qemu-image/shared-store-script os))
+ (store (open-connection))
+ (dry? (assoc-ref opts 'dry-run?))
+ (drv (run-with-store store mdrv)))
+ (set-build-options-from-command-line store opts)
+ (show-what-to-build store (list drv)
+ #:dry-run? dry?
+ #:use-substitutes? (assoc-ref opts 'substitutes?))
+
+ (unless dry?
+ (build-derivations store (list drv))
+ (display (derivation->output-path drv))
+ (newline)))))
diff --git a/guix/store.scm b/guix/store.scm
index eca0de7d97..8e88c5f86d 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -100,8 +100,8 @@
(define %protocol-version #x10c)
-(define %worker-magic-1 #x6e697863)
-(define %worker-magic-2 #x6478696f)
+(define %worker-magic-1 #x6e697863) ; "nixc"
+(define %worker-magic-2 #x6478696f) ; "dxio"
(define (protocol-major magic)
(logand magic #xff00))
@@ -732,10 +732,10 @@ is raised if the set of paths read from PORT is not signed (as per
(= 1 (read-int s))))
(define* (export-paths server paths port #:key (sign? #t))
- "Export the store paths listed in PATHS to PORT, signing them if SIGN?
-is true."
+ "Export the store paths listed in PATHS to PORT, in topological order,
+signing them if SIGN? is true."
(let ((s (nix-server-socket server)))
- (let loop ((paths paths))
+ (let loop ((paths (topologically-sorted server paths)))
(match paths
(()
(write-int 0 port))
diff --git a/guix/ui.scm b/guix/ui.scm
index d6058f806b..c232b32674 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -31,6 +31,7 @@
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:autoload (ice-9 ftw) (scandir)
#:use-module (ice-9 match)
@@ -186,7 +187,10 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
((nix-protocol-error? c)
;; FIXME: Server-provided error messages aren't i18n'd.
(leave (_ "build failed: ~a~%")
- (nix-protocol-error-message c))))
+ (nix-protocol-error-message c)))
+ ((message-condition? c)
+ ;; Normally '&message' error conditions have an i18n'd message.
+ (leave (_ "~a~%") (gettext (condition-message c)))))
;; Catch EPIPE and the likes.
(catch 'system-error
thunk
diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc
index d35b1cd076..79cd080363 100644
--- a/nix/nix-daemon/guix-daemon.cc
+++ b/nix/nix-daemon/guix-daemon.cc
@@ -30,6 +30,7 @@
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
+#include <strings.h>
#include <exception>
/* Variables used by `nix-daemon.cc'. */
@@ -68,6 +69,8 @@ builds derivations on behalf of its clients.";
#define GUIX_OPT_LISTEN 11
#define GUIX_OPT_NO_SUBSTITUTES 12
#define GUIX_OPT_NO_BUILD_HOOK 13
+#define GUIX_OPT_GC_KEEP_OUTPUTS 14
+#define GUIX_OPT_GC_KEEP_DERIVATIONS 15
static const struct argp_option options[] =
{
@@ -111,6 +114,14 @@ static const struct argp_option options[] =
" (this option has no effect in this configuration)"
#endif
},
+ { "gc-keep-outputs", GUIX_OPT_GC_KEEP_OUTPUTS,
+ "yes/no", OPTION_ARG_OPTIONAL,
+ "Tell whether the GC must keep outputs of live derivations" },
+ { "gc-keep-derivations", GUIX_OPT_GC_KEEP_DERIVATIONS,
+ "yes/no", OPTION_ARG_OPTIONAL,
+ "Tell whether the GC must keep derivations corresponding \
+to live outputs" },
+
{ "listen", GUIX_OPT_LISTEN, "SOCKET", 0,
"Listen for connections on SOCKET" },
{ "debug", GUIX_OPT_DEBUG, 0, 0,
@@ -118,6 +129,22 @@ static const struct argp_option options[] =
{ 0, 0, 0, 0, 0 }
};
+
+/* Convert ARG to a Boolean value, or throw an error if it does not denote a
+ Boolean. */
+static bool
+string_to_bool (const char *arg, bool dflt = true)
+{
+ if (arg == NULL)
+ return dflt;
+ else if (strcasecmp (arg, "yes") == 0)
+ return true;
+ else if (strcasecmp (arg, "no") == 0)
+ return false;
+ else
+ throw nix::Error (format ("'%1%': invalid Boolean value") % arg);
+}
+
/* Parse a single option. */
static error_t
parse_opt (int key, char *arg, struct argp_state *state)
@@ -168,6 +195,12 @@ parse_opt (int key, char *arg, struct argp_state *state)
case GUIX_OPT_DEBUG:
verbosity = lvlDebug;
break;
+ case GUIX_OPT_GC_KEEP_OUTPUTS:
+ settings.gcKeepOutputs = string_to_bool (arg);
+ break;
+ case GUIX_OPT_GC_KEEP_DERIVATIONS:
+ settings.gcKeepDerivations = string_to_bool (arg);
+ break;
case 'c':
settings.buildCores = atoi (arg);
break;
diff --git a/po/Makevars b/po/Makevars
index ade615a452..d45ea4b979 100644
--- a/po/Makevars
+++ b/po/Makevars
@@ -6,7 +6,7 @@ subdir = po
top_builddir = ..
# These options get passed to xgettext. We want to catch standard
-# gettext uses, package synopses and descriptions, and SRFI-34 error
+# gettext uses, package synopses and descriptions, and SRFI-35 error
# condition messages.
XGETTEXT_OPTIONS = \
--language=Scheme --from-code=UTF-8 \
diff --git a/po/POTFILES.in b/po/POTFILES.in
index b329f21e92..ef864fe817 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -12,6 +12,7 @@ guix/scripts/hash.scm
guix/scripts/pull.scm
guix/scripts/substitute-binary.scm
guix/scripts/authenticate.scm
+guix/scripts/system.scm
guix/gnu-maintenance.scm
guix/ui.scm
guix/http-client.scm
diff --git a/pre-inst-env.in b/pre-inst-env.in
index e90e1b0ac4..cd4ee01497 100644
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -45,7 +45,10 @@ NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
-export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK
+NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts" # for 'guix-authenticate'
+
+export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS \
+ NIX_BUILD_HOOK NIX_LIBEXEC_DIR
# The 'guix-register' program.
GUIX_REGISTER="$abs_top_builddir/guix-register"
diff --git a/test-env.in b/test-env.in
index df73ecdc7a..9b5817f4ee 100644
--- a/test-env.in
+++ b/test-env.in
@@ -1,7 +1,7 @@
#!/bin/sh
# 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.
#
@@ -53,9 +53,6 @@ then
chmod 400 "$NIX_CONF_DIR/signing-key.sec"
fi
- # For 'guix-authenticate'.
- NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts"
-
# A place to store data of the substituter.
GUIX_BINARY_SUBSTITUTE_URL="file://$NIX_STATE_DIR/substituter-data"
rm -rf "$NIX_STATE_DIR/substituter-data"
@@ -67,7 +64,7 @@ then
export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \
NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \
NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL \
- NIX_CONF_DIR NIX_LIBEXEC_DIR XDG_CACHE_HOME
+ NIX_CONF_DIR XDG_CACHE_HOME
# Do that because store.scm calls `canonicalize-path' on it.
mkdir -p "$NIX_STORE_DIR"
diff --git a/tests/derivations.scm b/tests/derivations.scm
index f7cedde505..f31b00b8a2 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.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.
;;;
@@ -23,7 +23,8 @@
#:use-module (guix utils)
#:use-module (guix hash)
#:use-module (guix base32)
- #:use-module ((guix packages) #:select (package-derivation))
+ #:use-module ((guix packages) #:select (package-derivation base32))
+ #:use-module ((guix build utils) #:select (executable-file?))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-1.8))
@@ -190,6 +191,23 @@
(equal? (derivation->output-path drv1)
(derivation->output-path drv2)))))
+(test-assert "fixed-output derivation, recursive"
+ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
+ "echo -n hello > $out" '()))
+ (hash (sha256 (string->utf8 "hello")))
+ (drv (derivation %store "fixed-rec"
+ %bash `(,builder)
+ #:inputs `((,builder))
+ #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+ #:hash-algo 'sha256
+ #:recursive? #t))
+ (succeeded? (build-derivations %store (list drv))))
+ (and succeeded?
+ (let ((p (derivation->output-path drv)))
+ (and (equal? (string->utf8 "hello")
+ (call-with-input-file p get-bytevector-all))
+ (bytevector? (query-path-hash %store p)))))))
+
(test-assert "derivation with a fixed-output input"
;; A derivation D using a fixed-output derivation F doesn't has the same
;; output path when passed F or F', as long as F and F' have the same output
@@ -637,6 +655,54 @@ Deriver: ~a~%"
(derivation-file-name final1)))
(build-derivations %store (list final1 final2)))))
+(test-assert "build-expression->derivation produces recursive fixed-output"
+ (let* ((builder '(begin
+ (use-modules (srfi srfi-26))
+ (mkdir %output)
+ (chdir %output)
+ (call-with-output-file "exe"
+ (cut display "executable" <>))
+ (chmod "exe" #o777)
+ (symlink "exe" "symlink")
+ (mkdir "subdir")))
+ (drv (build-expression->derivation %store "fixed-rec" builder
+ #:hash-algo 'sha256
+ #:hash (base32
+ "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
+ #:recursive? #t)))
+ (and (build-derivations %store (list drv))
+ (let* ((dir (derivation->output-path drv))
+ (exe (string-append dir "/exe"))
+ (link (string-append dir "/symlink"))
+ (subdir (string-append dir "/subdir")))
+ (and (executable-file? exe)
+ (string=? "executable"
+ (call-with-input-file exe get-string-all))
+ (string=? "exe" (readlink link))
+ (file-is-directory? subdir))))))
+
+(test-assert "build-expression->derivation uses recursive fixed-output"
+ (let* ((builder '(call-with-output-file %output
+ (lambda (port)
+ (display "hello" port))))
+ (fixed (build-expression->derivation %store "small-fixed-rec"
+ builder
+ #:hash-algo 'sha256
+ #:hash (base32
+ "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+ #:recursive? #t))
+ (in (derivation->output-path fixed))
+ (builder `(begin
+ (mkdir %output)
+ (chdir %output)
+ (symlink ,in "symlink")))
+ (drv (build-expression->derivation %store "fixed-rec-user"
+ builder
+ #:inputs `(("fixed" ,fixed)))))
+ (and (build-derivations %store (list drv))
+ (let ((out (derivation->output-path drv)))
+ (string=? (readlink (string-append out "/symlink")) in)))))
+
(test-assert "build-expression->derivation with #:references-graphs"
(let* ((input (add-text-to-store %store "foo" "hello"
(list %bash %mkdir)))
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 53325ce1f4..23df01d417 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -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.
#
@@ -22,7 +22,27 @@
guix hash --version
+tmpdir="guix-hash-$$"
+trap 'rm -rf "$tmpdir"' EXIT
+
test `guix hash /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq
+
+mkdir "$tmpdir"
+echo -n executable > "$tmpdir/exe"
+chmod +x "$tmpdir/exe"
+( cd "$tmpdir" ; ln -s exe symlink )
+mkdir "$tmpdir/subdir"
+
+test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+
+# Without '-r', this should fail.
+if guix hash "$tmpdir"
+then false; else true; fi
+
+# This should fail because /dev/null is a character device, which
+# the archive format doesn't support.
+if guix hash -r /dev/null
+then false; else true; fi
diff --git a/tests/monads.scm b/tests/monads.scm
index d3f78e1568..b51e705f01 100644
--- a/tests/monads.scm
+++ b/tests/monads.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.
;;;
@@ -126,6 +126,30 @@
(readlink (string-append out "/guile-rocks"))))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
+(test-assert "text-file*"
+ (let ((references (store-lift references)))
+ (run-with-store %store
+ (mlet* %store-monad
+ ((drv (package->derivation %bootstrap-guile))
+ (guile -> (derivation->output-path drv))
+ (file (text-file "bar" "This is bar."))
+ (text (text-file* "foo"
+ %bootstrap-guile "/bin/guile "
+ `(,%bootstrap-guile "out") "/bin/guile "
+ drv "/bin/guile "
+ file))
+ (done (built-derivations (list text)))
+ (out -> (derivation->output-path text))
+ (refs (references out)))
+ ;; Make sure we get the right references and the right content.
+ (return (and (lset= string=? refs (list guile file))
+ (equal? (call-with-input-file out get-string-all)
+ (string-append guile "/bin/guile "
+ guile "/bin/guile "
+ guile "/bin/guile "
+ file)))))
+ #:guile-for-build (package-derivation %store %bootstrap-guile))))
+
(test-assert "mapm"
(every (lambda (monad run)
(with-monad monad
diff --git a/tests/nar.scm b/tests/nar.scm
index 9f21f990c8..16a7845342 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -19,10 +19,14 @@
(define-module (test-nar)
#:use-module (guix nar)
#:use-module (guix store)
- #:use-module ((guix hash) #:select (open-sha256-input-port))
+ #:use-module ((guix hash)
+ #:select (open-sha256-port open-sha256-input-port))
+ #:use-module ((guix packages)
+ #:select (base32))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -183,6 +187,34 @@
(test-begin "nar")
+(test-assert "write-file supports non-file output ports"
+ (let ((input (string-append (dirname (search-path %load-path "guix.scm"))
+ "/guix"))
+ (output (%make-void-port "w")))
+ (write-file input output)
+ #t))
+
+(test-equal "write-file puts file in C locale collation order"
+ (base32 "0sfn5r63k88w9ls4hivnvscg82bqg8a0w7955l6xlk4g96jnb2z3")
+ (let ((input (string-append %test-dir ".input")))
+ (dynamic-wind
+ (lambda ()
+ (define (touch file)
+ (call-with-output-file (string-append input "/" file)
+ (const #t)))
+
+ (mkdir input)
+ (touch "B")
+ (touch "Z")
+ (touch "a")
+ (symlink "B" (string-append input "/z")))
+ (lambda ()
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file input port)
+ (get-hash)))
+ (lambda ()
+ (rm-rf input)))))
+
(test-assert "write-file + restore-file"
(let* ((input (string-append (dirname (search-path %load-path "guix.scm"))
"/guix"))
diff --git a/tests/store.scm b/tests/store.scm
index a61d449fb4..7b0f3249d2 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -398,6 +398,25 @@ Deriver: ~a~%"
get-string-all))
files)))))))
+(test-assert "export/import paths, ensure topological order"
+ (let* ((file1 (add-text-to-store %store "foo" (random-text)))
+ (file2 (add-text-to-store %store "bar" (random-text)
+ (list file1)))
+ (files (list file1 file2))
+ (dump1 (call-with-bytevector-output-port
+ (cute export-paths %store (list file1 file2) <>)))
+ (dump2 (call-with-bytevector-output-port
+ (cute export-paths %store (list file2 file1) <>))))
+ (delete-paths %store files)
+ (and (every (negate file-exists?) files)
+ (bytevector=? dump1 dump2)
+ (let* ((source (open-bytevector-input-port dump1))
+ (imported (import-paths %store source)))
+ (and (equal? imported (list file1 file2))
+ (every file-exists? files)
+ (null? (references %store file1))
+ (equal? (list file1) (references %store file2)))))))
+
(test-assert "import corrupt path"
(let* ((text (random-text))
(file (add-text-to-store %store "text" text))