Merge pull request #1014 from johnelse/ca-98492

CA-98492: Fix for VDI.create for certain VDI types

Author: Jon Ludlam

ocaml/xapi/OMakefile

@@ -86,6 +86,7 @@ XAPI_MODULES = $(COMMON) \
 	storage_mux \
 	storage_migrate \
 	storage_proxy \
+	storage_utils \
 	xapi_services \
 	sm_exec \
 	sm \

ocaml/xapi/storage_access.ml

@@ -45,9 +45,6 @@ let find_content ~__context ?sr name =
 let redirect sr =
 	raise (Redirect (Some (Pool_role.get_master_address ())))
 
-let string_of_vdi_type vdi_type =
-	Rpc.string_of_rpc (API.rpc_of_vdi_type vdi_type)
-
 module SMAPIv1 = struct
 	(** xapi's builtin ability to call local SM plugins using the existing
 	    protocol. The code here should only call the SM functions and encapsulate
@@ -185,7 +182,7 @@ module SMAPIv1 = struct
 				content_id = content_id; (* PR-1255 *)
 				name_label = vdi_rec.API.vDI_name_label;
 				name_description = vdi_rec.API.vDI_name_description;
-				ty = string_of_vdi_type vdi_rec.API.vDI_type;
+				ty = Storage_utils.string_of_vdi_type vdi_rec.API.vDI_type;
 				metadata_of_pool = Ref.string_of vdi_rec.API.vDI_metadata_of_pool;
 				is_a_snapshot = vdi_rec.API.vDI_is_a_snapshot;
 				snapshot_time = Date.to_string vdi_rec.API.vDI_snapshot_time;
@@ -338,7 +335,7 @@ module SMAPIv1 = struct
 				content_id = r.API.vDI_location; (* PR-1255 *)
                 name_label = r.API.vDI_name_label;
                 name_description = r.API.vDI_name_description;
-                ty = string_of_vdi_type r.API.vDI_type;
+                ty = Storage_utils.string_of_vdi_type r.API.vDI_type;
 				metadata_of_pool = Ref.string_of r.API.vDI_metadata_of_pool;
                 is_a_snapshot = r.API.vDI_is_a_snapshot;
                 snapshot_time = Date.to_string r.API.vDI_snapshot_time;

ocaml/xapi/storage_utils.ml

@@ -0,0 +1,19 @@
+(*
+ * Copyright (C) 2006-2013 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+let string_of_vdi_type vdi_type =
+	Rpc.string_of_rpc (API.rpc_of_vdi_type vdi_type)
+
+let vdi_type_of_string str =
+	API.vdi_type_of_rpc (Rpc.String str)

ocaml/xapi/xapi_sr.ml

@@ -333,7 +333,7 @@ let update_vdis ~__context ~sr db_vdis vdi_infos =
 				~snapshot_time:(Date.of_string vdi.snapshot_time)
 				~sR:sr ~virtual_size:vdi.virtual_size
 				~physical_utilisation:vdi.physical_utilisation
-				~_type:(Opt.default `user (Record_util.string_to_vdi_type vdi.ty))
+				~_type:(try Storage_utils.vdi_type_of_string vdi.ty with _ -> `user)
 				~sharable:false ~read_only:vdi.read_only
 				~xenstore_data:[] ~sm_config:[]
 				~other_config:[] ~storage_lock:false ~location:vdi.vdi
@@ -354,7 +354,7 @@ let update_vdis ~__context ~sr db_vdis vdi_infos =
 				debug "%s name_description <- %s" (Ref.string_of r) vi.name_description;
 				Db.VDI.set_name_description ~__context ~self:r ~value:vi.name_description
 			end;
-			let ty = Opt.default `user (Record_util.string_to_vdi_type vi.ty) in
+			let ty = (try Storage_utils.vdi_type_of_string vi.ty with _ -> `user) in
 			if v.API.vDI_type <> ty then begin
 				debug "%s type <- %s" (Ref.string_of r) vi.ty;
 				Db.VDI.set_type ~__context ~self:r ~value:ty