Re: TOCTTOU race

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> From ad10c577eb1f13b9b66ea387648671df33b869d7 Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@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’.