From 02219431ad8db14eac7c3f33b2eea34f65f7326e Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 13 Jan 2023 12:20:17 +0000 Subject: [PATCH] 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 | 2 +- configure.ac | 2 +- shell/context_flags.ml | 2 +- src/client/opamConfigCommand.ml | 34 +++++++++++++++++++++++++++++-- src/core/opamStubs.dummy.ml | 1 + src/core/opamStubs.mli | 4 ++++ src/stubs/win32/opamWin32Stubs.ml | 1 + src/stubs/win32/opamWindows.c | 25 ++++++++++++++++++++++- 8 files changed, 65 insertions(+), 6 deletions(-) diff --git a/configure b/configure index bfc1e8ba1ad..e6981d57686 100755 --- a/configure +++ b/configure @@ -6088,7 +6088,7 @@ case $TARGET in #( # 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" ;; #( *) : ;; diff --git a/configure.ac b/configure.ac index 2ae3218f623..2b96d1e86f0 100644 --- a/configure.ac +++ b/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}).])], diff --git a/shell/context_flags.ml b/shell/context_flags.ml index 1437c9cd6bd..55e464d0906 100644 --- a/shell/context_flags.ml +++ b/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 "()" | _ -> diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index 5b863c3b374..e6eac729534 100644 --- a/src/client/opamConfigCommand.ml +++ b/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 = diff --git a/src/core/opamStubs.dummy.ml b/src/core/opamStubs.dummy.ml index 34d3924a49c..349016d8fb6 100644 --- a/src/core/opamStubs.dummy.ml +++ b/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 diff --git a/src/core/opamStubs.mli b/src/core/opamStubs.mli index 41303e4f949..8e29d92de2f 100644 --- a/src/core/opamStubs.mli +++ b/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. *) diff --git a/src/stubs/win32/opamWin32Stubs.ml b/src/stubs/win32/opamWin32Stubs.ml index d1d06d7ff18..3fcb44ec126 100644 --- a/src/stubs/win32/opamWin32Stubs.ml +++ b/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" diff --git a/src/stubs/win32/opamWindows.c b/src/stubs/win32/opamWindows.c index 1487bcdcde3..852fb2aa3c7 100644 --- a/src/stubs/win32/opamWindows.c +++ b/src/stubs/win32/opamWindows.c @@ -28,7 +28,7 @@ #include #include #include -#include +#include #include @@ -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); +}