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