davie/guile-env
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

env: unmount-environment -> unmount-environment-maybe: check for lock

Browse source
This commit is contained in:
Davie Li 2024-02-04 19:20:47 +01:00
parent 9d574fcdd1
commit 625ce83c94
Signed by: davie
GPG key ID: 29FD88532FC91BF4
1 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
env.scm
View file

@ -39,7 +39,7 @@
remove-env-no-checks! remove-env-no-checks!
roll-back! roll-back!
environment->overlay-mount-maybe environment->overlay-mount-maybe
unmount-environment unmount-environment-maybe
environment-mounted?)) environment-mounted?))
(define directory-files (@@ (ice-9 ftw) directory-files)) (define directory-files (@@ (ice-9 ftw) directory-files))
@ -431,15 +431,18 @@ by other environments made."
(0 (values (make-overlay-mount layers-links upper work merged) 0)) (0 (values (make-overlay-mount layers-links upper work merged) 0))
(err (values #f err))))))) (err (values #f err)))))))
(define (unmount-environment env) (define (unmount-environment-maybe env)
(let* ((name (symbol->string (environment-name env))) (let* ((name (symbol->string (environment-name env)))
(dir (string-append %env-directory "/" name)) (dir (string-append %env-directory "/" name))
(tmpdirln (string-append "/tmp/genv/" name))) (tmpdirln (string-append "/tmp/genv/" name)))
(when (file-exists? dir) (if (file-exists? (string-append tmpdirln "/lock"))
(system* "umount" dir) #f
(delete-file-recursively dir)) (begin
(when (file-exists? tmpdirln) (when (file-exists? dir)
(delete-file tmpdirln)))) (system* "umount" dir)
(delete-file-recursively dir))
(when (file-exists? tmpdirln)
(delete-file tmpdirln))))))
(define (fuse-overlayfs-mounts) (define (fuse-overlayfs-mounts)
(filter (λ (m) (equal? "fuse.fuse-overlayfs" (filter (λ (m) (equal? "fuse.fuse-overlayfs"