services: Prevent following symlinks during activation.

This addresses a potential security issue, where a compromised
service could trick the activation code in changing the permissions,
owner and group of arbitrary files.  However, this patch is
currently only a partial fix, due to a TOCTTOU (time-of-check to
time-of-use) race, which can be fixed once guile has bindings
to openat and friends.

Fixes: <https://lists.gnu.org/archive/html/guix-devel/2021-01/msg00388.html>

* gnu/build/activation.scm: new procedure 'mkdir-p/perms'.
* gnu/services/authentication.scm
  (%nslcd-activation, nslcd-service-type): use new procedure.
* gnu/services/cups.scm (%cups-activation): likewise.
* gnu/services/dbus.scm (dbus-activation): likewise.
* gnu/services/dns.scm (knot-activation): likewise.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

1 files changed, 19 insertions, 18 deletions

diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index e015d3f68d..af1a1e4c3a 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
   #:use-module (guix gexp)
   #:use-module ((guix packages) #:select (package-name))
   #:use-module (guix records)
+  #:use-module (guix modules)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (dbus-configuration
@@ -161,24 +163,23 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
 
 (define (dbus-activation config)
   "Return an activation gexp for D-Bus using @var{config}."
-  #~(begin
-      (use-modules (guix build utils))
-
-      (mkdir-p "/var/run/dbus")
-
-      (let ((user (getpwnam "messagebus")))
-        (chown "/var/run/dbus"
-               (passwd:uid user) (passwd:gid user))
-
-        ;; This directory contains the daemon's socket so it must be
-        ;; world-readable.
-        (chmod "/var/run/dbus" #o755))
-
-      (unless (file-exists? "/etc/machine-id")
-        (format #t "creating /etc/machine-id...~%")
-        (invoke (string-append #$(dbus-configuration-dbus config)
-                               "/bin/dbus-uuidgen")
-                "--ensure=/etc/machine-id"))))
+  (with-imported-modules (source-module-closure
+                          '((gnu build activation)
+                            (guix build utils)))
+    #~(begin
+        (use-modules (gnu build activation)
+                     (guix build utils))
+
+        (let ((user (getpwnam "messagebus")))
+          ;; This directory contains the daemon's socket so it must be
+          ;; world-readable.
+          (mkdir-p/perms "/var/run/dbus" user #o755))
+
+        (unless (file-exists? "/etc/machine-id")
+          (format #t "creating /etc/machine-id...~%")
+          (invoke (string-append #$(dbus-configuration-dbus config)
+                                 "/bin/dbus-uuidgen")
+                  "--ensure=/etc/machine-id")))))
 
 (define dbus-shepherd-service
   (match-lambda