diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/activation.scm | 38 | ||||
| -rw-r--r-- | gnu/services.scm | 45 | ||||
| -rw-r--r-- | gnu/system.scm | 14 | 
3 files changed, 79 insertions, 18 deletions
| diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 2af1d44b5f..9f6126023c 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -6,6 +6,8 @@  ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>  ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>  ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org> +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>  ;;;  ;;; This file is part of GNU Guix.  ;;; @@ -24,6 +26,7 @@  (define-module (gnu build activation)    #:use-module (gnu system accounts) +  #:use-module (gnu system setuid)    #:use-module (gnu build accounts)    #:use-module (gnu build linux-boot)    #:use-module (guix build utils) @@ -279,14 +282,17 @@ they already exist."    "/run/setuid-programs")  (define (activate-setuid-programs programs) -  "Turn PROGRAMS, a list of file names, into setuid programs stored under -%SETUID-DIRECTORY." -  (define (make-setuid-program prog) +  "Turn PROGRAMS, a list of file setuid-programs record, into setuid programs +stored under %SETUID-DIRECTORY." +  (define (make-setuid-program program setuid? setgid? uid gid)      (let ((target (string-append %setuid-directory -                                 "/" (basename prog)))) -      (copy-file prog target) -      (chown target 0 0) -      (chmod target #o4555))) +                                 "/" (basename program))) +          (mode (+ #o0555                   ; base permissions +                   (if setuid? #o4000 0)    ; setuid bit +                   (if setgid? #o2000 0)))) ; setgid bit +      (copy-file program target) +      (chown target uid gid) +      (chmod target mode)))    (format #t "setting up setuid programs in '~a'...~%"            %setuid-directory) @@ -302,15 +308,27 @@ they already exist."    (for-each (lambda (program)                (catch 'system-error                  (lambda () -                  (make-setuid-program program)) +                  (let* ((program-name (setuid-program-program program)) +                         (setuid?      (setuid-program-setuid? program)) +                         (setgid?      (setuid-program-setgid? program)) +                         (user         (setuid-program-user program)) +                         (group        (setuid-program-group program)) +                         (uid (match user +                                ((? string?) (passwd:uid (getpwnam user))) +                                ((? integer?) user))) +                         (gid (match group +                                ((? string?) (group:gid (getgrnam group))) +                                ((? integer?) group)))) +                    (make-setuid-program program-name setuid? setgid? uid gid)))                  (lambda args                    ;; If we fail to create a setuid program, better keep going                    ;; so that we don't leave %SETUID-DIRECTORY empty or                    ;; half-populated.  This can happen if PROGRAMS contains                    ;; incorrect file names: <https://bugs.gnu.org/38800>.                    (format (current-error-port) -                          "warning: failed to make '~a' setuid-root: ~a~%" -                          program (strerror (system-error-errno args)))))) +                          "warning: failed to make ~s setuid/setgid: ~a~%" +                          (setuid-program-program program) +                          (strerror (system-error-errno args))))))              programs))  (define (activate-special-files special-files) diff --git a/gnu/services.scm b/gnu/services.scm index 8d413e198e..2a8114a219 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -4,6 +4,8 @@  ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>  ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>  ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> +;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org> +;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>  ;;;  ;;; This file is part of GNU Guix.  ;;; @@ -40,6 +42,7 @@    #:use-module (gnu packages base)    #:use-module (gnu packages bash)    #:use-module (gnu packages hurd) +  #:use-module (gnu system setuid)    #:use-module (srfi srfi-1)    #:use-module (srfi srfi-9)    #:use-module (srfi srfi-9 gnu) @@ -801,15 +804,49 @@ directory."  FILES must be a list of name/file-like object pairs."    (service etc-service-type files)) +(define (setuid-program->activation-gexp programs) +  "Return an activation gexp for setuid-program from PROGRAMS." +  (let ((programs (map (lambda (program) +                         ;; FIXME This is really ugly, I didn't managed to use +                         ;; "inherit" +                         (let ((program-name (setuid-program-program program)) +                               (setuid?      (setuid-program-setuid? program)) +                               (setgid?      (setuid-program-setgid? program)) +                               (user         (setuid-program-user program)) +                               (group        (setuid-program-group program)) ) +                           #~(setuid-program +                              (setuid? #$setuid?) +                              (setgid? #$setgid?) +                              (user    #$user) +                              (group   #$group) +                              (program #$program-name)))) +                       programs))) +    (with-imported-modules (source-module-closure +                            '((gnu system setuid))) +      #~(begin +          (use-modules (gnu system setuid)) + +          (activate-setuid-programs (list #$@programs)))))) + +(define (setuid-program-file-like-deprecated file-like) +  (match file-like +    ((? file-like? program) +     (warning +      (G_ "representing setuid programs with '~a' is \ +deprecated; use 'setuid-program' instead~%") program) +     (setuid-program (program program))) +    ((? setuid-program? program) +     program))) +  (define setuid-program-service-type    (service-type (name 'setuid-program)                  (extensions                   (list (service-extension activation-service-type -                                          (lambda (programs) -                                            #~(activate-setuid-programs -                                               (list #$@programs)))))) +                                          setuid-program->activation-gexp)))                  (compose concatenate) -                (extend append) +                (extend (lambda (config extensions) +                          (map setuid-program-file-like-deprecated +                               (append config extensions))))                  (description                   "Populate @file{/run/setuid-programs} with the specified  executables, making them setuid-root."))) diff --git a/gnu/system.scm b/gnu/system.scm index a7c2b1bca4..11e7152be1 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -7,7 +7,7 @@  ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>  ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>  ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> -;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>  ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>  ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>  ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org> @@ -74,6 +74,7 @@    #:use-module (gnu system locale)    #:use-module (gnu system pam)    #:use-module (gnu system linux-initrd) +  #:use-module (gnu system setuid)    #:use-module (gnu system uuid)    #:use-module (gnu system file-systems)    #:use-module (gnu system mapped-devices) @@ -267,7 +268,7 @@    (pam-services operating-system-pam-services     ; list of PAM services                  (default (base-pam-services))) -  (setuid-programs operating-system-setuid-programs +  (setuid-programs %operating-system-setuid-programs                     (default %setuid-programs))    ; list of string-valued gexps    (sudoers-file operating-system-sudoers-file     ; file-like @@ -671,7 +672,7 @@ bookkeeping."              (operating-system-environment-variables os))             host-name procs root-fs             (service setuid-program-service-type -                    (operating-system-setuid-programs os)) +                    (%operating-system-setuid-programs os))             (service profile-service-type                      (operating-system-packages os))             other-fs @@ -701,7 +702,7 @@ bookkeeping."            (pam-root-service (operating-system-pam-services os))            (operating-system-etc-service os)            (service setuid-program-service-type -                   (operating-system-setuid-programs os)) +                   (%operating-system-setuid-programs os))            (service profile-service-type (operating-system-packages os)))))  (define* (operating-system-services os) @@ -1065,6 +1066,11 @@ use 'plain-file' instead~%")      ;; TODO: Remove when glibc@2.23 is long gone.      ("GUIX_LOCPATH" . "/run/current-system/locale"))) +(define (operating-system-setuid-programs os) +  "Return the setuid programs for OS, as a list of setuid-program record." +  (map file-like->setuid-program +         (%operating-system-setuid-programs os))) +  (define %setuid-programs    ;; Default set of setuid-root programs.    (let ((shadow (@ (gnu packages admin) shadow))) | 
