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

[Ludovic Courtès]

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

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))))))