aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
commit5608847c6f4131e8f30321fdf25289efd73f8689 (patch)
tree5a5910165d29455b249fd4d6612078ff5cf6ced5 /gnu
parent0c456db45bf03df61cdb71db7742a44f4328fb3d (diff)
parentf59e9eaac87b4365c646a475d44b431e43949649 (diff)
downloadpatches-5608847c6f4131e8f30321fdf25289efd73f8689.tar
patches-5608847c6f4131e8f30321fdf25289efd73f8689.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu')
-rw-r--r--gnu/packages/avahi.scm10
-rw-r--r--gnu/packages/cryptsetup.scm2
-rw-r--r--gnu/packages/gdb.scm2
-rw-r--r--gnu/packages/ghostscript.scm2
-rw-r--r--gnu/packages/glib.scm42
-rw-r--r--gnu/packages/gnome.scm57
-rw-r--r--gnu/packages/gnupg.scm2
-rw-r--r--gnu/packages/gnutls.scm12
-rw-r--r--gnu/packages/grub.scm62
-rw-r--r--gnu/packages/gstreamer.scm109
-rw-r--r--gnu/packages/gtk.scm4
-rw-r--r--gnu/packages/libevent.scm2
-rw-r--r--gnu/packages/linux-initrd.scm3
-rw-r--r--gnu/packages/linux.scm10
-rw-r--r--gnu/packages/mail.scm (renamed from gnu/packages/mailutils.scm)83
-rw-r--r--gnu/packages/netpbm.scm2
-rw-r--r--gnu/packages/oggvorbis.scm2
-rw-r--r--gnu/packages/patches/avahi-localstatedir.patch12
-rw-r--r--gnu/packages/patches/dbus-localstatedir.patch30
-rw-r--r--gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch36
-rw-r--r--gnu/packages/python.scm254
-rw-r--r--gnu/packages/qemu.scm2
-rw-r--r--gnu/packages/samba.scm2
-rw-r--r--gnu/packages/system.scm34
-rw-r--r--gnu/packages/texlive.scm4
-rw-r--r--gnu/packages/version-control.scm8
-rw-r--r--gnu/packages/xml.scm4
-rw-r--r--gnu/packages/xorg.scm13
-rw-r--r--gnu/packages/yasm.scm2
-rw-r--r--gnu/packages/zip.scm3
-rw-r--r--gnu/system/dmd.scm126
-rw-r--r--gnu/system/grub.scm84
-rw-r--r--gnu/system/linux.scm145
-rw-r--r--gnu/system/shadow.scm57
-rw-r--r--gnu/system/vm.scm207
35 files changed, 1167 insertions, 262 deletions
diff --git a/gnu/packages/avahi.scm b/gnu/packages/avahi.scm
index fbdc0e2834..14073b32a0 100644
--- a/gnu/packages/avahi.scm
+++ b/gnu/packages/avahi.scm
@@ -21,6 +21,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
#:use-module (gnu packages gdbm)
#:use-module (gnu packages libdaemon)
#:use-module (gnu packages pkg-config)
@@ -42,13 +43,15 @@
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--with-distro=none"
+ "--localstatedir=/var" ; for the DBus socket
"--disable-python"
"--disable-mono"
"--disable-doxygen-doc"
"--disable-xmltoman"
"--enable-tests"
"--disable-qt3" "--disable-qt4"
- "--disable-gtk" "--disable-gtk3")))
+ "--disable-gtk" "--disable-gtk3")
+ #:patches (list (assoc-ref %build-inputs "patch/localstatedir"))))
(inputs
`(("expat" ,expat)
("glib" ,glib)
@@ -56,7 +59,10 @@
("libdaemon" ,libdaemon)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
- ("gdbm" ,gdbm)))
+ ("gdbm" ,gdbm)
+
+ ("patch/localstatedir"
+ ,(search-patch "avahi-localstatedir.patch"))))
(synopsis "Avahi, an mDNS/DNS-SD implementation")
(description
"Avahi is a system which facilitates service discovery on a local
diff --git a/gnu/packages/cryptsetup.scm b/gnu/packages/cryptsetup.scm
index c746e28721..8645e9e04a 100644
--- a/gnu/packages/cryptsetup.scm
+++ b/gnu/packages/cryptsetup.scm
@@ -45,7 +45,7 @@
`(("libgcrypt" ,libgcrypt)
("lvm2" ,lvm2)
("popt" ,popt)
- ("python" ,python)
+ ("python" ,python-wrapper)
("util-linux" ,util-linux)))
(synopsis "hard disk encryption tool")
(description
diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm
index 4cf6b90cc3..5190283895 100644
--- a/gnu/packages/gdb.scm
+++ b/gnu/packages/gdb.scm
@@ -53,7 +53,7 @@
("gmp" ,gmp)
("readline" ,readline)
("ncurses" ,ncurses)
- ("python" ,python)
+ ("python" ,python-wrapper)
("texinfo" ,texinfo)
("dejagnu" ,dejagnu)))
(home-page "http://www.gnu.org/software/gdb/")
diff --git a/gnu/packages/ghostscript.scm b/gnu/packages/ghostscript.scm
index dd6c576cdf..7df1f6c17e 100644
--- a/gnu/packages/ghostscript.scm
+++ b/gnu/packages/ghostscript.scm
@@ -136,7 +136,7 @@ printing, and psresize, for adjusting page sizes.")
("libtiff" ,libtiff)
("perl" ,perl)
("pkg-config" ,pkg-config) ; needed to find libtiff
- ("python" ,python)
+ ("python" ,python-wrapper)
("tcl" ,tcl)
("zlib" ,zlib)))
(arguments
diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm
index fee834f9f9..815fafcbfb 100644
--- a/gnu/packages/glib.scm
+++ b/gnu/packages/glib.scm
@@ -35,9 +35,18 @@
#:use-module (gnu packages python)
#:use-module (gnu packages xml)
#:use-module (gnu packages bash)
- #:use-module (gnu packages file))
+ #:use-module (gnu packages file)
+ #:use-module (gnu packages xorg)
-(define-public dbus
+ ;; Export variables up-front to allow circular dependency with the 'xorg'
+ ;; module.
+ #:export (dbus
+ glib
+ dbus-glib
+ intltool
+ itstool))
+
+(define dbus
(package
(name "dbus")
(version "1.6.4")
@@ -50,9 +59,26 @@
(base32
"1wacqyfkcpayg7f8rvx9awqg275n5pksxq5q7y21lxjx85x6pfjz"))))
(build-system gnu-build-system)
+ (arguments
+ '(#:configure-flags (list ;; Install the system bus socket under /var.
+ "--localstatedir=/var"
+
+ ;; XXX: Fix the following to allow system-wide
+ ;; config.
+ ;; "--sysconfdir=/etc"
+
+ "--with-session-socket-dir=/tmp")
+ #:patches (list (assoc-ref %build-inputs "patch/localstatedir"))))
(inputs
`(("expat" ,expat)
- ("pkg-config" ,pkg-config)))
+ ("pkg-config" ,pkg-config)
+ ("patch/localstatedir"
+ ,(search-patch "dbus-localstatedir.patch"))
+
+ ;; Add a dependency on libx11 so that 'dbus-launch' has support for
+ ;; '--autolaunch'.
+ ("libx11" ,libx11)))
+
(home-page "http://dbus.freedesktop.org/")
(synopsis "Message bus for inter-process communication (IPC)")
(description
@@ -73,7 +99,7 @@ or through unencrypted TCP/IP suitable for use behind a firewall with
shared NFS home directories.")
(license license:gpl2+))) ; or Academic Free License 2.1
-(define-public glib
+(define glib
(package
(name "glib")
(version "2.37.1")
@@ -92,7 +118,7 @@ shared NFS home directories.")
("gettext" ,guix:gettext)
("libffi" ,libffi)
("pkg-config" ,pkg-config)
- ("python" ,python)
+ ("python" ,python-wrapper)
("zlib" ,zlib)
("perl" ,perl) ; needed by GIO tests
("dbus" ,dbus) ; for GDBus tests
@@ -145,7 +171,7 @@ dynamic loading, and an object system.")
(home-page "http://developer.gnome.org/glib/")
(license license:lgpl2.0+))) ; some files are under lgpl2.1+
-(define-public intltool
+(define intltool
(package
(name "intltool")
(version "0.50.2")
@@ -186,7 +212,7 @@ The intltool collection can be used to do these things:
oaf files. This merge step will happen at build resp. installation time.")
(license license:gpl2+)))
-(define-public itstool
+(define itstool
(package
(name "itstool")
(version "1.2.0")
@@ -220,7 +246,7 @@ information in their documents, such as whether a particular element should be
translated.")
(license license:gpl3+)))
-(define-public dbus-glib
+(define dbus-glib
(package
(name "dbus-glib")
(version "0.100.2")
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
new file mode 100644
index 0000000000..c66af51c98
--- /dev/null
+++ b/gnu/packages/gnome.scm
@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages gnome)
+ #:use-module ((guix licenses) #:select (gpl2+))
+ #: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 python)
+ #:use-module (gnu packages xml))
+
+(define-public gnome-doc-utils
+ (package
+ (name "gnome-doc-utils")
+ (version "0.20.10")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnome/sources/" name "/0.20/"
+ name "-" version ".tar.xz"))
+ (sha256
+ (base32
+ "19n4x25ndzngaciiyd8dd6s2mf9gv6nv3wv27ggns2smm7zkj1nb"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("intltool" ,intltool)
+ ("libxml2" ,libxml2)
+ ("libxslt" ,libxslt)
+ ("pkg-config" ,pkg-config)
+ ("python-2" ,python-2)))
+ (arguments
+ `(#:tests? #f)) ; tries to load http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd
+ (home-page "https://wiki.gnome.org/GnomeDocUtils")
+ (synopsis
+ "Documentation utilities for the Gnome project")
+ (description
+ "Gnome-doc-utils is a collection of documentation utilities for the
+Gnome project. It includes xml2po tool which makes it easier to translate
+and keep up to date translations of documentation.")
+ (license gpl2+))) ; xslt under lgpl
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index 604ebc2941..7c0f50900a 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -191,7 +191,7 @@ S/MIME.")
"1g1jly3wl4ks6h8ydkygyl2c4i7v3z91rg42005m6vm70y1d8b3d"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)
- ("python" ,python)
+ ("python" ,python-wrapper)
("gpg" ,gnupg)))
(arguments
`(#:tests? #f
diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm
index d636a9c927..766731e289 100644
--- a/gnu/packages/gnutls.scm
+++ b/gnu/packages/gnutls.scm
@@ -54,7 +54,7 @@ portable, and only require an ANSI C89 platform.")
(define-public gnutls
(package
(name "gnutls")
- (version "3.2.1")
+ (version "3.2.4")
(source (origin
(method url-fetch)
(uri
@@ -64,20 +64,14 @@ portable, and only require an ANSI C89 platform.")
version ".tar.xz"))
(sha256
(base32
- "1zi2kq3vcbqdy9khl7r6pgk4hgwibniasm9k6siasdvqjijq3ymb"))))
+ "0zvhzy87v9dfxfvmg1pl951kw55rp647cqdza8942fxq7spp158i"))))
(build-system gnu-build-system)
- (arguments
- `(#:patches (list (assoc-ref %build-inputs
- "patch/fix-tests"))
- #:patch-flags '("-p0")))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("guile" ,guile-2.0)
("zlib" ,guix:zlib)
- ("perl" ,perl)
- ("patch/fix-tests"
- ,(search-patch "gnutls-fix-tests-on-32-bits-system.patch"))))
+ ("perl" ,perl)))
(propagated-inputs
`(("libtasn1" ,libtasn1)
("nettle" ,nettle)
diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm
index 71c4fad781..8c981bf88d 100644
--- a/gnu/packages/grub.scm
+++ b/gnu/packages/grub.scm
@@ -19,9 +19,6 @@
(define-module (gnu packages grub)
#:use-module (guix download)
#:use-module (guix packages)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix derivations)
#:use-module ((guix licenses) #:select (gpl3+))
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
@@ -33,11 +30,7 @@
#:use-module (gnu packages qemu)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages cdrom)
- #:use-module (srfi srfi-1)
- #:use-module (ice-9 match)
- #:export (menu-entry
- menu-entry?
- grub-configuration-file))
+ #:use-module (srfi srfi-1))
(define qemu-for-tests
;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
@@ -117,56 +110,3 @@ computer starts. It is responsible for loading and transferring control to
the operating system kernel software (such as the Hurd or the Linux). The
kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
(license gpl3+)))
-
-
-;;;
-;;; Configuration.
-;;;
-
-(define-record-type* <menu-entry>
- menu-entry make-menu-entry
- menu-entry?
- (label menu-entry-label)
- (linux menu-entry-linux)
- (linux-arguments menu-entry-linux-arguments
- (default '()))
- (initrd menu-entry-initrd))
-
-(define* (grub-configuration-file store entries
- #:key (default-entry 1) (timeout 5)
- (system (%current-system)))
- "Return the GRUB configuration file in STORE for ENTRIES, a list of
-<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
- (define prologue
- (format #f "
-set default=~a
-set timeout=~a
-search.file ~a~%"
- default-entry timeout
- (any (match-lambda
- (($ <menu-entry> _ linux)
- (let* ((drv (package-derivation store linux system))
- (out (derivation-path->output-path drv)))
- (string-append out "/bzImage"))))
- entries)))
-
- (define entry->text
- (match-lambda
- (($ <menu-entry> label linux arguments initrd)
- (let ((linux-drv (package-derivation store linux system))
- (initrd-drv (package-derivation store initrd system)))
- ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
- (format #f "menuentry ~s {
- linux ~a/bzImage ~a
- initrd ~a/initrd
-}~%"
- label
- (derivation-path->output-path linux-drv)
- (string-join arguments)
- (derivation-path->output-path initrd-drv))))))
-
- (add-text-to-store store "grub.cfg"
- (string-append prologue
- (string-concatenate
- (map entry->text entries)))
- '()))
diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm
new file mode 100644
index 0000000000..7478dc3188
--- /dev/null
+++ b/gnu/packages/gstreamer.scm
@@ -0,0 +1,109 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages gstreamer)
+ #:use-module ((guix licenses) #:select (lgpl2.0+))
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages bison)
+ #:use-module (gnu packages flex)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu packages perl)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages python))
+
+(define-public gstreamer
+ (package
+ (name "gstreamer")
+ (version "1.0.10")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://gstreamer.freedesktop.org/src/gstreamer/gstreamer-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "0c0irk85jd2cihm5pmf4zxhlpg08qpxjcqv1l9qn2n3h2gsaj2lf"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("bison" ,bison)
+ ("flex" ,flex)
+ ("glib" ,glib)
+ ("perl" ,perl)
+ ("pkg-config" ,pkg-config)
+ ("python-wrapper" ,python-wrapper)))
+ (home-page "http://gstreamer.freedesktop.org/")
+ (synopsis
+ "Multimedia library")
+ (description
+ "GStreamer is a library for constructing graphs of media-handling
+components. The applications it supports range from simple Ogg/Vorbis
+playback, audio/video streaming to complex audio (mixing) and video
+(non-linear editing) processing.
+
+Applications can take advantage of advances in codec and filter technology
+transparently. Developers can add new codecs and filters by writing a
+simple plugin with a clean, generic interface.
+
+This package provides the core library and elements.")
+ (license lgpl2.0+)))
+
+(define-public gst-plugins-base
+ (package
+ (name "gst-plugins-base")
+ (version "1.0.10")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://gstreamer.freedesktop.org/src/gst-plugins-base/gst-plugins-base-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "1s4pphbb5kpdh4rrmb8rala4sp499k4by59925k15xiz58xyhm4p"))))
+ (build-system gnu-build-system)
+ ;; FIXME: Add more dependencies for further plugins.
+ (inputs
+ `(("glib" ,glib)
+ ("gstreamer" ,gstreamer)
+ ("pkg-config" ,pkg-config)
+ ("python-wrapper" ,python-wrapper)))
+ (arguments
+ `(#:tests? #f))
+ ;; All tests pass except for one:
+ ;; Running suite(s): pbutils library
+ ;; 85%: Checks: 7, Failures: 1, Errors: 0
+ ;; libs/pbutils.c:522:F:general:test_pb_utils_install_plugins:0: gst_install_plugins_sync() failed ;; with unexpected ret 201, which is neither HELPER_MISSING nor 1
+ ;; FAIL: libs/pbutils
+ ;; According to the documentation, "gst_install_plugins_sync (...)
+ ;; should almost never be used".
+ (home-page "http://gstreamer.freedesktop.org/")
+ (synopsis
+ "Plugins for the gstreamer multimedia library")
+ (description
+ "GStreamer is a library for constructing graphs of media-handling
+components. The applications it supports range from simple Ogg/Vorbis
+playback, audio/video streaming to complex audio (mixing) and video
+(non-linear editing) processing.
+
+Applications can take advantage of advances in codec and filter technology
+transparently. Developers can add new codecs and filters by writing a
+simple plugin with a clean, generic interface.
+
+This package provides an essential exemplary set of elements.")
+ (license lgpl2.0+)))
diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm
index 742cbf172e..e72f7c5acc 100644
--- a/gnu/packages/gtk.scm
+++ b/gnu/packages/gtk.scm
@@ -83,7 +83,7 @@ tools have full access to view and control running applications.")
("libspectre" ,libspectre)
("pkg-config" ,pkg-config)
("poppler" ,poppler)
- ("python" ,python)
+ ("python" ,python-wrapper)
("xextproto" ,xextproto)
("zlib" ,zlib)))
(arguments
@@ -123,7 +123,7 @@ affine transformation (scale, rotation, shear, etc.)")
`(("cairo" ,cairo)
("icu4c" ,icu4c)
("pkg-config" ,pkg-config)
- ("python" ,python)))
+ ("python" ,python-wrapper)))
(synopsis "opentype text shaping engine")
(description
"HarfBuzz is an OpenType text shaping engine.")
diff --git a/gnu/packages/libevent.scm b/gnu/packages/libevent.scm
index ccca427fc4..8f2d5dad46 100644
--- a/gnu/packages/libevent.scm
+++ b/gnu/packages/libevent.scm
@@ -44,7 +44,7 @@
;; Dependencies used for the tests and for `event_rpcgen.py'.
("which" ,which)
- ("python" ,python)))
+ ("python" ,python-wrapper)))
(arguments
'(#:patches (list (assoc-ref %build-inputs "patch/dns-tests"))))
(home-page "http://libevent.org/")
diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
index 6dd2a10e53..b62843aadd 100644
--- a/gnu/packages/linux-initrd.scm
+++ b/gnu/packages/linux-initrd.scm
@@ -386,7 +386,8 @@ the Linux kernel.")
(chroot "/root")
(primitive-load to-load)
(format (current-error-port)
- "boot program '~a' terminated, rebooting~%")
+ "boot program '~a' terminated, rebooting~%"
+ to-load)
(sleep 2)
(reboot))
(begin
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index b5ed92e198..38bff72933 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -214,6 +214,11 @@
(license gpl2)
(home-page "http://www.gnu.org/software/linux-libre/"))))
+
+;;;
+;;; Pluggable authentication modules (PAM).
+;;;
+
(define-public linux-pam
(package
(name "linux-pam")
@@ -255,6 +260,11 @@ be used through the PAM API to perform tasks, like authenticating a user
at login. Local and dynamic reconfiguration are its key features")
(license bsd-3)))
+
+;;;
+;;; Miscellaneous.
+;;;
+
(define-public psmisc
(package
(name "psmisc")
diff --git a/gnu/packages/mailutils.scm b/gnu/packages/mail.scm
index 15ca939e66..b8ddcd71e1 100644
--- a/gnu/packages/mailutils.scm
+++ b/gnu/packages/mail.scm
@@ -16,20 +16,23 @@
;;; 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 mailutils)
+(define-module (gnu packages mail)
#:use-module (gnu packages)
- #:use-module (gnu packages linux)
- #:use-module (gnu packages gnutls)
+ #:use-module (gnu packages autotools)
+ #:use-module (gnu packages dejagnu)
#:use-module (gnu packages gdbm)
+ #:use-module (gnu packages gnutls)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages m4)
+ #:use-module (gnu packages mysql)
#:use-module (gnu packages ncurses)
+ #:use-module (gnu packages openssl)
+ #:use-module (gnu packages perl)
#:use-module (gnu packages readline)
- #:use-module (gnu packages dejagnu)
- #:use-module (gnu packages m4)
#:use-module (gnu packages texinfo)
- #:use-module (gnu packages mysql)
- #:use-module (gnu packages autotools)
- #:use-module (guix licenses)
+ #:use-module ((guix licenses)
+ #:select (gpl2+ gpl3+ lgpl3+))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
@@ -104,3 +107,67 @@ message handling system.")
(license
;; Libraries are under LGPLv3+, and programs under GPLv3+.
(list gpl3+ lgpl3+))))
+
+(define-public fetchmail
+ (package
+ (name "fetchmail")
+ (version "6.3.26")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://sourceforge/fetchmail/branch_6.3/fetchmail-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "0l78ayvi9dm8hd190gl139cs2xqsrf7r9ncilslw20mgvd6cbd3r"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("openssl" ,openssl)))
+ (arguments
+ `(#:configure-flags (list (string-append "--with-ssl="
+ (assoc-ref %build-inputs "openssl")))))
+ (home-page "http://fetchmail.berlios.de/")
+ (synopsis "Remote-mailr etrieval and forwarding utility")
+ (description
+ "Fetchmail is a full-featured, robust, well-documented remote-mail
+retrieval and forwarding utility intended to be used over on-demand
+TCP/IP links (such as SLIP or PPP connections). It supports every
+remote-mail protocol now in use on the Internet: POP2, POP3, RPOP, APOP,
+KPOP, all flavors of IMAP, ETRN, and ODMR. It can even support IPv6
+and IPSEC.
+
+Fetchmail retrieves mail from remote mail servers and forwards it via SMTP,
+so it can then be read by normal mail user agents such as mutt, elm
+or BSD Mail. It allows all your system MTA's filtering, forwarding, and
+aliasing facilities to work just as they would on normal mail.")
+ (license gpl2+))) ; most files are actually public domain or x11
+
+(define-public mutt
+ (package
+ (name "mutt")
+ (version "1.5.21")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "ftp://ftp.mutt.org/mutt/devel/mutt-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1864cwz240gh0zy56fb47qqzwyf6ghg01037rb4p2kqgimpg6h91"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("ncurses" ,ncurses)
+ ("openssl" ,openssl)
+ ("perl" ,perl)))
+ (arguments
+ `(#:configure-flags '("--enable-smtp"
+ "--enable-imap"
+ "--enable-pop"
+ "--with-ssl"
+ ;; so that mutt does not check whether the path
+ ;; exists, which it does not in the chroot
+ "--with-mailpath=/var/mail")))
+ (home-page "http://www.mutt.org/")
+ (synopsis "Mail client")
+ (description
+ "Mutt is a small but very powerful text-based mail client for Unix
+operating systems.")
+ (license gpl2+)))
diff --git a/gnu/packages/netpbm.scm b/gnu/packages/netpbm.scm
index d2213b8f0d..c8d3603701 100644
--- a/gnu/packages/netpbm.scm
+++ b/gnu/packages/netpbm.scm
@@ -57,7 +57,7 @@
("libxml2" ,libxml2)
("perl" ,perl)
("pkg-config" ,pkg-config)
- ("python" ,python)
+ ("python" ,python-wrapper)
("zlib" ,zlib)))
(arguments
`(#:phases
diff --git a/gnu/packages/oggvorbis.scm b/gnu/packages/oggvorbis.scm
index 2aa606ca22..589828be0a 100644
--- a/gnu/packages/oggvorbis.scm
+++ b/gnu/packages/oggvorbis.scm
@@ -191,7 +191,7 @@ meaning that audio is compressed in FLAC without any loss in quality.")
("libogg" ,libogg)
("libpng" ,libpng)
("pkg-config" ,pkg-config)
- ("python" ,python)
+ ("python" ,python-wrapper)
("zlib" ,zlib)))
(synopsis "kate, a karaoke and text codec for embedding in ogg")
(description
diff --git a/gnu/packages/patches/avahi-localstatedir.patch b/gnu/packages/patches/avahi-localstatedir.patch
new file mode 100644
index 0000000000..76377d1057
--- /dev/null
+++ b/gnu/packages/patches/avahi-localstatedir.patch
@@ -0,0 +1,12 @@
+Don't "mkdir $(localstatedir)" since we can't do it (/var).
+
+--- avahi-0.6.27/avahi-daemon/Makefile.in 2010-07-13 05:06:35.000000000 +0200
++++ avahi-0.6.27/avahi-daemon/Makefile.in 2010-07-13 18:03:45.000000000 +0200
+@@ -1554,7 +1554,6 @@ xmllint:
+ done
+
+ install-data-local:
+- test -z "$(localstatedir)/run" || $(mkdir_p) "$(DESTDIR)$(localstatedir)/run"
+
+ update-systemd:
+ curl http://cgit.freedesktop.org/systemd/plain/src/sd-daemon.c > sd-daemon.c
diff --git a/gnu/packages/patches/dbus-localstatedir.patch b/gnu/packages/patches/dbus-localstatedir.patch
new file mode 100644
index 0000000000..61bed91b5c
--- /dev/null
+++ b/gnu/packages/patches/dbus-localstatedir.patch
@@ -0,0 +1,30 @@
+Do not try to create $localstatedir and $sysconfdir since we cannot do this
+when they are /var and /etc.
+
+--- dbus-1.6.4/bus/Makefile.in 2013-09-11 16:15:13.000000000 +0200
++++ dbus-1.6.4/bus/Makefile.in 2013-09-11 16:15:15.000000000 +0200
+@@ -1510,9 +1510,6 @@ clean-local:
+ /bin/rm *.bb *.bbg *.da *.gcov || true
+
+ install-data-hook:
+- $(mkinstalldirs) $(DESTDIR)$(localstatedir)/run/dbus
+- $(mkinstalldirs) $(DESTDIR)$(configdir)/system.d
+- $(mkinstalldirs) $(DESTDIR)$(configdir)/session.d
+ $(mkinstalldirs) $(DESTDIR)$(datadir)/dbus-1/services
+ $(mkinstalldirs) $(DESTDIR)$(datadir)/dbus-1/system-services
+ # Install dbus.socket as default implementation of a D-Bus stack.
+
+--- dbus-1.6.4/tools/Makefile.in 2013-09-11 16:10:31.000000000 +0200
++++ dbus-1.6.4/tools/Makefile.in 2013-09-11 16:10:32.000000000 +0200
+@@ -757,11 +757,6 @@ uninstall-am: uninstall-binPROGRAMS
+
+
+ # create the /var/lib/dbus directory for dbus-uuidgen
+-install-data-local:
+- $(MKDIR_P) $(DESTDIR)$(localstatedir)/lib/dbus
+-
+-installcheck-local:
+- test -d $(DESTDIR)$(localstatedir)/lib/dbus
+
+ # Tell versions [3.59,3.63) of GNU make to not export all variables.
+ # Otherwise a system limit (for SysV at least) may be exceeded.
diff --git a/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch b/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch
deleted file mode 100644
index 07d633149e..0000000000
--- a/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch
+++ /dev/null
@@ -1,36 +0,0 @@
-From b12040aeab5fbaf02677571db1d8bf1995bd5ee0 Mon Sep 17 00:00:00 2001
-From: Nikos Mavrogiannopoulos <nmav@gnutls.org>
-Date: Sun, 2 Jun 2013 12:10:06 +0200
-Subject: [PATCH] Avoid comparing the expiration date to prevent false positive
-error in 32-bit systems.
-
----
- tests/cert-tests/pem-decoding | 6 ++++--
- 1 files changed, 4 insertions(+), 2 deletions(-)
-
-diff --git a/tests/cert-tests/pem-decoding b/tests/cert-tests/pem-decoding
-index fe769ec..f8c6372 100755
---- tests/cert-tests/pem-decoding
-+++ tests/cert-tests/pem-decoding
-@@ -61,7 +61,9 @@ if test "$rc" != "0"; then
- exit $rc
- fi
-
--diff $srcdir/complex-cert.pem tmp-pem.pem
-+cat $srcdir/complex-cert.pem |grep -v "Not After:" >tmp1
-+cat $srcdir/tmp-pem.pem |grep -v "Not After:" >tmp2
-+diff tmp1 tmp2
- rc=$?
-
- if test "$rc" != "0"; then
-@@ -69,6 +71,6 @@ if test "$rc" != "0"; then
- exit $rc
- fi
-
--rm -f tmp-pem.pem
-+rm -f tmp-pem.pem tmp1 tmp2
-
- exit 0
---
-1.7.1
-
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index 493068adde..d64ed1a131 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -19,19 +19,25 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages python)
- #:use-module ((guix licenses) #:select (bsd-3 psfl x11))
+ #:use-module ((guix licenses) #:select (bsd-3 bsd-style psfl x11))
+ #:use-module ((guix licenses) #:select (zlib)
+ #:renamer (symbol-prefix-proc 'license:))
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gdbm)
+ #:use-module (gnu packages icu4c)
#:use-module (gnu packages readline)
#:use-module (gnu packages openssl)
#:use-module (gnu packages patchelf)
+ #:use-module (gnu packages sqlite)
#:use-module (guix packages)
#:use-module (guix download)
+ #:use-module (guix utils)
#:use-module (guix build-system gnu)
- #:use-module (guix build-system python))
+ #:use-module (guix build-system python)
+ #:use-module (guix build-system trivial))
-(define-public python
+(define-public python-2
(package
(name "python")
(version "2.7.5")
@@ -151,8 +157,8 @@ packages; exception-based error handling; and very high level dynamic
data types.")
(license psfl)))
-(define-public python-3
- (package (inherit python)
+(define-public python
+ (package (inherit python-2)
(version "3.3.2")
(source
(origin
@@ -167,9 +173,34 @@ data types.")
(variable "PYTHONPATH")
(directories '("lib/python3.3/site-packages")))))))
-(define-public pytz
+(define-public python-wrapper
+ (package (inherit python)
+ (name "python-wrapper")
+ (source #f)
+ (build-system trivial-build-system)
+ (inputs `(("python" ,python)))
+ (arguments
+ `(#:modules ((guix build utils))
+ #:builder
+ (begin
+ (use-modules (guix build utils))
+ (let ((bin (string-append (assoc-ref %outputs "out") "/bin"))
+ (python (string-append (assoc-ref %build-inputs "python") "/bin/")))
+ (mkdir-p bin)
+ (for-each
+ (lambda (old new)
+ (symlink (string-append python old)
+ (string-append bin "/" new)))
+ `("python3", "pydoc3", "idle3")
+ `("python", "pydoc", "idle"))))))
+ (description (string-append (package-description python)
+ "\n\nThis wrapper package provides symbolic links to the python binaries
+ without version suffix."))))
+
+
+(define-public python-pytz
(package
- (name "pytz")
+ (name "python-pytz")
(version "2013b")
(source
(origin
@@ -180,6 +211,7 @@ data types.")
(base32
"19giwgfcrg0nr1gdv49qnmf2jb2ilkcfc7qyqvfpz4dp0p64ksv5"))))
(build-system python-build-system)
+ (arguments `(#:tests? #f)) ; no test target
(home-page "https://launchpad.net/pytz")
(synopsis "The Python timezone library.")
(description
@@ -187,22 +219,28 @@ data types.")
using Python 2.4 or higher and provides access to the Olson timezone database.")
(license x11)))
-(define-public babel
+(define-public python2-pytz
+ (package-with-python2 python-pytz))
+
+
+(define-public python-babel
(package
- (name "babel")
- (version "0.9.6")
+ (name "python-babel")
+ (version "1.3")
(source
(origin
(method url-fetch)
- (uri (string-append "http://ftp.edgewall.com/pub/babel/Babel-"
+ (uri (string-append "https://pypi.python.org/packages/source/B/Babel/Babel-"
version ".tar.gz"))
(sha256
(base32
- "03vmr54jq5vf3qw6kpdv7cdk7x7i2jhzyf1mawv2gk8zrxg0hfja"))))
+ "0bnin777lc53nxd1hp3apq410jj5wx92n08h7h4izpl4f4sx00lz"))))
(build-system python-build-system)
(inputs
- `(("pytz" ,pytz)))
- (home-page "http://babel.edgewall.org/")
+ `(("python-pytz" ,python-pytz)
+ ("python-setuptools" ,python-setuptools)))
+ (arguments `(#:tests? #f)) ; no test target
+ (home-page "http://babel.pocoo.org/")
(synopsis
"Tools for internationalizing Python applications")
(description
@@ -212,3 +250,191 @@ using Python 2.4 or higher and provides access to the Olson timezone database.")
access to various locale display names, localized number and date formatting,
etc. ")
(license bsd-3)))
+
+(define-public python2-babel
+ (package-with-python2 python-babel))
+
+
+(define-public python-setuptools
+ (package
+ (name "python-setuptools")
+ (version "1.1.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://pypi.python.org/packages/source/s/setuptools/setuptools-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0hl9sa5xr9bi2ifq51wy1bawsjv5nzvpbac7m9z1ciz778874csf"))))
+ (build-system python-build-system)
+ (arguments
+ `(#:tests? #f))
+ ;;FIXME: test_sdist_with_utf8_encoded_filename fails in
+ ;; /tmp/nix-build-python2-setuptools-1.1.4.drv-0/setuptools-1.1.4/setuptools/tests/test_sdist.py"
+ ;; line 354
+ ;; The tests pass with Python 2.7.5.
+ (home-page "https://pypi.python.org/pypi/setuptools")
+ (synopsis
+ "Library designed to facilitate packaging Python projects")
+ (description
+ "Setuptools is a fully-featured, stable library designed to facilitate
+packaging Python projects, where packaging includes:
+Python package and module definitions,
+distribution package metadata,
+test hooks,
+project installation,
+platform-specific details,
+Python 3 support.")
+ (license psfl)))
+
+(define-public python2-setuptools
+ (package-with-python2 python-setuptools))
+
+
+(define-public python-dateutil
+ (package
+ (name "python-dateutil")
+ (version "1.5") ; last version for python < 3
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://labix.org/download/python-dateutil/python-dateutil-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0fqfglhy5khbvsipr3x7m6bcaqljh8xl5cw33vbfxy7qhmywm2n0"))))
+ (build-system python-build-system)
+ (inputs
+ `(("python-setuptools" ,python-setuptools)))
+ (home-page "http://labix.org/python-dateutil")
+ (synopsis
+ "Extensions to the standard datetime module, available in Python 2.3+")
+ (description
+ "The dateutil module provides powerful extensions to the standard
+datetime module, available in Python 2.3+.")
+ (license psfl)))
+
+(define-public python2-dateutil
+ (package-with-python2 python-dateutil))
+
+
+(define-public python2-pysqlite
+ (package
+ (name "python2-pysqlite")
+ (version "2.6.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://pysqlite.googlecode.com/files/pysqlite-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0nsqqfp072rgqbls100rdvbzkjkin7li3kprhfxlfqvzf608hlqd"))))
+ (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.")
+ (description
+ "Pysqlite provides SQLite bindings for Python that comply to the
+Database API 2.0T.")
+ (license license:zlib)))
+
+
+(define-public python2-mechanize
+ (package
+ (name "python2-mechanize")
+ (version "0.2.5")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://pypi.python.org/packages/source/m/mechanize/mechanize-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0rj7r166i1dyrq0ihm5rijfmvhs8a04im28lv05c0c3v206v4rrf"))))
+ (build-system python-build-system)
+ (inputs
+ `(("python2-setuptools" ,python2-setuptools)))
+ (arguments
+ `(#:python ,python-2 ; apparently incompatible with Python 3
+ #:tests? #f))
+ ;; test fails with message
+ ;; AttributeError: 'module' object has no attribute 'test_pullparser'
+ ;; (python-3.3.2) or
+ ;; AttributeError: 'module' object has no attribute 'test_urllib2_localnet'
+ ;; (python-2.7.5).
+ ;; The source code is from March 2011 and probably not up-to-date
+ ;; with respect to python unit tests.
+ (home-page "http://wwwsearch.sourceforge.net/mechanize/")
+ (synopsis
+ "Stateful programmatic web browsing in Python")
+ (description
+ "Mechanize implements stateful programmatic web browsing in Python,
+after Andy Lester’s Perl module WWW::Mechanize.")
+ (license (bsd-style "file://COPYING"
+ "See COPYING in the distribution."))))
+
+
+(define-public python-simplejson
+ (package
+ (name "python-simplejson")
+ (version "3.3.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://pypi.python.org/packages/source/s/simplejson/simplejson-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "07wsry5j44l5zzm74l4j2bvasiq8n5m32f31n2p7c68i5vc6p2ks"))))
+ (build-system python-build-system)
+ (home-page "http://simplejson.readthedocs.org/en/latest/")
+ (synopsis
+ "Json library for Python")
+ (description
+ "JSON (JavaScript Object Notation) is a subset of JavaScript syntax
+(ECMA-262 3rd edition) used as a lightweight data interchange format.
+
+Simplejson exposes an API familiar to users of the standard library marshal
+and pickle modules. It is the externally maintained version of the json
+library contained in Python 2.6, but maintains compatibility with Python 2.5
+and (currently) has significant performance advantages, even without using
+the optional C extension for speedups. Simplejson is also supported on
+Python 3.3+.")
+ (license x11)))
+
+(define-public python2-simplejson
+ (package-with-python2 python-simplejson))
+
+
+(define-public python2-pyicu
+ (package
+ (name "python2-pyicu")
+ (version "1.5")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://pypi.python.org/packages/source/P/PyICU/PyICU-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "011vwflpir8wvh48mvi6d9a7vw0f43bkwv0w6bzxbzmvz20ax5vm"))))
+ (build-system python-build-system)
+ (inputs
+ `(("icu4c" ,icu4c)))
+ (arguments
+ `(#:python ,python-2 ; Python 3 works also, but needs special care for
+ ; linking with libpython3.3m
+ #:tests? #f)) ; no check target
+ (home-page "http://pyicu.osafoundation.org/")
+ (synopsis
+ "Python extension wrapping the ICU C++ API.")
+ (description
+ "PyICU is a python extension wrapping the ICU C++ API.")
+ (license x11)))
diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm
index 9c9355c4d6..6330fabcf9 100644
--- a/gnu/packages/qemu.scm
+++ b/gnu/packages/qemu.scm
@@ -94,7 +94,7 @@
`(;; ("mesa" ,mesa)
;; ("libaio" ,libaio)
("glib" ,glib)
- ("python" ,python)
+ ("python" ,python-2) ; incompatible with Python 3 according to error message
("ncurses" ,ncurses)
("libpng" ,libpng)
("libjpeg" ,libjpeg-8)
diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm
index b016442908..e0199bce90 100644
--- a/gnu/packages/samba.scm
+++ b/gnu/packages/samba.scm
@@ -150,7 +150,7 @@ anywhere.")
("patchelf" ,patchelf))) ; for (guix build rpath)
(native-inputs ; for the test suite
`(("perl" ,perl)
- ("python" ,python)))
+ ("python" ,python-wrapper)))
(home-page "http://www.samba.org/")
(synopsis
"The standard Windows interoperability suite of programs for GNU and Unix")
diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm
index 7c733f9575..9af0365812 100644
--- a/gnu/packages/system.scm
+++ b/gnu/packages/system.scm
@@ -25,7 +25,39 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages ncurses)
- #:use-module (gnu packages linux))
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages pkg-config))
+
+(define-public dmd
+ (package
+ (name "dmd")
+ (version "-0.4")
+ (source (origin
+ (method url-fetch)
+
+ ;; XXX: Temporary location until dmd gets back home.
+ (uri (string-append
+ "http://www.fdn.fr/~lcourtes/software/guix/dmd-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "094ja3xvk9ljghhxmy39if67cfjd1hy6m4svnp399n0wpxvaryvy"))))
+ (build-system gnu-build-system)
+ (arguments
+ '(#:configure-flags '("--localstatedir=/var")))
+ (inputs `(("pkg-config" ,pkg-config)
+ ("guile" ,guile-2.0)))
+ (synopsis "Daemon managing daemons")
+ (description "'DMD' is a \"Daemon managing Daemons\" (or
+\"Daemons-managing Daemon\"?)---i.e. a service manager that provides a
+replacement for the service-managing capabilities of SysV-init (or any other
+init) with a both powerful and beautiful dependency-based system with a
+convenient interface. It is intended for use on GNU/Hurd, but it is supposed
+to work on every POSIX-like system where Guile is available. In particular,
+it has been tested on GNU/Linux.")
+ (license gpl3+)
+ (home-page "http://www.gnu.org/software/dmd/")))
(define-public dfc
(package
diff --git a/gnu/packages/texlive.scm b/gnu/packages/texlive.scm
index a0d57444e3..7c6f82b9c9 100644
--- a/gnu/packages/texlive.scm
+++ b/gnu/packages/texlive.scm
@@ -81,7 +81,7 @@
("pkg-config" ,pkg-config)
;; FIXME: Add interpreters fontforge and ruby,
;; once they are available.
- ("python" ,python)
+ ("python" ,python-2) ; incompatible with Python 3 (print syntax)
("tcsh" ,tcsh)
("teckit" ,teckit)
("t1lib" ,t1lib)
@@ -202,7 +202,7 @@ world.")
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; no `check' target
(inputs `(("texinfo" ,texinfo)
- ("python" ,python)
+ ("python" ,python-2) ; incompatible with Python 3 (print syntax)
("which" ,which)))
(home-page "https://launchpad.net/rubber")
(synopsis "Rubber, a wrapper for LaTeX and friends")
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 14404f0bfe..42b5d5fe99 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -58,7 +58,9 @@
;; require Zsh.
`(("gettext" ,guix:gettext)))
(arguments
- `(#:tests? #f)) ; no test target
+ `(#:tests? #f ; no test target
+ #:python ,python-2)) ; Python 3 apparently not yet supported, see
+ ; https://answers.launchpad.net/bzr/+question/229048
(home-page "https://gnu.org/software/bazaar")
(synopsis "Decentralized revision control system")
(description
@@ -86,7 +88,7 @@ from a command line or use a GUI application.")
("gettext" ,guix:gettext)
("openssl" ,openssl)
("perl" ,perl)
- ("python" ,python) ; CAVEAT: incompatible with python-3 according to INSTALL
+ ("python" ,python-2) ; CAVEAT: incompatible with python-3 according to INSTALL
("zlib" ,zlib)))
(arguments
`(#:make-flags `("V=1") ; more verbose compilation
@@ -126,7 +128,7 @@ everything from small to very large projects with speed and efficiency.")
`(("apr" ,apr)
("apr-util" ,apr-util)
("perl" ,perl)
- ("python" ,python)
+ ("python" ,python-2) ; incompatible with Python 3 (print syntax)
("sqlite" ,sqlite)
("zlib" ,zlib)))
(home-page "http://subversion.apache.org/")
diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm
index 2f9d64b81a..28c99b1f8c 100644
--- a/gnu/packages/xml.scm
+++ b/gnu/packages/xml.scm
@@ -66,7 +66,7 @@ things the parser might find in the XML document (like start tags).")
(home-page "http://www.xmlsoft.org/")
(synopsis "libxml2, a C parser for XML")
(inputs `(("perl" ,perl)
- ("python" ,python)
+ ("python" ,python-2) ; incompatible with Python 3 (print syntax)
("zlib" ,zlib)))
(arguments
`(#:phases
@@ -102,7 +102,7 @@ things the parser might find in the XML document (like start tags).")
(synopsis "libxslt, a C library for applying XSLT stylesheets to XML documents")
(inputs `(("libgcrypt" ,libgcrypt)
("libxml2" ,libxml2)
- ("python" ,python)
+ ("python" ,python-wrapper)
("zlib" ,zlib)))
(description
"Libxslt is an XSLT C library developed for the GNOME project. It is
diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm
index 98f104b0b6..0659c8d10c 100644
--- a/gnu/packages/xorg.scm
+++ b/gnu/packages/xorg.scm
@@ -1857,7 +1857,7 @@ tracking.")
"0ds4qg6slidrzyz6q9ckq0a19hn6blzpnvciy4brh741gn49jpdd"))))
(build-system gnu-build-system)
(inputs
- `(("pkg-config" ,pkg-config) ("python" ,python)))
+ `(("pkg-config" ,pkg-config) ("python" ,python-wrapper)))
(home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
@@ -1929,6 +1929,11 @@ tracking.")
`(("libxcursor" ,libxcursor)
("pkg-config" ,pkg-config)
("xcursorgen" ,xcursorgen)))
+ (arguments
+ `(#:configure-flags
+ (list (string-append "--with-cursordir="
+ (assoc-ref %outputs "out")
+ "/share/icons"))))
(home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
@@ -4169,7 +4174,7 @@ tracking.")
("libxml2" ,libxml2)
("makedepend" ,makedepend)
("pkg-config" ,pkg-config)
- ("python" ,python)))
+ ("python" ,python-2))) ; incompatible with Python 3 (print syntax)
(arguments
`(#:configure-flags
`("--with-gallium-drivers=r600,svga,swrast") ; drop r300 from the default list as it requires llvm
@@ -4215,7 +4220,7 @@ emulation to complete hardware acceleration for modern GPUs.")
`(("xcb-proto" ,xcb-proto)
("libxslt" ,libxslt)
("pkg-config" ,pkg-config)
- ("python" ,python)))
+ ("python" ,python-wrapper)))
(home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
@@ -4270,7 +4275,7 @@ emulation to complete hardware acceleration for modern GPUs.")
("mesa" ,mesa)
("openssl" ,openssl)
("pkg-config" ,pkg-config)
- ("python" ,python)
+ ("python" ,python-wrapper)
("recordproto" ,recordproto)
("resourceproto" ,resourceproto)
("scrnsaverproto" ,scrnsaverproto)
diff --git a/gnu/packages/yasm.scm b/gnu/packages/yasm.scm
index 51cd3ed0a5..a990d08174 100644
--- a/gnu/packages/yasm.scm
+++ b/gnu/packages/yasm.scm
@@ -40,7 +40,7 @@
"0cfg7ji3ia2in628w42wrfvw2ixmmm4rghwmv2k202mraysgm3vn"))))
(build-system gnu-build-system)
(inputs
- `(("python" ,python)
+ `(("python" ,python-wrapper)
("xmlto" ,xmlto)))
(home-page "http://yasm.tortall.net/")
(synopsis "Rewrite of the NASM assembler")
diff --git a/gnu/packages/zip.scm b/gnu/packages/zip.scm
index 934acdc316..f505d053c6 100644
--- a/gnu/packages/zip.scm
+++ b/gnu/packages/zip.scm
@@ -120,7 +120,8 @@ UnZip recreates the stored directory structure by default.")
(build-system gnu-build-system)
(inputs `(("perl" ,perl) ; for the documentation
("pkg-config" ,pkg-config)
- ("python" ,python) ; for the documentation
+ ("python" ,python-2) ; for the documentation; Python 3 not supported,
+ ; http://forums.gentoo.org/viewtopic-t-863161-start-0.html
("zip" ,zip) ; to create test files
("zlib" ,zlib)))
(arguments
diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm
new file mode 100644
index 0000000000..1e8767e357
--- /dev/null
+++ b/gnu/system/dmd.scm
@@ -0,0 +1,126 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system dmd)
+ #:use-module (guix store)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (guix records)
+ #:use-module ((gnu packages system)
+ #:select (mingetty inetutils))
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:export (service?
+ service
+ service-provision
+ service-requirement
+ service-respawn?
+ service-start
+ service-stop
+ service-inputs
+
+ syslog-service
+ mingetty-service
+ dmd-configuration-file))
+
+;;; Commentary:
+;;;
+;;; System services as cajoled by dmd.
+;;;
+;;; Code:
+
+(define-record-type* <service>
+ service make-service
+ service?
+ (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 '())))
+
+(define (mingetty-service store tty)
+ "Return a service to run mingetty on TTY."
+ (let* ((mingetty-drv (package-derivation store mingetty))
+ (mingetty-bin (string-append (derivation->output-path mingetty-drv)
+ "/sbin/mingetty")))
+ (service
+ (provision (list (symbol-append 'term- (string->symbol tty))))
+ (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
+ (inputs `(("mingetty" ,mingetty))))))
+
+(define (syslog-service store)
+ "Return a service that runs 'syslogd' with reasonable default settings."
+
+ (define syslog.conf
+ ;; Snippet adapted from the GNU inetutils manual.
+ (add-text-to-store store "syslog.conf" "
+ # Log all kernel messages, authentication messages of
+ # level notice or higher and anything of level err or
+ # higher to the console.
+ # Don't log private authentication messages!
+ *.err;kern.*;auth.notice;authpriv.none /dev/console
+
+ # Log anything (except mail) of level info or higher.
+ # Don't log private authentication messages!
+ *.info;mail.none;authpriv.none /var/log/messages
+
+ # Same, in a different place.
+ *.info;mail.none;authpriv.none /dev/tty12
+
+ # The authpriv file has restricted access.
+ authpriv.* /var/log/secure
+
+ # Log all the mail messages in one place.
+ mail.* /var/log/maillog
+"))
+
+ (let* ((inetutils-drv (package-derivation store inetutils))
+ (syslogd (string-append (derivation->output-path inetutils-drv)
+ "/libexec/syslogd")))
+ (service
+ (provision '(syslogd))
+ (start `(make-forkexec-constructor ,syslogd
+ "--rcfile" ,syslog.conf))
+ (inputs `(("inetutils" ,inetutils)
+ ("syslog.conf" ,syslog.conf))))))
+
+(define (dmd-configuration-file store services)
+ "Return the dmd configuration file for SERVICES."
+ (define config
+ `(begin
+ (register-services
+ ,@(map (match-lambda
+ (($ <service> provision requirement respawn? start stop)
+ `(make <service>
+ #:provides ',provision
+ #:requires ',requirement
+ #:respawn? ,respawn?
+ #:start ,start
+ #:stop ,stop)))
+ services))
+ (for-each start ',(append-map service-provision services))))
+
+ (add-text-to-store store "dmd.conf"
+ (object->string config)))
+
+;;; dmd.scm ends here
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
new file mode 100644
index 0000000000..b2438b9c5b
--- /dev/null
+++ b/gnu/system/grub.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system grub)
+ #:use-module (guix store)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (guix records)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:export (menu-entry
+ menu-entry?
+ grub-configuration-file))
+
+;;; Commentary:
+;;;
+;;; Configuration of GNU GRUB.
+;;;
+;;; Code:
+
+(define-record-type* <menu-entry>
+ menu-entry make-menu-entry
+ menu-entry?
+ (label menu-entry-label)
+ (linux menu-entry-linux)
+ (linux-arguments menu-entry-linux-arguments
+ (default '()))
+ (initrd menu-entry-initrd))
+
+(define* (grub-configuration-file store entries
+ #:key (default-entry 1) (timeout 5)
+ (system (%current-system)))
+ "Return the GRUB configuration file in STORE for ENTRIES, a list of
+<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
+ (define prologue
+ (format #f "
+set default=~a
+set timeout=~a
+search.file ~a~%"
+ default-entry timeout
+ (any (match-lambda
+ (($ <menu-entry> _ linux)
+ (let* ((drv (package-derivation store linux system))
+ (out (derivation->output-path drv)))
+ (string-append out "/bzImage"))))
+ entries)))
+
+ (define entry->text
+ (match-lambda
+ (($ <menu-entry> label linux arguments initrd)
+ (let ((linux-drv (package-derivation store linux system))
+ (initrd-drv (package-derivation store initrd system)))
+ ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
+ (format #f "menuentry ~s {
+ linux ~a/bzImage ~a
+ initrd ~a/initrd
+}~%"
+ label
+ (derivation->output-path linux-drv)
+ (string-join arguments)
+ (derivation->output-path initrd-drv))))))
+
+ (add-text-to-store store "grub.cfg"
+ (string-append prologue
+ (string-concatenate
+ (map entry->text entries)))
+ '()))
+
+;;; grub.scm ends here
diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm
new file mode 100644
index 0000000000..b2daa13e06
--- /dev/null
+++ b/gnu/system/linux.scm
@@ -0,0 +1,145 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system linux)
+ #:use-module (guix store)
+ #:use-module (guix records)
+ #:use-module (guix derivations)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module ((guix utils) #:select (%current-system))
+ #:export (pam-service
+ pam-entry
+ pam-services->directory
+ %pam-other-services
+ unix-pam-service))
+
+;;; Commentary:
+;;;
+;;; Configuration of Linux-related things, including pluggable authentication
+;;; modules (PAM).
+;;;
+;;; Code:
+
+;; PAM services (see
+;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
+(define-record-type* <pam-service> pam-service
+ make-pam-service
+ pam-service?
+ (name pam-service-name) ; string
+
+ ;; The four "management groups".
+ (account pam-service-account ; list of <pam-entry>
+ (default '()))
+ (auth pam-service-auth
+ (default '()))
+ (password pam-service-password
+ (default '()))
+ (session pam-service-session
+ (default '())))
+
+(define-record-type* <pam-entry> pam-entry
+ make-pam-entry
+ pam-entry?
+ (control pam-entry-control) ; string
+ (module pam-entry-module) ; file name
+ (arguments pam-entry-arguments ; list of strings
+ (default '())))
+
+(define (pam-service->configuration service)
+ "Return the configuration string for SERVICE, to be dumped in
+/etc/pam.d/NAME, where NAME is the name of SERVICE."
+ (define (entry->string type entry)
+ (match entry
+ (($ <pam-entry> control module (arguments ...))
+ (string-append type " "
+ control " " module " "
+ (string-join arguments)
+ "\n"))))
+
+ (match service
+ (($ <pam-service> name account auth password session)
+ (string-concatenate
+ (append (map (cut entry->string "account" <>) account)
+ (map (cut entry->string "auth" <>) auth)
+ (map (cut entry->string "password" <>) password)
+ (map (cut entry->string "session" <>) session))))))
+
+(define (pam-services->directory store services)
+ "Return the derivation to build the configuration directory to be used as
+/etc/pam.d for SERVICES."
+ (let ((names (map pam-service-name services))
+ (files (map (match-lambda
+ ((and service ($ <pam-service> name))
+ (let ((config (pam-service->configuration service)))
+ (add-text-to-store store
+ (string-append name ".pam")
+ config '()))))
+ services)))
+ (define builder
+ '(begin
+ (use-modules (ice-9 match))
+
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (for-each (match-lambda
+ ((name . file)
+ (symlink file (string-append out "/" name))))
+ %build-inputs)
+ #t)))
+
+ (build-expression->derivation store "pam.d" (%current-system)
+ builder
+ (zip names files))))
+
+(define %pam-other-services
+ ;; The "other" PAM configuration, which denies everything (see
+ ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
+ (let ((deny (pam-entry
+ (control "required")
+ (module "pam_deny.so"))))
+ (pam-service
+ (name "other")
+ (account (list deny))
+ (auth (list deny))
+ (password (list deny))
+ (session (list deny)))))
+
+(define unix-pam-service
+ (let ((unix (pam-entry
+ (control "required")
+ (module "pam_unix.so"))))
+ (lambda* (name #:key allow-empty-passwords?)
+ "Return a standard Unix-style PAM service for NAME. When
+ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords."
+ ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
+ (let ((name* name))
+ (pam-service
+ (name name*)
+ (account (list unix))
+ (auth (list (if allow-empty-passwords?
+ (pam-entry
+ (control "required")
+ (module "pam_unix.so")
+ (arguments '("nullok")))
+ unix)))
+ (password (list unix))
+ (session (list unix)))))))
+
+;;; linux.scm ends here
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
new file mode 100644
index 0000000000..71f8e0d771
--- /dev/null
+++ b/gnu/system/shadow.scm
@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system shadow)
+ #:use-module (guix store)
+ #:use-module (ice-9 match)
+ #:export (passwd-file))
+
+;;; Commentary:
+;;;
+;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
+;;;
+;;; Code:
+
+(define* (passwd-file store accounts #:key shadow?)
+ "Return a password file for ACCOUNTS, a list of vectors as returned by
+'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it
+is a /etc/passwd file."
+ ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
+ (define contents
+ (let loop ((accounts accounts)
+ (result '()))
+ (match accounts
+ ((#(name pass uid gid comment home-dir shell) rest ...)
+ (loop rest
+ (cons (if shadow?
+ (string-append name
+ ":" ; XXX: use (crypt PASS …)?
+ ":::::::")
+ (string-append name
+ ":" "x"
+ ":" (number->string uid)
+ ":" (number->string gid)
+ ":" comment ":" home-dir ":" shell))
+ result)))
+ (()
+ (string-join (reverse result) "\n" 'suffix)))))
+
+ (add-text-to-store store (if shadow? "shadow" "passwd")
+ contents '()))
+
+;;; shadow.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 73543896ef..df55f7c94e 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -33,13 +33,20 @@
#:use-module (gnu packages linux-initrd)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
- #:use-module ((gnu packages system)
- #:select (mingetty))
+ #:use-module (gnu packages system)
+
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system linux)
+ #:use-module (gnu system grub)
+ #:use-module (gnu system dmd)
+
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+
#:export (expression->derivation-in-linux-vm
- qemu-image))
+ qemu-image
+ system-qemu-image))
;;; Commentary:
@@ -75,6 +82,9 @@ DISK-IMAGE-SIZE bytes and return it.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs, as for `derivation'. The files containing the reference graphs are
made available under the /xchg CIFS share."
+ ;; FIXME: Allow use of macros from other modules, as done in
+ ;; `build-expression->derivation'.
+
(define input-alist
(map (match-lambda
((input (? package? package))
@@ -197,10 +207,10 @@ It can be used to provide additional files, such as /etc files."
(define input->name+derivation
(match-lambda
((name (? package? package))
- `(,name . ,(derivation-path->output-path
+ `(,name . ,(derivation->output-path
(package-derivation store package system))))
((name (? package? package) sub-drv)
- `(,name . ,(derivation-path->output-path
+ `(,name . ,(derivation->output-path
(package-derivation store package system)
sub-drv)))
((input (and (? string?) (? store-path?) file))
@@ -294,6 +304,19 @@ It can be used to provide additional files, such as /etc files."
(primitive-load populate)
(chdir "/")))
+ (display "clearing file timestamps...\n")
+ (for-each (lambda (file)
+ (let ((s (lstat file)))
+ ;; XXX: Guile uses libc's 'utime' function
+ ;; (not 'futime'), so the timestamp of
+ ;; symlinks cannot be changed, and there
+ ;; are symlinks here pointing to
+ ;; /nix/store, which is the host,
+ ;; read-only store.
+ (unless (eq? (stat:type s) 'symlink)
+ (utime file 0 0 0 0))))
+ (find-files "/fs" ".*"))
+
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
@@ -327,100 +350,88 @@ It can be used to provide additional files, such as /etc files."
;;;
-;;; Guile 2.0 potluck examples.
+;;; Stand-alone VM image.
;;;
-(define (example1)
- (let ((store #f))
- (dynamic-wind
- (lambda ()
- (set! store (open-connection)))
- (lambda ()
- (parameterize ((%guile-for-build (package-derivation store guile-final)))
- (expression->derivation-in-linux-vm
- store "vm-test"
- '(begin
- (display "hello from boot!\n")
- (call-with-output-file "/xchg/hello"
- (lambda (p)
- (display "world" p)))))))
- (lambda ()
- (close-connection store)))))
-
-(define (/etc/shadow store accounts)
- "Return a /etc/shadow file for ACCOUNTS."
- (define contents
- (let loop ((accounts accounts)
- (result '()))
- (match accounts
- (((name uid gid comment home-dir shell) rest ...)
- (loop rest
- (cons (string-append name "::" (number->string uid)
- ":" (number->string gid)
- comment ":" home-dir ":" shell)
- result)))
- (()
- (string-concatenate-reverse result)))))
-
- (add-text-to-store store "shadow" contents '()))
-
-(define (example2)
- (let ((store #f))
- (dynamic-wind
- (lambda ()
- (set! store (open-connection)))
- (lambda ()
- (parameterize ((%guile-for-build (package-derivation store guile-final)))
- (let* ((bash-drv (package-derivation store bash))
- (bash-file (string-append (derivation-path->output-path bash-drv)
- "/bin/bash"))
- (passwd (/etc/shadow store
- `(("root" 0 0 "System administrator" "/"
- ,bash-file))))
- (populate
- (add-text-to-store store "populate-qemu-image"
- (object->string
- `(begin
- (mkdir-p "etc")
- (symlink ,(substring passwd 1)
- "etc/shadow")))
- (list passwd)))
- (out (derivation-path->output-path
- (package-derivation store mingetty)))
- (getty (string-append out "/sbin/mingetty"))
- (boot (add-text-to-store store "boot"
- (object->string
- `(begin
- ;; Become the session leader,
- ;; so that mingetty can do
- ;; 'TIOCSCTTY'.
- (setsid)
-
- ;; Directly into mingetty.
- (execl ,getty "mingetty"
- "--noclear" "tty1")))
- (list out)))
- (entries (list (menu-entry
- (label "Boot-to-Guile! (GNU System technology preview)")
- (linux linux-libre)
- (linux-arguments `("--root=/dev/vda1"
- ,(string-append "--load=" boot)))
- (initrd gnu-system-initrd))))
- (grub.cfg (grub-configuration-file store entries)))
- (qemu-image store
- #:grub-configuration grub.cfg
- #:populate populate
- #:disk-image-size (* 400 (expt 2 20))
- #:inputs-to-copy `(("boot" ,boot)
- ("linux" ,linux-libre)
- ("initrd" ,gnu-system-initrd)
- ("coreutils" ,coreutils)
- ("bash" ,bash)
- ("guile" ,guile-2.0)
- ("mingetty" ,mingetty)
-
- ("shadow" ,passwd))))))
- (lambda ()
- (close-connection store)))))
+(define (system-qemu-image store)
+ "Return the derivation of a QEMU image of the GNU system."
+ (define %pam-services
+ ;; Services known to PAM.
+ (list %pam-other-services
+ (unix-pam-service "login" #:allow-empty-passwords? #t)))
+
+ (define %dmd-services
+ ;; Services run by dmd.
+ (list (mingetty-service store "tty1")
+ (mingetty-service store "tty2")
+ (mingetty-service store "tty3")
+ (syslog-service store)))
+
+ (parameterize ((%guile-for-build (package-derivation store guile-final)))
+ (let* ((bash-drv (package-derivation store bash))
+ (bash-file (string-append (derivation->output-path bash-drv)
+ "/bin/bash"))
+ (dmd-drv (package-derivation store dmd))
+ (dmd-file (string-append (derivation->output-path dmd-drv)
+ "/bin/dmd"))
+ (dmd-conf (dmd-configuration-file store %dmd-services))
+ (accounts (list (vector "root" "" 0 0 "System administrator"
+ "/" bash-file)))
+ (passwd (passwd-file store accounts))
+ (shadow (passwd-file store accounts #:shadow? #t))
+ (group (add-text-to-store store "group"
+ "root:x:0:\n"))
+ (pam.d-drv (pam-services->directory store %pam-services))
+ (pam.d (derivation->output-path pam.d-drv))
+ (populate
+ (add-text-to-store store "populate-qemu-image"
+ (object->string
+ `(begin
+ (mkdir-p "etc")
+ (mkdir-p "var/log") ; for dmd
+ (symlink ,shadow "etc/shadow")
+ (symlink ,passwd "etc/passwd")
+ (symlink ,group "etc/group")
+ (symlink "/dev/null"
+ "etc/login.defs")
+ (symlink ,pam.d "etc/pam.d")
+ (mkdir-p "var/run")))
+ (list passwd)))
+ (out (derivation->output-path
+ (package-derivation store mingetty)))
+ (boot (add-text-to-store store "boot"
+ (object->string
+ `(execl ,dmd-file "dmd"
+ "--config" ,dmd-conf))
+ (list out)))
+ (entries (list (menu-entry
+ (label "Boot-to-Guile! (GNU System technology preview)")
+ (linux linux-libre)
+ (linux-arguments `("--root=/dev/vda1"
+ ,(string-append "--load=" boot)))
+ (initrd gnu-system-initrd))))
+ (grub.cfg (grub-configuration-file store entries)))
+ (build-derivations store (list pam.d-drv))
+ (qemu-image store
+ #:grub-configuration grub.cfg
+ #:populate populate
+ #:disk-image-size (* 400 (expt 2 20))
+ #:inputs-to-copy `(("boot" ,boot)
+ ("linux" ,linux-libre)
+ ("initrd" ,gnu-system-initrd)
+ ("coreutils" ,coreutils)
+ ("bash" ,bash)
+ ("guile" ,guile-2.0)
+ ("mingetty" ,mingetty)
+ ("dmd" ,dmd)
+
+ ;; Configuration.
+ ("dmd.conf" ,dmd-conf)
+ ("etc-pam.d" ,pam.d)
+ ("etc-passwd" ,passwd)
+ ("etc-shadow" ,shadow)
+ ("etc-group" ,group)
+ ,@(append-map service-inputs
+ %dmd-services))))))
;;; vm.scm ends here