4 files changed, 100 insertions(+), 3 deletions(-)

M Makefile.am
A build-aux/hydra/demo-os.scm
M build-aux/hydra/gnu-system.scm
M guix/scripts/system.scm

@@ 186,6 186,7 @@ EXTRA_DIST =					\
   TODO						\
   .dir-locals.el				\
   build-aux/hydra/gnu-system.scm		\
+  build-aux/hydra/demo-os.scm			\
   build-aux/hydra/guix.scm			\
   build-aux/check-available-binaries.scm	\
   build-aux/download.scm			\

@@ 0,0 1,62 @@
+;;; 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/>.
+
+
+;;;
+;;; This file defines an operating system configuration for the demo virtual
+;;; machine images that we build.
+;;;
+
+(use-modules (gnu packages emacs)
+             (gnu packages xorg)
+             (gnu packages base)
+             (gnu packages admin)
+             (gnu packages guile)
+             (gnu packages bash)
+             (gnu packages linux)
+             (gnu packages less)
+             (gnu packages tor)
+
+             (gnu system shadow)                  ; 'user-account'
+             (gnu services base)
+             (gnu services networking)
+             (gnu services xorg))
+
+(operating-system
+ (host-name "gnu")
+ (timezone "Europe/Paris")
+ (locale "en_US.UTF-8")
+ (users (list (user-account
+               (name "guest")
+               (uid 1000) (gid 100)
+               (comment "Guest of GNU")
+               (home-directory "/home/guest"))))
+ (services (cons* (slim-service #:auto-login? #f
+                                #:default-user "root")
+
+                  ;; QEMU networking settings.
+                  (static-networking-service "eth0" "10.0.2.10"
+                                             #:name-servers '("10.0.2.3")
+                                             #:gateway "10.0.2.2")
+
+                  %base-services))
+ (packages (list bash coreutils findutils grep sed
+                 procps psmisc less
+                 guile-2.0 dmd util-linux inetutils
+                 xterm emacs
+                 tor)))

@@ 36,10 36,14 @@
                      dir)
              (set! %load-path (cons dir %load-path))))))
 
-(use-modules (guix store)
+(use-modules (guix config)
+             (guix store)
              (guix packages)
              (guix derivations)
+             (guix monads)
+             ((guix licenses) #:select (gpl3+))
              ((guix utils) #:select (%current-system))
+             ((guix scripts system) #:select (read-operating-system))
              (gnu packages)
              (gnu packages gcc)
              (gnu packages base)


@@ 49,6 53,8 @@
              (gnu packages compression)
              (gnu packages multiprecision)
              (gnu packages make-bootstrap)
+             (gnu system)
+             (gnu system vm)
              (srfi srfi-1)
              (srfi srfi-26)
              (ice-9 match))


@@ 108,6 114,32 @@ SYSTEM."
   '("mips64el-linux-gnu"
     "mips64el-linux-gnuabi64"))
 
+(define (qemu-jobs store system)
+  "Return a list of jobs that build QEMU images for SYSTEM."
+  (define (->alist drv)
+    `((derivation . ,drv)
+      (description . "Stand-alone QEMU image of the GNU system")
+      (long-description . "This is a demo stand-alone QEMU image of the GNU
+system.")
+      (license . ,gpl3+)
+      (home-page . ,%guix-home-page-url)
+      (maintainers . ("bug-guix@gnu.org"))))
+
+  (define (->job name drv)
+    (let ((name (symbol-append name (string->symbol ".")
+                               (string->symbol system))))
+      `(,name . ,(->alist drv))))
+
+  (if (string=? system "x86_64-linux")
+      (let* ((dir  (dirname (assoc-ref (current-source-location) 'filename)))
+             (file (string-append dir "/demo-os.scm"))
+             (os   (read-operating-system file)))
+        (if (operating-system? os)
+            (list (->job 'qemu-image
+                         (run-with-store store (system-qemu-image os))))
+            '()))
+      '()))
+
 (define (hydra-jobs store arguments)
   "Return Hydra jobs."
   (define systems


@@ 156,7 188,8 @@ SYSTEM."
                                           (cons (package-job store (job-name package)
                                                              package system)
                                                 result)))
-                                    (cross-jobs system)))
+                                    (append (qemu-jobs store system)
+                                            (cross-jobs system))))
                     ((core)
                      ;; Build core packages only.
                      (append (map (lambda (package)

@@ 28,7 28,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:export (guix-system))
+  #:export (guix-system
+            read-operating-system))
 
 (define %user-module
   ;; Module in which the machine description file is loaded.