mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
build: file-systems: Allow for bind mounting regular files.
* 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:
parent
014cbde612
commit
8c812f2aee
1 changed files with 14 additions and 1 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue