Merge branch 'master' into emacs-team

4 files changed, 113 insertions, 36 deletions

diff --git a/gnu/tests/cachefilesd.scm b/gnu/tests/cachefilesd.scm
new file mode 100644
index 0000000000..7f5d513067
--- /dev/null
+++ b/gnu/tests/cachefilesd.scm
@@ -0,0 +1,71 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
+;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@lease-up.com>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests cachefilesd)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services linux)
+  #:use-module (guix gexp)
+  #:export (%test-cachefilesd))
+
+(define %cachefilesd-os
+  (simple-operating-system
+   (service cachefilesd-service-type
+            (cachefilesd-configuration
+             (cache-directory "/var/cache/fscache")))))
+
+(define (run-cachefilesd-test)
+  "Run tests in %cachefilesd-os, which has cachefilesd running."
+  (define os
+    (marionette-operating-system
+     %cachefilesd-os
+     #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine os))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (gnu build marionette))
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "cachefilesd")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'cachefilesd))
+             marionette))
+
+          (test-end))))
+  (gexp->derivation "cachefilesd-test" test))
+
+(define %test-cachefilesd
+  (system-test
+   (name "cachefilesd")
+   (description "Test that the cachefilesd runs when started.")
+   (value (run-cachefilesd-test))))
diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 137260ea93..ef30442886 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -55,7 +55,7 @@
           (test-equal "login on tty1"
             '(("c1" "0" "root" "seat0" "tty1")      ;session
               ("seat0")                             ;seat
-              ("0" "root"))                         ;user
+              ("0" "root" "no"))                    ;user
 
             (begin
               ;; Wait for tty1.
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 0f4204d1a6..daa4647299 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -229,7 +229,7 @@ reboot\n")
                                                 (gnu installer tests)
                                                 (guix combinators))))
                       (uefi-support? #f)
-                      (installation-image-type 'efi-raw)
+                      (installation-image-type 'mbr-raw)
                       (install-size 'guess)
                       (target-size (* 2200 MiB))
                       (number-of-disks 1))
@@ -291,7 +291,7 @@ such as for RAID systems."
                        '("-bios" #$uefi-firmware)
                        '())
                  #$@(cond
-                     ((eq? 'efi-raw installation-image-type)
+                     ((eq? 'mbr-raw installation-image-type)
                       #~("-drive"
                          ,(string-append "file=" #$image
                                          ",if=virtio,readonly")))
diff --git a/gnu/tests/pam.scm b/gnu/tests/pam.scm
index 1654396e42..fa480e69ff 100644
--- a/gnu/tests/pam.scm
+++ b/gnu/tests/pam.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@lease-up.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,8 +26,7 @@
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (ice-9 format)
-  #:export (%test-pam-limits
-            %test-pam-limits-deprecated))
+  #:export (%test-pam-limits))
 
 
 ;;;
@@ -35,26 +35,29 @@
 
 (define pam-limit-entries
   (list
-   (pam-limits-entry "@realtime" 'both 'rtprio 99)
-   (pam-limits-entry "@realtime" 'both 'memlock 'unlimited)))
+   ;; make sure the limits apply to root (uid 0)
+   (pam-limits-entry ":0" 'both 'rtprio 99)               ;default is 0
+   (pam-limits-entry ":0" 'both 'memlock 'unlimited)))    ;default is 8192 kbytes
 
 (define (run-test-pam-limits config)
   "Run tests in a os with pam-limits-service-type configured."
   (define os
     (marionette-operating-system
      (simple-operating-system
-      (service pam-limits-service-type config))))
+      (service pam-limits-service-type config))
+     #:imported-modules '((gnu services herd))))
 
   (define vm
     (virtual-machine os))
 
-  (define name (format #f "pam-limit-service~:[~;-deprecated~]"
-                       (file-like? config)))
+  (define name "pam-limits-service")
 
   (define test
-    (with-imported-modules '((gnu build marionette))
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
       #~(begin
           (use-modules (gnu build marionette)
+                       (guix build syscalls)
                        (srfi srfi-64))
 
           (let ((marionette (make-marionette (list #$vm))))
@@ -63,18 +66,32 @@
 
             (test-begin #$name)
 
-            (test-assert "/etc/security/limits.conf ready"
-              (wait-for-file "/etc/security/limits.conf" marionette))
-
-            (test-equal "/etc/security/limits.conf content matches"
-              #$(string-join (map pam-limits-entry->string pam-limit-entries)
-                             "\n" 'suffix)
-              (marionette-eval
-               '(begin
-                  (use-modules (rnrs io ports))
-                  (call-with-input-file "/etc/security/limits.conf"
-                    get-string-all))
-               marionette))
+            (test-equal "log in on tty1 and read limits"
+              '(("99")                  ;real-time priority
+                ("unlimited"))          ;max locked memory
+
+              (begin
+                ;; Wait for tty1.
+                (marionette-eval '(begin
+                                    (use-modules (gnu services herd))
+                                    (start-service 'term-tty1))
+                                 marionette)
+
+                (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+                ;; Now we can type.
+                (marionette-type "root\n" marionette)
+                (marionette-type "ulimit -r > real-time-priority\n" marionette)
+                (marionette-type "ulimit -l > max-locked-memory\n" marionette)
+
+                ;; Read the two files.
+                (marionette-eval '(use-modules (rnrs io ports)) marionette)
+                (let ((guest-file (lambda (file)
+                                    (string-tokenize
+                                     (wait-for-file file marionette
+                                                    #:read 'get-string-all)))))
+                  (list (guest-file "/root/real-time-priority")
+                        (guest-file "/root/max-locked-memory")))))
 
             (test-end)))))
 
@@ -83,17 +100,6 @@
 (define %test-pam-limits
   (system-test
    (name "pam-limits-service")
-   (description "Test that pam-limits-service can serialize its config
-(as a list) to @file{limits.conf}.")
+   (description "Test that pam-limits-service actually sets the limits as
+configured.")
    (value (run-test-pam-limits pam-limit-entries))))
-
-(define %test-pam-limits-deprecated
-  (system-test
-   (name "pam-limits-service-deprecated")
-   (description "Test that pam-limits-service can serialize its config
-(as a file-like object) to @file{limits.conf}.")
-   (value (run-test-pam-limits
-           (plain-file "limits.conf"
-                       (string-join (map pam-limits-entry->string
-                                         pam-limit-entries)
-                                    "\n" 'suffix))))))