From 2c071ce96e7e4049be3ae2eb958077566d3b4ea0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 23 Jul 2014 00:44:27 +0200
Subject: system: Recognize more file system flags.

* guix/build/linux-initrd.scm (MS_NOSUID, MS_NODEV, MS_NOEXEC): New
  variables.
  (mount-flags->bit-mask): New procedure.
  (mount-file-system)[flags->bit-mask]: Remove.
  Use 'mount-flags->bit-mask' instead.
  In /etc/mtab, use the empty string when OPTIONS is false.
* gnu/services/base.scm (file-system-service): Add #:flags parameter and
  honor it.
* gnu/system.scm (other-file-system-services): Pass FLAGS to
  'file-system-service'.
---
 guix/build/linux-initrd.scm | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

(limited to 'guix/build')

diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 08df32ad1e..662f7967e3 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -40,6 +40,7 @@
             find-partition-by-label
             canonicalize-device-spec
 
+            mount-flags->bit-mask
             check-file-system
             mount-file-system
             bind-mount
@@ -393,6 +394,9 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
 
 ;; Linux mount flags, from libc's <sys/mount.h>.
 (define MS_RDONLY 1)
+(define MS_NOSUID 2)
+(define MS_NODEV  4)
+(define MS_NOEXEC 8)
 (define MS_BIND 4096)
 (define MS_MOVE 8192)
 
@@ -494,6 +498,24 @@ UNIONFS."
                fsck code device)
        (start-repl)))))
 
+(define (mount-flags->bit-mask flags)
+  "Return the number suitable for the 'flags' argument of 'mount' that
+corresponds to the symbols listed in FLAGS."
+  (let loop ((flags flags))
+    (match flags
+      (('read-only rest ...)
+       (logior MS_RDONLY (loop rest)))
+      (('bind-mount rest ...)
+       (logior MS_BIND (loop rest)))
+      (('no-suid rest ...)
+       (logior MS_NOSUID (loop rest)))
+      (('no-dev rest ...)
+       (logior MS_NODEV (loop rest)))
+      (('no-exec rest ...)
+       (logior MS_NOEXEC (loop rest)))
+      (()
+       0))))
+
 (define* (mount-file-system spec #:key (root "/root"))
   "Mount the file system described by SPEC under ROOT.  SPEC must have the
 form:
@@ -503,15 +525,6 @@ form:
 DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
 FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
 run a file system check."
-  (define flags->bit-mask
-    (match-lambda
-     (('read-only rest ...)
-      (or MS_RDONLY (flags->bit-mask rest)))
-     (('bind-mount rest ...)
-      (or MS_BIND (flags->bit-mask rest)))
-     (()
-      0)))
-
   (match spec
     ((source title mount-point type (flags ...) options check?)
      (let ((source      (canonicalize-device-spec source title))
@@ -519,7 +532,7 @@ run a file system check."
        (when check?
          (check-file-system source type))
        (mkdir-p mount-point)
-       (mount source mount-point type (flags->bit-mask flags)
+       (mount source mount-point type (mount-flags->bit-mask flags)
               (if options
                   (string->pointer options)
                   %null-pointer))
@@ -528,7 +541,7 @@ run a file system check."
        (mkdir-p (string-append root "/etc"))
        (let ((port (open-file (string-append root "/etc/mtab") "a")))
          (format port "~a ~a ~a ~a 0 0~%"
-                 source mount-point type options)
+                 source mount-point type (or options ""))
          (close-port port))))))
 
 (define (switch-root root)
-- 
cgit v1.2.3