bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

I’m observing this:

--8<---------------cut here---------------start------------->8---
$ guix environment --ad-hoc coreutils -C
guix environment: error: mount: mount "/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16" on "/tmp/guix-directory.Nagh8Y//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16": Operation not permitted
$ uname -rv
4.19.0-13-amd64 #1 SMP Debian 4.19.160-2 (2020-11-28)
$ cat /proc/sys/kernel/unprivileged_userns_clone
1
--8<---------------cut here---------------end--------------->8---

Excerpt of the strace log:

--8<---------------cut here---------------start------------->8---
7605  mkdir("/tmp/guix-directory.EtXAVT/dev/mqueue", 0777) = 0
7605  mount("mqueue", "/tmp/guix-directory.EtXAVT//dev/mqueue", "mqueue", MS_NOSUID|MS_NODEV|MS_NOEXEC, NULL) = 0
7605  stat("/home/lcourtes", {st_mode=S_IFDIR|0710, st_size=4096, ...}) = 0
7605  mkdir("/tmp", 0777)               = -1 EEXIST (File exists)
7605  mkdir("/tmp/guix-directory.EtXAVT", 0777) = -1 EEXIST (File exists)
7605  mkdir("/tmp/guix-directory.EtXAVT/home", 0777) = 0
7605  mkdir("/tmp/guix-directory.EtXAVT/home/lcourtes", 0777) = 0
7605  mount("/home/lcourtes", "/tmp/guix-directory.EtXAVT//home/lcourtes", 0xeea390, MS_BIND, NULL) = 0
7605  stat("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", {st_mode=S_IFDIR|0555, st_size=4096, ...}) = 0
7605  mkdir("/tmp", 0777)               = -1 EEXIST (File exists)
7605  mkdir("/tmp/guix-directory.EtXAVT", 0777) = -1 EEXIST (File exists)
7605  mkdir("/tmp/guix-directory.EtXAVT/gnu", 0777) = 0
7605  mkdir("/tmp/guix-directory.EtXAVT/gnu/store", 0777) = 0
7605  mkdir("/tmp/guix-directory.EtXAVT/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0777) = 0
7605  mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.EtXAVT//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0xeea3b0, MS_RDONLY|MS_BIND, NULL) = 0
7605  mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.EtXAVT//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0xeea3d0, MS_RDONLY|MS_REMOUNT|MS_BIND, NULL) = -1 EPERM (Operation not permitted)
--8<---------------cut here---------------end--------------->8---

The read-only remount comes from ‘mount-file-system’ in (gnu build
file-systems):

    ;; For read-only bind mounts, an extra remount is needed, as per
    ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
    ;; 4.0.
    (when (and (= MS_BIND (logand flags MS_BIND))
               (= MS_RDONLY (logand flags MS_RDONLY)))
      (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
        (mount source mount-point type flags #f)))

This recipe has been working well “forever”, although it’s probably
unnecessary with recent kernels (the LWN article is from 2008).

The problem may have to do with the fact that /gnu/store is an NFS
mount.  Indeed, similar commands fail on $HOME (also an NFS mount):

--8<---------------cut here---------------start------------->8---
$ mkdir t m
$ unshare -mrf
# mount --bind ./t ./m
# mount --bind -r -o remount ./t ./m
mount: /home/lcourtes/m: permission denied.
--8<---------------cut here---------------end--------------->8---

… but they succeed on /tmp (not an NFS mount):

--8<---------------cut here---------------start------------->8---
$ mkdir /tmp/t
$ mkdir /tmp/m
$ unshare -mrf
# mount --bind /tmp/{t,m}
# mount --bind -r -o remount /tmp/{t,m}
--8<---------------cut here---------------end--------------->8---

To be continued…

Ludo’.

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[zimoun]

Hi,

On Thu, 04 Feb 2021 at 11:43, Ludovic Courtès <ludovic.courtes@inria.fr> wrote:

> --8<---------------cut here---------------start------------->8---
> $ guix environment --ad-hoc coreutils -C
> guix environment: error: mount: mount "/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16" on "/tmp/guix-directory.Nagh8Y//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16": Operation not permitted
> $ uname -rv
> 4.19.0-13-amd64 #1 SMP Debian 4.19.160-2 (2020-11-28)
> $ cat /proc/sys/kernel/unprivileged_userns_clone
> 1
> --8<---------------cut here---------------end--------------->8---

With a bit older Debian than yours:

--8<---------------cut here---------------start------------->8---
$ guix environment --ad-hoc coreutils -C
[env]$ uname -rv
4.19.0-8-amd64 #1 SMP Debian 4.19.98-1 (2020-01-26)
[env]$ cat /proc/sys/kernel/unprivileged_userns_clone
1
[env]$ exit
exit
--8<---------------cut here---------------end--------------->8---

On another machine with the same kernel:

--8<---------------cut here---------------start------------->8---
$ guix environment --ad-hoc coreutils -C
[env]$ uname -rv
4.19.0-13-amd64 #1 SMP Debian 4.19.160-2 (2020-11-28)
[env]$ cat /proc/sys/kernel/unprivileged_userns_clone
1
[env]$ exit
exit
--8<---------------cut here---------------end--------------->8---


Maybe I misconfigured mines or something is different on yours. :-)


All the best,
simon

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

Ludovic Courtès <ludovic.courtes@inria.fr> skribis:

> The problem may have to do with the fact that /gnu/store is an NFS
> mount.

Maybe not?  I tested on a similar setup where it Just Works:

--8<---------------cut here---------------start------------->8---
$ guix describe
Generation 6    Feb 04 2021 15:37:16    (current)
  guix e7195e8
    repository URL: https://git.savannah.gnu.org/git/guix.git
    branch: master
    commit: e7195e83c85a83131c0981bae2b6e5613669ebd1
$ df -h /gnu/store
Filesystem                                Size  Used Avail Use% Mounted on
<redacted>:/GNUSTORE                      973G  118G  856G  13% /gnu/store
$ uname -rv
4.9.0-11-amd64 #1 SMP Debian 4.9.189-3+deb9u2 (2019-11-11)
$ guix environment -C --ad-hoc coreutils
[env]$ id
uid=11279(lcourtes) gid=10038(users) groups=10038(users),65534(overflow)
--8<---------------cut here---------------end--------------->8---

Ludo’.

bug#46292: more info

[Lucas Nussbaum]

Hi,

This is not due to NFS, but due to the fact that the NFS mount is
mounted nosuid (and nodev, probably). I can reproduce it on a local
filesystem mounted nosuid.

It seems that, when remounting a bind mount which is originally nosuid
inside a mount ns, you need to specify explicitely the nosuid option, or
else can_change_locked_flags()[1] will return false.

[1] https://github.com/torvalds/linux/blame/master/fs/namespace.c#L2480

There's a concept of "locked mount flags" that cannot be cleared by a
less privileged user (see [2]). Our call to 'mount -o remount' ignores the
fact that the filesystem is mounted nosuid (and does not include this
flag), so the remount call tries to remove nosuid, and fails.

[2] https://github.com/torvalds/linux/commit/9566d6742852c527bf5af38af5cbb878dad75705

This probably needs to be fixed in Guix by fetching the current mount
flags and including them in the bind+remount+readonly call.
Unfortunately I did not find an easy way to convert mount flags in
/proc/$$/mountinfo to flags for the mount syscall...

Lucas

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

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

Hi Lucas,

Lucas Nussbaum <lucas.nussbaum@inria.fr> skribis:

> This is not due to NFS, but due to the fact that the NFS mount is
> mounted nosuid (and nodev, probably). I can reproduce it on a local
> filesystem mounted nosuid.
>
> It seems that, when remounting a bind mount which is originally nosuid
> inside a mount ns, you need to specify explicitely the nosuid option, or
> else can_change_locked_flags()[1] will return false.
>
> [1] https://github.com/torvalds/linux/blame/master/fs/namespace.c#L2480
>
> There's a concept of "locked mount flags" that cannot be cleared by a
> less privileged user (see [2]). Our call to 'mount -o remount' ignores the
> fact that the filesystem is mounted nosuid (and does not include this
> flag), so the remount call tries to remove nosuid, and fails.
>
> [2] https://github.com/torvalds/linux/commit/9566d6742852c527bf5af38af5cbb878dad75705

Ooh, thanks for investigating!

> This probably needs to be fixed in Guix by fetching the current mount
> flags and including them in the bind+remount+readonly call.
> Unfortunately I did not find an easy way to convert mount flags in
> /proc/$$/mountinfo to flags for the mount syscall...

I tried grabbing mount options from there and reapplying them to the
MS_REMOUNT call (patch below).  However, that still doesn’t work:

--8<---------------cut here---------------start------------->8---
14273 mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.Plgkgt//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0x236a4b0, MS_RDONLY|MS_REMOUNT|MS_BIND, "rw,nosuid,nodev,relatime") = -1 EPERM (Operation not permitted)
--8<---------------cut here---------------end--------------->8---

Interestingly, the ‘mount’ command does not attempt to re-apply the
original mount options (“nosuid” & co.):

--8<---------------cut here---------------start------------->8---
# strace -e mount mount --bind -o ro t m
mount("/home/lcourtes/t", "/home/lcourtes/m", 0x564dde270cb0, MS_RDONLY|MS_BIND, NULL) = 0
mount("none", "/home/lcourtes/m", NULL, MS_RDONLY|MS_REMOUNT|MS_BIND, NULL) = -1 EPERM (Operation not permitted)
mount: /home/lcourtes/m: filesystem was mounted, but any subsequent operation failed: Unknown error 5005.
+++ exited with 32 +++
# mount --version
mount from util-linux 2.33.1 (libmount 2.33.1: selinux, smack, btrfs, namespaces, assert, debug)
--8<---------------cut here---------------end--------------->8---

To be continued…

Ludo’.


[-- Attachment #2: Type: text/x-patch, Size: 6053 bytes --]

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ddf6117b67..4ecb58c8ea 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@@ -36,6 +36,7 @@
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:export (disk-partitions
             partition-label-predicate
@@ -886,6 +887,59 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
+(define-record-type <mount>
+  (%mount source point devno type options)
+  mount?
+  (devno    mount-device-number)                  ;st_dev
+  (source   mount-source)
+  (point    mount-point)
+  (type     mount-type)
+  (options  mount-options))
+
+(define (octal-decode str)
+  "Decode octal escapes from STR and return the corresponding string.  STR may
+look like this: \"white\\040space\", which is decoded as \"white space\"."
+  (define char-set:octal
+    (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
+  (define (octal? c)
+    (char-set-contains? char-set:octal c))
+
+  (let loop ((chars (string->list str))
+             (result '()))
+    (match chars
+      (()
+       (list->string (reverse result)))
+      ((#\\ (? octal? a) (? octal? b) (? octal? c) . rest)
+       (loop rest
+             (cons (integer->char
+                    (string->number (list->string (list a b c)) 8))
+                   result)))
+      ((head . tail)
+       (loop tail (cons head result))))))
+
+(define (string->device-number str)
+  (match (string-split str #\:)
+    (((= string->number major) (= string->number minor))
+     (+ (* major 256) minor))))
+
+(define (mounts)
+  "Return the list of mounts (<mount> records) visible in the namespace of the
+current process."
+  (call-with-input-file "/proc/self/mountinfo"
+    (lambda (port)
+      (let loop ((result '()))
+        (let ((line (read-line port)))
+          (if (eof-object? line)
+              (reverse result)
+              (match (string-tokenize line)
+                ((id parent-id major:minor root mount-point
+                     options _ _ type source _ ...)
+                 (let ((devno (string->device-number major:minor)))
+                   (loop (cons (%mount (octal-decode source)
+                                       (octal-decode mount-point)
+                                       devno type options)
+                               result)))))))))))
+
 (define* (mount-file-system fs #:key (root "/root"))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
@@ -894,8 +948,8 @@ corresponds to the symbols listed in FLAGS."
            (host-part (string-take source idx))
            ;; Strip [] from around host if present
            (host (match (string-split host-part (string->char-set "[]"))
-                 (("" h "") h)
-                 ((h) h)))
+                   (("" h "") h)
+                   ((h) h)))
            (aa (match (getaddrinfo host "nfs") ((x . _) x)))
            (sa (addrinfo:addr aa))
            (inet-addr (inet-ntop (sockaddr:fam sa)
@@ -912,7 +966,7 @@ corresponds to the symbols listed in FLAGS."
   (let ((type        (file-system-type fs))
         (options     (file-system-options fs))
         (source      (canonicalize-device-spec (file-system-device fs)))
-        (mount-point (string-append root "/"
+        (target      (string-append root "/"
                                     (file-system-mount-point fs)))
         (flags       (mount-flags->bit-mask (file-system-flags fs))))
     (when (file-system-check? fs)
@@ -925,24 +979,30 @@ corresponds to the symbols listed in FLAGS."
         ;; needed.
         (if (and (= MS_BIND (logand flags MS_BIND))
                  (not (file-is-directory? source)))
-            (unless (file-exists? mount-point)
-              (mkdir-p (dirname mount-point))
-              (call-with-output-file mount-point (const #t)))
-            (mkdir-p mount-point))
+            (unless (file-exists? target)
+              (mkdir-p (dirname target))
+              (call-with-output-file target (const #t)))
+            (mkdir-p target))
 
         (cond
          ((string-prefix? "nfs" type)
-          (mount-nfs source mount-point type flags options))
+          (mount-nfs source target type flags options))
          (else
-          (mount source mount-point type flags options)))
+          (mount source target type flags options)))
 
         ;; For read-only bind mounts, an extra remount is needed, as per
         ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
         ;; 4.0.
         (when (and (= MS_BIND (logand flags MS_BIND))
                    (= MS_RDONLY (logand flags MS_RDONLY)))
-          (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
-            (mount source mount-point type flags #f))))
+          (let ((flags   (logior MS_BIND MS_REMOUNT MS_RDONLY))
+                (options (and=> (find (let ((devno (stat:dev (lstat source))))
+                                        (lambda (mount)
+                                          (= (mount-device-number mount)
+                                             devno)))
+                                      (mounts))
+                                mount-options)))
+            (mount source target type flags options))))
       (lambda args
         (or (file-system-mount-may-fail? fs)
             (apply throw args))))))

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Lucas Nussbaum]

Hi Ludovic,

On 18/02/21 at 12:38 +0100, Ludovic Courtès wrote:
> Hi Lucas,
> 
> Lucas Nussbaum <lucas.nussbaum@inria.fr> skribis:
> 
> > This is not due to NFS, but due to the fact that the NFS mount is
> > mounted nosuid (and nodev, probably). I can reproduce it on a local
> > filesystem mounted nosuid.
> >
> > It seems that, when remounting a bind mount which is originally nosuid
> > inside a mount ns, you need to specify explicitely the nosuid option, or
> > else can_change_locked_flags()[1] will return false.
> >
> > [1] https://github.com/torvalds/linux/blame/master/fs/namespace.c#L2480
> >
> > There's a concept of "locked mount flags" that cannot be cleared by a
> > less privileged user (see [2]). Our call to 'mount -o remount' ignores the
> > fact that the filesystem is mounted nosuid (and does not include this
> > flag), so the remount call tries to remove nosuid, and fails.
> >
> > [2] https://github.com/torvalds/linux/commit/9566d6742852c527bf5af38af5cbb878dad75705
> 
> Ooh, thanks for investigating!
> 
> > This probably needs to be fixed in Guix by fetching the current mount
> > flags and including them in the bind+remount+readonly call.
> > Unfortunately I did not find an easy way to convert mount flags in
> > /proc/$$/mountinfo to flags for the mount syscall...
> 
> I tried grabbing mount options from there and reapplying them to the
> MS_REMOUNT call (patch below).  However, that still doesn’t work:
> 
> --8<---------------cut here---------------start------------->8---
> 14273 mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.Plgkgt//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0x236a4b0, MS_RDONLY|MS_REMOUNT|MS_BIND, "rw,nosuid,nodev,relatime") = -1 EPERM (Operation not permitted)
> --8<---------------cut here---------------end--------------->8---

That's strange: it worked in my manual tests.

> Interestingly, the ‘mount’ command does not attempt to re-apply the
> original mount options (“nosuid” & co.):
> 
> --8<---------------cut here---------------start------------->8---
> # strace -e mount mount --bind -o ro t m
> mount("/home/lcourtes/t", "/home/lcourtes/m", 0x564dde270cb0, MS_RDONLY|MS_BIND, NULL) = 0
> mount("none", "/home/lcourtes/m", NULL, MS_RDONLY|MS_REMOUNT|MS_BIND, NULL) = -1 EPERM (Operation not permitted)
> mount: /home/lcourtes/m: filesystem was mounted, but any subsequent operation failed: Unknown error 5005.
> +++ exited with 32 +++
> # mount --version
> mount from util-linux 2.33.1 (libmount 2.33.1: selinux, smack, btrfs, namespaces, assert, debug)
> --8<---------------cut here---------------end--------------->8---
> 
> To be continued…

I think that's something I also initially misunderstood as well: mount
-o remount,<flags> essentially means: remount the filesystem with a
fresh set of flags. The set of flags previously configured is completely
ignored.

Lucas

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

Hi Lucas,

Lucas Nussbaum <lucas.nussbaum@inria.fr> skribis:

> On 18/02/21 at 12:38 +0100, Ludovic Courtès wrote:

[...]

>> I tried grabbing mount options from there and reapplying them to the
>> MS_REMOUNT call (patch below).  However, that still doesn’t work:
>> 
>> --8<---------------cut here---------------start------------->8---
>> 14273 mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.Plgkgt//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0x236a4b0, MS_RDONLY|MS_REMOUNT|MS_BIND, "rw,nosuid,nodev,relatime") = -1 EPERM (Operation not permitted)
>> --8<---------------cut here---------------end--------------->8---
>
> That's strange: it worked in my manual tests.

I investigated some more and can’t get it to work.  Do you happen to
have a working invocation or C snippet?

Thanks,
Ludo’.

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Lucas Nussbaum]

On 22/02/21 at 10:46 +0100, Ludovic Courtès wrote:
> Hi Lucas,
> 
> Lucas Nussbaum <lucas.nussbaum@inria.fr> skribis:
> 
> > On 18/02/21 at 12:38 +0100, Ludovic Courtès wrote:
> 
> [...]
> 
> >> I tried grabbing mount options from there and reapplying them to the
> >> MS_REMOUNT call (patch below).  However, that still doesn’t work:
> >> 
> >> --8<---------------cut here---------------start------------->8---
> >> 14273 mount("/gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", "/tmp/guix-directory.Plgkgt//gnu/store/mmhimfwmmidf09jw1plw3aw1g1zn2nkh-bash-static-5.0.16", 0x236a4b0, MS_RDONLY|MS_REMOUNT|MS_BIND, "rw,nosuid,nodev,relatime") = -1 EPERM (Operation not permitted)
> >> --8<---------------cut here---------------end--------------->8---
> >
> > That's strange: it worked in my manual tests.
> 
> I investigated some more and can’t get it to work.  Do you happen to
> have a working invocation or C snippet?

Here is an example:

root@grisou-48:/tmp# mkdir t m

without nosuid:

root@grisou-48:/tmp# unshare -mrf
mesg: cannot open /dev/pts/0: Permission denied
root@grisou-48:/tmp# mount --bind t m
root@grisou-48:/tmp# mount --bind -r -o remount ./t ./m
root@grisou-48:/tmp# logout

now remount with nosuid:

root@grisou-48:/tmp# mount -o remount,nosuid /tmp
root@grisou-48:/tmp# mount |grep /tmp
/dev/sda5 on /tmp type ext4 (rw,nosuid,relatime)

and try again:

root@grisou-48:/tmp# unshare -mrf
mesg: cannot open /dev/pts/0: Permission denied
root@grisou-48:/tmp# mount --bind t m
root@grisou-48:/tmp# mount |grep /tmp
/dev/sda5 on /tmp type ext4 (rw,nosuid,relatime)
/dev/sda5 on /tmp/m type ext4 (rw,nosuid,relatime)
root@grisou-48:/tmp# mount --bind -r -o remount ./t ./m
mount: /tmp/m: permission denied.

^ that's expected
but it works when specifying nosuid:

root@grisou-48:/tmp# mount --bind -r -o remount,nosuid ./t ./m
root@grisou-48:/tmp# 

From strace:
mount("/tmp/t", "/tmp/m", 0x55e75bf38cb0, MS_RDONLY|MS_NOSUID|MS_REMOUNT|MS_BIND, NULL) = 0

MS_NOSUID is missing from mountflags in your invocation. Apparently data
can be NULL.
-- 
Lucas Nussbaum   <lucas.nussbaum@inria.fr>   +33 3 54 95 86 19
Responsable du programme plateformes d'expérimentation
DDO-SDT - Direction Générale Déléguée à l'Innovation - Inria

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

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

Hi,

Lucas Nussbaum <lucas.nussbaum@inria.fr> skribis:

>>From strace:
> mount("/tmp/t", "/tmp/m", 0x55e75bf38cb0, MS_RDONLY|MS_NOSUID|MS_REMOUNT|MS_BIND, NULL) = 0
>
> MS_NOSUID is missing from mountflags in your invocation. Apparently data
> can be NULL.

Ooooh, got it.  It’s another instance of the mount flag vs. option
confusion (/proc/mounts & co. lump flags and options together in one
string).

The attached patch solves that.  I’ll polish it and push soon.

Thank you!

Ludo’.


[-- Attachment #2: Type: text/x-patch, Size: 8633 bytes --]

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ddf6117b67..527c51cea0 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@@ -36,6 +36,7 @@
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:export (disk-partitions
             partition-label-predicate
@@ -886,6 +887,98 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
+;; Mount point information.
+(define-record-type <mount>
+  (%mount source point devno type options)
+  mount?
+  (devno    mount-device-number)                  ;st_dev
+  (source   mount-source)                         ;string
+  (point    mount-point)                          ;string
+  (type     mount-type)                           ;string
+  (options  mount-options))                       ;string
+
+(define (option-string->mount-flags str)
+  "Parse the \"option string\" STR as it appears in /proc/mounts and similar,
+and return two values: a mount bitmask (inclusive or of MS_* constants), and
+the remaining unprocessed options."
+  (define not-comma
+    (char-set-complement (char-set #\,)))
+
+  (define lst
+    (string-tokenize str not-comma))
+
+  (let loop ((options   lst)
+             (mask      0)
+             (remainder '()))
+    (match options
+      (()
+       (values mask (string-concatenate-reverse remainder)))
+      ((head . tail)
+       (letrec-syntax ((match-options (syntax-rules (=>)
+                                        ((_)
+                                         (loop tail mask
+                                               (cons head remainder)))
+                                        ((_ (str => bit) rest ...)
+                                         (if (string=? str head)
+                                             (loop tail (logior bit mask)
+                                                   remainder)
+                                             (match-options rest ...))))))
+         ;; TODO: Add MS_RELATIME and more flags.
+         (match-options ("ro"      => MS_RDONLY)
+                        ("nosuid"  => MS_NOSUID)
+                        ("nodev"   => MS_NODEV)
+                        ("noexec"  => MS_NOEXEC)
+                        ("noatime" => MS_NOATIME)))))))
+
+(define (mount-flags mount)
+  "Return the mount flags of MOUNT, a <mount> record, as an inclusive or of
+MS_* constants."
+  (option-string->mount-flags (mount-options mount)))
+
+(define (octal-decode str)
+  "Decode octal escapes from STR and return the corresponding string.  STR may
+look like this: \"white\\040space\", which is decoded as \"white space\"."
+  (define char-set:octal
+    (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
+  (define (octal? c)
+    (char-set-contains? char-set:octal c))
+
+  (let loop ((chars (string->list str))
+             (result '()))
+    (match chars
+      (()
+       (list->string (reverse result)))
+      ((#\\ (? octal? a) (? octal? b) (? octal? c) . rest)
+       (loop rest
+             (cons (integer->char
+                    (string->number (list->string (list a b c)) 8))
+                   result)))
+      ((head . tail)
+       (loop tail (cons head result))))))
+
+(define (mounts)
+  "Return the list of mounts (<mount> records) visible in the namespace of the
+current process."
+  (define (string->device-number str)
+    (match (string-split str #\:)
+      (((= string->number major) (= string->number minor))
+       (+ (* major 256) minor))))
+
+  (call-with-input-file "/proc/self/mountinfo"
+    (lambda (port)
+      (let loop ((result '()))
+        (let ((line (read-line port)))
+          (if (eof-object? line)
+              (reverse result)
+              (match (string-tokenize line)
+                ((id parent-id major:minor root mount-point
+                     options _ type source _ ...)
+                 (let ((devno (string->device-number major:minor)))
+                   (loop (cons (%mount (octal-decode source)
+                                       (octal-decode mount-point)
+                                       devno type options)
+                               result)))))))))))
+
 (define* (mount-file-system fs #:key (root "/root"))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
@@ -894,8 +987,8 @@ corresponds to the symbols listed in FLAGS."
            (host-part (string-take source idx))
            ;; Strip [] from around host if present
            (host (match (string-split host-part (string->char-set "[]"))
-                 (("" h "") h)
-                 ((h) h)))
+                   (("" h "") h)
+                   ((h) h)))
            (aa (match (getaddrinfo host "nfs") ((x . _) x)))
            (sa (addrinfo:addr aa))
            (inet-addr (inet-ntop (sockaddr:fam sa)
@@ -909,12 +1002,22 @@ corresponds to the symbols listed in FLAGS."
                             (if options
                                 (string-append "," options)
                                 "")))))
-  (let ((type        (file-system-type fs))
-        (options     (file-system-options fs))
-        (source      (canonicalize-device-spec (file-system-device fs)))
-        (mount-point (string-append root "/"
-                                    (file-system-mount-point fs)))
-        (flags       (mount-flags->bit-mask (file-system-flags fs))))
+  (let* ((type    (file-system-type fs))
+         (source  (canonicalize-device-spec (file-system-device fs)))
+         (target  (string-append root "/"
+                                 (file-system-mount-point fs)))
+         (flags   (logior (mount-flags->bit-mask (file-system-flags fs))
+                          (if (memq 'bind-mount (file-system-flags fs))
+                              (or (and=> (find (let ((devno (stat:dev
+                                                             (lstat source))))
+                                                 (lambda (mount)
+                                                   (= (mount-device-number mount)
+                                                      devno)))
+                                               (mounts))
+                                         mount-flags)
+                                  0)
+                              0)))
+         (options (file-system-options fs)))
     (when (file-system-check? fs)
       (check-file-system source type))
 
@@ -925,24 +1028,24 @@ corresponds to the symbols listed in FLAGS."
         ;; needed.
         (if (and (= MS_BIND (logand flags MS_BIND))
                  (not (file-is-directory? source)))
-            (unless (file-exists? mount-point)
-              (mkdir-p (dirname mount-point))
-              (call-with-output-file mount-point (const #t)))
-            (mkdir-p mount-point))
+            (unless (file-exists? target)
+              (mkdir-p (dirname target))
+              (call-with-output-file target (const #t)))
+            (mkdir-p target))
 
         (cond
          ((string-prefix? "nfs" type)
-          (mount-nfs source mount-point type flags options))
+          (mount-nfs source target type flags options))
          (else
-          (mount source mount-point type flags options)))
+          (mount source target type flags options)))
 
         ;; For read-only bind mounts, an extra remount is needed, as per
         ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
         ;; 4.0.
         (when (and (= MS_BIND (logand flags MS_BIND))
                    (= MS_RDONLY (logand flags MS_RDONLY)))
-          (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
-            (mount source mount-point type flags #f))))
+          (let ((flags (logior MS_REMOUNT flags)))
+            (mount source target type flags options))))
       (lambda args
         (or (file-system-mount-may-fail? fs)
             (apply throw args))))))

bug#46292: [PATCH 1/3] syscalls: Define MS_RELATIME.

[Ludovic Courtès]

* guix/build/syscalls.scm (MS_RELATIME): New variable.
---
 guix/build/syscalls.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 85c1c45f81..b19a7a271b 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -43,9 +43,10 @@
             MS_NOEXEC
             MS_REMOUNT
             MS_NOATIME
+            MS_STRICTATIME
+            MS_RELATIME
             MS_BIND
             MS_MOVE
-            MS_STRICTATIME
             MS_LAZYTIME
             MNT_FORCE
             MNT_DETACH
@@ -466,6 +467,7 @@ the returned procedure is called."
 (define MS_NOATIME         1024)
 (define MS_BIND            4096)
 (define MS_MOVE            8192)
+(define MS_RELATIME     2097152)
 (define MS_STRICTATIME 16777216)
 (define MS_LAZYTIME    33554432)
 
-- 
2.30.0

bug#46292: [PATCH 2/3] syscalls: Add 'mounts' and the <mount> record type.

[Ludovic Courtès]

* guix/build/syscalls.scm (<mount>): New record type.
(option-string->mount-flags, mount-flags)
(octal-decode, mounts): New procedures.
(mount-points): Rewrite in terms of 'mount'.
* tests/syscalls.scm ("mounts"): New test.
---
 guix/build/syscalls.scm | 112 +++++++++++++++++++++++++++++++++++++---
 tests/syscalls.scm      |  16 +++++-
 2 files changed, 121 insertions(+), 7 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index b19a7a271b..552343a481 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -54,7 +54,18 @@
             UMOUNT_NOFOLLOW
 
             restart-on-EINTR
+
+            mount?
+            mount-device-number
+            mount-source
+            mount-point
+            mount-type
+            mount-options
+            mount-flags
+
+            mounts
             mount-points
+
             swapon
             swapoff
 
@@ -521,17 +532,106 @@ constants from <sys/mount.h>."
       (when update-mtab?
         (remove-from-mtab target)))))
 
-(define (mount-points)
-  "Return the mounts points for currently mounted file systems."
-  (call-with-input-file "/proc/mounts"
+;; Mount point information.
+(define-record-type <mount>
+  (%mount source point devno type options)
+  mount?
+  (devno    mount-device-number)                  ;st_dev
+  (source   mount-source)                         ;string
+  (point    mount-point)                          ;string
+  (type     mount-type)                           ;string
+  (options  mount-options))                       ;string
+
+(define (option-string->mount-flags str)
+  "Parse the \"option string\" STR as it appears in /proc/mounts and similar,
+and return two values: a mount bitmask (inclusive or of MS_* constants), and
+the remaining unprocessed options."
+  ;; Why do we need to do this?  Because mount flags and mount options are
+  ;; often lumped together; this is the case in /proc/mounts & co., so we need
+  ;; to extract the bits that actually correspond to mount flags.
+
+  (define not-comma
+    (char-set-complement (char-set #\,)))
+
+  (define lst
+    (string-tokenize str not-comma))
+
+  (let loop ((options   lst)
+             (mask      0)
+             (remainder '()))
+    (match options
+      (()
+       (values mask (string-concatenate-reverse remainder)))
+      ((head . tail)
+       (letrec-syntax ((match-options (syntax-rules (=>)
+                                        ((_)
+                                         (loop tail mask
+                                               (cons head remainder)))
+                                        ((_ (str => bit) rest ...)
+                                         (if (string=? str head)
+                                             (loop tail (logior bit mask)
+                                                   remainder)
+                                             (match-options rest ...))))))
+         (match-options ("rw"         => 0)
+                        ("ro"         => MS_RDONLY)
+                        ("nosuid"     => MS_NOSUID)
+                        ("nodev"      => MS_NODEV)
+                        ("noexec"     => MS_NOEXEC)
+                        ("relatime"   => MS_RELATIME)
+                        ("noatime"    => MS_NOATIME)))))))
+
+(define (mount-flags mount)
+  "Return the mount flags of MOUNT, a <mount> record, as an inclusive or of
+MS_* constants."
+  (option-string->mount-flags (mount-options mount)))
+
+(define (octal-decode str)
+  "Decode octal escapes from STR and return the corresponding string.  STR may
+look like this: \"white\\040space\", which is decoded as \"white space\"."
+  (define char-set:octal
+    (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
+  (define (octal? c)
+    (char-set-contains? char-set:octal c))
+
+  (let loop ((chars (string->list str))
+             (result '()))
+    (match chars
+      (()
+       (list->string (reverse result)))
+      ((#\\ (? octal? a) (? octal? b) (? octal? c) . rest)
+       (loop rest
+             (cons (integer->char
+                    (string->number (list->string (list a b c)) 8))
+                   result)))
+      ((head . tail)
+       (loop tail (cons head result))))))
+
+(define (mounts)
+  "Return the list of mounts (<mount> records) visible in the namespace of the
+current process."
+  (define (string->device-number str)
+    (match (string-split str #\:)
+      (((= string->number major) (= string->number minor))
+       (+ (* major 256) minor))))
+
+  (call-with-input-file "/proc/self/mountinfo"
     (lambda (port)
       (let loop ((result '()))
         (let ((line (read-line port)))
           (if (eof-object? line)
               (reverse result)
               (match (string-tokenize line)
-                ((source mount-point _ ...)
-                 (loop (cons mount-point result))))))))))
+                ((id parent-id major:minor root mount-point
+                     options _ type source _ ...)
+                 (let ((devno (string->device-number major:minor)))
+                   (loop (cons (%mount (octal-decode source)
+                                       (octal-decode mount-point)
+                                       devno type options)
+                               result)))))))))))
+
+(define (mount-points)
+  "Return the mounts points for currently mounted file systems."
+  (map mount-point (mounts)))
 
 (define swapon
   (let ((proc (syscall->procedure int "swapon" (list '* int))))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 09aa228e8e..706dd4177f 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 Simon South <simon@simonsouth.net>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -56,6 +56,20 @@
       ;; Both return values have been encountered in the wild.
       (memv (system-error-errno args) (list EPERM ENOENT)))))
 
+(test-assert "mounts"
+  ;; Check for one of the common mount points.
+  (let ((mounts (mounts)))
+    (any (match-lambda
+           ((point . type)
+            (let ((mount (find (lambda (mount)
+                                 (string=? (mount-point mount) point))
+                               mounts)))
+              (and mount
+                   (string=? (mount-type mount) type)))))
+         '(("/proc"    . "proc")
+           ("/sys"     . "sysfs")
+           ("/dev/shm" . "tmpfs")))))
+
 (test-assert "mount-points"
   ;; Reportedly "/" is not always listed as a mount point, so check a few
   ;; others (see <http://bugs.gnu.org/20261>.)
-- 
2.30.0

bug#46292: [PATCH 3/3] file-systems: 'mount-file-system' preserves source flags for bind mounts.

[Ludovic Courtès]

From: Ludovic Courtès <ludovic.courtes@inria.fr>

Fixes <https://bugs.gnu.org/46292>.

* gnu/build/file-systems.scm (mount-file-system): If FS is a bind mount,
add its original mount flags to FLAGS.
---
 gnu/build/file-systems.scm | 45 +++++++++++++++++++++++++-------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ddf6117b67..aca4aad848 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@@ -909,12 +909,27 @@ corresponds to the symbols listed in FLAGS."
                             (if options
                                 (string-append "," options)
                                 "")))))
-  (let ((type        (file-system-type fs))
-        (options     (file-system-options fs))
-        (source      (canonicalize-device-spec (file-system-device fs)))
-        (mount-point (string-append root "/"
-                                    (file-system-mount-point fs)))
-        (flags       (mount-flags->bit-mask (file-system-flags fs))))
+  (let* ((type    (file-system-type fs))
+         (source  (canonicalize-device-spec (file-system-device fs)))
+         (target  (string-append root "/"
+                                 (file-system-mount-point fs)))
+         (flags   (logior (mount-flags->bit-mask (file-system-flags fs))
+
+                          ;; For bind mounts, preserve the original flags such
+                          ;; as MS_NOSUID, etc.  Failing to do that, the
+                          ;; MS_REMOUNT call below fails with EPERM.
+                          ;; See <https://bugs.gnu.org/46292>
+                          (if (memq 'bind-mount (file-system-flags fs))
+                              (or (and=> (find (let ((devno (stat:dev
+                                                             (lstat source))))
+                                                 (lambda (mount)
+                                                   (= (mount-device-number mount)
+                                                      devno)))
+                                               (mounts))
+                                         mount-flags)
+                                  0)
+                              0)))
+         (options (file-system-options fs)))
     (when (file-system-check? fs)
       (check-file-system source type))
 
@@ -925,24 +940,24 @@ corresponds to the symbols listed in FLAGS."
         ;; needed.
         (if (and (= MS_BIND (logand flags MS_BIND))
                  (not (file-is-directory? source)))
-            (unless (file-exists? mount-point)
-              (mkdir-p (dirname mount-point))
-              (call-with-output-file mount-point (const #t)))
-            (mkdir-p mount-point))
+            (unless (file-exists? target)
+              (mkdir-p (dirname target))
+              (call-with-output-file target (const #t)))
+            (mkdir-p target))
 
         (cond
          ((string-prefix? "nfs" type)
-          (mount-nfs source mount-point type flags options))
+          (mount-nfs source target type flags options))
          (else
-          (mount source mount-point type flags options)))
+          (mount source target type flags options)))
 
         ;; For read-only bind mounts, an extra remount is needed, as per
         ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
         ;; 4.0.
         (when (and (= MS_BIND (logand flags MS_BIND))
                    (= MS_RDONLY (logand flags MS_RDONLY)))
-          (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
-            (mount source mount-point type flags #f))))
+          (let ((flags (logior MS_REMOUNT flags)))
+            (mount source target type flags options))))
       (lambda args
         (or (file-system-mount-may-fail? fs)
             (apply throw args))))))
-- 
2.30.0

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

Pushed as dcb640f02b1f9590c3bd4301a22bf31bd60c56d4, thanks!

Ludo’.

bug#46292: ‘guix environment -C’ fails with Linux 4.19 (Debian)

[Ludovic Courtès]

Ludovic Courtès <ludovic.courtes@inria.fr> skribis:

> The read-only remount comes from ‘mount-file-system’ in (gnu build
> file-systems):
>
>     ;; For read-only bind mounts, an extra remount is needed, as per
>     ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
>     ;; 4.0.
>     (when (and (= MS_BIND (logand flags MS_BIND))
>                (= MS_RDONLY (logand flags MS_RDONLY)))
>       (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
>         (mount source mount-point type flags #f)))
>
> This recipe has been working well “forever”, although it’s probably
> unnecessary with recent kernels (the LWN article is from 2008).

Apparently the extra remount is still necessary, and the ‘mount’ command
does it for you if you combine ‘--bind’ with ‘-o ro’:

--8<---------------cut here---------------start------------->8---
# strace -e mount mount --bind -o ro t m
mount("/tmp/t", "/tmp/m", 0xde1930, MS_RDONLY|MS_BIND, NULL) = 0
mount("none", "/tmp/m", NULL, MS_RDONLY|MS_REMOUNT|MS_BIND, NULL) = 0
+++ exited with 0 +++
# mount --version
mount from util-linux 2.35.1 (libmount 2.35.1: btrfs, namespaces, assert, debug)
# uname -sr
Linux 5.10.10-gnu
--8<---------------cut here---------------end--------------->8---

Ludo’.

bug#46292: Reopen

[Andreas Enge]

Hello,

I notice the exact same problem still on a Guix System (!) freshly
reconfigured with commit b1cabedd28b92324259875fc52ca5d52d411a026,
so the kernel is 5.11.4-gnu.

In my case /tmp is just an ordinary subdirectory of /, which itself is
LUKS encrypted and mounted from /dev/mapper/cryptroot.

The "permission denied" occurs for ordinary users and root.

Andreas

bug#46292: Reopen

[Andreas Enge]

This has become a duplicate of
   https://issues.guix.gnu.org/47007 ,
closing it again.

Andreas