aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-04-20 22:16:13 +0200
committerLudovic Courtès <ludo@gnu.org>2015-04-20 22:16:13 +0200
commitb86fee7848f964da4d5e695dc8027d95d40a1c77 (patch)
treead0c6ef4421da2f5de4fce27170db7a82e8ac74d
parent38cf2ba084881a4c8fca0ee2888b5fd5724e9104 (diff)
downloadguix-b86fee7848f964da4d5e695dc8027d95d40a1c77.tar
guix-b86fee7848f964da4d5e695dc8027d95d40a1c77.tar.gz
file-systems: Use a second 'mount' call for read-only bind mounts.
* gnu/build/file-systems.scm (MS_REMOUNT): New constant. (mount-file-system): Add 'flags' local variable. When FLAGS has MS_BIND & MS_RDONLY, call 'mount' with MS_REMOUNT. * gnu/services/base.scm (file-system-service) <start>: Likewise.
-rw-r--r--gnu/build/file-systems.scm17
-rw-r--r--gnu/services/base.scm17
2 files changed, 26 insertions, 8 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 38e4851515..dc99d60d3d 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -55,6 +55,7 @@
(define MS_NOSUID 2)
(define MS_NODEV 4)
(define MS_NOEXEC 8)
+(define MS_REMOUNT 32)
(define MS_BIND 4096)
(define MS_MOVE 8192)
@@ -280,13 +281,21 @@ run a file system check."
(match spec
((source title mount-point type (flags ...) options check?)
(let ((source (canonicalize-device-spec source title))
- (mount-point (string-append root "/" mount-point)))
+ (mount-point (string-append root "/" mount-point))
+ (flags (mount-flags->bit-mask flags)))
(when check?
(check-file-system source type))
(mkdir-p mount-point)
- (mount source mount-point type (mount-flags->bit-mask flags)
+ (mount source mount-point type flags
(if options
(string->pointer options)
- %null-pointer))))))
+ %null-pointer))
+
+ ;; 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)))
+ (mount source mount-point type (logior MS_BIND MS_REMOUNT MS_RDONLY)
+ %null-pointer))))))
;;; file-systems.scm ends here
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 956fa7efa0..d0a2e8c848 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -131,7 +131,9 @@ names such as device-mapping services."
(requirement `(root-file-system ,@requirements))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
- (let ((device (canonicalize-device-spec #$device '#$title)))
+ ;; FIXME: Use or factorize with 'mount-file-system'.
+ (let ((device (canonicalize-device-spec #$device '#$title))
+ (flags #$(mount-flags->bit-mask flags)))
#$(if create-mount-point?
#~(mkdir-p #$target)
#~#t)
@@ -145,9 +147,16 @@ names such as device-mapping services."
(getenv "PATH")))
(check-file-system device #$type))
#~#t)
- (mount device #$target #$type
- #$(mount-flags->bit-mask flags)
- #$options))
+
+ (mount device #$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)))
+ (mount device #$target #$type
+ (logior MS_BIND MS_REMOUNT MS_RDONLY))))
#t))
(stop #~(lambda args
;; Normally there are no processes left at this point, so