Skip to content

Commit 0711dda

Browse files
djs55djs55
committed
Merge pull request xapi-project#6 from jonludlam/events
Add the event helper modules.
2 parents ab91377 + a13c959 commit 0711dda

File tree

6 files changed

+250
-60
lines changed

6 files changed

+250
-60
lines changed

‎_oasis‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ Library "xen-api-client"
1919
CompiledObject: best
2020
Path: lib
2121
Findlibname: xen-api-client
22-
Modules: API, Api_errors, Client, Date, XMLRPC, Xml, Xen_api
22+
Modules: API, Api_errors, Client, Date, XMLRPC, Xml, Xen_api, Event_helper, Event_types
2323
BuildDepends: xmlm, cohttp
2424

2525
Library "xen-api-client-lwt"

‎lib/event_helper.ml‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
(*
2+
* Copyright (C) 2006-2009 Citrix Systems Inc.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
type event_record =
16+
| Session of [`Session ] API.Ref.t * API.session_t option
17+
| Task of [`task ] API.Ref.t * API.task_t option
18+
| Event of [`Event] API.Ref.t * API.event_t option
19+
| VM of [`VM] API.Ref.t * API.vM_t option
20+
| VM_metrics of [`VM_metrics] API.Ref.t * API.vM_metrics_t option
21+
| VM_guest_metrics of [`VM_guest_metrics] API.Ref.t * API.vM_guest_metrics_t option
22+
| Host of [`host] API.Ref.t * API.host_t option
23+
| Host_metrics of [`host_metrics] API.Ref.t * API.host_metrics_t option
24+
| Host_cpu of [`host_cpu] API.Ref.t * API.host_cpu_t option
25+
| Network of [`network] API.Ref.t * API.network_t option
26+
| VIF of [`VIF] API.Ref.t * API.vIF_t option
27+
| VIF_metrics of [`VIF_metrics] API.Ref.t * API.vIF_metrics_t option
28+
| PIF of [`PIF] API.Ref.t * API.pIF_t option
29+
| PIF_metrics of [`PIF_metrics] API.Ref.t * API.pIF_metrics_t option
30+
| SR of [`SR] API.Ref.t * API.sR_t option
31+
| VDI of [`VDI] API.Ref.t * API.vDI_t option
32+
| VBD of [`VBD] API.Ref.t * API.vBD_t option
33+
| VBD_metrics of [`VBD_metrics] API.Ref.t * API.vBD_metrics_t option
34+
| PBD of [`PBD] API.Ref.t * API.pBD_t option
35+
| Crashdump of [`Crashdump] API.Ref.t * API.crashdump_t option
36+
| VTPM of [`VTPM] API.Ref.t * API.vTPM_t option
37+
| Console of [`Console] API.Ref.t * API.console_t option
38+
| User of [`User] API.Ref.t * API.user_t option
39+
| Pool of [`pool] API.Ref.t * API.pool_t option
40+
| Message of [`message] API.Ref.t * API.message_t option
41+
| Secret of [`secret] API.Ref.t * API.secret_t option
42+
| VMPP of [`VMPP] API.Ref.t * API.vMPP_t option
43+
44+
let maybe f x =
45+
match x with
46+
| Some x -> Some (f x)
47+
| None -> None
48+
49+
let record_of_event ev =
50+
let xmlrpc = ev.Event_types.snapshot in
51+
match ev.Event_types.ty with
52+
| "session" -> Session (API.Ref.of_string ev.Event_types.reference, maybe (API.From.session_t "") xmlrpc)
53+
| "task" -> Task (API.Ref.of_string ev.Event_types.reference, maybe (API.From.task_t "") xmlrpc)
54+
| "event" -> Event (API.Ref.of_string ev.Event_types.reference, maybe (API.From.event_t "") xmlrpc)
55+
| "vm" -> VM (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_t "") xmlrpc)
56+
| "vm_metrics" -> VM_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_metrics_t "") xmlrpc)
57+
| "vm_guest_metrics" -> VM_guest_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_guest_metrics_t "") xmlrpc)
58+
| "host" -> Host (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_t "") xmlrpc)
59+
| "host_metrics" -> Host_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_metrics_t "") xmlrpc)
60+
| "host_cpu" -> Host_cpu (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_cpu_t "") xmlrpc)
61+
| "network" -> Network (API.Ref.of_string ev.Event_types.reference, maybe (API.From.network_t "") xmlrpc)
62+
| "vif" -> VIF (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vIF_t "") xmlrpc)
63+
| "vif_metrics" -> VIF_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vIF_metrics_t "") xmlrpc)
64+
| "pif" -> PIF (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pIF_t "") xmlrpc)
65+
| "pif_metrics" -> PIF_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pIF_metrics_t "") xmlrpc)
66+
| "sr" -> SR (API.Ref.of_string ev.Event_types.reference, maybe (API.From.sR_t "") xmlrpc)
67+
| "vdi" -> VDI (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vDI_t "") xmlrpc)
68+
| "vbd" -> VBD (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vBD_t "") xmlrpc)
69+
| "vbd_metrics" -> VBD_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vBD_metrics_t "") xmlrpc)
70+
| "pbd" -> PBD (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pBD_t "") xmlrpc)
71+
| "crashdump" -> Crashdump (API.Ref.of_string ev.Event_types.reference, maybe (API.From.crashdump_t "") xmlrpc)
72+
| "vtpm" -> VTPM (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vTPM_t "") xmlrpc)
73+
| "console" -> Console (API.Ref.of_string ev.Event_types.reference, maybe (API.From.console_t "") xmlrpc)
74+
| "user" -> User (API.Ref.of_string ev.Event_types.reference, maybe (API.From.user_t "") xmlrpc)
75+
| "pool" -> Pool (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pool_t "") xmlrpc)
76+
| "message" -> Message (API.Ref.of_string ev.Event_types.reference, maybe (API.From.message_t "") xmlrpc)
77+
| "secret" -> Secret (API.Ref.of_string ev.Event_types.reference, maybe (API.From.secret_t "") xmlrpc)
78+
| "vmpp" -> VMPP (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vMPP_t "") xmlrpc)
79+
| _ -> failwith "unknown event type"

‎lib/event_types.ml‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,107 @@
1+
(*
2+
* Copyright (C) 2006-2009 Citrix Systems Inc.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
(** Types used to store events: *****************************************************************)
16+
type op =
17+
| Add (** Object has been created *)
18+
| Del (** Object has been deleted *)
19+
| Mod (** Object has been modified *)
20+
| Dummy (** A dummy or filler event inserted by coalesce_events *)
21+
22+
type event = {
23+
id: int64;
24+
ts: float;
25+
ty: string;
26+
op: op;
27+
reference: string;
28+
snapshot: XMLRPC.xmlrpc option;
29+
}
30+
31+
type token = string
32+
33+
type event_from = {
34+
events: event list;
35+
valid_ref_counts: (string * int32) list;
36+
token: token;
37+
}
38+
(** Return result of an events.from call *)
39+
40+
open Printf
41+
42+
let string_of_op = function Add -> "add" | Mod -> "mod" | Del -> "del" | Dummy -> "dummy"
43+
let op_of_string x = match String.lowercase x with
44+
| "add" -> Add | "mod" -> Mod | "del" -> Del
45+
| x -> failwith (sprintf "Unknown operation type: %s" x)
46+
47+
let string_of_event ev = sprintf "%Ld %s %s %s %s" ev.id ev.ty (string_of_op ev.op) ev.reference
48+
(if ev.snapshot = None then "(no snapshot)" else "OK")
49+
50+
let maybe_with_default d f v =
51+
match v with None -> d | Some x -> f x
52+
53+
(** if v is not none, apply f on it and return some value else return none. *)
54+
let may f v = maybe_with_default None (fun x -> Some (f x)) v
55+
56+
(** default value to d if v is none. *)
57+
let default d v = maybe_with_default d (fun x -> x) v
58+
59+
(* Print a single event record as an XMLRPC value *)
60+
let xmlrpc_of_event ev =
61+
XMLRPC.To.structure
62+
([
63+
"id", XMLRPC.To.string (Int64.to_string ev.id);
64+
"timestamp", XMLRPC.To.string (string_of_float ev.ts);
65+
"class", XMLRPC.To.string ev.ty;
66+
"operation", XMLRPC.To.string (string_of_op ev.op);
67+
"ref", XMLRPC.To.string ev.reference;
68+
] @ (default [] (may (fun x -> [ "snapshot", x ]) ev.snapshot)))
69+
70+
let xmlrpc_of_event_from x =
71+
XMLRPC.To.structure
72+
[
73+
"events", XMLRPC.To.array (List.map xmlrpc_of_event x.events);
74+
"valid_ref_counts", XMLRPC.To.structure (List.map (fun (tbl, int) -> tbl, XMLRPC.To.int int) x.valid_ref_counts);
75+
"token",XMLRPC.To.string x.token;
76+
]
77+
78+
exception Event_field_missing of string
79+
let find kvpairs x =
80+
if not(List.mem_assoc x kvpairs)
81+
then raise (Event_field_missing x) else List.assoc x kvpairs
82+
83+
(* Convert a single XMLRPC value containing an encoded event into the event record *)
84+
let event_of_xmlrpc x =
85+
let kvpairs = XMLRPC.From.structure x in
86+
let find = find kvpairs in
87+
{ id = Int64.of_string (XMLRPC.From.string (find "id"));
88+
ts = float_of_string (XMLRPC.From.string (find "timestamp"));
89+
ty = XMLRPC.From.string (find "class");
90+
op = op_of_string (XMLRPC.From.string (find "operation"));
91+
reference = XMLRPC.From.string (find "ref");
92+
snapshot = if List.mem_assoc "snapshot" kvpairs then Some (List.assoc "snapshot" kvpairs) else None
93+
}
94+
95+
(* Convert an XMLRPC array of events into a list of event records *)
96+
let events_of_xmlrpc = XMLRPC.From.array event_of_xmlrpc
97+
98+
let event_from_of_xmlrpc x =
99+
let kvpairs = XMLRPC.From.structure x in
100+
let find = find kvpairs in
101+
{
102+
events = events_of_xmlrpc (find "events");
103+
valid_ref_counts = List.map (fun (tbl, int) -> tbl, XMLRPC.From.int int) (XMLRPC.From.structure (find "valid_ref_counts"));
104+
token = XMLRPC.From.string (find "token");
105+
}
106+
107+

‎lib/xen-api-client.mllib‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,12 @@
11
# OASIS_START
2-
# DO NOT EDIT (digest: 4c26ad75e5265add63f5266b8873d331)
2+
# DO NOT EDIT (digest: 5a7c4da49eb47f16e515d418a69f5b45)
33
API
44
Api_errors
55
Client
66
Date
77
XMLRPC
88
Xml
99
Xen_api
10+
Event_helper
11+
Event_types
1012
# OASIS_STOP

‎myocamlbuild.ml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(* OASIS_START *)
2-
(* DO NOT EDIT (digest: eb271b8c6b047764140fcaae774537c6) *)
2+
(* DO NOT EDIT (digest: 2cf81b2008cd8212e54a5cda2cc27912) *)
33
module OASISGettext = struct
4-
# 21 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/oasis/OASISGettext.ml"
4+
# 21 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/oasis/OASISGettext.ml"
55

66
let ns_ str =
77
str
@@ -24,7 +24,7 @@ module OASISGettext = struct
2424
end
2525

2626
module OASISExpr = struct
27-
# 21 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/oasis/OASISExpr.ml"
27+
# 21 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/oasis/OASISExpr.ml"
2828

2929

3030

@@ -116,7 +116,7 @@ end
116116

117117
# 117 "myocamlbuild.ml"
118118
module BaseEnvLight = struct
119-
# 21 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/base/BaseEnvLight.ml"
119+
# 21 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/base/BaseEnvLight.ml"
120120

121121
module MapString = Map.Make(String)
122122

@@ -214,7 +214,7 @@ end
214214

215215
# 215 "myocamlbuild.ml"
216216
module MyOCamlbuildFindlib = struct
217-
# 21 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
217+
# 21 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
218218

219219
(** OCamlbuild extension, copied from
220220
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
@@ -323,7 +323,7 @@ module MyOCamlbuildFindlib = struct
323323
end
324324

325325
module MyOCamlbuildBase = struct
326-
# 21 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
326+
# 21 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
327327

328328
(** Base functions for writing myocamlbuild.ml
329329
@author Sylvain Le Gall
@@ -339,7 +339,7 @@ module MyOCamlbuildBase = struct
339339
type name = string
340340
type tag = string
341341

342-
# 56 "/home/djs/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
342+
# 56 "/home/jludlam/.opam/3.12.1/build/oasis.0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
343343

344344
type t =
345345
{

0 commit comments

Comments
 (0)