1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
From 59981b08c8ef6eed37b1171656c2a5f3b4b74012 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edvin.torok@citrix.com>
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 <edvin.torok@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
(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
|