Permalink
Browse files

[fix] database: adding the possibility to automatically attempt to re…

…connect to a lost database server
  • Loading branch information...
1 parent 17be19a commit 6ff7da0fce0040aae1ff91852fdeeab6e0c6958b Louis Gesbert committed Jun 28, 2011
Showing with 25 additions and 15 deletions.
  1. +2 −1 database/badop.ml
  2. +5 −4 database/badop_client.ml
  3. +1 −1 database/badop_meta.ml
  4. +2 −1 libbase/debugVariables.ml
  5. +13 −7 libbase/debugVariables.mli
  6. +2 −1 opabsl/mlbsl/bsl-sources
View
@@ -128,7 +128,8 @@ type local_options =
type options =
| Options_Local of local_options
- | Options_Client of Scheduler.t * (Unix.inet_addr * int) (** scheduler, server *)
+ | Options_Client of Scheduler.t * (Unix.inet_addr * int) * (unit -> [ `retry of Time.t | `abort ])
+ (** scheduler, server, on_disconnect *)
| Options_Debug of string * options (** debug line prefix, backend options *)
| Options_Dispatcher of int * options list (** flat-replication factor, backends options *)
View
@@ -33,13 +33,14 @@ include Badop_protocol.F
module N = Hlnet
let open_database options k =
- let scheduler, remote = match options with
- | Badop.Options_Client (scheduler,(addr,port)) -> scheduler, N.Tcp (addr,port)
+ let scheduler, remote, on_disconnect = match options with
+ | Badop.Options_Client (scheduler,(addr,port), on_disconnect) -> scheduler, N.Tcp (addr,port), on_disconnect
| _ -> assert false
in
let on_disconnect () =
- Logger.error "Can not connect to %s" (N.endpoint_to_string remote);
- `abort in
+ Logger.error "Disconnected from %s" (N.endpoint_to_string remote);
+ on_disconnect()
+ in
N.open_channel scheduler remote ~on_disconnect database_channel_spec @> k
let close_database db k = N.close_channel db |> k
View
@@ -77,7 +77,7 @@ let options_parser_with_default ?name (_default_m, default_o) =
if o <> default_o
then prerr_endline ("Warning: database options before --db-remote will be ignored"^spec_msg);
(module Badop_client : Badop.S),
- Badop.Options_Client (Scheduler.default, (addr, Option.default default_port portopt))),
+ Badop.Options_Client (Scheduler.default, (addr, Option.default default_port portopt), fun () -> `abort)),
"<host>[:<port>]",
(let default_str = match default_o with
| Badop.Options_Client(_,(host,port),_) ->
@@ -63,8 +63,8 @@ let cps_keep_letcont = var "cps_keep_letcont"
let cps_noskip = var "cps_noskip"
let cps_stack_trace = var "cps_stack_trace"
let cps_verbose = var "cps_verbose"
+let database_reconnect = var "database_reconnect"
let db3_no_final_snapshot = var "db3_no_final_snapshot"
-let low_level_db_log = var "low_level_db_log"
let db3_transaction_limit = var "db3_transaction_limit"
let dbgen_always_upgrade = var "dbgen_always_upgrade"
let dbgen_butcher = var "dbgen_butcher"
@@ -101,6 +101,7 @@ let js_serialize = var "js_serialize"
let lambda_coerce = var "lambda_coerce"
let lambda_correct = var "lambda_correct"
let lambda_debug = var "lambda_debug"
+let low_level_db_log = var "low_level_db_log"
let no_access_log = var "no_access_log"
let no_database_upgrade = var "no_database_upgrade"
let no_flood_prevention = var "no_flood_prevention"
View
@@ -398,6 +398,12 @@ val cps_verbose : debug_var
*)
val cps_blocking_wait : debug_var
+(** {b MLSTATE_DATABASE_RECONNECT}
+ Set up a delay in seconds for automatic reconnection when a database server is lost.
+ (if unset, never reconnect automatically)
+*)
+val database_reconnect : debug_var
+
(**
{b MLSTATE_DB3_NO_FINAL_SNAPSHOT}
When activated, when the database is closed, we do not make a snapshot of the current revision,
@@ -408,13 +414,6 @@ val cps_blocking_wait : debug_var
*)
val db3_no_final_snapshot : debug_var
-(**
- {b MLSTATE_LOW_LEVEL_DB_LOG}
- When activated, the low level database will print disk writing related log in
- 'low_level_db.log' file.
-*)
-val low_level_db_log : debug_var
-
(**
{b MLSTATE_DB3_TRANSACTION_LIMIT}
Defines a limit of operations within a transaction, after which it is automatically aborted.
@@ -592,6 +591,13 @@ val lambda_correct : debug_var (** check that the code is well lambda lifted
is not correct anyway
*)
+(**
+ {b MLSTATE_LOW_LEVEL_DB_LOG}
+ When activated, the low level database will print disk writing related log in
+ 'low_level_db.log' file.
+*)
+val low_level_db_log : debug_var
+
(**
{b MLSTATE_NO_ACCESS_LOG}
*)
View
@@ -44,13 +44,14 @@ bslJsIdent.ml
bslInit.ml
bslClientCode.ml
+bslServer_event.ml
+
# Database handling
badop_engine.ml
badoplink.ml
transactions.ml
path.ml
dbser.ml
-bslServer_event.ml
bslCommandLine.ml
bslXmlm.ml

0 comments on commit 6ff7da0

Please sign in to comment.