summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--context_mirror_bot.ml95
1 files changed, 35 insertions, 60 deletions
diff --git a/context_mirror_bot.ml b/context_mirror_bot.ml
index 57b1e84..5dc76e2 100644
--- a/context_mirror_bot.ml
+++ b/context_mirror_bot.ml
@@ -57,7 +57,8 @@ exception Prepare_failed of string
let bootstrap_repo = "git://repo.or.cz/context.git" (* Marius’s mirror *)
let garden_repo = "http://git.contextgarden.net/context/context.git" (* official, but broken *)
-let mirror_repo = "git@bitbucket.org:phg/context-mirror.git" (* our mirror *)
+(*let mirror_repo = "git@bitbucket.org:phg/context-mirror.git" [> our mirror <]*)
+let mirror_repo = "git@bb-git-mirror:phg/context-mirror.git" (* our mirror *)
let sources =
[ { name = "beta";
@@ -605,48 +606,19 @@ let handle_zipball = function
end
(******************************************************************************
- * arg handling
+ * job dispatch
*****************************************************************************)
type job = {
mutable kind : job_kind;
}
-and job_kind = Status (* output status of local repo *)
- | Check (* check source of updates *)
- | Update (* update local repo from sources *)
- | Prepare (* init local repo *)
- | Download (* download and import upstream zips *)
- | Clean (* remove unwanted side-effects *)
- | Push (* push current state of repository *)
- | Files (* write SSH wrapper and git config *)
- | Nil (* no-op *)
+and job_kind = Action of action | Nop
+and action = string * (unit -> unit)
let usage = Printf.sprintf "Usage:
%s [ --check | --status | --update ]
" Sys.argv.(0)
-let parse_argv () =
- let j : job = {
- kind = Nil;
- }
- in
- Arg.parse [
- ("--check", Arg.Unit (fun () -> j.kind <- Check; ()), "check source timestamps");
- ("--status", Arg.Unit (fun () -> j.kind <- Status; ()), "print status of local repo");
- ("--update", Arg.Unit (fun () -> j.kind <- Update; ()), "update from sources");
- ("--prepare", Arg.Unit (fun () -> j.kind <- Prepare; ()), "prepare local repository");
- ("--download", Arg.Unit (fun () -> j.kind <- Download; ()), "download source packages");
- ("--clean", Arg.Unit (fun () -> j.kind <- Clean; ()), "remove leftover files");
- ("--push", Arg.Unit (fun () -> j.kind <- Push; ()), "push to mirror");
- ("--files", Arg.Unit (fun () -> j.kind <- Files; ()), "install config and wrapper files");
- ("--verbose", Arg.Unit (fun () -> set_verbosity 1; ()), "enable verbose output");
- ] (fun a -> print_endline ("unexpected argument: "^a); exit 0) usage;
- j
-
-(******************************************************************************
- * job dispatch
- *****************************************************************************)
-
let run_status () =
if not (dir_exists repo_dir) then msg ("No directory at " ^ repo_dir) else
begin
@@ -752,32 +724,35 @@ let run_push () =
let run_files () = Git.install_files ()
-let print_kind = function
- | Status -> "status"
- | Check -> "check"
- | Update -> "update"
- | Prepare -> "prepare"
- | Download -> "download"
- | Clean -> "cleanup"
- | Push -> "push"
- | Files -> "files"
- | Nil -> "()"
-
-let dispatch_job j =
- log_info (Printf.sprintf
- "started in %s mode at %s."
- (print_kind j.kind)
- (format_time t_start));
- match j.kind with
- | Status -> run_status ()
- | Check -> run_check ()
- | Update -> run_update ()
- | Prepare -> run_prepare ()
- | Download -> run_download ()
- | Clean -> run_cleanup ()
- | Push -> run_push ()
- | Files -> run_files ()
- | Nil -> ()
+let dispatch_job = function
+ | Nop -> print_endline usage
+ | Action (descr, act) ->
+ begin
+ log_info (Printf.sprintf
+ "started in %s mode at %s."
+ descr
+ (format_time t_start));
+ act ()
+ end
+
+(******************************************************************************
+ * arg handling
+ *****************************************************************************)
+
+let parse_argv () =
+ let j : job = { kind = Nop; } in
+ Arg.parse [
+ ("--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");
+ ("--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");
+ ("--push", Arg.Unit (fun () -> j.kind <- Action ("push" , run_push ); ()), "push to mirror");
+ ("--files", Arg.Unit (fun () -> j.kind <- Action ("files" , run_files ); ()), "install config and wrapper files");
+ ("--verbose", Arg.Unit (fun () -> set_verbosity 1; ()), "enable verbose output");
+ ] (fun a -> print_endline ("unexpected argument: "^a); exit 0) usage;
+ j
(******************************************************************************
* main
@@ -786,7 +761,7 @@ let dispatch_job j =
let () =
let job = parse_argv () in
Git.set_path repo_dir;
- dispatch_job job;
+ dispatch_job job.kind;
log_info (Printf.sprintf
"mirror bot finished in %.2f ms."
(Unix.gettimeofday () -. t_start));