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