@@ -40,111 +40,6 @@ let choose_backend dbg sr =
40
40
(* * module [MigrateRemote] is similar to [MigrateLocal], but most of these functions
41
41
tend to be executed on the receiver side. *)
42
42
module MigrateRemote = struct
43
- let receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm =
44
- let on_fail : (unit -> unit) list ref = ref [] in
45
- let vdis = Local.SR. scan dbg sr in
46
- (* We drop cbt_metadata VDIs that do not have any actual data *)
47
- let vdis = List. filter (fun vdi -> vdi.ty <> " cbt_metadata" ) vdis in
48
- let leaf_dp = Local.DP. create dbg Uuidx. (to_string (make () )) in
49
- try
50
- let vdi_info = {vdi_info with sm_config= [(" base_mirror" , id)]} in
51
- let leaf = Local.VDI. create dbg sr vdi_info in
52
- info " Created leaf VDI for mirror receive: %s" (string_of_vdi_info leaf) ;
53
- on_fail := (fun () -> Local.VDI. destroy dbg sr leaf.vdi) :: ! on_fail ;
54
- (* dummy VDI is created so that the leaf VDI becomes a differencing disk,
55
- useful for calling VDI.compose later on *)
56
- let dummy = Local.VDI. snapshot dbg sr leaf in
57
- on_fail := (fun () -> Local.VDI. destroy dbg sr dummy.vdi) :: ! on_fail ;
58
- debug " %s Created dummy snapshot for mirror receive: %s" __FUNCTION__
59
- (string_of_vdi_info dummy) ;
60
- let _ : backend = Local.VDI. attach3 dbg leaf_dp sr leaf.vdi vm true in
61
- Local.VDI. activate3 dbg leaf_dp sr leaf.vdi vm ;
62
- let nearest =
63
- List. fold_left
64
- (fun acc content_id ->
65
- match acc with
66
- | Some _ ->
67
- acc
68
- | None -> (
69
- try
70
- Some
71
- (List. find
72
- (fun vdi ->
73
- vdi.content_id = content_id
74
- && vdi.virtual_size < = vdi_info.virtual_size
75
- )
76
- vdis
77
- )
78
- with Not_found -> None
79
- )
80
- )
81
- None similar
82
- in
83
- debug " Nearest VDI: content_id=%s vdi=%s"
84
- (Option. fold ~none: " None" ~some: (fun x -> x.content_id) nearest)
85
- (Option. fold ~none: " None"
86
- ~some: (fun x -> Storage_interface.Vdi. string_of x.vdi)
87
- nearest
88
- ) ;
89
- let parent =
90
- match nearest with
91
- | Some vdi ->
92
- debug " Cloning VDI" ;
93
- let vdi = add_to_sm_config vdi " base_mirror" id in
94
- let vdi_clone = Local.VDI. clone dbg sr vdi in
95
- debug " Clone: %s" (Storage_interface.Vdi. string_of vdi_clone.vdi) ;
96
- ( if vdi_clone.virtual_size <> vdi_info.virtual_size then
97
- let new_size =
98
- Local.VDI. resize dbg sr vdi_clone.vdi vdi_info.virtual_size
99
- in
100
- debug " Resize local clone VDI to %Ld: result %Ld"
101
- vdi_info.virtual_size new_size
102
- ) ;
103
- vdi_clone
104
- | None ->
105
- debug " Creating a blank remote VDI" ;
106
- Local.VDI. create dbg sr vdi_info
107
- in
108
- debug " Parent disk content_id=%s" parent.content_id ;
109
- State. add id
110
- State. (
111
- Recv_op
112
- Receive_state.
113
- {
114
- sr
115
- ; dummy_vdi= dummy.vdi
116
- ; leaf_vdi= leaf.vdi
117
- ; leaf_dp
118
- ; parent_vdi= parent.vdi
119
- ; remote_vdi= vdi_info.vdi
120
- ; mirror_vm= vm
121
- }
122
- ) ;
123
- let nearest_content_id = Option. map (fun x -> x.content_id) nearest in
124
- Mirror. Vhd_mirror
125
- {
126
- Mirror. mirror_vdi= leaf
127
- ; mirror_datapath= leaf_dp
128
- ; copy_diffs_from= nearest_content_id
129
- ; copy_diffs_to= parent.vdi
130
- ; dummy_vdi= dummy.vdi
131
- }
132
- with e ->
133
- List. iter
134
- (fun op ->
135
- try op ()
136
- with e ->
137
- debug " Caught exception in on_fail: %s" (Printexc. to_string e)
138
- )
139
- ! on_fail ;
140
- raise e
141
-
142
- let receive_start ~dbg ~sr ~vdi_info ~id ~similar =
143
- receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm: (Vm. of_string " 0" )
144
-
145
- let receive_start2 ~dbg ~sr ~vdi_info ~id ~similar ~vm =
146
- receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm
147
-
148
43
let receive_finalize ~dbg ~id =
149
44
let recv_state = State. find_active_receive_mirror id in
150
45
let open State.Receive_state in
@@ -630,10 +525,6 @@ let killall = MigrateLocal.killall
630
525
631
526
let stat = MigrateLocal. stat
632
527
633
- let receive_start = MigrateRemote. receive_start
634
-
635
- let receive_start2 = MigrateRemote. receive_start2
636
-
637
528
let receive_finalize = MigrateRemote. receive_finalize
638
529
639
530
let receive_finalize2 = MigrateRemote. receive_finalize2
0 commit comments