Windows get free space

worker/GetDiskFreeSpaceExW.c

@@ -0,0 +1,55 @@
+#define CAML_NAME_SPACE
+#define CAML_INTERNALS
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+
+#if defined(_WIN32)
+
+#include <windef.h>
+#include <fileapi.h>
+
+#include <caml/misc.h>
+#include <caml/osdeps.h>
+#include <caml/fail.h>
+
+CAMLprim value
+stub_GetDiskFreeSpaceExW(value directoryName)
+{
+    CAMLparam1(directoryName);
+    CAMLlocal1(pair);
+    BOOL found = FALSE;
+    ULONGLONG freeBytes = 0ULL, totalNumber = 0ULL;
+    char_os *osDirectoryName =
+        caml_stat_strdup_to_os(String_val(directoryName));
+
+    found = GetDiskFreeSpaceExW(osDirectoryName,
+                                (PULARGE_INTEGER) &freeBytes,
+                                (PULARGE_INTEGER) &totalNumber,
+                                (PULARGE_INTEGER) NULL)
+        && freeBytes <= LLONG_MAX && totalNumber <= LLONG_MAX;
+    caml_stat_free(osDirectoryName);
+
+    if(!found)
+        caml_raise_not_found();
+
+    pair = caml_alloc_small(16, 0);
+    Field(pair, 0) = caml_copy_int64(freeBytes);
+    Field(pair, 1) = caml_copy_int64(totalNumber);
+    CAMLreturn(pair);
+}
+
+#else
+
+CAMLprim value
+stub_GetDiskFreeSpaceExW(value directoryName)
+{
+    CAMLparam1(directoryName);
+    CAMLlocal1(pair);
+    pair = caml_alloc_small(16, 0);
+    Field(pair, 0) = caml_copy_int64(0ULL);
+    Field(pair, 1) = caml_copy_int64(0ULL);
+    CAMLreturn(pair);
+}
+
+#endif

worker/cluster_worker.ml

@@ -159,7 +159,8 @@ let check_docker_partition t =
   match t.prune_threshold with
   | None -> Lwt_result.return ()
   | Some prune_threshold ->
-    Df.free_space_percent "/var/lib/docker" >|= fun free ->
+    Lwt_process.pread_line("", [| "docker"; "info"; "-f"; "{{.DockerRootDir}}" |]) >>= fun line ->
+    Df.free_space_percent (String.trim line) >|= fun free ->
     Log.info (fun f -> f "Docker partition: %.0f%% free" free);
     if free < prune_threshold then Error `Disk_space_low
     else Ok ()

worker/df.ml

@@ -1,6 +1,6 @@
 open Lwt.Infix
 
-let free_space_percent path =
+let free_space_percent_unix path =
   Lwt_process.pread ("", [| "df"; path; "--output=pcent" |]) >|= fun lines ->
   match String.split_on_char '\n' (String.trim lines) with
   | [_; result] ->
@@ -11,3 +11,14 @@ let free_space_percent path =
     100. -. used
   | _ ->
     Fmt.failwith "Expected two lines from df, but got:@,%S" lines
+
+external get_disk_free_space_ex_w: string -> (int64 * int64) = "stub_GetDiskFreeSpaceExW"
+let free_space_percent_win32 path =
+  let free, total = get_disk_free_space_ex_w path in
+  Int64.to_float free /. Int64.to_float total *. 100.0 |> Lwt.return
+
+let free_space_percent path =
+  if Sys.os_type = "Win32" then
+    free_space_percent_win32 path
+  else
+    free_space_percent_unix path

worker/dune

@@ -1,3 +1,4 @@
 (library
  (name cluster_worker)
- (libraries ocluster-api digestif fpath logs capnp-rpc-lwt lwt.unix prometheus-app cohttp-lwt-unix obuilder))
+ (libraries ocluster-api digestif fpath logs capnp-rpc-lwt lwt.unix prometheus-app cohttp-lwt-unix obuilder)
+ (foreign_stubs (language c) (names GetDiskFreeSpaceExW)))