Hi Maxime, Maxime Devos <maximede...@telenet.be> skribis:
> From ad10c577eb1f13b9b66ea387648671df33b869d7 Mon Sep 17 00:00:00 2001 > From: Maxime Devos <maximede...@telenet.be> > 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. Nice! > +(define-module (guix build service-utils) > + #:use-module (ice-9 match) > + #:use-module (guix build utils) > + #:export (mkdir-p/perms)) I think this should go either in (gnu build activation) or in a new (gnu build utils) module. (guix build …) is for non-Guix-System things. > +;; 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))) It’s tempting to do something like: (error "file name component is a directory" dir) Note that, if that happens at boot time, the system will fail to boot (I think you’d get a REPL rather than a kernel panic, but it’d be good to check in a VM.) > + (let loop ((components (string-tokenize dir not-slash)) > + (root (if absolute? > + "" > + "."))) > + (match components > + ((head tail ...) > + (let ((path (string-append root "/" head))) Per GNU and Guix convention, “path” is for “search paths”; here it should be “file” or something. > + (catch 'system-error > + (lambda () > + (verify-component path) > + (loop tail path)) > + (lambda args > + (if (= ENOENT (system-error-errno args)) > + #t > + (apply throw args)))))) > + (() #t)))) That reminded me of the ‘safe_path’ function in OpenSSH, but that one checks the permissions on file name components, and doesn’t check for symlinks (maybe it should; there’s an XXX comment there.) > +(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)) Otherwise LGTM, thanks! Ludo’.