env: Add unmount-environment, environment->overlay-mount-maybe

Restructure /tmp folder. Provide metadata.

env.scm

@@ -36,7 +36,9 @@
             lookup-environment
             mount-environment
             remove-env-no-checks!
-            roll-back!))
+            roll-back!
+            environment->overlay-mount-maybe
+            unmount-environment))
 
 (define directory-files (@@ (ice-9 ftw) directory-files))
 
@@ -392,23 +394,30 @@ by other environments made."
     (when (or (not layers-stack) (null? layers-stack))
       (throw 'no-layers-stack-found))
 
-    (let* ((mkdtemp*
+    (let* ((dir (begin
-            (λ (pfix)
+                  (mkdir-p "/tmp/genv")
-              ;; /tmp/env name is too common
+                  (mkdtemp "/tmp/genv/XXXXXX")))
-              (mkdir-p "/tmp/env")
+           (id  (string-take-right dir 6))
-              (mkdtemp (string-append
-                        "/tmp/env/" (symbol->string name)
-                        "." pfix ".XXXXXX"))))
            (merged (let ((f (or target
                                 (string-append %env-directory
                                                "/" (symbol->string name)))))
                      (if (directory-exists? f) f (begin (mkdir-p f) f))))
-           (upper  (mkdtemp* "upper"))
+           (upper (string-append dir "/upper"))
-           (work   (mkdtemp* "work"))
+           (work  (string-append dir "/work"))
            ;; TODO abstract away
            (layers-links (map (λ (l) (string-take l 7))
                               layers-stack)))
-
+      (mkdir upper)
+      (mkdir work)
+      (let ((dirln (string-append "/tmp/genv/" (symbol->string name))))
+        (when (file-exists? dirln)
+          (delete-file dirln))
+        (symlink dir dirln)
+        (let loop ((links layers-links)
+                   (n 0))
+          (unless (nil? links)
+            (symlink (car links) (string-append dir "/layer" (number->string n)))
+            (loop (cdr links) (1+ n)))))
       (with-directory-excursion %env-links
         ;; TODO report missing links? or global sanity check.
         ;; TODO handle errors
@@ -420,6 +429,30 @@ by other environments made."
           (0 (values (make-overlay-mount layers-links upper work merged) 0))
           (err (values #f err)))))))
 
+(define (unmount-environment env)
+  (let* ((name (symbol->string (environment-name env)))
+         (dir (string-append %env-directory "/" name))
+         (tmpdirln (string-append "/tmp/genv/" name)))
+    (when (file-exists? dir)
+      (system* "umount" dir)
+      (delete-file-recursively dir))
+    (when (file-exists? tmpdirln)
+      (delete-file tmpdirln))))
+
+(define (environment->overlay-mount-maybe env)
+  (let* ((name (symbol->string (environment-name env)))
+         (dir (readlink (string-append "/tmp/genv/" name))))
+    (if (file-exists? dir)
+        (let ((upper (string-append dir "/upper"))
+              (work (string-append dir "/work"))
+              (merged (string-append %env-directory "/" name))
+              (layers-links
+               (map (λ (s) (readlink (string-append dir "/" s)))
+                    (filter (λ (s) (string-prefix? "layer" s))
+                            (directory-files dir)))))
+          (make-overlay-mount layers-links upper work merged))
+        #f)))
+
 (define* (call-with-env env proc #:optional save? clean?)
   (match (mount-environment env)
     (($ <overlay-mount> lower upper work merged)