feat: dune-cache on windows via vhdx

packages/setup-ocaml/src/cache.ts

@@ -11,6 +11,7 @@ import {
   ARCHITECTURE,
   CACHE_PREFIX,
   DUNE_CACHE_ROOT,
+  DUNE_CACHE_VHDX_PATH,
   GITHUB_WORKSPACE,
   OPAM_DISABLE_SANDBOXING,
   OPAM_REPOSITORIES,
@@ -21,6 +22,12 @@ import {
 } from "./constants.js";
 import { latestOpamRelease } from "./opam.js";
 import { resolvedCompiler } from "./version.js";
+import {
+  attachDuneCacheVhdx,
+  colocateBuildDirOnCacheVolume,
+  createDuneCacheVhdx,
+  detachDuneCacheVhdx,
+} from "./vhdx.js";
 
 async function composeDuneCacheKeys() {
   const { workflow, job, runId } = github.context;
@@ -79,6 +86,10 @@ async function composeOpamCacheKeys() {
 }
 
 function composeDuneCachePaths() {
+  // On Windows we cache the single VHDX image, not the unpacked cache tree.
+  if (PLATFORM === "windows") {
+    return [DUNE_CACHE_VHDX_PATH];
+  }
   return [DUNE_CACHE_ROOT];
 }
 
@@ -165,6 +176,16 @@ export async function restoreDuneCache() {
     const { key, restoreKeys } = await composeDuneCacheKeys();
     const paths = composeDuneCachePaths();
     const cacheKey = await restoreCache(key, restoreKeys, paths);
+    if (PLATFORM === "windows") {
+      // The cache holds a single VHDX image. Make its contents available by
+      // attaching the restored image, or by creating a fresh one on a miss.
+      if (cacheKey) {
+        await attachDuneCacheVhdx();
+      } else {
+        await createDuneCacheVhdx();
+      }
+      await colocateBuildDirOnCacheVolume();
+    }
     return cacheKey;
   });
 }
@@ -181,6 +202,10 @@ export async function saveDuneCache() {
   await core.group("Saving dune cache", async () => {
     const { key } = await composeDuneCacheKeys();
     const paths = composeDuneCachePaths();
+    if (PLATFORM === "windows") {
+      // Detach so the image file is flushed and unlocked before it is cached.
+      await detachDuneCacheVhdx();
+    }
     await saveCache(key, paths);
   });
 }

packages/setup-ocaml/src/constants.ts

@@ -108,17 +108,23 @@ export const CYGWIN_ROOT_BIN = path.join(CYGWIN_ROOT, "bin");
 
 export const CYGWIN_BASH_ENV = path.join(CYGWIN_ROOT, "bash_env");
 
+export const DUNE_CACHE_VHDX_DRIVE_LETTER = "X";
+
 export const DUNE_CACHE_ROOT = (() => {
   const xdgCacheHome = process.env.XDG_CACHE_HOME;
   if (xdgCacheHome) {
     return path.join(xdgCacheHome, "dune");
   }
   if (PLATFORM === "windows") {
-    return path.join("C:", "dune");
+    return path.join(`${DUNE_CACHE_VHDX_DRIVE_LETTER}:\\`, "dune");
   }
   return path.join(os.homedir(), ".cache", "dune");
 })();
 
+export const DUNE_CACHE_VHDX_PATH = path.join("C:", "dune-cache.vhdx");
+
+export const DUNE_CACHE_VHDX_MAX_SIZE_MB = 12_288;
+
 // ── Action Inputs ──
 
 export const OCAML_COMPILER = core.getInput("ocaml-compiler", {

packages/setup-ocaml/src/installer.ts

@@ -91,7 +91,10 @@ export async function installer() {
     await installDune();
     core.exportVariable("DUNE_CACHE_ROOT", DUNE_CACHE_ROOT);
     core.exportVariable("DUNE_CACHE", "enabled");
-    core.exportVariable("DUNE_CACHE_STORAGE_MODE", "copy");
+    // On Windows the cache lives on its own VHDX volume, with the build dir
+    // junctioned onto the same volume (see restoreDuneCache), so hardlink mode
+    // works and avoids copy mode's "rmdir: Directory not empty" failures.
+    core.exportVariable("DUNE_CACHE_STORAGE_MODE", PLATFORM === "windows" ? "hardlink" : "copy");
   }
   core.exportVariable("CLICOLOR_FORCE", "1");
   if (OPAM_PIN) {

packages/setup-ocaml/src/vhdx.ts

@@ -0,0 +1,126 @@
+// Windows dune cache backed by a virtual disk image (VHDX).
+//
+// On Windows the dune cache is a tree of hundreds of thousands of tiny
+// content-addressed files. Saving/restoring it as a tar archive via
+// `@actions/cache` is dominated by NTFS per-file metadata cost, so the restore
+// can take tens of minutes. Instead we keep the whole cache inside a single
+// dynamically-sized VHDX and cache that one file: "restore" becomes attaching
+// the image and "save" becomes detaching it, both O(1) in the number of files
+// the image contains.
+//
+// We drive everything through `diskpart`, which ships with every Windows
+// install — unlike the `Hyper-V` PowerShell module (`New-VHD`/`Mount-VHD`),
+// which is not guaranteed to be present on CI runners.
+
+import { promises as fs } from "node:fs";
+import * as os from "node:os";
+import * as path from "node:path";
+import * as core from "@actions/core";
+import { exec } from "@actions/exec";
+import {
+  DUNE_CACHE_ROOT,
+  DUNE_CACHE_VHDX_DRIVE_LETTER,
+  DUNE_CACHE_VHDX_MAX_SIZE_MB,
+  DUNE_CACHE_VHDX_PATH,
+  GITHUB_WORKSPACE,
+} from "./constants.js";
+
+// Run a diskpart script. diskpart reads its commands from a file (`/s`), so we
+// stage the script in a temp file and clean it up afterwards.
+async function runDiskpart(commands: string[]) {
+  const scriptPath = path.join(os.tmpdir(), `setup-ocaml-dune-vhdx-${process.pid}.txt`);
+  await fs.writeFile(scriptPath, `${commands.join("\n")}\n`);
+  try {
+    await exec("diskpart", ["/s", scriptPath]);
+  } finally {
+    await fs.rm(scriptPath, { force: true });
+  }
+}
+
+// Best-effort: stop Windows Defender from holding transient handles on files
+// dune writes into the cache. When real-time scanning has a just-written file
+// open, Windows marks it delete-pending but leaves the directory entry, so
+// dune's copy-mode store fails cleaning up its staging dir with
+// "rmdir: Directory not empty". Excluding the cache volume avoids the scan.
+// Also reports Defender status so we can tell whether it is active at all.
+async function hardenCacheVolumeAgainstHandleHolders() {
+  const driveRoot = `${DUNE_CACHE_VHDX_DRIVE_LETTER}:\\`;
+  const scriptPath = path.join(os.tmpdir(), `setup-ocaml-dune-vhdx-${process.pid}.ps1`);
+  await fs.writeFile(
+    scriptPath,
+    [
+      "try { Get-MpComputerStatus | Select-Object RealTimeProtectionEnabled, IsTamperProtected | Format-List }",
+      'catch { Write-Host "Defender status unavailable: $($_.Exception.Message)" }',
+      `Add-MpPreference -ExclusionPath '${driveRoot}' -ErrorAction SilentlyContinue`,
+    ].join("\n"),
+  );
+  try {
+    await exec("powershell", ["-NoProfile", "-ExecutionPolicy", "Bypass", "-File", scriptPath]);
+  } catch (error) {
+    if (error instanceof Error) {
+      core.warning(`Failed to exclude dune cache volume from Defender: ${error.message}`);
+    }
+  } finally {
+    await fs.rm(scriptPath, { force: true });
+  }
+}
+
+// Create a fresh, empty dune cache image and mount it at the drive letter.
+// Used on a cache miss (no image was restored). The image is `expandable`, so
+// the on-disk file only grows to the space actually used, up to the maximum.
+export async function createDuneCacheVhdx() {
+  await runDiskpart([
+    `create vdisk file="${DUNE_CACHE_VHDX_PATH}" maximum=${DUNE_CACHE_VHDX_MAX_SIZE_MB} type=expandable`,
+    `select vdisk file="${DUNE_CACHE_VHDX_PATH}"`,
+    "attach vdisk",
+    "create partition primary",
+    'format fs=ntfs quick label="dune"',
+    `assign letter=${DUNE_CACHE_VHDX_DRIVE_LETTER}`,
+  ]);
+  await fs.mkdir(DUNE_CACHE_ROOT, { recursive: true });
+  await hardenCacheVolumeAgainstHandleHolders();
+}
+
+// Attach a previously-cached dune cache image and mount it at the drive letter.
+// Used on a cache hit (the .vhdx file was restored to disk).
+export async function attachDuneCacheVhdx() {
+  await runDiskpart([
+    `select vdisk file="${DUNE_CACHE_VHDX_PATH}"`,
+    "attach vdisk",
+    // The image already contains a formatted partition; just re-establish the
+    // drive letter (assignments are not persisted across runners).
+    "select partition 1",
+    `assign letter=${DUNE_CACHE_VHDX_DRIVE_LETTER}`,
+  ]);
+  await fs.mkdir(DUNE_CACHE_ROOT, { recursive: true });
+  await hardenCacheVolumeAgainstHandleHolders();
+}
+
+// Put the dune build dir on the same volume as the cache so dune can use
+// `hardlink` storage mode (hardlinks cannot cross volumes). We junction the
+// workspace `_build` onto the cache volume rather than relocating it, so the
+// consumer's relative `_build/...` paths keep resolving. `_build` therefore
+// also lives in the image and is persisted across runs, which only helps
+// incremental builds.
+export async function colocateBuildDirOnCacheVolume() {
+  const cacheVolumeBuildDir = path.join(`${DUNE_CACHE_VHDX_DRIVE_LETTER}:\\`, "_build");
+  const workspaceBuildDir = path.join(GITHUB_WORKSPACE, "_build");
+  await fs.mkdir(cacheVolumeBuildDir, { recursive: true });
+  // A fresh checkout has no `_build` yet; remove any stale one so the junction
+  // can be created.
+  await fs.rm(workspaceBuildDir, { recursive: true, force: true });
+  await exec("cmd", ["/c", "mklink", "/J", workspaceBuildDir, cacheVolumeBuildDir]);
+}
+
+// Detach the image so the .vhdx file is flushed, consistent, and unlocked
+// before it is handed to `@actions/cache`. Best-effort: a failure here must not
+// prevent the (still-valid) image file from being saved.
+export async function detachDuneCacheVhdx() {
+  try {
+    await runDiskpart([`select vdisk file="${DUNE_CACHE_VHDX_PATH}"`, "detach vdisk"]);
+  } catch (error) {
+    if (error instanceof Error) {
+      core.warning(`Failed to detach dune cache VHDX before saving: ${error.message}`);
+    }
+  }
+}