[Libguestfs] [PATCH v2] v2v: disk: strip only common extension (RHBZ#1365005)

[Pino Toscano]

In disk input mode, to determine the guest name strip the extension from
the filename only if it's a very well extension for disk images.
---
 v2v/input_disk.ml | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/v2v/input_disk.ml b/v2v/input_disk.ml
index 17ad61d..d56c476 100644
--- a/v2v/input_disk.ml
+++ b/v2v/input_disk.ml
@@ -42,9 +42,23 @@ class input_disk input_format disk = object
      * the filename passed in.  Users can override this using the
      * `-on name' option.
      *)
-    let name = Filename.basename disk in
     let name =
-      try Filename.chop_extension name with Invalid_argument _ -> name in
+      let name = Filename.basename disk in
+      (* Remove the extension (or suffix), only if it's one usually
+       * used for disk images. *)
+      let suffixes = [
+        ".img"; ".qcow2"; ".raw"; ".vmdk";
+        "-sda";
+      ] in
+      let rec loop = function
+        | suff :: xs ->
+          if Filename.check_suffix name suff then
+            Filename.chop_suffix name suff
+          else
+            loop xs
+        | [] -> name
+      in
+      loop suffixes in
     if name = "" then
       error (f_"-i disk: invalid input filename (%s)") disk;
 
-- 
2.7.4