Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ocaml/xapi-idl/storage/dune
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@
xapi-log
)
(wrapped false)
(preprocess (pps ppx_sexp_conv ppx_deriving_rpc)))
(preprocess (pps ppx_sexp_conv ppx_deriving_rpc ppx_deriving.show)))

(library
(name xcp_storage)
Expand Down
20 changes: 18 additions & 2 deletions ocaml/xapi-idl/storage/storage_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -233,7 +233,7 @@ let default_vdi_info =
failwith (Printf.sprintf "Error creating default_vdi_info: %s" m)

type sr_health = Healthy | Recovering | Unreachable | Unavailable
[@@deriving rpcty]
[@@deriving rpcty, show {with_path= false}]
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

how about this: removed the to_string function now since I can't type it right


type sr_info = {
sr_uuid: string option
Expand Down Expand Up @@ -354,6 +354,7 @@ module Errors = struct
| Cancelled of string
| Redirect of string option
| Sr_attached of string
| Sr_unhealthy of sr_health
| Unimplemented of string
| Activated_on_another_host of uuid
| Duplicated_key of string
Expand Down Expand Up @@ -617,12 +618,24 @@ module StorageAPI (R : RPC) = struct
let destroy =
declare "SR.destroy" [] (dbg_p @-> sr_p @-> returning unit_p err)

(** [scan task sr] returns a list of VDIs contained within an attached SR *)
(** [scan task sr] returns a list of VDIs contained within an attached SR.
@deprecated This function is deprecated, and is only here to keep backward
compatibility with old xapis that call Remote.SR.scan during SXM.
Use the scan2 function instead.
*)
let scan =
let open TypeCombinators in
let result = Param.mk ~name:"result" (list vdi_info) in
declare "SR.scan" [] (dbg_p @-> sr_p @-> returning result err)

(** [scan2 task sr] returns a list of VDIs contained within an attached SR,
as well as the sr_info of the scanned [sr]. This operation is implemented as
a combination of scan and stats. *)
let scan2 =
let open TypeCombinators in
let result = Param.mk ~name:"result" (pair (list vdi_info, sr_info)) in
declare "SR.scan2" [] (dbg_p @-> sr_p @-> returning result err)

(** [update_snapshot_info_src sr vdi url dest dest_vdi snapshot_pairs] *
updates the fields is_a_snapshot, snapshot_time and snapshot_of for a *
list of snapshots on a remote SR. *)
Expand Down Expand Up @@ -1160,6 +1173,8 @@ module type Server_impl = sig

val scan : context -> dbg:debug_info -> sr:sr -> vdi_info list

val scan2 : context -> dbg:debug_info -> sr:sr -> vdi_info list * sr_info

val update_snapshot_info_src :
context
-> dbg:debug_info
Expand Down Expand Up @@ -1449,6 +1464,7 @@ module Server (Impl : Server_impl) () = struct
S.SR.reset (fun dbg sr -> Impl.SR.reset () ~dbg ~sr) ;
S.SR.destroy (fun dbg sr -> Impl.SR.destroy () ~dbg ~sr) ;
S.SR.scan (fun dbg sr -> Impl.SR.scan () ~dbg ~sr) ;
S.SR.scan2 (fun dbg sr -> Impl.SR.scan2 () ~dbg ~sr) ;
S.SR.update_snapshot_info_src
(fun dbg sr vdi url dest dest_vdi snapshot_pairs verify_dest ->
Impl.SR.update_snapshot_info_src () ~dbg ~sr ~vdi ~url ~dest ~dest_vdi
Expand Down
2 changes: 2 additions & 0 deletions ocaml/xapi-idl/storage/storage_skeleton.ml
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,8 @@ module SR = struct

let scan ctx ~dbg ~sr = u "SR.scan"

let scan2 ctx ~dbg ~sr = u "SR.scan2"

let update_snapshot_info_src ctx ~dbg ~sr ~vdi ~url ~dest ~dest_vdi
~snapshot_pairs =
u "SR.update_snapshot_info_src"
Expand Down
1 change: 1 addition & 0 deletions ocaml/xapi-storage-script/dune
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@

message-switch-async
message-switch-unix
ppx_deriving.runtime
result
rpclib.core
rpclib.json
Expand Down
68 changes: 68 additions & 0 deletions ocaml/xapi-storage-script/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1207,6 +1207,74 @@ let bind ~volume_script_dir =
|> wrap
in
S.SR.scan sr_scan_impl ;
let sr_scan2_impl dbg sr =
Attached_SRs.find sr
>>>= (fun sr ->
return_volume_rpc (fun () -> Sr_client.stat (volume_rpc ~dbg) dbg sr)
>>>= fun response ->
Deferred.Result.return
{
Storage_interface.sr_uuid= response.Xapi_storage.Control.uuid
; name_label= response.Xapi_storage.Control.name
; name_description= response.Xapi_storage.Control.description
; total_space= response.Xapi_storage.Control.total_space
; free_space= response.Xapi_storage.Control.free_space
; clustered= response.Xapi_storage.Control.clustered
; health=
( match response.Xapi_storage.Control.health with
| Xapi_storage.Control.Healthy _ ->
Healthy
| Xapi_storage.Control.Recovering _ ->
Recovering
| Xapi_storage.Control.Unreachable _ ->
Unreachable
| Xapi_storage.Control.Unavailable _ ->
Unavailable
)
}
>>>= fun sr_info ->
match sr_info.health with
| Healthy ->
return_volume_rpc (fun () ->
Sr_client.ls
(volume_rpc ~dbg ~compat_out:Compat.compat_out_volumes)
dbg sr
)
>>>= fun response ->
let response = Array.to_list response in
(* Filter out volumes which are clone-on-boot transients *)
let transients =
List.fold
~f:(fun set x ->
match
List.Assoc.find x.Xapi_storage.Control.keys
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I assume this list is short? Otherwise this could be costly if response is large.

Copy link
Contributor Author

@Vincent-lau Vincent-lau Aug 30, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I copied this from the previous implementation, but response contains a list of volumes within an SR, and the max length of the list would be defined as the max num of volumes, which can be large potentially https://docs.xenserver.com/en-us/xenserver/8/system-requirements/configuration-limits.html

Copy link
Contributor Author

@Vincent-lau Vincent-lau Aug 30, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

and this would depend on the size of keys as well, which I believe should be small. But even if it is large, there is not much we can do about it, creating an set for each x in the list of volumes? That would be a O(mn) operation itself (plus O(mn) space)

_clone_on_boot_key ~equal:String.equal
with
| None ->
set
| Some transient ->
Set.add set transient
)
~init:Core.String.Set.empty response
in
let response =
List.filter
~f:(fun x ->
not (Set.mem transients x.Xapi_storage.Control.key)
)
response
in
Deferred.Result.return
(List.map ~f:vdi_of_volume response, sr_info)
| health ->
debug "%s: sr unhealthy %s" __FUNCTION__
(Storage_interface.show_sr_health health) ;
Deferred.Result.fail
Storage_interface.(Errors.Sr_unhealthy health)
)
|> wrap
in
S.SR.scan2 sr_scan2_impl ;
let vdi_create_impl dbg sr (vdi_info : Storage_interface.vdi_info) =
Attached_SRs.find sr
>>>= (fun sr ->
Expand Down
8 changes: 8 additions & 0 deletions ocaml/xapi/storage_mux.ml
Original file line number Diff line number Diff line change
Expand Up @@ -348,6 +348,14 @@ module Mux = struct
end)) in
C.SR.stat (Debug_info.to_string di) sr

let scan2 () ~dbg ~sr =
with_dbg ~name:"SR.scan2" ~dbg @@ fun di ->
info "SR.scan2 dbg:%s sr:%s" dbg (s_of_sr sr) ;
let module C = StorageAPI (Idl.Exn.GenClient (struct
let rpc = of_sr sr
end)) in
C.SR.scan2 (Debug_info.to_string di) sr

let scan () ~dbg ~sr =
with_dbg ~name:"SR.scan" ~dbg @@ fun di ->
info "SR.scan dbg:%s sr:%s" dbg (s_of_sr sr) ;
Expand Down
14 changes: 14 additions & 0 deletions ocaml/xapi/storage_smapiv1_wrapper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1210,6 +1210,20 @@ functor
Impl.SR.scan context ~dbg ~sr
)

let scan2 context ~dbg ~sr =
with_dbg ~name:"SR.scan2" ~dbg @@ fun di ->
info "SR.scan2 dbg:%s sr:%s" di.log (s_of_sr sr) ;
let dbg = Debug_info.to_string di in
with_sr sr (fun () ->
match Host.find sr !Host.host with
| None ->
raise (Storage_error (Sr_not_attached (s_of_sr sr)))
| Some _ ->
let vs = Impl.SR.scan context ~dbg ~sr in
let sr_info = Impl.SR.stat context ~dbg ~sr in
(vs, sr_info)
)

let create context ~dbg ~sr ~name_label ~name_description ~device_config
~physical_size =
with_dbg ~name:"SR.create" ~dbg @@ fun di ->
Expand Down
8 changes: 2 additions & 6 deletions ocaml/xapi/xapi_sr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -787,19 +787,15 @@ let scan ~__context ~sr =
SRScanThrottle.execute (fun () ->
transform_storage_exn (fun () ->
let sr_uuid = Db.SR.get_uuid ~__context ~self:sr in
let vs =
C.SR.scan (Ref.string_of task)
let vs, sr_info =
C.SR.scan2 (Ref.string_of task)
(Storage_interface.Sr.of_string sr_uuid)
in
let db_vdis =
Db.VDI.get_records_where ~__context
~expr:(Eq (Field "SR", Literal sr'))
in
update_vdis ~__context ~sr db_vdis vs ;
let sr_info =
C.SR.stat (Ref.string_of task)
(Storage_interface.Sr.of_string sr_uuid)
in
let virtual_allocation =
List.fold_left Int64.add 0L
(List.map (fun v -> v.Storage_interface.virtual_size) vs)
Expand Down
Loading