Skip to content

Commit ace50ae

Browse files
edwintorokedwintorok
committed
CP-51692: feat(use-event-next): xe event-wait: use Event.from instead of Event.next
Feature flag: use-event-next Signed-off-by: Edwin Török <edwin.torok@cloud.com>
1 parent e40c1ae commit ace50ae

File tree

1 file changed

+104
-91
lines changed

1 file changed

+104
-91
lines changed

‎ocaml/xapi-cli-server/cli_operations.ml‎

Lines changed: 104 additions & 91 deletions
Original file line numberDiff line numberDiff line change
@@ -2848,8 +2848,6 @@ exception Finished
28482848
let event_wait_gen rpc session_id classname record_matches =
28492849
(* Immediately register *)
28502850
let classes = [classname] in
2851-
Client.Event.register ~rpc ~session_id ~classes ;
2852-
debug "Registered for events" ;
28532851
(* Check to see if the condition is already satisfied - get all objects of whatever class specified... *)
28542852
let poll () =
28552853
let current_tbls =
@@ -2930,96 +2928,111 @@ let event_wait_gen rpc session_id classname record_matches =
29302928
in
29312929
List.exists record_matches all_recs
29322930
in
2933-
finally
2934-
(fun () ->
2935-
if not (poll ()) then
2936-
try
2937-
while true do
2938-
try
2939-
let events =
2940-
Event_types.events_of_rpc (Client.Event.next ~rpc ~session_id)
2941-
in
2942-
let doevent event =
2943-
let tbl =
2944-
match Event_helper.record_of_event event with
2945-
| Event_helper.VM (r, Some x) ->
2946-
let record = vm_record rpc session_id r in
2947-
record.setrefrec (r, x) ;
2948-
record.fields
2949-
| Event_helper.VDI (r, Some x) ->
2950-
let record = vdi_record rpc session_id r in
2951-
record.setrefrec (r, x) ;
2952-
record.fields
2953-
| Event_helper.SR (r, Some x) ->
2954-
let record = sr_record rpc session_id r in
2955-
record.setrefrec (r, x) ;
2956-
record.fields
2957-
| Event_helper.Host (r, Some x) ->
2958-
let record = host_record rpc session_id r in
2959-
record.setrefrec (r, x) ;
2960-
record.fields
2961-
| Event_helper.Network (r, Some x) ->
2962-
let record = net_record rpc session_id r in
2963-
record.setrefrec (r, x) ;
2964-
record.fields
2965-
| Event_helper.VIF (r, Some x) ->
2966-
let record = vif_record rpc session_id r in
2967-
record.setrefrec (r, x) ;
2968-
record.fields
2969-
| Event_helper.PIF (r, Some x) ->
2970-
let record = pif_record rpc session_id r in
2971-
record.setrefrec (r, x) ;
2972-
record.fields
2973-
| Event_helper.VBD (r, Some x) ->
2974-
let record = vbd_record rpc session_id r in
2975-
record.setrefrec (r, x) ;
2976-
record.fields
2977-
| Event_helper.PBD (r, Some x) ->
2978-
let record = pbd_record rpc session_id r in
2979-
record.setrefrec (r, x) ;
2980-
record.fields
2981-
| Event_helper.Pool (r, Some x) ->
2982-
let record = pool_record rpc session_id r in
2983-
record.setrefrec (r, x) ;
2984-
record.fields
2985-
| Event_helper.Task (r, Some x) ->
2986-
let record = task_record rpc session_id r in
2987-
record.setrefrec (r, x) ;
2988-
record.fields
2989-
| Event_helper.VMSS (r, Some x) ->
2990-
let record = vmss_record rpc session_id r in
2991-
record.setrefrec (r, x) ;
2992-
record.fields
2993-
| Event_helper.Secret (r, Some x) ->
2994-
let record = secret_record rpc session_id r in
2995-
record.setrefrec (r, x) ;
2996-
record.fields
2997-
| _ ->
2998-
failwith
2999-
("Cli listening for class '"
3000-
^ classname
3001-
^ "' not currently implemented"
3002-
)
3003-
in
3004-
let record =
3005-
List.map (fun r -> (r.name, fun () -> safe_get_field r)) tbl
3006-
in
3007-
if record_matches record then raise Finished
2931+
let use_event_next = !Constants.use_event_next in
2932+
let run () =
2933+
if not (poll ()) then
2934+
try
2935+
let token = ref "" in
2936+
while true do
2937+
let events =
2938+
if use_event_next then
2939+
Event_types.events_of_rpc (Client.Event.next ~rpc ~session_id)
2940+
else
2941+
let event_from =
2942+
Event_types.event_from_of_rpc
2943+
(Client.Event.from ~rpc ~session_id ~timeout:30. ~token:!token
2944+
~classes
2945+
)
30082946
in
3009-
List.iter doevent
3010-
(List.filter (fun e -> e.Event_types.snapshot <> None) events)
3011-
with
3012-
| Api_errors.Server_error (code, _)
3013-
when code = Api_errors.events_lost
3014-
->
3015-
debug "Got EVENTS_LOST; reregistering" ;
3016-
Client.Event.unregister ~rpc ~session_id ~classes ;
3017-
Client.Event.register ~rpc ~session_id ~classes ;
3018-
if poll () then raise Finished
3019-
done
3020-
with Finished -> ()
3021-
)
3022-
(fun () -> Client.Event.unregister ~rpc ~session_id ~classes)
2947+
token := event_from.token ;
2948+
event_from.events
2949+
in
2950+
let doevent event =
2951+
let tbl =
2952+
match Event_helper.record_of_event event with
2953+
| Event_helper.VM (r, Some x) ->
2954+
let record = vm_record rpc session_id r in
2955+
record.setrefrec (r, x) ;
2956+
record.fields
2957+
| Event_helper.VDI (r, Some x) ->
2958+
let record = vdi_record rpc session_id r in
2959+
record.setrefrec (r, x) ;
2960+
record.fields
2961+
| Event_helper.SR (r, Some x) ->
2962+
let record = sr_record rpc session_id r in
2963+
record.setrefrec (r, x) ;
2964+
record.fields
2965+
| Event_helper.Host (r, Some x) ->
2966+
let record = host_record rpc session_id r in
2967+
record.setrefrec (r, x) ;
2968+
record.fields
2969+
| Event_helper.Network (r, Some x) ->
2970+
let record = net_record rpc session_id r in
2971+
record.setrefrec (r, x) ;
2972+
record.fields
2973+
| Event_helper.VIF (r, Some x) ->
2974+
let record = vif_record rpc session_id r in
2975+
record.setrefrec (r, x) ;
2976+
record.fields
2977+
| Event_helper.PIF (r, Some x) ->
2978+
let record = pif_record rpc session_id r in
2979+
record.setrefrec (r, x) ;
2980+
record.fields
2981+
| Event_helper.VBD (r, Some x) ->
2982+
let record = vbd_record rpc session_id r in
2983+
record.setrefrec (r, x) ;
2984+
record.fields
2985+
| Event_helper.PBD (r, Some x) ->
2986+
let record = pbd_record rpc session_id r in
2987+
record.setrefrec (r, x) ;
2988+
record.fields
2989+
| Event_helper.Pool (r, Some x) ->
2990+
let record = pool_record rpc session_id r in
2991+
record.setrefrec (r, x) ;
2992+
record.fields
2993+
| Event_helper.Task (r, Some x) ->
2994+
let record = task_record rpc session_id r in
2995+
record.setrefrec (r, x) ;
2996+
record.fields
2997+
| Event_helper.VMSS (r, Some x) ->
2998+
let record = vmss_record rpc session_id r in
2999+
record.setrefrec (r, x) ;
3000+
record.fields
3001+
| Event_helper.Secret (r, Some x) ->
3002+
let record = secret_record rpc session_id r in
3003+
record.setrefrec (r, x) ;
3004+
record.fields
3005+
| _ ->
3006+
failwith
3007+
("Cli listening for class '"
3008+
^ classname
3009+
^ "' not currently implemented"
3010+
)
3011+
in
3012+
let record =
3013+
List.map (fun r -> (r.name, fun () -> safe_get_field r)) tbl
3014+
in
3015+
if record_matches record then raise_notrace Finished
3016+
in
3017+
List.iter doevent
3018+
(List.filter (fun e -> e.Event_types.snapshot <> None) events)
3019+
done
3020+
with
3021+
| Api_errors.Server_error (code, _)
3022+
when code = Api_errors.events_lost && use_event_next ->
3023+
debug "Got EVENTS_LOST; reregistering" ;
3024+
Client.Event.unregister ~rpc ~session_id ~classes ;
3025+
Client.Event.register ~rpc ~session_id ~classes ;
3026+
if poll () then raise Finished
3027+
| Finished ->
3028+
()
3029+
in
3030+
if use_event_next then (
3031+
Client.Event.register ~rpc ~session_id ~classes ;
3032+
debug "Registered for events" ;
3033+
finally run (fun () -> Client.Event.unregister ~rpc ~session_id ~classes)
3034+
) else
3035+
run ()
30233036
30243037
(* We're done. Unregister and finish *)
30253038

0 commit comments

Comments
 (0)