← Back to branch summary

~ubuntu-branches/ubuntu/quantal/xen-api/quantal

« back to all changes in this revision

Viewing changes to ocaml/xapi/monitor_transfer.ml

  • Committer: Package Import Robot
  • Author(s): Jon Ludlam
  • Date: 2011-07-07 21:50:18 UTC
  • Revision ID: package-import@ubuntu.com-20110707215018-3t9ekbh7qy5y2b1p
Tags: upstream-1.3
Import upstream version 1.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/xapi/monitor_transfer.ml
 
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
 * @group Performance Monitoring
 
16
 *)
 
17
 
 
18
open Monitor_types
 
19
 
 
20
let marshall_vifs l =
 
21
  let f x =
 
22
    match x with
 
23
        (uuid,vif) -> (*(i2,(s,i64_1, i64_2))) ->*)
 
24
          XMLRPC.To.array
 
25
            [
 
26
              XMLRPC.To.string uuid;
 
27
              XMLRPC.To.string (string_of_int vif.vif_n);
 
28
              XMLRPC.To.string vif.vif_name;
 
29
              XMLRPC.To.string (string_of_float vif.vif_tx);
 
30
              XMLRPC.To.string (string_of_float vif.vif_rx)
 
31
            ] in
 
32
    XMLRPC.To.array (List.map f l)
 
33
 
 
34
let unmarshall_vifs xml =
 
35
  let f xml =
 
36
    match XMLRPC.From.array (fun x->x) xml with
 
37
        [uuid;i2;s;i64_1;i64_2] ->
 
38
          (XMLRPC.From.string uuid,
 
39
           {vif_n=int_of_string (XMLRPC.From.string i2);
 
40
            vif_name=(XMLRPC.From.string s);
 
41
            vif_tx=float_of_string (XMLRPC.From.string i64_1);
 
42
            vif_rx=float_of_string (XMLRPC.From.string i64_2);
 
43
            vif_raw_tx=0L;
 
44
            vif_raw_rx=0L;
 
45
            vif_raw_tx_err=0L;
 
46
            vif_raw_rx_err=0L})
 
47
                | _ -> failwith (Printf.sprintf "unmarshall_vifs unexpected XML: %s" (Xml.to_string xml))
 
48
 in
 
49
    List.map f (XMLRPC.From.array (fun x->x) xml)
 
50
 
 
51
let marshall_vbds l =
 
52
  let f x =
 
53
    match x with
 
54
        (uuid,vbd) ->
 
55
          XMLRPC.To.array
 
56
            [
 
57
              XMLRPC.To.string uuid;
 
58
              XMLRPC.To.string (string_of_int vbd.vbd_device_id);
 
59
              XMLRPC.To.string (string_of_float vbd.vbd_io_read);
 
60
              XMLRPC.To.string (string_of_float vbd.vbd_io_write);
 
61
            ] in
 
62
    XMLRPC.To.array (List.map f l)
 
63
 
 
64
let unmarshall_vbds xml =
 
65
  let f xml =
 
66
    match XMLRPC.From.array (fun x->x) xml with
 
67
        [uuid;i2;i64_1;i64_2] ->
 
68
          (XMLRPC.From.string uuid,
 
69
           {vbd_device_id=int_of_string (XMLRPC.From.string i2);
 
70
            vbd_io_read=float_of_string (XMLRPC.From.string i64_1);
 
71
            vbd_io_write=float_of_string (XMLRPC.From.string i64_2);
 
72
            vbd_raw_io_read=0L;
 
73
            vbd_raw_io_write=0L;})
 
74
                | _ -> failwith (Printf.sprintf "unmarshall_vbds unexpected XML: %s" (Xml.to_string xml))
 
75
 in
 
76
    List.map f (XMLRPC.From.array (fun x->x) xml)
 
77
 
 
78
let marshall_float_array (a : float array) =
 
79
  let l = Array.to_list a in
 
80
    XMLRPC.To.array (List.map (fun x -> XMLRPC.To.string (string_of_float x)) l)
 
81
 
 
82
let unmarshall_float_array xml : float array =
 
83
  Array.of_list (XMLRPC.From.array (fun x -> float_of_string (XMLRPC.From.string x)) xml)
 
84
 
 
85
let marshall_pcpus pcpus =
 
86
  XMLRPC.To.array [ marshall_float_array pcpus.pcpus_usage ]
 
87
 
 
88
let unmarshall_pcpus xml =
 
89
    match XMLRPC.From.array (fun x->x) xml with
 
90
        [ia] -> {pcpus_usage=unmarshall_float_array ia}
 
91
                | _ -> failwith (Printf.sprintf "unmarshall_pcpus unexpected XML: %s" (Xml.to_string xml))
 
92
 
 
93
 
 
94
let marshall_vcpus l =
 
95
  let f x =
 
96
    match x with
 
97
        (uuid, vcpus) ->
 
98
          XMLRPC.To.array
 
99
            [
 
100
              XMLRPC.To.string uuid;
 
101
              XMLRPC.To.string (string_of_float vcpus.vcpu_sumcpus);
 
102
              marshall_float_array (vcpus.vcpu_vcpus)
 
103
            ] in
 
104
    XMLRPC.To.array (List.map f l)
 
105
 
 
106
let unmarshall_vcpus xml =
 
107
  let f xml =
 
108
    match XMLRPC.From.array (fun x->x) xml with
 
109
        [uuid;i;ia] ->
 
110
          (XMLRPC.From.string uuid,
 
111
           {vcpu_sumcpus=float_of_string (XMLRPC.From.string i);
 
112
            vcpu_vcpus=unmarshall_float_array ia;
 
113
            vcpu_rawvcpus=[| |];
 
114
            vcpu_cputime=0L;
 
115
           })
 
116
                | _ -> failwith (Printf.sprintf "unmarshall_vcpus unexpected XML: %s" (Xml.to_string xml))
 
117
 in
 
118
    List.map f (XMLRPC.From.array (fun x->x) xml)
 
119
 
 
120
let marshall_memory l =
 
121
  let f x =
 
122
    match x with
 
123
        (uuid, mem) ->
 
124
          XMLRPC.To.array
 
125
            [
 
126
              XMLRPC.To.string uuid;
 
127
              XMLRPC.To.string (Int64.to_string mem.memory_mem)
 
128
            ] in
 
129
    XMLRPC.To.array (List.map f l)
 
130
 
 
131
let unmarshall_memory xml =
 
132
  let f xml =
 
133
    match XMLRPC.From.array (fun x->x) xml with
 
134
        [uuid;i64] ->
 
135
          (XMLRPC.From.string uuid,
 
136
           {memory_mem=Int64.of_string (XMLRPC.From.string i64)})
 
137
                | _ -> failwith (Printf.sprintf "unmarshall_memory unexpected XML: %s" (Xml.to_string xml))
 
138
 in
 
139
    List.map f (XMLRPC.From.array (fun x->x) xml)
 
140
 
 
141
let marshall_pifs pifs =
 
142
        let f x = match x with
 
143
        | pif ->
 
144
                XMLRPC.To.array [
 
145
                        XMLRPC.To.string pif.pif_name;
 
146
                        XMLRPC.To.string (string_of_float pif.pif_tx);
 
147
                        XMLRPC.To.string (string_of_float pif.pif_rx);
 
148
                        XMLRPC.To.string (string_of_bool pif.pif_carrier);
 
149
                        XMLRPC.To.string (string_of_int (Netdev.Link.int_of_speed pif.pif_speed));
 
150
                        XMLRPC.To.string (Netdev.Link.string_of_duplex pif.pif_duplex);
 
151
                        XMLRPC.To.string pif.pif_pci_bus_path;
 
152
                        XMLRPC.To.string pif.pif_vendor_id;
 
153
                        XMLRPC.To.string pif.pif_device_id;
 
154
                ] in
 
155
        XMLRPC.To.array (List.map f pifs)
 
156
 
 
157
let unmarshall_pifs xml =
 
158
        let f xml = match XMLRPC.From.array (fun x -> x) xml with
 
159
        | [ name; i64_1; i64_2; carrier; speed; duplex; pcibuspath; vendor; device ] ->
 
160
                {pif_name=XMLRPC.From.string name;
 
161
                 pif_tx=float_of_string (XMLRPC.From.string i64_1);
 
162
                 pif_rx=float_of_string (XMLRPC.From.string i64_2);
 
163
                 pif_raw_tx=0L;
 
164
                 pif_raw_rx=0L; (* Ignore these, for RRD only *)
 
165
                 pif_carrier=bool_of_string (XMLRPC.From.string carrier);
 
166
                 pif_speed=Netdev.Link.speed_of_int (int_of_string (XMLRPC.From.string speed));
 
167
                 pif_duplex=Netdev.Link.duplex_of_string (XMLRPC.From.string duplex);
 
168
                 pif_pci_bus_path=XMLRPC.From.string pcibuspath;
 
169
                 pif_vendor_id=XMLRPC.From.string vendor;
 
170
                 pif_device_id=XMLRPC.From.string device}
 
171
                | _ -> failwith (Printf.sprintf "unmarshall_pifs unexpected XML: %s" (Xml.to_string xml))
 
172
 in
 
173
        List.map f (XMLRPC.From.array (fun x -> x) xml)
 
174
 
 
175
let marshall_uuids uuids =
 
176
  XMLRPC.To.array (List.map XMLRPC.To.string uuids)
 
177
 
 
178
let unmarshall_uuids xml =
 
179
  XMLRPC.From.array XMLRPC.From.string xml
 
180
 
 
181
let marshall_host_stats hs =
 
182
  XMLRPC.To.array
 
183
    [
 
184
      XMLRPC.To.string (Ref.string_of hs.host_ref);
 
185
      XMLRPC.To.string (Int64.to_string hs.total_kib);
 
186
      XMLRPC.To.string (Int64.to_string hs.free_kib);
 
187
      marshall_vifs hs.vifs;
 
188
      marshall_pifs hs.pifs;
 
189
      marshall_vbds hs.vbds;
 
190
      marshall_pcpus hs.pcpus;
 
191
      marshall_vcpus hs.vcpus;
 
192
      marshall_memory hs.mem;
 
193
      marshall_uuids hs.registered
 
194
    ]
 
195
    
 
196
let unmarshall_host_stats xml =
 
197
  match (XMLRPC.From.array (fun x->x) xml) with
 
198
      [href; i64_1; i64_2; vifs; pifs; vbds; pcpus; vcpus; mem; uuids] ->
 
199
        {timestamp=0.0;
 
200
         host_ref=Ref.of_string (XMLRPC.From.string href);
 
201
         total_kib=Int64.of_string (XMLRPC.From.string i64_1);
 
202
         free_kib=Int64.of_string (XMLRPC.From.string i64_2);
 
203
         vifs=unmarshall_vifs vifs;
 
204
         pifs=unmarshall_pifs pifs;
 
205
         vbds=unmarshall_vbds vbds;
 
206
         pcpus=unmarshall_pcpus pcpus;
 
207
         vcpus=unmarshall_vcpus vcpus;
 
208
         mem=unmarshall_memory mem;
 
209
         registered=unmarshall_uuids uuids}
 
210
        | [vifs; pifs; vbds; pcpus; vcpus; mem; hostmetrics; uuids] ->
 
211
                (* CA-18377: This case supports unmarshalling of data from a Miami host. *)
 
212
                begin
 
213
                        match (XMLRPC.From.array (fun x->x) hostmetrics) with
 
214
                                [href; i64_1; i64_2] ->
 
215
                                        {timestamp=0.0;
 
216
                                         host_ref=Ref.of_string (XMLRPC.From.string href);
 
217
                                         total_kib=Int64.of_string (XMLRPC.From.string i64_1);
 
218
                                         free_kib=Int64.of_string (XMLRPC.From.string i64_2);
 
219
                                         vifs=unmarshall_vifs vifs;
 
220
                                         pifs=unmarshall_pifs pifs;
 
221
                                         vbds=unmarshall_vbds vbds;
 
222
                                         pcpus=unmarshall_pcpus pcpus;
 
223
                                         vcpus=unmarshall_vcpus vcpus;
 
224
                                         mem=unmarshall_memory mem;
 
225
                                         registered=unmarshall_uuids uuids}
 
226
                                | _ -> failwith (Printf.sprintf "unmarshall_host_stats unexpected XML: %s" (Xml.to_string xml))
 
227
                end
 
228
                | _ -> failwith (Printf.sprintf "unmarshall_host_stats unexpected XML: %s" (Xml.to_string xml))
 
229
 
 
230
let marshall hs = 
 
231
  marshall_host_stats hs
 
232
 
 
233
let unmarshall xml =
 
234
  unmarshall_host_stats xml