Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 7c62863b04
Fetching contributors…

Cannot retrieve contributors at this time

790 lines (690 sloc) 32.565 kB
(*
* Copyright (C) 2006-2009 Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
open Pervasiveext
open Threadext
open Stringext
module R = Debug.Debugger(struct let name = "redo_log" end)
(* --------------------------------------- *)
(* Functions relating to the redo log VDI. *)
let get_static_device reason =
(* Specifically use Static_vdis_list rather than Static_vdis to avoid the
cyclic dependency caused by reference to Server_helpers in Static_vdis *)
let vdis = List.filter
(fun x -> x.Static_vdis_list.reason = reason && x.Static_vdis_list.currently_attached)
(Static_vdis_list.list ())
in
(* Return the path to the first attached VDI which matches the reason *)
R.debug "Found %d VDIs matching [%s]" (List.length vdis) reason;
match vdis with
| [] -> None
| hd :: _ -> hd.Static_vdis_list.path
(* Make sure we have plenty of room for the database *)
let minimum_vdi_size =
let ( ** ) = Int64.mul in
let mib = 1024L ** 1024L in
256L ** mib
let redo_log_sm_config = [ "type", "raw" ]
(* ---------------------------------------------------- *)
(* Encapsulate the state of a single redo_log instance. *)
type redo_log = {
name: string;
marker: string;
read_only: bool;
enabled: bool ref;
device: string option ref;
currently_accessible: bool ref;
state_change_callback: (bool -> unit) option;
time_of_last_failure: float ref;
backoff_delay: int ref;
sock: Unix.file_descr option ref;
pid: (Forkhelpers.pidty * string * string) option ref;
dying_processes_mutex: Mutex.t;
num_dying_processes: int ref;
}
module RedoLogSet = Set.Make(
struct
type t = redo_log
let compare = fun log1 log2 -> compare log1.marker log2.marker
end
)
(* Keep a store of all redo_logs - this will make it easy to write to all the active ones. *)
let all_redo_logs = ref (RedoLogSet.empty)
(* ------------------------------------------------------------------------ *)
(* Functions relating to whether writing to the log is enabled or disabled. *)
let ready_to_write = ref true (* Controls whether DB writes are also copied to the redo log. *)
let is_enabled log = !(log.enabled)
let enable log vdi_reason =
R.info "Enabling use of redo log";
log.device := get_static_device vdi_reason;
log.enabled := true
let enable_block log path =
R.info "Enabling use of redo log";
log.device := Some path;
log.enabled := true
let disable log =
R.info "Disabling use of redo log";
log.device := None;
log.enabled := false
(* ------------------------------------------------------------------------------------------------ *)
(* Functions relating to whether the latest attempt to read/write the redo-log succeeded or failed. *)
let redo_log_events = Event.new_channel ()
let cannot_connect_fn log =
if !(log.currently_accessible) then begin
R.debug "Signalling unable to access redo log";
Event.sync (Event.send redo_log_events (log.name, false));
Opt.iter (fun callback -> callback false) log.state_change_callback
end;
log.currently_accessible := false
let can_connect_fn log =
if not !(log.currently_accessible) then begin
R.debug "Signalling redo log is healthy";
Event.sync (Event.send redo_log_events (log.name, true));
Opt.iter (fun callback -> callback true) log.state_change_callback
end;
log.currently_accessible := true
(* ----------------------------------------------------------- *)
(* Functions relating to the serialisation of redo log entries *)
(* The type of a delta, describing an incremental change to the database. *)
type t =
(* (tblname, newobjref, (k,v) list) *)
| CreateRow of string * string * (string*string) list
(* (tblname, objref) *)
| DeleteRow of string * string
(* (tblname, objref, fldname, newval) *)
| WriteField of string * string * string * string
(* First 9 bytes of encoding of entries is an ASCII string indicating the kind of record, from {"CreateRow", "DeleteRow", "WriteFiel"} *)
(* Constituent strings are expressed as "<length><string>", where the length is specified in decimal using 8 ASCII digits *)
exception MalformedLogEntry of string
let kind_size = 9 (* number of bytes to indicate kind of record *)
let short_length_size = 8 (* number of bytes to encode a string's length *)
let redo_log_entry_to_string r =
match r with
| CreateRow(tbl, objref, kvs) ->
Printf.sprintf "CreateRow%08d%s%08d%s%08d%s" (String.length tbl) tbl (String.length objref) objref (List.length kvs)
(String.concat ""
(List.map (fun (k,v) -> Printf.sprintf "%08d%s%08d%s" (String.length k) k (String.length v) v) kvs)
)
| DeleteRow(tbl, objref) ->
Printf.sprintf "DeleteRow%08d%s%08d%s" (String.length tbl) tbl (String.length objref) objref
| WriteField(tblname, objref, fldname, newval) ->
Printf.sprintf "WriteFiel%08d%s%08d%s%08d%s%08d%s" (String.length tblname) tblname (String.length objref) objref (String.length fldname) fldname (String.length newval) newval
let parse_string str len pos =
let str = String.sub str !pos len in
pos := !pos + len;
str
let parse_num str pos =
let len_str = parse_string str short_length_size pos in
let len = (try int_of_string len_str with _ -> 0) in
len
let parse_length_and_string str pos =
let len = parse_num str pos in
parse_string str len pos
let string_to_redo_log_entry str =
let pos = ref 0 in
let kind = parse_string str kind_size pos in
match kind with
| "CreateRow" ->
let tbl = parse_length_and_string str pos in
let objref = parse_length_and_string str pos in
let num_kvs = parse_num str pos in
(* Parse key-value pairs *)
let parse_kvs n =
let rec aux acc = function
| 0 -> acc
| n ->
let k = parse_length_and_string str pos in
let v = parse_length_and_string str pos in
aux ((k,v)::acc) (n-1)
in aux [] n
in
let kvs = parse_kvs num_kvs in
CreateRow (tbl, objref, kvs)
| "DeleteRow" ->
let tbl = parse_length_and_string str pos in
let objref = parse_length_and_string str pos in
DeleteRow (tbl, objref)
| "WriteFiel" ->
let tbl = parse_length_and_string str pos in
let objref = parse_length_and_string str pos in
let fldname = parse_length_and_string str pos in
let newval = parse_length_and_string str pos in
WriteField (tbl, objref, fldname, newval)
| s -> (* unrecognised log entry *)
raise (MalformedLogEntry s)
(* ---------------------------------------------------------------------- *)
(* Functions relating to communication with the block device I/O process. *)
exception RedoLogFailure of string
exception CommunicationsProblem of string
let prog = Filename.concat Fhs.libexecdir "block_device_io"
let generation_size = 16
let length_size = 16
let get_latest_response_time block_time =
let now = Unix.gettimeofday() in
now +. block_time
(* Returns the PID of the process *)
let start_io_process block_dev ctrlsockpath datasockpath =
(* Check that the process exists and is executable *)
Unix.access prog [Unix.F_OK; Unix.X_OK]; (* raises Unix.Unix_error if the file does not exist or is not executable *)
(* Execute the process *)
let args = ["-device"; block_dev; "-ctrlsock"; ctrlsockpath; "-datasock"; datasockpath] in
Forkhelpers.safe_close_and_exec None None None [] prog args
let connect sockpath latest_response_time =
let rec attempt () =
let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
try
Unix.connect s (Unix.ADDR_UNIX sockpath);
R.debug "Connected to I/O process via socket %s" sockpath;
s
with Unix.Unix_error(a,b,c) ->
(* It's probably the case that the process hasn't started yet. *)
(* See if we can afford to wait and try again *)
Unix.close s;
let attempt_delay = !Xapi_globs.redo_log_connect_delay in
let now = Unix.gettimeofday() in
let remaining = latest_response_time -. now in
if attempt_delay < remaining then begin
(* Wait for a while then try again *)
R.debug "Waiting to connect to I/O process via socket %s (error was %s: %s)..." sockpath b (Unix.error_message a);
Thread.delay attempt_delay;
attempt ()
end else
raise Unixext.Timeout
in
attempt ()
let read_separator sock latest_response_time =
let sep = Unixext.time_limited_read sock 1 latest_response_time in
if sep <> "|" then raise (CommunicationsProblem "expected separator") else ()
let read_generation_count sock latest_response_time =
read_separator sock latest_response_time;
let gen_count = Unixext.time_limited_read sock generation_size latest_response_time in
Generation.of_string gen_count
let read_length sock latest_response_time =
read_separator sock latest_response_time;
let length_str = Unixext.time_limited_read sock length_size latest_response_time in
let length = (try int_of_string length_str with _ -> 0) in
length
let read_length_and_string sock latest_response_time =
let length = read_length sock latest_response_time in
read_separator sock latest_response_time;
let str = Unixext.time_limited_read sock length latest_response_time in
str
let read_database f gen_count sock latest_response_time datasockpath =
R.debug "Reading database with generation count %s" (Generation.to_string gen_count);
let expected_length = read_length sock latest_response_time in
R.debug "Expecting to receive database of length %d" expected_length;
(* Connect to the data socket *)
let datasock = connect datasockpath latest_response_time in
R.debug "Connected to data socket";
finally
(fun () ->
(* Pass the gen_count and the socket's fd to f. f may raise Unixext.Timeout if it cannot complete before latest_response_time. *)
f gen_count datasock expected_length latest_response_time;
)
(fun () ->
(* Close the data socket *)
R.debug "Closing the data socket";
Unix.close datasock
)
let read_delta f gen_count sock latest_response_time =
R.debug "Reading delta with generation count %s" (Generation.to_string gen_count);
let str = read_length_and_string sock latest_response_time in
let entry = string_to_redo_log_entry str in
f gen_count entry
let rec read_read_response sock fn_db fn_delta expected_gen_count latest_response_time datasockpath =
let hdr = Unixext.time_limited_read sock 5 latest_response_time in
if hdr <> "read|" then raise (CommunicationsProblem "expected 'read|'");
let kind = Unixext.time_limited_read sock 5 latest_response_time in
match kind with
| "db___" ->
let gen_count = read_generation_count sock latest_response_time in
read_database fn_db gen_count sock latest_response_time datasockpath;
read_read_response sock fn_db fn_delta (Generation.add_int gen_count 1) latest_response_time datasockpath
| "delta" ->
let gen_count = read_generation_count sock latest_response_time in
(* Since Boston all deltas cause a bump in generation count, whether or not they are persisted to the redo_log. *)
(* For safety, we should only read a delta if the generation count is higher than that of the last delta read. *)
if gen_count < expected_gen_count then begin
R.debug "Found record with generation count %Ld. Expected a record with generation count of at least %Ld so skipping this record." gen_count expected_gen_count;
(* Now skip over all the remaining data that the process is trying to send, discarding it all *)
read_delta (fun _ _ -> ()) gen_count sock latest_response_time;
read_read_response sock fn_db fn_delta expected_gen_count latest_response_time datasockpath
end else begin
R.debug "Found record with generation count %Ld which is >= expected generation count %Ld" gen_count expected_gen_count;
read_delta fn_delta gen_count sock latest_response_time;
read_read_response sock fn_db fn_delta (Generation.add_int gen_count 1) latest_response_time datasockpath
end
| "end__" -> R.debug "Reached the end of the read response"; ()
| "nack_" ->
(* Read the error message *)
let error = read_length_and_string sock latest_response_time in
R.warn "Read error received: [%s]" error;
if error = Block_device_io_errors.timeout_error_msg then raise Unixext.Timeout
else raise (RedoLogFailure error)
| e -> raise (CommunicationsProblem ("unrecognised read response prefix ["^e^"]"))
let action_empty sock datasockpath =
R.debug "Performing empty";
(* Compute desired response time *)
let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_empty in
(* Empty *)
let str = "empty_____" in
Unixext.time_limited_write sock (String.length str) str latest_response_time;
(* Read response *)
let response_length = 10 in
let response = Unixext.time_limited_read sock response_length latest_response_time in
match response with
| "empty|ack_" -> ()
| "empty|nack" ->
(* Read the error message *)
let error = read_length_and_string sock latest_response_time in
R.warn "Emptying was unsuccessful: [%s]" error;
if error = Block_device_io_errors.timeout_error_msg then raise Unixext.Timeout
else raise (RedoLogFailure error)
| e -> raise (CommunicationsProblem ("unrecognised empty response ["^e^"]"))
let action_read fn_db fn_delta sock datasockpath =
R.debug "Performing read";
(* Compute desired response time *)
let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_read in
(* Write *)
let str = "read______" in
Unixext.time_limited_write sock (String.length str) str latest_response_time;
(* Read response *)
read_read_response sock fn_db fn_delta Generation.null_generation latest_response_time datasockpath
let action_write_db marker generation_count write_fn sock datasockpath =
R.debug "Performing writedb (generation %Ld)" generation_count;
(* Compute desired response time *)
let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_writedb in
(* Send write command down control channel *)
let str = Printf.sprintf "writedb___|%s|%016Ld" marker generation_count in
Unixext.time_limited_write sock (String.length str) str latest_response_time;
(*
* Connect to the data socket. Note that this may delay a bit before being
* able to connect, as we might need to wait for the I/O process to start
* listening on the socket.
*)
let datasock = connect datasockpath latest_response_time in
finally
(fun () ->
(* Send data straight down the data channel, then close it to send an EOF. *)
(* Ideally, we would check whether this completes before the latest_response_time. Could implement this by performing the write in a separate thread. *)
try
write_fn datasock;
R.debug "Finished writing database to data socket";
with
| Sys_error("Connection reset by peer") ->
(* CA-41914: Note that if the block_device_io process internally
* throws Timeout (or indeed any other exception), it will forcibly
* close this connection, we'll see a Sys_error("Connection reset by
* peer"). This can be safely suppressed because we'll hear all the
* gory details in the response we read over the control socket. *)
R.warn "I/O process forcibly closed the data socket while trying to write database to it. Await the response to see why it did that.";
| e ->
(* We'll re-raise other exceptions, though. *)
R.error "Got an unexpected exception while trying to write database to the data socket: %s. Re-raising." (Printexc.to_string e);
raise e
)
(fun () ->
(* Ensure the data socket is closed even if exception is thrown from write_fn *)
R.info "Closing data socket";
Unix.close datasock;
);
(* Read response *)
let response_length = 12 in
R.debug "Reading response...";
let response = Unixext.time_limited_read sock response_length latest_response_time in
R.debug "Got response [%s]" response;
match response with
| "writedb|ack_" -> ()
| "writedb|nack" ->
(* Read the error message *)
let error = read_length_and_string sock latest_response_time in
R.warn "Write was unsuccessful: [%s]" error;
if error = Block_device_io_errors.timeout_error_msg then raise Unixext.Timeout
else raise (RedoLogFailure error)
| e -> raise (CommunicationsProblem ("unrecognised writedb response ["^e^"]"))
let action_write_delta marker generation_count data flush_db_fn sock datasockpath =
R.debug "Performing writedelta (generation %Ld)" generation_count;
(* Compute desired response time *)
let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_writedelta in
(* Write *)
let str = Printf.sprintf "writedelta|%s|%016Ld|%016d|%s" marker generation_count (String.length data) data in
Unixext.time_limited_write sock (String.length str) str latest_response_time;
(* Read response *)
let response_length = 15 in
let response = Unixext.time_limited_read sock response_length latest_response_time in
match response with
| "writedelta|ack_" -> R.debug "Write was successful"; ()
| "writedelta|nack" ->
(* Read the error message *)
let error = read_length_and_string sock latest_response_time in
R.warn "Write was unsuccessful: [%s]" error;
if error = Block_device_io_errors.timeout_error_msg then
raise Unixext.Timeout (* Propagate the timeout exception *)
else if error = Block_device_io_errors.not_enough_space_error_msg then begin
R.info "Not enough space on block device, so attempting to flush the DB...";
flush_db_fn() (* There wasn't enough space to write the delta, so flush the current database instead, which will free up space. *)
end else
raise (RedoLogFailure error) (* Some other error *)
| e -> R.warn "Received unexpected response"; raise (CommunicationsProblem ("unrecognised writedelta response ["^e^"]"))
(* ----------------------------------------------------------------------------------------------- *)
(* Functions relating to the exponential back-off of repeated attempts to reconnect after failure. *)
let initialise_backoff_delay log =
log.backoff_delay := Xapi_globs.redo_log_initial_backoff_delay
let increase_backoff_delay log =
if !(log.backoff_delay) = 0 then initialise_backoff_delay log
else log.backoff_delay := !(log.backoff_delay) * Xapi_globs.redo_log_exponentiation_base;
if !(log.backoff_delay) > Xapi_globs.redo_log_maximum_backoff_delay then
log.backoff_delay := Xapi_globs.redo_log_maximum_backoff_delay;
R.debug "Bumped backoff delay to %d seconds" !(log.backoff_delay)
let set_time_of_last_failure log =
let now = Unix.gettimeofday() in
log.time_of_last_failure := now;
increase_backoff_delay log
let reset_time_of_last_failure log =
log.time_of_last_failure := 0. ;
initialise_backoff_delay log
let maybe_retry f log =
let now = Unix.gettimeofday() in
R.debug "Considering whether to attempt to flush the DB... (backoff %d secs, time since last failure %.1f secs)"
!(log.backoff_delay) (now -. !(log.time_of_last_failure));
if now -. !(log.time_of_last_failure) >= float_of_int !(log.backoff_delay) then begin
R.debug "It's time for an attempt to reconnect and flush the DB.";
f()
end else
R.debug "No; we'll wait a bit longer before trying again."
(* -------------------------------------------------------------------- *)
(* Functions relating to the lifecycle of the block device I/O process. *)
(* Close any existing socket and kill the corresponding process. *)
let shutdown log =
if is_enabled log then begin
R.debug "Shutting down connection to I/O process";
try
begin
match !(log.pid) with
| None -> ()
| Some (p, ctrlsockpath, datasockpath) ->
(* If there's an existing socket, close it. *)
begin
match !(log.sock) with
| None -> ()
| Some s ->
ignore_exn (fun () -> Unix.close s);
(* Now we can forget about the communication channel to the process *)
log.sock := None;
end;
(* Terminate the child process *)
let ipid = Forkhelpers.getpid p in
R.info "Killing I/O process with pid %d" ipid;
Unix.kill ipid Sys.sigkill;
(* Wait for the process to die. This is done in a separate thread in case it does not respond to the signal immediately. *)
ignore (Thread.create (fun () ->
R.debug "Waiting for I/O process with pid %d to die..." ipid;
Mutex.execute log.dying_processes_mutex
(fun () -> log.num_dying_processes := !(log.num_dying_processes) + 1);
ignore(Forkhelpers.waitpid p);
R.debug "Finished waiting for process %d" ipid;
Mutex.execute log.dying_processes_mutex
(fun () -> log.num_dying_processes := !(log.num_dying_processes) - 1)
) ());
(* Forget about that process *)
log.pid := None;
(* Attempt to remove the sockets *)
List.iter (fun sockpath ->
R.debug "Removing socket %s" sockpath;
Unixext.unlink_safe sockpath
) [ctrlsockpath; datasockpath]
end;
with _ -> () (* ignore any errors *)
end
let broken log =
set_time_of_last_failure log;
shutdown log;
cannot_connect_fn log
let healthy log =
reset_time_of_last_failure log;
can_connect_fn log
exception TooManyProcesses
let startup log =
if is_enabled log then
try
begin
match !(log.pid) with
| Some _ -> () (* We're already started *)
| None ->
begin
(* Don't start if there are already some processes hanging around *)
Mutex.execute log.dying_processes_mutex
(fun () -> if !(log.num_dying_processes) >= Xapi_globs.redo_log_max_dying_processes then raise TooManyProcesses);
match !(log.device) with
| None ->
R.info "Could not find block device"
| Some device ->
begin
R.info "Using block device at %s" device;
(* Check that the block device exists *)
Unix.access device [Unix.F_OK; Unix.R_OK];
(* will throw Unix.Unix_error if not readable *)
(* Start the I/O process *)
let ctrlsockpath, datasockpath =
let f suffix = Filename.temp_file Xapi_globs.redo_log_comms_socket_stem suffix in
f "ctrl", f "data" in
R.info "Starting I/O process with block device [%s], control socket [%s] and data socket [%s]" device ctrlsockpath datasockpath;
let p = start_io_process device ctrlsockpath datasockpath in
log.pid := Some (p, ctrlsockpath, datasockpath);
R.info "Block device I/O process has PID [%d]" (Forkhelpers.getpid p)
end
end
end;
match !(log.pid) with
| Some (_, ctrlsockpath, _) ->
begin
match !(log.sock) with
| Some _ -> () (* We're already connected *)
| None ->
let latest_connect_time = get_latest_response_time !Xapi_globs.redo_log_max_startup_time in
(* Now connect to the process via the socket *)
let s = connect ctrlsockpath latest_connect_time in
finally
(fun () ->
try
begin
(* Check that we connected okay by reading the startup message *)
let response_length = 12 in
let response = Unixext.time_limited_read s response_length latest_connect_time in
match response with
| "connect|ack_" ->
R.info "Connect was successful";
(* Save the socket. This defers the responsibility for closing it to shutdown(). *)
log.sock := Some s
| "connect|nack" ->
(* Read the error message *)
let error = read_length_and_string s latest_connect_time in
R.warn "Connect was unsuccessful: [%s]" error;
broken log;
| e ->
R.warn "Received unexpected connect response: [%s]" e;
broken log
end
with Unixext.Timeout -> R.warn "Timed out waiting to connect"; broken log
)
(fun () ->
(* If the socket s has been opened, but sock hasn't been set then close it here. *)
match !(log.sock) with
| Some _ -> ()
| None -> ignore_exn (fun () -> Unix.close s)
)
end
| None -> () (* don't attempt to connect *)
with TooManyProcesses ->
R.info "Too many dying I/O processes. Not starting another one.";
cannot_connect_fn log
let switch log vdi_reason =
shutdown log;
log.device := get_static_device vdi_reason;
startup log
(* Given a socket, execute a function and catch exceptions. *)
let perform_action f desc sock log =
try
match !(log.pid) with
| None -> ()
| Some (_, _, datasockpath) ->
R.debug "About to perform action %s" desc;
f sock datasockpath;
R.debug "Action '%s' completed successfully" desc;
healthy log (* no exceptions: we can be confident that the redo log is working healthily *)
with
| Unixext.Timeout ->
(* Timeout: try to close the connection to the redo log. it will be re-opened when we next attempt another access *)
R.warn "Could not %s: Timeout." desc;
broken log
| Unix.Unix_error(a,b,c) ->
(* problem with process I/O *)
R.warn "Could not %s: Unix error on %s: %s" desc b (Unix.error_message a);
broken log
| RedoLogFailure e ->
(* error received from block_device_io *)
R.warn "Could not %s: received error %s" desc e;
broken log
| CommunicationsProblem str ->
(* unexpected response received from block_device_io *)
R.warn "Could not %s: communications problem: %s" desc str;
broken log
| e ->
(* other exception *)
R.warn "Could not %s: unexpected exception %s" desc (Printexc.to_string e);
broken log
(* Attempt to connect to the block device I/O process. If successful, execute the function. *)
let connect_and_do f log =
if !(log.pid) = None then startup log; (* try to connect if not already connected *)
match !(log.sock) with
| None -> () (* do nothing *)
| Some sock -> f sock log (* execute the function, passing the socket and the redo_log state *)
let connect_and_perform_action f desc log =
connect_and_do (perform_action f desc) log
(* ------------------------------------------------------------------- *)
(* Functions for handling creation and deletion of redo log instances. *)
let redo_log_creation_mutex = Mutex.create ()
let create ~name ~state_change_callback ~read_only =
let instance = {
name = name;
marker = Uuid.to_string (Uuid.make_uuid ());
read_only = read_only;
enabled = ref false;
device = ref None;
currently_accessible = ref true;
state_change_callback = state_change_callback;
time_of_last_failure = ref 0.;
backoff_delay = ref Xapi_globs.redo_log_initial_backoff_delay;
sock = ref None;
pid = ref None;
dying_processes_mutex = Mutex.create ();
num_dying_processes = ref 0;
} in
Mutex.execute redo_log_creation_mutex
(fun () -> all_redo_logs := RedoLogSet.add instance !all_redo_logs);
instance
let delete log =
shutdown log;
disable log;
Mutex.execute redo_log_creation_mutex
(fun () -> all_redo_logs := RedoLogSet.remove log !all_redo_logs)
(* -------------------------------------------------------- *)
(* Helper functions for interacting with multiple redo_logs *)
let with_active_redo_logs f =
Mutex.execute redo_log_creation_mutex
(fun () ->
let active_redo_logs =
RedoLogSet.filter (fun log -> (is_enabled log) && not(log.read_only)) !(all_redo_logs)
in
RedoLogSet.iter f active_redo_logs)
(* --------------------------------------------------------------- *)
(* Functions which interact with the redo log on the block device. *)
let write_db generation_count write_fn log =
if is_enabled log then
let f () = connect_and_perform_action (action_write_db log.marker generation_count write_fn) "write database to redo log" log in
if !(log.sock) = None then begin
(* We're not currently connected. See if it's time to attempt to reconnect *)
R.debug "We're not currently connected to the block device I/O process.";
maybe_retry f log
end else begin
(* it looks like everything's healthy *)
R.debug "We believe that we are currently connected to a healthy block device. Attempting to write DB...";
f ()
end
let write_delta generation_count t flush_db_fn log =
if (is_enabled log) && !ready_to_write then begin
(* If we're not currently connected, then try to re-connect (by calling flush_db_fn) at increasing time intervals. *)
match !(log.sock) with
| None ->
(* Instead of writing a delta, try to write the whole DB *)
R.debug "write_delta: Not currently connected, so trying to re-connect and flush DB instead of writing the delta";
flush_db_fn ()
| Some sock ->
(* It looks like we're probably connected, so try to write the delta *)
let str = redo_log_entry_to_string t in
perform_action (action_write_delta log.marker generation_count str flush_db_fn) "write delta to redo log" sock log
end
let apply fn_db fn_delta log =
if is_enabled log then begin
(* Turn off writing to the database while we are applying deltas. *)
ready_to_write := false;
finally
(fun () -> connect_and_perform_action (action_read fn_db fn_delta) "read from redo log" log)
(fun () -> ready_to_write := true)
end
let empty log =
if is_enabled log then
connect_and_perform_action (action_empty) "invalidate the redo log" log
(** ------------------------------------------------ *)
(** Functions which operate on all active redo_logs. *)
(* Flush the database to the given redo_log instance. *)
let flush_db_to_redo_log db log =
R.info "Flushing database to redo_log [%s]" log.name;
let write_db_to_fd = (fun out_fd -> Db_xml.To.fd out_fd db) in
write_db (Db_cache_types.Manifest.generation (Db_cache_types.Database.manifest db)) write_db_to_fd log
(* Write the given database to all active redo_logs *)
let flush_db_to_all_active_redo_logs db =
R.info "Flushing database to all active redo-logs";
with_active_redo_logs (fun log ->
flush_db_to_redo_log db log)
(* Write a delta to all active redo_logs *)
let database_callback event db =
let to_write =
match event with
| Db_cache_types.RefreshRow (tblname, objref) ->
None
| Db_cache_types.WriteField (tblname, objref, fldname, oldval, newval) ->
R.debug "WriteField(%s, %s, %s, %s, %s)" tblname objref fldname oldval newval;
if Schema.is_field_persistent (Db_cache_types.Database.schema db) tblname fldname
then Some (WriteField(tblname, objref, fldname, newval))
else None
| Db_cache_types.PreDelete (tblname, objref) ->
None
| Db_cache_types.Delete (tblname, objref, _) ->
if Schema.is_table_persistent (Db_cache_types.Database.schema db) tblname
then Some (DeleteRow(tblname, objref))
else None
| Db_cache_types.Create (tblname, objref, kvs) ->
if Schema.is_table_persistent (Db_cache_types.Database.schema db) tblname
then Some (CreateRow(tblname, objref, kvs))
else None
in
Opt.iter (fun entry ->
with_active_redo_logs (fun log ->
write_delta (Db_cache_types.Manifest.generation (Db_cache_types.Database.manifest db)) entry
(fun () ->
(* the function which will be invoked if a database write is required instead of a delta *)
flush_db_to_redo_log db log)
log
)
) to_write
Jump to Line
Something went wrong with that request. Please try again.