diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 9d46c943..bdf8fd57 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -70,6 +70,10 @@ jobs: runs-on: ${{ matrix.os }} steps: + - name: Free space + # https://github.com/actions/runner-images/issues/2840#issuecomment-790492173 + run: sudo rm -rf /usr/share/dotnet /opt/ghc /usr/local/share/boost "$AGENT_TOOLSDIRECTORY" + - name: Checkout code uses: actions/checkout@v3 @@ -116,4 +120,4 @@ jobs: - run: opam install . --deps-only --with-test - - run: opam exec -- dune build + - run: opam exec -- dune runtest diff --git a/.run-gha-tests.sh b/.run-gha-tests.sh index 6d709acb..6a329254 100755 --- a/.run-gha-tests.sh +++ b/.run-gha-tests.sh @@ -86,4 +86,3 @@ case "$1" in printf "Usage: .run-gha-tests.sh [btrfs|rsync|zfs]" >&2 exit 1 esac - diff --git a/README.md b/README.md index 57edfb65..65dda05f 100644 --- a/README.md +++ b/README.md @@ -83,7 +83,7 @@ When performing a build, the user gives OBuilder a specification file (as descri and a source directory, containing files which may be copied into the image using `copy`. ```sexp -((from BASE) OP...) +((from BASE) OP…) ``` Example: @@ -128,7 +128,7 @@ For example: (run (shell "hello"))) ``` -At the moment, the `(build ...)` items must appear before the `(from ...)` line. +At the moment, the `(build …)` items must appear before the `(from …)` line. ### workdir @@ -149,7 +149,7 @@ If the path given is relative, it is combined with the previous setting. ### shell ```sexp -(shell ARG...) +(shell ARG…) ``` Example: @@ -165,9 +165,9 @@ The command run will be this list of arguments followed by the single argument ` ```sexp (run - (cache CACHE...)? - (network NETWORK...)? - (secrets SECRET...)? + (cache CACHE…)? + (network NETWORK…)? + (secrets SECRET…)? (shell COMMAND)) ``` @@ -188,7 +188,7 @@ Examples: Runs the single argument `COMMAND` using the values in the current context (set by `workdir` and `shell`). -The `(cache CACHE...)` field can be used to mount one or more persistent caches for the command. +The `(cache CACHE…)` field can be used to mount one or more persistent caches for the command. Each `CACHE` takes the form `(NAME (target PATH))`, where `NAME` uniquely identifies the cache to use and `PATH` is the mount point within the container. @@ -198,14 +198,14 @@ A mutable copy of the cache is created for the command. When the command finishe this copy becomes the new version of the cache, unless some other command updated the same cache first, in which case this one is discarded. -The `(network NETWORK...)` field specifies which network(s) the container will be connected to. +The `(network NETWORK…)` field specifies which network(s) the container will be connected to. `(network host)` is a special value which runs the container in the host's network namespace. Otherwise, a fresh network namespace is created for the container, with interfaces for the given networks (if any). Currently, no other networks can be used, so the only options are `host` or an isolated private network. -The `(secrets SECRET...)` field can be used to request values for chosen keys, mounted as read-only files in +The `(secrets SECRET…)` field can be used to request values for chosen keys, mounted as read-only files in the image. Each `SECRET` entry is under the form `(ID (target PATH))`, where `ID` selects the secret, and `PATH` is the location of the mounted secret file within the container. The sandbox context API contains a `secrets` parameter to provide values to the runtime. @@ -219,10 +219,10 @@ When used with Docker, make sure to use the **buildkit** syntax, as only buildki ```sexp (copy - (from ...)? - (src SRC...) + (from …)? + (src SRC…) (dst DST) - (exclude EXCL...)?) + (exclude EXCL…)?) ``` Examples: @@ -257,7 +257,7 @@ Otherwise, it is the source directory provided by the user. Notes: - Unlike Docker's `COPY` operation, OBuilder copies the files using the current - user and group IDs, as set with `(user ...)`. + user and group IDs, as set with `(user …)`. - Both `SRC` and `DST` use `/` as the directory separator on all platforms. @@ -304,12 +304,12 @@ obuilder dockerfile -f example.spec > Dockerfile The dockerfile should work the same way as the spec file, except for these limitations: -- In `(copy (excludes ...) ...)` the excludes part is ignored. +- In `(copy (excludes …) …)` the excludes part is ignored. You will need to ensure you have a suitable `.dockerignore` file instead. - If you want to include caches or to use secrets, use `--buildkit` to output in the extended BuildKit syntax. -- All `(network ...)` fields are ignored, as Docker does not allow per-step control of +- All `(network …)` fields are ignored, as Docker does not allow per-step control of networking. ## Experimental macOS Support diff --git a/lib/btrfs_store.ml b/lib/btrfs_store.ml index ef4cc2ed..604a942a 100644 --- a/lib/btrfs_store.ml +++ b/lib/btrfs_store.ml @@ -142,8 +142,13 @@ let build t ?base ~id fn = let result t id = let dir = Path.result t id in match Os.check_dir dir with - | `Present -> Some dir - | `Missing -> None + | `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 get_cache t name = match Hashtbl.find_opt t.caches name with diff --git a/lib/build.ml b/lib/build.ml index 6ef4a843..589943b0 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -29,7 +29,9 @@ module Context = struct secrets : (string * string) list; } - let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?(workdir="/") ?(shell=["/bin/bash"; "-c"]) ?(secrets=[]) ~log ~src_dir () = + let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?workdir ?shell ?(secrets=[]) ~log ~src_dir () = + let workdir = Option.value ~default:(if Sys.win32 then {|C:/|} else "/") workdir in + let shell = Option.value ~default:(if Sys.win32 then ["cmd"; "/S"; "/C"] else ["/bin/bash"; "-c"]) shell in { switch; env; src_dir; user; workdir; shell; log; scope = Scope.empty; secrets } let with_binding name value t = @@ -122,7 +124,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st match Scope.find_opt name scope with | None -> Fmt.failwith "Unknown build %S" name (* (shouldn't happen; gets caught earlier) *) | Some id -> - match Store.result t.store id with + Store.result t.store id >>= function | None -> Lwt_result.fail (`Msg (Fmt.str "Build result %S not found" id)) | Some dir -> @@ -226,7 +228,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); let id = Sha256.to_hex (Sha256.string base) in Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp -> - Log.info (fun f -> f "Base image not present; importing %S..." base); + Log.info (fun f -> f "Base image not present; importing %S…" base); let rootfs = tmp / "rootfs" in Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () -> Fetch.fetch ~log ~rootfs base >>= fun env -> @@ -234,8 +236,8 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> Lwt_result.return () ) - >>!= fun id -> - let path = Option.get (Store.result t.store id) in + >>!= fun id -> Store.result t.store id + >|= Option.get >>= fun path -> let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in Lwt_result.return (id, env) @@ -243,7 +245,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st let rec aux context = function | [] -> Lwt_result.return context | (name, child_spec) :: child_builds -> - context.Context.log `Heading Fmt.(str "(build %S ...)" name); + context.Context.log `Heading Fmt.(str "(build %S …)" name); build ~scope t context child_spec >>!= fun child_result -> context.Context.log `Note Fmt.(str "--> finished %S" name); let context = Context.with_binding name child_result context in diff --git a/lib/db_store.ml b/lib/db_store.ml index 770f20a1..17978e33 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -45,11 +45,11 @@ module Make (Raw : S.STORE) = struct or by doing a new build using [fn]. We only run one instance of this at a time for a single [id]. *) let get_build t ~base ~id ~cancelled ~set_log fn = - match Raw.result t.raw id with - | Some dir -> + Raw.result t.raw id >>= function + | Some _ -> let now = Unix.(gmtime (gettimeofday ())) in Dao.set_used t.dao ~id ~now; - let log_file = dir / "log" in + Raw.log_file t.raw id >>= fun log_file -> begin if Sys.file_exists log_file then Build_log.of_saved log_file else Lwt.return Build_log.empty @@ -58,7 +58,7 @@ module Make (Raw : S.STORE) = struct Lwt_result.return (`Loaded, id) | None -> Raw.build t.raw ?base ~id (fun dir -> - let log_file = dir / "log" in + Raw.log_file t.raw id >>= fun log_file -> if Sys.file_exists log_file then Unix.unlink log_file; Build_log.create log_file >>= fun log -> Lwt.wakeup set_log log; diff --git a/lib/db_store.mli b/lib/db_store.mli index 5a72fb3d..5aae49af 100644 --- a/lib/db_store.mli +++ b/lib/db_store.mli @@ -18,7 +18,7 @@ module Make (Raw : S.STORE) : sig val prune : ?log:(S.id -> unit) -> t -> before:Unix.tm -> int -> int Lwt.t - val result : t -> S.id -> string option + val result : t -> S.id -> string option Lwt.t val cache : user : Obuilder_spec.user -> diff --git a/lib/macos.ml b/lib/macos.ml index 2a5c36da..b8a01bdd 100644 --- a/lib/macos.ml +++ b/lib/macos.ml @@ -41,7 +41,7 @@ let descendants ~pid = let+ s = pread ["sudo"; "pgrep"; "-P"; string_of_int pid ] in let pids = Astring.String.cuts ~sep:"\n" s in List.filter_map int_of_string_opt pids) - (* Errors if there are none, probably errors for other reasons too... *) + (* Errors if there are none, probably errors for other reasons too… *) (fun _ -> Lwt.return []) let kill ~pid = @@ -69,7 +69,7 @@ let copy_template ~base ~local = let change_home_directory_for ~user ~home_dir = ["dscl"; "."; "-create"; "/Users/" ^ user ; "NFSHomeDirectory"; home_dir ] -(* Used by the FUSE filesystem to indicate where a users home directory should be ...*) +(* Used by the FUSE filesystem to indicate where a users home directory should be …*) let update_scoreboard ~uid ~scoreboard ~home_dir = ["ln"; "-Fhs"; home_dir; scoreboard ^ "/" ^ string_of_int uid] diff --git a/lib/rsync_store.ml b/lib/rsync_store.ml index ba881b1d..0c628b07 100644 --- a/lib/rsync_store.ml +++ b/lib/rsync_store.ml @@ -120,8 +120,13 @@ let delete t id = let result t id = let dir = Path.result t id in match Os.check_dir dir with - | `Present -> Some dir - | `Missing -> None + | `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 t = t.path / Path.state_dirname diff --git a/lib/s.ml b/lib/s.ml index 80c4c6a8..7dbc3213 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -34,9 +34,13 @@ module type STORE = sig val delete : t -> id -> unit Lwt.t (** [delete t id] removes [id] from the store, if present. *) - val result : t -> id -> string option + val result : t -> id -> string option Lwt.t (** [result t id] is the path of the build result for [id], if present. *) + val log_file : t -> id -> string Lwt.t + (** [log_file t id] is the path of the build logs for [id]. The file may + not exist if the build has never been run, or failed. *) + val state_dir : t -> string (** [state_dir] is the path of a directory which can be used to store mutable state related to this store (e.g. an sqlite3 database). *) diff --git a/lib/sandbox.macos.ml b/lib/sandbox.macos.ml index 511efba3..fcc7a264 100644 --- a/lib/sandbox.macos.ml +++ b/lib/sandbox.macos.ml @@ -5,7 +5,7 @@ type t = { uid: int; gid: int; (* Where zfs dynamic libraries are -- can't be in /usr/local/lib - see notes in .mli file under "Various Gotchas"... *) + see notes in .mli file under "Various Gotchas"… *) fallback_library_path : string; (* FUSE file system mount point *) fuse_path : string; @@ -80,7 +80,7 @@ let user_name ~prefix ~uid = let home_directory user = Filename.concat "/Users/" user (* A build step in macos: - - Should be properly sandboxed using sandbox-exec (coming soon...) + - Should be properly sandboxed using sandbox-exec (coming soon…) - Umask g+w to work across users if restored from a snapshot - Set the new home directory of the user to something static and copy in the environment - Should be executed by the underlying user (t.uid) *) @@ -120,7 +120,7 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp = if Lwt.is_sleeping proc then ( match !proc_id with | Some pid -> Macos.kill_all_descendants ~pid - | None -> Log.warn (fun f -> f "Failed to find pid..."); Lwt.return () + | None -> Log.warn (fun f -> f "Failed to find pid…"); Lwt.return () ) else Lwt.return_unit (* Process has already finished *) in diff --git a/lib/zfs_store.ml b/lib/zfs_store.ml index 3baa9a37..69791bbf 100644 --- a/lib/zfs_store.ml +++ b/lib/zfs_store.ml @@ -213,8 +213,16 @@ let build t ?base ~id fn = let result t id = let ds = Dataset.result id in let path = Dataset.path t ds ~snapshot:default_snapshot in - if Sys.file_exists path then Some path - else None + if Sys.file_exists path then Lwt.return_some path + else Lwt.return_none + +let log_file t id = + result t id >|= function + | Some dir -> Filename.concat dir "log" + | None -> + let ds = Dataset.result id in + let clone = Dataset.path t ds in + Filename.concat clone "log" let get_cache t name = match Hashtbl.find_opt t.caches name with diff --git a/lib_spec/docker.mli b/lib_spec/docker.mli index c9dbf908..fe5c485d 100644 --- a/lib_spec/docker.mli +++ b/lib_spec/docker.mli @@ -4,7 +4,7 @@ val dockerfile_of_spec : buildkit:bool -> os:[`Unix | `Windows] -> Spec.t -> str However, note that: - - In "(copy (excludes ...) ...)" the excludes part is ignored. You will need to ensure + - In "(copy (excludes …) …)" the excludes part is ignored. You will need to ensure you have a suitable ".dockerignore" file. - The conversion is not robust against malicious input, as the escaping rules are unclear. diff --git a/lib_spec/spec.ml b/lib_spec/spec.ml index d79e1e21..b3994fd6 100644 --- a/lib_spec/spec.ml +++ b/lib_spec/spec.ml @@ -6,7 +6,7 @@ type sexp = Sexplib.Sexp.t = | Atom of string | List of sexp list -(* Convert fields matched by [p] from (name v1 v2 ...) to (name (v1 v2 ...)) *) +(* Convert fields matched by [p] from (name v1 v2 …) to (name (v1 v2 …)) *) let inflate_record p = let open Sexplib.Sexp in function | Atom _ as x -> Fmt.failwith "Invalid record field: %a" Sexplib.Sexp.pp_hum x @@ -17,7 +17,7 @@ let inflate_record p = in List (List.map expand xs) -(* Convert fields matched by [p] from (name (v1 v2 ...)) to (name v1 v2 ...) *) +(* Convert fields matched by [p] from (name (v1 v2 …)) to (name v1 v2 …) *) let deflate_record p = let open Sexplib.Sexp in function | Atom _ as x -> Fmt.failwith "Invalid record field: %a" Sexplib.Sexp.pp_hum x @@ -111,7 +111,7 @@ type op = [ (* For some ops, we remove the extra () in the sexp string format, formatting them as if they were in-line records. e.g. - (copy ((src ...) (dst ...))) becomes (copy (src ...) (dst ...)). *) + (copy ((src …) (dst …))) becomes (copy (src …) (dst …)). *) let inline = function | "run" | "copy" | "user" | "env" -> true | _ -> false diff --git a/stress.sh b/stress.sh index ad22f229..baa0789b 100755 --- a/stress.sh +++ b/stress.sh @@ -1,12 +1,12 @@ #!/bin/bash set -eu if [ "$#" -lt 1 ]; then - echo "usage: $0 STORE..." + echo "usage: $0 STORE…" echo "e.g. $0 btrfs:/btrfs/stress zfs:stress" exit 1; fi; stores="$*" -echo "Remove everything that depends on busybox..." +echo "Remove everything that depends on busybox…" for store in $stores; do echo Clean $store dune exec -- obuilder delete 9d75f0d7c398df565d7ac04c6819b62d6d8f9560f5eb4672596ecd8f7e96ae91 --store=$store diff --git a/stress/stress.ml b/stress/stress.ml index 78317859..d19d5d4e 100644 --- a/stress/stress.ml +++ b/stress/stress.ml @@ -20,21 +20,22 @@ module Fetcher = Docker module Test(Store : S.STORE) = struct let assert_output expected t id = - match Store.result t id with + Store.result t id >>= function | None -> Fmt.failwith "%S not in store!" id | Some path -> let ch = open_in (path / "output") in let data = really_input_string ch (in_channel_length ch) in close_in ch; - assert_str expected data + assert_str expected data; + Lwt.return_unit let test_store t = - assert (Store.result t "unknown" = None); + Store.result t "unknown" >>= fun r -> assert (r = None); (* Build without a base *) Store.delete t "base" >>= fun () -> Store.build t ~id:"base" (fun tmpdir -> write ~path:(tmpdir / "output") "ok" >|= Result.ok) >>= fun r -> assert (r = Ok ()); - assert_output "ok" t "base"; + assert_output "ok" t "base" >>= fun () -> (* Build with a base *) Store.delete t "sub" >>= fun () -> Store.build t ~base:"base" ~id:"sub" (fun tmpdir -> @@ -42,16 +43,16 @@ module Test(Store : S.STORE) = struct write ~path:(tmpdir / "output") (orig ^ "+") >|= Result.ok ) >>= fun r -> assert (r = Ok ()); - assert_output "ok+" t "sub"; + assert_output "ok+" t "sub" >>= fun () -> (* Test deletion *) - assert (Store.result t "sub" <> None); + Store.result t "sub" >>= fun r -> assert (r <> None); Store.delete t "sub" >>= fun () -> - assert (Store.result t "sub" = None); + Store.result t "sub" >>= fun r -> assert (r = None); (* A failing build isn't saved *) Store.delete t "fail" >>= fun () -> Store.build t ~id:"fail" (fun _tmpdir -> Lwt_result.fail `Failed) >>= fun r -> assert (r = Error `Failed); - assert (Store.result t "fail" = None); + Store.result t "fail" >>= fun r -> assert (r = None); Lwt.return_unit let test_cache t = @@ -200,7 +201,7 @@ module Test(Store : S.STORE) = struct let log id = Logs.info (fun f -> f "Deleting %S" id) in let end_time = Unix.(gettimeofday () +. 60.0 |> gmtime) in let rec aux () = - Fmt.pr "Pruning...@."; + Fmt.pr "Pruning…@."; Build.prune ~log builder ~before:end_time 1000 >>= function | 0 -> Lwt.return_unit | _ -> aux () diff --git a/test/mock_exec.ml b/test/mock_exec.ml index 2df7ad9e..76f7c3f7 100644 --- a/test/mock_exec.ml +++ b/test/mock_exec.ml @@ -6,11 +6,20 @@ let ( / ) = Filename.concat let strf = Printf.sprintf +let unix_path path = + if Sys.win32 then + Lwt_process.pread ("", [| "cygpath"; "-u"; path|]) >|= fun str -> String.trim str + else + Lwt.return path + let next_container_id = ref 0 let base_tar = let mydir = Sys.getcwd () in - Lwt_main.run (Lwt_io.(with_file ~mode:input) (mydir / "base.tar") Lwt_io.read) + Lwt_main.run begin + let base_tar = mydir / "base.tar" in + Lwt_io.(with_file ~mode:input) base_tar Lwt_io.read + end |> Bytes.of_string let with_fd x f = @@ -80,9 +89,14 @@ let exec ?cwd ?stdin ?stdout ?stderr ~pp cmd = Fmt.pr "exec: %a@." Fmt.(Dump.array string) argv; begin match Array.to_list argv with | "docker" :: args -> exec_docker ?stdout args - | "sudo" :: "--" :: ("tar" :: _ as tar) -> Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar) - | "sudo" :: "--" :: "mkdir" :: args - | "mkdir" :: args -> mkdir args + | "sudo" :: "--" :: ("tar" :: _ as tar) when not Os.running_as_root -> + Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar) + | "tar" :: "-C" :: path :: opts when Os.running_as_root -> + unix_path path >>= fun path -> + let tar = (if Sys.win32 then "C:\\cygwin64\\bin\\tar.exe" else "tar") :: "-C" :: path :: opts in + Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar) + | "mkdir" :: args when Os.running_as_root -> mkdir args + | "sudo" :: "--" :: "mkdir" :: args when not Os.running_as_root -> mkdir args | x -> Fmt.failwith "Unknown mock command %a" Fmt.(Dump.list string) x end | (x, _) -> Fmt.failwith "Unexpected absolute path: %S" x diff --git a/test/mock_store.ml b/test/mock_store.ml index 7863d7a5..9775543f 100644 --- a/test/mock_store.ml +++ b/test/mock_store.ml @@ -10,6 +10,12 @@ type t = { mutable builds : int; } +let unix_path path = + if Sys.win32 then + Lwt_process.pread ("", [| "cygpath"; "-u"; path|]) >|= fun str -> String.trim str + else + Lwt.return path + let delay_store = ref Lwt.return_unit let rec waitpid_non_intr pid = @@ -34,7 +40,8 @@ let build t ?base ~id fn = begin match base with | None -> Os.ensure_dir tmp_dir; Lwt.return_unit | Some base -> - Lwt_process.exec ("", [| "cp"; "-r"; t.dir / base; tmp_dir |]) >>= function + Lwt.both (unix_path (t.dir / base)) (unix_path tmp_dir) >>= fun (src, dst) -> + Lwt_process.exec ("", [| "cp"; "-r"; src; dst |]) >>= function | Unix.WEXITED 0 -> Lwt.return_unit | _ -> failwith "cp failed!" end >>= fun () -> @@ -45,6 +52,7 @@ let build t ?base ~id fn = Unix.rename tmp_dir dir; Lwt_result.return () | Error _ as e -> + unix_path tmp_dir >>= fun tmp_dir -> rm_r tmp_dir; Lwt.return e ) @@ -61,8 +69,11 @@ let path t id = t.dir / id let result t id = let dir = path t id in match Os.check_dir dir with - | `Present -> Some dir - | `Missing -> None + | `Present -> Lwt.return_some dir + | `Missing -> Lwt.return_none + +let log_file t id = + Lwt.return (t.dir / "logs" / (id ^ ".log")) let rec finish t = if t.builds > 0 then ( @@ -75,12 +86,13 @@ let with_store fn = Lwt_io.with_temp_dir ~prefix:"mock-store-" @@ fun dir -> let t = { dir; cond = Lwt_condition.create (); builds = 0 } in Obuilder.Os.ensure_dir (state_dir t); + Obuilder.Os.ensure_dir (t.dir / "logs"); Lwt.finalize (fun () -> fn t) (fun () -> finish t) let delete t id = - match result t id with + result t id >>= function | Some path -> rm_r path; Lwt.return_unit | None -> Lwt.return_unit diff --git a/test/test.ml b/test/test.ml index 8eec88dc..697c9a1c 100644 --- a/test/test.ml +++ b/test/test.ml @@ -5,6 +5,8 @@ module B = Builder(Mock_store)(Mock_sandbox)(Docker) let ( / ) = Filename.concat let ( >>!= ) = Lwt_result.bind +let sprintf = Printf.sprintf +let root = if Sys.win32 then "C:/" else "/" let () = Logs.(set_level ~all:true (Some Info)); @@ -31,12 +33,22 @@ let with_config fn = Os.ensure_dir src_dir; fn ~src_dir ~store ~sandbox ~builder +let with_default_exec fn = + Lwt.finalize (fun () -> + Os.lwt_process_exec := Os.default_exec; + fn ()) + (fun () -> Os.lwt_process_exec := Mock_exec.exec; Lwt.return_unit) + +let with_file path flags perms fn = + Lwt_unix.openfile path flags perms >>= fun fd -> + Lwt.finalize (fun () -> fn fd) (fun () -> Lwt_unix.close fd) + let mock_op ?(result=Lwt_result.return ()) ?(delay_store=Lwt.return_unit) ?cancel ?output () = fun ~cancelled ?stdin:_ ~log (config:Obuilder.Config.t) dir -> Mock_store.delay_store := delay_store; let cmd = match config.argv with - | ["/bin/bash"; "-c"; cmd] -> cmd + | ["/bin/bash"; "-c"; cmd] | ["cmd"; "/S"; "/C"; cmd] -> cmd | x -> Fmt.str "%a" Fmt.(Dump.list string) x in Build_log.printf log "%s@." cmd >>= fun () -> @@ -65,23 +77,23 @@ let test_simple _switch () = B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> saved as .* - /: (run (shell Append)) + %s: (run (shell Append)) Append ;---> saved as .* - |} log; + |} root) log; (* Check result is cached *) Log.clear log; B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result cached" (Ok "base-distro\nrunner") result; Log.check "Check cached log" - {|(from base) + (sprintf {|(from base) ;---> using .* from cache - /: (run (shell Append)) + %s: (run (shell Append)) Append ;---> using .* from cache - |} log; + |} root) log; Lwt.return_unit let test_prune _switch () = @@ -94,12 +106,12 @@ let test_prune _switch () = B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> saved as .* - /: (run (shell Append)) + %s: (run (shell Append)) Append ;---> saved as .* - |} log; + |} root) log; let log id = Logs.info (fun f -> f "Deleting %S" id) in B.prune ~log builder ~before:start 10 >>= fun n -> Alcotest.(check int) "Nothing before start time" 0 n; @@ -123,35 +135,35 @@ let test_concurrent _switch () = Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ()); Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ()); let b1 = B.build builder context1 spec1 in - Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> let b2 = B.build builder context2 spec2 in - Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> Lwt.wakeup a_done (Ok ()); b1 >>!= get store "output" >>= fun b1 -> b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "Final result" (Ok "AB") b1; Alcotest.(check build_result) "Final result" (Ok "AC") b2; Log.check "Check AB log" - {| (from base) + (sprintf {| (from base) ;---> saved as .* - /: (run (shell A)) + %s: (run (shell A)) A ;---> saved as .* - /: (run (shell B)) + %s: (run (shell B)) B ;---> saved as .* - |} + |} root root) log1; Log.check "Check AC log" - {| (from base) + (sprintf {| (from base) ;---> using .* from cache - /: (run (shell A)) + %s: (run (shell A)) A ;---> saved as .* - /: (run (shell C)) + %s: (run (shell C)) C ;---> saved as .* - |} + |} root root) log2; Lwt.return () @@ -167,27 +179,27 @@ let test_concurrent_failure _switch () = let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:a ()); let b1 = B.build builder context1 spec1 in - Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> let b2 = B.build builder context2 spec2 in - Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> Lwt.wakeup a_done (Error (`Msg "Mock build failure")); b1 >>!= get store "output" >>= fun b1 -> b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1; Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2; Log.check "Check AB log" - {| (from base) + (sprintf {| (from base) ;---> saved as .* - /: (run (shell A)) + %s: (run (shell A)) A - |} + |} root) log1; Log.check "Check AC log" - {| (from base) + (sprintf {| (from base) ;---> using .* from cache - /: (run (shell A)) + %s: (run (shell A)) A - |} + |} root) log2; Lwt.return () @@ -204,27 +216,27 @@ let test_concurrent_failure_2 _switch () = let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:(Lwt_result.fail (`Msg "Mock build failure")) ~delay_store:a ()); let b1 = B.build builder context1 spec1 in - Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> let b2 = B.build builder context2 spec2 in - Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell A))\nA\n" root) >>= fun () -> Lwt.wakeup a_done (); b1 >>!= get store "output" >>= fun b1 -> b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1; Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2; Log.check "Check AB log" - {| (from base) + (sprintf {| (from base) ;---> saved as .* - /: (run (shell A)) + %s: (run (shell A)) A - |} + |} root) log1; Log.check "Check AC log" - {| (from base) + (sprintf {| (from base) ;---> using .* from cache - /: (run (shell A)) + %s: (run (shell A)) A - |} + |} root) log2; Lwt.return () @@ -237,16 +249,16 @@ let test_cancel _switch () = let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let b = B.build builder context spec in - Log.await log "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt_switch.turn_off switch >>= fun () -> b >>= fun result -> Alcotest.(check build_result) "Final result" (Error `Cancelled) result; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> saved as .* - /: (run (shell Wait)) + %s: (run (shell Wait)) Wait - |} log; + |} root) log; Lwt.return_unit (* Two users are sharing a build. One cancels. *) @@ -262,28 +274,28 @@ let test_cancel_2 _switch () = let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in let b1 = B.build builder context1 spec in - Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> let b2 = B.build builder context2 spec in - Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> saved as .* - /: (run (shell Wait)) + %s: (run (shell Wait)) Wait - |} log1; + |} root) log1; Lwt.wakeup set_r (Ok ()); b2 >>!= get store "output" >>= fun result2 -> Alcotest.(check build_result) "Final result" (Ok "ok") result2; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> using .* from cache - /: (run (shell Wait)) + %s: (run (shell Wait)) Wait ;---> saved as .* - |} log2; + |} root) log2; Lwt.return_unit (* Two users are sharing a build. Both cancel. *) @@ -299,27 +311,27 @@ let test_cancel_3 _switch () = let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in let b1 = B.build builder context1 spec in - Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> let b2 = B.build builder context2 spec in - Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> saved as .* - /: (run (shell Wait)) + %s: (run (shell Wait)) Wait - |} log1; + |} root) log1; Lwt_switch.turn_off switch2 >>= fun () -> b2 >>!= get store "output" >>= fun result2 -> Alcotest.(check build_result) "User 2 result" (Error `Cancelled) result2; Log.check "Check log" - {|(from base) + (sprintf {|(from base) ;---> using .* from cache - /: (run (shell Wait)) + %s: (run (shell Wait)) Wait - |} log2; + |} root) log2; r >>= fun r -> let r = Result.map (fun () -> "-") r in Alcotest.(check build_result) "Build cancelled" (Error `Cancelled) r; @@ -338,13 +350,13 @@ let test_cancel_4 _switch () = let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in let b1 = B.build builder context1 spec in - Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt.wakeup set_r (Error (`Msg "Build failed")); (* Begin a new build. *) let r2, set_r2 = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r2 ~cancel:set_r2 ~output:(`Constant "ok") ()); let b2 = B.build builder context2 spec in - Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> (* Cancel the original build. *) Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> @@ -354,7 +366,7 @@ let test_cancel_4 _switch () = let switch3 = Lwt_switch.create () in let context3 = Context.v ~switch:switch3 ~src_dir ~log:(Log.add log3) () in let b3 = B.build builder context3 spec in - Log.await log3 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log3 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt.wakeup set_r2 (Ok ()); b2 >>!= get store "output" >>= fun result2 -> Alcotest.(check build_result) "User 2 result" (Ok "ok") result2; @@ -373,7 +385,7 @@ let test_cancel_5 _switch () = let switch1 = Lwt_switch.create () in let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in let b1 = B.build builder context1 spec in - Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () -> + Log.await log1 (sprintf "(from base)\n%s: (run (shell Wait))\nWait\n" root) >>= fun () -> Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1; @@ -383,7 +395,7 @@ let test_cancel_5 _switch () = let switch2 = Lwt_switch.create () in let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in let b2 = B.build builder context2 spec in - Log.await log2 "(from base)\n/: (run (shell Wait))\n" >>= fun () -> + Log.await log2 (sprintf "(from base)\n%s: (run (shell Wait))\n" root) >>= fun () -> Lwt.wakeup set_delay (); b2 >>!= get store "output" >>= fun result1 -> Alcotest.(check build_result) "User 2 result" (Ok "ok") result1; @@ -419,16 +431,17 @@ let test_delete _switch () = let test_tar_long_filename _switch () = let do_test length = - Logs.info (fun m -> m "Test copy length %d " length); + Logs.info (fun f -> f "Test copy length %d " length); Lwt_io.with_temp_dir ~prefix:"test-copy-src-" @@ fun src_dir -> Lwt_io.with_temp_dir ~prefix:"test-copy-dst-" @@ fun dst_dir -> - let filename = String.make length 'a' in + let filename = src_dir / String.make length 'a' in + Logs.info (fun f -> f "length: %d %s" (String.length filename) filename); Lwt_io.(with_file ~mode:output) - (src_dir / filename) + filename (fun ch -> Lwt_io.write ch "file-data") >>= fun () -> - Lwt_unix.openfile (dst_dir / "out.tar") [Lwt_unix.O_WRONLY; Lwt_unix.O_CREAT] 0 - >>= fun to_untar -> + with_file (dst_dir / "out.tar") Lwt_unix.[O_WRONLY; O_CREAT; O_CLOEXEC] 0 + @@ fun to_untar -> let src_manifest = Manifest.generate ~exclude:[] ~src_dir "." |> Result.get_ok in let user = Spec.(`Unix { uid=1000; gid=1000 }) in Tar_transfer.send_file @@ -440,7 +453,8 @@ let test_tar_long_filename _switch () = in do_test 80 >>= fun () -> do_test 160 >>= fun () -> - do_test 240 + (* Maximum path length on Windows is 260 characters. *) + do_test (260 - 1 (* NUL *) - String.length {|C:\cygwin64\tmp\build_123456_dune\test-copy-src-123456\|}) let sexp = Alcotest.of_pp Sexplib.Sexp.pp_hum @@ -644,48 +658,53 @@ let manifest = (Alcotest.of_pp (fun f (`Msg m) -> Fmt.string f m)) (* Test copy step. *) -let test_copy _switch () = - Lwt_io.with_temp_dir ~prefix:"test-copy-" @@ fun src_dir -> +let test_copy generate = + Lwt_io.with_temp_dir ~prefix:"test-copy-bash-" @@ fun src_dir -> Lwt_io.(with_file ~mode:output) (src_dir / "file") (fun ch -> Lwt_io.write ch "file-data") >>= fun () -> + let root = if Sys.unix then "/root" else "C:/Windows" in (* Files *) let f1hash = Sha256.string "file-data" in - Alcotest.(check manifest) "File" (Ok (`File ("file", f1hash))) - @@ Manifest.generate ~exclude:[] ~src_dir "file"; - Alcotest.(check manifest) "File" (Ok (`File ("file", f1hash))) - @@ Manifest.generate ~exclude:[] ~src_dir "./file"; - Alcotest.(check manifest) "File" (Ok (`File ("file", f1hash))) - @@ Manifest.generate ~exclude:[] ~src_dir "/file"; - Alcotest.(check manifest) "Missing" (Error (`Msg {|Source path "file2" not found|})) - @@ Manifest.generate ~exclude:[] ~src_dir "file2"; - Alcotest.(check manifest) "Not dir" (Error (`Msg {|Not a directory: file (in "file/file2")|})) - @@ Manifest.generate ~exclude:[] ~src_dir "file/file2"; - Alcotest.(check manifest) "Parent" (Error (`Msg {|Can't use .. in source paths! (in "../file")|})) - @@ Manifest.generate ~exclude:[] ~src_dir "../file"; + generate ~exclude:[] ~src_dir "file" >>= fun r -> + Alcotest.(check manifest) "File" (Ok (`File ("file", f1hash))) r; + generate ~exclude:[] ~src_dir "./file" >>= fun r -> + Alcotest.(check manifest) "File relative" (Ok (`File ("file", f1hash))) r; + generate ~exclude:[] ~src_dir "/file" >>= fun r -> + Alcotest.(check manifest) "File absolute" (Ok (`File ("file", f1hash))) r; + generate ~exclude:[] ~src_dir "file2" >>= fun r -> + Alcotest.(check manifest) "Missing" (Error (`Msg {|Source path "file2" not found|})) r; + generate ~exclude:[] ~src_dir "file/file2" >>= fun r -> + Alcotest.(check manifest) "Not dir" (Error (`Msg {|Not a directory: file (in "file/file2")|})) r; + generate ~exclude:[] ~src_dir "../file" >>= fun r -> + Alcotest.(check manifest) "Parent" (Error (`Msg {|Can't use .. in source paths! (in "../file")|})) r; (* Symlinks *) - Unix.symlink "/root" (src_dir / "link"); - Alcotest.(check manifest) "Link" (Ok (`Symlink (("link", "/root")))) - @@ Manifest.generate ~exclude:[] ~src_dir "link"; - Alcotest.(check manifest) "Follow link" (Error (`Msg {|Not a regular file: link (in "link/file")|})) - @@ Manifest.generate ~exclude:[] ~src_dir "link/file"; + Unix.symlink ~to_dir:true root (src_dir / "link"); + generate ~exclude:[] ~src_dir "link" >>= fun r -> + Alcotest.(check manifest) "Link" (Ok (`Symlink (("link", root)))) r; + generate ~exclude:[] ~src_dir "link/file" >>= fun r -> + Alcotest.(check manifest) "Follow link" (Error (`Msg {|Not a regular file: link (in "link/file")|})) r; (* Directories *) + generate ~exclude:["file"] ~src_dir "" >>= fun r -> Alcotest.(check manifest) "Tree" - (Ok (`Dir ("", [`Symlink ("link", "/root")]))) - @@ Manifest.generate ~exclude:["file"] ~src_dir ""; + (Ok (`Dir ("", [`Symlink ("link", root)]))) r; + generate ~exclude:[] ~src_dir "." >>= fun r -> Alcotest.(check manifest) "Tree" (Ok (`Dir ("", [`File ("file", f1hash); - `Symlink ("link", "/root")]))) - @@ Manifest.generate ~exclude:[] ~src_dir "."; + `Symlink ("link", root)]))) r; Unix.mkdir (src_dir / "dir1") 0o700; Unix.mkdir (src_dir / "dir1" / "dir2") 0o700; Lwt_io.(with_file ~mode:output) (src_dir / "dir1" / "dir2" / "file2") (fun ch -> Lwt_io.write ch "file2") >>= fun () -> let f2hash = Sha256.string "file2" in - Alcotest.(check manifest) "Nested file" (Ok (`File ("dir1/dir2/file2", f2hash))) - @@ Manifest.generate ~exclude:[] ~src_dir "dir1/dir2/file2"; + generate ~exclude:[] ~src_dir "dir1/dir2/file2" >>= fun r -> + Alcotest.(check manifest) "Nested file" (Ok (`File ("dir1/dir2/file2", f2hash))) r; + generate ~exclude:[] ~src_dir "dir1" >>= fun r -> Alcotest.(check manifest) "Tree" - (Ok (`Dir ("dir1", [`Dir ("dir1/dir2", [`File ("dir1/dir2/file2", f2hash)])]))) - @@ Manifest.generate ~exclude:[] ~src_dir "dir1"; + (Ok (`Dir ("dir1", [`Dir ("dir1/dir2", [`File ("dir1/dir2/file2", f2hash)])]))) r; Lwt.return_unit +(* Test the Manifest module. *) +let test_copy_ocaml _switch () = + test_copy (fun ~exclude ~src_dir src -> Lwt_result.lift (Manifest.generate ~exclude ~src_dir src)) + let test_cache_id () = let check expected id = Alcotest.(check string) ("ID-" ^ id) expected (Escape.cache id) @@ -719,44 +738,44 @@ let test_secrets_simple _switch () = B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; Log.check "Check b log" - {| (from base) - ;---> saved as .* - /: (run (secrets (test (target /testsecret)) (test2 (target /run/secrets/test2))) - ........(shell Append)) + (sprintf {| (from base) + ;---> saved as ".*" + %s: (run (secrets (test (target /testsecret)) (test2 (target /run/secrets/test2))) + [ ]+(shell Append)) Append - ;---> saved as .* - |} + ;---> saved as ".*" + |} root) log; Lwt.return_unit let test_exec_nul _switch () = - Os.lwt_process_exec := Os.default_exec; + with_default_exec @@ fun () -> let args = ["dummy"; "stdout"] in Os.exec ~stdout:`Dev_null ~stderr:`Dev_null args >>= fun actual -> Alcotest.(check unit) "stdout" actual (); let args = ["dummy"; "stderr"] in Os.exec ~stdout:`Dev_null ~stderr:`Dev_null args >|= fun actual -> - Alcotest.(check unit) "stderr" actual (); - Os.lwt_process_exec := Mock_exec.exec + Alcotest.(check unit) "stderr" actual () let test_pread_nul _switch () = - Os.lwt_process_exec := Os.default_exec; + with_default_exec @@ fun () -> let expected = "the quick brown fox jumps over the lazy dog" in let args = ["dummy"; "stdout"] in Os.pread ~stderr:`Dev_null args >|= fun actual -> - Alcotest.(check string) "stdout" actual expected; - Os.lwt_process_exec := Mock_exec.exec + Alcotest.(check string) "stdout" actual expected let () = let open Alcotest_lwt in - Lwt_main.run begin - run "OBuilder" [ - "spec", [ - test_case_sync "Sexp" `Quick test_sexp; - test_case_sync "Cache ID" `Quick test_cache_id; - test_case_sync "Docker UNIX" `Quick test_docker_unix; - test_case_sync "Docker Windows" `Quick test_docker_windows; - ]; + let test_case name speed f = + let wrap switch () = + let s = 10.0 in + let timeout = Lwt_unix.sleep s >|= fun () -> + Alcotest.(check reject (sprintf "timeout %fs" s) () ()) in + Lwt.pick ([f switch (); timeout]) + in + test_case name speed wrap + in + let needs_docker = [ "build", [ test_case "Simple" `Quick test_simple; test_case "Prune" `Quick test_prune; @@ -774,15 +793,30 @@ let () = test_case "Simple" `Quick test_secrets_simple; test_case "No secret provided" `Quick test_secrets_not_provided; ]; + ] in + let is_win32_gha = + match Sys.getenv "CI", Sys.getenv "GITHUB_ACTIONS", Sys.win32 with + | "true", "true", true -> true + | _ | exception _ -> false in + Lwt_main.run begin + let manifest = + if not Sys.win32 then [test_case "Copy using Manifest" `Quick test_copy_ocaml] + else [] + in + run "OBuilder" ([ + "spec", [ + test_case_sync "Sexp" `Quick test_sexp; + test_case_sync "Cache ID" `Quick test_cache_id; + test_case_sync "Docker Windows" `Quick test_docker_windows; + test_case_sync "Docker UNIX" `Quick test_docker_unix; + ]; "tar_transfer", [ test_case "Long filename" `Quick test_tar_long_filename; ]; - "manifest", [ - test_case "Copy" `Quick test_copy; - ]; + "manifest", manifest; "process", [ test_case "Execute a process" `Quick test_exec_nul; test_case "Read stdout of a process" `Quick test_pread_nul; ]; - ] + ] @ (if not is_win32_gha then needs_docker else [])) end