@@ -128,17 +128,17 @@ end
128
128
129
129
let vdi_of_volume x =
130
130
let open Storage_interface in {
131
- vdi = x.Storage.V .Types. key;
131
+ vdi = x.Storage.Volume .Types. key;
132
132
content_id = " " ;
133
- name_label = x.Storage.V .Types. name;
134
- name_description = x.Storage.V .Types. description;
133
+ name_label = x.Storage.Volume .Types. name;
134
+ name_description = x.Storage.Volume .Types. description;
135
135
ty = " " ;
136
136
metadata_of_pool = " " ;
137
137
is_a_snapshot = false ;
138
138
snapshot_time = " 19700101T00:00:00Z" ;
139
139
snapshot_of = " " ;
140
- read_only = not x.Storage.V .Types. read_write;
141
- virtual_size = x.Storage.V .Types. virtual_size;
140
+ read_only = not x.Storage.Volume .Types. read_write;
141
+ virtual_size = x.Storage.Volume .Types. virtual_size;
142
142
physical_utilisation = 0L ;
143
143
sm_config = [] ;
144
144
persistent = true ;
@@ -159,12 +159,12 @@ let script root_dir name kind script = match kind with
159
159
| `Datapath datapath -> Filename. (concat (concat (concat (dirname root_dir) " datapath" ) datapath) script)
160
160
161
161
let stat root_dir name dbg sr vdi =
162
- let args = Storage.V .Types.Volume.Stat.In. make dbg sr vdi in
163
- let args = Storage.V .Types.Volume.Stat.In. rpc_of_t args in
162
+ let args = Storage.Volume .Types.Volume.Stat.In. make dbg sr vdi in
163
+ let args = Storage.Volume .Types.Volume.Stat.In. rpc_of_t args in
164
164
let open Deferred.Result.Monad_infix in
165
- fork_exec_rpc root_dir (script root_dir name `Volume " Volume.stat" ) args Storage.V .Types.Volume.Stat.Out. t_of_rpc
165
+ fork_exec_rpc root_dir (script root_dir name `Volume " Volume.stat" ) args Storage.Volume .Types.Volume.Stat.Out. t_of_rpc
166
166
>> = fun response ->
167
- choose_datapath response.Storage.V .Types. uri
167
+ choose_datapath response.Storage.Volume .Types. uri
168
168
169
169
(* Process a message *)
170
170
let process root_dir name x =
@@ -174,34 +174,34 @@ let process root_dir name x =
174
174
| { R. name = "Query.query" ; R. params = [ args ] } ->
175
175
let args = Args.Query.Query. request_of_rpc args in
176
176
(* convert to new storage interface *)
177
- let args = Storage.P .Types.Plugin.Query.In. make args.Args.Query.Query. dbg in
178
- let args = Storage.P .Types.Plugin.Query.In. rpc_of_t args in
177
+ let args = Storage.Plugin .Types.Plugin.Query.In. make args.Args.Query.Query. dbg in
178
+ let args = Storage.Plugin .Types.Plugin.Query.In. rpc_of_t args in
179
179
let open Deferred.Result.Monad_infix in
180
- fork_exec_rpc root_dir (script root_dir name `Volume " Plugin.Query" ) args Storage.P .Types.Plugin.Query.Out. t_of_rpc
180
+ fork_exec_rpc root_dir (script root_dir name `Volume " Plugin.Query" ) args Storage.Plugin .Types.Plugin.Query.Out. t_of_rpc
181
181
>> = fun response ->
182
182
(* Convert between the xapi-storage interface and the SMAPI *)
183
183
let features = List. map ~f: (function
184
184
| "VDI_DESTROY" -> " VDI_DELETE"
185
- | x -> x) response.Storage.P .Types. features in
185
+ | x -> x) response.Storage.Plugin .Types. features in
186
186
let response = {
187
- driver = response.Storage.P .Types. plugin;
188
- name = response.Storage.P .Types. name;
189
- description = response.Storage.P .Types. description;
190
- vendor = response.Storage.P .Types. vendor;
191
- copyright = response.Storage.P .Types. copyright;
192
- version = response.Storage.P .Types. version;
193
- required_api_version = response.Storage.P .Types. required_api_version;
187
+ driver = response.Storage.Plugin .Types. plugin;
188
+ name = response.Storage.Plugin .Types. name;
189
+ description = response.Storage.Plugin .Types. description;
190
+ vendor = response.Storage.Plugin .Types. vendor;
191
+ copyright = response.Storage.Plugin .Types. copyright;
192
+ version = response.Storage.Plugin .Types. version;
193
+ required_api_version = response.Storage.Plugin .Types. required_api_version;
194
194
features;
195
195
configuration =
196
196
(" uri" , " URI of the storage medium" ) ::
197
- response.Storage.P .Types. configuration} in
197
+ response.Storage.Plugin .Types. configuration} in
198
198
Deferred.Result. return (R. success (Args.Query.Query. rpc_of_response response))
199
199
| { R. name = "Query.diagnostics" ; R. params = [ args ] } ->
200
200
let args = Args.Query.Diagnostics. request_of_rpc args in
201
- let args = Storage.P .Types.Plugin.Diagnostics.In. make args.Args.Query.Diagnostics. dbg in
202
- let args = Storage.P .Types.Plugin.Diagnostics.In. rpc_of_t args in
201
+ let args = Storage.Plugin .Types.Plugin.Diagnostics.In. make args.Args.Query.Diagnostics. dbg in
202
+ let args = Storage.Plugin .Types.Plugin.Diagnostics.In. rpc_of_t args in
203
203
let open Deferred.Result.Monad_infix in
204
- fork_exec_rpc root_dir (script root_dir name `Volume " Plugin.diagnostics" ) args Storage.P .Types.Plugin.Diagnostics.Out. t_of_rpc
204
+ fork_exec_rpc root_dir (script root_dir name `Volume " Plugin.diagnostics" ) args Storage.Plugin .Types.Plugin.Diagnostics.Out. t_of_rpc
205
205
>> = fun response ->
206
206
Deferred.Result. return (R. success (Args.Query.Diagnostics. rpc_of_response response))
207
207
| { R. name = "SR.attach" ; R. params = [ args ] } ->
@@ -211,10 +211,10 @@ let process root_dir name x =
211
211
| None ->
212
212
Deferred.Result. return (R. failure (missing_uri () ))
213
213
| Some (_ , uri ) ->
214
- let args' = Storage.V .Types.SR.Attach.In. make args.Args.SR.Attach. dbg uri in
215
- let args' = Storage.V .Types.SR.Attach.In. rpc_of_t args' in
214
+ let args' = Storage.Volume .Types.SR.Attach.In. make args.Args.SR.Attach. dbg uri in
215
+ let args' = Storage.Volume .Types.SR.Attach.In. rpc_of_t args' in
216
216
let open Deferred.Result.Monad_infix in
217
- fork_exec_rpc root_dir (script root_dir name `Volume " SR.attach" ) args' Storage.V .Types.SR.Attach.Out. t_of_rpc
217
+ fork_exec_rpc root_dir (script root_dir name `Volume " SR.attach" ) args' Storage.Volume .Types.SR.Attach.Out. t_of_rpc
218
218
>> = fun response ->
219
219
(* associate the 'sr' from the plugin with the SR reference passed in *)
220
220
Attached_SRs. add args.Args.SR.Attach. sr response
@@ -230,11 +230,11 @@ let process root_dir name x =
230
230
Deferred.Result. return (R. success (Args.SR.Detach. rpc_of_response () ))
231
231
| Ok sr ->
232
232
let open Deferred.Result.Monad_infix in
233
- let args' = Storage.V .Types.SR.Detach.In. make
233
+ let args' = Storage.Volume .Types.SR.Detach.In. make
234
234
args.Args.SR.Detach. dbg
235
235
sr in
236
- let args' = Storage.V .Types.SR.Detach.In. rpc_of_t args' in
237
- fork_exec_rpc root_dir (script root_dir name `Volume " SR.detach" ) args' Storage.V .Types.SR.Detach.Out. t_of_rpc
236
+ let args' = Storage.Volume .Types.SR.Detach.In. rpc_of_t args' in
237
+ fork_exec_rpc root_dir (script root_dir name `Volume " SR.detach" ) args' Storage.Volume .Types.SR.Detach.Out. t_of_rpc
238
238
>> = fun response ->
239
239
Attached_SRs. remove args.Args.SR.Detach. sr
240
240
>> = fun () ->
@@ -247,13 +247,13 @@ let process root_dir name x =
247
247
| None ->
248
248
Deferred.Result. return (R. failure (missing_uri () ))
249
249
| Some (_ , uri ) ->
250
- let args = Storage.V .Types.SR.Create.In. make
250
+ let args = Storage.Volume .Types.SR.Create.In. make
251
251
args.Args.SR.Create. dbg
252
252
uri
253
253
device_config in
254
- let args = Storage.V .Types.SR.Create.In. rpc_of_t args in
254
+ let args = Storage.Volume .Types.SR.Create.In. rpc_of_t args in
255
255
let open Deferred.Result.Monad_infix in
256
- fork_exec_rpc root_dir (script root_dir name `Volume " SR.create" ) args Storage.V .Types.SR.Create.Out. t_of_rpc
256
+ fork_exec_rpc root_dir (script root_dir name `Volume " SR.create" ) args Storage.Volume .Types.SR.Create.Out. t_of_rpc
257
257
>> = fun response ->
258
258
Deferred.Result. return (R. success (Args.SR.Create. rpc_of_response response))
259
259
end
@@ -262,11 +262,11 @@ let process root_dir name x =
262
262
let args = Args.SR.Scan. request_of_rpc args in
263
263
Attached_SRs. find args.Args.SR.Scan. sr
264
264
>> = fun sr ->
265
- let args = Storage.V .Types.SR.Ls.In. make
265
+ let args = Storage.Volume .Types.SR.Ls.In. make
266
266
args.Args.SR.Scan. dbg
267
267
sr in
268
- let args = Storage.V .Types.SR.Ls.In. rpc_of_t args in
269
- fork_exec_rpc root_dir (script root_dir name `Volume " SR.ls" ) args Storage.V .Types.SR.Ls.Out. t_of_rpc
268
+ let args = Storage.Volume .Types.SR.Ls.In. rpc_of_t args in
269
+ fork_exec_rpc root_dir (script root_dir name `Volume " SR.ls" ) args Storage.Volume .Types.SR.Ls.Out. t_of_rpc
270
270
>> = fun response ->
271
271
let response = List. map ~f: vdi_of_volume response in
272
272
Deferred.Result. return (R. success (Args.SR.Scan. rpc_of_response response))
@@ -276,14 +276,14 @@ let process root_dir name x =
276
276
Attached_SRs. find args.Args.VDI.Create. sr
277
277
>> = fun sr ->
278
278
let vdi_info = args.Args.VDI.Create. vdi_info in
279
- let args = Storage.V .Types.Volume.Create.In. make
279
+ let args = Storage.Volume .Types.Volume.Create.In. make
280
280
args.Args.VDI.Create. dbg
281
281
sr
282
282
vdi_info.name_label
283
283
vdi_info.name_description
284
284
vdi_info.virtual_size in
285
- let args = Storage.V .Types.Volume.Create.In. rpc_of_t args in
286
- fork_exec_rpc root_dir (script root_dir name `Volume " Volume.create" ) args Storage.V .Types.Volume.Create.Out. t_of_rpc
285
+ let args = Storage.Volume .Types.Volume.Create.In. rpc_of_t args in
286
+ fork_exec_rpc root_dir (script root_dir name `Volume " Volume.create" ) args Storage.Volume .Types.Volume.Create.Out. t_of_rpc
287
287
>> = fun response ->
288
288
let response = vdi_of_volume response in
289
289
Deferred.Result. return (R. success (Args.VDI.Create. rpc_of_response response))
@@ -292,12 +292,12 @@ let process root_dir name x =
292
292
let args = Args.VDI.Destroy. request_of_rpc args in
293
293
Attached_SRs. find args.Args.VDI.Destroy. sr
294
294
>> = fun sr ->
295
- let args = Storage.V .Types.Volume.Destroy.In. make
295
+ let args = Storage.Volume .Types.Volume.Destroy.In. make
296
296
args.Args.VDI.Destroy. dbg
297
297
sr
298
298
args.Args.VDI.Destroy. vdi in
299
- let args = Storage.V .Types.Volume.Destroy.In. rpc_of_t args in
300
- fork_exec_rpc root_dir (script root_dir name `Volume " Volume.destroy" ) args Storage.V .Types.Volume.Destroy.Out. t_of_rpc
299
+ let args = Storage.Volume .Types.Volume.Destroy.In. rpc_of_t args in
300
+ fork_exec_rpc root_dir (script root_dir name `Volume " Volume.destroy" ) args Storage.Volume .Types.Volume.Destroy.Out. t_of_rpc
301
301
>> = fun response ->
302
302
Deferred.Result. return (R. success (Args.VDI.Destroy. rpc_of_response response))
303
303
| { R. name = "VDI.snapshot" ; R. params = [ args ] } ->
@@ -306,12 +306,12 @@ let process root_dir name x =
306
306
Attached_SRs. find args.Args.VDI.Snapshot. sr
307
307
>> = fun sr ->
308
308
let vdi_info = args.Args.VDI.Snapshot. vdi_info in
309
- let args = Storage.V .Types.Volume.Snapshot.In. make
309
+ let args = Storage.Volume .Types.Volume.Snapshot.In. make
310
310
args.Args.VDI.Snapshot. dbg
311
311
sr
312
312
vdi_info.vdi in
313
- let args = Storage.V .Types.Volume.Snapshot.In. rpc_of_t args in
314
- fork_exec_rpc root_dir (script root_dir name `Volume " Volume.snapshot" ) args Storage.V .Types.Volume.Snapshot.Out. t_of_rpc
313
+ let args = Storage.Volume .Types.Volume.Snapshot.In. rpc_of_t args in
314
+ fork_exec_rpc root_dir (script root_dir name `Volume " Volume.snapshot" ) args Storage.Volume .Types.Volume.Snapshot.Out. t_of_rpc
315
315
>> = fun response ->
316
316
let response = vdi_of_volume response in
317
317
Deferred.Result. return (R. success (Args.VDI.Snapshot. rpc_of_response response))
@@ -321,12 +321,12 @@ let process root_dir name x =
321
321
Attached_SRs. find args.Args.VDI.Clone. sr
322
322
>> = fun sr ->
323
323
let vdi_info = args.Args.VDI.Clone. vdi_info in
324
- let args = Storage.V .Types.Volume.Clone.In. make
324
+ let args = Storage.Volume .Types.Volume.Clone.In. make
325
325
args.Args.VDI.Clone. dbg
326
326
sr
327
327
vdi_info.vdi in
328
- let args = Storage.V .Types.Volume.Clone.In. rpc_of_t args in
329
- fork_exec_rpc root_dir (script root_dir name `Volume " Volume.clone" ) args Storage.V .Types.Volume.Clone.Out. t_of_rpc
328
+ let args = Storage.Volume .Types.Volume.Clone.In. rpc_of_t args in
329
+ fork_exec_rpc root_dir (script root_dir name `Volume " Volume.clone" ) args Storage.Volume .Types.Volume.Clone.Out. t_of_rpc
330
330
>> = fun response ->
331
331
let response = vdi_of_volume response in
332
332
Deferred.Result. return (R. success (Args.VDI.Clone. rpc_of_response response))
@@ -341,16 +341,16 @@ let process root_dir name x =
341
341
sr
342
342
args.Args.VDI.Attach. vdi
343
343
>> = fun (datapath , uri , domain ) ->
344
- let args' = Storage.D .Types.Datapath.Attach.In. make
344
+ let args' = Storage.Datapath .Types.Datapath.Attach.In. make
345
345
args.Args.VDI.Attach. dbg
346
346
uri domain in
347
- let args' = Storage.D .Types.Datapath.Attach.In. rpc_of_t args' in
348
- fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.attach" ) args' Storage.D .Types.Datapath.Attach.Out. t_of_rpc
347
+ let args' = Storage.Datapath .Types.Datapath.Attach.In. rpc_of_t args' in
348
+ fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.attach" ) args' Storage.Datapath .Types.Datapath.Attach.Out. t_of_rpc
349
349
>> = fun response ->
350
- let backend, params = match response.Storage.D .Types. implementation with
351
- | Storage.D .Types. Blkback p -> " vbd" , p
352
- | Storage.D .Types. Qdisk p -> " qdisk" , p
353
- | Storage.D .Types. Tapdisk3 p -> " vbd3" , p in
350
+ let backend, params = match response.Storage.Datapath .Types. implementation with
351
+ | Storage.Datapath .Types. Blkback p -> " vbd" , p
352
+ | Storage.Datapath .Types. Qdisk p -> " qdisk" , p
353
+ | Storage.Datapath .Types. Tapdisk3 p -> " vbd3" , p in
354
354
let attach_info = {
355
355
params;
356
356
xenstore_data = [ " backend-kind" , backend ];
@@ -369,11 +369,11 @@ let process root_dir name x =
369
369
sr
370
370
args.Args.VDI.Activate. vdi
371
371
>> = fun (datapath , uri , domain ) ->
372
- let args' = Storage.D .Types.Datapath.Activate.In. make
372
+ let args' = Storage.Datapath .Types.Datapath.Activate.In. make
373
373
args.Args.VDI.Activate. dbg
374
374
uri domain in
375
- let args' = Storage.D .Types.Datapath.Activate.In. rpc_of_t args' in
376
- fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.activate" ) args' Storage.D .Types.Datapath.Activate.Out. t_of_rpc
375
+ let args' = Storage.Datapath .Types.Datapath.Activate.In. rpc_of_t args' in
376
+ fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.activate" ) args' Storage.Datapath .Types.Datapath.Activate.Out. t_of_rpc
377
377
>> = fun response ->
378
378
Deferred.Result. return (R. success (Args.VDI.Activate. rpc_of_response () ))
379
379
| { R. name = "VDI.deactivate" ; R. params = [ args ] } ->
@@ -387,11 +387,11 @@ let process root_dir name x =
387
387
sr
388
388
args.Args.VDI.Deactivate. vdi
389
389
>> = fun (datapath , uri , domain ) ->
390
- let args' = Storage.D .Types.Datapath.Deactivate.In. make
390
+ let args' = Storage.Datapath .Types.Datapath.Deactivate.In. make
391
391
args.Args.VDI.Deactivate. dbg
392
392
uri domain in
393
- let args' = Storage.D .Types.Datapath.Deactivate.In. rpc_of_t args' in
394
- fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.deactivate" ) args' Storage.D .Types.Datapath.Deactivate.Out. t_of_rpc
393
+ let args' = Storage.Datapath .Types.Datapath.Deactivate.In. rpc_of_t args' in
394
+ fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.deactivate" ) args' Storage.Datapath .Types.Datapath.Deactivate.Out. t_of_rpc
395
395
>> = fun response ->
396
396
Deferred.Result. return (R. success (Args.VDI.Deactivate. rpc_of_response () ))
397
397
| { R. name = "VDI.detach" ; R. params = [ args ] } ->
@@ -405,11 +405,11 @@ let process root_dir name x =
405
405
sr
406
406
args.Args.VDI.Detach. vdi
407
407
>> = fun (datapath , uri , domain ) ->
408
- let args' = Storage.D .Types.Datapath.Detach.In. make
408
+ let args' = Storage.Datapath .Types.Datapath.Detach.In. make
409
409
args.Args.VDI.Detach. dbg
410
410
uri domain in
411
- let args' = Storage.D .Types.Datapath.Detach.In. rpc_of_t args' in
412
- fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.detach" ) args' Storage.D .Types.Datapath.Detach.Out. t_of_rpc
411
+ let args' = Storage.Datapath .Types.Datapath.Detach.In. rpc_of_t args' in
412
+ fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) " Datapath.detach" ) args' Storage.Datapath .Types.Datapath.Detach.Out. t_of_rpc
413
413
>> = fun response ->
414
414
Deferred.Result. return (R. success (Args.VDI.Detach. rpc_of_response () ))
415
415
| { R. name = "SR.stat" ; R. params = [ args ] } ->
0 commit comments