resize: Add --alignment flag to allow partition alignment to be picked.
[libguestfs.git] / resize / resize.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 open Utils
24
25 (* Minimum surplus before we create an extra partition. *)
26 let min_extra_partition = 10L *^ 1024L *^ 1024L
27
28 (* Command line argument parsing. *)
29 let prog = Filename.basename Sys.executable_name
30
31 let infile, outfile, alignment, copy_boot_loader, debug, deletes, dryrun,
32   expand, expand_content, extra_partition, format, ignores,
33   lv_expands, machine_readable, ntfsresize_force, output_format,
34   quiet, resizes, resizes_force, shrink =
35   let display_version () =
36     let g = new G.guestfs () in
37     let version = g#version () in
38     printf "virt-resize %Ld.%Ld.%Ld%s\n"
39       version.G.major version.G.minor version.G.release version.G.extra;
40     exit 0
41   in
42
43   let add xs s = xs := s :: !xs in
44
45   let alignment = ref 128 in
46   let copy_boot_loader = ref true in
47   let debug = ref false in
48   let deletes = ref [] in
49   let dryrun = ref false in
50   let expand = ref "" in
51   let set_expand s =
52     if s = "" then error "%s: empty --expand option" prog
53     else if !expand <> "" then error "--expand option given twice"
54     else expand := s
55   in
56   let expand_content = ref true in
57   let extra_partition = ref true in
58   let format = ref "" in
59   let ignores = ref [] in
60   let lv_expands = ref [] in
61   let machine_readable = ref false in
62   let ntfsresize_force = ref false in
63   let output_format = ref "" in
64   let quiet = ref false in
65   let resizes = ref [] in
66   let resizes_force = ref [] in
67   let shrink = ref "" in
68   let set_shrink s =
69     if s = "" then error "empty --shrink option"
70     else if !shrink <> "" then error "--shrink option given twice"
71     else shrink := s
72   in
73
74   let argspec = Arg.align [
75     "--alignment", Arg.Set_int alignment,   "sectors Set partition alignment (default: 128 sectors)";
76     "--no-copy-boot-loader", Arg.Clear copy_boot_loader, " Don't copy boot loader";
77     "-d",        Arg.Set debug,             " Enable debugging messages";
78     "--debug",   Arg.Set debug,             " -\"-";
79     "--delete",  Arg.String (add deletes),  "part Delete partition";
80     "--expand",  Arg.String set_expand,     "part Expand partition";
81     "--no-expand-content", Arg.Clear expand_content, " Don't expand content";
82     "--no-extra-partition", Arg.Clear extra_partition, " Don't create extra partition";
83     "--format",  Arg.Set_string format,     "format Format of input disk";
84     "--ignore",  Arg.String (add ignores),  "part Ignore partition";
85     "--lv-expand", Arg.String (add lv_expands), "lv Expand logical volume";
86     "--LV-expand", Arg.String (add lv_expands), "lv -\"-";
87     "--lvexpand", Arg.String (add lv_expands), "lv -\"-";
88     "--LVexpand", Arg.String (add lv_expands), "lv -\"-";
89     "--machine-readable", Arg.Set machine_readable, " Make output machine readable";
90     "-n",        Arg.Set dryrun,            " Don't perform changes";
91     "--dryrun",  Arg.Set dryrun,            " -\"-";
92     "--dry-run", Arg.Set dryrun,            " -\"-";
93     "--ntfsresize-force", Arg.Set ntfsresize_force, " Force ntfsresize";
94     "--output-format", Arg.Set_string format, "format Format of output disk";
95     "-q",        Arg.Set quiet,             " Don't print the summary";
96     "--quiet",   Arg.Set quiet,             " -\"-";
97     "--resize",  Arg.String (add resizes),  "part=size Resize partition";
98     "--resize-force", Arg.String (add resizes_force), "part=size Forcefully resize partition";
99     "--shrink",  Arg.String set_shrink,     "part Shrink partition";
100     "-V",        Arg.Unit display_version,  " Display version and exit";
101     "--version", Arg.Unit display_version,  " -\"-";
102   ] in
103   let disks = ref [] in
104   let anon_fun s = disks := s :: !disks in
105   let usage_msg =
106     sprintf "\
107 %s: resize a virtual machine disk
108
109 A short summary of the options is given below.  For detailed help please
110 read the man page virt-resize(1).
111 "
112       prog in
113   Arg.parse argspec anon_fun usage_msg;
114
115   let debug = !debug in
116   if debug then (
117     eprintf "command line:";
118     List.iter (eprintf " %s") (Array.to_list Sys.argv);
119     prerr_newline ()
120   );
121
122   (* Dereference the rest of the args. *)
123   let alignment = !alignment in
124   let copy_boot_loader = !copy_boot_loader in
125   let deletes = List.rev !deletes in
126   let dryrun = !dryrun in
127   let expand = match !expand with "" -> None | str -> Some str in
128   let expand_content = !expand_content in
129   let extra_partition = !extra_partition in
130   let format = match !format with "" -> None | str -> Some str in
131   let ignores = List.rev !ignores in
132   let lv_expands = List.rev !lv_expands in
133   let machine_readable = !machine_readable in
134   let ntfsresize_force = !ntfsresize_force in
135   let output_format = match !output_format with "" -> None | str -> Some str in
136   let quiet = !quiet in
137   let resizes = List.rev !resizes in
138   let resizes_force = List.rev !resizes_force in
139   let shrink = match !shrink with "" -> None | str -> Some str in
140
141   if alignment < 1 then
142     error "alignment cannot be < 1";
143   let alignment = Int64.of_int alignment in
144
145   (* No arguments and machine-readable mode?  Print out some facts
146    * about what this binary supports.  We only need to print out new
147    * things added since this option, or things which depend on features
148    * of the appliance.
149    *)
150   if !disks = [] && machine_readable then (
151     printf "virt-resize\n";
152     printf "ntfsresize-force\n";
153     printf "32bitok\n";
154     printf "128-sector-alignment\n";
155     printf "alignment\n";
156     let g = new G.guestfs () in
157     g#add_drive_opts "/dev/null";
158     g#launch ();
159     if feature_available g [| "ntfsprogs"; "ntfs3g" |] then
160       printf "ntfs\n";
161     if feature_available g [| "btrfs" |] then
162       printf "btrfs\n";
163     exit 0
164   );
165
166   (* Verify we got exactly 2 disks. *)
167   let infile, outfile =
168     match List.rev !disks with
169     | [infile; outfile] -> infile, outfile
170     | _ ->
171         error "usage is: %s [--options] indisk outdisk" prog in
172
173   infile, outfile, alignment, copy_boot_loader, debug, deletes, dryrun,
174   expand, expand_content, extra_partition, format, ignores,
175   lv_expands, machine_readable, ntfsresize_force, output_format,
176   quiet, resizes, resizes_force, shrink
177
178 (* Default to true, since NTFS and btrfs support are usually available. *)
179 let ntfs_available = ref true
180 let btrfs_available = ref true
181
182 (* Add in and out disks to the handle and launch. *)
183 let connect_both_disks () =
184   let g = new G.guestfs () in
185   if debug then g#set_trace true;
186   g#add_drive_opts ?format ~readonly:true infile;
187   g#add_drive_opts ?format:output_format ~readonly:false outfile;
188   if not quiet then Progress.set_up_progress_bar ~machine_readable g;
189   g#launch ();
190
191   (* Set the filter to /dev/sda, in case there are any rogue
192    * PVs lying around on the target disk.
193    *)
194   g#lvm_set_filter [|"/dev/sda"|];
195
196   (* Update features available in the daemon. *)
197   ntfs_available := feature_available g [|"ntfsprogs"; "ntfs3g"|];
198   btrfs_available := feature_available g [|"btrfs"|];
199
200   g
201
202 let g =
203   if not quiet then
204     printf "Examining %s ...\n%!" infile;
205
206   let g = connect_both_disks () in
207
208   g
209
210 (* Get the size in bytes of each disk.
211  *
212  * Originally we computed this by looking at the same of the host file,
213  * but of course this failed for qcow2 images (RHBZ#633096).  The right
214  * way to do it is with g#blockdev_getsize64.
215  *)
216 let sectsize, insize, outsize =
217   let sectsize = g#blockdev_getss "/dev/sdb" in
218   let insize = g#blockdev_getsize64 "/dev/sda" in
219   let outsize = g#blockdev_getsize64 "/dev/sdb" in
220   if debug then (
221     eprintf "%s size %Ld bytes\n" infile insize;
222     eprintf "%s size %Ld bytes\n" outfile outsize
223   );
224   sectsize, insize, outsize
225
226 let max_bootloader =
227   (* In reality the number of sectors containing boot loader data will be
228    * less than this (although Windows 7 defaults to putting the first
229    * partition on sector 2048, and has quite a large boot loader).
230    *
231    * However make this large enough to be sure that we have copied over
232    * the boot loader.  We could also do this by looking for the sector
233    * offset of the first partition.
234    *
235    * It doesn't matter if we copy too much.
236    *)
237   4096 * 512
238
239 (* Check the disks are at least as big as the bootloader. *)
240 let () =
241   if insize < Int64.of_int max_bootloader then
242     error "%s: file is too small to be a disk image (%Ld bytes)"
243       infile insize;
244   if outsize < Int64.of_int max_bootloader then
245     error "%s: file is too small to be a disk image (%Ld bytes)"
246       outfile outsize
247
248 (* Build a data structure describing the source disk's partition layout. *)
249 type partition = {
250   p_name : string;               (* Device name, like /dev/sda1. *)
251   p_part : G.partition;          (* SOURCE partition data from libguestfs. *)
252   p_bootable : bool;             (* Is it bootable? *)
253   p_mbr_id : int option;         (* MBR ID, if it has one. *)
254   p_type : partition_content;    (* Content type and content size. *)
255
256   (* What we're going to do: *)
257   mutable p_operation : partition_operation;
258   p_target_partnum : int;        (* TARGET partition number. *)
259   p_target_start : int64;        (* TARGET partition start (sector num). *)
260   p_target_end : int64;          (* TARGET partition end (sector num). *)
261 }
262 and partition_content =
263   | ContentUnknown               (* undetermined *)
264   | ContentPV of int64           (* physical volume (size of PV) *)
265   | ContentFS of string * int64  (* mountable filesystem (FS type, FS size) *)
266 and partition_operation =
267   | OpCopy                       (* copy it as-is, no resizing *)
268   | OpIgnore                     (* ignore it (create on target, but don't
269                                     copy any content) *)
270   | OpDelete                     (* delete it *)
271   | OpResize of int64            (* resize it to the new size *)
272
273 let rec debug_partition p =
274   eprintf "%s:\n" p.p_name;
275   eprintf "\tpartition data: %ld %Ld-%Ld (%Ld bytes)\n"
276     p.p_part.G.part_num p.p_part.G.part_start p.p_part.G.part_end
277     p.p_part.G.part_size;
278   eprintf "\tbootable: %b\n" p.p_bootable;
279   eprintf "\tpartition ID: %s\n"
280     (match p.p_mbr_id with None -> "(none)" | Some i -> sprintf "0x%x" i);
281   eprintf "\tcontent: %s\n" (string_of_partition_content p.p_type)
282 and string_of_partition_content = function
283   | ContentUnknown -> "unknown data"
284   | ContentPV sz -> sprintf "LVM PV (%Ld bytes)" sz
285   | ContentFS (fs, sz) -> sprintf "filesystem %s (%Ld bytes)" fs sz
286 and string_of_partition_content_no_size = function
287   | ContentUnknown -> "unknown data"
288   | ContentPV _ -> sprintf "LVM PV"
289   | ContentFS (fs, _) -> sprintf "filesystem %s" fs
290
291 let get_partition_content =
292   let pvs_full = Array.to_list (g#pvs_full ()) in
293   fun dev ->
294     try
295       let fs = g#vfs_type dev in
296       if fs = "unknown" then
297         ContentUnknown
298       else if fs = "LVM2_member" then (
299         let rec loop = function
300           | [] ->
301               error "%s: physical volume not returned by pvs_full"
302                 dev
303           | pv :: _ when canonicalize pv.G.pv_name = dev ->
304               ContentPV pv.G.pv_size
305           | _ :: pvs -> loop pvs
306         in
307         loop pvs_full
308       )
309       else (
310         g#mount_ro dev "/";
311         let stat = g#statvfs "/" in
312         let size = stat.G.bsize *^ stat.G.blocks in
313         ContentFS (fs, size)
314       )
315     with
316       G.Error _ -> ContentUnknown
317
318 let partitions : partition list =
319   let parts = Array.to_list (g#part_list "/dev/sda") in
320
321   if List.length parts = 0 then
322     error "the source disk has no partitions";
323
324   let partitions =
325     List.map (
326       fun ({ G.part_num = part_num } as part) ->
327         let part_num = Int32.to_int part_num in
328         let name = sprintf "/dev/sda%d" part_num in
329         let bootable = g#part_get_bootable "/dev/sda" part_num in
330         let mbr_id =
331           try Some (g#part_get_mbr_id "/dev/sda" part_num)
332           with G.Error _ -> None in
333         let typ = get_partition_content name in
334
335         { p_name = name; p_part = part;
336           p_bootable = bootable; p_mbr_id = mbr_id; p_type = typ;
337           p_operation = OpCopy; p_target_partnum = 0;
338           p_target_start = 0L; p_target_end = 0L }
339     ) parts in
340
341   if debug then (
342     eprintf "%d partitions found\n" (List.length partitions);
343     List.iter debug_partition partitions
344   );
345
346   (* Check content isn't larger than partitions.  If it is then
347    * something has gone wrong and we shouldn't continue.  Old
348    * virt-resize didn't do these checks.
349    *)
350   List.iter (
351     function
352     | { p_name = name; p_part = { G.part_size = size };
353         p_type = ContentPV pv_size }
354         when size < pv_size ->
355         error "%s: partition size %Ld < physical volume size %Ld"
356           name size pv_size
357     | { p_name = name; p_part = { G.part_size = size };
358         p_type = ContentFS (_, fs_size) }
359         when size < fs_size ->
360         error "%s: partition size %Ld < filesystem size %Ld"
361           name size fs_size
362     | _ -> ()
363   ) partitions;
364
365   (* Check partitions don't overlap. *)
366   let rec loop end_of_prev = function
367     | [] -> ()
368     | { p_name = name; p_part = { G.part_start = part_start } } :: _
369         when end_of_prev > part_start ->
370         error "%s: this partition overlaps the previous one" name
371     | { p_part = { G.part_end = part_end } } :: parts -> loop part_end parts
372   in
373   loop 0L partitions;
374
375   partitions
376
377 (* Build a data structure describing LVs on the source disk.
378  * This is only used if the user gave the --lv-expand option.
379  *)
380 type logvol = {
381   lv_name : string;
382   lv_type : logvol_content;
383   mutable lv_operation : logvol_operation
384 }
385 and logvol_content = partition_content (* except ContentPV cannot occur *)
386 and logvol_operation =
387   | LVOpNone                     (* nothing *)
388   | LVOpExpand                   (* expand it *)
389
390 let debug_logvol lv =
391   eprintf "%s:\n" lv.lv_name;
392   eprintf "\tcontent: %s\n" (string_of_partition_content lv.lv_type)
393
394 let lvs =
395   let lvs = Array.to_list (g#lvs ()) in
396
397   let lvs = List.map (
398     fun name ->
399       let typ = get_partition_content name in
400       assert (match typ with ContentPV _ -> false | _ -> true);
401
402       { lv_name = name; lv_type = typ; lv_operation = LVOpNone }
403   ) lvs in
404
405   if debug then (
406     eprintf "%d logical volumes found\n" (List.length lvs);
407     List.iter debug_logvol lvs
408   );
409
410   lvs
411
412 (* These functions tell us if we know how to expand the content of
413  * a particular partition or LV, and what method to use.
414  *)
415 type expand_content_method =
416   | PVResize | Resize2fs | NTFSResize | BtrfsFilesystemResize
417
418 let string_of_expand_content_method = function
419   | PVResize -> "pvresize"
420   | Resize2fs -> "resize2fs"
421   | NTFSResize -> "ntfsresize"
422   | BtrfsFilesystemResize -> "btrfs-filesystem-resize"
423
424 let can_expand_content =
425   if expand_content then
426     function
427     | ContentUnknown -> false
428     | ContentPV _ -> true
429     | ContentFS (("ext2"|"ext3"|"ext4"), _) -> true
430     | ContentFS (("ntfs"), _) when !ntfs_available -> true
431     | ContentFS (("btrfs"), _) when !btrfs_available -> true
432     | ContentFS (_, _) -> false
433   else
434     fun _ -> false
435
436 let expand_content_method =
437   if expand_content then
438     function
439     | ContentUnknown -> assert false
440     | ContentPV _ -> PVResize
441     | ContentFS (("ext2"|"ext3"|"ext4"), _) -> Resize2fs
442     | ContentFS (("ntfs"), _) when !ntfs_available -> NTFSResize
443     | ContentFS (("btrfs"), _) when !btrfs_available -> BtrfsFilesystemResize
444     | ContentFS (_, _) -> assert false
445   else
446     fun _ -> assert false
447
448 (* Helper function to locate a partition given what the user might
449  * type on the command line.  It also gives errors for partitions
450  * that the user has asked to be ignored or deleted.
451  *)
452 let find_partition =
453   let hash = Hashtbl.create 13 in
454   List.iter (fun ({ p_name = name } as p) -> Hashtbl.add hash name p)
455     partitions;
456   fun ~option name ->
457     let name =
458       if String.length name < 5 || String.sub name 0 5 <> "/dev/" then
459         "/dev/" ^ name
460       else
461         name in
462     let name = canonicalize name in
463
464     let partition =
465       try Hashtbl.find hash name
466       with Not_found ->
467         error "%s: partition not found in the source disk image (this error came from '%s' option on the command line).  Try running this command: virt-filesystems --partitions --long -a %s"
468           name option infile in
469
470     if partition.p_operation = OpIgnore then
471       error "%s: partition already ignored, you cannot use it in '%s' option"
472         name option;
473
474     if partition.p_operation = OpDelete then
475       error "%s: partition already deleted, you cannot use it in '%s' option"
476         name option;
477
478     partition
479
480 (* Handle --ignore option. *)
481 let () =
482   List.iter (
483     fun dev ->
484       let p = find_partition ~option:"--ignore" dev in
485       p.p_operation <- OpIgnore
486   ) ignores
487
488 (* Handle --delete option. *)
489 let () =
490   List.iter (
491     fun dev ->
492       let p = find_partition ~option:"--delete" dev in
493       p.p_operation <- OpDelete
494   ) deletes
495
496 (* Helper function to mark a partition for resizing.  It prevents the
497  * user from trying to mark the same partition twice.  If the force
498  * flag is given, then we will allow the user to shrink the partition
499  * even if we think that would destroy the content.
500  *)
501 let mark_partition_for_resize ~option ?(force = false) p newsize =
502   let name = p.p_name in
503   let oldsize = p.p_part.G.part_size in
504
505   (match p.p_operation with
506    | OpResize _ ->
507        error "%s: this partition has already been marked for resizing"
508          name
509    | OpIgnore | OpDelete ->
510        (* This error should have been caught already by find_partition ... *)
511        error "%s: this partition has already been ignored or deleted"
512          name
513    | OpCopy -> ()
514   );
515
516   (* Only do something if the size will change. *)
517   if oldsize <> newsize then (
518     let bigger = newsize > oldsize in
519
520     if not bigger && not force then (
521       (* Check if this contains filesystem content, and how big that is
522        * and whether we will destroy any content by shrinking this.
523        *)
524       match p.p_type with
525       | ContentUnknown ->
526           error "%s: This partition has unknown content which might be damaged by shrinking it.  If you want to shrink this partition, you need to use the '--resize-force' option, but that could destroy any data on this partition.  (This error came from '%s' option on the command line.)"
527             name option
528       | ContentPV size when size > newsize ->
529           error "%s: This partition has contains an LVM physical volume which will be damaged by shrinking it below %Ld bytes (user asked to shrink it to %Ld bytes).  If you want to shrink this partition, you need to use the '--resize-force' option, but that could destroy any data on this partition.  (This error came from '%s' option on the command line.)"
530             name size newsize option
531       | ContentPV _ -> ()
532       | ContentFS (fstype, size) when size > newsize ->
533           error "%s: This partition has contains a %s filesystem which will be damaged by shrinking it below %Ld bytes (user asked to shrink it to %Ld bytes).  If you want to shrink this partition, you need to use the '--resize-force' option, but that could destroy any data on this partition.  (This error came from '%s' option on the command line.)"
534             name fstype size newsize option
535       | ContentFS _ -> ()
536     );
537
538     p.p_operation <- OpResize newsize
539   )
540
541 (* Handle --resize and --resize-force options. *)
542 let () =
543   let do_resize ~option ?(force = false) arg =
544     (* Argument is "dev=size". *)
545     let dev, sizefield =
546       try
547         let i = String.index arg '=' in
548         let n = String.length arg - (i+1) in
549         if n == 0 then raise Not_found;
550         String.sub arg 0 i, String.sub arg (i+1) n
551       with Not_found ->
552         error "%s: missing size field in '%s' option" arg option in
553
554     let p = find_partition ~option dev in
555
556     (* Parse the size field. *)
557     let oldsize = p.p_part.G.part_size in
558     let newsize = parse_size oldsize sizefield in
559
560     if newsize <= 0L then
561       error "%s: new partition size is zero or negative" dev;
562
563     mark_partition_for_resize ~option ~force p newsize
564   in
565
566   List.iter (do_resize ~option:"--resize") resizes;
567   List.iter (do_resize ~option:"--resize-force" ~force:true) resizes_force
568
569 (* Helper function calculates the surplus space, given the total
570  * required so far for the current partition layout, compared to
571  * the size of the target disk.  If the return value >= 0 then it's
572  * a surplus, if it is < 0 then it's a deficit.
573  *)
574 let calculate_surplus () =
575   (* We need some overhead for partitioning.  Worst case would be for
576    * EFI partitioning + massive per-partition alignment.
577    *)
578   let nr_partitions = List.length partitions in
579   let overhead = (Int64.of_int sectsize) *^ (
580     2L *^ 64L +^                                 (* GPT start and end *)
581     (alignment *^ (Int64.of_int (nr_partitions + 1))) (* Maximum alignment *)
582   ) +^
583   (Int64.of_int (max_bootloader - 64 * 512)) in  (* Bootloader *)
584
585   let required = List.fold_left (
586     fun total p ->
587       let newsize =
588         match p.p_operation with
589         | OpCopy | OpIgnore -> p.p_part.G.part_size
590         | OpDelete -> 0L
591         | OpResize newsize -> newsize in
592       total +^ newsize
593   ) 0L partitions in
594
595   outsize -^ (required +^ overhead)
596
597 (* Handle --expand and --shrink options. *)
598 let () =
599   if expand <> None && shrink <> None then
600     error "you cannot use options --expand and --shrink together";
601
602   if expand <> None || shrink <> None then (
603     let surplus = calculate_surplus () in
604
605     if debug then
606       eprintf "surplus before --expand or --shrink: %Ld\n" surplus;
607
608     (match expand with
609      | None -> ()
610      | Some dev ->
611          if surplus < 0L then
612            error "You cannot use --expand when there is no surplus space to expand into.  You need to make the target disk larger by at least %s."
613              (human_size (Int64.neg surplus));
614
615          let option = "--expand" in
616          let p = find_partition ~option dev in
617          let oldsize = p.p_part.G.part_size in
618          mark_partition_for_resize ~option p (oldsize +^ surplus)
619     );
620     (match shrink with
621      | None -> ()
622      | Some dev ->
623          if surplus > 0L then
624            error "You cannot use --shrink when there is no deficit (see 'deficit' in the virt-resize(1) man page).";
625
626          let option = "--shrink" in
627          let p = find_partition ~option dev in
628          let oldsize = p.p_part.G.part_size in
629          mark_partition_for_resize ~option p (oldsize +^ surplus)
630     )
631   )
632
633 (* Calculate the final surplus.
634  * At this point, this number must be >= 0.
635  *)
636 let surplus =
637   let surplus = calculate_surplus () in
638
639   if surplus < 0L then (
640     let deficit = Int64.neg surplus in
641     error "There is a deficit of %Ld bytes (%s).  You need to make the target disk larger by at least this amount or adjust your resizing requests."
642       deficit (human_size deficit)
643   );
644
645   surplus
646
647 (* Mark the --lv-expand LVs. *)
648 let () =
649   let hash = Hashtbl.create 13 in
650   List.iter (fun ({ lv_name = name } as lv) -> Hashtbl.add hash name lv) lvs;
651
652   List.iter (
653     fun name ->
654       let lv =
655         try Hashtbl.find hash name
656         with Not_found ->
657           error "%s: logical volume not found in the source disk image (this error came from '--lv-expand' option on the command line).  Try running this command: virt-filesystems --logical-volumes --long -a %s"
658             name infile in
659       lv.lv_operation <- LVOpExpand
660   ) lv_expands
661
662 (* Print a summary of what we will do. *)
663 let () =
664   flush stderr;
665
666   if not quiet then (
667     printf "**********\n\n";
668     printf "Summary of changes:\n\n";
669
670     List.iter (
671       fun ({ p_name = name; p_part = { G.part_size = oldsize }} as p) ->
672         let text =
673           match p.p_operation with
674           | OpCopy ->
675               sprintf "%s: This partition will be left alone." name
676           | OpIgnore ->
677               sprintf "%s: This partition will be created, but the contents will be ignored (ie. not copied to the target)." name
678           | OpDelete ->
679               sprintf "%s: This partition will be deleted." name
680           | OpResize newsize ->
681               sprintf "%s: This partition will be resized from %s to %s."
682                 name (human_size oldsize) (human_size newsize) ^
683               if can_expand_content p.p_type then (
684                 sprintf "  The %s on %s will be expanded using the '%s' method."
685                   (string_of_partition_content_no_size p.p_type)
686                   name
687                   (string_of_expand_content_method
688                      (expand_content_method p.p_type))
689               ) else "" in
690
691         wrap ~hanging:4 (text ^ "\n\n")
692     ) partitions;
693
694     List.iter (
695       fun ({ lv_name = name } as lv) ->
696         match lv.lv_operation with
697         | LVOpNone -> ()
698         | LVOpExpand ->
699             let text =
700               sprintf "%s: This logical volume will be expanded to maximum size."
701                 name ^
702               if can_expand_content lv.lv_type then (
703                 sprintf "  The %s on %s will be expanded using the '%s' method."
704                   (string_of_partition_content_no_size lv.lv_type)
705                   name
706                   (string_of_expand_content_method
707                      (expand_content_method lv.lv_type))
708               ) else "" in
709
710             wrap ~hanging:4 (text ^ "\n\n")
711     ) lvs;
712
713     if surplus > 0L then (
714       let text =
715         sprintf "There is a surplus of %s." (human_size surplus) ^
716         if extra_partition then (
717           if surplus >= min_extra_partition then
718             sprintf "  An extra partition will be created for the surplus."
719           else
720             sprintf "  The surplus space is not large enough for an extra partition to be created and so it will just be ignored."
721         ) else
722           sprintf "  The surplus space will be ignored.  Run a partitioning program in the guest to partition this extra space if you want." in
723
724       wrap (text ^ "\n\n")
725     );
726
727     printf "**********\n";
728     flush stdout
729   );
730
731   if dryrun then exit 0
732
733 (* Create a partition table.
734  *
735  * We *must* do this before copying the bootloader across, and copying
736  * the bootloader must be careful not to disturb this partition table
737  * (RHBZ#633766).  There are two reasons for this:
738  *
739  * (1) The 'parted' library is stupid and broken.  In many ways.  In
740  * this particular instance the stupid and broken bit is that it
741  * overwrites the whole boot sector when initializating a partition
742  * table.  (Upstream don't consider this obvious problem to be a bug).
743  *
744  * (2) GPT has a backup partition table located at the end of the disk.
745  * It's non-movable, because the primary GPT contains fixed references
746  * to both the size of the disk and the backup partition table at the
747  * end.  This would be a problem for any resize that didn't either
748  * carefully move the backup GPT (and rewrite those references) or
749  * recreate the whole partition table from scratch.
750  *)
751 let g, parttype =
752   let parttype = g#part_get_parttype "/dev/sda" in
753   if debug then eprintf "partition table type: %s\n%!" parttype;
754
755   (* Try hard to initialize the partition table.  This might involve
756    * relaunching another handle.
757    *)
758   if not quiet then
759     printf "Setting up initial partition table on %s ...\n%!" outfile;
760
761   let last_error = ref "" in
762   let rec initialize_partition_table g attempts =
763     let ok =
764       try g#part_init "/dev/sdb" parttype; true
765       with G.Error error -> last_error := error; false in
766     if ok then g, true
767     else if attempts > 0 then (
768       g#zero "/dev/sdb";
769       g#sync ();
770       g#close ();
771
772       let g = connect_both_disks () in
773       initialize_partition_table g (attempts-1)
774     )
775     else g, false
776   in
777
778   let g, ok = initialize_partition_table g 5 in
779   if not ok then
780     error "Failed to initialize the partition table on the target disk.  You need to wipe or recreate the target disk and then run virt-resize again.\n\nThe underlying error was: %s" !last_error;
781
782   g, parttype
783
784 (* Copy the bootloader across.
785  * Don't disturb the partition table that we just wrote.
786  * https://secure.wikimedia.org/wikipedia/en/wiki/Master_Boot_Record
787  * https://secure.wikimedia.org/wikipedia/en/wiki/GUID_Partition_Table
788  *)
789 let () =
790   if copy_boot_loader then (
791     let bootsect = g#pread_device "/dev/sda" 446 0L in
792     if String.length bootsect < 446 then
793       error "pread-device: short read";
794     ignore (g#pwrite_device "/dev/sdb" bootsect 0L);
795
796     let start =
797       if parttype <> "gpt" then 512L
798       else
799         (* XXX With 4K sectors does GPT just fit more entries in a
800          * sector, or does it always use 34 sectors?
801          *)
802         17408L in
803
804     let loader = g#pread_device "/dev/sda" max_bootloader start in
805     if String.length loader < max_bootloader then
806       error "pread-device: short read";
807     ignore (g#pwrite_device "/dev/sdb" loader start)
808   )
809
810 (* Repartition the target disk. *)
811
812 (* Calculate the location of the partitions on the target disk.  This
813  * also removes from the list any partitions that will be deleted, so
814  * the final list just contains partitions that need to be created
815  * on the target.
816  *)
817 let partitions =
818   let sectsize = Int64.of_int sectsize in
819
820   (* Return 'i' rounded up to the next multiple of 'a'. *)
821   let roundup64 i a = let a = a -^ 1L in (i +^ a) &^ (~^ a) in
822
823   let rec loop partnum start = function
824     | p :: ps ->
825       (match p.p_operation with
826        | OpDelete -> loop partnum start ps      (* skip p *)
827
828        | OpIgnore | OpCopy ->           (* same size *)
829          (* Size in sectors. *)
830          let size = (p.p_part.G.part_size +^ sectsize -^ 1L) /^ sectsize in
831          (* Start of next partition + alignment. *)
832          let end_ = start +^ size in
833          let next = roundup64 end_ alignment in
834
835          { p with p_target_start = start; p_target_end = end_ -^ 1L;
836            p_target_partnum = partnum } :: loop (partnum+1) next ps
837
838        | OpResize newsize ->            (* resized partition *)
839          (* New size in sectors. *)
840          let size = (newsize +^ sectsize -^ 1L) /^ sectsize in
841          (* Start of next partition + alignment. *)
842          let next = start +^ size in
843          let next = roundup64 next alignment in
844
845          { p with p_target_start = start; p_target_end = next -^ 1L;
846            p_target_partnum = partnum } :: loop (partnum+1) next ps
847       )
848
849     | [] ->
850       (* Create the surplus partition if there is room for it. *)
851       if extra_partition && surplus >= min_extra_partition then (
852         [ {
853           (* Since this partition has no source, this data is
854            * meaningless and not used since the operation is
855            * OpIgnore.
856            *)
857           p_name = "";
858           p_part = { G.part_num = 0l; part_start = 0L; part_end = 0L;
859                      part_size = 0L };
860           p_bootable = false; p_mbr_id = None; p_type = ContentUnknown;
861
862           (* Target information is meaningful. *)
863           p_operation = OpIgnore;
864           p_target_partnum = partnum;
865           p_target_start = start; p_target_end = ~^ 64L
866         } ]
867       )
868       else
869         []
870   in
871
872   (* The first partition must start at the same position as the old
873    * first partition.  Old virt-resize used to align this to 64
874    * sectors, but I suspect this is the cause of boot failures, so
875    * let's not do this.
876    *)
877   let start = (List.hd partitions).p_part.G.part_start /^ sectsize in
878   loop 1 start partitions
879
880 (* Now partition the target disk. *)
881 let () =
882   List.iter (
883     fun p ->
884       g#part_add "/dev/sdb" "primary" p.p_target_start p.p_target_end;
885
886       (* Set bootable and MBR IDs *)
887       if p.p_bootable then
888         g#part_set_bootable "/dev/sdb" p.p_target_partnum true;
889
890       (match p.p_mbr_id with
891       | None -> ()
892       | Some mbr_id ->
893         g#part_set_mbr_id "/dev/sdb" p.p_target_partnum mbr_id
894       );
895   ) partitions
896
897 (* Copy over the data. *)
898 let () =
899   List.iter (
900     fun p ->
901       match p.p_operation with
902       | OpCopy | OpResize _ ->
903         (* XXX Old code had 'when target_partnum > 0', but it appears
904          * to have served no purpose since the field could never be 0
905          * at this point.
906          *)
907
908         let oldsize = p.p_part.G.part_size in
909         let newsize =
910           match p.p_operation with OpResize s -> s | _ -> oldsize in
911
912         let copysize = if newsize < oldsize then newsize else oldsize in
913
914         let source = p.p_name in
915         let target = sprintf "/dev/sdb%d" p.p_target_partnum in
916
917         if not quiet then
918           printf "Copying %s ...\n%!" source;
919
920         g#copy_size source target copysize;
921
922       | _ -> ()
923   ) partitions
924
925 (* After copying the data over we must shut down and restart the
926  * appliance in order to expand the content.  The reason for this may
927  * not be obvious, but it's because otherwise we'll have duplicate VGs
928  * (the old VG(s) and the new VG(s)) which breaks LVM.
929  *
930  * The restart is only required if we're going to expand something.
931  *)
932 let to_be_expanded =
933   List.exists (
934     function
935     | ({ p_operation = OpResize _ } as p) -> can_expand_content p.p_type
936     | _ -> false
937   ) partitions
938   || List.exists (
939     function
940     | ({ lv_operation = LVOpExpand } as lv) -> can_expand_content lv.lv_type
941     | _ -> false
942   ) lvs
943
944 let g =
945   if to_be_expanded then (
946     g#umount_all ();
947     g#sync ();
948     g#close ();
949
950     let g = new G.guestfs () in
951     if debug then g#set_trace true;
952     g#add_drive_opts ?format:output_format ~readonly:false outfile;
953     if not quiet then Progress.set_up_progress_bar ~machine_readable g;
954     g#launch ();
955
956     g (* Return new handle. *)
957   )
958   else g (* Return existing handle. *)
959
960 let () =
961   if to_be_expanded then (
962     (* Helper function to expand partition or LV content. *)
963     let do_expand_content target = function
964       | PVResize -> g#pvresize target
965       | Resize2fs ->
966           g#e2fsck_f target;
967           g#resize2fs target
968       | NTFSResize -> g#ntfsresize_opts ~force:ntfsresize_force target
969       | BtrfsFilesystemResize ->
970           (* Complicated ...  Btrfs forces us to mount the filesystem
971            * in order to resize it.
972            *)
973           assert (Array.length (g#mounts ()) = 0);
974           g#mount_options "" target "/";
975           g#btrfs_filesystem_resize "/";
976           g#umount "/"
977     in
978
979     (* Expand partition content as required. *)
980     List.iter (
981       function
982       | ({ p_operation = OpResize _ } as p) when can_expand_content p.p_type ->
983           let source = p.p_name in
984           let target = sprintf "/dev/sda%d" p.p_target_partnum in
985           let meth = expand_content_method p.p_type in
986
987           if not quiet then
988             printf "Expanding %s%s using the '%s' method ...\n%!"
989               source
990               (if source <> target then sprintf " (now %s)" target else "")
991               (string_of_expand_content_method meth);
992
993           do_expand_content target meth
994       | _ -> ()
995     ) partitions;
996
997     (* Expand logical volume content as required. *)
998     List.iter (
999       function
1000       | ({ lv_operation = LVOpExpand } as lv) when can_expand_content lv.lv_type ->
1001           let name = lv.lv_name in
1002           let meth = expand_content_method lv.lv_type in
1003
1004           if not quiet then
1005             printf "Expanding %s using the '%s' method ...\n%!"
1006               name
1007               (string_of_expand_content_method meth);
1008
1009           (* First expand the LV itself to maximum size. *)
1010           g#lvresize_free name 100;
1011
1012           (* Then expand the content in the LV. *)
1013           do_expand_content name meth
1014       | _ -> ()
1015     ) lvs
1016   )
1017
1018 (* Finished.  Unmount disks and exit. *)
1019 let () =
1020   g#umount_all ();
1021   g#sync ();
1022   g#close ();
1023
1024   if not quiet then (
1025     print_newline ();
1026     wrap "Resize operation completed with no errors.  Before deleting the old disk, carefully check that the resized disk boots and works correctly.\n";
1027   );
1028
1029   exit 0