Source file `clone.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
open Lwt.Infix

type t = No_context

let ( >>!= ) = Lwt_result.bind

module Key = struct
  type t = {
    repo : string;  (* Remote repository from which to pull. *)
    gref : string;
  } [@@deriving to_yojson]

  let pp f t = Yojson.Safe.pretty_print f (to_yojson t)

  let digest t = Yojson.Safe.to_string (to_yojson t)
end

module Value = Commit

module Repo_map = Map.Make(String)

let repo_locks = ref Repo_map.empty

let repo_lock repo =
  match Repo_map.find_opt repo !repo_locks with
  | Some l -> l
  | None ->
    let l = Lwt_mutex.create () in
    repo_locks := Repo_map.add repo l !repo_locks;
    l

let id = "git-clone"

let build No_context job { Key.repo; gref } =
  Lwt_mutex.with_lock (repo_lock repo) @@ fun () ->
  Current.Job.start job ~level:Current.Level.Mostly_harmless >>= fun () ->
  let local_repo = Cmd.local_copy repo in
  (* Ensure we have a local clone of the repository. *)
  begin
    if Cmd.dir_exists local_repo
    then Cmd.git_fetch ~cancellable:true ~job ~src:repo ~dst:local_repo (Fmt.str "%s:refs/remotes/origin/%s" gref gref)
    else Cmd.git_clone ~cancellable:true ~job ~src:repo local_repo
  end >>!= fun () ->
  Cmd.git_rev_parse ~cancellable:true ~job ~repo:local_repo ("origin/" ^ gref) >>!= fun hash ->
  let id = { Commit_id.repo; gref; hash } in
  Lwt.return @@ Ok { Commit.repo = local_repo; id }

let pp f key = Fmt.pf f "git clone %a" Key.pp key

let auto_cancel = false