Merge pull request #458 from talex5/local-bridge

Add local git bridge

Dockerfile.bridge-local-git

@@ -0,0 +1,27 @@
+FROM docker/datakit:client
+
+RUN opam pin add github --dev -n
+RUN opam pin add prometheus.dev /home/opam/src/datakit -n
+RUN opam pin add prometheus-app.dev /home/opam/src/datakit -n
+RUN opam pin add datakit-github.dev /home/opam/src/datakit -n
+RUN opam depext datakit-github && opam install datakit-github --deps
+COPY datakit-bridge-local-git.opam /home/opam/src/datakit/datakit-bridge-local-git.opam
+RUN opam pin add datakit-bridge-local-git.dev /home/opam/src/datakit -n
+RUN opam depext datakit-bridge-local-git && opam install datakit-bridge-local-git --deps
+
+COPY . /home/opam/src/datakit/
+RUN sudo chown opam.nogroup -R /home/opam/src/datakit
+RUN cd /home/opam/src/datakit && \
+    git diff && git status --porcelain && \
+    git checkout . && scripts/watermark.sh && \
+    git status --porcelain
+
+RUN opam update datakit-bridge-local-git
+RUN opam install datakit-bridge-local-git -vv
+
+RUN opam config exec -- ocaml /home/opam/src/datakit/check-libev.ml
+RUN sudo cp $(opam config exec -- which datakit-bridge-local-git) /usr/bin/
+
+USER root
+ENTRYPOINT ["/usr/bin/datakit-bridge-local-git"]
+CMD ["-v", "--datakit=tcp:datakit:5640"]

Makefile

@@ -31,6 +31,9 @@ server:
 github:
 	ocaml pkg/pkg.ml build -n datakit-github -q
 
+bridge-local-git:
+	ocaml pkg/pkg.ml build -n datakit-bridge-local-git -q
+
 prometheus-app:
 	ocaml pkg/pkg.ml build -n prometheus-app -q --tests true
 	ocaml pkg/pkg.ml test _build/prometheus/tests/test.native

_tags

@@ -1,6 +1,6 @@
 true: -traverse
 true : bin_annot, safe_string
-not <ci/**>: warn_error(+1..49-3), warn(A-4-41-44)
+not <ci/**> and not <bridge/local/**>: warn_error(+1..49-3), warn(A-4-41-44)
 not <prometheus/**>: package(bytes lwt astring logs result cstruct fmt rresult)
 <ci/static/**>: traverse
 

bridge/github/main.ml

@@ -2,10 +2,10 @@ open Lwt.Infix
 open Astring
 open Result
 
-let src = Logs.Src.create "gh-bridge" ~doc:"Github bridge for Datakit "
+let src = Logs.Src.create "gh-bridge" ~doc:"Github bridge for Datakit"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-let src9p = Logs.Src.create "g9p" ~doc:"Github bridge for Datakit (9p) "
+let src9p = Logs.Src.create "g9p" ~doc:"Github bridge for Datakit (9p)"
 module Log9p = (val Logs.src_log src9p : Logs.LOG)
 
 let quiet_9p () =
@@ -268,7 +268,7 @@ let capabilities =
   Arg.(value & opt cap Datakit_github.Capabilities.all doc)
 
 let term =
-  let doc = "Bridge between GiHub API and Datakit." in
+  let doc = "Bridge between GitHub API and Datakit." in
   let man = [
     `S "DESCRIPTION";
     `P "$(tname) exposes a subset of the GitHub API as a 9p \

bridge/local/Makefile

@@ -0,0 +1,5 @@
+all:
+	make -w -C ../.. bridge-local-git
+
+clean:
+	make -C ../.. clean

bridge/local/README.md

@@ -0,0 +1,44 @@
+## DataKit Local-Git bridge
+
+This service is a drop-in replacement for the DataKit-GitHub bridge that instead just monitors a local Git repository.
+It is useful for testing a new DataKitCI configuration without having to configure GitHub integration first.
+
+The local bridge monitors the state of one or more local Git repositories, writing the current head of each branch to DataKit.
+DataKitCI can be configured to run the CI tests against the project each time a commit is made.
+
+Once you are happy with the way the CI is working, you can replace this service with the GitHub bridge service to have the CI test a project hosted on GitHub instead.
+
+Unlike the GitHub bridge, this service:
+
+- only reports on branches, not tags or pull requests;
+- does not report build statuses from other CI systems; and
+- does not push the statuses set by the CI anywhere.
+
+For an example test configuration using this bridge, see `ci/self-ci/docker-compose.yml`.
+
+
+### Build
+
+Build using the `Dockerfile.bridge-local-git` file at the root of this repository:
+
+    docker build -t docker/datakit:bridge-local-git -f Dockerfile.bridge-local-git .
+
+### Run
+
+To see the help text:
+
+    docker run -it --rm docker/datakit:bridge-local-git --help
+
+To run it (after starting a DataKit container called "datakit"):
+
+    docker run -it --rm \
+      --link datakit:datakit \
+      -v /path/to/repos:/repos \
+      docker/datakit:bridge-local-git -v \
+      me/my-project:/repos/my-project \
+      --verbose \
+      --webhook=http://my-ip
+
+Replace:
+- `/path/to/repos` with the path to your local repository or repositories.
+- `me/my-project` (simulating the GitHub `http://github.com/my/my-project` repository) with the ID of your project.

bridge/local/_tags

@@ -0,0 +1,4 @@
+true: warn(A)
+true: strict_sequence, safe_string, annot, bin_annot
+true: package(cmdliner, logs, datakit-client, protocol-9p.unix, fmt.cli, fmt.tty, logs.cli)
+true: package(irmin.unix, irmin.git, irmin-watcher, datakit-github.client)

bridge/local/datakit-bridge-local-git.mllib

@@ -0,0 +1,2 @@
+Main
+Sync

bridge/local/main.ml

@@ -0,0 +1,122 @@
+open Lwt.Infix
+
+let src = Logs.Src.create "bridge-local-git" ~doc:"Local Git bridge for Datakit"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let src9p = Logs.Src.create "bridge-local-git.9p" ~doc:"Local Git bridge for Datakit (9p)"
+module Log9p = (val Logs.src_log src9p : Logs.LOG)
+module Client9p = Client9p_unix.Make(Log9p)
+module Store = Irmin_unix.Irmin_git.FS(Irmin.Contents.String)(Irmin.Ref.String)(Irmin.Hash.SHA1)
+module DK = Datakit_client_9p.Make(Client9p)
+
+module Sync = Sync.Make(Store)(DK)
+
+let failf fmt =
+  Fmt.kstrf failwith fmt
+
+let start () (protocol, address) repos =
+  Log.info (fun f -> f "Connecting to DataKit server on %s:%s" protocol address);
+  Irmin.Private.Watch.set_listen_dir_hook Irmin_watcher.hook;
+  Lwt_main.run begin
+    Lwt.catch
+      (fun () ->
+         Client9p.connect protocol address () >|= function
+         | Ok c -> c
+         | Error (`Msg m) -> failwith m
+      )
+      (fun ex ->
+         failf "Failed to connect to DataKit server at proto=%S addr=%S: %s"
+           protocol address (Printexc.to_string ex)
+      )
+    >|= DK.connect >>= fun dk ->
+    repos |> Lwt_list.map_p (fun (name, root) ->
+        Log.info (fun f -> f "Monitoring local repository %S" root);
+        let config = Irmin_unix.Irmin_git.config ~root ~bare:true () in
+        Store.Repo.create config >|= fun store -> (name, store)
+      )
+    >>= Sync.run dk
+  end
+
+(* Command-line parsing *)
+
+open Cmdliner
+
+let datakit_endpoint =
+  let doc =
+    Arg.info ~doc:"DataKit store for metadata."
+      ~docv:"ADDR" ["metadata-store"]
+  in
+  Arg.(value (opt (pair ~sep:':' string string) ("tcp","localhost:5640") doc))
+
+let pp_level f lvl =
+  let style, msg = match lvl with
+    | Logs.App -> `Black, "APP"
+    | Logs.Error -> `Red, "ERR"
+    | Logs.Warning -> `Red, "WRN"
+    | Logs.Info -> `None, "INF"
+    | Logs.Debug ->  `Cyan, "DBG"
+  in
+  Fmt.pf f "%a" Fmt.(styled style string) msg
+
+let pp_timestamp f x =
+  let open Unix in
+  let tm = localtime x in
+  Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d"
+    (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
+
+let report src level ~over k msgf =
+  let k _ = over (); k () in
+  msgf @@ fun ?header:_ ?tags:_ fmt ->
+  let src = Logs.Src.name src in
+  Format.kfprintf k Format.err_formatter ("%a %a [%s] @[" ^^ fmt ^^ "@]@.")
+    pp_timestamp (Unix.gettimeofday ())
+    pp_level level
+    src
+
+let init style_renderer level =
+  Fmt_tty.setup_std_outputs ?style_renderer ();
+  Logs.set_level level;
+  Logs.set_reporter { Logs.report }
+
+let setup_log =
+  Term.(const init $ Fmt_cli.style_renderer () $ Logs_cli.level ())
+
+let repo_id =
+  let parse s =
+    match Datakit_github.Repo.of_string s with
+    | None -> `Error (Fmt.strf "Bad repository name %S (format should be user/project)" s)
+    | Some x -> `Ok x
+  in
+  (parse, Datakit_github.Repo.pp)
+
+let git_dir =
+  let parse, pp = Arg.dir in
+  let parse s =
+    match parse (Filename.concat s ".git") with
+    | `Ok _ -> `Ok s
+    | `Error _ as e -> e
+  in
+  (parse, pp)
+
+let repo = Arg.(pair ~sep:':' repo_id git_dir)
+
+let repos =
+  let doc = Arg.info []
+      ~doc:"A Git repository to monitor and the name to use for it. e.g. 'my/my-project:/tmp/my-project'"
+      ~docv:"NAME:PATH" in
+  Arg.(non_empty @@ pos_all repo [] doc)
+
+let main =
+  let doc = "Bridge between a local Git repository and Datakit." in
+  let man = [
+    `S "DESCRIPTION";
+    `P "$(tname) is a local replacement for datakit-github. \
+        It allows you to test DataKitCI against a local Git repository \
+        without having to configure GitHub integration first.";
+  ] in
+  Term.(pure start $ setup_log $ datakit_endpoint $ repos),
+  Term.info (Filename.basename Sys.argv.(0)) ~doc ~man
+
+let () = match Term.eval main with
+  | `Error _ -> exit 1
+  | `Help | `Version | `Ok () -> ()

bridge/local/sync.ml

@@ -0,0 +1,108 @@
+open Lwt.Infix
+open Datakit_github
+
+let src = Logs.Src.create "bridge-local-git.sync" ~doc:"Local Git bridge sync for Datakit"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module Make
+    (S : Irmin.S with type branch_id = string)
+    (DK : Datakit_S.CLIENT)
+= struct
+  module Conv = Datakit_github_conv.Make(DK)
+
+  let ( >>*= ) x f =
+    x >>= function
+    | Ok x -> f x
+    | Error e -> Lwt.fail (Failure (Fmt.to_to_string DK.pp_error e))
+
+  type t = {
+    repos : Repo.Set.t;
+    metadata_branch : DK.Branch.t;
+    mutable known : Commit.t Ref.Index.t;
+    cond : unit Lwt_condition.t;        (* Fires when [known] changes. *)
+  }
+
+  let on_change t repo_id irmin_repo branch =
+    Log.debug (fun f -> f "Notification for %S" branch);
+    S.Private.Ref.read (S.Private.Repo.ref_t irmin_repo) branch >|= fun head ->
+    let old = t.known in
+    let id = (repo_id, ["heads"; branch]) in
+    let next =
+      match head with
+      | None -> Ref.Index.remove id old
+      | Some head -> Ref.Index.add id (Commit.v repo_id (S.Hash.to_hum head)) old
+    in
+    if t.known != next then (
+      Log.debug (fun f -> f "Update for %S" branch);
+      t.known <- next;
+      Lwt_condition.broadcast t.cond ();
+    )
+
+  let watch t (name, repo) =
+    let callback branch _diff = on_change t name repo branch in
+    S.Repo.watch_branches ~init:[] repo callback >>= fun (_stop : (unit -> unit Lwt.t)) ->
+    (* XXX: In theory, we should be able to pass [~init:[]] and have Irmin notify us
+       of the initial state. However, Irmin's [watch_branches] is buggy. *)
+    S.Repo.branches repo >>= Lwt_list.iter_s (fun b -> on_change t name repo b)
+
+  let read_refs t tr =
+    DK.Transaction.parents tr >>*= function
+    | [] -> Lwt.return Ref.Set.empty
+    | [p] -> Conv.refs ~repos:t.repos (DK.Commit.tree p)
+    | _ -> assert false (* We never make merge transactions. *)
+
+  let update_ref tr ~changelog ~new_state existing_ref =
+    Log.debug (fun f -> f "Updating ref %a" Ref.pp existing_ref);
+    let id = Ref.id existing_ref in
+    match Ref.Index.find id !new_state with
+    | None ->
+      Log.info (fun f -> f "Branch %a no longer exists" Ref.pp existing_ref);
+      Buffer.add_string changelog (Fmt.strf "Removing deleted branch %a@." Ref.pp existing_ref);
+      Conv.remove_elt tr (`Ref (Ref.id existing_ref));
+    | Some new_head ->
+      new_state := Ref.Index.remove id !new_state;
+      if Commit.equal new_head (Ref.commit existing_ref) then Lwt.return ()
+      else (
+        let r = Ref.v new_head (Ref.name existing_ref) in
+        Log.debug (fun f -> f "Updating ref to %a" Ref.pp r);
+        Buffer.add_string changelog (Fmt.strf "Updating existing branch to %a@." Ref.pp r);
+        Conv.update_elt tr (`Ref r)
+      )
+
+  let add_ref tr ~changelog (id, commit) =
+    Log.info (fun f -> f "Tracking new branch %a" Ref.pp_id id);
+    let r = Ref.v commit (snd id) in
+    Buffer.add_string changelog (Fmt.strf "Tracking new branch %a@." Ref.pp r);
+    Conv.update_elt tr (`Ref r)
+
+  let sync t new_state =
+    Log.info (fun f -> f "Copy state to DataKit");
+    DK.Branch.with_transaction t.metadata_branch (fun tr ->
+        let changelog = Buffer.create 128 in
+        read_refs t tr >>= fun old_refs ->
+        let new_state = ref new_state in
+        Lwt_list.iter_s (update_ref tr ~changelog ~new_state) (Ref.Set.elements old_refs) >>= fun () ->
+        let new_state = !new_state in
+        Lwt_list.iter_s (add_ref tr ~changelog) (Ref.Index.bindings new_state) >>= fun () ->
+        match Buffer.contents changelog with
+        | "" ->
+          Log.info (fun f -> f "No updates needed");
+          DK.Transaction.abort tr >|= fun () -> Ok ()
+        | message ->
+          DK.Transaction.commit tr ~message
+      )
+    >>*= Lwt.return
+
+  let run dk repos =
+    DK.branch dk "github-metadata" >>*= fun metadata_branch ->
+    let cond = Lwt_condition.create () in
+    let monitored = List.map fst repos |> Repo.Set.of_list in
+    let t = { repos = monitored; metadata_branch; known = Ref.Index.empty; cond } in
+    Lwt_list.iter_p (watch t) repos >>= fun () ->
+    let rec aux () =
+      let next = Lwt_condition.wait t.cond in
+      sync t t.known >>= fun () ->
+      next >>= aux
+    in
+    aux ()
+end

bridge/local/sync.mli

@@ -0,0 +1,5 @@
+module Make
+    (S : Irmin.S with type branch_id = string)
+    (DK : Datakit_S.CLIENT) : sig
+  val run : DK.t -> (Datakit_github.Repo.t * S.Repo.t) list -> 'a Lwt.t
+end