[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [PATCH v1 4/5] tools/ocaml/xenstored: add support for binary format
Signed-off-by: Edwin Török <edvin.torok@xxxxxxxxxx> --- tools/ocaml/xenstored/perms.ml | 2 + tools/ocaml/xenstored/xenstored.ml | 201 ++++++++++++++++++++++++----- 2 files changed, 173 insertions(+), 30 deletions(-) diff --git a/tools/ocaml/xenstored/perms.ml b/tools/ocaml/xenstored/perms.ml index e8a16221f8..61c1c60083 100644 --- a/tools/ocaml/xenstored/perms.ml +++ b/tools/ocaml/xenstored/perms.ml @@ -69,6 +69,8 @@ let remove_domid ~domid perm = let default0 = create 0 NONE [] +let acls t = (t.owner, t.other) :: t.acl + let perm_of_string s = let ty = permty_of_char s.[0] and id = int_of_string (String.sub s 1 (String.length s - 1)) in diff --git a/tools/ocaml/xenstored/xenstored.ml b/tools/ocaml/xenstored/xenstored.ml index e25b407303..9338190804 100644 --- a/tools/ocaml/xenstored/xenstored.ml +++ b/tools/ocaml/xenstored/xenstored.ml @@ -141,7 +141,8 @@ exception Bad_format of string let dump_format_header = "$xenstored-dump-format" -let from_channel_f chan global_f socket_f domain_f watch_f store_f = +(* for backwards compatibility with already released live-update *) +let from_channel_f_compat chan global_f socket_f domain_f watch_f store_f = let unhexify s = Utils.unhexify s in let getpath s = let u = Utils.unhexify s in @@ -186,7 +187,7 @@ let from_channel_f chan global_f socket_f domain_f watch_f store_f = done; info "Completed loading xenstore dump" -let from_channel store cons doms chan = +let from_channel_compat ~live store cons doms chan = (* don't let the permission get on our way, full perm ! *) let op = Store.get_ops store Perms.Connection.full_rights in let rwro = ref (None) in @@ -226,43 +227,183 @@ let from_channel store cons doms chan = op.Store.write path value; op.Store.setperms path perms in - from_channel_f chan global_f socket_f domain_f watch_f store_f; + from_channel_f_compat chan global_f socket_f domain_f watch_f store_f; !rwro -let from_file store cons doms file = - info "Loading xenstore dump from %s" file; - let channel = open_in file in - finally (fun () -> from_channel store doms cons channel) +module LR = Disk.LiveRecord + +let from_channel_f_bin chan on_global_data on_connection_data on_watch_data on_transaction_data on_node_data = + Disk.BinaryIn.read_header chan; + let quit = ref false in + let on_end () = quit := true in + let errors = ref 0 in + while not !quit + do + try + LR.read_record chan ~on_end ~on_global_data ~on_connection_data ~on_watch_data ~on_transaction_data ~on_node_data + with exn -> + let bt = Printexc.get_backtrace () in + incr errors; + Logging.warn "xenstored" "restoring: ignoring faulty record (exception: %s): %s" (Printexc.to_string exn) bt + done; + info "Completed loading xenstore dump"; + !errors + + +let from_channel_bin ~live store cons doms chan = + (* don't let the permission get on our way, full perm ! *) + let maintx = Transaction.make ~internal:true Transaction.none store in + let fullperm = Perms.Connection.full_rights in + let fds = ref None in + let allcons = Hashtbl.create 1021 in + let contxid_to_op = Hashtbl.create 1021 in + let global_f ~rw_sock = + (* file descriptors are only valid on a live-reload, a cold restart won't have them *) + if live then + fds := Some rw_sock + in + let domain_f ~conid ~conn ~in_data ~out_data ~out_resp_len = + let con = match conn with + | LR.Domain { LR.id = 0; _ } -> + (* Dom0 is precreated *) + Connections.find_domain cons 0 + | LR.Domain d -> + debug "Recreating domain %d, port %d" d.id d.remote_port; + (* FIXME: gnttab *) + Domains.create doms d.id 0n d.remote_port + |> Connections.add_domain cons; + Connections.find_domain cons d.id + | LR.Socket fd -> + debug "Recreating open socket"; + (* TODO: rw/ro flag *) + Connections.add_anonymous cons fd; + Connections.find cons fd + in + Hashtbl.add allcons conid con + in + let watch_f ~conid ~wpath ~token = + let con = Hashtbl.find allcons conid in + ignore (Connections.add_watch cons con wpath token); + () + in + let transaction_f ~conid ~txid = + let con = Hashtbl.find allcons conid in + con.Connection.next_tid <- txid; + let id = Connection.start_transaction con store in + assert (id = txid); + let txn = Connection.get_transaction con txid in + Hashtbl.add contxid_to_op (conid, txid) txn + in + let store_f ~txaccess ~perms ~path ~value = + let txn, op = match txaccess with + | None -> maintx, LR.W + | Some (conid, txid, op) -> + let (txn, _) as r = Hashtbl.find contxid_to_op (conid, txid), op in + (* make sure this doesn't commit, even as RO *) + Transaction.mark_failed txn; + r + in + let get_con id = + if id < 0 then Connections.find cons (Utils.FD.of_int (-id)) + else Connections.find_domain cons id + in + let watch_f id path token = + ignore (Connections.add_watch cons (get_con id) path token) + in + let path = Store.Path.of_string path in + try match op with + | LR.R -> + Logging.debug "xenstored" "TR %s %S" (Store.Path.to_string path) value; + (* these are values read by the tx, potentially + no write access here. Make the tree match. *) + Transaction.write txn fullperm path value; + Transaction.setperms txn fullperm path perms; + | LR.W | LR.RW -> + Logging.debug "xenstored" "TW %d %s %S" (Transaction.get_id txn) (Store.Path.to_string path) value; + (* We started with empty tree, create parents. + All the implicit mkdirs from the original tx should be explicit already for quota purposes. + *) + Process.create_implicit_path txn fullperm path; + Transaction.write txn fullperm path value; + Transaction.setperms txn fullperm path perms; + Logging.debug "xenstored" "TWdone %s %S" (Store.Path.to_string path) value; + | LR.Del -> + Logging.debug "xenstored" "TDel %s " (Store.Path.to_string path); + Transaction.rm txn fullperm path + with Not_found|Define.Doesnt_exist|Define.Lookup_Doesnt_exist _ -> () + in + (* make sure we got a quota entry for Dom0, so that setperms on / doesn't cause quota to be off-by-one *) + Transaction.mkdir maintx fullperm (Store.Path.of_string "/local"); + let errors = from_channel_f_bin chan global_f domain_f watch_f transaction_f store_f in + (* do not fire any watches, but this makes a tx RO *) +(* Transaction.clear_wops maintx; *) + let errors = if not @@ Transaction.commit ~con:"live-update" maintx then begin + Logging.warn "xenstored" "live-update: failed to commit main transaction"; + errors + 1 + end else errors + in + !fds, errors + +let from_channel = from_channel_bin (* TODO: detect and accept text format *) + +let from_file ~live store cons doms file = + let channel = open_in_bin file in + finally (fun () -> from_channel_bin ~live store doms cons channel) (fun () -> close_in channel) -let to_channel store cons rw chan = - let hexify s = Utils.hexify s in +let to_channel rw_sock store cons chan = + let t = Disk.BinaryOut.write_header chan in - fprintf chan "%s\n" dump_format_header; - let fdopt = function None -> -1 | Some fd -> - (* systemd and utils.ml sets it close on exec *) - Unix.clear_close_on_exec fd; - Utils.FD.to_int fd in - fprintf chan "global,%d\n" (fdopt rw); - - (* dump connections related to domains: domid, mfn, eventchn port/ sockets, and watches *) - Connections.iter cons (fun con -> Connection.dump con chan); + (match rw_sock with + | Some rw_sock -> + LR.write_global_data t ~rw_sock + | _ -> ()); (* dump the store *) Store.dump_fct store (fun path node -> - let name, perms, value = Store.Node.unpack node in - let fullpath = Store.Path.to_string (Store.Path.of_path_and_name path name) in - let permstr = Perms.Node.to_string perms in - fprintf chan "store,%s,%s,%s\n" (hexify fullpath) (hexify permstr) (hexify value) + Transaction.write_node t None path node ); + + (* dump connections related to domains and sockets; domid, mfn, eventchn port, watches *) + Connections.iter cons (fun con -> Connection.dump con store t); + + LR.write_end t; flush chan; () +let validate_f ch = + let conids = Hashtbl.create 1021 in + let txids = Hashtbl.create 1021 in + let global_f ~rw_sock = () in + let domain_f ~conid ~conn ~in_data ~out_data ~out_resp_len = + Hashtbl.add conids conid () + in + let watch_f ~conid ~wpath ~token = + Hashtbl.find conids conid + in + let transaction_f ~conid ~txid = + Hashtbl.find conids conid; + Hashtbl.add txids (conid, txid) () + in + let store_f ~txaccess ~perms ~path ~value = + match txaccess with + | None -> () + | Some (conid, txid, _) -> + Hashtbl.find conids conid; + Hashtbl.find txids (conid, txid) + in + let errors = from_channel_f_bin ch global_f domain_f watch_f transaction_f store_f in + if errors > 0 then + failwith (Printf.sprintf "Failed to re-read dump: %d errors" errors) -let to_file store cons fds file = - let channel = open_out_gen [ Open_wronly; Open_creat; Open_trunc; ] 0o600 file in - finally (fun () -> to_channel store cons fds channel) - (fun () -> close_out channel) +let to_file fds store cons file = + let channel = open_out_gen [ Open_wronly; Open_creat; Open_trunc; Open_binary ] 0o600 file in + finally (fun () -> to_channel fds store cons channel) + (fun () -> close_out channel); + let channel = open_in_bin file in + finally (fun () -> validate_f channel) + (fun () -> close_in channel) + end let main () = @@ -329,8 +470,8 @@ let main () = let rw_sock = if cf.restart && Sys.file_exists Disk.xs_daemon_database then ( - let rwro = DB.from_file store domains cons Disk.xs_daemon_database in - info "Live reload: database loaded"; + let rwro, errors = DB.from_file ~live:cf.live_reload store domains cons Disk.xs_daemon_database in + info "Live reload: database loaded (%d errors)" errors; Event.bind_dom_exc_virq eventchn; Process.LiveUpdate.completed (); rwro @@ -367,7 +508,7 @@ let main () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore; if cf.activate_access_log then begin - let post_rotate () = DB.to_file store cons (None) Disk.xs_daemon_database in + let post_rotate () = DB.to_file None store cons Disk.xs_daemon_database in Logging.init_access_log post_rotate end; @@ -528,7 +669,7 @@ let main () = live_update := Process.LiveUpdate.should_run cons; if !live_update || !quit then begin (* don't initiate live update if saving state fails *) - DB.to_file store cons (rw_sock) Disk.xs_daemon_database; + DB.to_file rw_sock store cons Disk.xs_daemon_database; quit := true; end with exc -> -- 2.29.2
|
Lists.xenproject.org is hosted with RackSpace, monitoring our |