From fe933833504c90eb40b0d2c71847675b31c142b4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 23 Nov 2016 13:56:42 +0100 Subject: marionette: Add 'marionette-screen-text' using OCR. * gnu/build/marionette.scm (marionette-screen-text): New procedure. * gnu/tests/base.scm (run-basic-test)["screen text"]: New test. --- gnu/tests/base.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'gnu/tests') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 9a265309c0..3be1c55b41 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -31,6 +31,8 @@ #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (gnu services networking) + #:use-module (gnu packages imagemagick) + #:use-module (gnu packages ocr) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) @@ -241,6 +243,20 @@ info --version") marionette) (file-exists? "tty1.ppm"))) + (test-assert "screen text" + (let ((text (marionette-screen-text marionette + #:ocrad + #$(file-append ocrad + "/bin/ocrad")))) + ;; Check whether the welcome message and shell prompt are + ;; displayed. Note: OCR confuses "y" and "V" for instance, so + ;; we cannot reliably match the whole text. + (and (string-contains text "This is the GNU") + (string-contains text + (string-append + "root@" + #$(operating-system-host-name os)))))) + (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) -- cgit v1.2.3 From f7f292d359e0eb77617f4ecf6b3164f868ec1784 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 23 Nov 2016 20:59:13 +0100 Subject: install: Enable "cryptodisk" handling in GRUB. This allows 'grub-install' to do the right thing when / or /boot is a LUKS-encrypted partition. Fixes . * gnu/build/install.scm (install-grub): Add 'setenv' to set 'GRUB_ENABLE_CRYPTODISK'. (wait-for-screen-text): New test. * gnu/tests/base.scm (run-basic-test): Add #:initialization parameter and honor it. * gnu/tests/install.scm (%encrypted-root-os)[kernel-arguments]: Remove. (%encrypted-root-installation-script): Pass '--uuid' to 'cryptsetup luksFormat'. Remove 'sed' invocation. (enter-luks-passphrase): New procedure. (%test-encrypted-os)[value]: Pass #:initialization to 'run-basic-test'. --- gnu/build/install.scm | 5 ++++ gnu/build/marionette.scm | 19 ++++++++++++++ gnu/tests/base.scm | 13 ++++++++-- gnu/tests/install.scm | 66 ++++++++++++++++++++++++++++++++++++++++-------- 4 files changed, 90 insertions(+), 13 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 3d1594e203..5c2b35632d 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -46,6 +46,11 @@ Note that the caller must make sure that GRUB.CFG is registered as a GC root so that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd." (install-grub-config grub.cfg mount-point) + + ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root + ;; partition. + (setenv "GRUB_ENABLE_CRYPTODISK" "y") + (unless (zero? (system* "grub-install" "--no-floppy" "--boot-directory" (string-append mount-point "/boot") diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 8070b6b439..506d6da420 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -27,6 +27,7 @@ marionette-eval marionette-control marionette-screen-text + wait-for-screen-text %qwerty-us-keystrokes marionette-type)) @@ -204,6 +205,24 @@ this by invoking OCRAD (file name for GNU Ocrad's command)" (lambda () (false-if-exception (delete-file image)))))) +(define* (wait-for-screen-text marionette predicate + #:key (timeout 30) (ocrad "ocrad")) + "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches +PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded." + (define start + (car (gettimeofday))) + + (define end + (+ start timeout)) + + (let loop () + (if (> (car (gettimeofday)) end) + (error "'wait-for-screen-text' timeout" predicate) + (or (predicate (marionette-screen-text marionette #:ocrad ocrad)) + (begin + (sleep 1) + (loop)))))) + (define %qwerty-us-keystrokes ;; Maps "special" characters to their keystrokes. '((#\newline . "ret") diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 3be1c55b41..86242d9665 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -67,10 +67,16 @@ %base-user-accounts)))) -(define* (run-basic-test os command #:optional (name "basic")) +(define* (run-basic-test os command #:optional (name "basic") + #:key initialization) "Return a derivation called NAME that tests basic features of the OS started using COMMAND, a gexp that evaluates to a list of strings. Compare some -properties of running system to what's declared in OS, an ." +properties of running system to what's declared in OS, an . + +When INITIALIZATION is true, it must be a one-argument procedure that is +passed a gexp denoting the marionette, and it must return gexp that is +inserted before the first test. This is used to introduce an extra +initialization step, such as entering a LUKS passphrase." (define test (with-imported-modules '((gnu build marionette)) #~(begin @@ -88,6 +94,9 @@ properties of running system to what's declared in OS, an ." (test-begin "basic") + #$(and initialization + (initialization #~marionette)) + (test-assert "uname" (match (marionette-eval '(uname) marionette) (#("Linux" host-name version _ architecture) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 98f8649af8..ecf1ac1923 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -24,6 +24,7 @@ #:use-module (gnu system install) #:use-module (gnu system vm) #:use-module ((gnu build vm) #:select (qemu-command)) + #:use-module (gnu packages ocr) #:use-module (gnu packages qemu) #:use-module (gnu packages package-management) #:use-module (guix store) @@ -398,17 +399,20 @@ by 'mdadm'.") (locale "en_US.UTF-8") (bootloader (grub-configuration (device "/dev/vdb"))) - (kernel-arguments '("console=ttyS0")) + + ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt + ;; detection logic in 'enter-luks-passphrase'. + + (mapped-devices (list (mapped-device + (source (uuid "12345678-1234-1234-1234-123456789abc")) + (target "the-root-device") + (type luks-device-mapping)))) (file-systems (cons (file-system (device "/dev/mapper/the-root-device") (title 'device) (mount-point "/") (type "ext4")) %base-file-systems)) - (mapped-devices (list (mapped-device - (source "REPLACE-WITH-LUKS-UUID") - (target "the-root-device") - (type luks-device-mapping)))) (users (cons (user-account (name "charlie") (group "users") @@ -435,7 +439,8 @@ parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 3M 1G \\ set 1 boot on \\ set 1 bios_grub on -echo -n thepassphrase | cryptsetup luksFormat -q /dev/vdb2 - +echo -n thepassphrase | \\ + cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 - echo -n thepassphrase | \\ cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device mkfs.ext4 -L my-root /dev/mapper/the-root-device @@ -443,15 +448,53 @@ mount LABEL=my-root /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm -cat /mnt/etc/config -luks_uuid=`cryptsetup luksUUID /dev/vdb2` -sed -i /mnt/etc/config.scm \\ - -e \"s/\\\"REPLACE-WITH-LUKS-UUID\\\"/(uuid \\\"$luks_uuid\\\")/g\" guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") +(define (enter-luks-passphrase marionette) + "Return a gexp to be inserted in the basic system test running on MARIONETTE +to enter the LUKS passphrase." + (let ((ocrad (file-append ocrad "/bin/ocrad"))) + #~(begin + (define (passphrase-prompt? text) + (string-contains (pk 'screen-text text) "Enter pass")) + + (define (bios-boot-screen? text) + ;; Return true if TEXT corresponds to the boot screen, before GRUB's + ;; menu. + (string-prefix? "SeaBIOS" text)) + + (test-assert "enter LUKS passphrase for GRUB" + (begin + ;; At this point we have no choice but to use OCR to determine + ;; when the passphrase should be entered. + (wait-for-screen-text #$marionette passphrase-prompt? + #:ocrad #$ocrad) + (marionette-type "thepassphrase\n" #$marionette) + + ;; Now wait until we leave the boot screen. This is necessary so + ;; we can then be sure we match the "Enter passphrase" prompt from + ;; 'cryptsetup', in the initrd. + (wait-for-screen-text #$marionette (negate bios-boot-screen?) + #:ocrad #$ocrad + #:timeout 20))) + + (test-assert "enter LUKS passphrase for the initrd" + (begin + ;; XXX: Here we use OCR as well but we could instead use QEMU + ;; '-serial stdio' and run it in an input pipe, + (wait-for-screen-text #$marionette passphrase-prompt? + #:ocrad #$ocrad + #:timeout 60) + (marionette-type "thepassphrase\n" #$marionette) + + ;; Take a screenshot for debugging purposes. + (marionette-control (string-append "screendump " #$output + "/post-initrd-passphrase.ppm") + #$marionette)))))) + (define %test-encrypted-os (system-test (name "encrypted-root-os") @@ -465,6 +508,7 @@ build (current-guix) and then store a couple of full system images.") #:script %encrypted-root-installation-script)) (command (qemu-command/writable-image image))) - (run-basic-test %encrypted-root-os command "encrypted-root-os"))))) + (run-basic-test %encrypted-root-os command "encrypted-root-os" + #:initialization enter-luks-passphrase))))) ;;; install.scm ends here -- cgit v1.2.3 From cc73339b97901cf1e50f07a6f0114974b34592c4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 23 Nov 2016 21:10:49 +0100 Subject: tests: Remove 'GUIX_LOCPATH' hack that had been added for glibc@2.23. * gnu/tests/base.scm (run-basic-test)[test]("locale"): Remove 'GUIX_LOCPATH' hack, which is no longer needed since commit 9f58fe3d1c32e3f0ced065e286532a10cad1b5e3. --- gnu/tests/base.scm | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 86242d9665..6370d6951b 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -199,14 +199,8 @@ info --version") (test-equal "locale" "en_US.utf8" - (marionette-eval '(begin - ;; XXX: This 'setenv' call wouldn't be needed - ;; but our glibc@2.23 currently ignores - ;; /run/current-system/locale. - (setenv "GUIX_LOCPATH" - "/run/current-system/locale") - (let ((before (setlocale LC_ALL "en_US.utf8"))) - (setlocale LC_ALL before))) + (marionette-eval '(let ((before (setlocale LC_ALL "en_US.utf8"))) + (setlocale LC_ALL before)) marionette)) (test-assert "/run/current-system is a GC root" -- cgit v1.2.3 From a82f0b36177848eda340d880ae0802c3e26c4ea8 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Sat, 26 Nov 2016 13:51:58 +0800 Subject: tests: Add 'opensmtpd-service-type' test. * gnu/tests/mail.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/local.mk | 1 + gnu/tests/mail.scm | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 160 insertions(+) create mode 100644 gnu/tests/mail.scm (limited to 'gnu/tests') diff --git a/gnu/local.mk b/gnu/local.mk index dfa9c0077d..821533837a 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -447,6 +447,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests.scm \ %D%/tests/base.scm \ %D%/tests/install.scm \ + %D%/tests/mail.scm \ %D%/tests/ssh.scm diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm new file mode 100644 index 0000000000..47328a54ae --- /dev/null +++ b/gnu/tests/mail.scm @@ -0,0 +1,159 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Sou Bunnbu +;;; +;;; 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 . + +(define-module (gnu tests mail) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system grub) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services mail) + #:use-module (gnu services networking) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (guix store) + #:export (%test-opensmtpd)) + +(define %opensmtpd-os + (operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.UTF-8") + (bootloader (grub-configuration (device #f))) + (file-systems %base-file-systems) + (firmware '()) + (services (cons* + (dhcp-client-service) + (service opensmtpd-service-type + (opensmtpd-configuration + (config-file + (plain-file "smtpd.conf" " +listen on 0.0.0.0 +accept from any for local deliver to mbox +")))) + %base-services)))) + +(define (run-opensmtpd-test) + "Return a test of an OS running OpenSMTPD service." + (mlet* %store-monad ((command (system-qemu-image/shared-store-script + (marionette-operating-system + %opensmtpd-os + #:imported-modules '((gnu services herd))) + #:graphic? #f))) + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (rnrs base) + (srfi srfi-64) + (ice-9 rdelim) + (ice-9 regex) + (gnu build marionette)) + + (define marionette + (make-marionette + ;; Enable TCP forwarding of the guest's port 25. + '(#$command "-net" "user,hostfwd=tcp::1025-:25"))) + + (define (read-reply-code port) + "Read a SMTP reply from PORT and return its reply code." + (let* ((line (read-line port)) + (mo (string-match "([0-9]+)([ -]).*" line)) + (code (string->number (match:substring mo 1))) + (finished? (string= " " (match:substring mo 2)))) + (if finished? + code + (read-reply-code port)))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "opensmptd") + + (test-assert "service is running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'smtpd) + #t) + marionette)) + + (test-assert "mbox is empty" + (marionette-eval + '(and (file-exists? "/var/mail") + (not (file-exists? "/var/mail/root"))) + marionette)) + + (test-eq "accept an email" + #t + (let* ((smtp (socket AF_INET SOCK_STREAM 0)) + (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))) + (connect smtp addr) + ;; Be greeted. + (read-reply-code smtp) ;220 + ;; Greet the server. + (write-line "EHLO somehost" smtp) + (read-reply-code smtp) ;250 + ;; Set sender email. + (write-line "MAIL FROM: " smtp) + (read-reply-code smtp) ;250 + ;; Set recipient email. + (write-line "RCPT TO: " smtp) + (read-reply-code smtp) ;250 + ;; Send message. + (write-line "DATA" smtp) + (read-reply-code smtp) ;354 + (write-line "Subject: Hello" smtp) + (newline smtp) + (write-line "Nice to meet you!" smtp) + (write-line "." smtp) + (read-reply-code smtp) ;250 + ;; Say goodbye. + (write-line "QUIT" smtp) + (read-reply-code smtp) ;221 + (close smtp) + #t)) + + (test-assert "mail arrived" + (marionette-eval + '(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define (queue-empty?) + (eof-object? + (read-line + (open-input-pipe "smtpctl show queue")))) + + (let wait () + (if (queue-empty?) + (file-exists? "/var/mail/root") + (begin (sleep 1) (wait))))) + marionette)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "opensmtpd-test" test))) + +(define %test-opensmtpd + (system-test + (name "opensmtpd") + (description "Send an email to a running OpenSMTPD server.") + (value (run-opensmtpd-test)))) -- cgit v1.2.3 From 130079ae27b47228516dc2934bcdecca5dbedf12 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 30 Nov 2016 00:05:22 +0100 Subject: tests: Create a copy-on-write image instead of copying eagerly. * gnu/tests/install.scm (qemu-command/writable-image): Invoke 'qemu-img -o backing_file' instead of calling 'copy-file'. --- gnu/tests/install.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index ecf1ac1923..4779b80e94 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -199,8 +199,15 @@ IMAGE, a disk image. The QEMU VM is has access to MEMORY-SIZE MiB of RAM." (mlet %store-monad ((system (current-system))) (return #~(let ((image #$image)) ;; First we need a writable copy of the image. - (format #t "copying image '~a'...~%" image) - (copy-file image "disk.img") + (format #t "creating writable image from '~a'...~%" image) + (unless (zero? (system* #+(file-append qemu-minimal + "/bin/qemu-img") + "create" "-f" "qcow2" + "-o" + (string-append "backing_file=" image) + "disk.img")) + (error "failed to create writable QEMU image" image)) + (chmod "disk.img" #o644) `(,(string-append #$qemu-minimal "/bin/" #$(qemu-command system)) -- cgit v1.2.3