Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[fix] badop: fixed closure comparison during command-line parsing

  • Loading branch information...
commit 0f295898e8b37411d8fd15ff0390b2df7fe20f21 1 parent d2e242d
Louis Gesbert authored
View
13 database/badop.ml
@@ -234,6 +234,9 @@ module Aux : sig
('which, 'transaction1, 'revision1) generic_write_op list ->
('which, 'transaction2, 'revision2) generic_write_op list Cps.t
+ (** checks if the two sets of options may conflict (bind to the same database twice) *)
+ val options_conflict: options -> options -> bool
+
(** Printers and debug helpers *)
val path_to_string: path -> string
@@ -337,5 +340,15 @@ end = struct
in
Cps.List.fold wr [] l_op k
+ let rec options_conflict o1 o2 = match (o1,o2) with
+ | Options_Local l1, Options_Local l2 -> l1 = l2
+ | Options_Client (_,remote1,_), Options_Client (_,remote2,_) -> remote1 = remote2
+ | Options_Debug (_,o1), o2
+ | o1, Options_Debug (_,o2) -> options_conflict o1 o2
+ | Options_Dispatcher (_, ol), o
+ | o, Options_Dispatcher (_, ol) ->
+ List.exists (fun o1 -> options_conflict o1 o) ol
+ | _ -> false
+
let path_to_string = Path.to_string
end
View
14 database/badop_meta.ml
@@ -74,8 +74,8 @@ let options_parser_with_default ?name (_default_m, default_o) =
["--db-remote"],
A.func A.parse_addr
(fun (_,o) (addr,portopt) ->
- if o <> default_o
- then prerr_endline ("Warning: database options before --db-remote will be ignored"^spec_msg);
+ if o != default_o
+ then Logger.warning "Warning: database options before --db-remote will be ignored%s" spec_msg;
(module Badop_client : Badop.S),
Badop.Options_Client (Scheduler.default, (addr, Option.default default_port portopt), fun () -> `abort)),
"<host>[:<port>]",
@@ -89,8 +89,8 @@ let options_parser_with_default ?name (_default_m, default_o) =
["--db-local"],
A.func (A.option A.string)
(fun (_,o) str_opt ->
- if o <> default_o
- then prerr_endline ("Warning: database options before --db-local will be ignored"^spec_msg);
+ if o != default_o
+ then Logger.warning "Warning: database options before --db-local will be ignored%s" spec_msg;
let path,flags = match str_opt with
| Some str -> Base.String.split_char_last ':' str
| None -> "", ""
@@ -127,7 +127,7 @@ let options_parser_with_default ?name (_default_m, default_o) =
in r,lflags in
if not (List.is_empty lflags) then
- (prerr_endline ("Error: unknown db flag "^(List.print (fun x -> x) lflags)^spec_msg); raise Exit);
+ (Logger.warning "Error: unknown db flag %s%s" (List.print (fun x -> x) lflags) spec_msg; raise Exit);
(module Badop_local : Badop.S),
Badop.Options_Local { Badop. path; restore; dot; readonly; revision = None }),
@@ -147,8 +147,8 @@ let options_parser_with_default ?name (_default_m, default_o) =
["--db-remote-replicated"],
A.func (A.list ',' A.parse_addr)
(fun (_,o) addrlist ->
- if o <> default_o
- then prerr_endline ("Warning: database options before --db-remote-replicated will be ignored"^spec_msg);
+ if o != default_o
+ then Logger.warning "Warning: database options before --db-remote-replicated will be ignored%s "spec_msg;
(module Badop_dispatcher.F(Badop_client) : Badop.S),
Badop.Options_Dispatcher
(List.length addrlist,
View
25 opabsl/mlbsl/badop_engine.ml
@@ -152,17 +152,20 @@ let db_options =
arguments := rest (* consume the specific arguments, not the generic ones *)
;
(* check for conflicting options with previous settings *)
- match Base.List.assoc_opt (snd options.engine_options) (!parsed_engine_options) with
- | Some conflicting_db ->
- Printf.fprintf stderr
- "Error: conflicting configuration for databases \"%s\" and \"%s\": same location%s.\n%!"
- conflicting_db (Option.default "database" ident)
- (match snd options.engine_options with
- | Badop.Options_Local { Badop.path = str; _ } -> Printf.sprintf " (%s)" str
- | Badop.Options_Client (_,(h,p), _) -> Printf.sprintf " (%s:%d)" (Unix.string_of_inet_addr h) p
- | _ -> "");
- exit 1
- | None ->
+ try
+ let conflicting_db =
+ Base.List.assoc_custom_equality ~eq:Badop.Aux.options_conflict
+ (snd options.engine_options) !parsed_engine_options
+ in
+ Logger.critical
+ "Error: conflicting configuration for databases \"%s\" and \"%s\": same location%s."
+ conflicting_db (Option.default "database" ident)
+ (match snd options.engine_options with
+ | Badop.Options_Local { Badop.path = str; _ } -> Printf.sprintf " (%s)" str
+ | Badop.Options_Client (_,(h,p), _) -> Printf.sprintf " (%s:%d)" (Unix.string_of_inet_addr h) p
+ | _ -> "");
+ exit 1
+ with Not_found ->
parsed_engine_options :=
(snd options.engine_options, Option.default "database" ident) :: !parsed_engine_options;
options
Please sign in to comment.
Something went wrong with that request. Please try again.