resize/utils.ml

   1 (* virt-resize
   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 open Printf
  20
  21 module G = Guestfs
  22
  23 let ( +^ ) = Int64.add
  24 let ( -^ ) = Int64.sub
  25 let ( *^ ) = Int64.mul
  26 let ( /^ ) = Int64.div
  27 let ( &^ ) = Int64.logand
  28 let ( ~^ ) = Int64.lognot
  29
  30 let output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
  31
  32 let wrap ?(chan = stdout) ?(hanging = 0) str =
  33   let rec _wrap col str =
  34     let n = String.length str in
  35     let i = try String.index str ' ' with Not_found -> n in
  36     let col =
  37       if col+i >= 72 then (
  38         output_char chan '\n';
  39         output_spaces chan hanging;
  40         i+hanging+1
  41       ) else col+i+1 in
  42     output_string chan (String.sub str 0 i);
  43     if i < n then (
  44       output_char chan ' ';
  45       _wrap col (String.sub str (i+1) (n-(i+1)))
  46     )
  47   in
  48   _wrap 0 str
  49
  50 let error fs =
  51   let display str =
  52     wrap ~chan:stderr ("virt-resize: error: " ^ str);
  53     prerr_newline ();
  54     prerr_newline ();
  55     wrap ~chan:stderr
  56       "If reporting bugs, run virt-resize with the '-d' option and include the complete output.";
  57     prerr_newline ();
  58     exit 1
  59   in
  60   ksprintf display fs
  61
  62 (* The reverse of device name translation, see
  63  * BLOCK DEVICE NAMING in guestfs(3).
  64  *)
  65 let canonicalize dev =
  66   if String.length dev >= 8 &&
  67     dev.[0] = '/' && dev.[1] = 'd' && dev.[2] = 'e' && dev.[3] = 'v' &&
  68     dev.[4] = '/' && (dev.[5] = 'h' || dev.[5] = 'v') && dev.[6] = 'd' then (
  69       let dev = String.copy dev in
  70       dev.[5] <- 's';
  71       dev
  72     )
  73   else
  74     dev
  75
  76 let feature_available (g : Guestfs.guestfs) names =
  77   try g#available names; true
  78   with G.Error _ -> false
  79
  80 (* Parse the size field from --resize and --resize-force options. *)
  81 let parse_size =
  82   let const_re = Pcre.regexp "^([.\\d]+)([bKMG])$"
  83   and plus_const_re = Pcre.regexp "^\\+([.\\d]+)([bKMG])$"
  84   and minus_const_re = Pcre.regexp "^-([.\\d]+)([bKMG])$"
  85   and percent_re = Pcre.regexp "^([.\\d]+)%$"
  86   and plus_percent_re = Pcre.regexp "^\\+([.\\d]+)%$"
  87   and minus_percent_re = Pcre.regexp "^-([.\\d]+)%$"
  88   in
  89   fun oldsize field ->
  90     let subs = ref None in
  91     let matches rex =
  92       try subs := Some (Pcre.exec ~rex field); true
  93       with Not_found -> false
  94     in
  95     let sub i =
  96       match !subs with None -> assert false
  97       | Some subs -> Pcre.get_substring subs i
  98     in
  99     let size_scaled f = function
 100       | "b" -> Int64.of_float f
 101       | "K" -> Int64.of_float (f *. 1024.)
 102       | "M" -> Int64.of_float (f *. 1024. *. 1024.)
 103       | "G" -> Int64.of_float (f *. 1024. *. 1024. *. 1024.)
 104       | _ -> assert false
 105     in
 106
 107     if matches const_re then (
 108       size_scaled (float_of_string (sub 1)) (sub 2)
 109     )
 110     else if matches plus_const_re then (
 111       let incr = size_scaled (float_of_string (sub 1)) (sub 2) in
 112       oldsize +^ incr
 113     )
 114     else if matches minus_const_re then (
 115       let incr = size_scaled (float_of_string (sub 1)) (sub 2) in
 116       oldsize -^ incr
 117     )
 118     else if matches percent_re then (
 119       let percent = Int64.of_float (10. *. float_of_string (sub 1)) in
 120       oldsize *^ percent /^ 1000L
 121     )
 122     else if matches plus_percent_re then (
 123       let percent = Int64.of_float (10. *. float_of_string (sub 1)) in
 124       oldsize +^ oldsize *^ percent /^ 1000L
 125     )
 126     else if matches minus_percent_re then (
 127       let percent = Int64.of_float (10. *. float_of_string (sub 1)) in
 128       oldsize -^ oldsize *^ percent /^ 1000L
 129     )
 130     else
 131       error "virt-resize: %s: cannot parse size field" field
 132
 133 let human_size i =
 134   let sign, i = if i < 0L then "-", Int64.neg i else "", i in
 135
 136   if i < 1024L then
 137     sprintf "%s%Ld" sign i
 138   else (
 139     let f = Int64.to_float i /. 1024. in
 140     let i = i /^ 1024L in
 141     if i < 1024L then
 142       sprintf "%s%.1fK" sign f
 143     else (
 144       let f = Int64.to_float i /. 1024. in
 145       let i = i /^ 1024L in
 146       if i < 1024L then
 147         sprintf "%s%.1fM" sign f
 148       else (
 149         let f = Int64.to_float i /. 1024. in
 150         (*let i = i /^ 1024L in*)
 151         sprintf "%s%.1fG" sign f
 152       )
 153     )
 154   )