file-systems: Allow for bind-mounts of named sockets.
Previously a named socket such as /dev/log would fail the 'regular-file?' test and we'd end up mkdir'ing it. * gnu/build/file-systems.scm (regular-file?): Remove. (mount-file-system): Change (regular-file? source) to (not (file-is-directory? source)).
This commit is contained in:
parent
6ddf4fcfae
commit
bb5cad4eb2
|
@ -565,10 +565,6 @@ (define (mount-flags->bit-mask flags)
|
||||||
(()
|
(()
|
||||||
0))))
|
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"))
|
(define* (mount-file-system spec #:key (root "/root"))
|
||||||
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
||||||
form:
|
form:
|
||||||
|
@ -608,9 +604,9 @@ (define (mount-nfs source mount-point type flags options)
|
||||||
(check-file-system source type))
|
(check-file-system source type))
|
||||||
|
|
||||||
;; Create the mount point. Most of the time this is a directory, but
|
;; 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.
|
;; in the case of a bind mount, a regular file or socket may be needed.
|
||||||
(if (and (= MS_BIND (logand flags MS_BIND))
|
(if (and (= MS_BIND (logand flags MS_BIND))
|
||||||
(regular-file? source))
|
(not (file-is-directory? source)))
|
||||||
(unless (file-exists? mount-point)
|
(unless (file-exists? mount-point)
|
||||||
(mkdir-p (dirname mount-point))
|
(mkdir-p (dirname mount-point))
|
||||||
(call-with-output-file mount-point (const #t)))
|
(call-with-output-file mount-point (const #t)))
|
||||||
|
|
Loading…
Reference in a new issue