X-Git-Url: http://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/ba88eea2b3a8a33ecd7fc0ec64e3917c6c2fe21d..37130eccd23eccfdc6653c3e73321fea4000d51d:/gnu/tests/base.scm

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0f8fb7f456..086d2a133f 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -1,5 +1,5 @@
 ;;; 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.
@@ -55,7 +55,7 @@
 
 
 (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>.
@@ -63,7 +63,10 @@ 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)
@@ -192,6 +195,14 @@ info --version")
                      (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
@@ -223,8 +234,8 @@ info --version")
                                   (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)
@@ -258,6 +269,12 @@ info --version")
                                     (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"
             '()
 
@@ -294,13 +311,39 @@ info --version")
                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))
@@ -362,6 +405,9 @@ info --version")
                                                     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")
@@ -397,7 +443,7 @@ info --version")
                                 (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
@@ -413,6 +459,21 @@ info --version")
             (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