forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
/
database_server_main.ml
85 lines (73 loc) · 2.8 KB
/
database_server_main.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
open Threadext
type mode =
| Slave of string (* master IP *)
| Master of string (* database filename *)
let mode = ref None
let finished = ref false
let m = Mutex.create ()
let c = Condition.create ()
(** Handler for the remote database access URL *)
let remote_database_access_handler_v1 req bio =
try
Db_remote_cache_access_v1.handler req bio
with e ->
Printf.printf "Caught: %s\n" (Printexc.to_string e);
Printexc.print_backtrace stdout;
flush stdout;
raise e
(** Handler for the remote database access URL *)
let remote_database_access_handler_v2 req bio =
try
Db_remote_cache_access_v2.handler req bio
with e ->
Printf.printf "Caught: %s\n" (Printexc.to_string e);
Printexc.print_backtrace stdout;
flush stdout;
raise e
module Local_tests = Database_test.Tests(Db_cache_impl)
let schema = Test_schemas.schema
let _ =
let listen_path = ref "./database" in
let self_test = ref false in
Printexc.record_backtrace true;
Arg.parse [
"--slave-of", Arg.String (fun master -> mode := Some(Slave master)), "run as a slave of a remote db";
"--master", Arg.String (fun db -> mode := Some(Master db)), "run as a master from the given db filename";
"--listen-on", Arg.Set_string listen_path, Printf.sprintf "listen for requests on path (default %s)" !listen_path;
"--test", Arg.Set self_test, "Run unit tests in-process";
] (fun x -> Printf.fprintf stderr "Ignoring unknown parameter: %s\n%!" x)
"run a stand-alone database server";
match !mode with
| None -> failwith "Requires either --slave-of or --master arguments"
| Some mode ->
begin match mode with
| Slave _ -> failwith "unimplemented"
| Master db_filename ->
Printf.printf "Database path: %s\n%!" db_filename;
let db = Parse_db_conf.make db_filename in
Db_conn_store.initialise_db_connections [ db ];
let t = Db_backend.make () in
Db_cache_impl.make t [ db ] schema;
Db_cache_impl.sync [ db ] (Db_ref.get_database t);
Unixext.unlink_safe !listen_path;
let sockaddr = Unix.ADDR_UNIX !listen_path in
let socket = Http_svr.bind sockaddr "unix_rpc" in
let server = Http_svr.Server.empty in
Http_svr.add_handler server Http.Post "/post_remote_db_access" (Http_svr.BufIO remote_database_access_handler_v1);
Http_svr.add_handler server Http.Post "/post_remote_db_access_v2" (Http_svr.BufIO remote_database_access_handler_v2);
Http_svr.start server socket;
Printf.printf "server listening\n%!";
if !self_test then begin
Printf.printf "Running unit-tests\n%!";
Local_tests.main true;
Printf.printf "All tests passed\n%!";
end;
(* Wait for either completion *)
Mutex.execute m
(fun () ->
while not (!finished) do
Condition.wait c m
done
);
Http_svr.stop socket
end