New tool: virt-sparsify to make disk images sparse.

[libguestfs.git] / sparsify / utils.ml

diff --git a/sparsify/utils.ml b/sparsify/utils.ml
new file mode 100644 (file)
index 0000000..4f5631d
--- /dev/null
+++ b/sparsify/utils.ml
@@ -0,0 +1,123 @@
+(* virt-sparsify
+ * 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.
+ *)
+
+(* XXX This was copied from virt-resize, and probably some of the
+   functions here are not used in virt-sparsify and could be
+   deleted. *)
+
+open Printf
+
+module G = Guestfs
+
+let (//) = Filename.concat
+
+let ( +^ ) = Int64.add
+let ( -^ ) = Int64.sub
+let ( *^ ) = Int64.mul
+let ( /^ ) = Int64.div
+let ( &^ ) = Int64.logand
+let ( ~^ ) = Int64.lognot
+
+let output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
+
+let wrap ?(chan = stdout) ?(hanging = 0) str =
+  let rec _wrap col str =
+    let n = String.length str in
+    let i = try String.index str ' ' with Not_found -> n in
+    let col =
+      if col+i >= 72 then (
+        output_char chan '\n';
+        output_spaces chan hanging;
+        i+hanging+1
+      ) else col+i+1 in
+    output_string chan (String.sub str 0 i);
+    if i < n then (
+      output_char chan ' ';
+      _wrap col (String.sub str (i+1) (n-(i+1)))
+    )
+  in
+  _wrap 0 str
+
+let string_prefix str prefix =
+  let n = String.length prefix in
+  String.length str >= n && String.sub str 0 n = prefix
+
+let string_random8 =
+  let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in
+  fun () ->
+    String.concat "" (
+      List.map (
+        fun _ ->
+          let c = Random.int 36 in
+          let c = chars.[c] in
+          String.make 1 c
+      ) [1;2;3;4;5;6;7;8]
+    )
+
+let error fs =
+  let display str =
+    wrap ~chan:stderr ("virt-sparsify: error: " ^ str);
+    prerr_newline ();
+    prerr_newline ();
+    wrap ~chan:stderr
+      "If reporting bugs, run virt-sparsify with the '-v' and '-x' options and include the complete output.";
+    prerr_newline ();
+    exit 1
+  in
+  ksprintf display fs
+
+(* The reverse of device name translation, see
+ * BLOCK DEVICE NAMING in guestfs(3).
+ *)
+let canonicalize dev =
+  if String.length dev >= 8 &&
+    dev.[0] = '/' && dev.[1] = 'd' && dev.[2] = 'e' && dev.[3] = 'v' &&
+    dev.[4] = '/' && (dev.[5] = 'h' || dev.[5] = 'v') && dev.[6] = 'd' then (
+      let dev = String.copy dev in
+      dev.[5] <- 's';
+      dev
+    )
+  else
+    dev
+
+let feature_available (g : Guestfs.guestfs) names =
+  try g#available names; true
+  with G.Error _ -> false
+
+let human_size i =
+  let sign, i = if i < 0L then "-", Int64.neg i else "", i in
+
+  if i < 1024L then
+    sprintf "%s%Ld" sign i
+  else (
+    let f = Int64.to_float i /. 1024. in
+    let i = i /^ 1024L in
+    if i < 1024L then
+      sprintf "%s%.1fK" sign f
+    else (
+      let f = Int64.to_float i /. 1024. in
+      let i = i /^ 1024L in
+      if i < 1024L then
+        sprintf "%s%.1fM" sign f
+      else (
+        let f = Int64.to_float i /. 1024. in
+        (*let i = i /^ 1024L in*)
+        sprintf "%s%.1fG" sign f
+      )
+    )
+  )