forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
/
test.ml
367 lines (313 loc) · 13 KB
/
test.ml
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
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
(*
* Copyright (C) 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.
*)
(**
* @group Storage
*)
open OUnit
open Listext
open Stringext
open Xmlrpc_client
let default_storage_path = Filename.concat Fhs.vardir "storage"
let default_xapi_path = Filename.concat Fhs.vardir "xapi"
let default_remote_storage_path = Filename.concat Fhs.vardir "storage"
let default_remote_xapi_path = Filename.concat Fhs.vardir "xapi"
let transport = ref (Unix default_storage_path)
let xtransport = ref (Unix default_xapi_path)
let rtransport = ref (Unix default_remote_storage_path)
let rxtransport = ref (Unix default_remote_xapi_path)
let session = ref ""
let rsession = ref ""
module I=struct
type t=int64 with rpc
let add=Int64.add
let sub=Int64.sub
let zero=Int64.zero
end
module Int64extentlist = ExtentlistSet.ExtentlistSet(I)
type junk_t = (Int64extentlist.t * char) list
let storage_rpc transport session call =
XMLRPC_protocol.rpc ~srcstr:"sm-cli-test" ~dststr:"smapi2_via_xapi" ~transport
~http:(xmlrpc ~version:"1.0" ~query:["session_id",session] "/services/SM") call
let xapi_rpc transport call =
XMLRPC_protocol.rpc ~srcstr:"sm-cli-test" ~dststr:"xapi" ~transport
~http:(xmlrpc ~version:"1.0" "/") call
let rpc = fun call -> storage_rpc !transport !session call
let xrpc = fun call -> xapi_rpc !xtransport call
let rrpc = fun call -> storage_rpc !rtransport !rsession call
let rxrpc = fun call -> xapi_rpc !rxtransport call
let do_nbd url sr vdi dp f =
let url = Http.Url.of_string url in
let path = (Printf.sprintf "/services/SM/nbd/%s/%s/%s" sr vdi dp) in
let dest_url = Http.Url.set_uri url path in
let request = Http.Request.make ~query:(Http.Url.get_query_params url)
~user_agent:"smtest" Http.Put path in
let transport = Xmlrpc_client.transport_of_url dest_url in
with_transport transport (with_http request (fun (response, s) -> f s))
exception Bad_junk
(* Helpers *)
let write_char fd c start len =
Printf.printf "write_char: %c sector:%Ld nsectors:%d\n%!" c start len;
if len*512 > Sys.max_string_length then failwith "len too large";
let s = String.make (len*512) c in
ignore(Nbd.write fd (Int64.mul 512L start) s 0 (String.length s))
let write_junk fd size n current_junk =
let maxsize = (1024*2) (*Sys.max_string_length*) in
let maxsizeL = Int64.of_int maxsize in
let rec inner m cur =
if m=n then cur else
let char = Char.chr (Random.int 255) in
let start = Random.int64 (Int64.sub size maxsizeL) in
let len = Random.int maxsize in
write_char fd char start len;
let myextentlist = Int64extentlist.of_list [(start,Int64.of_int len)] in
inner (m+1) ((myextentlist,char)::(List.map (fun (extlist,c) -> (Int64extentlist.difference extlist myextentlist, c)) cur))
in
inner 0 current_junk
let check_junk fd junk =
let rec inner j =
match j with
| (extentlist,c)::rest ->
List.iter (fun (start,len64) ->
let len = 512 * (Int64.to_int len64) in
let s = match Nbd.read fd (Int64.mul start 512L) (Int32.of_int len) with Some s -> s | None -> failwith "Failed to read" in
let check = String.make len c in
Printf.printf "Checking %d at sector offset %Ld, size %Ld sectors\n" (Char.code c) start len64;
if String.compare s check <> 0 then raise Bad_junk)
(Int64extentlist.to_list extentlist);
inner rest
| _ -> ()
in
inner junk
(**open Storage_interface*)
module SMClient = Storage_interface.Client(struct let rpc = rpc end)
module RSMClient = Storage_interface.Client(struct let rpc = rrpc end)
module XapiClient = Client.Client
open Storage_interface
let dbg = "sm-test"
let mib = Int64.mul 1024L 1024L
let usage_and_exit () =
Printf.fprintf stderr "Usage:\n";
Printf.fprintf stderr " %s <SR>" Sys.argv.(0);
exit 1
let find_vdi_in_scan sr vdi =
let results = SMClient.SR.scan ~dbg ~sr in
try
Some (List.find (fun x -> x.vdi = vdi) results)
with Not_found ->
None
let test_query sr _ = let (_: query_result) = SMClient.Query.query ~dbg in ()
let missing_vdi = "missing"
let test_scan_missing_vdi sr _ =
match find_vdi_in_scan sr missing_vdi with
| Some vdi -> failwith (Printf.sprintf "SR.scan found a VDI that was supposed to be missing: %s" (string_of_vdi_info vdi))
| None -> ()
let test_destroy_missing_vdi sr _ =
try
SMClient.VDI.destroy ~dbg ~sr ~vdi:missing_vdi;
failwith "VDI.destroy unexpectedly succeeded"
with
| Vdi_does_not_exist(_) -> ()
| x -> failwith (Printf.sprintf "Unexpected result from VDI.destroy: %s\n" (Printexc.to_string x))
let vdi_info_assert_equal vdi_info vdi_info' =
assert_equal ~msg:"name_label" ~printer:(fun x -> x) vdi_info.name_label vdi_info'.name_label;
assert_equal ~msg:"name_description" ~printer:(fun x -> x) vdi_info.name_description vdi_info'.name_description;
assert_equal ~msg:"ty" ~printer:(fun x -> x) (String.lowercase vdi_info.ty) (String.lowercase vdi_info'.ty);
assert_equal ~msg:"metadata_of_pool" ~printer:(fun x -> x) vdi_info.metadata_of_pool vdi_info'.metadata_of_pool;
assert_equal ~msg:"is_a_snapshot" ~printer:string_of_bool vdi_info.is_a_snapshot vdi_info'.is_a_snapshot;
assert_equal ~msg:"snapshot_time" ~printer:(fun x -> x) vdi_info.snapshot_time vdi_info'.snapshot_time;
assert_equal ~msg:"snapshot_of" ~printer:(fun x -> x) vdi_info.snapshot_of vdi_info'.snapshot_of;
assert_equal ~msg:"read_only" ~printer:string_of_bool vdi_info.read_only vdi_info'.read_only;
assert_equal ~msg:"persistent" ~printer:string_of_bool vdi_info.persistent vdi_info'.persistent
let example_vdi_info =
let name_label = "test_name_label" in
let name_description = "test_name_description" in
let ty = "ephemeral" in
let metadata_of_pool = "mop" in
let is_a_snapshot = true in
let snapshot_time = "19700101T00:00:00Z" in
let snapshot_of = "sof" in
let read_only = false in
let virtual_size = Int64.mul 8L mib in
let physical_utilisation = 0L in
let sm_config = [] in
{
vdi = "";
content_id = "";
name_label = name_label;
name_description = name_description;
ty = ty;
metadata_of_pool = metadata_of_pool;
is_a_snapshot = is_a_snapshot;
snapshot_time = snapshot_time;
snapshot_of = snapshot_of;
read_only = read_only;
virtual_size = virtual_size;
physical_utilisation = physical_utilisation;
persistent = true;
sm_config = sm_config;
}
let test_create_destroy sr _ =
let vdi_info = example_vdi_info in
let vdi_info' =
let vdi_info' = SMClient.VDI.create ~dbg ~sr ~vdi_info in
vdi_info_assert_equal vdi_info vdi_info';
vdi_info'
in
begin match find_vdi_in_scan sr vdi_info'.vdi with
| None -> failwith (Printf.sprintf "SR.scan failed to find vdi: %s" (string_of_vdi_info vdi_info'))
| Some vdi_info'' -> vdi_info_assert_equal vdi_info' vdi_info''
end;
SMClient.VDI.destroy ~dbg ~sr ~vdi:vdi_info'.vdi;
begin match find_vdi_in_scan sr vdi_info'.vdi with
| Some vdi_info''' -> failwith (Printf.sprintf "SR.scan found a VDI that was just deleted: %s" (string_of_vdi_info vdi_info'''))
| None -> ()
end
let test_attach_activate url sr _ =
let vdi_info = SMClient.VDI.create ~dbg ~sr ~vdi_info:example_vdi_info in
let dp = "test_attach_activate" in
let _ = SMClient.VDI.attach ~dbg ~sr ~dp ~vdi:vdi_info.vdi ~read_write:true in
SMClient.VDI.activate ~dbg ~sr ~dp ~vdi:vdi_info.vdi;
do_nbd url sr vdi_info.vdi dp (fun s ->
let (size,_) = Nbd.negotiate s in
Printf.printf "size=%Ld\n" size;
let secsize = Int64.div size 512L in
let junk = write_junk s secsize 10 [(Int64extentlist.of_list [(0L,secsize)],Char.chr 0)] in
check_junk s junk;
let junk2 =
let (e,c) = List.hd junk in
let newc = if c='x' then 'y' else 'x' in
List.rev ((e,newc)::List.tl junk)
in
let success = try check_junk s junk2; false with _ -> true in
if success
then Printf.printf "OK\n"
else Printf.printf "Not OK!\n"
);
SMClient.VDI.destroy ~dbg ~sr ~vdi:vdi_info.vdi
let test_mirror_1 url sr rurl rsr _ =
let vdi_info = SMClient.VDI.create ~dbg ~sr ~vdi_info:example_vdi_info in
let dp = "test_attach_activate" in
ignore(SMClient.VDI.attach ~dbg ~sr ~dp ~vdi:vdi_info.vdi ~read_write:true);
SMClient.VDI.activate ~dbg ~sr ~dp ~vdi:vdi_info.vdi;
let junk = do_nbd url sr vdi_info.vdi dp (fun s ->
let (size,_) = Nbd.negotiate s in
Printf.printf "size=%Ld\n" size;
let secsize = Int64.div size 512L in
let junk = write_junk s secsize 10 [(Int64extentlist.of_list [(0L,secsize)],Char.chr 0)] in
check_junk s junk;
let junk2 =
let (e,c) = List.hd junk in
let newc = if c='x' then 'y' else 'x' in
List.rev ((e,newc)::List.tl junk)
in
let success = try check_junk s junk2; false with _ -> true in
(if success
then Printf.printf "OK\n"
else Printf.printf "Not OK!\n");
junk
) in
(* At this point, we have a VDI containing data with which we can mirror *)
let task = SMClient.DATA.MIRROR.start ~dbg ~sr ~vdi:vdi_info.vdi ~dp ~url:rurl ~dest:rsr in
let finished = function
| Task.Pending _ -> false
| _ -> true
in
while not (finished (SMClient.TASK.stat ~dbg ~task).Task.state) do
Thread.delay 5.0;
done;
let task = SMClient.TASK.stat ~dbg ~task in
let mirror_id = match task.Task.state with
| Task.Completed { Task.result=Some (Mirror_id m) } -> m
| _ -> failwith "Mirror failed"
in
let mirror = SMClient.DATA.MIRROR.stat ~dbg ~id:mirror_id in
let remote_vdi = mirror.Mirror.dest_vdi in
let junk = do_nbd url sr vdi_info.vdi dp (fun s ->
let (size,_) = Nbd.negotiate s in
Printf.printf "size=%Ld\n" size;
let secsize = Int64.div size 512L in
let junk = write_junk s secsize 10 junk in
check_junk s junk;
let junk2 =
let (e,c) = List.hd junk in
let newc = if c='x' then 'y' else 'x' in
List.rev ((e,newc)::List.tl junk)
in
let success = try check_junk s junk2; false with _ -> true in
(if success
then Printf.printf "OK\n"
else Printf.printf "Not OK!\n");
junk
) in
(* *)
SMClient.VDI.deactivate ~dbg ~sr ~dp ~vdi:vdi_info.vdi;
SMClient.VDI.detach ~dbg ~sr ~dp ~vdi:vdi_info.vdi;
SMClient.VDI.destroy ~dbg ~sr ~vdi:vdi_info.vdi;
ignore(RSMClient.VDI.attach ~dbg ~sr:rsr ~dp ~vdi:remote_vdi ~read_write:true);
RSMClient.VDI.activate ~dbg ~sr:rsr ~dp ~vdi:remote_vdi;
do_nbd rurl rsr remote_vdi dp (fun s ->
let (size,_) = Nbd.negotiate s in
Printf.printf "Mirror VDI: size=%Ld\n" size;
check_junk s junk;
let junk2 =
let (e,c) = List.hd junk in
let newc = if c='x' then 'y' else 'x' in
List.rev ((e,newc)::List.tl junk)
in
let success = try check_junk s junk2; false with _ -> true in
if success
then Printf.printf "Mirror VDI: OK\n"
else Printf.printf "Mirror VDI: Not OK!\n"
);
RSMClient.VDI.destroy ~dbg ~sr:rsr ~vdi:remote_vdi
let _ =
let verbose = ref false in
let sr = ref "" in
let rsr = ref "" in
let host = ref "localhost" in
let host2 = ref "localhost" in
let username = ref "root" in
let password = ref "xenroot" in
Arg.parse [
"-socket", Arg.String (fun s -> transport := Unix s), "Unix domain socket for local SMAPIv2";
"-sr", Arg.Set_string sr, "Specify SR";
"-rsr", Arg.Set_string rsr, "Specify remote SR";
"-verbose", Arg.Unit (fun _ -> verbose := true), "Run in verbose mode";
"-host", Arg.Set_string host, "Host to connect to (defaults to localhost)";
"-host2", Arg.Set_string host2, "Second host to connect to for mirroring (can be the same as host1)";
"-username", Arg.Set_string username, "Xapi username";
"-password", Arg.Set_string password, "Xapi password";
] (fun x -> Printf.fprintf stderr "Ignoring argument: %s\n" x)
"Test via storage backend";
if !sr = "" then failwith "Please supply -sr argument";
rxtransport := (TCP (!host2, 80));
rtransport := (TCP (!host2, 80));
let localsession = XapiClient.Session.login_with_password xrpc !username !password "1.0" in
session := Ref.string_of localsession;
let remotesession = XapiClient.Session.login_with_password rxrpc !username !password "1.0" in
rsession := Ref.string_of remotesession;
let url = Printf.sprintf "http://%s/services/SM?session_id=%s" !host !session in
let rurl = Printf.sprintf "http://%s/services/SM?session_id=%s" !host2 !rsession in
Pervasiveext.finally (fun () ->
let suite = "Storage test" >:::
[
"test_query" >:: (test_query !sr);
"test_scan_missing_vdi" >:: (test_scan_missing_vdi !sr);
"test_destroy_missing_vdi" >:: (test_destroy_missing_vdi !sr);
"test_create_destroy" >:: (test_create_destroy !sr);
"test_attach_activate" >:: (test_attach_activate url !sr);
"test_mirror" >:: (test_mirror_1 url !sr rurl !rsr);
] in
run_test_tt ~verbose:!verbose suite
) (fun () -> ())