diff --git a/src/client/arakoon_client.mli b/src/client/arakoon_client.mli index 88b9930a..bebd637e 100644 --- a/src/client/arakoon_client.mli +++ b/src/client/arakoon_client.mli @@ -21,16 +21,16 @@ class type client = object method get: ?allow_dirty:bool -> key -> value Lwt.t (** or fails with Arakoon_exc.Exception (E_NOT_FOUND,_) if there is none *) - method range: ?allow_dirty:bool -> key option -> bool -> key option -> bool -> int -> key list Lwt.t + method range: ?allow_dirty:bool -> key option -> bool -> key option -> bool -> int option -> key list Lwt.t (** will yield a list of key value pairs in range. *) method range_entries: ?allow_dirty:bool -> first:key option -> finc:bool -> - last:key option -> linc:bool -> max:int -> + last:key option -> linc:bool -> max:int option -> (key * value) list Lwt.t (** [range_entries ~first ~finc ~last ~linc ~max] - [max] is the maximum number of keys (if max < 0 then you want them all). + [max] is the maximum number of keys (None if you want them all). The keys fall in the range first..last. The booleans [finc] [linc] determine iff the boundaries are considered in the result @@ -39,10 +39,10 @@ method range_entries: method rev_range_entries: ?allow_dirty:bool -> first:key option -> finc:bool -> - last:key option -> linc:bool -> max:int -> + last:key option -> linc:bool -> max:int option -> (key * value) list Lwt.t (** [rev_range_entries ~first ~finc ~last ~linc ~max] - [max] is the maximum number of keys (if max < 0 then you want them all). + [max] is the maximum number of keys (None if you want them all). The keys fall in the range first..last. The booleans [finc] [linc] determine iff the boundaries are considered in the result diff --git a/src/client/benchmark.ml b/src/client/benchmark.ml index cbdb2bd6..c3a6aa92 100644 --- a/src/client/benchmark.ml +++ b/src/client/benchmark.ml @@ -127,7 +127,7 @@ let _range (client:Arakoon_client.client) () = and last = _cat "key" 9999 in Lwt_io.printlf "range %s true %s true -1" first last >>= fun () -> - client # range (Some first) true (Some last) true (-1) >>= fun keys -> + client # range (Some first) true (Some last) true None >>= fun keys -> Lwt_io.printlf "#keys %i" (List.length keys) let _time diff --git a/src/client/common.ml b/src/client/common.ml index f0b12dca..a51f7ff5 100644 --- a/src/client/common.ml +++ b/src/client/common.ml @@ -199,36 +199,23 @@ let delete_to out key = command_to out DELETE; Pack.string_to out key -let range_to b ~allow_dirty first finc last linc max = - (* command_to b RANGE; - Llio.bool_to b allow_dirty; - Llio.string_option_to b first; - Llio.bool_to b finc; - Llio.string_option_to b last; - Llio.bool_to b linc; - Llio.int_to b max - *) - failwith "todo" +let _range_params b cmd ~allow_dirty first finc last linc max = + command_to b cmd; + Pack.bool_to b allow_dirty; + Pack.string_option_to b first; + Pack.bool_to b finc; + Pack.string_option_to b last; + Pack.bool_to b linc; + Pack.option_to b Pack.vint_to max -let range_entries_to b ~allow_dirty first finc last linc max = - failwith "todo" - (* command_to b RANGE_ENTRIES; - Llio.bool_to b allow_dirty; - Llio.string_option_to b first; - Llio.bool_to b finc; - Llio.string_option_to b last; - Llio.bool_to b linc; - Llio.int_to b max*) +let range_to b ~allow_dirty first finc last linc (max:int option) = + _range_params b RANGE ~allow_dirty first finc last linc max +let range_entries_to b ~allow_dirty first finc last linc max = + _range_params b RANGE_ENTRIES ~allow_dirty first finc last linc max + let rev_range_entries_to b ~allow_dirty first finc last linc max = - failwith "todo" - (* command_to b REV_RANGE_ENTRIES; - Llio.bool_to b allow_dirty; - Llio.string_option_to b first; - Llio.bool_to b finc; - Llio.string_option_to b last; - Llio.bool_to b linc; - Llio.int_to b max *) + _range_params b REV_RANGE_ENTRIES ~allow_dirty first finc last linc max let prefix_keys_to b ~allow_dirty prefix max = command_to b PREFIX_KEYS; @@ -237,19 +224,15 @@ let prefix_keys_to b ~allow_dirty prefix max = Pack.vint_to b max let test_and_set_to b key expected wanted = - failwith "todo" -(* command_to b TEST_AND_SET; - Llio.string_to b key; - Llio.string_option_to b expected; - Llio.string_option_to b wanted *) + Pack.string_to b key; + Pack.string_option_to b expected; + Pack.string_option_to b wanted let user_function_to b name po = - failwith "todo" - (* command_to b USER_FUNCTION; - Llio.string_to b name; - Llio.string_option_to b po *) + Pack.string_to b name; + Pack.string_option_to b po let multiget_to b ~allow_dirty keys = command_to b MULTI_GET; @@ -369,7 +352,7 @@ let set_routing_delta (ic,oc) left sep right = response ic nothing -let _build_sequence_request buf changes = +let _build_sequence_request output changes = let update_buf = Buffer.create (32 * List.length changes) in let rec c2u = function | Arakoon_client.Set (k,v) -> Update.Set(k,v) @@ -381,7 +364,7 @@ let _build_sequence_request buf changes = let updates = List.map c2u changes in let seq = Update.Sequence updates in let () = Update.to_buffer update_buf seq in - let () = Llio.string_to buf (Buffer.contents update_buf) + let () = Pack.string_to output (Buffer.contents update_buf) in () let migrate_range (ic,oc) interval changes = @@ -397,15 +380,12 @@ let migrate_range (ic,oc) interval changes = let _sequence (ic,oc) changes cmd = - failwith "todo" - (* let outgoing buf = command_to buf cmd; _build_sequence_request buf changes in request oc (fun buf -> outgoing buf) >>= fun () -> response ic nothing - *) let sequence conn changes = _sequence conn changes SEQUENCE diff --git a/src/hope/bstore.ml b/src/hope/bstore.ml index 38c764d9..f6813b7d 100644 --- a/src/hope/bstore.ml +++ b/src/hope/bstore.ml @@ -86,18 +86,11 @@ module BStore = (struct | None -> None | Some k -> Some (pref_key k) - - let maxo max = - if max = -1 then None - else Some max - - let range t first finc last linc max = - let mo = maxo max in BS.range_latest t.store (opx true first ) finc (opx false last) linc - mo + max >>= fun ks -> Lwt.return (List.map unpref_key ks) @@ -116,8 +109,7 @@ module BStore = (struct Lwt.return () let _do_range_entries inner t first finc last linc max = - let mo = maxo max in - inner t.store (opx true first) finc (opx false last) linc mo + inner t.store (opx true first) finc (opx false last) linc max >>= fun kvs -> let unpref_kv (k,v) = (unpref_key k, v) in Lwt.return (List.map unpref_kv kvs) diff --git a/src/hope/c.ml b/src/hope/c.ml index 7bf457c3..458cea85 100644 --- a/src/hope/c.ml +++ b/src/hope/c.ml @@ -9,7 +9,7 @@ let my_read_command (ic,oc) = let s = 8 in let h = String.create s in Lwt_io.read_into_exactly ic h 0 s >>= fun () -> - Lwtc.log "my_read_command: h=%S" h >>= fun () -> + Lwtc.log "my_read_command: h=%S" h >>= fun () -> let masked,p0 = Llio.int32_from h 4 in let magic = Int32.logand masked _MAGIC in if magic <> _MAGIC @@ -58,14 +58,14 @@ module ProtocolHandler (S:Core.STORE) = struct Lwt.return () - let get_range_params ic = - Llio.input_bool ic >>= fun allow_dirty -> - Llio.input_string_option ic >>= fun (first:string option) -> - Llio.input_bool ic >>= fun finc -> - Llio.input_string_option ic >>= fun (last:string option) -> - Llio.input_bool ic >>= fun linc -> - Llio.input_int ic >>= fun max -> - Lwt.return (allow_dirty, first, finc, last, linc, max) + let get_range_params input = + let allow_dirty = Pack.input_bool input in + let first = Pack.input_string_option input in + let finc = Pack.input_bool input in + let last = Pack.input_string_option input in + let linc = Pack.input_bool input in + let max = Pack.input_option Pack.input_vint input in + (allow_dirty, first, finc, last, linc, max) let send_string_option oc so = Llio.output_int oc 0 >>= fun () -> @@ -127,8 +127,8 @@ module ProtocolHandler (S:Core.STORE) = struct ) (Client_protocol.handle_exception oc) in - let _do_range inner output = - get_range_params ic >>= fun (allow_dirty, first, finc, last, linc, max) -> + let _do_range rest inner output = + let (allow_dirty, first, finc, last, linc, max) = get_range_params rest in only_if_master allow_dirty (fun () -> inner store first finc last linc max >>= fun l -> @@ -137,10 +137,10 @@ module ProtocolHandler (S:Core.STORE) = struct Lwt.return false ) in - my_read_command conn >>= fun (comm, input) -> + my_read_command conn >>= fun (comm, rest) -> match comm with | Common.WHO_MASTER -> - Lwtc.log "who master" >>= fun () -> + Lwtc.log "who master" >>= fun () -> _get_meta store >>= fun ms -> let mo = extract_master_info ms in Llio.output_int32 oc 0l >>= fun () -> @@ -148,8 +148,8 @@ module ProtocolHandler (S:Core.STORE) = struct Lwt.return false | Common.SET -> begin - let key = Pack.input_string input in - let value = Pack.input_string input in + let key = Pack.input_string rest in + let value = Pack.input_string rest in Lwt.catch (fun () -> _set driver key value >>= fun () -> @@ -158,8 +158,8 @@ module ProtocolHandler (S:Core.STORE) = struct end | Common.GET -> begin - let allow_dirty =Pack.input_bool input in - let key = Pack.input_string input in + let allow_dirty =Pack.input_bool rest in + let key = Pack.input_string rest in let do_get () = _get store key >>= fun value -> Client_protocol.response_rc_string oc 0l value @@ -167,7 +167,7 @@ module ProtocolHandler (S:Core.STORE) = struct only_if_master allow_dirty do_get end | Common.DELETE -> - let key = Pack.input_string input in + let key = Pack.input_string rest in _delete driver key >>= fun () -> Client_protocol.response_ok_unit oc @@ -185,7 +185,7 @@ module ProtocolHandler (S:Core.STORE) = struct Lwt.catch (fun () -> begin - Llio.input_string ic >>= fun data -> + let data = Pack.input_string rest in let probably_sequence,_ = Core.update_from data 0 in let sequence = match probably_sequence with | Core.SEQUENCE _ -> probably_sequence @@ -199,52 +199,39 @@ module ProtocolHandler (S:Core.STORE) = struct end | Common.MULTI_GET -> begin - Llio.input_bool ic >>= fun allow_dirty -> - Llio.input_int ic >>= fun length -> + let allow_dirty = Pack.input_bool rest in + let keys = Pack.input_list Pack.input_string rest in let do_multi_get () = - let rec loop keys i = - if i = 0 then Lwt.return keys - else - begin - Llio.input_string ic >>= fun key -> - loop (key :: keys) (i-1) - end - in - loop [] length >>= fun keys -> Lwt_list.map_s (fun k -> _get store k ) keys >>= fun values -> Llio.output_int oc 0>>= fun () -> - Llio.output_int oc length >>= fun () -> - Lwt_list.iter_s (Llio.output_string oc) values >>= fun () -> + Llio.output_list Llio.output_string oc values >>= fun () -> Lwt.return false in only_if_master allow_dirty do_multi_get end - | Common.RANGE -> - _do_range S.range (Llio.output_list Llio.output_string) - | Common.REV_RANGE_ENTRIES -> - _do_range S.rev_range_entries Llio.output_kv_list - | Common.RANGE_ENTRIES -> - _do_range S.range_entries Llio.output_kv_list + | Common.RANGE -> _do_range rest S.range (Llio.output_list Llio.output_string) + | Common.REV_RANGE_ENTRIES -> _do_range rest S.rev_range_entries Llio.output_kv_list + | Common.RANGE_ENTRIES -> _do_range rest S.range_entries Llio.output_kv_list | Common.EXISTS -> - Llio.input_bool ic >>= fun allow_dirty -> - Llio.input_string ic >>= fun key -> + let allow_dirty = Pack.input_bool rest in + let key = Pack.input_string rest in let do_exists () = _safe_get store key >>= fun m_val -> Llio.output_int oc 0 >>= fun () -> - begin + let r = match m_val with - | None -> - Llio.output_bool oc false - | Some v -> - Llio.output_bool oc true - end >>= fun () -> + | None -> false + | Some _ -> true + in + Llio.output_bool oc r + >>= fun () -> Lwt.return false in only_if_master allow_dirty do_exists | Common.ASSERT -> - Llio.input_bool ic >>= fun allow_dirty -> - Llio.input_string ic >>= fun key -> - Llio.input_string_option ic >>= fun req_val -> + let allow_dirty = Pack.input_bool rest in + let key = Pack.input_string rest in + let req_val = Pack.input_string_option rest in let do_assert () = _safe_get store key >>= fun m_val -> if m_val <> req_val @@ -252,14 +239,14 @@ module ProtocolHandler (S:Core.STORE) = struct Lwt.fail (Common.XException(Arakoon_exc.E_ASSERTION_FAILED, key)) else Llio.output_int oc 0 >>= fun () -> - Lwt.return false + Lwt.return false in only_if_master allow_dirty do_assert | Common.CONFIRM -> begin - Llio.input_string ic >>= fun key -> - Llio.input_string ic >>= fun value -> + let key = Pack.input_string rest in + let value = Pack.input_string rest in let do_confirm () = begin _safe_get store key >>= fun v -> @@ -275,9 +262,9 @@ module ProtocolHandler (S:Core.STORE) = struct only_if_master false do_confirm end | Common.TEST_AND_SET -> - Llio.input_string ic >>= fun key -> - Llio.input_string_option ic >>= fun m_old -> - Llio.input_string_option ic >>= fun m_new -> + let key = Pack.input_string rest in + let m_old = Pack.input_string_option rest in + let m_new = Pack.input_string_option rest in let do_test_and_set () = _safe_get store key >>= fun m_val -> begin @@ -299,24 +286,24 @@ module ProtocolHandler (S:Core.STORE) = struct only_if_master false do_test_and_set - (* | _ -> Client_protocol.handle_exception oc (Failure "Command not implemented (yet)") *) + (* | _ -> Client_protocol.handle_exception oc (Failure "Command not implemented (yet)") *) - let protocol me driver store (ic,oc) = - let rec loop () = - begin - one_command me driver store (ic,oc) >>= fun stop -> - if stop - then Lwtc.log "end of session" - else - begin - Lwt_io.flush oc >>= fun () -> - loop () - end - end - in - Lwtc.log "session started" >>= fun () -> - prologue(ic,oc) >>= fun () -> - Lwtc.log "prologue ok" >>= fun () -> - loop () - + let protocol me driver store (ic,oc) = + let rec loop () = + begin + one_command me driver store (ic,oc) >>= fun stop -> + if stop + then Lwtc.log "end of session" + else + begin + Lwt_io.flush oc >>= fun () -> + loop () + end + end + in + Lwtc.log "session started" >>= fun () -> + prologue(ic,oc) >>= fun () -> + Lwtc.log "prologue ok" >>= fun () -> + loop () + end diff --git a/src/hope/core.ml b/src/hope/core.ml index d7930517..fc1b5bb3 100644 --- a/src/hope/core.ml +++ b/src/hope/core.ml @@ -93,9 +93,12 @@ module type STORE = sig val commit : t -> tick -> result Lwt.t val log : t -> bool -> update -> result Lwt.t val get : t -> k -> v option Lwt.t - val range: t -> string option -> bool -> string option -> bool -> int -> string list Lwt.t - val range_entries: t -> string option -> bool -> string option -> bool -> int -> (string*string) list Lwt.t - val rev_range_entries: t -> string option -> bool -> string option -> bool -> int -> (string*string) list Lwt.t + val range: t -> string option -> bool -> string option -> bool -> int option + -> string list Lwt.t + val range_entries: t -> string option -> bool -> string option -> bool -> int option + -> (string*string) list Lwt.t + val rev_range_entries: t -> string option -> bool -> string option -> bool -> int option + -> (string*string) list Lwt.t val last_entries: t -> tick -> Lwtc.oc -> unit Lwt.t val last_update: t -> (tick * update option) option Lwt.t val get_meta: t -> string option Lwt.t