env: Add environment-mounted?
This commit is contained in:
parent
b00cb803ee
commit
a2ea1192f3
1 changed files with 18 additions and 1 deletions
19
env.scm
19
env.scm
|
@ -1,6 +1,7 @@
|
||||||
(define-module (env)
|
(define-module (env)
|
||||||
#:use-module (gcrypt hash)
|
#:use-module (gcrypt hash)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
|
#:use-module (guix build syscalls)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:use-module (guix hash)
|
#:use-module (guix hash)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
|
@ -38,7 +39,8 @@
|
||||||
remove-env-no-checks!
|
remove-env-no-checks!
|
||||||
roll-back!
|
roll-back!
|
||||||
environment->overlay-mount-maybe
|
environment->overlay-mount-maybe
|
||||||
unmount-environment))
|
unmount-environment
|
||||||
|
environment-mounted?))
|
||||||
|
|
||||||
(define directory-files (@@ (ice-9 ftw) directory-files))
|
(define directory-files (@@ (ice-9 ftw) directory-files))
|
||||||
|
|
||||||
|
@ -439,6 +441,21 @@ by other environments made."
|
||||||
(when (file-exists? tmpdirln)
|
(when (file-exists? tmpdirln)
|
||||||
(delete-file tmpdirln))))
|
(delete-file tmpdirln))))
|
||||||
|
|
||||||
|
(define (fuse-overlayfs-mounts)
|
||||||
|
(filter (λ (m) (equal? "fuse.fuse-overlayfs"
|
||||||
|
(mount-type m) ))
|
||||||
|
(mounts)))
|
||||||
|
|
||||||
|
(define (fuse-overlayfs-mount-points)
|
||||||
|
(map mount-point (fuse-overlayfs-mounts)))
|
||||||
|
|
||||||
|
(define (environment-mounted? env)
|
||||||
|
(if (member (string-append %env-directory
|
||||||
|
"/" (symbol->string (environment-name env)))
|
||||||
|
(fuse-overlayfs-mount-points))
|
||||||
|
#t
|
||||||
|
#f))
|
||||||
|
|
||||||
(define (environment->overlay-mount-maybe env)
|
(define (environment->overlay-mount-maybe env)
|
||||||
(let* ((name (symbol->string (environment-name env)))
|
(let* ((name (symbol->string (environment-name env)))
|
||||||
(dir (readlink (string-append "/tmp/genv/" name))))
|
(dir (readlink (string-append "/tmp/genv/" name))))
|
||||||
|
|
Loading…
Reference in a new issue