forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request xapi-project#6 from jonludlam/events
Add the event helper modules.
- Loading branch information
Showing
6 changed files
with
250 additions
and
60 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,79 @@ | ||
| (* | ||
| * Copyright (C) 2006-2009 Citrix Systems Inc. | ||
| * | ||
| * This program is free software; you can redistribute it and/or modify | ||
| * it under the terms of the GNU Lesser General Public License as published | ||
| * by the Free Software Foundation; version 2.1 only. with the special | ||
| * exception on linking described in file LICENSE. | ||
| * | ||
| * This program is distributed in the hope that it will be useful, | ||
| * but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| * GNU Lesser General Public License for more details. | ||
| *) | ||
|
|
||
| type event_record = | ||
| | Session of [`Session ] API.Ref.t * API.session_t option | ||
| | Task of [`task ] API.Ref.t * API.task_t option | ||
| | Event of [`Event] API.Ref.t * API.event_t option | ||
| | VM of [`VM] API.Ref.t * API.vM_t option | ||
| | VM_metrics of [`VM_metrics] API.Ref.t * API.vM_metrics_t option | ||
| | VM_guest_metrics of [`VM_guest_metrics] API.Ref.t * API.vM_guest_metrics_t option | ||
| | Host of [`host] API.Ref.t * API.host_t option | ||
| | Host_metrics of [`host_metrics] API.Ref.t * API.host_metrics_t option | ||
| | Host_cpu of [`host_cpu] API.Ref.t * API.host_cpu_t option | ||
| | Network of [`network] API.Ref.t * API.network_t option | ||
| | VIF of [`VIF] API.Ref.t * API.vIF_t option | ||
| | VIF_metrics of [`VIF_metrics] API.Ref.t * API.vIF_metrics_t option | ||
| | PIF of [`PIF] API.Ref.t * API.pIF_t option | ||
| | PIF_metrics of [`PIF_metrics] API.Ref.t * API.pIF_metrics_t option | ||
| | SR of [`SR] API.Ref.t * API.sR_t option | ||
| | VDI of [`VDI] API.Ref.t * API.vDI_t option | ||
| | VBD of [`VBD] API.Ref.t * API.vBD_t option | ||
| | VBD_metrics of [`VBD_metrics] API.Ref.t * API.vBD_metrics_t option | ||
| | PBD of [`PBD] API.Ref.t * API.pBD_t option | ||
| | Crashdump of [`Crashdump] API.Ref.t * API.crashdump_t option | ||
| | VTPM of [`VTPM] API.Ref.t * API.vTPM_t option | ||
| | Console of [`Console] API.Ref.t * API.console_t option | ||
| | User of [`User] API.Ref.t * API.user_t option | ||
| | Pool of [`pool] API.Ref.t * API.pool_t option | ||
| | Message of [`message] API.Ref.t * API.message_t option | ||
| | Secret of [`secret] API.Ref.t * API.secret_t option | ||
| | VMPP of [`VMPP] API.Ref.t * API.vMPP_t option | ||
|
|
||
| let maybe f x = | ||
| match x with | ||
| | Some x -> Some (f x) | ||
| | None -> None | ||
|
|
||
| let record_of_event ev = | ||
| let xmlrpc = ev.Event_types.snapshot in | ||
| match ev.Event_types.ty with | ||
| | "session" -> Session (API.Ref.of_string ev.Event_types.reference, maybe (API.From.session_t "") xmlrpc) | ||
| | "task" -> Task (API.Ref.of_string ev.Event_types.reference, maybe (API.From.task_t "") xmlrpc) | ||
| | "event" -> Event (API.Ref.of_string ev.Event_types.reference, maybe (API.From.event_t "") xmlrpc) | ||
| | "vm" -> VM (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_t "") xmlrpc) | ||
| | "vm_metrics" -> VM_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_metrics_t "") xmlrpc) | ||
| | "vm_guest_metrics" -> VM_guest_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vM_guest_metrics_t "") xmlrpc) | ||
| | "host" -> Host (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_t "") xmlrpc) | ||
| | "host_metrics" -> Host_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_metrics_t "") xmlrpc) | ||
| | "host_cpu" -> Host_cpu (API.Ref.of_string ev.Event_types.reference, maybe (API.From.host_cpu_t "") xmlrpc) | ||
| | "network" -> Network (API.Ref.of_string ev.Event_types.reference, maybe (API.From.network_t "") xmlrpc) | ||
| | "vif" -> VIF (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vIF_t "") xmlrpc) | ||
| | "vif_metrics" -> VIF_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vIF_metrics_t "") xmlrpc) | ||
| | "pif" -> PIF (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pIF_t "") xmlrpc) | ||
| | "pif_metrics" -> PIF_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pIF_metrics_t "") xmlrpc) | ||
| | "sr" -> SR (API.Ref.of_string ev.Event_types.reference, maybe (API.From.sR_t "") xmlrpc) | ||
| | "vdi" -> VDI (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vDI_t "") xmlrpc) | ||
| | "vbd" -> VBD (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vBD_t "") xmlrpc) | ||
| | "vbd_metrics" -> VBD_metrics (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vBD_metrics_t "") xmlrpc) | ||
| | "pbd" -> PBD (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pBD_t "") xmlrpc) | ||
| | "crashdump" -> Crashdump (API.Ref.of_string ev.Event_types.reference, maybe (API.From.crashdump_t "") xmlrpc) | ||
| | "vtpm" -> VTPM (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vTPM_t "") xmlrpc) | ||
| | "console" -> Console (API.Ref.of_string ev.Event_types.reference, maybe (API.From.console_t "") xmlrpc) | ||
| | "user" -> User (API.Ref.of_string ev.Event_types.reference, maybe (API.From.user_t "") xmlrpc) | ||
| | "pool" -> Pool (API.Ref.of_string ev.Event_types.reference, maybe (API.From.pool_t "") xmlrpc) | ||
| | "message" -> Message (API.Ref.of_string ev.Event_types.reference, maybe (API.From.message_t "") xmlrpc) | ||
| | "secret" -> Secret (API.Ref.of_string ev.Event_types.reference, maybe (API.From.secret_t "") xmlrpc) | ||
| | "vmpp" -> VMPP (API.Ref.of_string ev.Event_types.reference, maybe (API.From.vMPP_t "") xmlrpc) | ||
| | _ -> failwith "unknown event type" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,107 @@ | ||
| (* | ||
| * Copyright (C) 2006-2009 Citrix Systems Inc. | ||
| * | ||
| * This program is free software; you can redistribute it and/or modify | ||
| * it under the terms of the GNU Lesser General Public License as published | ||
| * by the Free Software Foundation; version 2.1 only. with the special | ||
| * exception on linking described in file LICENSE. | ||
| * | ||
| * This program is distributed in the hope that it will be useful, | ||
| * but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| * GNU Lesser General Public License for more details. | ||
| *) | ||
|
|
||
| (** Types used to store events: *****************************************************************) | ||
| type op = | ||
| | Add (** Object has been created *) | ||
| | Del (** Object has been deleted *) | ||
| | Mod (** Object has been modified *) | ||
| | Dummy (** A dummy or filler event inserted by coalesce_events *) | ||
|
|
||
| type event = { | ||
| id: int64; | ||
| ts: float; | ||
| ty: string; | ||
| op: op; | ||
| reference: string; | ||
| snapshot: XMLRPC.xmlrpc option; | ||
| } | ||
|
|
||
| type token = string | ||
|
|
||
| type event_from = { | ||
| events: event list; | ||
| valid_ref_counts: (string * int32) list; | ||
| token: token; | ||
| } | ||
| (** Return result of an events.from call *) | ||
|
|
||
| open Printf | ||
|
|
||
| let string_of_op = function Add -> "add" | Mod -> "mod" | Del -> "del" | Dummy -> "dummy" | ||
| let op_of_string x = match String.lowercase x with | ||
| | "add" -> Add | "mod" -> Mod | "del" -> Del | ||
| | x -> failwith (sprintf "Unknown operation type: %s" x) | ||
|
|
||
| let string_of_event ev = sprintf "%Ld %s %s %s %s" ev.id ev.ty (string_of_op ev.op) ev.reference | ||
| (if ev.snapshot = None then "(no snapshot)" else "OK") | ||
|
|
||
| let maybe_with_default d f v = | ||
| match v with None -> d | Some x -> f x | ||
|
|
||
| (** if v is not none, apply f on it and return some value else return none. *) | ||
| let may f v = maybe_with_default None (fun x -> Some (f x)) v | ||
|
|
||
| (** default value to d if v is none. *) | ||
| let default d v = maybe_with_default d (fun x -> x) v | ||
|
|
||
| (* Print a single event record as an XMLRPC value *) | ||
| let xmlrpc_of_event ev = | ||
| XMLRPC.To.structure | ||
| ([ | ||
| "id", XMLRPC.To.string (Int64.to_string ev.id); | ||
| "timestamp", XMLRPC.To.string (string_of_float ev.ts); | ||
| "class", XMLRPC.To.string ev.ty; | ||
| "operation", XMLRPC.To.string (string_of_op ev.op); | ||
| "ref", XMLRPC.To.string ev.reference; | ||
| ] @ (default [] (may (fun x -> [ "snapshot", x ]) ev.snapshot))) | ||
|
|
||
| let xmlrpc_of_event_from x = | ||
| XMLRPC.To.structure | ||
| [ | ||
| "events", XMLRPC.To.array (List.map xmlrpc_of_event x.events); | ||
| "valid_ref_counts", XMLRPC.To.structure (List.map (fun (tbl, int) -> tbl, XMLRPC.To.int int) x.valid_ref_counts); | ||
| "token",XMLRPC.To.string x.token; | ||
| ] | ||
|
|
||
| exception Event_field_missing of string | ||
| let find kvpairs x = | ||
| if not(List.mem_assoc x kvpairs) | ||
| then raise (Event_field_missing x) else List.assoc x kvpairs | ||
|
|
||
| (* Convert a single XMLRPC value containing an encoded event into the event record *) | ||
| let event_of_xmlrpc x = | ||
| let kvpairs = XMLRPC.From.structure x in | ||
| let find = find kvpairs in | ||
| { id = Int64.of_string (XMLRPC.From.string (find "id")); | ||
| ts = float_of_string (XMLRPC.From.string (find "timestamp")); | ||
| ty = XMLRPC.From.string (find "class"); | ||
| op = op_of_string (XMLRPC.From.string (find "operation")); | ||
| reference = XMLRPC.From.string (find "ref"); | ||
| snapshot = if List.mem_assoc "snapshot" kvpairs then Some (List.assoc "snapshot" kvpairs) else None | ||
| } | ||
|
|
||
| (* Convert an XMLRPC array of events into a list of event records *) | ||
| let events_of_xmlrpc = XMLRPC.From.array event_of_xmlrpc | ||
|
|
||
| let event_from_of_xmlrpc x = | ||
| let kvpairs = XMLRPC.From.structure x in | ||
| let find = find kvpairs in | ||
| { | ||
| events = events_of_xmlrpc (find "events"); | ||
| valid_ref_counts = List.map (fun (tbl, int) -> tbl, XMLRPC.From.int int) (XMLRPC.From.structure (find "valid_ref_counts")); | ||
| token = XMLRPC.From.string (find "token"); | ||
| } | ||
|
|
||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,10 +1,12 @@ | ||
| # OASIS_START | ||
| # DO NOT EDIT (digest: 4c26ad75e5265add63f5266b8873d331) | ||
| # DO NOT EDIT (digest: 5a7c4da49eb47f16e515d418a69f5b45) | ||
| API | ||
| Api_errors | ||
| Client | ||
| Date | ||
| XMLRPC | ||
| Xml | ||
| Xen_api | ||
| Event_helper | ||
| Event_types | ||
| # OASIS_STOP |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.