X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=sparsify%2Fsparsify.ml;h=dd3e043b9de5d7c05bcf67cd21e2e429fe4e1538;hb=e7e3a32edc29e3448b1d7efb3f6b53c5173c4e9c;hp=89a2c1377d024eed0aad1b3d976869a4cc6e06d8;hpb=fac15924f59a076c903d453d20305e00e1ae258a;p=libguestfs.git

diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
index 89a2c13..dd3e043 100644
--- a/sparsify/sparsify.ml
+++ b/sparsify/sparsify.ml
@@ -28,8 +28,9 @@ let () = Random.self_init ()
 (* Command line argument parsing. *)
 let prog = Filename.basename Sys.executable_name
 
-let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
-  verbose, trace =
+let indisk, outdisk, compress, convert, debug_gc,
+  format, ignores, machine_readable,
+  option, quiet, verbose, trace =
   let display_version () =
     let g = new G.guestfs () in
     let version = g#version () in
@@ -40,19 +41,25 @@ let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
 
   let add xs s = xs := s :: !xs in
 
+  let compress = ref false in
   let convert = ref "" in
+  let debug_gc = ref false in
   let format = ref "" in
   let ignores = ref [] in
   let machine_readable = ref false in
+  let option = ref "" in
   let quiet = ref false in
   let verbose = ref false in
   let trace = ref false in
 
   let argspec = Arg.align [
+    "--compress", Arg.Set compress,         " Compressed output format";
     "--convert", Arg.Set_string convert,    "format Format of output disk (default: same as input)";
+    "--debug-gc", Arg.Set debug_gc,         " Debug GC and memory allocations";
     "--format",  Arg.Set_string format,     "format Format of input disk";
     "--ignore",  Arg.String (add ignores),  "fs Ignore filesystem";
     "--machine-readable", Arg.Set machine_readable, " Make output machine readable";
+    "-o",        Arg.Set_string option,     "option Add qemu-img options";
     "-q",        Arg.Set quiet,             " Quiet output";
     "--quiet",   Arg.Set quiet,             " -\"-";
     "-v",        Arg.Set verbose,           " Enable debugging messages";
@@ -76,10 +83,13 @@ read the man page virt-sparsify(1).
   Arg.parse argspec anon_fun usage_msg;
 
   (* Dereference the rest of the args. *)
+  let compress = !compress in
   let convert = match !convert with "" -> None | str -> Some str in
+  let debug_gc = !debug_gc in
   let format = match !format with "" -> None | str -> Some str in
   let ignores = List.rev !ignores in
   let machine_readable = !machine_readable in
+  let option = match !option with "" -> None | str -> Some str in
   let quiet = !quiet in
   let verbose = !verbose in
   let trace = !trace in
@@ -122,8 +132,9 @@ read the man page virt-sparsify(1).
   if contains_comma then
     error "input filename '%s' contains a comma; qemu-img command line syntax prevents us from using such an image" indisk;
 
-  indisk, outdisk, convert, format, ignores, machine_readable, quiet,
-  verbose, trace
+  indisk, outdisk, compress, convert,
+    debug_gc, format, ignores, machine_readable,
+    option, quiet, verbose, trace
 
 let () =
   if not quiet then
@@ -177,10 +188,15 @@ let () =
   let filesystems = g#list_filesystems () in
   let filesystems = List.map fst filesystems in
   let filesystems = List.sort compare filesystems in
+
+  let is_ignored fs =
+    let fs = canonicalize fs in
+    List.exists (fun fs' -> fs = canonicalize fs') ignores
+  in
+
   List.iter (
     fun fs ->
-      if not (List.mem fs ignores) then (
-
+      if not (is_ignored fs) then (
         let mounted =
           try g#mount_options "" fs "/"; true
           with _ -> false in
@@ -269,6 +285,8 @@ let output_format =
       );
       if string_prefix line "QEMU QCOW Image (v2)" then
         "qcow2"
+      else if string_find line "VirtualBox" >= 0 then
+        "vdi"
       else
         "raw" (* XXX guess *)
 
@@ -280,10 +298,14 @@ let () =
     printf "Copy to destination and make sparse ...\n%!";
 
   let cmd =
-    sprintf "qemu-img convert -f qcow2 -O %s %s %s"
+    sprintf "qemu-img convert -f qcow2 -O %s%s%s %s %s"
       (Filename.quote output_format)
+      (if compress then " -c" else "")
+      (match option with
+      | None -> ""
+      | Some option -> " -o " ^ Filename.quote option)
       (Filename.quote overlaydisk) (Filename.quote outdisk) in
-  if verbose then
+(*  if verbose then*)
     printf "%s\n%!" cmd;
   if Sys.command cmd <> 0 then
     error "external command failed: %s" cmd
@@ -295,4 +317,7 @@ let () =
     wrap "Sparsify operation completed with no errors.  Before deleting the old disk, carefully check that the target disk boots and works correctly.\n";
   );
 
+  if debug_gc then
+    Gc.compact ();
+
   exit 0