From 200c392c36db4800e915e3c4de16ea6294dd4cd7 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 28 Aug 2015 13:53:24 +0100 Subject: [PATCH] v2v: Convert xpath_to_* to use xpath convenience functions. In -i libvirtxml, -i ova and -o libvirt drivers, replace the ad hoc xpath_to_* functions with use of the new xpath convenience functions introduced in the previous commit. This is not entirely refactoring because I fixed a few bugs found by type safety. (cherry picked from commit 261d05749fb75e60d56d3c2d92589de9dca7ca09) --- v2v/input_libvirtxml.ml | 281 ++++++++++++++++++++++-------------------------- v2v/input_ova.ml | 85 +++++++-------- v2v/output_libvirt.ml | 23 ++-- 3 files changed, 180 insertions(+), 209 deletions(-) diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml index 16c34a6..be48a75 100644 --- a/v2v/input_libvirtxml.ml +++ b/v2v/input_libvirtxml.ml @@ -39,37 +39,23 @@ let parse_libvirt_xml ?conn ~verbose xml = let doc = Xml.parse_memory xml in let xpathctx = Xml.xpath_new_context doc in + let xpath_string = xpath_string xpathctx + and xpath_int = xpath_int xpathctx + and xpath_int_default = xpath_int_default xpathctx in - let xpath_to_string expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - Xml.node_as_string node - ) - and xpath_to_int expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - let str = Xml.node_as_string node in - try int_of_string str - with Failure "int_of_string" -> - error (f_"expecting XML expression to return an integer (expression: %s)") - expr - ) - in - - let dom_type = xpath_to_string "/domain/@type" "" in - let name = xpath_to_string "/domain/name/text()" "" in - let memory = xpath_to_int "/domain/memory/text()" (1024 * 1024) in + let dom_type = + match xpath_string "/domain/@type" with + | None | Some "" -> + error ~prog (f_"in the libvirt XML metadata, is missing or empty") + | Some s -> s in + let name = + match xpath_string "/domain/name/text()" with + | None | Some "" -> + error ~prog (f_"in the libvirt XML metadata, is missing or empty") + | Some s -> s in + let memory = xpath_int_default "/domain/memory/text()" (1024 * 1024) in let memory = Int64.of_int memory *^ 1024L in - let vcpu = xpath_to_int "/domain/vcpu/text()" 1 in - - if dom_type = "" then - error (f_"in the libvirt XML metadata, is missing or empty"); - if name = "" then - error (f_"in the libvirt XML metadata, is missing or empty"); + let vcpu = xpath_int_default "/domain/vcpu/text()" 1 in let features = let features = ref [] in @@ -89,54 +75,53 @@ let parse_libvirt_xml ?conn ~verbose xml = (* Ignore everything except the first device. *) let node = Xml.xpathobj_node obj 0 in Xml.xpathctx_set_current_context xpathctx node; - let keymap = - match xpath_to_string "@keymap" "" with "" -> None | k -> Some k in - let password = - match xpath_to_string "@passwd" "" with "" -> None | pw -> Some pw in + let keymap = xpath_string "@keymap" in + let password = xpath_string "@passwd" in let listen = let obj = Xml.xpath_eval_expression xpathctx "listen" in let nr_nodes = Xml.xpathobj_nr_nodes obj in if nr_nodes < 1 then ( - match xpath_to_string "@listen" "" with "" -> LNone | a -> LAddress a + match xpath_string "@listen" with + | None -> LNone | Some a -> LAddress a ) else ( (* Use only the first configuration. *) - match xpath_to_string "listen[1]/@type" "" with - | "" -> LNone - | "address" -> - (match xpath_to_string "listen[1]/@address" "" with - | "" -> LNone - | a -> LAddress a + match xpath_string "listen[1]/@type" with + | None -> LNone + | Some "address" -> + (match xpath_string "listen[1]/@address" with + | None -> LNone + | Some a -> LAddress a ) - | "network" -> - (match xpath_to_string "listen[1]/@network" "" with - | "" -> LNone - | n -> LNetwork n + | Some "network" -> + (match xpath_string "listen[1]/@network" with + | None -> LNone + | Some n -> LNetwork n ) - | t -> + | Some t -> warning ~prog (f_" in the input libvirt XML was ignored") t; LNone ) in let port = - match xpath_to_string "@autoport" "yes" with - | "no" -> - let port = xpath_to_int "@port" (-1) in - if port >= 0 then Some port - else None + match xpath_string "@autoport" with + | Some "no" -> + (match xpath_int "@port" with + | Some port when port > 0 -> Some port + | Some _ | None -> None) | _ -> None in - match xpath_to_string "@type" "" with - | "" -> None - | "vnc" -> + match xpath_string "@type" with + | None -> None + | Some "vnc" -> Some { s_display_type = VNC; s_keymap = keymap; s_password = password; s_listen = listen; s_port = port } - | "spice" -> + | Some "spice" -> Some { s_display_type = Spice; s_keymap = keymap; s_password = password; s_listen = listen; s_port = port } - | "sdl"|"desktop" as t -> + | Some ("sdl"|"desktop" as t) -> warning ~prog (f_"virt-v2v does not support local displays, so in the input libvirt XML was ignored") t; None - | t -> + | Some t -> warning ~prog (f_"display in the input libvirt XML was ignored") t; None ) in @@ -151,16 +136,16 @@ let parse_libvirt_xml ?conn ~verbose xml = let node = Xml.xpathobj_node obj 0 in Xml.xpathctx_set_current_context xpathctx node; - match xpath_to_string "@model" "" with - | "" -> None - | "ac97" -> Some { s_sound_model = AC97 } - | "es1370" -> Some { s_sound_model = ES1370 } - | "ich6" -> Some { s_sound_model = ICH6 } - | "ich9" -> Some { s_sound_model = ICH9 } - | "pcspk" -> Some { s_sound_model = PCSpeaker } - | "sb16" -> Some { s_sound_model = SB16 } - | "usb" -> Some { s_sound_model = USBAudio } - | model -> + match xpath_string "@model" with + | None -> None + | Some "ac97" -> Some { s_sound_model = AC97 } + | Some "es1370" -> Some { s_sound_model = ES1370 } + | Some "ich6" -> Some { s_sound_model = ICH6 } + | Some "ich9" -> Some { s_sound_model = ICH9 } + | Some "pcspk" -> Some { s_sound_model = PCSpeaker } + | Some "sb16" -> Some { s_sound_model = SB16 } + | Some "usb" -> Some { s_sound_model = USBAudio } + | Some model -> warning ~prog (f_"unknown sound model %s ignored") model; None ) in @@ -191,84 +176,80 @@ let parse_libvirt_xml ?conn ~verbose xml = Xml.xpathctx_set_current_context xpathctx node; let controller = - let target_bus = xpath_to_string "target/@bus" "" in + let target_bus = xpath_string "target/@bus" in match target_bus with - | "" -> None - | "ide" -> Some Source_IDE - | "scsi" -> Some Source_SCSI - | "virtio" -> Some Source_virtio_blk - | _ -> None in + | None -> None + | Some "ide" -> Some Source_IDE + | Some "scsi" -> Some Source_SCSI + | Some "virtio" -> Some Source_virtio_blk + | Some _ -> None in let format = - match xpath_to_string "driver/@type" "" with - | "aio" -> Some "raw" (* Xen wierdness *) - | "" -> None - | format -> Some format in + match xpath_string "driver/@type" with + | Some "aio" -> Some "raw" (* Xen wierdness *) + | None -> None + | Some format -> Some format in (* The attribute may be 'block', 'file', * 'network' or 'volume'. We ignore any other types. *) - match xpath_to_string "@type" "" with - | "block" -> - let path = xpath_to_string "source/@dev" "" in - if path <> "" then - add_disk path format controller (P_source_dev path) - | "file" -> - let path = xpath_to_string "source/@file" "" in - if path <> "" then - add_disk path format controller (P_source_file path) - | "network" -> + match xpath_string "@type" with + | None -> + warning ~prog (f_" element with no type attribute ignored") + | Some "block" -> + (match xpath_string "source/@dev" with + | Some path -> + add_disk path format controller (P_source_dev path) + | None -> () + ); + | Some "file" -> + (match xpath_string "source/@file" with + | Some path -> + add_disk path format controller (P_source_file path) + | None -> () + ); + | Some "network" -> (* We only handle here, and that is * intended only for virt-p2v. Any other network disk is * currently ignored. *) - (match xpath_to_string "source/@protocol" "" with - | "nbd" -> - let host = xpath_to_string "source/host/@name" "" in - let port = xpath_to_int "source/host/@port" 0 in - if host <> "" && port > 0 then ( - (* Generate a qemu nbd URL. - * XXX Quoting, although it's not needed for virt-p2v. - *) - let path = sprintf "nbd:%s:%d" host port in - add_disk path format controller P_dont_rewrite - ) - | "" -> () - | protocol -> - warning ~prog (f_"network with was ignored") + (match (xpath_string "source/@protocol", + xpath_string "source/host/@name", + xpath_int "source/host/@port") with + | None, _, _ -> + warning ~prog (f_" was ignored") + | Some "nbd", Some ("localhost" as host), Some port when port > 0 -> + (* virt-p2v: Generate a qemu nbd URL. *) + let path = sprintf "nbd:%s:%d" host port in + add_disk path format controller P_dont_rewrite + | Some protocol, _, _ -> + warning ~prog (f_" with was ignored") protocol ) - | "volume" -> - let pool = xpath_to_string "source/@pool" "" in - let vol = xpath_to_string "source/@volume" "" in - if pool <> "" && vol <> "" then ( + | Some "volume" -> + (match xpath_string "source/@pool", xpath_string "source/@volume" with + | None, None | Some _, None | None, Some _ -> () + | Some pool, Some vol -> let xml = Domainxml.vol_dumpxml ?conn pool vol in let doc = Xml.parse_memory xml in let xpathctx = Xml.xpath_new_context doc in - - let xpath_to_string expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - Xml.node_as_string node - ) in + let xpath_string = Utils.xpath_string xpathctx in (* Use the format specified in the volume itself. *) - let format = - match xpath_to_string "/volume/target/format/@type" "" with - | "" -> None - | format -> Some format in + let format = xpath_string "/volume/target/format/@type" in - match xpath_to_string "/volume/@type" "" with - | "" | "file" -> - let path = xpath_to_string "/volume/target/path/text()" "" in - if path <> "" then - add_disk path format controller (P_source_file path) - | vol_type -> + (match xpath_string "/volume/@type" with + | None | Some "file" -> + (match xpath_string "/volume/target/path/text()" with + | Some path -> + add_disk path format controller (P_source_file path) + | None -> () + ); + | Some vol_type -> warning ~prog (f_" with was ignored") vol_type + ) ) - | disk_type -> + | Some disk_type -> warning ~prog (f_" was ignored") disk_type done; get_disks () in @@ -285,18 +266,18 @@ let parse_libvirt_xml ?conn ~verbose xml = Xml.xpathctx_set_current_context xpathctx node; let controller = - let target_bus = xpath_to_string "target/@bus" "" in + let target_bus = xpath_string "target/@bus" in match target_bus with - | "" -> None - | "ide" -> Some Source_IDE - | "scsi" -> Some Source_SCSI - | "virtio" -> Some Source_virtio_blk - | _ -> None in + | None -> None + | Some "ide" -> Some Source_IDE + | Some "scsi" -> Some Source_SCSI + | Some "virtio" -> Some Source_virtio_blk + | Some _ -> None in let typ = - match xpath_to_string "@device" "" with - | "cdrom" -> CDROM - | "floppy" -> Floppy + match xpath_string "@device" with + | Some "cdrom" -> CDROM + | Some "floppy" -> Floppy | _ -> assert false (* libxml2 error? *) in let disk = @@ -314,31 +295,31 @@ let parse_libvirt_xml ?conn ~verbose xml = let node = Xml.xpathobj_node obj i in Xml.xpathctx_set_current_context xpathctx node; - let mac = xpath_to_string "mac/@address" "" in + let mac = xpath_string "mac/@address" in let mac = match mac with - | "" - | "00:00:00:00:00:00" (* thanks, VMware *) -> None - | mac -> Some mac in + | None + | Some "00:00:00:00:00:00" (* thanks, VMware *) -> None + | Some mac -> Some mac in let vnet_type = - match xpath_to_string "@type" "" with - | "network" -> Some Network - | "bridge" -> Some Bridge - | _ -> None in + match xpath_string "@type" with + | Some "network" -> Some Network + | Some "bridge" -> Some Bridge + | None | Some _ -> None in match vnet_type with | None -> () | Some vnet_type -> - let vnet = xpath_to_string "source/@network | source/@bridge" "" in - if vnet <> "" then ( - let nic = { - s_mac = mac; - s_vnet = vnet; - s_vnet_orig = vnet; - s_vnet_type = vnet_type - } in - nics := nic :: !nics - ) + match xpath_string "source/@network | source/@bridge" with + | None -> () + | Some vnet -> + let nic = { + s_mac = mac; + s_vnet = vnet; + s_vnet_orig = vnet; + s_vnet_type = vnet_type + } in + nics := nic :: !nics done; List.rev !nics in diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index ab8c27b..d1b7021 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -180,41 +180,27 @@ object Xml.xpath_register_ns xpathctx "vssd" "http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_VirtualSystemSettingData"; - let xpath_to_string expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - Xml.node_as_string node - ) - and xpath_to_int expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - let str = Xml.node_as_string node in - try int_of_string str - with Failure "int_of_string" -> - error (f_"expecting XML expression to return an integer (expression: %s)") - expr - ) - in + let xpath_string = xpath_string xpathctx + and xpath_int = xpath_int xpathctx + and xpath_string_default = xpath_string_default xpathctx + and xpath_int_default = xpath_int_default xpathctx in (* Search for vm name. *) let name = - xpath_to_string "/ovf:Envelope/ovf:VirtualSystem/ovf:Name/text()" "" in - if name = "" then - error (f_"could not parse ovf:Name from OVF document"); + match xpath_string "/ovf:Envelope/ovf:VirtualSystem/ovf:Name/text()" with + | None | Some "" -> + error (f_"could not parse ovf:Name from OVF document") + | Some name -> name in (* Search for memory. *) - let memory = xpath_to_int "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()" (1024 * 1024) in + let memory = xpath_int_default "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()" (1024 * 1024) in let memory = Int64.of_int (memory * 1024 * 1024) in (* Search for number of vCPUs. *) - let vcpu = xpath_to_int "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()" 1 in + let vcpu = xpath_int_default "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()" 1 in (* BIOS or EFI firmware? *) - let firmware = xpath_to_string "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value" "bios" in + let firmware = xpath_string_default "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value" "bios" in let firmware = match firmware with | "bios" -> BIOS @@ -225,16 +211,16 @@ object (* Helper function to return the parent controller of a disk. *) let parent_controller id = let expr = sprintf "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:InstanceID/text()=%d]/rasd:ResourceType/text()" id in - let controller = xpath_to_int expr 0 in + let controller = xpath_int expr in (* 6: iscsi controller, 5: ide *) match controller with - | 6 -> Some Source_SCSI - | 5 -> Some Source_IDE - | 0 -> + | Some 6 -> Some Source_SCSI + | Some 5 -> Some Source_IDE + | None -> warning ~prog (f_"ova disk has no parent controller, please report this as a bug supplying the *.ovf file extracted from the ova"); None - | _ -> + | Some controller -> warning ~prog (f_"ova disk has an unknown VMware controller type (%d), please report this as a bug supplying the *.ovf file extracted from the ova") controller; None @@ -251,27 +237,32 @@ object Xml.xpathctx_set_current_context xpathctx n; (* XXX We assume the OVF lists these in order. - let address = xpath_to_int "rasd:AddressOnParent/text()" 0 in + let address = xpath_int "rasd:AddressOnParent/text()" in *) (* Find the parent controller. *) - let parent_id = xpath_to_int "rasd:Parent/text()" 0 in + let parent_id = xpath_int "rasd:Parent/text()" in let controller = match parent_id with - | 0 -> None - | id -> parent_controller id in + | None -> None + | Some id -> parent_controller id in Xml.xpathctx_set_current_context xpathctx n; - let file_id = xpath_to_string "rasd:HostResource/text()" "" in + let file_id = xpath_string_default "rasd:HostResource/text()" "" in let rex = Str.regexp "^ovf:/disk/\\(.*\\)" in if Str.string_match rex file_id 0 then ( (* Chase the references through to the actual file name. *) let file_id = Str.matched_group 1 file_id in let expr = sprintf "/ovf:Envelope/ovf:DiskSection/ovf:Disk[@ovf:diskId='%s']/@ovf:fileRef" file_id in - let file_ref = xpath_to_string expr "" in - if file_ref == "" then error (f_"error parsing disk fileRef"); + let file_ref = + match xpath_string expr with + | None -> error (f_"error parsing disk fileRef") + | Some s -> s in let expr = sprintf "/ovf:Envelope/ovf:References/ovf:File[@ovf:id='%s']/@ovf:href" file_ref in - let filename = xpath_to_string expr "" in + let filename = + match xpath_string expr with + | None -> error (f_"no href in ovf:File (id=%s)") file_ref + | Some s -> s in (* Does the file exist and is it readable? *) let filename = exploded // filename in @@ -318,19 +309,22 @@ object for i = 0 to nr_nodes-1 do let n = Xml.xpathobj_node obj i in Xml.xpathctx_set_current_context xpathctx n; - let id = xpath_to_int "rasd:ResourceType/text()" 0 in - assert (id = 14 || id = 15 || id = 16); + let id = + match xpath_int "rasd:ResourceType/text()" with + | None -> assert false + | Some (14|15|16 as i) -> i + | Some _ -> assert false in (* XXX We assume the OVF lists these in order. - let address = xpath_to_int "rasd:AddressOnParent/text()" 0 in + let address = xpath_int "rasd:AddressOnParent/text()" in *) (* Find the parent controller. *) - let parent_id = xpath_to_int "rasd:Parent/text()" 0 in + let parent_id = xpath_int "rasd:Parent/text()" in let controller = match parent_id with - | 0 -> None - | id -> parent_controller id in + | None -> None + | Some id -> parent_controller id in let typ = match id with @@ -352,7 +346,8 @@ object for i = 0 to nr_nodes-1 do let n = Xml.xpathobj_node obj i in Xml.xpathctx_set_current_context xpathctx n; - let vnet = xpath_to_string "rasd:ElementName/text()" (sprintf"eth%d" i) in + let vnet = + xpath_string_default "rasd:ElementName/text()" (sprintf"eth%d" i) in let nic = { s_mac = None; s_vnet = vnet; diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml index de4aeb4..16510d2 100644 --- a/v2v/output_libvirt.ml +++ b/v2v/output_libvirt.ml @@ -350,23 +350,18 @@ class output_libvirt verbose oc output_pool = object let xml = Domainxml.pool_dumpxml ?conn:oc output_pool in let doc = Xml.parse_memory xml in let xpathctx = Xml.xpath_new_context doc in - - let xpath_to_string expr default = - let obj = Xml.xpath_eval_expression xpathctx expr in - if Xml.xpathobj_nr_nodes obj < 1 then default - else ( - let node = Xml.xpathobj_node obj 0 in - Xml.node_as_string node - ) - in + let xpath_string = xpath_string xpathctx in (* We can only output to a pool of type 'dir' (directory). *) - let pool_type = xpath_to_string "/pool/@type" "" in - if pool_type <> "dir" then + if xpath_string "/pool/@type" <> Some "dir" then error (f_"-o libvirt: output pool '%s' is not a directory (type='dir'). See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool; - let target_path = xpath_to_string "/pool/target/path/text()" "" in - if target_path = "" || not (is_directory target_path) then - error (f_"-o libvirt: output pool '%s' has type='dir' but the /pool/target/path element either does not exist or is not a local directory. See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool; + let target_path = + match xpath_string "/pool/target/path/text()" with + | None -> + error (f_"-o libvirt: output pool '%s' does not have /pool/target/path element. See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool + | Some dir when not (is_directory dir) -> + error (f_"-o libvirt: output pool '%s' has type='dir' but the /pool/target/path element is not a local directory. See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool + | Some dir -> dir in (* Set up the targets. *) List.map ( -- 1.8.3.1