From ad10c577eb1f13b9b66ea387648671df33b869d7 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 14 Feb 2021 12:57:32 +0100 Subject: [PATCH] services: prevent following symlinks during activation Currently, there's a TOCTTOU race. This can be addressed once guile has bindings for fstatat, openat and friends. XXX I'm horrible at naming exceptions: (throw 'XXX-TODO-does-someone-have-an-idea? path) * guix/build/service-utils.scm: new module with new procedure 'mkdir-p/perms'. * Makefile.am (MODULES): compile new module. * 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. --- Makefile.am | 1 + gnu/services/authentication.scm | 22 ++++++----- gnu/services/cups.scm | 12 +++--- gnu/services/dbus.scm | 36 +++++++++--------- gnu/services/dns.scm | 20 +++++----- guix/build/service-utils.scm | 66 +++++++++++++++++++++++++++++++++ 6 files changed, 113 insertions(+), 44 deletions(-) create mode 100644 guix/build/service-utils.scm diff --git a/Makefile.am b/Makefile.am index 798808bde6..c82922fc87 100644 --- a/Makefile.am +++ b/Makefile.am @@ -239,6 +239,7 @@ MODULES = \ guix/build/bournish.scm \ guix/build/qt-utils.scm \ guix/build/make-bootstrap.scm \ + guix/build/service-utils.scm \ guix/search-paths.scm \ guix/packages.scm \ guix/import/cabal.scm \ diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm index 73969a5a6d..aad02d3eab 100644 --- a/gnu/services/authentication.scm +++ b/gnu/services/authentication.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Danny Milosavljevic ;;; Copyright © 2018, 2019 Ricardo Wurmus +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +32,7 @@ #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix packages) + #:use-module (guix modules) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -521,6 +523,16 @@ password.") (define (pam-ldap-pam-services config) (list (pam-ldap-pam-service config))) +(define nslcd-activation + (with-imported-modules (source-module-closure '((guix build service-utils))) + #~(begin + (use-modules (guix build service-utils)) + (let ((rundir "/var/run/nslcd") + (user (getpwnam "nslcd"))) + (mkdir-p/perms rundir user #o755) + (when (file-exists? "/etc/nslcd.conf") + (chmod "/etc/nslcd.conf" #o400)))))) + (define nslcd-service-type (service-type (name 'nslcd) @@ -531,15 +543,7 @@ password.") (service-extension etc-service-type nslcd-etc-service) (service-extension activation-service-type - (const #~(begin - (use-modules (guix build utils)) - (let ((rundir "/var/run/nslcd") - (user (getpwnam "nslcd"))) - (mkdir-p rundir) - (chown rundir (passwd:uid user) (passwd:gid user)) - (chmod rundir #o755) - (when (file-exists? "/etc/nslcd.conf") - (chmod "/etc/nslcd.conf" #o400)))))) + (const nslcd-activation)) (service-extension pam-root-service-type pam-ldap-pam-services) (service-extension nscd-service-type diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm index 17ed04e58b..0c4e4a4307 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Alex Griffin ;;; Copyright © 2019 Tobias Geerinckx-Rice +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +32,7 @@ #:use-module (guix packages) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (ice-9 match) #:use-module ((srfi srfi-1) #:select (append-map find)) #:export (cups-service-type @@ -871,13 +873,11 @@ IPP specifications.") (define %cups-activation ;; Activation gexp. - (with-imported-modules '((guix build utils)) + (with-imported-modules (source-module-closure '((guix build service-utils) + (guix build utils))) #~(begin - (use-modules (guix build utils)) - (define (mkdir-p/perms directory owner perms) - (mkdir-p directory) - (chown directory (passwd:uid owner) (passwd:gid owner)) - (chmod directory perms)) + (use-modules (guix build service-utils) + (guix build utils)) (define (build-subject parameters) (string-concatenate (map (lambda (pair) diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index e015d3f68d..bb840e7167 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 ;;; Copyright © 2015 Sou Bunnbu +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -161,24 +162,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 + '((guix build service-utils) + (guix build utils))) + #~(begin + (use-modules (guix build service-utils) + (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 diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index d4aefe6285..2c413b6004 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Julien Lepiller ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2020 Pierre Langlois +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -607,17 +608,14 @@ (shell (file-append shadow "/sbin/nologin"))))) (define (knot-activation config) - #~(begin - (use-modules (guix build utils)) - (define (mkdir-p/perms directory owner perms) - (mkdir-p directory) - (chown directory (passwd:uid owner) (passwd:gid owner)) - (chmod directory perms)) - (mkdir-p/perms #$(knot-configuration-run-directory config) - (getpwnam "knot") #o755) - (mkdir-p/perms "/var/lib/knot" (getpwnam "knot") #o755) - (mkdir-p/perms "/var/lib/knot/keys" (getpwnam "knot") #o755) - (mkdir-p/perms "/var/lib/knot/keys/keys" (getpwnam "knot") #o755))) + (with-imported-modules (source-module-closure '((guix build service-utils))) + #~(begin + (use-modules (guix build service-utils)) + (mkdir-p/perms #$(knot-configuration-run-directory config) + (getpwnam "knot") #o755) + (mkdir-p/perms "/var/lib/knot" (getpwnam "knot") #o755) + (mkdir-p/perms "/var/lib/knot/keys" (getpwnam "knot") #o755) + (mkdir-p/perms "/var/lib/knot/keys/keys" (getpwnam "knot") #o755)))) (define (knot-shepherd-service config) (let* ((config-file (knot-config-file config)) diff --git a/guix/build/service-utils.scm b/guix/build/service-utils.scm new file mode 100644 index 0000000000..0ebdb3f290 --- /dev/null +++ b/guix/build/service-utils.scm @@ -0,0 +1,66 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2015, 2018 Mark H Weaver +;;; Copyright © 2018 Arun Isaac +;;; Copyright © 2018, 2019 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build service-utils) + #:use-module (ice-9 match) + #:use-module (guix build utils) + #:export (mkdir-p/perms)) + +;; Based upon mkdir-p from (guix build utils) +(define (verify-not-symbolic dir) + "Verify DIR or its ancestors aren't symbolic links." + (define absolute? + (string-prefix? "/" dir)) + + (define not-slash + (char-set-complement (char-set #\/))) + + (define (verify-component path) + (when (eq? 'symlink (stat:type (lstat path))) + (throw 'XXX-TODO-does-someone-have-an-idea? path))) + + (let loop ((components (string-tokenize dir not-slash)) + (root (if absolute? + "" + "."))) + (match components + ((head tail ...) + (let ((path (string-append root "/" head))) + (catch 'system-error + (lambda () + (verify-component path) + (loop tail path)) + (lambda args + (if (= ENOENT (system-error-errno args)) + #t + (apply throw args)))))) + (() #t)))) + +(define (mkdir-p/perms directory owner bits) + "Create the directory DIRECTORY and all its ancestors. +Verify no component of DIRECTORY is a symbolic link. +Warning: this is currently suspect to a TOCTOU race!" + (verify-not-symbolic directory) + (mkdir-p directory) + (chown directory (passwd:uid owner) (passwd:gid owner)) + (chmod directory bits)) -- 2.30.0