Merge pull request #2 from ibnfirnas/re-write-in-ocaml

Re write in ocaml. Fixes #1

.gitignore

@@ -1 +1,4 @@
+_obuild/
+bin/
 data/
+ocp-build.root*

Makefile

@@ -0,0 +1,49 @@
+PROGRAMS := \
+	riak-snaps
+
+DIR_BUILD := _obuild
+
+
+# TODO: Test a cross-platform way of grabbing number of CPUs
+MAX_BUILD_WORKERS := $(shell sysctl -n hw.ncpu)
+
+
+.PHONY:\
+	build \
+	clean \
+	programs \
+	purge
+
+
+programs: build bin
+	@for p in $(PROGRAMS); do \
+		src="$(DIR_BUILD)/$$p/$$p.asm" ; \
+		dst="bin/$$p" ; \
+		cp $$src $$dst ; \
+	done
+
+bin:
+	@mkdir -p bin
+
+build: ocp-build.root
+	@ocp-build build -njobs $(MAX_BUILD_WORKERS)
+
+ocp-build.root:
+	@ocp-build -init -njobs $(MAX_BUILD_WORKERS)
+
+clean: clean_bin
+	@ocp-build clean
+	@rm -f ocp-build.root*
+
+clean_manually: clean_bin
+	@rm -rf $(DIR_BUILD)
+	@find \
+		. \
+			-name '*.o' \
+		-or -name '*.cmi' \
+		-or -name '*.cmo' \
+		-or -name '*.cmx' \
+	| xargs rm -f
+
+clean_bin:
+	@rm -rf bin

build.ocp

@@ -0,0 +1,24 @@
+sort   = true
+has_byte = false
+has_asm  = true
+cflags = "-w +A"
+
+begin library "process"
+    requires = [ "unix" ]
+    files    = [
+        "src/process/process.mli"
+        "src/process/process.ml"
+    ]
+end
+
+begin program "riak-snaps"
+    requires = [
+        "process"
+        "str"
+        "ezjsonm"
+    ]
+    files    = [
+        "src/riak_snaps/riak_snaps_main.mli"
+        "src/riak_snaps/riak_snaps_main.ml"
+    ]
+end

src/process/process.ml

@@ -0,0 +1,62 @@
+module String = StringLabels
+module Unix   = UnixLabels
+
+type process_error =
+  | Fail   of int * string
+  | Signal of int
+  | Stop   of int
+
+type argument_error =
+  | Invalid_prog
+
+type ('ok, 'error) result =
+  [ `Ok of 'ok | `Error of 'error ]
+
+type t =
+  { prog   : string
+  ; args   : string list
+  ; stdout : in_channel
+  ; stdin  : out_channel
+  ; stderr : in_channel
+  }
+
+let read_ic ~ic =
+  let buffer = Buffer.create 32 in
+  let rec read () =
+    try
+      Buffer.add_channel buffer ic 1;
+      read ()
+    with End_of_file ->
+      ()
+  in
+  read ();
+  Buffer.contents buffer
+
+let string_find ~str ~chr =
+  try Some (String.index str chr) with Not_found -> None
+
+let wait {stdout; stdin; stderr; _} =
+  let stdout_content = read_ic ~ic:stdout in
+  let stderr_content = read_ic ~ic:stderr in
+  match Unix.close_process_full (stdout, stdin, stderr) with
+  | Unix.WEXITED   0 -> `Ok                stdout_content
+  | Unix.WEXITED   n -> `Error (Fail   (n, stderr_content))
+  | Unix.WSIGNALED n -> `Error (Signal  n)
+  | Unix.WSTOPPED  n -> `Error (Stop    n)
+
+let create ~prog ~args =
+  match string_find ~str:prog ~chr:' ' with
+  | Some _ -> `Error Invalid_prog
+  | None ->
+    let cmd = String.concat (prog :: args) ~sep:" " in
+    let env = Unix.environment () in
+    let stdout, stdin, stderr = Unix.open_process_full cmd ~env in
+    let t =
+      { prog
+      ; args
+      ; stdout
+      ; stdin
+      ; stderr
+      }
+    in
+    `Ok t

src/process/process.mli

@@ -0,0 +1,16 @@
+type process_error =
+  | Fail   of int * string
+  | Signal of int
+  | Stop   of int
+
+type argument_error =
+  | Invalid_prog
+
+type ('ok, 'error) result =
+  [ `Ok of 'ok | `Error of 'error ]
+
+type t
+
+val create : prog:string -> args:string list -> (t, argument_error) result
+
+val wait : t -> (string, process_error) result

src/riak_snaps/riak_snaps_main.ml

@@ -0,0 +1,66 @@
+open Printf
+
+module String = StringLabels
+
+let port = 8098
+
+let (|-) f g x = g (f x)
+
+let last_line str =
+  List.hd (List.rev (Str.split (Str.regexp "\n+") str))
+
+let sys_out ~prog ~args =
+  match Process.create ~prog ~args with
+  | `Error Process.Invalid_prog -> assert false
+  | `Ok proc ->
+    begin match Process.wait proc with
+    | `Ok out  -> out
+    | `Error (Process.Signal _) -> assert false
+    | `Error (Process.Stop   _) -> assert false
+    | `Error (Process.Fail (code, reason)) ->
+        eprintf "~~~ FAILURE ~~~\n%!";
+        eprintf "Program   : %s\n%!" prog;
+        eprintf "Arguments : %s\n%!" (String.concat args ~sep:" ");
+        eprintf "Exit code : %d\n%!" code;
+        eprintf "Reason    : %s\n%!" reason;
+        exit code
+    end
+
+let sys_do ~prog ~args =
+  ignore (sys_out ~prog ~args)
+
+let riak_get_keys ~hostname ~bucket =
+  let uri = sprintf "http://%s:%d/riak/%s?keys=true" hostname port bucket in
+  let data = sys_out ~prog:"curl" ~args:["-i"; uri] in
+  let body = last_line data in
+  let json = Ezjsonm.from_string body in
+  Ezjsonm.(get_list get_string (find json ["keys"]))
+
+let riak_get_value ~hostname ~bucket key =
+  let uri = sprintf "http://%s:%d/riak/%s/%s" hostname port bucket key in
+  let data = sys_out ~prog:"curl" ~args:["-i"; uri] in
+  key, (last_line data)
+
+let git_init () =
+  sys_do ~prog:"git" ~args:["init"]
+
+let mkdir path =
+  sys_do ~prog:"mkdir" ~args:["-p"; path]
+
+let object_store ~bucket (key, value) =
+  let oc = open_out (bucket ^ "/" ^ key) in
+  output_string oc value;
+  close_out oc;
+  sys_do ~prog:"git" ~args:["add"   ; "."];
+  sys_do ~prog:"git" ~args:["commit"; "-m"; sprintf "'Update %s'" key]
+
+let () =
+  let repo_path = Sys.argv.(1) in
+  let hostname  = Sys.argv.(2) in
+  let bucket    = Sys.argv.(3) in
+  mkdir (repo_path ^ "/" ^ bucket);
+  Sys.chdir repo_path;
+  git_init ();
+  List.iter
+    (riak_get_value ~hostname ~bucket |- object_store ~bucket)
+    (riak_get_keys ~hostname ~bucket)