Libguestfs - Jun 2014 - [PATCH 1/2] mllib: Create a common utility function is_directory.

The first patch is just some simple refactoring.  See the second patch
for a description of the new virt-sparsify --tmp option.

I tested this using a loopback device as my temporary block device,
and it seems to work fine for me.

Federico .. this needs a BZ :-)

Rich.

This is a wrapper around Sys.is_directory which doesn't throw
exceptions.
---
 builder/cache.ml      | 9 ++-------
 mllib/common_utils.ml | 5 +++++
 v2v/cmdline.ml        | 4 +---
 3 files changed, 8 insertions(+), 10 deletions(-)

diff --git a/builder/cache.ml b/builder/cache.ml
index 581b2cf..683cd35 100644
--- a/builder/cache.ml
+++ b/builder/cache.ml
@@ -34,13 +34,8 @@ type t = {
 }
 
 let create ~debug ~directory -  (* Annoyingly Sys.is_directory throws an
exception on failure
-   * (RHBZ#1022431).
-   *)
-  let is_dir = try Sys.is_directory directory with Sys_error _ -> false in
-  if is_dir = false then (
-    mkdir directory 0o755
-  );
+  if not (is_directory directory) then
+    mkdir directory 0o755;
   {
     debug = debug;
     directory = directory;
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 3b15868..3726eec 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -451,3 +451,8 @@ let is_block_device file  let is_char_device file    try
(Unix.stat file).Unix.st_kind = Unix.S_CHR
   with Unix.Unix_error _ -> false
+
+(* Annoyingly Sys.is_directory throws an exception on failure
+ * (RHBZ#1022431).
+ *)
+let is_directory path = try Sys.is_directory path with Sys_error _ -> false
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 966fe42..52a4959 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -181,9 +181,7 @@ read the man page virt-v2v(1).
     | `Local ->
       if output_storage = "" then
         error (f_"-o local: output directory was not specified, use
'-os /dir'");
-      let dir_exists -        try Sys.is_directory output_storage with
Sys_error _ -> false in
-      if not dir_exists then
+      if not (is_directory output_storage) then
         error (f_"-os %s: output directory does not exist or is not a
directory")
           output_storage;
       OutputLocal output_storage
-- 
1.9.0

Add the virt-sparsify --tmp option.

This works in two ways.  Either you can specify a temporary directory,
in which case it's just the same as setting $TMPDIR before:

  virt-sparsify indisk outdisk --tmp /var/tmp

Or, as a new feature, you can specify a block device which is directly
used (and OVERWRITTEN):

  virt-sparsify indisk outdisk --tmp /dev/sdX

This is useful for oVirt nodes, where there is limited temporary
space, but a block device can be assigned to the node.

In both cases it is only used in copying mode.  In-place
sparsification doesn't require large amounts of temporary space.
---
 sparsify/cmdline.ml        | 12 +++++-
 sparsify/copying.ml        | 98 +++++++++++++++++++++++++++++-----------------
 sparsify/sparsify.ml       |  4 +-
 sparsify/virt-sparsify.pod | 23 ++++++++++-
 4 files changed, 95 insertions(+), 42 deletions(-)

diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index c96de57..01f66f1 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -27,7 +27,8 @@ let prog = Filename.basename Sys.executable_name
 let error ?exit_code fs = error ~prog ?exit_code fs
 
 type mode_t -| Mode_copying of string * check_t * bool * string option * string
option
+| Mode_copying of string * check_t * bool * string option * string option *
+    string option
 | Mode_in_place
 and check_t = [`Ignore|`Continue|`Warn|`Fail]
 
@@ -59,6 +60,7 @@ let parse_cmdline ()    let machine_readable = ref false in
   let option = ref "" in
   let quiet = ref false in
+  let tmp = ref "" in
   let verbose = ref false in
   let trace = ref false in
   let zeroes = ref [] in
@@ -78,6 +80,7 @@ let parse_cmdline ()      "-o",       
Arg.Set_string option,     s_"option" ^ " " ^ s_"Add
qemu-img options";
     "-q",        Arg.Set quiet,             " " ^
s_"Quiet output";
     "--quiet",   Arg.Set quiet,             ditto;
+    "--tmp",     Arg.Set_string tmp,        s_"block|dir" ^
" " ^ s_"Set temporary block device or directory";
     "-v",        Arg.Set verbose,           " " ^
s_"Enable debugging messages";
     "--verbose", Arg.Set verbose,           ditto;
     "-V",        Arg.Unit display_version,  " " ^
s_"Display version and exit";
@@ -113,6 +116,7 @@ read the man page virt-sparsify(1).
   let machine_readable = !machine_readable in
   let option = match !option with "" -> None | str -> Some str
in
   let quiet = !quiet in
+  let tmp = match !tmp with "" -> None | str -> Some str in
   let verbose = !verbose in
   let trace = !trace in
   let zeroes = List.rev !zeroes in
@@ -126,6 +130,7 @@ read the man page virt-sparsify(1).
     printf "zero\n";
     printf "check-tmpdir\n";
     printf "in-place\n";
+    printf "tmp-option\n";
     let g = new G.guestfs () in
     g#add_drive "/dev/null";
     g#launch ();
@@ -186,12 +191,15 @@ read the man page virt-sparsify(1).
       if option <> None then
         error (f_"you cannot use --in-place and -o options
together");
 
+      if tmp <> None then
+        error (f_"you cannot use --in-place and --tmp options
together");
+
       indisk
     ) in
 
   let mode      if not in_place then
-      Mode_copying (outdisk, check_tmpdir, compress, convert, option)
+      Mode_copying (outdisk, check_tmpdir, compress, convert, option, tmp)
     else
       Mode_in_place in
 
diff --git a/sparsify/copying.ml b/sparsify/copying.ml
index 5123bc2..5afb22f 100644
--- a/sparsify/copying.ml
+++ b/sparsify/copying.ml
@@ -33,8 +33,11 @@ open Cmdline
 external statvfs_free_space : string -> int64   
"virt_sparsify_statvfs_free_space"
 
+type tmp_place = Directory of string | Block_device of string
+
 let run indisk outdisk check_tmpdir compress convert
-    format ignores machine_readable option quiet verbose trace zeroes +   
format ignores machine_readable option tmp_param
+    quiet verbose trace zeroes  
   (* Once we have got past argument parsing and start to create
    * temporary files (including the potentially massive overlay file), we
@@ -65,20 +68,30 @@ let run indisk outdisk check_tmpdir compress convert
   if output_format = "raw" && compress then
     error (f_"--compress cannot be used for raw output.  Remove this
option or use --convert qcow2.");
 
-  (* Get virtual size of the input disk. *)
-  let virtual_size = (new G.guestfs ())#disk_virtual_size indisk in
-  if not quiet then
-    printf (f_"Input disk virtual size = %Ld bytes (%s)\n%!")
-      virtual_size (human_size virtual_size);
+  (* Use TMPDIR or --tmp parameter? *)
+  let tmp_place +    match tmp_param with
+    | None -> Directory Filename.temp_dir_name (* $TMPDIR or /tmp *)
+    | Some dir when is_directory dir -> Directory dir
+    | Some dev when is_block_device dev -> Block_device dev
+    | Some path ->
+      error (f_"--tmp parameter must point to a directory or a block
device") in
 
-  (* Check there is enough space in $TMPDIR. *)
-  let tmpdir = Filename.temp_dir_name in
+  (* Check there is enough space in temporary directory. *)
+  (match tmp_place with
+  | Block_device _ -> ()
+  | Directory tmpdir ->
+    (* Get virtual size of the input disk. *)
+    let virtual_size = (new G.guestfs ())#disk_virtual_size indisk in
+    if not quiet then
+      printf (f_"Input disk virtual size = %Ld bytes (%s)\n%!")
+        virtual_size (human_size virtual_size);
 
-  let print_warning () -    let free_space = statvfs_free_space tmpdir in
-    let extra_needed = virtual_size -^ free_space in
-    if extra_needed > 0L then (
-      eprintf (f_"\
+    let print_warning () +      let free_space = statvfs_free_space tmpdir in
+      let extra_needed = virtual_size -^ free_space in
+      if extra_needed > 0L then (
+        eprintf (f_"\
 
 WARNING: There may not be enough free space on %s.
 You may need to set TMPDIR to point to a directory with more free space.
@@ -92,34 +105,47 @@ You can ignore this warning or change it to a hard failure
using the
 --check-tmpdir=(ignore|continue|warn|fail) option.  See virt-sparsify(1).
 
 %!")
-        tmpdir (human_size virtual_size)
-        (human_size free_space) (human_size extra_needed);
-      true
-    ) else false
-  in
+          tmpdir (human_size virtual_size)
+          (human_size free_space) (human_size extra_needed);
+        true
+      ) else false
+    in
 
-  (match check_tmpdir with
-  | `Ignore -> ()
-  | `Continue -> ignore (print_warning ())
-  | `Warn ->
-    if print_warning () then (
-      eprintf "Press RETURN to continue or ^C to quit.\n%!";
-      ignore (read_line ())
-    );
-  | `Fail ->
-    if print_warning () then (
-      eprintf "Exiting because --check-tmpdir=fail was set.\n%!";
-      exit 2
-    )
+    match check_tmpdir with
+    | `Ignore -> ()
+    | `Continue -> ignore (print_warning ())
+    | `Warn ->
+      if print_warning () then (
+        eprintf "Press RETURN to continue or ^C to quit.\n%!";
+        ignore (read_line ())
+      );
+    | `Fail ->
+      if print_warning () then (
+        eprintf "Exiting because --check-tmpdir=fail was set.\n%!";
+        exit 2
+      )
   );
 
-  if not quiet then
-    printf (f_"Create overlay file in %s to protect source disk
...\n%!") tmpdir;
-
   (* Create the temporary overlay file. *)
   let overlaydisk -    let tmp = Filename.temp_file "sparsify"
".qcow2" in
-    unlink_on_exit tmp;
+    if not quiet then (
+      match tmp_place with
+      | Directory tmpdir ->
+        printf (f_"Create overlay file in %s to protect source disk
...\n%!")
+          tmpdir
+      | Block_device device ->
+        printf (f_"Create overlay device %s to protect source disk
...\n%!")
+          device
+    );
+
+    let tmp +      match tmp_place with
+      | Directory temp_dir ->
+        let tmp = Filename.temp_file ~temp_dir "sparsify"
".qcow2" in
+        unlink_on_exit tmp;
+        tmp
+
+      | Block_device device -> device in
 
     (* Create it with the indisk as the backing file. *)
     (* XXX Old code used to:
diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
index f148296..529a054 100644
--- a/sparsify/sparsify.ml
+++ b/sparsify/sparsify.ml
@@ -34,9 +34,9 @@ let rec main ()      parse_cmdline () in
 
   (match mode with
-  | Mode_copying (outdisk, check_tmpdir, compress, convert, option) ->
+  | Mode_copying (outdisk, check_tmpdir, compress, convert, option, tmp) ->
     Copying.run indisk outdisk check_tmpdir compress convert
-      format ignores machine_readable option quiet verbose trace zeroes
+      format ignores machine_readable option tmp quiet verbose trace zeroes
   | Mode_in_place ->
     In_place.run indisk format ignores machine_readable
       quiet verbose trace zeroes
diff --git a/sparsify/virt-sparsify.pod b/sparsify/virt-sparsify.pod
index 5573c95..3aac096 100644
--- a/sparsify/virt-sparsify.pod
+++ b/sparsify/virt-sparsify.pod
@@ -127,8 +127,8 @@ Display help.
 
 =item B<--check-tmpdir=fail>
 
-Check if L</TMPDIR> has enough space to complete the operation.  This
-is just an estimate.
+Check if L</TMPDIR> or I<--tmp> directory has enough space to
complete
+the operation.  This is just an estimate.
 
 If the check indicates a problem, then you can either:
 
@@ -246,6 +246,22 @@ You cannot use this option and I<--in-place>
together.
 
 This disables progress bars and other unnecessary output.
 
+=item B<--tmp> block_device
+
+=item B<--tmp> dir
+
+In copying mode only, use the named device, directory or filename as
+the location of the temporary overlay (see also L</TMPDIR> below).
+
+If the parameter given is a block device, then the block device is
+written to directly.
+B<Note this erases the existing contents of the block device>.
+
+If the parameter is a directory, then this is the same as setting the
+L</TMPDIR> environment variable.
+
+You cannot use this option and I<--in-place> together.
+
 =item B<-v>
 
 =item B<--verbose>
@@ -358,6 +374,9 @@ See L<guestfs(3)/WINDOWS HIBERNATION AND WINDOWS 8 FAST
STARTUP>.
 Location of the temporary directory used for the potentially large
 temporary overlay file.
 
+In virt-sparsify E<ge> 1.28, you can override this environment
+variable using the I<--tmp> option.
+
 You should ensure there is enough free space in the worst case for a
 full copy of the source disk (I<virtual> size), or else set
C<$TMPDIR>
 to point to another directory that has enough space.
-- 
1.9.0

On Friday 13 June 2014 13:49:35 Richard W.M. Jones
wrote:
> This is a wrapper around Sys.is_directory which doesn't throw
> exceptions.
> ---
>  builder/cache.ml      | 9 ++-------
>  mllib/common_utils.ml | 5 +++++
>  v2v/cmdline.ml        | 4 +---
>  3 files changed, 8 insertions(+), 10 deletions(-)
> 
> diff --git a/builder/cache.ml b/builder/cache.ml
> index 581b2cf..683cd35 100644
> --- a/builder/cache.ml
> +++ b/builder/cache.ml
> @@ -34,13 +34,8 @@ type t = {
>  }
> 
>  let create ~debug ~directory > -  (* Annoyingly Sys.is_directory throws
an exception on failure
> -   * (RHBZ#1022431).
> -   *)
> -  let is_dir = try Sys.is_directory directory with Sys_error _ -> false
in -  if is_dir = false then (
> -    mkdir directory 0o755
> -  );
> +  if not (is_directory directory) then
> +    mkdir directory 0o755;
>    {
>      debug = debug;
>      directory = directory;
> diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
> index 3b15868..3726eec 100644
> --- a/mllib/common_utils.ml
> +++ b/mllib/common_utils.ml
> @@ -451,3 +451,8 @@ let is_block_device file >  let is_char_device file
>    try (Unix.stat file).Unix.st_kind = Unix.S_CHR
>    with Unix.Unix_error _ -> false
> +
> +(* Annoyingly Sys.is_directory throws an exception on failure
> + * (RHBZ#1022431).
> + *)
> +let is_directory path = try Sys.is_directory path with Sys_error _ ->
false
I'd just reindent it like the other is_* functions right above this
one, mostly for readability.

In any case, LGTM.
> diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
> index 966fe42..52a4959 100644
> --- a/v2v/cmdline.ml
> +++ b/v2v/cmdline.ml
> @@ -181,9 +181,7 @@ read the man page virt-v2v(1).
> 
>      | `Local ->
> 
>        if output_storage = "" then
>          error (f_"-o local: output directory was not specified, use
'-os /dir'");
> -      let dir_exists > -        try Sys.is_directory output_storage
with Sys_error _ -> false in
> -      if not dir_exists then
> +      if not (is_directory output_storage) then
>          error (f_"-os %s: output directory does not exist or is not a
directory") output_storage;
>        OutputLocal output_storage
-- 
Pino Toscano