aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/tests/container.scm113
-rw-r--r--gnu/tests/container/test-system.scm26
2 files changed, 139 insertions, 0 deletions
diff --git a/gnu/tests/container.scm b/gnu/tests/container.scm
new file mode 100644
index 0000000000..4343cf97b2
--- /dev/null
+++ b/gnu/tests/container.scm
@@ -0,0 +1,113 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 tests container)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system vm)
+ #:use-module (gnu packages gnupg) ;; For libgcrypt
+ #:use-module (gnu packages package-management)
+ #:use-module (gnu services)
+ #:use-module (gnu services admin)
+ #:use-module (gnu services web)
+ #:use-module (gnu services networking)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:use-module (guix modules)
+ #:use-module (guix monads)
+ #:export (%test-guix-system-container))
+
+(define %os
+ (simple-operating-system
+ (service nginx-service-type
+ (nginx-configuration))))
+
+(define %vm
+ (virtual-machine
+ (operating-system
+ (marionette-operating-system
+ %os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (port-forwardings '())))
+
+(define %test-guix-system-container
+ (system-test
+ (name "guix-system-container")
+ (description "Test a system container created through the guix system
+container command.")
+ (value
+ (gexp->derivation
+ name
+ (with-imported-modules (source-module-closure
+ '((gnu build marionette)))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (ice-9 match)
+ (ice-9 rdelim)
+ (ice-9 popen)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette (list #$%vm)))
+
+ (define libgcrypt #$libgcrypt)
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "guix-system-container")
+
+ (display (environ))
+ (display "\n")
+
+ (marionette-eval
+ '(use-modules (ice-9 popen)
+ (ice-9 rdelim))
+ marionette)
+
+ (let ((start-script
+ (marionette-eval
+ '(let* ((command
+ '("guix" "system" "container"
+ #$(local-file "./container/test-system.scm")))
+ (pipe (apply open-pipe* OPEN_READ command))
+ (str (read-line pipe))
+ (status (close-pipe pipe)))
+
+ (display (environ))
+ (display "\n")
+
+ (apply system* command)
+
+ (simple-format #t "output: ~A\n" str)
+
+ (if (zero? status)
+ str
+ status))
+ marionette)))
+
+ (simple-format #t "start script: ~A\n" start-script)
+
+ (test-assert "start script created"
+ (string? start-script)))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0))))))))
diff --git a/gnu/tests/container/test-system.scm b/gnu/tests/container/test-system.scm
new file mode 100644
index 0000000000..03b26a691a
--- /dev/null
+++ b/gnu/tests/container/test-system.scm
@@ -0,0 +1,26 @@
+(define-module (gnu tests container test-system)
+ #:use-module (gnu)
+ #:use-module (gnu packages package-management)
+ #:export (%system))
+
+(define %system
+ (operating-system
+ (host-name "guix-container")
+ (timezone "Europe/Berlin")
+ (locale "en_US.utf8")
+
+ (packages (cons* guix
+ %base-packages))
+
+ ;; TODO file-systems is redundant
+ (file-systems
+ (cons (file-system
+ (device "my-root")
+ (title 'label)
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems))
+
+ (bootloader (grub-configuration (device "/dev/sdX")))))
+
+%system