From d725a5cda1c87aee19068d15da6510ca2160c841 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= <antonin@tarides.com>
Date: Tue, 8 Dec 2020 15:23:45 +0100
Subject: [PATCH 1/2] Fetch docker root dir from docker info

---
 worker/cluster_worker.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/worker/cluster_worker.ml b/worker/cluster_worker.ml
index d932078d..5350c43d 100644
--- a/worker/cluster_worker.ml
+++ b/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 ()

From b826043d6a61e726f50950e981b4e7dd82f34e66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= <antonin@tarides.com>
Date: Tue, 8 Dec 2020 17:25:07 +0100
Subject: [PATCH 2/2] Use GetDiskFreeSpaceExW on Windows to get available space

---
 worker/GetDiskFreeSpaceExW.c | 55 ++++++++++++++++++++++++++++++++++++
 worker/df.ml                 | 13 ++++++++-
 worker/dune                  |  3 +-
 3 files changed, 69 insertions(+), 2 deletions(-)
 create mode 100644 worker/GetDiskFreeSpaceExW.c

diff --git a/worker/GetDiskFreeSpaceExW.c b/worker/GetDiskFreeSpaceExW.c
new file mode 100644
index 00000000..50b8e685
--- /dev/null
+++ b/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
diff --git a/worker/df.ml b/worker/df.ml
index 83f5a395..1348d8d8 100644
--- a/worker/df.ml
+++ b/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
diff --git a/worker/dune b/worker/dune
index 700f2a95..ee6c6c2d 100644
--- a/worker/dune
+++ b/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)))