bug#47007: dcb640f02b broke guix environment --container

["Ludovic Courtès" <ludo@gnu.org>]

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

Here’s a more sensible patch for you to try.  This time it should
correctly determine the necessary mount flags based on statfs(2) info.

Could you apply it and report back?

TIA!

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4431 bytes --]

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index aca4aad848..304805db62 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -920,14 +920,8 @@ corresponds to the symbols listed in FLAGS."
                           ;; 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)
+                              (statfs-flags->mount-flags
+                               (file-system-mount-flags (statfs source)))
                               0)))
          (options (file-system-options fs)))
     (when (file-system-check? fs)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 552343a481..6ed11a0d69 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -82,6 +82,21 @@
             file-system-fragment-size
             file-system-mount-flags
             statfs
+
+            ST_RDONLY
+            ST_NOSUID
+            ST_NODEV
+            ST_NOEXEC
+            ST_SYNCHRONOUS
+            ST_MANDLOCK
+            ST_WRITE
+            ST_APPEND
+            ST_IMMUTABLE
+            ST_NOATIME
+            ST_NODIRATIME
+            ST_RELATIME
+            statfs-flags->mount-flags
+
             free-disk-space
             device-in-use?
             add-to-entropy-count
@@ -754,6 +769,56 @@ fdatasync(2) on the underlying file descriptor."
 (define-syntax fsword                             ;fsword_t
   (identifier-syntax long))
 
+(define linux? (string-contains %host-type "linux-gnu"))
+
+(define-syntax define-statfs-flags
+  (syntax-rules (linux hurd)
+    "Define the statfs mount flags."
+    ((_ (name (linux linux-value) (hurd hurd-value)) rest ...)
+     (begin
+       (define name
+         (if linux? linux-value hurd-value))
+       (define-statfs-flags rest ...)))
+    ((_ (name value) rest ...)
+     (begin
+       (define name value)
+       (define-statfs-flags rest ...)))
+    ((_) #t)))
+
+(define-statfs-flags                              ;<bits/statfs.h>
+  (ST_RDONLY      1)
+  (ST_NOSUID      2)
+  (ST_NODEV       (linux 4) (hurd 0))
+  (ST_NOEXEC      8)
+  (ST_SYNCHRONOUS 16)
+  (ST_MANDLOCK    (linux 64) (hurd 0))
+  (ST_WRITE       (linux 128) (hurd 0))
+  (ST_APPEND      (linux 256) (hurd 0))
+  (ST_IMMUTABLE   (linux 512) (hurd 0))
+  (ST_NOATIME     (linux 1024) (hurd 32))
+  (ST_NODIRATIME  (linux 2048) (hurd 0))
+  (ST_RELATIME    (linux 4096) (hurd 64)))
+
+(define (statfs-flags->mount-flags flags)
+  "Convert FLAGS, a logical or of ST_* constants as returned by
+'file-system-mount-flags', to the corresponding logical or of MS_* constants."
+  (letrec-syntax ((match-flags (syntax-rules (=>)
+                                 ((_ (statfs => mount) rest ...)
+                                  (logior (if (zero? (logand flags statfs))
+                                              0
+                                              mount)
+                                          (match-flags rest ...)))
+                                 ((_)
+                                  0))))
+    (match-flags
+     (ST_RDONLY     => MS_RDONLY)
+     (ST_NOSUID     => MS_NOSUID)
+     (ST_NODEV      => MS_NODEV)
+     (ST_NOEXEC     => MS_NOEXEC)
+     (ST_NOATIME    => MS_NOATIME)
+     (ST_NODIRATIME => 0)                         ;FIXME
+     (ST_RELATIME   => MS_RELATIME))))
+
 (define-c-struct %statfs                          ;<bits/statfs.h>
   sizeof-statfs                                   ;slightly overestimated
   file-system
@@ -769,7 +834,7 @@ fdatasync(2) on the underlying file descriptor."
   (identifier       (array int 2))
   (name-length      fsword)
   (fragment-size    fsword)
-  (mount-flags      fsword)
+  (mount-flags      fsword)                       ;ST_*
   (spare            (array fsword 4)))
 
 (define statfs