;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019 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.
\f
(define* (run-basic-test os command #:optional (name "basic")
- #:key initialization)
+ #:key initialization root-password)
"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)
(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"
'()
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))
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")
(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
(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)
(service dhcp-client-service-type) ;needed for multicast