[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
13/13: services: hurd-vm: Add system test.
From: |
guix-commits |
Subject: |
13/13: services: hurd-vm: Add system test. |
Date: |
Tue, 29 Sep 2020 16:06:15 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit c11c19bd4d0dc4ec56b949647057dbf00567f2ae
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Sep 29 21:33:49 2020 +0200
services: hurd-vm: Add system test.
* gnu/tests/virtualization.scm (%childhurd-os): New variable.
(run-childhurd-test): New procedure.
(%test-childhurd): New variable.
---
gnu/tests/virtualization.scm | 141 ++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 140 insertions(+), 1 deletion(-)
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
index fbdec20..9d38169 100644
--- a/gnu/tests/virtualization.scm
+++ b/gnu/tests/virtualization.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,9 +27,16 @@
#:use-module (gnu services networking)
#:use-module (gnu services virtualization)
#:use-module (gnu packages virtualization)
+ #:use-module (gnu packages ssh)
#:use-module (guix gexp)
#:use-module (guix store)
- #:export (%test-libvirt))
+ #:export (%test-libvirt
+ %test-childhurd))
+
+
+;;;
+;;; Libvirt.
+;;;
(define %libvirt-os
(simple-operating-system
@@ -93,3 +101,134 @@
(name "libvirt")
(description "Connect to the running LIBVIRT service.")
(value (run-libvirt-test))))
+
+
+;;;
+;;; GNU/Hurd virtual machines, aka. childhurds.
+;;;
+
+(define %childhurd-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service hurd-vm-service-type)))
+
+(define (run-childhurd-test)
+ (define os
+ (marionette-operating-system
+ %childhurd-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (memory-size (* 1024 3))))
+
+ (define run-uname-over-ssh
+ ;; Program that runs 'uname' over SSH and prints the result on standard
+ ;; output.
+ (let ()
+ (define run
+ (with-extensions (list guile-ssh)
+ #~(begin
+ (use-modules (ssh session)
+ (ssh auth)
+ (ssh popen)
+ (ice-9 match)
+ (ice-9 textual-ports))
+
+ (let ((session (make-session #:user "root"
+ #:port 10022
+ #:host "localhost"
+ #:log-verbosity 'rare)))
+ (match (connect! session)
+ ('ok
+ (userauth-password! session "")
+ (display
+ (get-string-all
+ (open-remote-input-pipe* session "uname" "-on"))))
+ (status
+ (error "could not connect to childhurd over SSH"
+ session status)))))))
+
+ (program-file "run-uname-over-ssh" run)))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "childhurd")
+
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'childhurd)
+ (#f #f)
+ (('service response-parts ...)
+ (match (assq-ref response-parts 'running)
+ ((pid) (number? pid))))))
+ marionette))
+
+ (test-equal "childhurd SSH server replies"
+ "SSH"
+ ;; Check from within the guest whether its childhurd's SSH
+ ;; server is reachable. Do that from the guest: port forwarding
+ ;; to the host won't work because QEMU listens on 127.0.0.1.
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 match))
+
+ (let loop ((n 60))
+ (if (zero? n)
+ 'all-attempts-failed
+ (let ((s (socket PF_INET SOCK_STREAM 0))
+ (a (make-socket-address AF_INET
+ INADDR_LOOPBACK
+ 10022)))
+ (format #t "connecting to childhurd SSH server...~%")
+ (connect s a)
+ (match (get-string-n s 3)
+ ((? eof-object?)
+ (close-port s)
+ (sleep 1)
+ (loop (- n 1)))
+ (str
+ (close-port s)
+ str))))))
+ marionette))
+
+ (test-equal "SSH up and running"
+ "childhurd GNU\n"
+
+ ;; Connect from the guest to the chidhurd over SSH and run the
+ ;; 'uname' command.
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen))
+
+ (get-string-all
+ (open-input-pipe #$run-uname-over-ssh)))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "childhurd-test" test))
+
+(define %test-childhurd
+ (system-test
+ (name "childhurd")
+ (description
+ "Connect to the GNU/Hurd virtual machine service, aka. a childhurd, making
+sure that the childhurd boots and runs its SSH server.")
+ (value (run-childhurd-test))))
- branch master updated (ac324be -> c11c19b), guix-commits, 2020/09/29
- 01/13: services: hurd-vm: Run QEMU as an unprivileged user., guix-commits, 2020/09/29
- 02/13: services: childhurd: Tweak description., guix-commits, 2020/09/29
- 03/13: secret-service: Clarify the origin of messages., guix-commits, 2020/09/29
- 07/13: services: hurd-vm: Pass "-no-reboot" when spawning the Hurd VM., guix-commits, 2020/09/29
- 04/13: services: hurd-vm: Check whether /dev/kvm exists at run time., guix-commits, 2020/09/29
- 05/13: services: guix: Generate key pair if needed during activation., guix-commits, 2020/09/29
- 06/13: services: hurd-vm: Initialize the guest's SSH/Guix keys at activation time., guix-commits, 2020/09/29
- 08/13: secret-service: Add a timeout when waiting for a client., guix-commits, 2020/09/29
- 10/13: services: secret-service: Move instance last in the list of services., guix-commits, 2020/09/29
- 13/13: services: hurd-vm: Add system test.,
guix-commits <=
- 11/13: services: secret-service: Add initial client/server handshake., guix-commits, 2020/09/29
- 09/13: secret-service: Fix file port leak in 'secret-service-send-secrets'., guix-commits, 2020/09/29
- 12/13: secret-service: Add proper logging procedure and log to syslog., guix-commits, 2020/09/29