New tool: virt-sparsify to make disk images sparse.
[libguestfs.git] / sparsify / utils.ml
1 (* virt-sparsify
2  * Copyright (C) 2010-2011 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License along
15  * with this program; if not, write to the Free Software Foundation, Inc.,
16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17  *)
18
19 (* XXX This was copied from virt-resize, and probably some of the
20    functions here are not used in virt-sparsify and could be
21    deleted. *)
22
23 open Printf
24
25 module G = Guestfs
26
27 let (//) = Filename.concat
28
29 let ( +^ ) = Int64.add
30 let ( -^ ) = Int64.sub
31 let ( *^ ) = Int64.mul
32 let ( /^ ) = Int64.div
33 let ( &^ ) = Int64.logand
34 let ( ~^ ) = Int64.lognot
35
36 let output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
37
38 let wrap ?(chan = stdout) ?(hanging = 0) str =
39   let rec _wrap col str =
40     let n = String.length str in
41     let i = try String.index str ' ' with Not_found -> n in
42     let col =
43       if col+i >= 72 then (
44         output_char chan '\n';
45         output_spaces chan hanging;
46         i+hanging+1
47       ) else col+i+1 in
48     output_string chan (String.sub str 0 i);
49     if i < n then (
50       output_char chan ' ';
51       _wrap col (String.sub str (i+1) (n-(i+1)))
52     )
53   in
54   _wrap 0 str
55
56 let string_prefix str prefix =
57   let n = String.length prefix in
58   String.length str >= n && String.sub str 0 n = prefix
59
60 let string_random8 =
61   let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in
62   fun () ->
63     String.concat "" (
64       List.map (
65         fun _ ->
66           let c = Random.int 36 in
67           let c = chars.[c] in
68           String.make 1 c
69       ) [1;2;3;4;5;6;7;8]
70     )
71
72 let error fs =
73   let display str =
74     wrap ~chan:stderr ("virt-sparsify: error: " ^ str);
75     prerr_newline ();
76     prerr_newline ();
77     wrap ~chan:stderr
78       "If reporting bugs, run virt-sparsify with the '-v' and '-x' options and include the complete output.";
79     prerr_newline ();
80     exit 1
81   in
82   ksprintf display fs
83
84 (* The reverse of device name translation, see
85  * BLOCK DEVICE NAMING in guestfs(3).
86  *)
87 let canonicalize dev =
88   if String.length dev >= 8 &&
89     dev.[0] = '/' && dev.[1] = 'd' && dev.[2] = 'e' && dev.[3] = 'v' &&
90     dev.[4] = '/' && (dev.[5] = 'h' || dev.[5] = 'v') && dev.[6] = 'd' then (
91       let dev = String.copy dev in
92       dev.[5] <- 's';
93       dev
94     )
95   else
96     dev
97
98 let feature_available (g : Guestfs.guestfs) names =
99   try g#available names; true
100   with G.Error _ -> false
101
102 let human_size i =
103   let sign, i = if i < 0L then "-", Int64.neg i else "", i in
104
105   if i < 1024L then
106     sprintf "%s%Ld" sign i
107   else (
108     let f = Int64.to_float i /. 1024. in
109     let i = i /^ 1024L in
110     if i < 1024L then
111       sprintf "%s%.1fK" sign f
112     else (
113       let f = Int64.to_float i /. 1024. in
114       let i = i /^ 1024L in
115       if i < 1024L then
116         sprintf "%s%.1fM" sign f
117       else (
118         let f = Int64.to_float i /. 1024. in
119         (*let i = i /^ 1024L in*)
120         sprintf "%s%.1fG" sign f
121       )
122     )
123   )