Skip to content

Commit de23bc3

Browse files
author
David Scott
committed
If the datapath doesn't support clone-on-boot, do it via Volume.clone
When the toolstack calls VDI.epoch_begin we query the volume and choose the datapath. If the datapath doesn't expose the NONPERSISTENT capability then we use Volume.clone to make a temporary volume. The key of the volume is added to the metadata of the original volume. In subsequent functions we call `Volume.stat` on the original volume, discover the _clone_on_boot_key and follow the link to the temporary volume. The temporary volume is destroyed on VDI.epoch_end and on Volume.destroy of the original volume. Signed-off-by: David Scott <[email protected]>
1 parent c4cdd12 commit de23bc3

File tree

1 file changed

+105
-64
lines changed

1 file changed

+105
-64
lines changed

‎main.ml

Lines changed: 105 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ let info fmt =
3737
) fmt
3838

3939
let _nonpersistent = "NONPERSISTENT"
40+
let _clone_on_boot_key = "clone-on-boot"
4041

4142
let backend_error name args =
4243
let open Storage_interface in
@@ -198,12 +199,27 @@ let vdi_of_volume x =
198199
persistent = true;
199200
}
200201

201-
let stat ?(persistent = true) root_dir name dbg sr vdi =
202+
let stat root_dir name dbg sr vdi =
202203
let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in
203204
let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in
204-
let open Deferred.Result.Monad_infix in
205205
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc
206-
>>= fun response ->
206+
207+
let clone root_dir name dbg sr vdi =
208+
let args = Storage.Volume.Types.Volume.Clone.In.make dbg sr vdi in
209+
let args = Storage.Volume.Types.Volume.Clone.In.rpc_of_t args in
210+
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.clone") args Storage.Volume.Types.Volume.Clone.Out.t_of_rpc
211+
212+
let destroy root_dir name dbg sr vdi =
213+
let args = Storage.Volume.Types.Volume.Destroy.In.make dbg sr vdi in
214+
let args = Storage.Volume.Types.Volume.Destroy.In.rpc_of_t args in
215+
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.destroy") args Storage.Volume.Types.Volume.Destroy.Out.t_of_rpc
216+
217+
let set root_dir name dbg sr vdi k v =
218+
let args = Storage.Volume.Types.Volume.Set.In.make dbg sr vdi k v in
219+
let args = Storage.Volume.Types.Volume.Set.In.rpc_of_t args in
220+
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.set") args Storage.Volume.Types.Volume.Set.Out.t_of_rpc
221+
222+
let choose_datapath ?(persistent = true) response =
207223
(* We can only use a URI with a valid scheme, since we use the scheme
208224
to name the datapath plugin. *)
209225
let possible =
@@ -403,14 +419,19 @@ let process root_dir name x =
403419
let args = Args.VDI.Destroy.request_of_rpc args in
404420
Attached_SRs.find args.Args.VDI.Destroy.sr
405421
>>= fun sr ->
406-
let args = Storage.Volume.Types.Volume.Destroy.In.make
407-
args.Args.VDI.Destroy.dbg
408-
sr
409-
args.Args.VDI.Destroy.vdi in
410-
let args = Storage.Volume.Types.Volume.Destroy.In.rpc_of_t args in
411-
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.destroy") args Storage.Volume.Types.Volume.Destroy.Out.t_of_rpc
422+
stat root_dir name args.Args.VDI.Destroy.dbg sr args.Args.VDI.Destroy.vdi
412423
>>= fun response ->
413-
Deferred.Result.return (R.success (Args.VDI.Destroy.rpc_of_response response))
424+
(* Destroy any clone-on-boot volume that might exist *)
425+
( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
426+
| None ->
427+
return (Ok ())
428+
| Some temporary ->
429+
(* Destroy the temporary disk we made earlier *)
430+
destroy root_dir name args.Args.VDI.Destroy.dbg sr temporary
431+
) >>= fun () ->
432+
destroy root_dir name args.Args.VDI.Destroy.dbg sr args.Args.VDI.Destroy.vdi
433+
>>= fun () ->
434+
Deferred.Result.return (R.success (Args.VDI.Destroy.rpc_of_response ()))
414435
| { R.name = "VDI.snapshot"; R.params = [ args ] } ->
415436
let open Deferred.Result.Monad_infix in
416437
let args = Args.VDI.Snapshot.request_of_rpc args in
@@ -432,12 +453,7 @@ let process root_dir name x =
432453
Attached_SRs.find args.Args.VDI.Clone.sr
433454
>>= fun sr ->
434455
let vdi_info = args.Args.VDI.Clone.vdi_info in
435-
let args = Storage.Volume.Types.Volume.Clone.In.make
436-
args.Args.VDI.Clone.dbg
437-
sr
438-
vdi_info.vdi in
439-
let args = Storage.Volume.Types.Volume.Clone.In.rpc_of_t args in
440-
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.clone") args Storage.Volume.Types.Volume.Clone.Out.t_of_rpc
456+
clone root_dir name args.Args.VDI.Clone.dbg sr vdi_info.vdi
441457
>>= fun response ->
442458
let response = vdi_of_volume response in
443459
Deferred.Result.return (R.success (Args.VDI.Clone.rpc_of_response response))
@@ -480,9 +496,7 @@ let process root_dir name x =
480496
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.resize") args Storage.Volume.Types.Volume.Resize.Out.t_of_rpc
481497
>>= fun () ->
482498
(* Now call Volume.stat to discover the size *)
483-
let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in
484-
let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in
485-
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc
499+
stat root_dir name dbg sr vdi
486500
>>= fun response ->
487501
Deferred.Result.return (R.success (Args.VDI.Resize.rpc_of_response response.Storage.Volume.Types.virtual_size))
488502
| { R.name = "VDI.stat"; R.params = [ args ] } ->
@@ -491,12 +505,7 @@ let process root_dir name x =
491505
Attached_SRs.find args.Args.VDI.Stat.sr
492506
>>= fun sr ->
493507
let vdi = args.Args.VDI.Stat.vdi in
494-
let args = Storage.Volume.Types.Volume.Stat.In.make
495-
args.Args.VDI.Stat.dbg
496-
sr
497-
vdi in
498-
let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in
499-
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc
508+
stat root_dir name args.Args.VDI.Stat.dbg sr vdi
500509
>>= fun response ->
501510
let response = vdi_of_volume response in
502511
Deferred.Result.return (R.success (Args.VDI.Stat.rpc_of_response response))
@@ -506,12 +515,7 @@ let process root_dir name x =
506515
Attached_SRs.find args.Args.VDI.Introduce.sr
507516
>>= fun sr ->
508517
let vdi = args.Args.VDI.Introduce.location in
509-
let args = Storage.Volume.Types.Volume.Stat.In.make
510-
args.Args.VDI.Introduce.dbg
511-
sr
512-
vdi in
513-
let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in
514-
fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc
518+
stat root_dir name args.Args.VDI.Introduce.dbg sr vdi
515519
>>= fun response ->
516520
let response = vdi_of_volume response in
517521
Deferred.Result.return (R.success (Args.VDI.Introduce.rpc_of_response response))
@@ -521,10 +525,16 @@ let process root_dir name x =
521525
Attached_SRs.find args.Args.VDI.Attach.sr
522526
>>= fun sr ->
523527
(* Discover the URIs using Volume.stat *)
524-
stat root_dir name
525-
args.Args.VDI.Attach.dbg
526-
sr
527-
args.Args.VDI.Attach.vdi
528+
stat root_dir name args.Args.VDI.Attach.dbg sr args.Args.VDI.Attach.vdi
529+
>>= fun response ->
530+
(* If we have a clone-on-boot volume then use that instead *)
531+
( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
532+
| None ->
533+
return (Ok response)
534+
| Some temporary ->
535+
stat root_dir name args.Args.VDI.Attach.dbg sr temporary
536+
) >>= fun response ->
537+
choose_datapath response
528538
>>= fun (datapath, uri, domain) ->
529539
let args' = Storage.Datapath.Types.Datapath.Attach.In.make
530540
args.Args.VDI.Attach.dbg
@@ -549,10 +559,16 @@ let process root_dir name x =
549559
Attached_SRs.find args.Args.VDI.Activate.sr
550560
>>= fun sr ->
551561
(* Discover the URIs using Volume.stat *)
552-
stat root_dir name
553-
args.Args.VDI.Activate.dbg
554-
sr
555-
args.Args.VDI.Activate.vdi
562+
stat root_dir name args.Args.VDI.Activate.dbg sr args.Args.VDI.Activate.vdi
563+
>>= fun response ->
564+
(* If we have a clone-on-boot volume then use that instead *)
565+
( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
566+
| None ->
567+
return (Ok response)
568+
| Some temporary ->
569+
stat root_dir name args.Args.VDI.Activate.dbg sr temporary
570+
) >>= fun response ->
571+
choose_datapath response
556572
>>= fun (datapath, uri, domain) ->
557573
let args' = Storage.Datapath.Types.Datapath.Activate.In.make
558574
args.Args.VDI.Activate.dbg
@@ -567,10 +583,15 @@ let process root_dir name x =
567583
Attached_SRs.find args.Args.VDI.Deactivate.sr
568584
>>= fun sr ->
569585
(* Discover the URIs using Volume.stat *)
570-
stat root_dir name
571-
args.Args.VDI.Deactivate.dbg
572-
sr
573-
args.Args.VDI.Deactivate.vdi
586+
stat root_dir name args.Args.VDI.Deactivate.dbg sr args.Args.VDI.Deactivate.vdi
587+
>>= fun response ->
588+
( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
589+
| None ->
590+
return (Ok response)
591+
| Some temporary ->
592+
stat root_dir name args.Args.VDI.Deactivate.dbg sr temporary
593+
) >>= fun response ->
594+
choose_datapath response
574595
>>= fun (datapath, uri, domain) ->
575596
let args' = Storage.Datapath.Types.Datapath.Deactivate.In.make
576597
args.Args.VDI.Deactivate.dbg
@@ -585,10 +606,15 @@ let process root_dir name x =
585606
Attached_SRs.find args.Args.VDI.Detach.sr
586607
>>= fun sr ->
587608
(* Discover the URIs using Volume.stat *)
588-
stat root_dir name
589-
args.Args.VDI.Detach.dbg
590-
sr
591-
args.Args.VDI.Detach.vdi
609+
stat root_dir name args.Args.VDI.Detach.dbg sr args.Args.VDI.Detach.vdi
610+
>>= fun response ->
611+
( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
612+
| None ->
613+
return (Ok response)
614+
| Some temporary ->
615+
stat root_dir name args.Args.VDI.Detach.dbg sr temporary
616+
) >>= fun response ->
617+
choose_datapath response
592618
>>= fun (datapath, uri, domain) ->
593619
let args' = Storage.Datapath.Types.Datapath.Detach.In.make
594620
args.Args.VDI.Detach.dbg
@@ -620,15 +646,15 @@ let process root_dir name x =
620646
>>= fun sr ->
621647
(* Discover the URIs using Volume.stat *)
622648
let persistent = args.Args.VDI.Epoch_begin.persistent in
623-
stat ~persistent root_dir name
624-
args.Args.VDI.Epoch_begin.dbg
625-
sr
626-
args.Args.VDI.Epoch_begin.vdi
649+
stat root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi
650+
>>= fun response ->
651+
choose_datapath ~persistent response
627652
>>= fun (datapath, uri, domain) ->
628653
(* If non-persistent and the datapath plugin supports NONPERSISTENT
629654
then we delegate this to the datapath plugin. Otherwise we will
630655
make a temporary clone now and attach/detach etc this file. *)
631656
if Datapath_plugins.supports_feature datapath _nonpersistent then begin
657+
(* We delegate handling non-persistent disks to the datapath plugin. *)
632658
let args = Storage.Datapath.Types.Datapath.Open.In.make
633659
args.Args.VDI.Epoch_begin.dbg
634660
uri persistent in
@@ -637,27 +663,42 @@ let process root_dir name x =
637663
>>= fun () ->
638664
Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ()))
639665
end else begin
640-
Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ]))
666+
(* We create a non-persistent disk here with Volume.clone, and store
667+
the name of the cloned disk in the metadata of the original. *)
668+
clone root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi
669+
>>= fun vdi ->
670+
set root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi _clone_on_boot_key vdi.Storage.Volume.Types.key
671+
>>= fun () ->
672+
Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ()))
641673
end
642674
| { R.name = "VDI.epoch_end"; R.params = [ args ] } ->
643675
let open Deferred.Result.Monad_infix in
644676
let args = Args.VDI.Epoch_end.request_of_rpc args in
645677
Attached_SRs.find args.Args.VDI.Epoch_end.sr
646678
>>= fun sr ->
647679
(* Discover the URIs using Volume.stat *)
648-
stat root_dir name
649-
args.Args.VDI.Epoch_end.dbg
650-
sr
651-
args.Args.VDI.Epoch_end.vdi
680+
stat root_dir name args.Args.VDI.Epoch_end.dbg sr args.Args.VDI.Epoch_end.vdi
681+
>>= fun response ->
682+
choose_datapath response
652683
>>= fun (datapath, uri, domain) ->
653-
let args = Storage.Datapath.Types.Datapath.Close.In.make
654-
args.Args.VDI.Epoch_end.dbg
655-
uri in
656-
let args = Storage.Datapath.Types.Datapath.Close.In.rpc_of_t args in
657-
fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.close") args Storage.Datapath.Types.Datapath.Close.Out.t_of_rpc
658-
>>= fun () ->
659-
Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ()))
660-
684+
if Datapath_plugins.supports_feature datapath _nonpersistent then begin
685+
let args = Storage.Datapath.Types.Datapath.Close.In.make
686+
args.Args.VDI.Epoch_end.dbg
687+
uri in
688+
let args = Storage.Datapath.Types.Datapath.Close.In.rpc_of_t args in
689+
fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.close") args Storage.Datapath.Types.Datapath.Close.Out.t_of_rpc
690+
>>= fun () ->
691+
Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ()))
692+
end else begin
693+
match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with
694+
| None ->
695+
Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ()))
696+
| Some temporary ->
697+
(* Destroy the temporary disk we made earlier *)
698+
destroy root_dir name args.Args.VDI.Epoch_end.dbg sr temporary
699+
>>= fun () ->
700+
Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ()))
701+
end
661702
| { R.name = name } ->
662703
Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ])))
663704
>>= function

0 commit comments

Comments
 (0)