gazagnaire.org
OCI-oriented build engine
2.0 kB
52 lines
1(* Fuzz the COPY/secret destination resolver for path-containment.
2
3 Invariant: for any destination path -- including ones full of "..", ".", and
4 leading "/" -- [snapshot_dst] resolves inside the snapshot root or rejects it
5 with [Invalid_argument], and materialising the resolved path never creates
6 anything outside the root. Mirrors ocaml-oci's checkout fuzz: resolve against
7 [root]/out and assert [root] afterwards holds only "out" -- a traversal that
8 escaped would leave a sibling there (tar-slip / CVE-2024-21626 class). *)
9
10open Alcobar
11module Backend = Builder.Backend
12
13(* Segments biased toward adversarial shapes: "..", ".", empty and leading-"/". *)
14let segment = choose [ const ".."; const "."; const ""; const "a"; const "etc" ]
15
16let path =
17 map
18 [ bool; list1 segment ]
19 (fun leading segs -> (if leading then "/" else "") ^ String.concat "/" segs)
20
21let counter = ref 0
22
23let test_containment p =
24 Eio_main.run @@ fun env ->
25 incr counter;
26 let cwd = Eio.Stdenv.cwd env in
27 let root =
28 Eio.Path.(cwd / "_build" / "builder-backend-fuzz" / string_of_int !counter)
29 in
30 (try Eio.Path.rmtree ~missing_ok:true root with Eio.Io _ -> ());
31 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 root;
32 let out = Eio.Path.(root / "out") in
33 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 out;
34 (match Backend.snapshot_dst ~root:out p with
35 | exception Invalid_argument _ -> () (* rejecting an unsafe dst is fine *)
36 | dst -> (
37 try
38 (match Eio.Path.split dst with
39 | Some (parent, _) -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 parent
40 | None -> ());
41 Eio.Path.save ~create:(`If_missing 0o600) dst "x"
42 with Eio.Io _ | Invalid_argument _ -> ()));
43 let entries = List.sort compare (Eio.Path.read_dir root) in
44 (try Eio.Path.rmtree ~missing_ok:true root with Eio.Io _ -> ());
45 check (List.equal String.equal entries [ "out" ])
46
47let suite =
48 ( "backend",
49 [
50 test_case "dest path never escapes the snapshot root" [ path ]
51 test_containment;
52 ] )