diff options
| -rw-r--r-- | gnu/system.scm | 16 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 121 |
2 files changed, 130 insertions, 7 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 44f93f91d1..c19730b331 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -809,6 +809,11 @@ bookkeeping." %shepherd-root-service (pam-root-service (operating-system-pam-services os)) + ;; Make sure that privileged-programs activation script + ;; runs after accounts are created + (service privileged-program-service-type + (append (operating-system-privileged-programs os) + (operating-system-setuid-programs os))) (account-service (append (operating-system-accounts os) (operating-system-groups os)) (operating-system-skeletons os)) @@ -826,9 +831,6 @@ bookkeeping." (operating-system-environment-variables os)) (service host-name-service-type host-name) procs root-fs - (service privileged-program-service-type - (append (operating-system-privileged-programs os) - (operating-system-setuid-programs os))) (service profile-service-type (operating-system-packages os)) boot-fs non-boot-fs @@ -850,6 +852,11 @@ bookkeeping." (service shepherd-root-service-type) (service user-processes-service-type) + ;; Make sure that privileged-programs activation script + ;; runs after accounts are created + (service privileged-program-service-type + (append (operating-system-privileged-programs os) + (operating-system-setuid-programs os))) (account-service (append (operating-system-accounts os) (operating-system-groups os)) (operating-system-skeletons os)) @@ -866,9 +873,6 @@ bookkeeping." (list `("hosts" ,hosts-file))) (service hosts-service-type (local-host-entries host-name))) - (service privileged-program-service-type - (append (operating-system-privileged-programs os) - (operating-system-setuid-programs os))) (service profile-service-type (operating-system-packages os))))) (define* (operating-system-services os) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index e1a676ecd4..9430cbee12 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Marius Bakke <marius@gnu.org> +;;; Copyright © 2024 Dariqq <dariqq@posteo.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module (gnu image) #:use-module (gnu system) #:autoload (gnu system image) (system-image) + #:use-module (gnu system privilege) #:use-module (gnu system shadow) #:use-module (gnu system nss) #:use-module (gnu system vm) @@ -60,7 +62,8 @@ %test-root-unmount %test-cleanup %test-mcron - %test-nss-mdns)) + %test-nss-mdns + %test-activation)) (define %simple-os (simple-operating-system)) @@ -1105,3 +1108,119 @@ non-ASCII names from /tmp.") "Test Avahi's multicast-DNS implementation, and in particular, test its glibc name service switch (NSS) module.") (value (run-nss-mdns-test)))) + + +;;; +;;; Activation: Order of activation scripts +;;; Create accounts before running scripts using them + +(define %activation-os + ;; System with a new user/group, a setuid/setgid binary and an activation script + (let* ((%hello-accounts + (list (user-group (name "hello") (system? #t)) + (user-account + (name "hello") + (group "hello") + (system? #t) + (comment "") + (home-directory "/var/empty")))) + (%hello-privileged + (list + (privileged-program + (program (file-append hello "/bin/hello")) + (setuid? #t) + (setgid? #t) + (user "hello") + (group "hello")))) + (%hello-activation + (with-imported-modules (source-module-closure + '((gnu build activation))) + #~(begin + (use-modules (gnu build activation)) + + (let ((user (getpwnam "hello"))) + (mkdir-p/perms "/run/hello" user #o755))))) + + (hello-service-type + (service-type + (name 'hello) + (extensions + (list (service-extension account-service-type + (const %hello-accounts)) + (service-extension activation-service-type + (const %hello-activation)) + (service-extension privileged-program-service-type + (const %hello-privileged)))) + (default-value #f) + (description "")))) + + (operating-system + (inherit %simple-os) + (services + (cons* (service hello-service-type) + (operating-system-user-services + %simple-os)))))) + +(define (run-activation-test name) + (define os + (marionette-operating-system + %activation-os)) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$(virtual-machine os)))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "activation") + + (test-assert "directory exists" + (marionette-eval + '(file-exists? "/run/hello") + marionette)) + + (test-assert "directory correct permissions and owner" + (marionette-eval + '(let ((dir (stat "/run/hello")) + (user (getpwnam "hello"))) + (and (eqv? (stat:uid dir) + (passwd:uid user)) + (eqv? (stat:gid dir) + (passwd:gid user)) + (= (stat:perms dir) + #o0755))) + marionette)) + + (test-assert "privileged-program exists" + (marionette-eval + '(file-exists? "/run/privileged/bin/hello") + marionette)) + + (test-assert "privileged-program correct permissions and owner" + (marionette-eval + '(let ((binary (stat "/run/privileged/bin/hello")) + (user (getpwnam "hello")) + (group (getgrnam "hello"))) + (and (eqv? (stat:uid binary) + (passwd:uid user)) + (eqv? (stat:gid binary) + (group:gid group)) + (= (stat:perms binary) + (+ #o0555 ;; base + #o4000 ;; setuid + #o2000)))) ;; setgid + marionette)) + + (test-end)))) + + (gexp->derivation name test)) + +(define %test-activation + (system-test + (name "activation") + (description "Test that activation scripts are run in the correct order") + (value (run-activation-test name)))) |