--- v2v/input_libvirtxml.ml | 284 +++++++++++++++++++++++------------------------- 1 file changed, 133 insertions(+), 151 deletions(-) diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml index 653bfc5..b464857 100644 --- a/v2v/input_libvirtxml.ml +++ b/v2v/input_libvirtxml.ml @@ -52,39 +52,23 @@ let parse_libvirt_xml ?conn 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 hypervisor = 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 hypervisor = + match xpath_string "/domain/@type" with + | Some s -> source_hypervisor_of_string s + | None -> + error (f_"in the libvirt XML metadata, <domain type='...'> is missing or empty") in + let name = + match xpath_string "/domain/name/text()" with + | Some s -> s + | None -> + error (f_"in the libvirt XML metadata, <name> is missing or empty") 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 hypervisor = "" then - error (f_"in the libvirt XML metadata, <domain type='...'> is missing or empty"); - let hypervisor = source_hypervisor_of_string hypervisor in - - if name = "" then - error (f_"in the libvirt XML metadata, <name> is missing or empty"); + let vcpu = xpath_int_default "/domain/vcpu/text()" 1 in let features = let features = ref [] in @@ -104,54 +88,53 @@ let parse_libvirt_xml ?conn xml = (* Ignore everything except the first <graphics> 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 <listen> 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 (f_"<listen type='%s'> 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 (f_"virt-v2v does not support local displays, so <graphics type='%s'> in the input libvirt XML was ignored") t; None - | t -> + | Some t -> warning (f_"display <graphics type='%s'> in the input libvirt XML was ignored") t; None ) in @@ -166,16 +149,16 @@ let parse_libvirt_xml ?conn 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 (f_"unknown sound model %s ignored") model; None ) in @@ -206,80 +189,79 @@ let parse_libvirt_xml ?conn 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 <disk type='...'> 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 (f_"<disk> 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 <source protocol="nbd"> here, and that is * intended only for virt-p2v. *) - (match (xpath_to_string "source/@protocol" "", - xpath_to_string "source/host/@name" "", - xpath_to_int "source/host/@port" 0) with - | "", _, _ -> + (match (xpath_string "source/@protocol", + xpath_string "source/host/@name", + xpath_int "source/host/@port") with + | None, _, _ -> warning (f_"<disk type=network> was ignored") - | "nbd", ("localhost" as host), port when port > 0 -> + | 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 - | protocol, _, _ -> + | Some protocol, _, _ -> warning (f_"<disk type='network'> with <source protocol='%s'> 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 (f_"<disk type='volume'> with <volume type='%s'> was ignored") vol_type + ) ) - | disk_type -> + | Some disk_type -> warning (f_"<disk type='%s'> was ignored") disk_type done; get_disks () in @@ -296,30 +278,30 @@ let parse_libvirt_xml ?conn 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 slot = - let target_dev = xpath_to_string "target/@dev" "" in + let target_dev = xpath_string "target/@dev" in match target_dev with - | "" -> None - | s when string_prefix s "hd" -> get_drive_slot s 2 - | s when string_prefix s "sd" -> get_drive_slot s 2 - | s when string_prefix s "vd" -> get_drive_slot s 2 - | s when string_prefix s "xvd" -> get_drive_slot s 3 - | s -> + | None -> None + | Some s when string_prefix s "hd" -> get_drive_slot s 2 + | Some s when string_prefix s "sd" -> get_drive_slot s 2 + | Some s when string_prefix s "vd" -> get_drive_slot s 2 + | Some s when string_prefix s "xvd" -> get_drive_slot s 3 + | Some s -> warning (f_"<target dev='%s'> was ignored because the device name could not be recognized") s; 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 = @@ -339,31 +321,31 @@ let parse_libvirt_xml ?conn 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 -- 2.5.0