TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

build: file-systems: Allow for bind mounting regular files.

Browse source 
* gnu/build/file-systems.scm (regular-file?): New procedure.
  (mount-file-system): Create a regular file instead of a directory when bind
  mounting a regular file.
This commit is contained in:
David Thompson 2015-08-01 13:43:33 -04:00
parent 014cbde612
commit 8c812f2aee
1 changed files with 14 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -323,6 +323,10 @@ (define (mount-flags->bit-mask flags)
(()
0))))
(define (regular-file? file-name)
"Return #t if FILE-NAME is a regular file."
(eq? (stat:type (stat file-name)) 'regular))
(define* (mount-file-system spec #:key (root "/root"))
"Mount the file system described by SPEC under ROOT. SPEC must have the
form:
@ -339,7 +343,16 @@ (define* (mount-file-system spec #:key (root "/root"))
(flags (mount-flags->bit-mask flags)))
(when check?
(check-file-system source type))
(mkdir-p mount-point)
;; Create the mount point. Most of the time this is a directory, but
;; in the case of a bind mount, a regular file may be needed.
(if (and (= MS_BIND (logand flags MS_BIND))
(regular-file? source))
(begin
(mkdir-p (dirname mount-point))
(call-with-output-file mount-point (const #t)))
(mkdir-p mount-point))
(mount source mount-point type flags options)
;; For read-only bind mounts, an extra remount is needed, as per