summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-07-29 22:34:57 +0200
committerMarius Bakke <marius@gnu.org>2021-07-29 22:34:57 +0200
commitb029be2ee0f81cdcbc14240ff426408085ab0a40 (patch)
treeed6d0e1bfdadfd28e1eb804e43763b793baa0b42 /gnu/services
parentbc55f3091bac4677df0cf020381c554921fea179 (diff)
parentffb381856d0c6cc1a557b789f6b377cfa17002a0 (diff)
downloadguix-b029be2ee0f81cdcbc14240ff426408085ab0a40.tar.gz
Merge branch 'master' into core-updates-frozen
 Conflicts:
	gnu/packages/bioinformatics.scm
	gnu/packages/cmake.scm
	gnu/packages/curl.scm
	gnu/packages/emacs-xyz.scm
	gnu/packages/gpodder.scm
	gnu/packages/music.scm
	gnu/packages/patches/glibc-bootstrap-system.patch
	gnu/packages/python-xyz.scm
	gnu/packages/shells.scm
	gnu/packages/statistics.scm
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/dbus.scm13
-rw-r--r--gnu/services/desktop.scm26
-rw-r--r--gnu/services/docker.scm9
-rw-r--r--gnu/services/networking.scm6
-rw-r--r--gnu/services/web.scm4
-rw-r--r--gnu/services/xorg.scm4
6 files changed, 40 insertions, 22 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index af1a1e4c3a..e7b3dac166 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 (define-module (gnu services dbus)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module ((gnu packages glib) #:select (dbus))
@@ -156,10 +158,12 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
          (shell (file-append shadow "/sbin/nologin")))))
 
 (define dbus-setuid-programs
-  ;; Return the file name of the setuid program that we need.
+  ;; Return a list of <setuid-program> for the program that we need.
   (match-lambda
     (($ <dbus-configuration> dbus services)
-     (list (file-append dbus "/libexec/dbus-daemon-launch-helper")))))
+     (list (setuid-program
+            (program (file-append
+                      dbus "/libexec/dbus-daemon-launch-helper")))))))
 
 (define (dbus-activation config)
   "Return an activation gexp for D-Bus using @var{config}."
@@ -335,8 +339,9 @@ tuples, are all set as environment variables when the bus daemon launches it."
 (define polkit-setuid-programs
   (match-lambda
     (($ <polkit-configuration> polkit)
-     (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
-           (file-append polkit "/bin/pkexec")))))
+     (map file-like->setuid-program
+          (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
+                (file-append polkit "/bin/pkexec"))))))
 
 (define polkit-service-type
   (service-type (name 'polkit)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index cd800fcc2b..64d0e85301 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 David Wilson <david@daviwil.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +41,7 @@
   #:use-module ((gnu system file-systems)
                 #:select (%elogind-file-systems file-system))
   #:use-module (gnu system)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module (gnu packages glib)
@@ -1034,14 +1036,15 @@ rules."
 
 (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
   (match-record enlightenment-desktop-configuration
-                <enlightenment-desktop-configuration>
-                (enlightenment)
-    (list (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_sys")
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_system")
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_ckpasswd"))))
+      <enlightenment-desktop-configuration>
+    (enlightenment)
+    (map file-like->setuid-program
+         (list (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_sys")
+               (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_system")
+               (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
 
 (define enlightenment-desktop-service-type
   (service-type
@@ -1204,8 +1207,11 @@ or setting its password with passwd.")))
          ;; Allow desktop users to also mount NTFS and NFS file systems
          ;; without root.
          (simple-service 'mount-setuid-helpers setuid-program-service-type
-                         (list (file-append nfs-utils "/sbin/mount.nfs")
-                               (file-append ntfs-3g "/sbin/mount.ntfs-3g")))
+                         (map (lambda (program)
+                                (setuid-program
+                                 (program program)))
+                              (list (file-append nfs-utils "/sbin/mount.nfs")
+                               (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
 
          ;; The global fontconfig cache directory can sometimes contain
          ;; stale entries, possibly referencing fonts that have been GC'd,
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index be85316180..ef551480aa 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)               ;singularity
@@ -195,9 +197,10 @@ bundles in Docker containers.")
                                                            "-helper")))
                                  '("action" "mount" "start")))))
 
-  (list (file-append helpers "/singularity-action-helper")
-        (file-append helpers "/singularity-mount-helper")
-        (file-append helpers "/singularity-start-helper")))
+  (map file-like->setuid-program
+       (list (file-append helpers "/singularity-action-helper")
+             (file-append helpers "/singularity-mount-helper")
+             (file-append helpers "/singularity-start-helper"))))
 
 (define singularity-service-type
   (service-type (name 'singularity)
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index eeb1487116..4e1055609d 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -17,6 +17,7 @@
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -363,8 +364,9 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
                (lambda _ (display ""))))
            ;; Validate the config.
            (invoke/quiet
-            #$(file-append package "/sbin/dhcpd") "-t" "-cf"
-            #$config-file))))))
+            #$(file-append package "/sbin/dhcpd")
+            #$(string-append "-" version)
+            "-t" "-cf" #$config-file))))))
 
 (define dhcpd-service-type
   (service-type
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index bfcdfe7421..6a093cf4e4 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Nikita <nikita@n0.is>
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
@@ -1163,7 +1163,7 @@ a webserver.")
        (provision     '(hpcguix-web))
        (requirement   '(networking))
        (start #~(make-forkexec-constructor
-                 (list #$(file-append hpcguix-web "/bin/run")
+                 (list #$(file-append hpcguix-web "/bin/hpcguix-web")
                        (string-append "--config="
                                       #$(scheme-file "hpcguix-web.scm" specs)))
                  #:user "hpcguix-web"
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 8ffea3b9dd..d95f8beb7a 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 shtwzrd <shtwzrd@protonmail.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system keyboard)
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
@@ -681,7 +683,7 @@ reboot_cmd " shepherd "/sbin/reboot\n"
                              #:allow-empty-passwords? empty?)))))
 
 (define screen-locker-setuid-programs
-  (compose list screen-locker-program))
+  (compose list file-like->setuid-program screen-locker-program))
 
 (define screen-locker-service-type
   (service-type (name 'screen-locker)