diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 54ca453d..52f5f3cf 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -132,6 +132,7 @@ let _ = dispatch & function flag ["ocaml";"link";"is_main"]( S[A"-linkpkg"; A"src/libcutil.a"; + A"-cclib"; A"-lrt"; ]); flag ["ocaml";"byte";"link"] (S[A"-custom";]); diff --git a/src/lib/to_string.ml b/src/lib/to_string.ml index dd46bbf8..0f21e09a 100644 --- a/src/lib/to_string.ml +++ b/src/lib/to_string.ml @@ -17,6 +17,7 @@ external id : 'a -> 'a = "%identity" let int i = string_of_int i +let int64 i = Printf.sprintf "%LdL" i let string s = Printf.sprintf "%S" s let bool = function | true -> "true" diff --git a/src/libcutil.clib b/src/libcutil.clib index 030f3b91..1cfc9c34 100644 --- a/src/libcutil.clib +++ b/src/libcutil.clib @@ -2,3 +2,4 @@ arakoon_crc32c.o bsd_crc32c.o arakoon_limits.o tcp_info_stubs.o +clock_stubs.o diff --git a/src/node/node_main.ml b/src/node/node_main.ml index e5cd9a68..593b2e89 100644 --- a/src/node/node_main.ml +++ b/src/node/node_main.ml @@ -645,7 +645,7 @@ let _main_2 (type s) | Some (m, ls) -> if m = my_name || is_preferred_master m - || (Unix.gettimeofday ()) -. ls > lease_period + || (Mp_clock.get_timestamp ()) -. ls > lease_period then (* no master or the current master is also preferred *) Lwt.return_unit diff --git a/src/node/store.ml b/src/node/store.ml index 5054e8cb..286268f2 100644 --- a/src/node/store.ml +++ b/src/node/store.ml @@ -132,7 +132,7 @@ struct let _master store = try let m = S.get store __master_key in - let ls = Unix.gettimeofday () in + let ls = Mp_clock.get_timestamp () in Some (m,ls) with Not_found -> None diff --git a/src/node/sync_backend.ml b/src/node/sync_backend.ml index 03cf87c5..477769f4 100644 --- a/src/node/sync_backend.ml +++ b/src/node/sync_backend.ml @@ -406,7 +406,7 @@ struct match Node_cfg.get_master cfg with | Elected | Preferred _ | Forced _ -> begin - let now = Unix.gettimeofday () in + let now = Mp_clock.get_timestamp () in let diff = now -. ls in if diff < float lease_expiration then (Some m,"inside lease") diff --git a/src/paxos/master.ml b/src/paxos/master.ml index e58af51d..d5df071b 100644 --- a/src/paxos/master.ml +++ b/src/paxos/master.ml @@ -55,7 +55,7 @@ let master_consensus (type s) constants {mo;v;n;i; lew} () = | None -> inject_lease_expired 0.0 | Some (m, ls) when m = me -> - let diff = (Unix.gettimeofday ()) -. ls in + let diff = (Multi_paxos.get_timestamp ()) -. ls in if diff >= float constants.lease_expiration then (* if we get here because a LeaseExpired message is @@ -68,7 +68,7 @@ let master_consensus (type s) constants {mo;v;n;i; lew} () = inject_lease_expired ls | Some (_m, ls) (* when m <> me *) -> (* always insert a lease expired after picking up master role - from another node. do not compare gettimeofday with when the + from another node. do not compare timestamp with when the lease started, as we might have acted earlier than necessary with the lease expiration timeout from the other node *) inject_lease_expired ls in @@ -97,7 +97,7 @@ let stable_master (type s) constants ((n,new_i, lease_expire_waiters) as current if not (is_empty lease_expire_waiters) then begin - if (Unix.gettimeofday () -. ls) > 2.2 *. (float constants.lease_expiration) + if (Multi_paxos.get_timestamp () -. ls) > 2.2 *. (float constants.lease_expiration) then begin (* nobody is taking over, go to elections *) diff --git a/src/paxos/mp_clock.ml b/src/paxos/mp_clock.ml new file mode 100644 index 00000000..4a95a7bb --- /dev/null +++ b/src/paxos/mp_clock.ml @@ -0,0 +1,25 @@ +(* + * Copyright (2010-2014) INCUBAID BVBA + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + *) + +let get_timestamp = + let open Clock in + match get_clock CLOCK_MONOTONIC_RAW with + | None -> failwith "Unknown clock: CLOCK_MONOTONIC_RAW" + | Some clk -> fun () -> + let ts = get_time clk in + Timespec.to_float ts + + diff --git a/src/paxos/multi_paxos.ml b/src/paxos/multi_paxos.ml index 7cea3226..74cb6f31 100644 --- a/src/paxos/multi_paxos.ml +++ b/src/paxos/multi_paxos.ml @@ -21,6 +21,7 @@ open MPMessage open Messaging open Master_type +let get_timestamp = Mp_clock.get_timestamp let section = let s = Logger.Section.make "paxos" in @@ -46,7 +47,7 @@ let can_promise (type s) (module S : Store.STORE with type t = s) store lease_ex match S.who_master store with | Some (m, ml) -> if ( - ( (ml +. float lease_expiration) > (Unix.gettimeofday ()) ) + ( (ml +. float lease_expiration) > (get_timestamp ()) ) && (String.compare requester m) <> 0 ) @@ -223,12 +224,12 @@ let start_lease_expiration_thread (type s) ?(immediate_lease_expiration=false) c begin Logger.debug_f_ "%s: waiting %2.1f seconds for lease to expire" constants.me sleep_sec >>= fun () -> - let t0 = Unix.gettimeofday () in + let t0 = get_timestamp () in Lwt_unix.sleep sleep_sec >>= fun () -> if id = constants.lease_expiration_id then begin - let t1 = Unix.gettimeofday () in + let t1 = get_timestamp () in Logger.debug_f_ "%s: lease expired (%2.1f passed, %2.1f intended)=> injecting LeaseExpired event for %f" constants.me (t1 -. t0) sleep_sec lease_start >>= fun () -> constants.inject_event (LeaseExpired (lease_start)) >>= fun () -> @@ -260,9 +261,9 @@ let start_election_timeout ?(from_master=false) constants n i = begin let rec t sleep_sec = Logger.debug_f_ "%s: waiting %2.1f seconds for timeout" constants.me sleep_sec >>= fun () -> - let t0 = Unix.gettimeofday () in + let t0 = get_timestamp () in Lwt_unix.sleep sleep_sec >>= fun () -> - let t1 = Unix.gettimeofday () in + let t1 = get_timestamp () in Logger.debug_f_ "%s: timeout (n=%s) should have finished by now (%2.1f passed, intended %2.1f)." constants.me (Sn.string_of n) (t1 -. t0) sleep_sec >>= fun () -> match constants.election_timeout with | None -> Logger.warning_f_ "%s: scheduled election timeout thread but no timeout configured!" constants.me @@ -279,7 +280,7 @@ let start_election_timeout ?(from_master=false) constants n i = Lwt.ignore_result (t sleep_sec) end | Some _ -> () in - constants.election_timeout <- Some (n, i, Unix.gettimeofday () +. sleep_sec); + constants.election_timeout <- Some (n, i, get_timestamp () +. sleep_sec); Lwt.return () type prepare_repsonse = @@ -341,7 +342,7 @@ let handle_prepare (type s) constants dest n n' i' = begin (* Ok, we can make a Promise to the other node, if we want to *) let make_promise () = - constants.respect_run_master <- Some (dest, Unix.gettimeofday () +. (float constants.lease_expiration) /. 4.0); + constants.respect_run_master <- Some (dest, get_timestamp () +. (float constants.lease_expiration) /. 4.0); let lv = constants.get_value nak_max in let reply = Promise(n',nak_max,lv) in Logger.info_f_ "%s: handle_prepare: starting election timer" me >>= fun () -> @@ -357,7 +358,7 @@ let handle_prepare (type s) constants dest n n' i' = | None -> make_promise () | Some (other, until) -> - let now = Unix.gettimeofday () in + let now = get_timestamp () in if until < now || dest = other then begin diff --git a/src/paxos/multi_paxos_fsm.ml b/src/paxos/multi_paxos_fsm.ml index a384cc73..cf61a29c 100644 --- a/src/paxos/multi_paxos_fsm.ml +++ b/src/paxos/multi_paxos_fsm.ml @@ -627,7 +627,7 @@ let paxos_produce buffers constants product_wanted = Lwt.catch (fun () -> Logger.debug_f_ "%s: T:waiting for event (%s)" me wmsg >>= fun () -> - let t0 = Unix.gettimeofday () in + let t0 = Multi_paxos.get_timestamp () in let wait_for_buffer = function | Client -> Lwt_buffer.wait_for_item buffers.client_buffer @@ -639,7 +639,7 @@ let paxos_produce buffers constants product_wanted = product_wanted in Lwt.pick waiters >>= fun () -> - let t1 = Unix.gettimeofday () in + let t1 = Multi_paxos.get_timestamp () in let d = t1 -. t0 in Logger.debug_f_ "%s: T:waiting for event took:%f" me d >>= fun () -> @@ -782,7 +782,7 @@ let enter_simple_paxos (type s) ?(stop = ref false) constants buffers current_i let other_master = match S.who_master constants.store with | None -> false | Some (_, ls) -> - let diff = (Unix.gettimeofday ()) -. ls in + let diff = (Multi_paxos.get_timestamp ()) -. ls in diff < float constants.lease_expiration in let run start_state = Lwt.catch diff --git a/src/paxos/slave.ml b/src/paxos/slave.ml index d4f6b878..d797c066 100644 --- a/src/paxos/slave.ml +++ b/src/paxos/slave.ml @@ -28,7 +28,7 @@ let time_for_elections ?invalidate_lease_start_until (type s) constants = begin let invalidate_lease_start_until = match invalidate_lease_start_until with | Some x -> x - | None -> Unix.gettimeofday () -. (float constants.lease_expiration) in + | None -> Multi_paxos.get_timestamp () -. (float constants.lease_expiration) in let lease_start = match S.who_master constants.store with | None -> 0.0 @@ -43,7 +43,7 @@ let time_for_elections ?invalidate_lease_start_until (type s) constants = | None -> return true | Some(_, until) -> - if Unix.gettimeofday () < until + if Multi_paxos.get_timestamp () < until then false, "lease expired, but respecting another node running for master" else @@ -287,7 +287,7 @@ let slave_discovered_other_master (type s) constants state () = let master_before = S.who_master store in let lease_expired = match master_before with | None -> true - | Some (_, ls) -> ls +. (float_of_int constants.lease_expiration) <= Unix.gettimeofday () in + | Some (_, ls) -> ls +. (float_of_int constants.lease_expiration) <= Multi_paxos.get_timestamp () in Catchup.catchup ~tls_ctx ~stop:constants.stop diff --git a/src/paxos/value.ml b/src/paxos/value.ml index 1182f701..2edd0398 100644 --- a/src/paxos/value.ml +++ b/src/paxos/value.ml @@ -24,7 +24,7 @@ type t = let create_client_value (us:Update.t list) (synced:bool) = Vc (us, synced) let create_master_value - ?(lease_start = Unix.gettimeofday ()) + ?(lease_start = Mp_clock.get_timestamp ()) m = Vm (m,lease_start) @@ -48,7 +48,7 @@ let clear_self_master_set me = function let fill_other_master_set me = function | Vm (m,_) when m <> me -> - let now = Unix.gettimeofday () in + let now = Mp_clock.get_timestamp () in Vm(m,now) | Vc _ | Vm _ as v -> v diff --git a/src/system/startup.ml b/src/system/startup.ml index 770e7be5..bec04563 100644 --- a/src/system/startup.ml +++ b/src/system/startup.ml @@ -161,7 +161,7 @@ let post_failure () = let v1 = Value.create_client_value [Update.Set("x","y")] false in let tlcs = Hashtbl.create 5 in let stores = Hashtbl.create 5 in - let now = Unix.gettimeofday () in + let now = Multi_paxos.get_timestamp () in let run_node0 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0;v1] node0 in let run_node1 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0;v1] node1 in @@ -221,7 +221,7 @@ let restart_slaves () = let v1 = Value.create_client_value [Update.Set("xxx","xxx")] false in let tlcs = Hashtbl.create 5 in let stores = Hashtbl.create 5 in - let now = Unix.gettimeofday () in + let now = Multi_paxos.get_timestamp () in let run_node0 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0] node0 in let run_node1 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0;v1] node1 in (* let run_node2 = _make_run ~stores ~tlcs ~now ~get_cfgs ~updates:[u0;u1] node2 in *) @@ -280,7 +280,7 @@ let ahead_master_loses_role () = let v2 = Value.create_client_value [Update.Set("invalidkey", "shouldnotbepresent")] false in let tlcs = Hashtbl.create 5 in let stores = Hashtbl.create 5 in - let now = Unix.gettimeofday () in + let now = Multi_paxos.get_timestamp () in let t_node0 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0] node0 () in let t_node1 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0;v0;v1] node1 () in @@ -349,7 +349,7 @@ let interrupted_election () = let v0 = Value.create_master_value ~lease_start:0. wannabe_master in let tlcs = Hashtbl.create 5 in let stores = Hashtbl.create 5 in - let now = Unix.gettimeofday () in + let now = Multi_paxos.get_timestamp () in let t_node2 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0] node2 () in let t_node3 = _make_run ~stores ~tlcs ~now ~get_cfgs ~values:[v0] node3 () in Lwt.ignore_result t_node2; @@ -412,10 +412,10 @@ let interrupted_election () = phase2 () in Lwt.pick - [(let t0 = Unix.gettimeofday () in + [(let t0 = Multi_paxos.get_timestamp () in phase1 () >>= fun () -> phase2 () >>= fun () -> - let t1 = Unix.gettimeofday () in + let t1 = Multi_paxos.get_timestamp () in let delta = t1 -. t0 in if (delta > (float lease_period)) then Lwt.return () diff --git a/src/tools/clock.ml b/src/tools/clock.ml new file mode 100644 index 00000000..4a88e7af --- /dev/null +++ b/src/tools/clock.ml @@ -0,0 +1,81 @@ +(* + * Copyright 2014, Incubaid BVBA + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + *) + +module Clock : sig + type clock = CLOCK_REALTIME + | CLOCK_REALTIME_COARSE + | CLOCK_MONOTONIC + | CLOCK_MONOTONIC_COARSE + | CLOCK_MONOTONIC_RAW + | CLOCK_BOOTTIME + | CLOCK_PROCESS_CPUTIME_ID + | CLOCK_THREAD_CPUTIME_ID + + type clock_id + + module Timespec : sig + type t = { sec : int64 + ; nsec : int64 + } + + val to_float : t -> float + val to_string : t -> string + end + + val get_clock : clock -> clock_id option + val get_time : clock_id -> Timespec.t + val get_res : clock_id -> Timespec.t +end = struct + type clock = CLOCK_REALTIME + | CLOCK_REALTIME_COARSE + | CLOCK_MONOTONIC + | CLOCK_MONOTONIC_COARSE + | CLOCK_MONOTONIC_RAW + | CLOCK_BOOTTIME + | CLOCK_PROCESS_CPUTIME_ID + | CLOCK_THREAD_CPUTIME_ID + + type clock_id = int + + module Timespec = struct + type t = { sec : int64 + ; nsec : int64 + } + + let to_float t = Int64.to_float t.sec +. (Int64.to_float t.nsec /. 1000000000.) + let to_string t = + let open To_string in + record [ "sec", int64 t.sec + ; "nsec", int64 t.nsec + ] + end + + external _arakoon_clocks_getclockid : int -> int option = "arakoon_clocks_getclockid" + external get_time : clock_id -> Timespec.t = "arakoon_clocks_gettime" + external get_res : clock_id -> Timespec.t = "arakoon_clocks_getres" + + let get_clock = function + | CLOCK_REALTIME -> _arakoon_clocks_getclockid 1 + | CLOCK_REALTIME_COARSE -> _arakoon_clocks_getclockid 2 + | CLOCK_MONOTONIC -> _arakoon_clocks_getclockid 3 + | CLOCK_MONOTONIC_COARSE -> _arakoon_clocks_getclockid 4 + | CLOCK_MONOTONIC_RAW -> _arakoon_clocks_getclockid 5 + | CLOCK_BOOTTIME -> _arakoon_clocks_getclockid 6 + | CLOCK_PROCESS_CPUTIME_ID -> _arakoon_clocks_getclockid 7 + | CLOCK_THREAD_CPUTIME_ID -> _arakoon_clocks_getclockid 8 +end + +include Clock diff --git a/src/tools/clock_stubs.c b/src/tools/clock_stubs.c new file mode 100644 index 00000000..d1a9cf1d --- /dev/null +++ b/src/tools/clock_stubs.c @@ -0,0 +1,135 @@ +/* + * Copyright 2014, Incubaid BVBA + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +#include +#include + +#include +#include +#include +#include + +#define Val_none Val_int(0) +static value Val_some(value v) { + CAMLparam1(v); + CAMLlocal1(res); + + res = caml_alloc(1, 0); + Store_field(res, 0, v); + + CAMLreturn(res); +} + +enum clocks { + REALTIME = 1, + REALTIME_COARSE = 2, + MONOTONIC = 3, + MONOTONIC_COARSE = 4, + MONOTONIC_RAW = 5, + BOOTTIME = 6, + PROCESS_CPUTIME_ID = 7, + THREAD_CPUTIME_ID = 8 +}; + +CAMLprim value arakoon_clocks_getclockid(value clock) { + CAMLparam1(clock); + CAMLlocal1(res); + + switch(Int_val(clock)) { + case REALTIME: + res = Val_some(Val_int(CLOCK_REALTIME)); + break; +#ifdef CLOCK_REALTIME_COARSE + case REALTIME_COARSE: + res = Val_some(Val_int(CLOCK_REALTIME_COARSE)); + break; +#endif +#ifdef CLOCK_MONOTONIC + case MONOTONIC: + res = Val_some(Val_int(CLOCK_MONOTONIC)); + break; +#endif +#ifdef CLOCK_MONOTONIC_COARSE + case MONOTONIC_COARSE: + res = Val_some(Val_int(CLOCK_MONOTONIC_COARSE)); + break; +#endif +#ifdef CLOCK_MONOTONIC_RAW + case MONOTONIC_RAW: + res = Val_some(Val_int(CLOCK_MONOTONIC_RAW)); + break; +#endif +#ifdef CLOCK_BOOTTIME + case BOOTTIME: + res = Val_some(Val_int(CLOCK_BOOTTIME)); + break; +#endif +#ifdef CLOCK_PROCESS_CPUTIME_ID + case PROCESS_CPUTIME_ID: + res = Val_some(Val_int(CLOCK_PROCESS_CPUTIME_ID)); + break; +#endif +#ifdef CLOCK_THREAD_CPUTIME_ID + case THREAD_CPUTIME_ID: + res = Val_some(Val_int(CLOCK_THREAD_CPUTIME_ID)); + break; +#endif + default: + res = Val_none; + } + + CAMLreturn(res); +} + +CAMLprim value arakoon_clocks_gettime(value clock) { + CAMLparam1(clock); + CAMLlocal1(res); + + struct timespec ts; + int rc = 0; + + rc = clock_gettime(Int_val(clock), &ts); + + if(rc != 0) { + unix_error(errno, "clock_gettime", Nothing); + } + + res = caml_alloc(2, 0); + Store_field(res, 0, caml_copy_int64(ts.tv_sec)); + Store_field(res, 1, caml_copy_int64(ts.tv_nsec)); + + CAMLreturn(res); +} + +CAMLprim value arakoon_clocks_getres(value clock) { + CAMLparam1(clock); + CAMLlocal1(res); + + struct timespec ts; + int rc = 0; + + rc = clock_getres(Int_val(clock), &ts); + + if(rc != 0) { + unix_error(errno, "clock_getres", Nothing); + } + + res = caml_alloc(2, 0); + Store_field(res, 0, caml_copy_int64(ts.tv_sec)); + Store_field(res, 1, caml_copy_int64(ts.tv_nsec)); + + CAMLreturn(res); +}