projects/guix·blob java-team · refs

105 lines · 3.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2023 Bruno Victal <[email protected]>
3;;; Copyright © 2023 Felix Lechner <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu tests pam)
21 #:use-module (gnu tests)
22 #:use-module (gnu services)
23 #:use-module (gnu services base)
24 #:use-module (gnu system)
25 #:use-module (gnu system pam)
26 #:use-module (gnu system vm)
27 #:use-module (guix gexp)
28 #:use-module (ice-9 format)
29 #:export (%test-pam-limits))
30
31
32;;;
33;;; pam-limits-service-type
34;;;
35
36(define pam-limit-entries
37 (list
38 ;; make sure the limits apply to root (uid 0)
39 (pam-limits-entry ":0" 'both 'rtprio 99) ;default is 0
40 (pam-limits-entry ":0" 'both 'memlock 'unlimited))) ;default is 8192 kbytes
41
42(define (run-test-pam-limits config)
43 "Run tests in a os with pam-limits-service-type configured."
44 (define os
45 (marionette-operating-system
46 (simple-operating-system
47 (service pam-limits-service-type config))
48 #:imported-modules '((gnu services herd))))
49
50 (define vm
51 (virtual-machine os))
52
53 (define name "pam-limits-service")
54
55 (define test
56 (with-imported-modules '((gnu build marionette)
57 (guix build syscalls))
58 #~(begin
59 (use-modules (gnu build marionette)
60 (guix build syscalls)
61 (srfi srfi-64))
62
63 (let ((marionette (make-marionette (list #$vm))))
64
65 (test-runner-current (system-test-runner #$output))
66
67 (test-begin #$name)
68
69 (test-equal "log in on tty1 and read limits"
70 '(("99") ;real-time priority
71 ("unlimited")) ;max locked memory
72
73 (begin
74 ;; Wait for tty1.
75 (marionette-eval '(begin
76 (use-modules (gnu services herd))
77 (start-service 'term-tty1))
78 marionette)
79
80 (marionette-control "sendkey ctrl-alt-f1" marionette)
81
82 ;; Now we can type.
83 (marionette-type "root\n" marionette)
84 (marionette-type "ulimit -r > real-time-priority\n" marionette)
85 (marionette-type "ulimit -l > max-locked-memory\n" marionette)
86
87 ;; Read the two files.
88 (marionette-eval '(use-modules (rnrs io ports)) marionette)
89 (let ((guest-file (lambda (file)
90 (string-tokenize
91 (wait-for-file file marionette
92 #:read 'get-string-all)))))
93 (list (guest-file "/root/real-time-priority")
94 (guest-file "/root/max-locked-memory")))))
95
96 (test-end)))))
97
98 (gexp->derivation (string-append name "-test") test))
99
100(define %test-pam-limits
101 (system-test
102 (name "pam-limits-service")
103 (description "Test that pam-limits-service actually sets the limits as
104configured.")
105 (value (run-test-pam-limits pam-limit-entries))))