diff --git a/example.spec b/example.spec
index 328ff144..de4384ff 100644
--- a/example.spec
+++ b/example.spec
@@ -7,11 +7,11 @@
 ; The result can then be found in /tank/HASH/rootfs/ (where HASH is displayed at the end of the build).
 
 ((build dev
-	((from ocaml/opam@sha256:02f01da51f1ed2ae4191f143a46a508e2a34652c11ad2715e2bbe8e0d36fc30d)
+	((from ocaml/opam:debian)
 	 (workdir /src)
 	 (user (uid 1000) (gid 1000))                           ; Build as the "opam" user
 	 (run (shell "sudo chown opam /src"))
-	 (env OPAM_HASH "8187cd8d3681d53f5042b5da316fa3f5e005a247")
+	 (env OPAM_HASH "fb593fd72351e22b3778cfd880158a3c4542aa3f")
 	 (run
 	  (network host)
 	  (shell "sudo apt-get --allow-releaseinfo-change update"))
diff --git a/example.windows.hcs.spec b/example.windows.hcs.spec
new file mode 100644
index 00000000..f7fe01bf
--- /dev/null
+++ b/example.windows.hcs.spec
@@ -0,0 +1,25 @@
+; This script builds OBuilder itself using the HCS backend on Windows.
+;
+; Run it from the top-level of the OBuilder source tree, e.g.
+;
+;   obuilder build -f example.windows.hcs.spec . --store=hcs:C:\obuilder
+;
+
+((from ocaml/opam:windows-server-msvc-ltsc2025-ocaml-5.4)
+ (workdir "C:/src")
+ ; Copy just the opam files first (helps caching)
+ (copy (src obuilder-spec.opam obuilder.opam) (dst ./))
+ ; Create a dummy dune-project so dune subst works for pinned dev packages
+ (run (shell "echo (lang dune 3.0)> dune-project"))
+ (run (shell "opam pin add -yn ."))
+ ; Install OCaml dependencies
+ (run
+  (network host)
+  (shell "opam install --deps-only -t obuilder"))
+ ; Copy the rest of the source code
+ (copy
+  (src .)
+  (dst "C:/src/")
+  (exclude .git _build _opam))
+ ; Build and test
+ (run (shell "opam exec -- dune build @install @runtest")))
diff --git a/lib/build.ml b/lib/build.ml
index b8a0b8fd..97248217 100644
--- a/lib/build.ml
+++ b/lib/build.ml
@@ -9,8 +9,18 @@ let hostname = "builder"
 
 let healthcheck_base () =
   if Sys.win32 then
-    Docker_sandbox.servercore () >>= fun (`Docker_image servercore) ->
-    Lwt.return servercore
+    let keyname = {|HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion|} in
+    let valuename = "CurrentBuild" in
+    Os.pread ["reg"; "query"; keyname; "/v"; valuename] >>= fun value ->
+    let line = String.(value |> trim |> split_on_char '\n') |> Fun.flip List.nth 1 in
+    Scanf.sscanf line " CurrentBuild REG_SZ %i" @@ fun version ->
+    let tag = match version with
+      | 17763 -> "ltsc2019"
+      | 20348 -> "ltsc2022"
+      | 26100 -> "ltsc2025"
+      | _ -> "ltsc2025"
+    in
+    Lwt.return ("mcr.microsoft.com/windows/nanoserver:" ^ tag)
   else Lwt.return "busybox"
 
 let healthcheck_ops =
@@ -149,11 +159,12 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
       Store.build t.store ?switch ~base ~id ~log (fun ~cancelled ~log result_tmp ->
           let argv = Sandbox.tar t.sandbox in
           let config = Config.v
-              ~cwd:"/"
+              ~cwd:(if Sys.win32 then "C:/" else "/")
               ~argv
               ~hostname
               ~user:Obuilder_spec.root
-              ~env:["PATH", "/bin:/usr/bin"]
+              ~env:(if Sys.win32 then ["PATH", {|C:\Windows\System32;C:\Windows|}]
+                    else ["PATH", "/bin:/usr/bin"])
               ~mount_secrets:[]
               ~mounts:[]
               ~network:[]
@@ -183,9 +194,18 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
     Fmt.pf f "@[<v2>%s: %a@]" context.workdir Obuilder_spec.pp_op op
 
   let update_workdir ~(context:Context.t) path =
+    let is_absolute =
+      Astring.String.is_prefix ~affix:"/" path ||
+      (* Windows absolute paths: C:\ or C:/ *)
+      (String.length path >= 3 &&
+       Char.uppercase_ascii path.[0] >= 'A' &&
+       Char.uppercase_ascii path.[0] <= 'Z' &&
+       path.[1] = ':' &&
+       (path.[2] = '/' || path.[2] = '\\'))
+    in
     let workdir =
-      if Astring.String.is_prefix ~affix:"/" path then path
-      else context.workdir ^ "/" ^ path
+      if is_absolute then path
+      else context.workdir // path
     in
     { context with workdir }
 
@@ -236,7 +256,8 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
     Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp ->
         Log.info (fun f -> f "Base image not present; importing %S…" base);
         let rootfs = tmp / "rootfs" in
-        Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () ->
+        (if Sys.win32 then (Os.ensure_dir rootfs; Lwt.return_unit)
+         else Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs]) >>= fun () ->
         Fetch.fetch ~log ~root ~rootfs base >>= fun env ->
         Os.write_file ~path:(tmp / "env")
           (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () ->
@@ -293,19 +314,12 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
     | `Output -> Buffer.add_string buffer x
 
   let healthcheck ?(timeout=300.0) t =
-    Os.with_pipe_from_child (fun ~r ~w ->
-        let result = Docker.Cmd.version ~stderr:(`FD_move_safely w) () in
-        let r = Lwt_io.(of_fd ~mode:input) r ~close:Lwt.return in
-        Lwt_io.read r >>= fun err ->
-        result >>= function
-        | Ok _desc -> Lwt_result.return ()
-        | Error (`Msg m) -> Lwt_result.fail (`Msg (Fmt.str "%s@.%s" m (String.trim err)))
-      ) >>!= fun () ->
     let buffer = Buffer.create 1024 in
     let log = log_to buffer in
     (* Get the base image first, before starting the timer. *)
     let switch = Lwt_switch.create () in
-    let context = Context.v ~shell:(Sandbox.shell t.sandbox) ~switch ~log ~src_dir:"/tmp" () in
+    let src_dir = if Sys.win32 then {|C:\TEMP|} else "/tmp" in
+    let context = Context.v ~shell:(Sandbox.shell t.sandbox) ~switch ~log ~src_dir () in
     healthcheck_base () >>= function healthcheck_base ->
     get_base t ~log healthcheck_base >>= function
     | Error (`Msg _) as x -> Lwt.return x
diff --git a/lib/build_log.ml b/lib/build_log.ml
index 7eb7abba..34df37fd 100644
--- a/lib/build_log.ml
+++ b/lib/build_log.ml
@@ -78,7 +78,7 @@ let create path =
 
 let finish t =
   match t.state with
-  | `Finished -> invalid_arg "Log is already finished!"
+  | `Finished -> Lwt.return_unit
   | `Open (fd, cond) ->
     t.state <- `Finished;
     Lwt_unix.close fd >|= fun () ->
diff --git a/lib/db_store.ml b/lib/db_store.ml
index a2be43b5..1b7c95a5 100644
--- a/lib/db_store.ml
+++ b/lib/db_store.ml
@@ -67,7 +67,8 @@ module Make (Raw : S.STORE) = struct
           if Sys.file_exists log_file then Unix.unlink log_file;
           Build_log.create log_file >>= fun log ->
           Lwt.wakeup set_log log;
-          fn ~cancelled ~log dir
+          fn ~cancelled ~log dir >>= fun r ->
+          Build_log.finish log >|= fun () -> r
         )
       >>!= fun () ->
       let now = Unix.(gmtime (gettimeofday () )) in
diff --git a/lib/docker_sandbox.ml b/lib/docker_sandbox.ml
index b6874503..6d280b8d 100644
--- a/lib/docker_sandbox.ml
+++ b/lib/docker_sandbox.ml
@@ -355,7 +355,8 @@ let servercore =
       | 18363 -> "1909"
       | 19041 -> "2004"
       | 19042 -> "20H2"
-      | _ -> "ltsc2022"
+      | 20348 -> "ltsc2022"
+      | _ -> "ltsc2025"
     in
     let img' = "mcr.microsoft.com/windows/servercore:" ^ version' in
     Log.info (fun f -> f "Windows host is build %i, will use tag %s." version img');
diff --git a/lib/hcs.ml b/lib/hcs.ml
new file mode 100644
index 00000000..9ffc4543
--- /dev/null
+++ b/lib/hcs.ml
@@ -0,0 +1,47 @@
+open Sexplib.Conv
+
+let ( / ) = Filename.concat
+
+type layerinfo = {
+  snapshot_key : string;
+  source : string;
+  parent_layer_paths : string list;
+} [@@deriving sexp]
+
+let layerinfo_path dir = dir / "layerinfo"
+
+let write_layerinfo ~dir li =
+  Os.write_file ~path:(layerinfo_path dir)
+    (Sexplib.Sexp.to_string_hum (sexp_of_layerinfo li) ^ "\n")
+
+let read_layerinfo dir =
+  layerinfo_of_sexp (Sexplib.Sexp.load_sexp (layerinfo_path dir))
+
+(* Parse the JSON output of `ctr snapshot prepare --mounts`.
+   Format:
+   [{"Type":"windows-layer","Source":"C:\\...\\snapshots\\N","Target":"",
+     "Options":["rw","parentLayerPaths=[\"C:\\\\...\\\\snapshots\\\\M\"]"]}]
+   Returns (source_path, parent_layer_paths). *)
+let parse_mount_json output =
+  try
+    let json = Yojson.Safe.from_string (String.trim output) in
+    let open Yojson.Safe.Util in
+    match to_list json with
+    | [] -> ("", [])
+    | mount :: _ ->
+      let source = mount |> member "Source" |> to_string in
+      let options = mount |> member "Options" |> to_list |> List.map to_string in
+      let parents =
+        List.find_map (fun opt ->
+          match Astring.String.cut ~sep:"parentLayerPaths=" opt with
+          | Some (_, json_str) ->
+            (try
+               let arr = Yojson.Safe.from_string json_str in
+               Some (to_list arr |> List.map to_string)
+             with _ -> None)
+          | None -> None
+        ) options
+        |> Option.value ~default:[]
+      in
+      (source, parents)
+  with _ -> ("", [])
diff --git a/lib/hcs_fetch.ml b/lib/hcs_fetch.ml
new file mode 100644
index 00000000..b3e8b6f2
--- /dev/null
+++ b/lib/hcs_fetch.ml
@@ -0,0 +1,173 @@
+open Lwt.Infix
+
+let ( / ) = Filename.concat
+
+let ctr_exec args =
+  let pp f = Os.pp_cmd f ("", "ctr" :: args) in
+  Os.exec_result ~pp ("ctr" :: args)
+
+let ctr_pread args =
+  if Sys.win32 then
+    Os.win32_pread ("ctr" :: args)
+  else
+    let pp f = Os.pp_cmd f ("", "ctr" :: args) in
+    Os.pread_result ~pp ("ctr" :: args)
+
+(* Parse the config digest from `ctr images inspect` tree output.
+   Look for lines like: "application/vnd.docker.container.image.v1+json @sha256:..." *)
+let parse_config_digest output =
+  let lines = String.split_on_char '\n' output in
+  List.find_map (fun line ->
+    if Astring.String.is_infix ~affix:"container.image.v1+json" line then
+      match Astring.String.cut ~sep:"@" line with
+      | Some (_, digest) ->
+        let digest = String.trim digest in
+        (* Extract just the digest, removing any trailing info like "(123 bytes)" *)
+        (match Astring.String.cut ~sep:" " digest with
+         | Some (d, _) -> Some d
+         | None -> Some digest)
+      | None -> None
+    else None
+  ) lines
+
+let parse_env_from_config output =
+  try
+    let json = Yojson.Safe.from_string output in
+    let open Yojson.Safe.Util in
+    let config = json |> member "config" in
+    let env_list = config |> member "Env" |> to_list |> List.map to_string in
+    List.filter_map (fun s ->
+      match String.index_opt s '=' with
+      | Some i ->
+        let key = String.sub s 0 i in
+        let value = String.sub s (i + 1) (String.length s - i - 1) in
+        Some (key, value)
+      | None -> None
+    ) env_list
+  with _ -> []
+
+
+(* Parse the chain ID from `ctr images pull --print-chainid --local` output.
+   The output contains a line like: "image chain ID: sha256:abc123..." *)
+let parse_chain_id output =
+  let lines = String.split_on_char '\n' output in
+  List.find_map (fun line ->
+    match Astring.String.cut ~sep:"image chain ID: " line with
+    | Some (_, chain_id) -> Some (String.trim chain_id)
+    | None -> None
+  ) lines
+
+(* Normalize image reference for containerd.
+   Docker Hub images need docker.io/ prefix:
+   - "ubuntu:latest" -> "docker.io/library/ubuntu:latest"
+   - "ocaml/opam:tag" -> "docker.io/ocaml/opam:tag"
+   - "mcr.microsoft.com/..." -> unchanged (already has registry)
+   - "docker.io/..." -> unchanged *)
+let normalize_image_ref image =
+  if String.contains image '/' then
+    (* Has a slash - check if it starts with a registry *)
+    let first_part =
+      match String.index_opt image '/' with
+      | Some i -> String.sub image 0 i
+      | None -> image
+    in
+    (* If first part contains a dot or colon, it's a registry *)
+    if String.contains first_part '.' || String.contains first_part ':' then
+      image  (* Already has registry prefix *)
+    else
+      "docker.io/" ^ image  (* Docker Hub user/repo format *)
+  else
+    (* No slash - it's a Docker Hub library image *)
+    "docker.io/library/" ^ image
+
+let fetch ~log:(_log : Build_log.t) ~root:(_root : string) ~rootfs base : Config.env Lwt.t =
+  let image = normalize_image_ref base in
+  let hash = Sha256.to_hex (Sha256.string base) in
+  let key = "obuilder-base-" ^ hash in
+  (* Pull the image — on Windows containerd, pull also unpacks layers *)
+  Log.info (fun f -> f "HCS fetch: pulling image %s (from %s)" image base);
+  let platform = ["--platform"; "windows/amd64"] in
+  (ctr_exec (["images"; "pull"] @ platform @ [image]) >>= function
+   | Ok () -> Log.info (fun f -> f "HCS fetch: pull succeeded"); Lwt.return_unit
+   | Error (`Msg m) -> Fmt.failwith "Failed to pull image %s: %s" image m)
+  >>= fun () ->
+  (* Get the image's chain ID (the snapshot key for the top layer).
+     Using --local makes this fast since the image is already pulled. *)
+  Log.info (fun f -> f "HCS fetch: getting chain ID");
+  (ctr_pread (["images"; "pull"; "--print-chainid"; "--local"] @ platform @ [image]) >>= function
+   | Ok output ->
+     Log.info (fun f -> f "HCS fetch: got chainid output");
+     (match parse_chain_id output with
+      | Some chain_id -> Log.info (fun f -> f "HCS fetch: chain ID = %s" chain_id); Lwt.return chain_id
+      | None -> Fmt.failwith "Could not find chain ID for image %s" image)
+   | Error (`Msg m) ->
+     Fmt.failwith "Failed to get chain ID for image %s: %s" image m)
+  >>= fun chain_id ->
+  (* Clean up any existing snapshots with this key first (for idempotency).
+     Remove any snapshots that depend on our key, then remove our key itself. *)
+  Log.info (fun f -> f "HCS fetch: cleaning up any existing snapshots for %s" key);
+  let committed_key = key ^ "-committed" in
+  (* Use ctr snapshot ls and parse to find snapshots that have our committed key as parent *)
+  (ctr_pread ["snapshot"; "ls"] >>= function
+   | Ok output ->
+     let lines = String.split_on_char '\n' output in
+     let children = lines |> List.filter_map (fun line ->
+       (* Format: KEY\s+PARENT\s+KIND *)
+       let parts = Astring.String.cuts ~empty:false ~sep:" " (String.trim line) in
+       match parts with
+       | child :: parent :: _ when parent = committed_key -> Some child
+       | _ -> None
+     ) in
+     Lwt_list.iter_s (fun child ->
+       Log.info (fun f -> f "HCS fetch: removing child snapshot %s" child);
+       ctr_exec ["snapshot"; "rm"; child] >>= fun _ -> Lwt.return_unit
+     ) children
+   | Error _ -> Lwt.return_unit)
+  >>= fun () ->
+  (* Now remove the main snapshots *)
+  (ctr_exec ["snapshot"; "rm"; key] >>= function
+   | Ok () -> Log.info (fun f -> f "HCS fetch: removed existing snapshot"); Lwt.return_unit
+   | Error (`Msg _) -> Log.info (fun f -> f "HCS fetch: no existing snapshot to remove"); Lwt.return_unit)
+  >>= fun () ->
+  (ctr_exec ["snapshot"; "rm"; committed_key] >>= function
+   | Ok () -> Log.info (fun f -> f "HCS fetch: removed existing committed snapshot"); Lwt.return_unit
+   | Error (`Msg m) -> Log.info (fun f -> f "HCS fetch: could not remove committed snapshot: %s" m); Lwt.return_unit)
+  >>= fun () ->
+  (* Prepare a writable snapshot from the image's top layer *)
+  Log.info (fun f -> f "HCS fetch: preparing snapshot %s from %s" key chain_id);
+  (ctr_pread ["snapshot"; "prepare"; "--mounts"; key; chain_id] >>= function
+   | Ok mounts_json ->
+     Log.info (fun f -> f "HCS fetch: snapshot prepared, parsing mount json");
+     let source, parent_layer_paths = Hcs.parse_mount_json mounts_json in
+     Log.info (fun f -> f "HCS fetch: source=%s, parents=%d" source (List.length parent_layer_paths));
+     Log.info (fun f -> f "HCS fetch: writing layerinfo to %s" rootfs);
+     Hcs.write_layerinfo ~dir:rootfs { snapshot_key = key; source; parent_layer_paths } >>= fun () ->
+     Log.info (fun f -> f "HCS fetch: layerinfo written");
+     Lwt.return_unit
+   | Error (`Msg m) ->
+     Fmt.failwith "Failed to prepare snapshot for base %s: %s" base m)
+  >>= fun () ->
+  (* Get environment variables from the image config.
+     First get the config digest from inspect, then get the config content. *)
+  Log.info (fun f -> f "HCS fetch: getting image config");
+  (ctr_pread ["images"; "inspect"; image] >>= function
+   | Ok inspect_output ->
+     (match parse_config_digest inspect_output with
+      | Some config_digest ->
+        Log.info (fun f -> f "HCS fetch: config digest = %s" config_digest);
+        ctr_pread ["content"; "get"; config_digest] >>= (function
+        | Ok config_json ->
+          Log.info (fun f -> f "HCS fetch: got config, parsing env");
+          Lwt.return (parse_env_from_config config_json)
+        | Error (`Msg m) ->
+          Log.warn (fun f -> f "HCS fetch: failed to get config content: %s" m);
+          Lwt.return [])
+      | None ->
+        Log.warn (fun f -> f "HCS fetch: could not find config digest in inspect output");
+        Lwt.return [])
+   | Error (`Msg m) ->
+     Log.warn (fun f -> f "HCS fetch: failed to inspect image: %s" m);
+     Lwt.return [])
+  >>= fun env ->
+  Log.info (fun f -> f "HCS fetch: done, got %d env vars" (List.length env));
+  Lwt.return env
diff --git a/lib/hcs_sandbox.ml b/lib/hcs_sandbox.ml
new file mode 100644
index 00000000..1768f4c5
--- /dev/null
+++ b/lib/hcs_sandbox.ml
@@ -0,0 +1,189 @@
+open Lwt.Infix
+open Sexplib.Conv
+
+let finished () = Lwt.return_unit
+
+let ( / ) = Filename.concat
+
+type t = {
+  ctr_path : string;
+  hcn_namespace_path : string;
+}
+
+type config = {
+  ctr_path : string;
+  hcn_namespace_path : string;
+} [@@deriving sexp]
+
+let next_id = ref (int_of_float (Unix.gettimeofday () *. 100.) mod 1_000_000)
+
+
+
+module Json_config = struct
+  let strings xs = `List (List.map (fun x -> `String x) xs)
+
+  let make {Config.cwd; argv; hostname; user; env; mounts; network; mount_secrets = _; entrypoint = _}
+      ~layer_folders ~network_namespace : Yojson.Safe.t =
+    let username =
+      match user with
+      | `Windows { Obuilder_spec.name } -> name
+      | `Unix _ -> "ContainerAdministrator"
+    in
+    let windows_section =
+      let base = [
+        "layerFolders", `List (List.map (fun p -> `String p) layer_folders);
+        "ignoreFlushesDuringBoot", `Bool true;
+      ] in
+      match network, network_namespace with
+      | ["host"], Some ns ->
+        base @ [
+          "network", `Assoc [
+            "allowUnqualifiedDNSQuery", `Bool true;
+            "networkNamespace", `String ns;
+          ];
+        ]
+      | _ -> base
+    in
+    let oci_mounts = List.map (fun { Config.Mount.src; dst; readonly; ty = _ } ->
+      `Assoc [
+        "destination", `String dst;
+        "type", `String "bind";
+        "source", `String src;
+        "options", `List (
+          (if readonly then [`String "ro"] else [`String "rw"]) @
+          [`String "rbind"; `String "rprivate"]
+        );
+      ]
+    ) mounts in
+    `Assoc ([
+      "ociVersion", `String "1.1.0";
+      "process", `Assoc [
+        "terminal", `Bool false;
+        "user", `Assoc [
+          "username", `String username;
+        ];
+        "args", strings argv;
+        "env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env);
+        "cwd", `String cwd;
+      ];
+      "root", `Assoc [
+        "path", `String "";
+        "readonly", `Bool false;
+      ];
+      "hostname", `String hostname;
+      "windows", `Assoc windows_section;
+    ] @
+      (if oci_mounts <> [] then ["mounts", `List oci_mounts] else [])
+    )
+end
+
+let run ~cancelled ?stdin:stdin ~log (t : t) config results_dir =
+  let pp f = Os.pp_cmd f ("", config.Config.argv) in
+  let container_id = Printf.sprintf "obuilder-run-%d" !next_id in
+  incr next_id;
+  let layer_folders =
+    if Sys.file_exists (Hcs.layerinfo_path results_dir) then
+      let li = Hcs.read_layerinfo results_dir in
+      li.parent_layer_paths @ [li.source]
+    else
+      Fmt.failwith "No layerinfo found in %s" results_dir
+  in
+  (* Create HCN namespace for networking if requested *)
+  let use_network = config.Config.network = ["host"] in
+  (if use_network && Sys.win32 then begin
+    Log.info (fun f -> f "hcs_sandbox: creating HCN namespace for networking");
+    (Os.win32_pread [t.hcn_namespace_path; "create"] >>= function
+     | Ok output -> Lwt.return output
+     | Error (`Msg m) -> Fmt.failwith "Failed to create HCN namespace: %s" m) >>= fun output ->
+    let ns = String.trim output in
+    Log.info (fun f -> f "hcs_sandbox: created HCN namespace %s" ns);
+    Lwt.return (Some ns)
+  end else Lwt.return_none) >>= fun network_namespace ->
+  Lwt.finalize (fun () ->
+  Lwt_io.with_temp_dir ~perm:0o700 ~prefix:"obuilder-hcs-" @@ fun tmp ->
+  (* Generate OCI config.json *)
+  let json_config = Json_config.make config ~layer_folders ~network_namespace in
+  let json_str = Yojson.Safe.pretty_to_string json_config ^ "\n" in
+  Log.info (fun f -> f "hcs_sandbox: OCI config.json:\n%s" json_str);
+  Os.write_file ~path:(tmp / "config.json") json_str >>= fun () ->
+  (* Write secrets *)
+  Lwt_list.iteri_s
+    (fun id Config.Secret.{value; _} ->
+      let secret_dir = tmp / "secrets" / string_of_int id in
+      Os.ensure_dir (tmp / "secrets");
+      Os.ensure_dir secret_dir;
+      Os.write_file ~path:(secret_dir / "secret") value
+    ) config.mount_secrets
+  >>= fun () ->
+  (* Build the ctr run command *)
+  let cmd = [t.ctr_path; "run"; "--rm"] @
+            (if Option.is_some network_namespace then ["--cni"] else []) @
+            ["--config"; tmp / "config.json";
+             container_id] in
+  Os.with_pipe_from_child @@ fun ~r:out_r ~w:out_w ->
+  let stdout = `FD_move_safely out_w in
+  let stderr = stdout in
+  let copy_log = Build_log.copy ~src:out_r ~dst:log in
+  let proc =
+    let stdin = Option.map (fun x -> `FD_move_safely x) stdin in
+    Os.exec_result ?stdin ~stdout ~stderr ~pp cmd
+  in
+  Lwt.on_termination cancelled (fun () ->
+      let aux () =
+        if Lwt.is_sleeping proc then (
+          let pp f = Fmt.pf f "ctr task kill %S" container_id in
+          Os.exec_result [t.ctr_path; "task"; "kill"; "-s"; "SIGKILL"; container_id] ~pp >>= fun _ ->
+          Lwt.return_unit
+        ) else Lwt.return_unit
+      in
+      Lwt.async aux
+    );
+  proc >>= fun r ->
+  copy_log >>= fun () ->
+  if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
+  else Lwt_result.fail `Cancelled
+  ) (fun () ->
+    (* Clean up HCN namespace if we created one *)
+    match network_namespace with
+    | Some ns ->
+      Log.info (fun f -> f "hcs_sandbox: deleting HCN namespace %s" ns);
+      Os.win32_pread [t.hcn_namespace_path; "delete"; ns] >>= fun result ->
+      (match result with
+       | Ok _ -> ()
+       | Error (`Msg m) -> Log.warn (fun f -> f "hcs_sandbox: failed to delete HCN namespace %s: %s" ns m));
+      Lwt.return_unit
+    | None -> Lwt.return_unit
+  )
+
+let create ~state_dir:_ (c : config) : t Lwt.t =
+  Lwt.return ({ ctr_path = c.ctr_path; hcn_namespace_path = c.hcn_namespace_path } : t)
+
+let shell _ = [{|C:\cygwin64\bin\bash.exe|}; "-lc"]
+
+let tar _ = ["tar"; "-xf"; "-"]
+
+open Cmdliner
+
+let docs = "HCS SANDBOX"
+
+let ctr_path =
+  Arg.value @@
+  Arg.opt Arg.string "ctr" @@
+  Arg.info ~docs
+    ~doc:"Path to the ctr (containerd) CLI."
+    ~docv:"CTR_PATH"
+    ["hcs-ctr-path"]
+
+let hcn_namespace_path =
+  Arg.value @@
+  Arg.opt Arg.string "hcn-namespace" @@
+  Arg.info ~docs
+    ~doc:"Path to the hcn-namespace tool for Windows container networking."
+    ~docv:"HCN_NAMESPACE_PATH"
+    ["hcs-hcn-namespace-path"]
+
+let cmdliner : config Term.t =
+  let make ctr_path hcn_namespace_path =
+    { ctr_path; hcn_namespace_path }
+  in
+  Term.(const make $ ctr_path $ hcn_namespace_path)
diff --git a/lib/hcs_store.ml b/lib/hcs_store.ml
new file mode 100644
index 00000000..8f965998
--- /dev/null
+++ b/lib/hcs_store.ml
@@ -0,0 +1,297 @@
+open Lwt.Infix
+
+let strf = Printf.sprintf
+
+type cache = {
+  lock : Lwt_mutex.t;
+  mutable gen : int;
+}
+
+type t = {
+  root : string;
+  caches : (string, cache) Hashtbl.t;
+  mutable next : int;
+}
+
+let ( / ) = Filename.concat
+
+module Path = struct
+  let result t id        = t.root / "result" / id
+  let result_tmp t id    = t.root / "result-tmp" / id
+  let state t            = t.root / "state"
+  let cache t name       = t.root / "cache" / Escape.cache name
+  let cache_tmp t i name = t.root / "cache-tmp" / strf "%d-%s" i (Escape.cache name)
+end
+
+module Ctr = struct
+  let ctr_with_output args =
+    if Sys.win32 then
+      Os.win32_pread ("ctr" :: args)
+    else begin
+      let pp f = Os.pp_cmd f ("", "ctr" :: args) in
+      Os.pread_all ~pp ("ctr" :: args) >>= fun (exit_code, stdout, stderr) ->
+      if exit_code = 0 then
+        Lwt_result.return stdout
+      else begin
+        Log.warn (fun f -> f "ctr %s failed (exit %d): stdout=%s stderr=%s"
+          (String.concat " " args) exit_code stdout stderr);
+        Lwt.return (Fmt.error_msg "ctr %s failed with exit status %d: %s"
+          (String.concat " " args) exit_code stderr)
+      end
+    end
+
+  let ctr args =
+    ctr_with_output args >|= Result.map (fun _ -> ())
+
+  let ctr_pread args =
+    ctr_with_output args
+
+  (* Prepare a writable snapshot from an optional parent.
+     Uses --mounts to get JSON mount info in the output. *)
+  let snapshot_prepare ~key ?parent () =
+    let parent_args = match parent with
+      | Some p -> [p]
+      | None -> []
+    in
+    ctr_pread (["snapshot"; "prepare"; "--mounts"; key] @ parent_args)
+
+  let snapshot_commit ~key ~committed_key () =
+    ctr (["snapshot"; "commit"; committed_key; key])
+
+  let snapshot_rm ~key () =
+    ctr (["snapshot"; "rm"; key])
+
+  let image_pull image =
+    ctr (["image"; "pull"; image])
+end
+
+let snapshot_key id = "obuilder-" ^ id
+
+
+let delete t id =
+  let path = Path.result t id in
+  match Os.check_dir path with
+  | `Missing -> Lwt.return_unit
+  | `Present ->
+    let rootfs = path / "rootfs" in
+    let key =
+      if Sys.file_exists (Hcs.layerinfo_path rootfs) then
+        (Hcs.read_layerinfo rootfs).snapshot_key
+      else if Sys.file_exists (Hcs.layerinfo_path path) then
+        (Hcs.read_layerinfo path).snapshot_key
+      else
+        snapshot_key id
+    in
+    Log.info (fun f -> f "Deleting snapshot %s for result %s" key id);
+    (Ctr.snapshot_rm ~key () >>= function
+     | Ok () -> Lwt.return_unit
+     | Error (`Msg m) ->
+       Log.warn (fun f -> f "Failed to remove snapshot %s: %s" key m);
+       Lwt.return_unit) >>= fun () ->
+    (* Also try to remove the committed snapshot *)
+    let committed_key = key ^ "-committed" in
+    (Ctr.snapshot_rm ~key:committed_key () >>= function
+     | Ok () -> Lwt.return_unit
+     | Error (`Msg _) -> Lwt.return_unit) >>= fun () ->
+    Os.rm ~directory:path
+
+let purge path =
+  Sys.readdir path |> Array.to_list |> Lwt_list.iter_s (fun item ->
+      let item = path / item in
+      Log.warn (fun f -> f "Removing left-over temporary item %S" item);
+      Os.rm ~directory:item
+    )
+
+let root t = t.root
+
+let df t = Lwt.return (Os.free_space_percent t.root)
+
+let create ~root =
+  Os.ensure_dir root;
+  Os.ensure_dir (root / "result");
+  Os.ensure_dir (root / "result-tmp");
+  Os.ensure_dir (root / "state");
+  Os.ensure_dir (root / "cache");
+  Os.ensure_dir (root / "cache-tmp");
+  purge (root / "result-tmp") >>= fun () ->
+  purge (root / "cache-tmp") >>= fun () ->
+  Lwt.return { root; caches = Hashtbl.create 10; next = 0 }
+
+let build t ?base ~id fn =
+  let result = Path.result t id in
+  let result_tmp = Path.result_tmp t id in
+  assert (not (Sys.file_exists result));
+  let key = snapshot_key id in
+  begin match base with
+    | None ->
+      (* No parent — this is a base image import.
+         The fetcher (fn) will handle snapshot preparation and write layerinfo.
+         We just need to create the result_tmp directory. *)
+      Os.ensure_dir result_tmp;
+      Lwt.return_unit
+    | Some base_id ->
+      (* Build step with a parent — prepare a snapshot from the parent's committed snapshot. *)
+      let parent_dir = Path.result t base_id in
+      let parent_rootfs = parent_dir / "rootfs" in
+      let parent_key =
+        if Sys.file_exists (Hcs.layerinfo_path parent_rootfs) then
+          (Hcs.read_layerinfo parent_rootfs).snapshot_key
+        else if Sys.file_exists (Hcs.layerinfo_path parent_dir) then
+          (Hcs.read_layerinfo parent_dir).snapshot_key
+        else
+          snapshot_key base_id
+      in
+      let parent = parent_key ^ "-committed" in
+      (* Clean up any existing snapshot with this key (for idempotency) *)
+      (Ctr.snapshot_rm ~key () >>= function
+       | Ok () -> Log.info (fun f -> f "Removed existing snapshot %s" key); Lwt.return_unit
+       | Error _ -> Lwt.return_unit) >>= fun () ->
+      Log.info (fun f -> f "Preparing snapshot from parent %s" parent);
+      Ctr.snapshot_prepare ~key ~parent () >>= function
+      | Ok mounts_json ->
+        let source, parent_layer_paths = Hcs.parse_mount_json mounts_json in
+        Os.ensure_dir result_tmp;
+        Hcs.write_layerinfo ~dir:result_tmp { snapshot_key = key; source; parent_layer_paths }
+      | Error (`Msg m) ->
+        Fmt.failwith "Failed to prepare snapshot %s: %s" key m
+  end
+  >>= fun () ->
+  Lwt.try_bind
+    (fun () -> fn result_tmp)
+    (fun r ->
+       begin match r with
+         | Ok () ->
+           let rootfs = result_tmp / "rootfs" in
+           let snap_key =
+             if Sys.file_exists (Hcs.layerinfo_path rootfs) then
+               (Hcs.read_layerinfo rootfs).snapshot_key
+             else if Sys.file_exists (Hcs.layerinfo_path result_tmp) then
+               (Hcs.read_layerinfo result_tmp).snapshot_key
+             else
+               key
+           in
+           Log.info (fun f -> f "Snapshot key is %s" snap_key);
+           let committed_key = snap_key ^ "-committed" in
+           Log.info (fun f -> f "Committing snapshot %s -> %s" snap_key committed_key);
+           (* Remove any existing committed snapshot first (idempotency) *)
+           (Ctr.snapshot_rm ~key:committed_key () >>= function
+            | Ok () -> Log.info (fun f -> f "Removed existing committed snapshot %s" committed_key); Lwt.return_unit
+            | Error _ -> Lwt.return_unit) >>= fun () ->
+           (Ctr.snapshot_commit ~key:snap_key ~committed_key () >>= function
+            | Ok () -> Lwt.return_unit
+            | Error (`Msg m) ->
+              Log.warn (fun f -> f "Failed to commit snapshot %s: %s" snap_key m);
+              Lwt.return_unit) >>= fun () ->
+           (* On Windows, Sys.rename cannot replace an existing directory.
+              Remove the target first if it exists (idempotency for retried builds). *)
+           (if Sys.win32 && Sys.file_exists result then
+              Os.rm ~directory:result
+            else Lwt.return_unit) >>= fun () ->
+           Os.mv ~src:result_tmp result
+         | Error _ ->
+           (* Clean up snapshot if we created one *)
+           (if base <> None then
+              Ctr.snapshot_rm ~key () >>= function
+              | Ok () -> Lwt.return_unit
+              | Error (`Msg m) ->
+                Log.warn (fun f -> f "Failed to remove snapshot %s: %s" key m);
+                Lwt.return_unit
+            else Lwt.return_unit) >>= fun () ->
+           Os.rm ~directory:result_tmp
+       end >>= fun () ->
+       Lwt.return r
+    )
+    (fun ex ->
+      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+      (if base <> None then
+         Ctr.snapshot_rm ~key () >>= function
+         | Ok () -> Lwt.return_unit
+         | Error (`Msg m) ->
+           Log.warn (fun f -> f "Failed to remove snapshot %s: %s" key m);
+           Lwt.return_unit
+       else Lwt.return_unit) >>= fun () ->
+      Os.rm ~directory:result_tmp >>= fun () ->
+      Lwt.reraise ex
+    )
+
+let result t id =
+  let dir = Path.result t id in
+  match Os.check_dir dir with
+  | `Present -> Lwt.return_some dir
+  | `Missing -> Lwt.return_none
+
+let log_file t id =
+  result t id >|= function
+  | Some dir -> dir / "log"
+  | None -> (Path.result_tmp t id) / "log"
+
+let state_dir = Path.state
+
+let get_cache t name =
+  match Hashtbl.find_opt t.caches name with
+  | Some c -> c
+  | None ->
+    let c = { lock = Lwt_mutex.create (); gen = 0 } in
+    Hashtbl.add t.caches name c;
+    c
+
+let cache ~user:_ t name =
+  let cache = get_cache t name in
+  Lwt_mutex.with_lock cache.lock @@ fun () ->
+  let tmp = Path.cache_tmp t t.next name in
+  t.next <- t.next + 1;
+  let master = Path.cache t name in
+  begin match Os.check_dir master with
+    | `Missing ->
+      Os.ensure_dir master;
+      Lwt.return_unit
+    | `Present -> Lwt.return_unit
+  end >>= fun () ->
+  let gen = cache.gen in
+  Os.ensure_dir tmp;
+  Os.cp ~src:master tmp >>= fun () ->
+  let release () =
+    Lwt_mutex.with_lock cache.lock @@ fun () ->
+    begin
+      if cache.gen = gen then (
+        cache.gen <- cache.gen + 1;
+        Os.rm ~directory:master >>= fun () ->
+        Os.mv ~src:tmp master
+      ) else
+        Os.rm ~directory:tmp
+    end
+  in
+  Lwt.return (tmp, release)
+
+let delete_cache t name =
+  let cache = get_cache t name in
+  Lwt_mutex.with_lock cache.lock @@ fun () ->
+  cache.gen <- cache.gen + 1;
+  let snapshot = Path.cache t name in
+  if Sys.file_exists snapshot then (
+    Os.rm ~directory:snapshot >>= fun () ->
+    Lwt_result.return ()
+  ) else Lwt_result.return ()
+
+(* After pruning, try to remove all obuilder-base-* containerd snapshots.
+   Snapshots still in use (have children) will fail harmlessly.
+   Orphaned ones (whose obuilder entry was already pruned) get cleaned up,
+   freeing the underlying image layer disk space. *)
+let complete_deletes _ =
+  Ctr.ctr_pread ["snapshot"; "ls"] >>= function
+  | Error _ -> Lwt.return_unit
+  | Ok output ->
+    let lines = String.split_on_char '\n' output in
+    let base_keys = List.filter_map (fun line ->
+      let parts = Astring.String.cuts ~empty:false ~sep:" " (String.trim line) in
+      match parts with
+      | key :: _ when Astring.String.is_prefix ~affix:"obuilder-base-" key -> Some key
+      | _ -> None
+    ) lines in
+    Lwt_list.iter_s (fun key ->
+      Ctr.snapshot_rm ~key () >>= function
+      | Ok () ->
+        Log.info (fun f -> f "Removed orphaned base snapshot %s" key);
+        Lwt.return_unit
+      | Error _ -> Lwt.return_unit
+    ) base_keys
diff --git a/lib/obuilder.ml b/lib/obuilder.ml
index f54fed61..3390e599 100644
--- a/lib/obuilder.ml
+++ b/lib/obuilder.ml
@@ -16,12 +16,14 @@ module Xfs_store = Xfs_store
 module Store_spec = Store_spec
 module Docker_store = Docker_store
 module Qemu_store = Qemu_store
+module Hcs_store = Hcs_store
 
 (** {2 Fetchers} *)
 module Zfs_clone = Zfs_clone
 module Qemu_snapshot = Qemu_snapshot
 module Docker_extract = Docker.Extract
 module Archive_extract = Archive_extract
+module Hcs_fetch = Hcs_fetch
 
 (** {2 Sandboxes} *)
 
@@ -29,6 +31,7 @@ module Config = Config
 module Native_sandbox = Sandbox
 module Docker_sandbox = Docker_sandbox
 module Qemu_sandbox = Qemu_sandbox
+module Hcs_sandbox = Hcs_sandbox
 
 (** {2 Builders} *)
 
diff --git a/lib/os.ml b/lib/os.ml
index 3b371b8f..c1071b41 100644
--- a/lib/os.ml
+++ b/lib/os.ml
@@ -195,6 +195,11 @@ let pread_result ?cwd ?stdin ?stderr ~pp ?is_success ?cmd argv =
     (fun () -> Lwt_io.close r)
   >>= fun data -> child >|= fun r -> Result.map (fun () -> data) r
 
+(* Simple command output capture used by HCS components on Windows. *)
+let win32_pread argv =
+  let pp f = pp_cmd f ("", argv) in
+  pread_result ~pp argv
+
 let pread_all ?stdin ~pp ?(cmd="") argv =
   with_pipe_from_child @@ fun ~r:r1 ~w:w1 ->
   with_pipe_from_child @@ fun ~r:r2 ~w:w2 ->
@@ -231,30 +236,61 @@ let read_link x =
 
 let rm ~directory =
   let pp _ ppf = Fmt.pf ppf "[ RM ]" in
-  sudo_result ~pp:(pp "RM") ["rm"; "-r"; directory ] >>= fun t ->
-  match t with
-  | Ok () -> Lwt.return_unit
-  | Error (`Msg m) ->
-    Log.warn (fun f -> f "Failed to remove %s because %s" directory m);
-    Lwt.return_unit
+  if Sys.win32 then begin
+    (* rmdir is a cmd.exe built-in; use \000 prefix to suppress Lwt_process quoting *)
+    exec_result ~pp:(pp "RM") ["cmd.exe"; "/c"; "\000rmdir /s /q " ^ Filename.quote directory ] >>= fun t ->
+    match t with
+    | Ok () -> Lwt.return_unit
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to remove %s because %s" directory m);
+      Lwt.return_unit
+  end else begin
+    sudo_result ~pp:(pp "RM") ["rm"; "-r"; directory ] >>= fun t ->
+    match t with
+    | Ok () -> Lwt.return_unit
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to remove %s because %s" directory m);
+      Lwt.return_unit
+  end
 
 let mv ~src dst =
   let pp _ ppf = Fmt.pf ppf "[ MV ]" in
-  sudo_result ~pp:(pp "MV") ["mv"; src; dst ] >>= fun t ->
-  match t with
-  | Ok () -> Lwt.return_unit
-  | Error (`Msg m) ->
-    Log.warn (fun f -> f "Failed to move %s to %s because %s" src dst m);
-    Lwt.return_unit
+  if Sys.win32 then begin
+    (* Use synchronous rename on Windows *)
+    Lwt.catch (fun () ->
+      Sys.rename src dst;
+      Lwt.return_unit
+    ) (fun exn ->
+      Log.warn (fun f -> f "Failed to move %s to %s because %s" src dst (Printexc.to_string exn));
+      Lwt.return_unit
+    )
+  end else begin
+    sudo_result ~pp:(pp "MV") ["mv"; src; dst ] >>= fun t ->
+    match t with
+    | Ok () -> Lwt.return_unit
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to move %s to %s because %s" src dst m);
+      Lwt.return_unit
+  end
 
 let cp ~src dst =
   let pp _ ppf = Fmt.pf ppf "[ CP ]" in
-  sudo_result ~pp:(pp "CP") ["cp"; "-pRduT"; "--reflink=auto"; src; dst ] >>= fun t ->
-  match t with
-  | Ok () -> Lwt.return_unit
-  | Error (`Msg m) ->
-    Log.warn (fun f -> f "Failed to copy from %s to %s because %s" src dst m);
-    Lwt.return_unit
+  if Sys.win32 then
+    exec_result ~pp:(pp "CP") ["robocopy"; src; dst; "/E"; "/NFL"; "/NDL"; "/NJH"; "/NJS"]
+      ~is_success:(fun n -> n < 8)  (* robocopy exit codes < 8 are success *)
+    >>= fun t ->
+    match t with
+    | Ok () -> Lwt.return_unit
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to copy from %s to %s because %s" src dst m);
+      Lwt.return_unit
+  else
+    sudo_result ~pp:(pp "CP") ["cp"; "-pRduT"; "--reflink=auto"; src; dst ] >>= fun t ->
+    match t with
+    | Ok () -> Lwt.return_unit
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to copy from %s to %s because %s" src dst m);
+      Lwt.return_unit
 
 let normalise_path root_dir =
   if Sys.win32 then
diff --git a/lib/store_spec.ml b/lib/store_spec.ml
index f676651e..01a07571 100644
--- a/lib/store_spec.ml
+++ b/lib/store_spec.ml
@@ -10,6 +10,7 @@ type t = [
   | `Overlayfs of string (* Path *)
   | `Docker of string (* Path *)
   | `Qemu of string   (* Path *)
+  | `Hcs of string    (* Path *)
 ]
 
 let is_absolute path = not (Filename.is_relative path)
@@ -23,7 +24,8 @@ let of_string s =
   | Some ("overlayfs", path) when is_absolute path -> Ok (`Overlayfs path)
   | Some ("docker", path) -> Ok (`Docker path)
   | Some ("qemu", path) -> Ok (`Qemu path)
-  | _ -> Error (`Msg "Store must start with zfs:, btrfs:/, rsync:/, xfs:/, qemu:/ or overlayfs:")
+  | Some ("hcs", path) -> Ok (`Hcs path)
+  | _ -> Error (`Msg "Store must start with zfs:, btrfs:/, rsync:/, xfs:/, qemu:/, hcs: or overlayfs:")
 
 let pp f = function
   | `Zfs path -> Fmt.pf f "zfs:%s" path
@@ -33,6 +35,7 @@ let pp f = function
   | `Overlayfs path -> Fmt.pf f "overlayfs:%s" path
   | `Docker path -> Fmt.pf f "docker:%s" path
   | `Qemu path -> Fmt.pf f "qemu:%s" path
+  | `Hcs path -> Fmt.pf f "hcs:%s" path
 
 type store = Store : (module S.STORE with type t = 'a) * 'a -> store
 
@@ -58,6 +61,9 @@ let to_store = function
   | `Qemu root ->
     `Qemu, Qemu_store.create ~root >|= fun store ->
     Store ((module Qemu_store), store)
+  | `Hcs root ->
+    `Hcs, Hcs_store.create ~root >|= fun store ->
+    Store ((module Hcs_store), store)
 
 open Cmdliner
 
@@ -66,7 +72,7 @@ let store_t = Arg.conv (of_string, pp)
 let store ?docs names =
   Arg.opt Arg.(some store_t) None @@
   Arg.info
-    ~doc:"$(docv) must be one of $(b,btrfs:/path), $(b,rsync:/path), $(b,xfs:/path), $(b,overlayfs:/path), $(b,zfs:pool), $(b,qemu:/path) or $(b,docker:path) for the OBuilder cache."
+    ~doc:"$(docv) must be one of $(b,btrfs:/path), $(b,rsync:/path), $(b,xfs:/path), $(b,overlayfs:/path), $(b,zfs:pool), $(b,qemu:/path), $(b,hcs:path) or $(b,docker:path) for the OBuilder cache."
     ~docv:"STORE"
     ?docs
     names
@@ -102,7 +108,8 @@ let of_t store rsync_mode =
   | Some (`Overlayfs path), None -> (`Overlayfs path)
   | Some (`Docker path), None -> (`Docker path)
   | Some (`Qemu path), None -> (`Qemu path)
-  | _, _ -> failwith "Store type required must be one of btrfs:/path, rsync:/path, xfs:/path, zfs:pool, qemu:/path or docker:path for the OBuilder cache."
+  | Some (`Hcs path), None -> (`Hcs path)
+  | _, _ -> failwith "Store type required must be one of btrfs:/path, rsync:/path, xfs:/path, zfs:pool, qemu:/path, hcs:path or docker:path for the OBuilder cache."
 
 (** Parse cli arguments for t *)
 let v =
diff --git a/lib/tar_transfer.ml b/lib/tar_transfer.ml
index c16cbeb3..e84aa205 100644
--- a/lib/tar_transfer.ml
+++ b/lib/tar_transfer.ml
@@ -29,7 +29,8 @@ module Tar_lwt_unix = struct
   module Writer = struct
     type out_channel = Lwt_unix.file_descr
     type 'a t = 'a Lwt.t
-    let really_write fd = Lwt_cstruct.(complete (write fd))
+    let really_write fd cs =
+      Os.write_all fd (Cstruct.to_bytes cs) 0 (Cstruct.length cs)
   end
 
   module HW = Tar.HeaderWriter(Lwt)(Writer)
@@ -64,18 +65,51 @@ let get_ids = function
   | `Windows _ -> None, None, None, None
 
 let copy_file ~src ~dst ~to_untar ~user =
-  Lwt_unix.LargeFile.lstat src >>= fun stat ->
-  let user_id, group_id, uname, gname = get_ids user in
-  let hdr = Tar.Header.make
-      ~file_mode:(if stat.Lwt_unix.LargeFile.st_perm land 0o111 <> 0 then 0o755 else 0o644)
-      ~mod_time:(Int64.of_float stat.Lwt_unix.LargeFile.st_mtime)
-      ?user_id ?group_id ?uname ?gname
-      dst stat.Lwt_unix.LargeFile.st_size
-  in
-  Tar_lwt_unix.write_block ~level hdr (fun ofd ->
-      let flags = [Unix.O_RDONLY; Unix.O_NONBLOCK; Unix.O_CLOEXEC] in
-      Lwt_io.(with_file ~mode:input ~flags) src (copy_to ~dst:ofd)
-    ) to_untar
+  if Sys.win32 then begin
+    (* On Windows, Lwt I/O hangs. Use synchronous stat and file reads. *)
+    let stat = Unix.LargeFile.stat src in
+    let user_id, group_id, uname, gname = get_ids user in
+    let hdr = Tar.Header.make
+        ~file_mode:(if stat.Unix.LargeFile.st_perm land 0o111 <> 0 then 0o755 else 0o644)
+        ~mod_time:(Int64.of_float stat.Unix.LargeFile.st_mtime)
+        ?user_id ?group_id ?uname ?gname
+        dst stat.Unix.LargeFile.st_size
+    in
+    Tar_lwt_unix.write_block ~level hdr (fun ofd ->
+        let unix_fd = Lwt_unix.unix_file_descr ofd in
+        let ic = open_in_bin src in
+        Fun.protect ~finally:(fun () -> close_in ic) @@ fun () ->
+        let buf = Bytes.create 4096 in
+        let rec loop () =
+          let n = input ic buf 0 4096 in
+          if n = 0 then ()
+          else begin
+            let rec write_all ofs len =
+              if len > 0 then
+                let w = Unix.write unix_fd buf ofs len in
+                write_all (ofs + w) (len - w)
+            in
+            write_all 0 n;
+            loop ()
+          end
+        in
+        loop ();
+        Lwt.return_unit
+      ) to_untar
+  end else begin
+    Lwt_unix.LargeFile.lstat src >>= fun stat ->
+    let user_id, group_id, uname, gname = get_ids user in
+    let hdr = Tar.Header.make
+        ~file_mode:(if stat.Lwt_unix.LargeFile.st_perm land 0o111 <> 0 then 0o755 else 0o644)
+        ~mod_time:(Int64.of_float stat.Lwt_unix.LargeFile.st_mtime)
+        ?user_id ?group_id ?uname ?gname
+        dst stat.Lwt_unix.LargeFile.st_size
+    in
+    Tar_lwt_unix.write_block ~level hdr (fun ofd ->
+        let flags = [Unix.O_RDONLY; Unix.O_NONBLOCK; Unix.O_CLOEXEC] in
+        Lwt_io.(with_file ~mode:input ~flags) src (copy_to ~dst:ofd)
+      ) to_untar
+  end
 
 let copy_symlink ~src ~target ~dst ~to_untar ~user =
   Lwt_unix.LargeFile.lstat src >>= fun stat ->
@@ -119,10 +153,37 @@ and send_dir ~src_dir ~dst ~to_untar ~user items =
         copy_dir ~src_dir ~src ~dst ~items ~to_untar ~user
     )
 
-let remove_leading_slashes = Astring.String.drop ~sat:((=) '/')
+let remove_leading_slashes s =
+  (* Strip Windows drive letter prefix (e.g. "C:/") *)
+  let s =
+    if String.length s >= 2 && Char.uppercase_ascii s.[0] >= 'A' &&
+       Char.uppercase_ascii s.[0] <= 'Z' && s.[1] = ':' then
+      String.sub s 2 (String.length s - 2)
+    else s
+  in
+  Astring.String.drop ~sat:((=) '/') s
+
+let ensure_dir_entries ~to_untar ~user path =
+  (* Emit tar directory entries for each component of path so that
+     extractors that don't auto-create intermediate directories work. *)
+  let user_id, group_id, uname, gname = get_ids user in
+  let parts = String.split_on_char '/' path in
+  let rec loop acc = function
+    | [] -> Lwt.return_unit
+    | "" :: rest | "." :: rest -> loop acc rest
+    | p :: rest ->
+      let dir = match acc with "" -> p | _ -> acc ^ "/" ^ p in
+      let hdr = Tar.Header.make ~file_mode:0o755
+          ?user_id ?group_id ?uname ?gname
+          (dir ^ "/") 0L in
+      Tar_lwt_unix.write_block ~level hdr (fun _ -> Lwt.return_unit) to_untar >>= fun () ->
+      loop dir rest
+  in
+  loop "" parts
 
 let send_files ~src_dir ~src_manifest ~dst_dir ~user ~to_untar =
   let dst = remove_leading_slashes dst_dir in
+  ensure_dir_entries ~to_untar ~user dst >>= fun () ->
   send_dir ~src_dir ~dst ~to_untar ~user src_manifest >>= fun () ->
   Tar_lwt_unix.write_end to_untar
 
diff --git a/main.ml b/main.ml
index 3b4e0870..70312b81 100644
--- a/main.ml
+++ b/main.ml
@@ -9,6 +9,8 @@ module Docker_store = Obuilder.Docker_store
 module Docker_extract = Obuilder.Docker_extract
 module Archive_extract = Obuilder.Archive_extract
 module Qemu_snapshot = Obuilder.Qemu_snapshot
+module Hcs_sandbox = Obuilder.Hcs_sandbox
+module Hcs_fetch = Obuilder.Hcs_fetch
 module Store_spec = Obuilder.Store_spec
 
 type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> builder
@@ -40,21 +42,29 @@ let create_qemu_builder store_spec conf =
   let builder = Builder.v ~store ~sandbox in
   Builder ((module Builder), builder)
 
+let create_hcs_builder store_spec conf =
+  store_spec >>= fun (Store_spec.Store ((module Store), store)) ->
+  let module Builder = Obuilder.Builder (Store) (Hcs_sandbox) (Hcs_fetch) in
+  Hcs_sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox ->
+  let builder = Builder.v ~store ~sandbox in
+  Builder ((module Builder), builder)
+
 let read_whole_file path =
   let ic = open_in_bin path in
   Fun.protect ~finally:(fun () -> close_in ic) @@ fun () ->
   let len = in_channel_length ic in
   really_input_string ic len
 
-let select_backend (sandbox, store_spec) native_conf docker_conf qemu_conf =
+let select_backend (sandbox, store_spec) native_conf docker_conf qemu_conf hcs_conf =
   match sandbox with
   | `Native -> create_builder store_spec native_conf
   | `Docker -> create_docker_builder store_spec docker_conf
   | `Qemu -> create_qemu_builder store_spec qemu_conf
+  | `Hcs -> create_hcs_builder store_spec hcs_conf
 
-let build () store spec native_conf docker_conf qemu_conf src_dir secrets =
+let build () store spec native_conf docker_conf qemu_conf hcs_conf src_dir secrets =
   Lwt_main.run begin
-    select_backend store native_conf docker_conf qemu_conf
+    select_backend store native_conf docker_conf qemu_conf hcs_conf
     >>= fun (Builder ((module Builder), builder)) ->
     Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () ->
     let spec =
@@ -77,9 +87,9 @@ let build () store spec native_conf docker_conf qemu_conf src_dir secrets =
       exit 1
   end
 
-let healthcheck () store native_conf docker_conf qemu_conf =
+let healthcheck () store native_conf docker_conf qemu_conf hcs_conf =
   Lwt_main.run begin
-    select_backend store native_conf docker_conf qemu_conf
+    select_backend store native_conf docker_conf qemu_conf hcs_conf
     >>= fun (Builder ((module Builder), builder)) ->
     Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () ->
     Builder.healthcheck builder >|= function
@@ -90,17 +100,17 @@ let healthcheck () store native_conf docker_conf qemu_conf =
       Fmt.pr "Healthcheck passed@."
   end
 
-let delete () store native_conf docker_conf qemu_conf id =
+let delete () store native_conf docker_conf qemu_conf hcs_conf id =
   Lwt_main.run begin
-    select_backend store native_conf docker_conf qemu_conf
+    select_backend store native_conf docker_conf qemu_conf hcs_conf
     >>= fun (Builder ((module Builder), builder)) ->
     Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () ->
     Builder.delete builder id ~log:(fun id -> Fmt.pr "Removing %s@." id)
   end
 
-let clean () store native_conf docker_conf qemu_conf =
+let clean () store native_conf docker_conf qemu_conf hcs_conf =
   Lwt_main.run begin
-    select_backend store native_conf docker_conf qemu_conf
+    select_backend store native_conf docker_conf qemu_conf hcs_conf
     >>= fun (Builder ((module Builder), builder)) ->
     Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ begin fun () ->
       let now = Unix.(gmtime (gettimeofday ())) in
@@ -167,21 +177,21 @@ let build =
   let info = Cmd.info "build" ~doc in
   Cmd.v info
     Term.(const build $ setup_log $ store $ spec_file $ Native_sandbox.cmdliner
-          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ src_dir $ secrets)
+          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ Hcs_sandbox.cmdliner $ src_dir $ secrets)
 
 let delete =
   let doc = "Recursively delete a cached build result." in
   let info = Cmd.info "delete" ~doc in
   Cmd.v info
     Term.(const delete $ setup_log $ store $ Native_sandbox.cmdliner
-          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ id)
+          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ Hcs_sandbox.cmdliner $ id)
 
 let clean =
   let doc = "Clean all cached build results." in
   let info = Cmd.info "clean" ~doc in
   Cmd.v info
     Term.(const clean $ setup_log $ store $ Native_sandbox.cmdliner
-          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner)
+          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ Hcs_sandbox.cmdliner)
 
 let buildkit =
   Arg.value @@
@@ -210,7 +220,7 @@ let healthcheck =
   let info = Cmd.info "healthcheck" ~doc in
   Cmd.v info
     Term.(const healthcheck $ setup_log $ store $ Native_sandbox.cmdliner
-          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner)
+          $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ Hcs_sandbox.cmdliner)
 
 let cmds = [build; delete; clean; dockerfile; healthcheck]