diff --git a/bot-components/GitHub_subscriptions.ml b/bot-components/GitHub_subscriptions.ml index c6ee89c0..2bb5b757 100644 --- a/bot-components/GitHub_subscriptions.ml +++ b/bot-components/GitHub_subscriptions.ml @@ -227,24 +227,30 @@ let github_event ~event json = Ok (UnsupportedEvent "Unsupported GitHub event.") let receive_github ~secret headers body = - let open Result in - ( match Header.get headers "X-Hub-Signature" with - | Some signature -> - let expected = - Mirage_crypto.Hash.SHA1.hmac ~key:(Cstruct.of_string secret) - (Cstruct.of_string body) - |> Hex.of_cstruct |> Hex.show |> f "sha1=%s" - in - if Eqaf.equal signature expected then return true - else Error "Webhook signed but with wrong signature." - | None -> - return false ) - >>= fun signed -> + let open Result.Monad_infix in match Header.get headers "X-GitHub-Event" with | Some event -> ( try let json = Yojson.Basic.from_string body in - github_event ~event json |> Result.map ~f:(fun r -> (signed, r)) + ( try + let install_id = + json |> member "installation" |> member "id" |> to_int + in + (* if there is an install id, the webhook should be signed *) + match Header.get headers "X-Hub-Signature" with + | Some signature -> + let expected = + Mirage_crypto.Hash.SHA1.hmac ~key:(Cstruct.of_string secret) + (Cstruct.of_string body) + |> Hex.of_cstruct |> Hex.show |> f "sha1=%s" + in + if Eqaf.equal signature expected then Ok (Some install_id) + else Error "Webhook signed but with wrong signature." + | None -> + Error "Webhook comes from a GitHub App, but it is not signed." + with Yojson.Json_error _ | Type_error _ -> Ok None ) + >>= fun install_id -> + github_event ~event json |> Result.map ~f:(fun r -> (install_id, r)) with | Yojson.Json_error err -> Error (f "Json error: %s" err) diff --git a/bot-components/GitHub_subscriptions.mli b/bot-components/GitHub_subscriptions.mli index c357ffff..7ca8b11a 100644 --- a/bot-components/GitHub_subscriptions.mli +++ b/bot-components/GitHub_subscriptions.mli @@ -17,4 +17,7 @@ type msg = | UnsupportedEvent of string val receive_github : - secret:string -> Cohttp.Header.t -> string -> (bool * msg, string) result + secret:string + -> Cohttp.Header.t + -> string + -> (int option * msg, string) result diff --git a/src/bot.ml b/src/bot.ml index 90c01f8a..692cdcd1 100644 --- a/src/bot.ml +++ b/src/bot.ml @@ -199,15 +199,17 @@ let callback _conn req body = (Request.headers req) body with | Ok - ( true + ( Some install_id , PushEvent {owner= "coq"; repo= "coq"; base_ref; head_sha; commits_msg} ) -> (fun () -> init_git_bare_repository ~bot_info >>= fun () -> - action_as_github_app ~bot_info ~key ~app_id ~owner:"coq" + action_as_github_app_from_install_id ~bot_info ~key ~app_id + ~install_id (coq_push_action ~base_ref ~commits_msg) - <&> action_as_github_app ~bot_info ~key ~app_id ~owner:"coq" + <&> action_as_github_app_from_install_id ~bot_info ~key ~app_id + ~install_id (mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner:"coq" ~repo:"coq" ~base_ref ~head_sha () ) ) |> Lwt.async ; @@ -216,13 +218,15 @@ let callback _conn req body = "Processing push event on Coq repository: analyzing merge / \ backporting info." () - | Ok (true, PushEvent {owner; repo; base_ref; head_sha; _}) -> ( + | Ok (Some install_id, PushEvent {owner; repo; base_ref; head_sha; _}) + -> ( match (owner, repo) with | "coq-community", ("docker-base" | "docker-coq") -> (fun () -> init_git_bare_repository ~bot_info >>= fun () -> - action_as_github_app ~bot_info ~key ~app_id ~owner + action_as_github_app_from_install_id ~bot_info ~key ~app_id + ~install_id (mirror_action ~gitlab_domain:"gitlab.com" ~owner ~repo ~base_ref ~head_sha () ) ) |> Lwt.async ; @@ -237,7 +241,8 @@ let callback _conn req body = (fun () -> init_git_bare_repository ~bot_info >>= fun () -> - action_as_github_app ~bot_info ~key ~app_id ~owner + action_as_github_app_from_install_id ~bot_info ~key ~app_id + ~install_id (mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner ~repo ~base_ref ~head_sha () ) ) |> Lwt.async ; @@ -333,7 +338,7 @@ let callback _conn req body = Server.respond_string ~status:`OK ~body:(f "Unhandled new issue: %s" body) () ) - | Ok (signed, CommentCreated comment_info) -> ( + | Ok (install_id, CommentCreated comment_info) -> ( let body = comment_info.body |> trim_comments |> strip_quoted_bot_name ~github_bot_name @@ -394,7 +399,7 @@ let callback _conn req body = && comment_info.issue.pull_request && String.equal comment_info.issue.issue.owner "coq" && String.equal comment_info.issue.issue.repo "coq" - && signed + && Option.is_some install_id then let full_ci = match Str.matched_group 1 body with @@ -421,7 +426,7 @@ let callback _conn req body = && comment_info.issue.pull_request && String.equal comment_info.issue.issue.owner "coq" && String.equal comment_info.issue.issue.repo "coq" - && signed + && Option.is_some install_id then ( (fun () -> action_as_github_app ~bot_info ~key ~app_id @@ -439,7 +444,7 @@ let callback _conn req body = && comment_info.issue.pull_request && String.equal comment_info.issue.issue.owner "coq" && String.equal comment_info.issue.issue.repo "coq" - && signed + && Option.is_some install_id then ( (fun () -> action_as_github_app ~bot_info ~key ~app_id @@ -458,7 +463,7 @@ let callback _conn req body = && comment_info.issue.pull_request && String.equal comment_info.issue.issue.owner "coq" && String.equal comment_info.issue.issue.repo "coq" - && signed + && Option.is_some install_id then ( (fun () -> action_as_github_app ~bot_info ~key ~app_id @@ -472,11 +477,11 @@ let callback _conn req body = Server.respond_string ~status:`OK ~body:(f "Unhandled comment: %s" body) () ) ) ) - | Ok (signed, CheckRunReRequested {external_id}) -> ( - if not signed then - Server.respond_string ~status:(Code.status_of_code 401) - ~body:"Request to rerun check run must be signed." () - else if String.is_empty external_id then + | Ok (None, CheckRunReRequested _) -> + Server.respond_string ~status:(Code.status_of_code 401) + ~body:"Request to rerun check run must be signed." () + | Ok (Some _, CheckRunReRequested {external_id}) -> ( + if String.is_empty external_id then Server.respond_string ~status:(Code.status_of_code 400) ~body:"Request to rerun check run but empty external ID." () else