diff --git a/ci/src/cI_git.ml b/ci/src/cI_git.ml index b6cc0ab83..82a171d15 100644 --- a/ci/src/cI_git.ml +++ b/ci/src/cI_git.ml @@ -96,10 +96,11 @@ module Builder = struct let hash = Key.hash key in Printf.sprintf "git-pull-of-%s" hash - let generate t ~switch ~log _trans NoContext pr = + let generate t ~switch ~log _trans NoContext target = let output = CI_live_log.write log in - let hash = Key.hash pr in - let tmp_branch = branch t pr in + let hash = Key.hash target in + let tmp_branch = branch t target in + let tmp_tag = Printf.sprintf "%s.new" tmp_branch in let env = Unix.environment () |> with_gitdir (Filename.concat t.dir ".git") in (* First, see if we've already got this commit. *) Lwt.try_bind @@ -116,11 +117,14 @@ module Builder = struct CI_live_log.log log "Fetching PR branch"; (* We can't be sure the PR's head still exists, but we can fetch the current head and then try to switch to the one we want. *) + (* We fetch to a tag rather than a branch in case the target is a tag object. *) (* Three step process to ensure we don't end up pointing at the wrong commit *) - CI_process.run ~switch ~env ~output ("", [| "git"; "fetch"; "origin"; Printf.sprintf "%s:%s.new" (Key.branch pr) tmp_branch |]) >>= fun () -> + let cmd = [| "git"; "fetch"; "origin"; + Printf.sprintf "%s:tags/%s" (Key.branch target) tmp_tag |] in + CI_process.run ~switch ~env ~output ("", cmd) >>= fun () -> Lwt_mutex.with_lock git_lock @@ fun () -> (* (hopefully fetch can handle parallel uses) *) CI_process.run ~env ~output ("", [| "git"; "branch"; "-f"; tmp_branch; hash |]) >>= fun () -> - CI_process.run ~env ~output ("", [| "git"; "branch"; "-D"; tmp_branch ^ ".new" |]) >>= fun () -> + CI_process.run ~env ~output ("", [| "git"; "tag"; "-d"; tmp_tag |]) >>= fun () -> Lwt.return @@ Ok { Commit.repo = t; hash } ) end diff --git a/ci/src/cI_process.ml b/ci/src/cI_process.ml index 9b25a37a6..f8dc34ab6 100644 --- a/ci/src/cI_process.ml +++ b/ci/src/cI_process.ml @@ -2,6 +2,9 @@ open! Astring open CI_utils open Lwt.Infix +let child_src = Logs.Src.create "datakit-ci.child" ~doc:"Output from child process" +module Child = (val Logs.src_log child_src : Logs.LOG) + let pp_args = let sep = Fmt.(const string) " " in Fmt.array ~sep String.dump @@ -69,6 +72,7 @@ let run_with_exit_status ?switch ?log ?cwd ?env ~output ?log_cmd cmd = Lwt.return `Eof | data -> output data; + Child.debug (fun f -> f "%S" data); (* Hack because child#terminate may not kill sub-children. Hopefully closing stdout will encourage them to exit. *) Lwt_switch.check switch; diff --git a/ci/tests/test_ci.ml b/ci/tests/test_ci.ml index dc6fb893d..f473d9571 100644 --- a/ci/tests/test_ci.ml +++ b/ci/tests/test_ci.ml @@ -37,6 +37,10 @@ module Workflows = struct let pass check_build _target = T.of_lwt_slow (check_build "pass") + + let fetch_only ~local_repo check_build t = + Git.fetch_head local_repo t >>= fun _ -> + T.of_lwt_slow (check_build "a") end open Lwt.Infix @@ -319,56 +323,30 @@ let test_pending_updates conn = | { result = Ok 1; _ } -> Lwt.return () | _ -> Alcotest.fail "Expected success" -let test_git_dir conn ~clone = - let logs = Private.create_logs () in - let run args = Process.run ~output:print_string ("", Array.of_list args) in +let run args = Process.run ~output:print_string ("", Array.of_list args) + +let with_git_remote fn = let ( / ) = Filename.concat in let old_cwd = Sys.getcwd () in - let cmd = - if clone then Workflows.ls_clone ~logs - else Workflows.ls ~logs - in Lwt.finalize (fun () -> Utils.with_tmpdir (fun tmpdir -> (* Set up the "remote" Git repository *) Sys.chdir tmpdir; - run ["git"; "init"; "my-repo"] >>= fun () -> - Sys.chdir "my-repo"; + let remote_dir = tmpdir / "my-repo" in + run ["git"; "init"; remote_dir] >>= fun () -> + Sys.chdir remote_dir; + (* Add a test file *) Lwt_io.with_file ~mode:Lwt_io.output "src" (fun ch -> Lwt_io.write ch "Test" ) >>= fun () -> - (* Add a test file *) run ["git"; "add"; "src"] >>= fun () -> run ["git"; "commit"; "-m"; "Initial commit"] >>= fun () -> - Lwt_process.pread_line ("", [| "git"; "rev-parse"; "HEAD" |]) >>= fun hash -> (* Clone a "local" copy *) - run ["git"; "clone"; tmpdir / "my-repo"; tmpdir / "clone"] >>= fun () -> - let local_repo = Git.v ~logs ~dir:(tmpdir / "clone") in - (* Start the CI *) - Test_utils.with_ci conn (Workflows.pull_and_run local_repo ~cmd) @@ fun ~logs ~switch dk with_handler -> - DK.branch dk "github-metadata" >>*= fun hooks -> - let wait_for ~commit path = Test_utils.wait_for_file ~switch hooks (Printf.sprintf "user/project/commit/%s/status/%s" commit path) in - (* Create a pull request *) - with_handler ~logs "a" (fun ~switch:_ _log -> - Test_utils.update_pr hooks ~message:"Init" ~id:1 ~head:hash ~states:[] >>= fun () -> - wait_for ~commit:hash "ci/datakit/test/state" "pending" >>= fun () -> - Lwt.return (Ok "Success!") - ) - >>= fun () -> - wait_for ~commit:hash "ci/datakit/test/state" ~old:"pending" "success" >>= fun () -> - DK.branch dk (Printf.sprintf "shell-of-ls-on-%s" hash) >>*= fun results -> - DK.Branch.head results >>*= function - | None -> Alcotest.fail "Missing results branch!" - | Some head -> - let tree = DK.Commit.tree head in - DK.Tree.read_file tree (Datakit_path.of_string_exn "log") >>*= fun log -> - let log = Cstruct.to_string log in - if not (String.is_infix ~affix:"Running \"ls\"...\nsrc" log) then - Alcotest.fail "Missing 'src' in log output" - else - Lwt.return () + let local_clone = tmpdir / "clone" in + run ["git"; "clone"; tmpdir / "my-repo"; local_clone] >>= fun () -> + fn ~remote_dir ~local_clone ) ) (fun () -> @@ -376,6 +354,62 @@ let test_git_dir conn ~clone = Lwt.return () ) +let test_git_dir conn ~clone = + let logs = Private.create_logs () in + let cmd = + if clone then Workflows.ls_clone ~logs + else Workflows.ls ~logs + in + with_git_remote @@ fun ~remote_dir ~local_clone -> + Sys.chdir remote_dir; + Lwt_process.pread_line ("", [| "git"; "rev-parse"; "HEAD" |]) >>= fun hash -> + let local_repo = Git.v ~logs ~dir:local_clone in + (* Start the CI *) + Test_utils.with_ci conn (Workflows.pull_and_run local_repo ~cmd) @@ fun ~logs ~switch dk with_handler -> + DK.branch dk "github-metadata" >>*= fun hooks -> + let wait_for ~commit path = Test_utils.wait_for_file ~switch hooks (Printf.sprintf "user/project/commit/%s/status/%s" commit path) in + (* Create a pull request *) + with_handler ~logs "a" (fun ~switch:_ _log -> + Test_utils.update_pr hooks ~message:"Init" ~id:1 ~head:hash ~states:[] >>= fun () -> + wait_for ~commit:hash "ci/datakit/test/state" "pending" >>= fun () -> + Lwt.return (Ok "Success!") + ) + >>= fun () -> + wait_for ~commit:hash "ci/datakit/test/state" ~old:"pending" "success" >>= fun () -> + DK.branch dk (Printf.sprintf "shell-of-ls-on-%s" hash) >>*= fun results -> + DK.Branch.head results >>*= function + | None -> Alcotest.fail "Missing results branch!" + | Some head -> + let tree = DK.Commit.tree head in + DK.Tree.read_file tree (Datakit_path.of_string_exn "log") >>*= fun log -> + let log = Cstruct.to_string log in + if not (String.is_infix ~affix:"Running \"ls\"...\nsrc" log) then + Alcotest.fail "Missing 'src' in log output" + else + Lwt.return () + +let test_git_tag conn = + let logs = Private.create_logs () in + with_git_remote @@ fun ~remote_dir ~local_clone -> + let local_repo = Git.v ~logs ~dir:local_clone in + (* Start the CI *) + Test_utils.with_ci conn Workflows.(fetch_only ~local_repo) @@ fun ~logs ~switch dk with_handler -> + DK.branch dk "github-metadata" >>*= fun hooks -> + let wait_for ~commit path = Test_utils.wait_for_file ~switch hooks (Printf.sprintf "user/project/commit/%s/status/%s" commit path) in + (* Create a tag *) + Sys.chdir remote_dir; + run ["git"; "commit"; "--allow-empty"; "-m"; "Release 0.1"] >>= fun () -> + Lwt_process.pread_line ("", [| "git"; "rev-parse"; "HEAD" |]) >>= fun hash -> + run ["git"; "tag"; "-a"; "-m"; "Release 0.1"; "v0.1"; hash] >>= fun () -> + with_handler ~logs "a" (fun ~switch:_ _log -> + Test_utils.update_ref hooks ~message:"Tag" ~id:"v0.1" ~head:hash ~states:[] >>= fun () -> + wait_for ~commit:hash "ci/datakit/test/state" "pending" >>= fun () -> + Lwt.return (Ok "Success") + ) + >>= fun () -> + wait_for ~old:"pending" ~commit:hash "ci/datakit/test/state" "success" >>= fun () -> + Lwt.return () + let test_cross_project conn = Test_utils.with_ci conn Workflows.test_cross_project @@ fun ~logs ~switch dk _with_handler -> ignore logs; @@ -492,6 +526,7 @@ let test_set = [ "Test pending", `Quick, Test_utils.run test_pending_updates; "Git", `Quick, Test_utils.run (test_git_dir ~clone:false); "Git (clone)", `Quick, Test_utils.run (test_git_dir ~clone:true); + "Git tag", `Quick, Test_utils.run test_git_tag; "Cross-project", `Quick, Test_utils.run test_cross_project; "Auth", `Quick, test_auth; "Roles", `Quick, Test_utils.run_private test_roles; diff --git a/ci/tests/test_utils.ml b/ci/tests/test_utils.ml index c7a310a03..ba116b6a3 100644 --- a/ci/tests/test_utils.ml +++ b/ci/tests/test_utils.ml @@ -53,6 +53,7 @@ let () = CI_log_reporter.init None (Some Logs.Info); Logs.Src.list () |> List.iter (fun src -> match Logs.Src.name src with + | "datakit-ci.child" -> Logs.Src.set_level src (Some Logs.Debug) | "datakit-ci" -> Logs.Src.set_level src (Some Logs.Debug) | "dkt-github" -> Logs.Src.set_level src (Some Logs.Debug) | "Client9p" -> Logs.Src.set_level src (Some Logs.Info) @@ -173,6 +174,13 @@ let assert_file branch path value = Alcotest.(check string) (Printf.sprintf "%s=%s" path value) value data; Lwt.return () +let update_ref hooks ~id ~head ~states ~message = + update hooks ~message ( + (Printf.sprintf "user/project/ref/%s/head" id, head) :: + (Printf.sprintf "user/project/ref/%s/state" id, "open") :: + List.map (fun (path, data) -> Printf.sprintf "user/project/commit/%s/status/%s" head path, data) states + ) + let update_pr hooks ~id ~head ~states ~message = update hooks ~message ( (Printf.sprintf "user/project/pr/%d/head" id, head) ::