@@ -458,6 +458,8 @@ module Storage = struct
458
458
459
459
let dp_destroy = dp_destroy
460
460
461
+ let detach = detach
462
+
461
463
let get_disk_by_name = get_disk_by_name
462
464
end
463
465
@@ -3659,6 +3661,8 @@ module VBD = struct
3659
3661
let vm = fst vbd.id in
3660
3662
Storage. activate ~xc ~xs task vm dp sr vdi
3661
3663
3664
+ (* TODO could split out a _deactivate function here *)
3665
+
3662
3666
let frontend_domid_of_device device =
3663
3667
device.Device_common. frontend.Device_common. domid
3664
3668
@@ -4230,6 +4234,175 @@ module VBD = struct
4230
4234
raise (Xenopsd_error (Device_detach_rejected (" VBD" , id_of vbd, s)))
4231
4235
)
4232
4236
4237
+ (* CP-53555: The deactivate half of VBD.unplug to allow them to be done separately *)
4238
+ let deactivate task vm vbd force =
4239
+ with_tracing ~task ~name: " VBD_deactivate" @@ fun () ->
4240
+ with_xc_and_xs (fun xc xs ->
4241
+ try
4242
+ (* On destroying the datapath
4243
+
4244
+ 1. if the device has already been shutdown and deactivated (as in
4245
+ suspend) we must call DP.destroy here to avoid leaks
4246
+
4247
+ 2. if the device is successfully shutdown here then we must call
4248
+ DP.destroy because no-one else will
4249
+
4250
+ 3. if the device shutdown is rejected then we should leave the DP
4251
+ alone and rely on the event thread calling us again later. *)
4252
+ let domid = domid_of_uuid ~xs (uuid_of_string vm) in
4253
+ (* If the device is gone then we don't need to shut it down but we do
4254
+ need to free any storage resources. *)
4255
+ let dev =
4256
+ try
4257
+ Some (device_by_id xc xs vm (device_kind_of ~xs vbd) (id_of vbd))
4258
+ with
4259
+ | Xenopsd_error (Does_not_exist (_ , _ )) ->
4260
+ debug " VM = %s; VBD = %s; Ignoring missing domain" vm (id_of vbd) ;
4261
+ None
4262
+ | Xenopsd_error Device_not_connected ->
4263
+ debug " VM = %s; VBD = %s; Ignoring missing device" vm (id_of vbd) ;
4264
+ None
4265
+ in
4266
+ let backend =
4267
+ match dev with
4268
+ | None ->
4269
+ None
4270
+ | Some dv -> (
4271
+ match
4272
+ Rpcmarshal. unmarshal typ_of_backend
4273
+ (Device.Generic. get_private_key ~xs dv _vdi_id
4274
+ |> Jsonrpc. of_string
4275
+ )
4276
+ with
4277
+ | Ok x ->
4278
+ x
4279
+ | Error (`Msg m ) ->
4280
+ internal_error " Failed to unmarshal VBD backend: %s" m
4281
+ )
4282
+ in
4283
+ Option. iter
4284
+ (fun dev ->
4285
+ if force && not (Device. can_surprise_remove ~xs dev) then
4286
+ debug
4287
+ " VM = %s; VBD = %s; Device is not surprise-removable \
4288
+ (ignoring and removing anyway)"
4289
+ vm (id_of vbd) ;
4290
+ (* this happens on normal shutdown too *)
4291
+ (* Case (1): success; Case (2): success; Case (3): an exception is
4292
+ thrown *)
4293
+ with_tracing ~task ~name: " VBD_deactivate_clean_shutdown"
4294
+ @@ fun () ->
4295
+ Xenops_task. with_subtask task
4296
+ (Printf. sprintf " Vbd.clean_shutdown %s" (id_of vbd))
4297
+ (fun () ->
4298
+ (if force then Device. hard_shutdown else Device. clean_shutdown)
4299
+ task ~xs dev
4300
+ )
4301
+ )
4302
+ dev ;
4303
+ (* We now have a shutdown device but an active DP: we should destroy
4304
+ the DP if the backend is of type VDI *)
4305
+ finally
4306
+ (fun () ->
4307
+ ( with_tracing ~task ~name: " VBD_deactivate_release" @@ fun () ->
4308
+ Option. iter
4309
+ (fun dev ->
4310
+ Xenops_task. with_subtask task
4311
+ (Printf. sprintf " Vbd.release %s" (id_of vbd))
4312
+ (fun () -> Device.Vbd. release task ~xc ~xs dev)
4313
+ )
4314
+ dev
4315
+ ) ;
4316
+ (* If we have a qemu frontend, detach this too. *)
4317
+ with_tracing ~task ~name: " VBD_deactivate_detach_qemu" @@ fun () ->
4318
+ let _ =
4319
+ DB. update vm
4320
+ (Option. map (fun vm_t ->
4321
+ let persistent = vm_t.VmExtra. persistent in
4322
+ if List. mem_assoc vbd.Vbd. id persistent.VmExtra. qemu_vbds
4323
+ then (
4324
+ let _, qemu_vbd =
4325
+ List. assoc vbd.Vbd. id persistent.VmExtra. qemu_vbds
4326
+ in
4327
+ (* destroy_vbd_frontend ignores 'refusing to close'
4328
+ transients' *)
4329
+ destroy_vbd_frontend ~xc ~xs task qemu_vbd ;
4330
+ VmExtra.
4331
+ {
4332
+ persistent=
4333
+ {
4334
+ persistent with
4335
+ qemu_vbds=
4336
+ List. remove_assoc vbd.Vbd. id
4337
+ persistent.qemu_vbds
4338
+ }
4339
+ }
4340
+ ) else
4341
+ vm_t
4342
+ )
4343
+ )
4344
+ in
4345
+ ()
4346
+ )
4347
+ (fun () ->
4348
+ with_tracing ~task ~name: " VBD_deactivate_deactivate" @@ fun () ->
4349
+ let vmid = Storage. vm_of_domid domid in
4350
+ match (domid, backend) with
4351
+ | Some x , Some (VDI path ) ->
4352
+ let sr, vdi = Storage. get_disk_by_name task path in
4353
+ let dp = Storage. id_of (string_of_int x) vbd.id in
4354
+ Storage. deactivate task dp sr vdi vmid
4355
+ (* TODO Do we only need to deactivate VDIs, not Local or CD? *)
4356
+ | _ ->
4357
+ ()
4358
+ )
4359
+ with Device_common. Device_error (_ , s ) ->
4360
+ debug " Caught Device_error: %s" s ;
4361
+ raise (Xenopsd_error (Device_detach_rejected (" VBD" , id_of vbd, s)))
4362
+ )
4363
+
4364
+ (* CP-53555: The detach half of VBD.unplug to allow them to be done separately *)
4365
+ let detach task vm vbd =
4366
+ with_tracing ~task ~name: " VBD_detach" @@ fun () ->
4367
+ with_xc_and_xs (fun xc xs ->
4368
+ let domid = domid_of_uuid ~xs (uuid_of_string vm) in
4369
+ let dev =
4370
+ try
4371
+ Some (device_by_id xc xs vm (device_kind_of ~xs vbd) (id_of vbd))
4372
+ with
4373
+ | Xenopsd_error (Does_not_exist (_ , _ )) ->
4374
+ debug " VM = %s; VBD = %s; Ignoring missing domain" vm (id_of vbd) ;
4375
+ None
4376
+ | Xenopsd_error Device_not_connected ->
4377
+ debug " VM = %s; VBD = %s; Ignoring missing device" vm (id_of vbd) ;
4378
+ None
4379
+ in
4380
+ let backend =
4381
+ match dev with
4382
+ | None ->
4383
+ None
4384
+ | Some dv -> (
4385
+ match
4386
+ Rpcmarshal. unmarshal typ_of_backend
4387
+ (Device.Generic. get_private_key ~xs dv _vdi_id
4388
+ |> Jsonrpc. of_string
4389
+ )
4390
+ with
4391
+ | Ok x ->
4392
+ x
4393
+ | Error (`Msg m ) ->
4394
+ internal_error " Failed to unmarshal VBD backend: %s" m
4395
+ )
4396
+ in
4397
+ with_tracing ~task ~name: " VBD_detach_dp_destroy" @@ fun () ->
4398
+ match (domid, backend) with
4399
+ | Some x , None | Some x , Some (VDI _ ) ->
4400
+ Storage. detach task (Storage. id_of (string_of_int x) vbd.Vbd. id)
4401
+ | _ ->
4402
+ ()
4403
+ ) ;
4404
+ cleanup_attached_vdis vm vbd.id
4405
+
4233
4406
let insert task vm vbd d =
4234
4407
on_frontend
4235
4408
(fun xc xs frontend_domid domain_type ->
0 commit comments