ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

file-systems: 'mount-file-system' preserves source flags for bind mounts.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2021-02-22 17:39:54 +01:00 committed by Ludovic Courtès
parent 7e9d9f28e9
commit dcb640f02b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
gnu/build/file-systems.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@ -909,12 +909,27 @@ (define (mount-nfs source mount-point type flags options)
(if options (if options
(string-append "," options) (string-append "," options)
""))))) "")))))
(let ((type (file-system-type fs)) (let* ((type (file-system-type fs))
(options (file-system-options fs))
(source (canonicalize-device-spec (file-system-device fs))) (source (canonicalize-device-spec (file-system-device fs)))
(mount-point (string-append root "/" (target (string-append root "/"
(file-system-mount-point fs))) (file-system-mount-point fs)))
(flags (mount-flags->bit-mask (file-system-flags 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) (when (file-system-check? fs)
(check-file-system source type)) (check-file-system source type))
@ -925,24 +940,24 @@ (define (mount-nfs source mount-point type flags options)
;; needed. ;; needed.
(if (and (= MS_BIND (logand flags MS_BIND)) (if (and (= MS_BIND (logand flags MS_BIND))
(not (file-is-directory? source))) (not (file-is-directory? source)))
(unless (file-exists? mount-point) (unless (file-exists? target)
(mkdir-p (dirname mount-point)) (mkdir-p (dirname target))
(call-with-output-file mount-point (const #t))) (call-with-output-file target (const #t)))
(mkdir-p mount-point)) (mkdir-p target))
(cond (cond
((string-prefix? "nfs" type) ((string-prefix? "nfs" type)
(mount-nfs source mount-point type flags options)) (mount-nfs source target type flags options))
(else (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 ;; For read-only bind mounts, an extra remount is needed, as per
;; <http://lwn.net/Articles/281157/>, which still applies to Linux ;; <http://lwn.net/Articles/281157/>, which still applies to Linux
;; 4.0. ;; 4.0.
(when (and (= MS_BIND (logand flags MS_BIND)) (when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY))) (= MS_RDONLY (logand flags MS_RDONLY)))
(let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY))) (let ((flags (logior MS_REMOUNT flags)))
(mount source mount-point type flags #f)))) (mount source target type flags options))))
(lambda args (lambda args
(or (file-system-mount-may-fail? fs) (or (file-system-mount-may-fail? fs)
(apply throw args)))))) (apply throw args))))))