WIP: clean-up old last-env files based on uptime

On Windows, files older than the system uptime are automatically pruned.
On Unix, the original solution was using /tmp, but we could bind
something similar...

configure.ac

@@ -350,7 +350,7 @@ AS_CASE([$TARGET],
     # NOTE: On Windows, the Windows specific dlls should stay dynamic for security reasons
     # NOTE: -l:libstdc++.a is necessary (vs. -lstdc++) as flexlink will use libstdc++.dll.a
     # which still depends on the DLL at runtime instead of libstdc++.a (that looks like a bug in flexlink)
-    platform_dependant_stuff="-cclib -lopam_stubs_win32_stubs -cclib -l:libstdc++.a -cclib -l:libpthread.a -cclib -Wl,-static -cclib -ladvapi32 -cclib -lgdi32 -cclib -luser32 -cclib -lshell32 -cclib -lole32 -cclib -luuid"
+    platform_dependant_stuff="-cclib -lopam_stubs_win32_stubs -cclib -l:libstdc++.a -cclib -l:libpthread.a -cclib -Wl,-static -cclib -ladvapi32 -cclib -lgdi32 -cclib -luser32 -cclib -lshell32 -cclib -lole32 -cclib -luuid -cclib -lpdh"
   ])
 AS_CASE([${support_static},${enable_static}],
   [no,yes],[AC_MSG_ERROR([--enable-static is not available on this platform (${TARGET}).])],

shell/context_flags.ml

@@ -15,7 +15,7 @@ match Sys.argv.(1) with
       print_string "i686"
 | "clibs" ->
     if Sys.win32 then
-      print_string "(-ladvapi32 -lgdi32 -luser32 -lshell32 -lole32 -luuid)"
+      print_string "(-ladvapi32 -lgdi32 -luser32 -lshell32 -lole32 -luuid -lpdh)"
     else
       print_string "()"
 | _ ->

src/client/opamConfigCommand.ml

@@ -256,10 +256,38 @@ let load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path
        gt switch env_file)
   else upd
 
+(* Posix specifies that processes should not rely on the persistence of files in
+   /tmp between invocations; in practice we can assume that they'll persist
+   until a restart. Windows does not prune its temporary directory, so some
+   garbage collection is needed. *)
+let prune_last_env_files temp_dir =
+  try
+    let files = Sys.readdir temp_dir in
+    let stamp =
+      let uptime = OpamStubs.uptime () in
+      if uptime < 1.0 then
+        (* Uptime isn't available available *)
+        raise Exit
+      else
+        (* Prune files older than 24 hours before the system started *)
+        Unix.time () -. uptime -. 86400.
+    in
+    let check file =
+      if OpamStd.String.starts_with ~prefix:"env-" file then
+        let file = Filename.concat temp_dir file in
+        try
+          let {Unix.st_mtime; _} = Unix.stat file in
+          if st_mtime < stamp then
+            Sys.remove file
+        with e -> OpamStd.Exn.fatal e
+    in
+    Array.iter check files
+  with e -> OpamStd.Exn.fatal e
+
 (* Returns [Some file] where [file] contains [updates]. [hash] should be
    [OpamEnv.hash_env_updates updates] and [n] should initially be [0]. If for
    whatever reason the file cannot be created, returns [None]. *)
-let  write_last_env_file gt updates =
+let write_last_env_file gt updates =
   let updates = check_writeable updates in
   let temp_dir = OpamPath.last_env gt.root in
   let hash = OpamEnv.hash_env_updates updates in
@@ -288,7 +316,9 @@ let  write_last_env_file gt updates =
       aux n
     with e -> OpamStd.Exn.fatal e; None
   in
-  aux 0
+  let result = aux 0 in
+  prune_last_env_files (OpamFilename.Dir.to_string temp_dir);
+  result
 
 let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false)
     ?(force_path=true) gt switch =

src/core/opamStubs.dummy.ml

@@ -42,3 +42,4 @@ let getConsoleWindowClass = that's_a_no_no
 let setErrorMode = that's_a_no_no
 let getErrorMode = that's_a_no_no
 let setConsoleToUTF8 = that's_a_no_no
+let uptime () = 0.0

src/core/opamStubs.mli

@@ -145,3 +145,7 @@ val getErrorMode : unit -> int
 
 val setConsoleToUTF8 : unit -> unit
 (** Windows only. Directly wraps SetConsoleOutputCP(CP_UTF8). *)
+
+val uptime : unit -> float
+(** Returns the number of seconds the system has been running on, or [0.0] if
+    this cannot be determined. *)

src/stubs/win32/opamWin32Stubs.ml

@@ -40,3 +40,4 @@ external getConsoleWindowClass : unit -> string option = "OPAMW_GetConsoleWindow
 external setErrorMode : int -> int = "OPAMW_SetErrorMode"
 external getErrorMode : unit -> int = "OPAMW_GetErrorMode"
 external setConsoleToUTF8 : unit -> unit = "OPAMW_SetConsoleToUTF8"
+external uptime : unit -> float = "OPAMW_uptime"

src/stubs/win32/opamWindows.c

@@ -28,7 +28,7 @@
 #include <TlHelp32.h>
 #include <Knownfolders.h>
 #include <Objbase.h>
-#include <WinCon.h>
+#include <pdh.h>
 
 #include <stdio.h>
 
@@ -804,3 +804,26 @@ CAMLprim value OPAMW_SetConsoleToUTF8(value _unit) {
   SetConsoleOutputCP(CP_UTF8);
   return Val_unit;
 }
+
+CAMLprim value OPAMW_uptime(void)
+{
+  HQUERY hQuery;
+  HCOUNTER counter;
+  PDH_FMT_COUNTERVALUE uptime;
+
+  if (PdhOpenQuery(NULL, 0, &hQuery) != ERROR_SUCCESS)
+    return caml_copy_double(0.0);
+
+  if (PdhAddCounter(hQuery, L"\\\\.\\System\\System Up Time",
+                    0, &counter) != ERROR_SUCCESS ||
+      PdhCollectQueryData(hQuery) != ERROR_SUCCESS ||
+      PdhGetFormattedCounterValue(counter, PDH_FMT_LARGE,
+                                  NULL, &uptime) != ERROR_SUCCESS) {
+    PdhCloseQuery(hQuery);
+    return caml_copy_double(0.0);
+  }
+
+  PdhCloseQuery(hQuery);
+
+  return caml_copy_double(uptime.largeValue);
+}