hydra: Add 'qemu-image' job.

* build-aux/hydra/demo-os.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.
* build-aux/hydra/gnu-system.scm (qemu-jobs): New procedure.
  (hydra-jobs): Use it.
* guix/scripts/system.scm (read-operating-system): Export.
This commit is contained in:
Ludovic Courtès 2014-04-05 22:40:16 +02:00
parent 512314d738
commit 731b996255
4 changed files with 100 additions and 3 deletions

View File

@ -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 \

View File

@ -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)))

View File

@ -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)

View File

@ -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.