diff options
| -rw-r--r-- | gnu/tests/container.scm | 113 | ||||
| -rw-r--r-- | gnu/tests/container/test-system.scm | 26 |
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 |