Potential security weakness in Guix services

Potential security weakness in Guix services

[Leo Famulari]

[-- Attachment #1: Type: text/plain, Size: 3912 bytes --]

On January 19 2021, we received a message from Maxime Devos describing a
potential attack vector on Guix System.

If an attacker can exploit a remote code execution vulnerability (RCE)
in a program used by a Guix service, they could use it to take over the
system in some cases. We have not deployed any mitigations for this.

Below is a summary of their messages, including a mitigation proposal.
Your feedback is requested!

----- Forwarded message from Maxime Devos <maximedevos@telenet.be> -----
For clarification: the scenario I currently have in mind, is that noone
has intentionally introduced a security hole in a service, but rather
there's an accidental security bug somewhere in service package, that
allows an attacker (I'm assuming the service is accessible from the
network) arbitrary code execution *within* the service's process.

As it is now, the attacker could overtake the service process, then chown
and chmod arbitrary directories from there. As a particular example, I'm
considering e.g. a hypothetical ipfs-service-type. A compromised IPFS process
shouldn't be able to change /etc/passwd entries. The security of the IPFS
service itself shouldn't be critical to the security of the system as a
whole.
-----

A more specific exapmle:

----- Forwarded message from Maxime Devos <maximedevos@telenet.be> -----
I seem to have stumbled upon a potential security issue, it has to
do with how some services use mkdir-p/perms. For example, in knot-activation:

   (define (knot-activation config)
     #~(begin
         (use-modules (guix build 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)))

/var/lib/knot/keys/keys is chmodded and chowned, which seems innocent enough.
However, what if knot whas compromised at some point, and the compromised knot
process has replaced /var/lib/knot/keys with, say, a symlink to /gnu/store?
Then the next time the system the system is reconfigured, the knot-activation
gexp is ran agan, and the last ‘mkdir-p/perms’ will chown /gnu/store to "knot",
and now the (compromised) knot service can manipulate the store!

Ok, this would be a security issue in knot but ideally the security hole
wouldn't ‘propagate’ to the whole Guix system.
-----

And in a followup:

----- Forwarded message from Maxime Devos <maximedevos@telenet.be> -----
It's also possible to create a symlink to /etc/passwd, in which case a
compromised (non-containerised) service can change /etc/passwd after
system reconfiguration -- mkdir-p/perms doesn't verify whether its
target is a directory before chowning and chmodding.
-----

And finally, a proposal:

----- Forwarded message from Maxime Devos <maximedevos@telenet.be> -----
Also, I propose a procedure to guix-security:

(define (mkdir-p/own root sub/.../dir owner bits)
  "Create ROOT/SUB/.../DIR, and its parent directories.

This procedure bails out if ROOT/SUB/.../DIR isn't owned by
OWNER. No restrictions are placed on the ownership of ROOT.
If ROOT doesn't exist, it is created with the current
uid, gid and umask. If SUB/... don't exist, they are created
with uid and gid OWNER and the current umask. If
ROOT/SUB/.../DIR doesn't exist, it is created with uid, gid
and permission bits BITS.

Symbolic links under ROOT/ are not followed."
  ... implementation)

idk if symlinks components in /ROOT should be followed.
Probably no service definition requires this, so *never*
following symlinks may also be possible? Not strictly
required for security I think, but it eases reasoning
about security properties. (Less variables to consider)
-----

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 912 bytes --]

Hi Guix,

On Thu, 2021-01-28 at 16:53 -0500, Leo Famulari wrote:
> On January 19 2021, we received a message from Maxime Devos describing a
> potential attack vector on Guix System.
> 
> If an attacker can exploit a remote code execution vulnerability (RCE)
> in a program used by a Guix service, they could use it to take over the
> system in some cases. We have not deployed any mitigations for this.
> 
> Below is a summary of their messages, including a mitigation proposal.
> Your feedback is requested!

I'm writing a patch right now.  It's a little more elaborate than my
mkdir-p/own proposal.  In the patch, directories with owner, group
and permission bits are created via extensions to a ‘fs-entry-service-type’,
which will perform various basic consistency checks at build time
(e.g., no directory can be owned by multiple users).

I'll post a draft when it's ready.

Maxime

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 2077 bytes --]

On Fri, 2021-01-29 at 14:33 +0100, Maxime Devos wrote:
> Hi Guix,
> [...]
> > Below is a summary of their messages, including a mitigation proposal.
> > Your feedback is requested!
> 
> I'm writing a patch right now.  It's a little more elaborate than my
> mkdir-p/own proposal.  In the patch, directories with owner, group
> and permission bits are created via extensions to a ‘fs-entry-service-type’,
> which will perform various basic consistency checks at build time
> (e.g., no directory can be owned by multiple users).
> 
> I'll post a draft when it's ready.

[First draft is attached, with many parts missing, it doesn't even
compile]
I think I've got a basic idea on how to handle this.
Some problems to address:

* Guile does not have ‘openat, mkdirat’ procedures.
  How to resolve: implement these upstream, write FFI bindings,
  or use 'chdir' carefully.

* Verify whether symlinks are handled correctly.
  (stat vs lstat vs fstatat ...)

* Perhaps O_NOCTTY, O_NOLINK, O_NOTRANS, O_NONBLOCK, O_DIRECTORY,
  O_NOFOLLOW ... need to be used at some places.

* Maybe fsync needs to be used in some places.

  The service definitions don't seem to do that anywhere when chmodding
  and chowning, so not implementing this shouldn't be a regression,
  but it does seem like something to verify.

* On some Linux versions and filesystems,
  the use of O_TMPFILE might simplify reasoning about security properties,
  race windows, etc., but idk if it's supported on the Hurd, and which
  (linux version, filesystem) combinations are supported.

* Mounting filesystems.
  Can all filesystems used by services when activating be assumed to be up?
  idk. 

* Support more security stuff (SELinux, SMACK, POSIX ACL, ...)
  Something for the far future, perhaps?

Perhaps I should just implement the basic mkdir-p/own proposal for now,
and in the future something more elaborate can be implemented?
All but the last two points probably still apply, though.

I'll take a look at how other systems handle this.

Maxime

[-- Attachment #1.2: directory-setup.scm --]
[-- Type: text/x-scheme, Size: 8414 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(define-module (gnu services fs-entry)
  #:use-module stuff ...)
;;;
;;; Create directory structures for services with security context,
;;; without race conditions.  Symbolic links are not followed.
;;;

;; Values passed in extensions to @code{fs-entry-service-type}.
;; TODO maybe also allow defining SELinux, SMACK and POSIX ACL.
(define-record-type* <fs-entry>
  fs-entry make-fs-entry fs-entry?
  (where fs-entry-where) ; /name/of/file
  (bits  fs-entry-bits) ; permission bits
  (type  fs-entry-type) ; directory, regular or symlink
  (owner fs-entry-owner) ; owner, as a string
  (group fs-entry-group)) ; group, as a string

;; Likewise, but converted to a tree structure.
(define-record-type* <fs-entry/tree>
  fs-entry/tree make-fs-entry/tree fs-entry/tree?
  (name     fs-entry/tree-where) ; basename
  (bits     fs-entry/tree-bits) ; permission bits
  (type     fs-entry/tree-type) ; directory, regular or symlink
  (owner    fs-entry/tree-owner) ; owner, as a string
  (group    fs-entry/tree-group) ; group, as a string
  ;; boolean, for when <fs-entry> for /a/b is defined,
  ;; but not <fs-entry> for / and /a are defined, in which case
  ;; a ‘filler?’ <fs-entry/tree> for / and /a are created
  ;; in fs-entries->tree, which have as child /a and /a/b
  ;; respectively.
  ;;
  ;; (Note: the security context for / is currently ignored)
  (filler?  fs-entry/tree-filler?
            (default #f))
  ;; list of known children
  (children fs-entry-children))

(define %directory-separator #\/)
(define (fs-entry-name-components x)
  (string-split (fs-entry-where x) %directory-separator))

(define (fs-entries->tree list)
  "Translate @var{list}, a list of @code{fs-entry}, into a tree
structure (of <fs-entry/tree>)."
  ;; Sort list to prepare for a depth-first construction
  (define (list<? component<? x y)
    (cond ((and (null? x) (null? y)) #f)
	  ((null? x) #t)
	  ((null? y) #f)
	  ((component<? (car x) (car y)) #t)
	  ((component<? (car y) (car x)) #f)
	  (else (list<? component<? (cdr x) (cdr y)))))
  (define (entry<? x y)
    (list<? string<?
            (fs-entry-name-components x)
            (fs-entry-name-components y)))
  (define sorted (sort list entry<?))
  ;; Now construct the tree.
  ;; XXX insert filler for ???
  XXX
  ;; XXX make sure there are no inconsistencies
  ;; XXX prevent some screw-ups such as chowning or chmodding
  ;; entries from /gnu/store/.... Maybe that's prevented
  ;; by bind-mounting anyway.
  ;; (e.g. a symlink and directory with the same name).
  )

(define (tree->alist tree)
  `((name . ,(fs-entry/tree-name tree))
    (bits . ,(fs-entry/tree-bits tree))
    (type . ,(fs-entry/tree-type tree))
    (owner . ,(fs-entry/tree-owner tree))
    (group . ,(fs-entry/tree-group tree))
    (filler? . ,(fs-entry/tree-filler? tree))))

(define* (fs-entry-activation tree)
  ;; XXX for efficiency reasons, it might be useful to implement
  ;; some sort of caching mechanism to avoid looking up a uid/gid
  ;; multiple times from user name / user gid.
  #~(let* ((root (open "/" O_RDONLY))
           (ref  (lambda (sexp-tree obj))))
      (use-modules (srfi srfi-26))
      ;; XXX dynamic-wind stuff to close directories
      ;; and leaves.
      ;; XXX bindings to openat, or use chdir
      (define (activate-children! parent-fd parent-tree)
        (for-each (cute activate-child! parent-fd <>)
                  (assq-ref parent-tree 'children)))
      (define (activate-child! parent-fd child-tree)
        (let* ((name (assq-ref child-tree 'name))
               (child
                ;; XXX define
                (false-if-not-found
                 (openat parent-fd (fs-entry/tree-name child-tree)))))
          (if child ;; already exists
              (maybe-fixup-child! child child-tree)
              (create-child! parent-fd name child-tree))))
      (define (maybe-fixup-child! child child-tree)
        ;; First check if any changes need to be made.
        ;; If not, don't perform any write I/O.
        ;; XXX what happens if child is a symbolic link?
        ;; XXX handle (assq-ref child 'filler?)
        (let* ((stat (stat child))
               (child:bits (assq-ref child-tree 'bits))
               (child:uid (xxx (assq-ref child-tree 'uid)))
               (child:gid (xxx (assq-ref child-tree 'gid)))
               (bits-ok? (= (stat:perms child) child:bits))
               (owner-ok? (= (stat:uid child) child:uid))
               (group-ok? (= (stat:gid child) child:gid))
               (type-ok? (eq? (stat:type child)
                              (assq-ref child-tree 'type))))
          ;; XXX if programs hold open files to some files,
          ;; which aren't permitted by the new configuration,
          ;; then these programs ???
          ;; XXX log stuff perhaps
          (cond ((not type-ok?) (xxx-what-now))
                ;; Easy, no risk of accidentally creating
                ;; a setuid/setgid binary.
                ((and group-ok? owner-ok? (not bits-ok?))
                 (chmod child child:bits)
                 (activate-children! child child-tree))
                ;; XXX this relies on the Linux behaviour
                ;; of clearing setuid and setgid at chown
                ;; (in some cases), check the behaviour
                ;; on the Hurd and Linux
                ((not (and group-ok? owner-ok?))
                 ;; XXX check behaviour on symbolic links
                 (chown child child:uid child:gid)
                 (chmod child child:bits)
                 (activate-children! child child-tree))
                ;; Everything is OK!  Descend down the tree.
                ((and bits-ok? owner-ok? group-ok? type-ok?)
                 (activate-children! child child-tree))
                (else (XXX-I-missed-a-case)))))
      (define (create-child! parent-fd name child-tree)
        (case (assq-ref child-tree 'type)
          ((regular)
           ;; XXX default contents? Maybe allow including
           ;; a gexp #~(lambda (file-fd) do-stuff)
           ;; in the <fs-entry>?
           xxx-???-regular)
          ((directory)
           ;; XXX handle filler?
           ;; XXX check security implications of sticky-bit
           (mkdirat parent-fd name (assq-ref child-tree 'bits))
           (chown xxx-the-just-created-dir (assq-ref child-tree 'owner))
           (activate-chilren! xxx-the-just-created-dir child-tree))
          ;; XXX target?  Also, does any service actually require
          ;; this?
          ((symlink) xxx-???-symlink)
          (else ???)))
      (call-with-saved-umask
       (lambda ()
         ;; Prevent a race windows were newly-created directories
         ;; are temporarily world-executable where inappropriate.
         (umask #o777)
         (activate-children! root tree)))))

(define fs-entry-service-type
  (service-type (name 'fs-entries)
                (extensions
                 (list (service-extension activation-service-type
                                          fs-entry-activation)))
                (compose concatenate)
                (extend append)
                (description
                 "Create directory structures, with permission
bits, owner and groups (together called the security context),
without race conditions.  The value of this service is a list
of @code{fs-entry}.  The old security context is overwritten
at activation time, and some inconsistencies are detected at
build time.

If some parent directories of a @code{fs-entry} are not
explicitely specfied, it is required (at activation time)
they are root-owned (both user and group) and
world-unwritable.")))

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Hi,

Leo Famulari <leo@famulari.name> skribis:

> For clarification: the scenario I currently have in mind, is that noone
> has intentionally introduced a security hole in a service, but rather
> there's an accidental security bug somewhere in service package, that
> allows an attacker (I'm assuming the service is accessible from the
> network) arbitrary code execution *within* the service's process.
>
> As it is now, the attacker could overtake the service process, then chown
> and chmod arbitrary directories from there. As a particular example, I'm
> considering e.g. a hypothetical ipfs-service-type. A compromised IPFS process
> shouldn't be able to change /etc/passwd entries. The security of the IPFS
> service itself shouldn't be critical to the security of the system as a
> whole.
> -----
>
> A more specific exapmle:
>
> ----- Forwarded message from Maxime Devos <maximedevos@telenet.be> -----
> I seem to have stumbled upon a potential security issue, it has to
> do with how some services use mkdir-p/perms. For example, in knot-activation:
>
>    (define (knot-activation config)
>      #~(begin
>          (use-modules (guix build 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)))
>
> /var/lib/knot/keys/keys is chmodded and chowned, which seems innocent enough.
> However, what if knot whas compromised at some point, and the compromised knot
> process has replaced /var/lib/knot/keys with, say, a symlink to /gnu/store?

I’m not sure I understand the threat model.  If Knot has a RCE
vulnerability, it can be exploited to run anything on behalf of the
‘knot’ user.

At that point, all the state associated with Knot in /var/lib should be
considered tainted; new keys should be generated, and so on.

Why focus on the permissions on /var/lib/knot?

Also, every time it’s possible and not redundant with measures already
implemented by the daemon itself, we should consider using
‘make-forkexec-constructor/container’ as a further mitigation.

WDYT?

Ludo’.

Re: Potential security weakness in Guix services

[Julien Lepiller]

Le 1 février 2021 10:35:56 GMT-05:00, "Ludovic Courtès" <ludo@gnu.org> a écrit :
>Hi,
>
>Leo Famulari <leo@famulari.name> skribis:
>
>> For clarification: the scenario I currently have in mind, is that
>noone
>> has intentionally introduced a security hole in a service, but rather
>> there's an accidental security bug somewhere in service package, that
>> allows an attacker (I'm assuming the service is accessible from the
>> network) arbitrary code execution *within* the service's process.
>>
>> As it is now, the attacker could overtake the service process, then
>chown
>> and chmod arbitrary directories from there. As a particular example,
>I'm
>> considering e.g. a hypothetical ipfs-service-type. A compromised IPFS
>process
>> shouldn't be able to change /etc/passwd entries. The security of the
>IPFS
>> service itself shouldn't be critical to the security of the system as
>a
>> whole.
>> -----
>>
>> A more specific exapmle:
>>
>> ----- Forwarded message from Maxime Devos <maximedevos@telenet.be>
>-----
>> I seem to have stumbled upon a potential security issue, it has to
>> do with how some services use mkdir-p/perms. For example, in
>knot-activation:
>>
>>    (define (knot-activation config)
>>      #~(begin
>>          (use-modules (guix build 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)))
>>
>> /var/lib/knot/keys/keys is chmodded and chowned, which seems innocent
>enough.
>> However, what if knot whas compromised at some point, and the
>compromised knot
>> process has replaced /var/lib/knot/keys with, say, a symlink to
>/gnu/store?
>
>I’m not sure I understand the threat model.  If Knot has a RCE
>vulnerability, it can be exploited to run anything on behalf of the
>‘knot’ user.
>
>At that point, all the state associated with Knot in /var/lib should be
>considered tainted; new keys should be generated, and so on.
>
>Why focus on the permissions on /var/lib/knot?

My understanding is that, in case of an RCE in knot, the attacker can replace /var/lib/knot/* with symlinks to arbitrary files in the FS. When the activation procedure is run afterwards, the files being linked to are chowned to the knot user, and the attacker can access them.

>Also, every time it’s possible and not redundant with measures already
>implemented by the daemon itself, we should consider using
>‘make-forkexec-constructor/container’ as a further mitigation.
>
>WDYT?
>
>Ludo’.

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 800 bytes --]

> > I’m not sure I understand the threat model.  If Knot has a RCE
> > vulnerability, it can be exploited to run anything on behalf of the
> > ‘knot’ user.
> > 
> > At that point, all the state associated with Knot in /var/lib should be
> > considered tainted; new keys should be generated, and so on.
> > 
> > Why focus on the permissions on /var/lib/knot?
> 
> My understanding is that, in case of an RCE in knot, the attacker can
> replace /var/lib/knot/* with symlinks to arbitrary files in the FS. When
> the activation procedure is run afterwards, the files being linked to
> are chowned to the knot user, and the attacker can access them.

That's exactly what I had in mind!  Though I would like to stress that
‘access’ here is both reading and writing.

Maxime.


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

>> > I’m not sure I understand the threat model.  If Knot has a RCE
>> > vulnerability, it can be exploited to run anything on behalf of the
>> > ‘knot’ user.
>> > 
>> > At that point, all the state associated with Knot in /var/lib should be
>> > considered tainted; new keys should be generated, and so on.
>> > 
>> > Why focus on the permissions on /var/lib/knot?
>> 
>> My understanding is that, in case of an RCE in knot, the attacker can
>> replace /var/lib/knot/* with symlinks to arbitrary files in the FS. When
>> the activation procedure is run afterwards, the files being linked to
>> are chowned to the knot user, and the attacker can access them.
>
> That's exactly what I had in mind!  Though I would like to stress that
> ‘access’ here is both reading and writing.

OK, I see.  Roughly, this symlink chown story would be a local exploit
that the attacker can take advantage of after exploiting the RCE to
potentially get root access.

‘mkdir-p/perms’ could check that the directory is not a symlink, to
begin with.  Is this what you had in mind, Maxime?

Thanks,
Ludo’.

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1580 bytes --]

On Tue, 2021-02-02 at 14:07 +0100, Ludovic Courtès wrote:
> OK, I see.  Roughly, this symlink chown story would be a local exploit
> that the attacker can take advantage of after exploiting the RCE to
> potentially get root access.
> 
> ‘mkdir-p/perms’ could check that the directory is not a symlink, to
> begin with.  Is this what you had in mind, Maxime?

Yes!  Though the parent- and grandparent and etc. should be checked as well.
If e.g. (I don't have a real example at hand) knot's activation has
a (mkdir-p/perms "/var/lib/knot/e/t/c/e/t/e/r/a" uid/gid-stuff) line, then
mkdir-p/perms has to take care that the "e", "t", "c", "e", "t", "e, "r"
and "a" directories aren't symlinks.

I don't know how I should implement this properly in Guile, though.
In C, I would use loop using openat with O_NOFOLLOW, in combination
with stat, but Guile doesn't have openat or O_NOFOLLOW.

I've proposed adding the O_NOFOLLOW to guile [1].  I don't have a
proposal for openat in guile yet.  If I do propose an interface
to openat(2); I should probably make a proposal for fchownat
and other *at variants at the same time.  I don't have a concrete
proposal for how a nice Scheme interface would look like.

In the mean time, I suppose it should be possible to use openat
via the FFI and define O_NOFOLLOW manually in Guix.

I'll look into writing a concrete proposal for *at in guile.
I'll post a link to the guile mailing list message when it has
been composed and sent.

Greetings, Maxime.

[1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=46220

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 495 bytes --]

> I'll look into writing a concrete proposal for *at in guile.
> I'll post a link to the guile mailing list message when it has
> been composed and sent.
Here it is:
http://debbugs.gnu.org/cgi/bugreport.cgi?bug=46258

I'm not familiar with guile's code base and conventions
and my TODO list is ever-growing, so it could take quite
some time before I get around writing a patch to Guile.
(Or implementing it in pure Scheme + FFI bindings as
a separate library).

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> On Tue, 2021-02-02 at 14:07 +0100, Ludovic Courtès wrote:
>> OK, I see.  Roughly, this symlink chown story would be a local exploit
>> that the attacker can take advantage of after exploiting the RCE to
>> potentially get root access.
>> 
>> ‘mkdir-p/perms’ could check that the directory is not a symlink, to
>> begin with.  Is this what you had in mind, Maxime?
>
> Yes!  Though the parent- and grandparent and etc. should be checked as well.
> If e.g. (I don't have a real example at hand) knot's activation has
> a (mkdir-p/perms "/var/lib/knot/e/t/c/e/t/e/r/a" uid/gid-stuff) line, then
> mkdir-p/perms has to take care that the "e", "t", "c", "e", "t", "e, "r"
> and "a" directories aren't symlinks.

OK.

> I don't know how I should implement this properly in Guile, though.
> In C, I would use loop using openat with O_NOFOLLOW, in combination
> with stat, but Guile doesn't have openat or O_NOFOLLOW.

In this case we need a solution without openat for now.  Perhaps simply
changing ‘mkdir-p/perms’ to ‘lstat’ components as it goes?

> I've proposed adding the O_NOFOLLOW to guile [1].  I don't have a
> proposal for openat in guile yet.  If I do propose an interface
> to openat(2); I should probably make a proposal for fchownat
> and other *at variants at the same time.  I don't have a concrete
> proposal for how a nice Scheme interface would look like.
>
> In the mean time, I suppose it should be possible to use openat
> via the FFI and define O_NOFOLLOW manually in Guix.
>
> I'll look into writing a concrete proposal for *at in guile.
> I'll post a link to the guile mailing list message when it has
> been composed and sent.

I think it’s a good endeavor, but it’s a longer-term one since it’ll
take some time before this new version is in use by all the Guix code.

The difficulty in designing such an interface is that the Scheme API is
more about ports than it’s about file names and file descriptors.

Thanks!

Ludo’.

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 2086 bytes --]

On Fri, 2021-02-05 at 10:57 +0100, Ludovic Courtès wrote:
> Hi Maxime,

> 
> > I don't know how I should implement this properly in Guile, though.
> > In C, I would use loop using openat with O_NOFOLLOW, in combination
> > with stat, but Guile doesn't have openat or O_NOFOLLOW.
> 
> In this case we need a solution without openat for now.  Perhaps simply
> changing ‘mkdir-p/perms’ to ‘lstat’ components as it goes?

A compromised service could create a component as a regular file or
directory, and quickly replace it with a symlink after the activation
gexp checks the component wasn't a symlink but before the chown or
chmod.

It's a tiny window though.  I was going to say this tiny ‘exploitation
window’ could be ignored for now until an API to openat & other *at
C functions makes it into guile, but then I checked the inotify(7)
API.  Apparently, inotify events are generated for directory accesses.

> > [...]
> > I'll look into writing a concrete proposal for *at in guile.
> > I'll post a link to the guile mailing list message when it has
> > been composed and sent.

Link: https://lists.gnu.org/archive/html/bug-guile/2021-02/msg00002.html

> The difficulty in designing such an interface is that the Scheme API is
> more about ports than it’s about file names and file descriptors.

This doesn't seem a large issue to me.
Ports for directories can be made with 'open': (open "/home" O_RDONLY).
Example use of for changing permission bits of "/home/USER" with
proposed API:

(let* ((directory (open "/home" O_RDONLY))
       ;; in the C API, this translates to:
       ;; openat(directory-fd, "USER", O_IDK)
       ;; (replace O_IDK with appropriate open flags)
       (file-in-dir (open  (make-path-at directory "USER") O_IDK)))
  (chmod file-in-dir #o077)
  (chown file-in-dir 0 0))

I'll try to implement this API in Scheme (using the FFI), and post
it at https://notabug.org/mdevos/things.  I'll post a follow-up
messsage once I've implemented the basics (openat, chmodat,
chownat).

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 456 bytes --]

On Fri, 2021-02-05 at 13:20 +0100, Maxime Devos wrote:
> On Fri, 2021-02-05 at 10:57 +0100, Ludovic Courtès wrote:
> > [...]
> [...]
> 
> I'll try to implement this API in Scheme (using the FFI), and post
> it at https://notabug.org/mdevos/things.  I'll post a follow-up
> messsage once I've implemented the basics (openat, chmodat,
> chownat).

Ping!
https://notabug.org/mdevos/things/src/a0715e6758ad43252e16993dcf688a25156057f3/fs-at.scm


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Maxime Devos <maximedevos@telenet.be> skribis:

> On Fri, 2021-02-05 at 13:20 +0100, Maxime Devos wrote:
>> On Fri, 2021-02-05 at 10:57 +0100, Ludovic Courtès wrote:
>> > [...]
>> [...]
>> 
>> I'll try to implement this API in Scheme (using the FFI), and post
>> it at https://notabug.org/mdevos/things.  I'll post a follow-up
>> messsage once I've implemented the basics (openat, chmodat,
>> chownat).
>
> Ping!
> https://notabug.org/mdevos/things/src/a0715e6758ad43252e16993dcf688a25156057f3/fs-at.scm

Nice!

I just remembered this subtlety: during bootup, the activation code is
evaluated by the Guile that’s in the initrd, which is a
statically-linked Guile, and thus we can’t use ‘dynamic-link’ & co. in
there.  :-/

(That’s why we carry ‘guile-linux-syscalls.patch’.)

Ludo’.

Re: Potential security weakness in Guix services

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1544 bytes --]

On Sat, 2021-02-06 at 22:28 +0100, Ludovic Courtès wrote:
> Maxime Devos <maximedevos@telenet.be> skribis:
> 
> I just remembered this subtlety: during bootup, the activation code is
> evaluated by the Guile that’s in the initrd, which is a
> statically-linked Guile, and thus we can’t use ‘dynamic-link’ & co. in
> there.  :-/

I remember trying to use make-forkexec-constructor/container from activation
code, which didn't work, due to some uses of dynamic-func ...  I see two
possible options to take:

* extend gnu/packages/patches/guile-linux-syscalls.patch with, say,
  a "%extra-function-pointers" procedure returning a vector (or alist,
  or something else) of pointers to the relevant C functions.  This
  allows us to write the FFI code mostly in Scheme, and only write C
  code for obtaining function pointer.

* extend gnu/packages/patches/guile-linux-syscalls.patch with
  additional bindings, or write a patch extending guile itself with
  fchownat
and other *at support.  This (second) patch should be
  submitted upstream, but can be kept in gnu/packages/patches until
  support for *at
functionality makes it upstream.

The first option is the path I would find the most convenient myself
(though I'll probably write C code for parsing struct stat, as its
layout apparently varies much with kernel (Linux / Hurd) and
architecture), but the latter seems the way to go to prevent duplicate
effort upstream later on.

My C is a little rusty, but I'll have a try at the latter.

Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> On Sat, 2021-02-06 at 22:28 +0100, Ludovic Courtès wrote:
>> Maxime Devos <maximedevos@telenet.be> skribis:
>> 
>> I just remembered this subtlety: during bootup, the activation code is
>> evaluated by the Guile that’s in the initrd, which is a
>> statically-linked Guile, and thus we can’t use ‘dynamic-link’ & co. in
>> there.  :-/
>
> I remember trying to use make-forkexec-constructor/container from activation
> code, which didn't work, due to some uses of dynamic-func ...  I see two
> possible options to take:
>
> * extend gnu/packages/patches/guile-linux-syscalls.patch with, say,
>   a "%extra-function-pointers" procedure returning a vector (or alist,
>   or something else) of pointers to the relevant C functions.  This
>   allows us to write the FFI code mostly in Scheme, and only write C
>   code for obtaining function pointer.
>
> * extend gnu/packages/patches/guile-linux-syscalls.patch with
>   additional bindings, or write a patch extending guile itself with
>   fchownat
> and other *at support.  This (second) patch should be
>   submitted upstream, but can be kept in gnu/packages/patches until
>   support for *at
> functionality makes it upstream.

Like I wrote earlier in <87zh0gzy52.fsf@gnu.org>, I think we can fix
this particular issue (‘mkdir-p/perms’) without resorting to the *at
functions, and I think that’s what we should do.

Support for *at will be useful, especially if we can make it part of
Guile proper, but it’s not an absolute prerequisite for the issue at
hand.

WDYT?

Thanks for looking into this!

Ludo’.

Re: Potential security weakness in Guix services

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> On Fri, 2021-02-05 at 10:57 +0100, Ludovic Courtès wrote:
>> Hi Maxime,
>
>> 
>> > I don't know how I should implement this properly in Guile, though.
>> > In C, I would use loop using openat with O_NOFOLLOW, in combination
>> > with stat, but Guile doesn't have openat or O_NOFOLLOW.
>> 
>> In this case we need a solution without openat for now.  Perhaps simply
>> changing ‘mkdir-p/perms’ to ‘lstat’ components as it goes?
>
> A compromised service could create a component as a regular file or
> directory, and quickly replace it with a symlink after the activation
> gexp checks the component wasn't a symlink but before the chown or
> chmod.

I understand the TOCTTOU race.  However, activation code runs in two
situations: when booting the system (before shepherd takes over), and
upon ‘guix system reconfigure’ completion.

When booting the system, there’s just no process out there to take
advantage of the race condition.

In the second case, presumably all the file name components already
exist.

Does that make sense?

>> > [...]
>> > I'll look into writing a concrete proposal for *at in guile.
>> > I'll post a link to the guile mailing list message when it has
>> > been composed and sent.
>
> Link: https://lists.gnu.org/archive/html/bug-guile/2021-02/msg00002.html

Thanks!

Ludo’.

TOCTTOU race (was: Potential security weakness in Guix services)

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 1633 bytes --]

On Sat, 2021-02-06 at 22:26 +0100, Ludovic Courtès wrote:
> 
> [...]
> I understand the TOCTTOU race.  However, activation code runs in two
> situations: when booting the system (before shepherd takes over), and
> upon ‘guix system reconfigure’ completion.
> 
> When booting the system, there’s just no process out there to take
> advantage of the race condition.
> 
> In the second case, presumably all the file name components already
> exist.

In the second situation, a compromised service could quickly rename
a component to something else and create a symlink in place, and after
the activation code has changed permissions and owner remove the symlink
and rename the component back to avoid suspicion. 

(The old component could be removed entirely and replaced with a symlink,
but that will likely break something, which may lead to the sysadmin
investigating.)

(The attack method I'm describing here of course only works if the
compromised service has control over both the component and the parent
directory.)

> Does that make sense?

Maybe?  While I would prefer there would *not* be a TOCTTOU race,
we may have to live with that for the moment (and even with a TOCTTOU
race, at least an attacker only has a narrow window).

I'll submit a new patch *without* a TOCTTOU race once openat,
fstatat, ... bindings make it into guile, but for the mean time, I've
attached a patch with the TOCTTOU race.

I've tested with 'make check-system TESTS="basic cups"'.
I couldn't test all affected services, unfortunately,
due to lack of system tests.

Thoughts?

Greetings,
Maxime.

[-- Attachment #1.2: 0001-services-prevent-following-symlinks-during-activatio.patch --]
[-- Type: text/x-patch, Size: 12021 bytes --]

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.
---
 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 <dannym@scratchpost.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 <rekado@elephly.net>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 <julien@lepiller.eu>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 <ludo@gnu.org>
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: TOCTTOU race (was: Potential security weakness in Guix services)

[Bengt Richter]

Hi,

On +2021-02-14 13:29:29 +0100, Maxime Devos wrote:
> On Sat, 2021-02-06 at 22:26 +0100, Ludovic Courtès wrote:
> > 
> > [...]
> > I understand the TOCTTOU race.  However, activation code runs in two
> > situations: when booting the system (before shepherd takes over), and 
> > upon ‘guix system reconfigure’ completion.
> >

Until we have a guix jargon file and a
    guix gloss SEARCHARGS ...
convenience command, it is nice towards noobs to spell out
an abbreviation or acronym on first use ;-)

--8<---------------cut here---------------start------------->8---
Time-of-check to time-of-use

   From Wikipedia, the free encyclopedia
     (Redirected from TOCTTOU)
   Jump to navigation Jump to search

   In software development, time-of-check to time-of-use (TOCTOU, TOCTTOU
   or TOC/TOU) is a class of software bugs caused by a race condition
   involving the checking of the state of a part of a system (such as a
   security credential) and the use of the results of that check.

   TOCTOU race conditions are common in Unix between operations on the
   file system,^[1] but can occur in other contexts, including local
   sockets and improper use of database transactions. In the early 1990s,
   the mail utility of BSD 4.3 UNIX had an exploitable race condition for
   temporary files because it used the mktemp()^[2] function.^[3] Early
   versions of OpenSSH had an exploitable race condition for Unix domain
   sockets.^[4] They remain a problem in modern systems; as of 2019, a
   TOCTOU race condition in Docker allows root access to the filesystem of
   the host platform.^[5]
   [ ]
--8<---------------cut here---------------end--------------->8---

[...snip...]
-- 
Regards,
Bengt Richter

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’.

Re: TOCTTOU race

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 1743 bytes --]

On Thu, 2021-02-18 at 18:54 +0100, Ludovic Courtès wrote:
> [...]
> 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.

I've moved mkdir-p/perms into (gnu build activation).

> > +;; Based upon mkdir-p from (guix build utils)
> > +(define (verify-not-symbolic dir)
> > +  [...])

I've replaced the (when (eq? 'symlink) ...) with
(unless (eq? 'directory) ...).

> It’s tempting to do something like:
> 
>   (error "file name component is a directory" dir)

I've added a "not" between "is" and "a" ->
  (error "file name component is not 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.)

If that happens, that's too bad.  Just ignoring the error seems bad from
a security perspective.  I verified in a VM you'd get a REPL.
From the REPL, a sysadmin could investigate and choose to delete the offending
symlink & reboot (and presumably fix the security bug and upgrade the service),
or decide Guix System needs to be reinstalled.

> > [...]
> 
> Per GNU and Guix convention, “path” is for “search paths”; here it
> should be “file” or something.

Changed in new patch (attached).

Apparently, I forgot a few #:use-module.  This should be corrected now.

Please take note that I didn't correct all potentially insecure activation gexps.
These should ideally be done by someone who knows how to use the particular service
and have a system to test it on.  (My changes to nscld-service-type and knot-activation
are untested.)

Greetings,
Maxime


[-- Attachment #1.2: 0001-services-prevent-following-symlinks-during-activatio.patch --]
[-- Type: text/x-patch, Size: 11837 bytes --]

From 2c3968f658ada27d2062a960d229f3db9cfe208c 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.

* 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.
---
 gnu/build/activation.scm        | 51 +++++++++++++++++++++++++++++++--
 gnu/services/authentication.scm | 22 ++++++++------
 gnu/services/cups.scm           | 12 ++++----
 gnu/services/dbus.scm           | 37 ++++++++++++------------
 gnu/services/dns.scm            | 21 +++++++-------
 5 files changed, 96 insertions(+), 47 deletions(-)

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index b458aee4ae..4ee51dfd6e 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,6 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,7 +42,8 @@
             activate-modprobe
             activate-firmware
             activate-ptrace-attach
-            activate-current-system))
+            activate-current-system
+            mkdir-p/perms))
 
 ;;; Commentary:
 ;;;
@@ -55,6 +61,45 @@
 (define (dot-or-dot-dot? file)
   (member file '("." "..")))
 
+;; 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 file)
+    (unless (eq? 'directory (stat:type (lstat file)))
+      (error "file name component is not a directory" dir)))
+
+  (let loop ((components (string-tokenize dir not-slash))
+             (root       (if absolute?
+                             ""
+                             ".")))
+    (match components
+      ((head tail ...)
+       (let ((file (string-append root "/" head)))
+         (catch 'system-error
+           (lambda ()
+             (verify-component file)
+             (loop tail file))
+           (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))
+
 (define* (copy-account-skeletons home
                                  #:key
                                  (directory %skeleton-directory)
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index 73969a5a6d..d7efc48cd0 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 <dannym@scratchpost.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 '((gnu build activation)))
+    #~(begin
+        (use-modules (gnu build activation))
+        (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..20e3917b93 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 '((gnu build activation)
+                                                  (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 (gnu build activation)
+                     (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..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
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index d4aefe6285..55211cb08f 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (guix modules)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -607,17 +609,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 '((gnu build activation)))
+    #~(begin
+        (use-modules (gnu build activation))
+        (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))
-- 
2.30.0


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: TOCTTOU race

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> On Thu, 2021-02-18 at 18:54 +0100, Ludovic Courtès wrote:

[...]

>> 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.)
>
> If that happens, that's too bad.  Just ignoring the error seems bad from
> a security perspective.  I verified in a VM you'd get a REPL.
> From the REPL, a sysadmin could investigate and choose to delete the offending
> symlink & reboot (and presumably fix the security bug and upgrade the service),
> or decide Guix System needs to be reinstalled.

OK, sounds reasonable.

> Please take note that I didn't correct all potentially insecure activation gexps.
> These should ideally be done by someone who knows how to use the particular service
> and have a system to test it on.  (My changes to nscld-service-type and knot-activation
> are untested.)

I agree this is how it should happen ideally… let’s see if things happen
“ideally”.  :-)

> From 2c3968f658ada27d2062a960d229f3db9cfe208c 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
                             ^
Nitpick: we usually capitalize here and in the commit log.

Perhaps add a couple of lines explaining that this fixes a potential
security issue, with a link to this thread.

> Currently, there's a TOCTTOU race.  This can be addressed
> once guile has bindings for fstatat, openat and friends.

I’d move that comment next to the ‘mkdir-p/perms’ definition.

> * guix/build/service-utils.scm: new module
>   with new procedure 'mkdir-p/perms'.

I think you can remove these lines.

> * 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.

LGTM for master, thanks!

Ludo’.

Re: TOCTTOU race

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 1204 bytes --]

Hi,

On Mon, 2021-02-22 at 09:54 +0100, Ludovic Courtès wrote:
> [...]
> > Subject: [PATCH] services: prevent following symlinks during activation
>                              ^
> Nitpick: we usually capitalize here and in the commit log.

Fixed!  Also added a period at the end.

> Perhaps add a couple of lines explaining that this fixes a potential
> security issue, with a link to this thread.

Done.  But since ....

> > Currently, there's a TOCTTOU race.  This can be addressed
> > once guile has bindings for fstatat, openat and friends.

... I only claim it's a partial fix at best in the commit message.

> I’d move that comment next to the ‘mkdir-p/perms’ definition.

I copied it there, but left it (reworded slightly) in the commit
message, to avoid giving a false impression the potential security issue
is really fixed.

> > * guix/build/service-utils.scm: new module
> >   with new procedure 'mkdir-p/perms'.
> 
> I think you can remove these lines.

I removed the ‘Makefile.am’ and ‘guix/build/service-utils.scm’
lines which aren't relevant anymore, but kept the other lines.

Is all addressed now? (Aside from the TOCTTOU.)

Maxime.

[-- Attachment #1.2: 0001-services-Prevent-following-symlinks-during-activatio.patch --]
[-- Type: text/x-patch, Size: 12180 bytes --]

From 395208e1e8e1ab6dd3eb5739b2726f06a49e0041 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.

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.
---
 gnu/build/activation.scm        | 53 +++++++++++++++++++++++++++++++--
 gnu/services/authentication.scm | 22 ++++++++------
 gnu/services/cups.scm           | 12 ++++----
 gnu/services/dbus.scm           | 37 ++++++++++++-----------
 gnu/services/dns.scm            | 21 +++++++------
 5 files changed, 98 insertions(+), 47 deletions(-)

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index b458aee4ae..6cb6f8819b 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,6 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,7 +42,8 @@
             activate-modprobe
             activate-firmware
             activate-ptrace-attach
-            activate-current-system))
+            activate-current-system
+            mkdir-p/perms))
 
 ;;; Commentary:
 ;;;
@@ -55,6 +61,47 @@
 (define (dot-or-dot-dot? file)
   (member file '("." "..")))
 
+;; 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 file)
+    (unless (eq? 'directory (stat:type (lstat file)))
+      (error "file name component is not a directory" dir)))
+
+  (let loop ((components (string-tokenize dir not-slash))
+             (root       (if absolute?
+                             ""
+                             ".")))
+    (match components
+      ((head tail ...)
+       (let ((file (string-append root "/" head)))
+         (catch 'system-error
+           (lambda ()
+             (verify-component file)
+             (loop tail file))
+           (lambda args
+             (if (= ENOENT (system-error-errno args))
+                 #t
+                 (apply throw args))))))
+      (() #t))))
+
+;; TODO: the TOCTTOU race can be addressed once guile has bindings
+;; for fstatat, openat and friends.
+(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 TOCTTOU race!"
+  (verify-not-symbolic directory)
+  (mkdir-p directory)
+  (chown directory (passwd:uid owner) (passwd:gid owner))
+  (chmod directory bits))
+
 (define* (copy-account-skeletons home
                                  #:key
                                  (directory %skeleton-directory)
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index 73969a5a6d..d7efc48cd0 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 <dannym@scratchpost.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 '((gnu build activation)))
+    #~(begin
+        (use-modules (gnu build activation))
+        (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..20e3917b93 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; 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 '((gnu build activation)
+                                                  (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 (gnu build activation)
+                     (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..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
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index d4aefe6285..55211cb08f 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (guix modules)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -607,17 +609,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 '((gnu build activation)))
+    #~(begin
+        (use-modules (gnu build activation))
+        (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))
-- 
2.30.0


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: TOCTTOU race

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> Is all addressed now? (Aside from the TOCTTOU.)

Yes, thank you!

Ludo’.

Re: TOCTTOU race

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 343 bytes --]

On Tue, 2021-02-23 at 16:30 +0100, Ludovic Courtès wrote:
> Hi,
> 
> Maxime Devos <maximedevos@telenet.be> skribis:
> 
> > Is all addressed now? (Aside from the TOCTTOU.)
> 
> Yes, thank you!

If all is addressed now, could you apply the patch?
I don't see it in master yet and I don't have commit access.

Greetings,
Maxime.


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: TOCTTOU race

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> On Tue, 2021-02-23 at 16:30 +0100, Ludovic Courtès wrote:
>> Hi,
>> 
>> Maxime Devos <maximedevos@telenet.be> skribis:
>> 
>> > Is all addressed now? (Aside from the TOCTTOU.)
>> 
>> Yes, thank you!
>
> If all is addressed now, could you apply the patch?
> I don't see it in master yet and I don't have commit access.

Oops, sorry for the huge delay; I keep thinking that you already have
commit rights.  Anyway, I’ve applied it now and will push shortly.

Thanks!

Ludo’.

PS: Feel free to ping me or other committers on IRC next time.  :-)

Re: Potential security weakness in Guix services

[Christopher Lemmer Webber]

Ludovic Courtès writes:

> I think it’s a good endeavor, but it’s a longer-term one since it’ll
> take some time before this new version is in use by all the Guix code.
>
> The difficulty in designing such an interface is that the Scheme API is
> more about ports than it’s about file names and file descriptors.
>
> Thanks!
>
> Ludo’.

In the long run, that might end up being safer.
In the meanwhile, we suffer the world of ACLs. ;)

(From my read, this is practically exactly the scenario from Norm
Hardy's original Confused Deputy paper...)