Rewrite virt-resize in OCaml.

This is a fairly straightforward translation of Perl virt-resize into
OCaml.  It is bug-for-bug and feature-for-feature identical to the
Perl version, except as noted below.

The motivation is to have a more solid, high-level, statically safe
compiled language to go forwards with fixing some of the harder bugs
in virt-resize.  In particular contracts between different parts of
the program are now handled by statically typed structures checked at
compile time, instead of the very ad-hoc unchecked hash tables used by
the Perl version.

OCaml and the ocaml-pcre library (Perl-Compatible Regular Expressions
bindings for OCaml) are required.

Extra features in this version:

- 32 bit hosts are now supported.

- We try hard to handle the case where the target disk is not "clean"
  (ie. all zeroes).  It usually works for this case, whereas the
  previous version would usually fail.  However it is still
  recommended that the system administrator creates a fresh blank disk
  for the target before running the program.

- User messages are a bit more verbose and helpful.  You can turn
  these off with the -q (--quiet) option.

There is one lost feature:

- Ability to specify >= T (terabytes) sizes in command line size
  expressions has been removed.  This probably didn't work in the Perl
  version.

Other differences:

- The first partition on the target is no longer aligned; instead we
  place it at the same sector as on the source.  I suspect that
  aligning it was causing the bootloader failures.

- Because it's easier, we do more sanity checking on the source disk.
  This might lead to more failures, but they'd be failures you'd want
  to know about.

- The order in which operations are performed has been changed to make
  it more logical.  The user should not notice any functional
  difference, but debug messages will be quite a bit different.

- virt-resize is a compiled binary, not a script.

1 files changed, 49 insertions, 0 deletions

diff --git a/resize/progress.ml b/resize/progress.ml
new file mode 100644
index 00000000..a4eff0fe
--- /dev/null
+++ b/resize/progress.ml
@@ -0,0 +1,49 @@
+(* virt-resize
+ * Copyright (C) 2010-2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+open Utils
+
+module G = Guestfs
+
+let set_up_progress_bar (g : Guestfs.guestfs) =
+  let progress_callback g event evh buf array =
+    if event = G.EVENT_PROGRESS && Array.length array >= 4 then (
+      (*let proc_nr = array.(0)
+      and serial = array.(1)*)
+      let position = array.(2)
+      and total = array.(3) in
+
+      let ratio =
+        if total <> 0L then Int64.to_float position /. Int64.to_float total
+        else 0. in
+      let ratio =
+        if ratio < 0. then 0. else if ratio > 1. then 1. else ratio in
+
+      let dots = int_of_float (ratio *. 72.) in
+
+      print_string "[";
+      for i = 0 to dots-1 do print_char '#' done;
+      for i = dots to 71 do print_char '-' done;
+      print_string "]\r";
+      if ratio = 1. then print_string "\n";
+      flush stdout
+    )
+  in
+  ignore (g#set_event_callback progress_callback [G.EVENT_PROGRESS])