From 59981b08c8ef6eed37b1171656c2a5f3b4b74012 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 12 Oct 2022 19:13:02 +0100 Subject: [PATCH 66/87] tools/ocaml: Change Xb.input to return Packet.t option MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The queue here would only ever hold at most one element. This will simplify follow-up patches. This is part of XSA-326. Signed-off-by: Edwin Török Acked-by: Christian Lindig (cherry picked from commit c0a86a462721008eca5ff733660de094d3c34bc7) --- tools/ocaml/libs/xb/xb.ml | 18 +++++------------- tools/ocaml/libs/xb/xb.mli | 5 +---- tools/ocaml/libs/xs/xsraw.ml | 20 ++++++-------------- tools/ocaml/xenstored/connection.ml | 4 +--- tools/ocaml/xenstored/process.ml | 15 +++++++-------- 5 files changed, 20 insertions(+), 42 deletions(-) diff --git a/tools/ocaml/libs/xb/xb.ml b/tools/ocaml/libs/xb/xb.ml index 8404ddd8a682..165fd4a1edf4 100644 --- a/tools/ocaml/libs/xb/xb.ml +++ b/tools/ocaml/libs/xb/xb.ml @@ -45,7 +45,6 @@ type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * bytes type t = { backend: backend; - pkt_in: Packet.t Queue.t; pkt_out: Packet.t Queue.t; mutable partial_in: partial_buf; mutable partial_out: string; @@ -62,7 +61,6 @@ let reconnect t = match t.backend with Xs_ring.close backend.mmap; backend.eventchn_notify (); (* Clear our old connection state *) - Queue.clear t.pkt_in; Queue.clear t.pkt_out; t.partial_in <- init_partial_in (); t.partial_out <- "" @@ -124,7 +122,6 @@ let output con = (* NB: can throw Reconnect *) let input con = - let newpacket = ref false in let to_read = match con.partial_in with | HaveHdr partial_pkt -> Partial.to_complete partial_pkt @@ -143,21 +140,19 @@ let input con = if Partial.to_complete partial_pkt = 0 then ( let pkt = Packet.of_partialpkt partial_pkt in con.partial_in <- init_partial_in (); - Queue.push pkt con.pkt_in; - newpacket := true - ) + Some pkt + ) else None | NoHdr (i, buf) -> (* we complete the partial header *) if sz > 0 then Bytes.blit b 0 buf (Partial.header_size () - i) sz; con.partial_in <- if sz = i then - HaveHdr (Partial.of_string (Bytes.to_string buf)) else NoHdr (i - sz, buf) - ); - !newpacket + HaveHdr (Partial.of_string (Bytes.to_string buf)) else NoHdr (i - sz, buf); + None + ) let newcon backend = { backend = backend; - pkt_in = Queue.create (); pkt_out = Queue.create (); partial_in = init_partial_in (); partial_out = ""; @@ -193,9 +188,6 @@ let has_output con = has_new_output con || has_old_output con let peek_output con = Queue.peek con.pkt_out -let input_len con = Queue.length con.pkt_in -let has_in_packet con = Queue.length con.pkt_in > 0 -let get_in_packet con = Queue.pop con.pkt_in let has_partial_input con = match con.partial_in with | HaveHdr _ -> true | NoHdr (n, _) -> n < Partial.header_size () diff --git a/tools/ocaml/libs/xb/xb.mli b/tools/ocaml/libs/xb/xb.mli index 794e35bb343e..91c682162cea 100644 --- a/tools/ocaml/libs/xb/xb.mli +++ b/tools/ocaml/libs/xb/xb.mli @@ -77,7 +77,7 @@ val write_fd : backend_fd -> 'a -> string -> int -> int val write_mmap : backend_mmap -> 'a -> string -> int -> int val write : t -> string -> int -> int val output : t -> bool -val input : t -> bool +val input : t -> Packet.t option val newcon : backend -> t val open_fd : Unix.file_descr -> t val open_mmap : Xenmmap.mmap_interface -> (unit -> unit) -> t @@ -89,10 +89,7 @@ val has_new_output : t -> bool val has_old_output : t -> bool val has_output : t -> bool val peek_output : t -> Packet.t -val input_len : t -> int -val has_in_packet : t -> bool val has_partial_input : t -> bool -val get_in_packet : t -> Packet.t val has_more_input : t -> bool val is_selectable : t -> bool val get_fd : t -> Unix.file_descr diff --git a/tools/ocaml/libs/xs/xsraw.ml b/tools/ocaml/libs/xs/xsraw.ml index d982fb24dbb1..451f8b38dbcc 100644 --- a/tools/ocaml/libs/xs/xsraw.ml +++ b/tools/ocaml/libs/xs/xsraw.ml @@ -94,26 +94,18 @@ let pkt_send con = done (* receive one packet - can sleep *) -let pkt_recv con = - let workdone = ref false in - while not !workdone - do - workdone := Xb.input con.xb - done; - Xb.get_in_packet con.xb +let rec pkt_recv con = + match Xb.input con.xb with + | Some packet -> packet + | None -> pkt_recv con let pkt_recv_timeout con timeout = let fd = Xb.get_fd con.xb in let r, _, _ = Unix.select [ fd ] [] [] timeout in if r = [] then true, None - else ( - let workdone = Xb.input con.xb in - if workdone then - false, (Some (Xb.get_in_packet con.xb)) - else - false, None - ) + else + false, Xb.input con.xb let queue_watchevent con data = let ls = split_string ~limit:2 '\000' data in diff --git a/tools/ocaml/xenstored/connection.ml b/tools/ocaml/xenstored/connection.ml index 38b47363a173..cc20e047d2b9 100644 --- a/tools/ocaml/xenstored/connection.ml +++ b/tools/ocaml/xenstored/connection.ml @@ -277,9 +277,7 @@ let get_transaction con tid = Hashtbl.find con.transactions tid let do_input con = Xenbus.Xb.input con.xb -let has_input con = Xenbus.Xb.has_in_packet con.xb let has_partial_input con = Xenbus.Xb.has_partial_input con.xb -let pop_in con = Xenbus.Xb.get_in_packet con.xb let has_more_input con = Xenbus.Xb.has_more_input con.xb let has_output con = Xenbus.Xb.has_output con.xb @@ -307,7 +305,7 @@ let is_bad con = match con.dom with None -> false | Some dom -> Domain.is_bad_do Restrictions below can be relaxed once xenstored learns to dump more of its live state in a safe way *) let has_extra_connection_data con = - let has_in = has_input con || has_partial_input con in + let has_in = has_partial_input con in let has_out = has_output con in let has_socket = con.dom = None in let has_nondefault_perms = make_perm con.dom <> con.perm in diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml index dd58e6979cf9..cbf708213796 100644 --- a/tools/ocaml/xenstored/process.ml +++ b/tools/ocaml/xenstored/process.ml @@ -195,10 +195,9 @@ let parse_live_update args = | _ when Unix.gettimeofday () < t.deadline -> false | l -> warn "timeout reached: have to wait, migrate or shutdown %d domains:" (List.length l); - let msgs = List.rev_map (fun con -> Printf.sprintf "%s: %d tx, in: %b, out: %b, perm: %s" + let msgs = List.rev_map (fun con -> Printf.sprintf "%s: %d tx, out: %b, perm: %s" (Connection.get_domstr con) (Connection.number_of_transactions con) - (Connection.has_input con) (Connection.has_output con) (Connection.get_perm con |> Perms.Connection.to_string) ) l in @@ -706,16 +705,17 @@ let do_input store cons doms con = info "%s requests a reconnect" (Connection.get_domstr con); History.reconnect con; info "%s reconnection complete" (Connection.get_domstr con); - false + None | Failure exp -> error "caught exception %s" exp; error "got a bad client %s" (sprintf "%-8s" (Connection.get_domstr con)); Connection.mark_as_bad con; - false + None in - if newpacket then ( - let packet = Connection.pop_in con in + match newpacket with + | None -> () + | Some packet -> let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in let req = {Packet.tid=tid; Packet.rid=rid; Packet.ty=ty; Packet.data=data} in @@ -725,8 +725,7 @@ let do_input store cons doms con = (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *) process_packet ~store ~cons ~doms ~con ~req; write_access_log ~ty ~tid ~con:(Connection.get_domstr con) ~data; - Connection.incr_ops con; - ) + Connection.incr_ops con let do_output _store _cons _doms con = if Connection.has_output con then ( -- 2.37.4