From 75e0e3dab0127f7bad4882b14dbab73a96616495 Mon Sep 17 00:00:00 2001 From: Philipp Gesang Date: Mon, 9 Jun 2014 12:08:06 +0200 Subject: add sync operation --- context_mirror_bot.ml | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/context_mirror_bot.ml b/context_mirror_bot.ml index 5da9172..0053126 100644 --- a/context_mirror_bot.ml +++ b/context_mirror_bot.ml @@ -76,7 +76,8 @@ let sources = let bot_owner = "Philipp Gesang" let owner_contact = "phg42.2a@gmail.com" -let repo_root = "/home/mirror/mirror" +(*let repo_root = "/home/mirror/mirror"*) +let repo_root = "/home/phg/src/mirror" let repo_subdir = "context-git" let repo_dir = Filename.concat repo_root repo_subdir let git_dir = Filename.concat repo_dir ".git" @@ -295,6 +296,8 @@ module Git : sig val import : extract_status -> import_status val push : string -> status val install_files : unit -> unit + val fetch : string -> unit + val pull : ?rbr:string -> string -> unit exception Git_checkout_failed of string end = struct exception Git_init_failed @@ -303,6 +306,8 @@ end = struct exception Git_checkout_failed of string exception Git_branch_failed of string exception Git_commit_failed of string + exception Git_fetch_failed of string + exception Git_pull_failed of string exception Import_files_failed exception Copy_ssh_key_failed @@ -349,6 +354,29 @@ end = struct | Bad _ -> raise Git_init_failed | Good -> install_files (); true + let fetch remote = + msg ("Fetching remote " ^ remote); + match list_of_pipe ("git fetch " ^ remote) with + | None -> raise (Git_fetch_failed remote) + | Some _ -> () + + let pull ?rbr:(rbr="mirror") br = + msg ~lev:1 (Printf.sprintf "tentatively checkout new branch %s from remote %s" br rbr); + let () = match list_of_pipe (* this fails if the branch already exists *) + (Printf.sprintf "git checkout -b \"%s\" \"%s\"" br rbr) with + | Some _ -> msg (Printf.sprintf "new branch %s created" br) + | None -> (* branch exists, do regular checkout *) + begin + msg ~lev:1 (Printf.sprintf "branch %s already exists; performing normal checkout" br); + match list_of_pipe (Printf.sprintf "git checkout \"%s\"" br) with + | None -> raise (Git_checkout_failed br) + | Some _ -> () + end + in + match list_of_pipe ("git pull --ff") with + | Some _ -> msg ~lev:1 (Printf.sprintf "pulled branch %s just fine" br) + | None -> raise (Git_pull_failed (Printf.sprintf "%s (remote: %s)" br rbr)) + let last_commit br = match list_of_pipe ("git checkout " ^ br) with | None -> raise (Git_checkout_failed br) @@ -706,6 +734,19 @@ let run_update () = in () +let run_sync () = + Git.fetch "mirror"; + Git.fetch "garden"; + Git.pull "beta"; + Git.pull "current"; + Git.pull ~rbr:"garden/master" "garden-master"; + let name = "garden-master" in + msg "Pushing changes from context garden repo to mirror"; + match Git.push name with + | Good -> msg "Success!" + | Bad errmsg -> + err (Printf.sprintf "Failed to push %s: “%s”" name errmsg) + let run_cleanup () = forall_sources (fun src -> @@ -751,6 +792,7 @@ let parse_argv () = ("--check", Arg.Unit (fun () -> j.kind <- Action ("status" , run_status ); ()), "check source timestamps"); ("--status", Arg.Unit (fun () -> j.kind <- Action ("check" , run_check ); ()), "print status of local repo"); ("--update", Arg.Unit (fun () -> j.kind <- Action ("update" , run_update ); ()), "update from sources"); + ("--sync", Arg.Unit (fun () -> j.kind <- Action ("sync" , run_sync ); ()), "sync local repo"); ("--prepare", Arg.Unit (fun () -> j.kind <- Action ("prepare" , run_prepare ); ()), "prepare local repository"); ("--download", Arg.Unit (fun () -> j.kind <- Action ("download", run_download); ()), "download source packages"); ("--clean", Arg.Unit (fun () -> j.kind <- Action ("cleanup" , run_cleanup ); ()), "remove leftover files"); -- cgit v1.2.3