;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (run-basic-test
%test-basic-os
%test-halt
\f
(define* (run-basic-test os command #:optional (name "basic")
- #:key initialization)
+ #:key
+ initialization
+ root-password
+ desktop?)
"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 <operating-system>.
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."
+initialization step, such as entering a LUKS passphrase.
+
+When ROOT-PASSWORD is true, enter it as the root password when logging in.
+Otherwise assume that there is no password for root."
(define special-files
(service-value
(fold-services (operating-system-services os)
#:target-type special-files-service-type)))
+ (define guix&co
+ (match (package-transitive-propagated-inputs guix)
+ (((labels packages) ...)
+ (cons guix packages))))
+
(define test
(with-imported-modules '((gnu build marionette)
(guix build syscalls))
#f))))
marionette))
+ (test-eq "stdin is /dev/null"
+ 'eof
+ ;; Make sure services can no longer read from stdin once the
+ ;; system has booted.
+ (marionette-eval
+ `(begin
+ (use-modules (gnu services herd))
+ (start 'user-processes)
+ ((@@ (gnu services herd) eval-there)
+ '(let ((result (read (current-input-port))))
+ (if (eof-object? result)
+ 'eof
+ result))))
+ marionette))
+
(test-assert "shell and user commands"
;; Is everything in $PATH?
(zero? (marionette-eval '(system "
(#f (reverse result))
(x (loop (cons x result))))))
marionette)))
- (lset= string=?
- (map passwd:name users)
+ (lset= equal?
+ (map (lambda (user)
+ (list (passwd:name user)
+ (passwd:dir user)))
+ users)
(list
- #$@(map user-account-name
+ #$@(map (lambda (account)
+ `(list ,(user-account-name account)
+ ,(user-account-home-directory account)))
(operating-system-user-accounts os))))))
(test-assert "shepherd services"
(pk 'services services)
'(root #$@(operating-system-shepherd-service-names os)))))
+ (test-equal "/var/log/messages is not world-readable"
+ #o640 ;<https://bugs.gnu.org/40405>
+ (begin
+ (wait-for-file "/var/log/messages" marionette
+ #:read 'get-u8)
+ (marionette-eval '(stat:perms (lstat "/var/log/messages"))
+ marionette)))
+
(test-assert "homes"
(let ((homes
'#$(map user-account-home-directory
(operating-system-user-accounts os))))
(marionette-eval
`(begin
- (use-modules (srfi srfi-1) (ice-9 ftw)
- (ice-9 match))
+ (use-modules (guix build utils) (srfi srfi-1)
+ (ice-9 ftw) (ice-9 match))
(every (match-lambda
((user home)
(operating-system-user-accounts os))))
(stat:perms (marionette-eval `(stat ,root-home) marionette))))
+ (test-equal "ownership and permissions of /var/empty"
+ '(0 0 #o555)
+ (let ((st (marionette-eval `(stat "/var/empty") marionette)))
+ (list (stat:uid st) (stat:gid st)
+ (stat:perms st))))
+
(test-equal "no extra home directories"
'()
(test-equal "login on tty1"
"root\n"
(begin
+ ;; XXX: On desktop, GDM3 will switch to TTY7. If this happens
+ ;; after we switched to TTY1, we won't be able to login. Make
+ ;; sure to wait long enough before switching to TTY1.
+ (when #$desktop?
+ (sleep 30))
+
(marionette-control "sendkey ctrl-alt-f1" marionette)
;; Wait for the 'term-tty1' service to be running (using
;; 'start-service' is the simplest and most reliable way to do
marionette)
;; Now we can type.
- (marionette-type "root\n\nid -un > logged-in\n" marionette)
+ (let ((password #$root-password))
+ (if password
+ (begin
+ (marionette-type "root\n" marionette)
+ (wait-for-screen-text marionette
+ (lambda (text)
+ (string-contains text "Password"))
+ #:ocrad
+ #$(file-append ocrad "/bin/ocrad"))
+ (marionette-type (string-append password "\n\n")
+ marionette))
+ (marionette-type "root\n\n" marionette)))
+ (marionette-type "id -un > logged-in\n" marionette)
;; It can take a while before the shell commands are executed.
(marionette-eval '(use-modules (rnrs io ports)) marionette)
(wait-for-file "/root/logged-in" marionette
#:read 'get-string-all)))
+ (test-equal "getlogin on tty1"
+ "\"root\""
+ (begin
+ ;; Assume we logged in in the previous test and type.
+ (marionette-type "guile -c '(write (getlogin))' > /root/login-id.tmp\n"
+ marionette)
+ (marionette-type "mv /root/login-id{.tmp,}\n"
+ marionette)
+
+ ;; It can take a while before the shell commands are executed.
+ (marionette-eval '(use-modules (rnrs io ports)) marionette)
+ (wait-for-file "/root/login-id" marionette
+ #:read 'get-string-all)))
+
;; There should be one utmpx entry for the user logged in on tty1.
(test-equal "utmpx entry"
'(("root" "tty1" #f))
(x
(pk 'failure x #f))))
+ (test-equal "nscd invalidate action"
+ '(#t) ;one value, #t
+ (marionette-eval '(with-shepherd-action 'nscd ('invalidate "hosts")
+ result
+ result)
+ marionette))
+
+ ;; FIXME: The 'invalidate' action can't reliably obtain the exit
+ ;; code of 'nscd' so skip this test.
+ (test-skip 1)
+ (test-equal "nscd invalidate action, wrong table"
+ '(#f) ;one value, #f
+ (marionette-eval '(with-shepherd-action 'nscd ('invalidate "xyz")
+ result
+ result)
+ marionette))
+
(test-equal "host not found"
#f
(marionette-eval
'success!
(marionette-eval '(begin
;; Make sure the (guix …) modules are found.
- (add-to-load-path
- #+(file-append guix "/share/guile/site/2.2"))
+ (eval-when (expand load eval)
+ (set! %load-path
+ (append (map (lambda (package)
+ (string-append package
+ "/share/guile/site/"
+ (effective-version)))
+ '#$guix&co)
+ %load-path)))
(use-modules (srfi srfi-34) (guix store))
(let ((system (readlink "/run/current-system")))
- (guard (c ((nix-protocol-error? c)
+ (guard (c ((store-protocol-error? c)
(and (file-exists? system)
'success!)))
(with-store store
(marionette-eval '(readlink "/var/guix/gcroots/profiles")
marionette))
+ (test-equal "guix-daemon set-http-proxy action"
+ '(#t) ;one value, #t
+ (marionette-eval '(with-shepherd-action 'guix-daemon
+ ('set-http-proxy "http://localhost:8118")
+ result
+ result)
+ marionette))
+
+ (test-equal "guix-daemon set-http-proxy action, clear"
+ '(#t) ;one value, #t
+ (marionette-eval '(with-shepherd-action 'guix-daemon
+ ('set-http-proxy)
+ result
+ result)
+ marionette))
(test-assert "screendump"
(begin
(job3 #~(job next-second-from ;to test $PATH
"touch witness-touch")))
(simple-operating-system
- (mcron-service (list job1 job2 job3)))))
+ (service mcron-service-type
+ (mcron-configuration (jobs (list job1 job2 job3)))))))
(define (run-mcron-test name)
(define os
(operating-system
(inherit %simple-os)
(name-service-switch %mdns-host-lookup-nss)
- (services (cons* (avahi-service #:debug? #t)
+ (services (cons* (service avahi-service-type
+ (avahi-configuration (debug? #t)))
(dbus-service)
- (dhcp-client-service) ;needed for multicast
+ (service dhcp-client-service-type) ;needed for multicast
;; Enable heavyweight debugging output.
(modify-services (operating-system-user-services
HCoop / jackhill / guix / guix.git / blobdiff