extra-tests: Add an extra suppression for OCaml 3.11.2 in RHEL 6.
[libguestfs.git] / tools / virt-make-fs
1 #!/usr/bin/perl -w
2 # virt-make-fs
3 # Copyright (C) 2010-2011 Red Hat Inc.
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
19 use warnings;
20 use strict;
21
22 use Sys::Guestfs;
23 use Sys::Guestfs::Lib qw(feature_available);
24
25 use Pod::Usage;
26 use Getopt::Long;
27 use File::Temp qw(tempdir);
28 use POSIX qw(mkfifo floor);
29 use Data::Dumper;
30 use String::ShellQuote qw(shell_quote);
31 use Locale::TextDomain 'libguestfs';
32
33 =encoding utf8
34
35 =head1 NAME
36
37 virt-make-fs - Make a filesystem from a tar archive or files
38
39 =head1 SYNOPSIS
40
41  virt-make-fs [--options] input.tar output.img
42
43  virt-make-fs [--options] input.tar.gz output.img
44
45  virt-make-fs [--options] directory output.img
46
47 =head1 DESCRIPTION
48
49 Virt-make-fs is a command line tool for creating a filesystem from a
50 tar archive or some files in a directory.  It is similar to tools like
51 L<mkisofs(1)>, L<genisoimage(1)> and L<mksquashfs(1)>.  Unlike those
52 tools, it can create common filesystem types like ext2/3 or NTFS,
53 which can be useful if you want to attach these filesystems to
54 existing virtual machines (eg. to import large amounts of read-only
55 data to a VM).
56
57 Basic usage is:
58
59  virt-make-fs input output.img
60
61 where C<input> is either a directory containing files that you want to
62 add, or a tar archive (either uncompressed tar or gzip-compressed
63 tar); and C<output.img> is a disk image.  The input type is detected
64 automatically.  The output disk image defaults to a raw ext2 sparse
65 image unless you specify extra flags (see L</OPTIONS> below).
66
67 =head2 FILESYSTEM TYPE
68
69 The default filesystem type is C<ext2>.  Just about any filesystem
70 type that libguestfs supports can be used (but I<not> read-only
71 formats like ISO9660).  Here are some of the more common choices:
72
73 =over 4
74
75 =item I<ext3>
76
77 Note that ext3 filesystems contain a journal, typically 1-32 MB in size.
78 If you are not going to use the filesystem in a way that requires the
79 journal, then this is just wasted overhead.
80
81 =item I<ntfs> or I<vfat>
82
83 Useful if exporting data to a Windows guest.
84
85 I<Note for vfat>: The tar archive or local directory must only contain
86 files which are owned by root (ie. UID:GID = 0:0).  The reason is that
87 the tar program running within libguestfs is unable to change the
88 ownership of non-root files, since vfat itself does not support this.
89
90 =item I<minix>
91
92 Lower overhead than C<ext2>, but certain limitations on filename
93 length and total filesystem size.
94
95 =back
96
97 =head3 EXAMPLE
98
99  virt-make-fs --type=minix input minixfs.img
100
101 =head2 TO PARTITION OR NOT TO PARTITION
102
103 Optionally virt-make-fs can add a partition table to the output disk.
104
105 Adding a partition can make the disk image more compatible with
106 certain virtualized operating systems which don't expect to see a
107 filesystem directly located on a block device (Linux doesn't care and
108 will happily handle both types).
109
110 On the other hand, if you have a partition table then the output image
111 is no longer a straight filesystem.  For example you cannot run
112 L<fsck(8)> directly on a partitioned disk image.  (However libguestfs
113 tools such as L<guestfish(1)> and L<virt-resize(1)> can still be
114 used).
115
116 =head3 EXAMPLE
117
118 Add an MBR partition:
119
120  virt-make-fs --partition -- input disk.img
121
122 If the output disk image could be terabyte-sized or larger, it's
123 better to use an EFI/GPT-compatible partition table:
124
125  virt-make-fs --partition=gpt --size=+4T --format=qcow2 input disk.img
126
127 =head2 EXTRA SPACE
128
129 Unlike formats such as tar and squashfs, a filesystem does not "just
130 fit" the files that it contains, but might have extra space.
131 Depending on how you are going to use the output, you might think this
132 extra space is wasted and want to minimize it, or you might want to
133 leave space so that more files can be added later.  Virt-make-fs
134 defaults to minimizing the extra space, but you can use the I<--size>
135 flag to leave space in the filesystem if you want it.
136
137 An alternative way to leave extra space but not make the output image
138 any bigger is to use an alternative disk image format (instead of the
139 default "raw" format).  Using I<--format=qcow2> will use the native
140 QEmu/KVM qcow2 image format (check your hypervisor supports this
141 before using it).  This allows you to choose a large I<--size> but the
142 extra space won't actually be allocated in the image until you try to
143 store something in it.
144
145 Don't forget that you can also use local commands including
146 L<resize2fs(8)> and L<virt-resize(1)> to resize existing filesystems,
147 or rerun virt-make-fs to build another image from scratch.
148
149 =head3 EXAMPLE
150
151  virt-make-fs --format=qcow2 --size=+200M input output.img
152
153 =head1 OPTIONS
154
155 =over 4
156
157 =cut
158
159 my $help;
160
161 =item B<--help>
162
163 Display brief help.
164
165 =cut
166
167 my $version;
168
169 =item B<--version>
170
171 Display version number and exit.
172
173 =cut
174
175 my $debug;
176
177 =item B<--debug>
178
179 Enable debugging information.
180
181 =cut
182
183 my $size;
184
185 =item B<--size=E<lt>NE<gt>>
186
187 =item B<--size=+E<lt>NE<gt>>
188
189 =item B<-s E<lt>NE<gt>>
190
191 =item B<-s +E<lt>NE<gt>>
192
193 Use the I<--size> (or I<-s>) option to choose the size of the output
194 image.
195
196 If this option is I<not> given, then the output image will be just
197 large enough to contain all the files, with not much wasted space.
198
199 To choose a fixed size output disk, specify an absolute number
200 followed by b/K/M/G/T/P/E to mean bytes, Kilobytes, Megabytes,
201 Gigabytes, Terabytes, Petabytes or Exabytes.  This must be large
202 enough to contain all the input files, else you will get an error.
203
204 To leave extra space, specify C<+> (plus sign) and a number followed
205 by b/K/M/G/T/P/E to mean bytes, Kilobytes, Megabytes, Gigabytes,
206 Terabytes, Petabytes or Exabytes.  For example: I<--size=+200M> means
207 enough space for the input files, and (approximately) an extra 200 MB
208 free space.
209
210 Note that virt-make-fs estimates free space, and therefore will not
211 produce filesystems containing precisely the free space requested.
212 (It is much more expensive and time-consuming to produce a filesystem
213 which has precisely the desired free space).
214
215 =cut
216
217 my $format = "raw";
218
219 =item B<--format=E<lt>fmtE<gt>>
220
221 =item B<-F E<lt>fmtE<gt>>
222
223 Choose the output disk image format.
224
225 The default is C<raw> (raw sparse disk image).
226
227 For other choices, see the L<qemu-img(1)> manpage.  The only other
228 choice that would really make sense here is C<qcow2>.
229
230 =cut
231
232 my $type = "ext2";
233
234 =item B<--type=E<lt>fsE<gt>>
235
236 =item B<-t E<lt>fsE<gt>>
237
238 Choose the output filesystem type.
239
240 The default is C<ext2>.
241
242 Any filesystem which is supported read-write by libguestfs can be used
243 here.
244
245 =cut
246
247 my $partition;
248
249 =item B<--partition>
250
251 =item B<--partition=E<lt>parttypeE<gt>>
252
253 If specified, this flag adds an MBR partition table to the output disk
254 image.
255
256 You can change the partition table type, eg. I<--partition=gpt> for
257 large disks.
258
259 Note that if you just use a lonesome I<--partition>, the Perl option
260 parser might consider the next parameter to be the partition type.
261 For example:
262
263  virt-make-fs --partition input.tar output.img
264
265 would cause virt-make-fs to think you wanted to use a partition type
266 of C<input.tar> which is completely wrong.  To avoid this, use I<-->
267 (a double dash) between options and the input and output arguments:
268
269  virt-make-fs --partition -- input.tar output.img
270
271 For MBR, virt-make-fs sets the partition type byte automatically.
272
273 =back
274
275 =cut
276
277 GetOptions ("help|?" => \$help,
278             "version" => \$version,
279             "debug" => \$debug,
280             "s|size=s" => \$size,
281             "F|format=s" => \$format,
282             "t|type=s" => \$type,
283             "partition:s" => \$partition,
284     ) or pod2usage (2);
285 pod2usage (1) if $help;
286 if ($version) {
287     my $g = Sys::Guestfs->new ();
288     my %h = $g->version ();
289     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
290     exit
291 }
292
293 die __"virt-make-fs input output\n" if @ARGV != 2;
294
295 my $input = $ARGV[0];
296 my $output = $ARGV[1];
297
298 # Input.  What is it?  Estimate how much space it will need.
299 #
300 # Estimation is a Hard Problem.  Some factors which make it hard:
301 #
302 #   - Superblocks, block free bitmaps, FAT and other fixed overhead
303 #   - Indirect blocks (ext2, ext3), and extents
304 #   - Journal size
305 #   - Internal fragmentation of files
306 #
307 # What we could also do is try shrinking the filesystem after creating
308 # and populating it, but that is complex given partitions.
309
310 my $estimate;     # Estimated size required (in bytes).
311 my $ifmt;         # Input format.
312
313 if (-d $input) {
314     $ifmt = "directory";
315
316     my @cmd = ("du", "--apparent-size", "-b", "-s", $input);
317     open PIPE, "-|", @cmd or die "du $input: $!";
318
319     $_ = <PIPE>;
320     if (/^(\d+)/) {
321         $estimate = $1;
322     } else {
323         die __"unexpected output from 'du' command";
324     }
325 } else {
326     local $ENV{LANG} = "C";
327     my @cmd = ("file", "-bsLz", $input);
328     open PIPE, "-|", @cmd or die "file $input: $!";
329
330     $ifmt = <PIPE>;
331     chomp $ifmt;
332     close PIPE;
333
334     if ($ifmt !~ /tar archive/) {
335         die __x("{f}: unknown input format: {fmt}\n",
336                 f => $input, fmt => $ifmt);
337     }
338
339     if ($ifmt =~ /compress.d/) {
340         if ($ifmt =~ /compress'd/) {
341             @cmd = ("uncompress", "-c", $input);
342         } elsif ($ifmt =~ /gzip compressed/) {
343             @cmd = ("gzip", "-cd", $input);
344         } elsif ($ifmt =~ /bzip2 compressed/) {
345             @cmd = ("bzip2", "-cd", $input);
346         } elsif ($ifmt =~ /xz compressed/) {
347             @cmd = ("xz", "-cd", $input);
348         } else {
349             die __x("{f}: unknown input format: {fmt}\n",
350                     f => $input, fmt => $ifmt);
351         }
352
353         open PIPE, "-|", @cmd or die "uncompress $input: $!";
354         $estimate = 0;
355         $estimate += length while <PIPE>;
356         close PIPE or die "close: $!";
357     } else {
358         # Plain tar file, just get the size directly.  Tar files have
359         # a 512 byte block size (compared with typically 1K or 4K for
360         # filesystems) so this isn't very accurate.
361         $estimate = -s $input;
362     }
363 }
364
365 if ($debug) {
366     printf STDERR "input format = %s\n", $ifmt;
367     printf STDERR "estimate = %s bytes (%s 1K blocks, %s 4K blocks)\n",
368       $estimate, $estimate / 1024, $estimate / 4096;
369 }
370
371 $estimate += 256 * 1024;        # For superblocks &c.
372
373 if ($type =~ /^ext[3-9]/) {
374     $estimate += 1024 * 1024;   # For ext3/4, add some more for the journal.
375 }
376
377 if ($type =~ /^ntfs/) {
378     $estimate += 4 * 1024 * 1024; # NTFS journal.
379 }
380
381 $estimate *= 1.10;              # Add 10%, see above.
382
383 # Calculate the output size.
384
385 if (!defined $size) {
386     $size = $estimate;
387 } else {
388     if ($size =~ /^\+([.\d]+)([bKMGTPE])$/) {
389         $size = $estimate + sizebytes ($1, $2);
390     } elsif ($size =~ /^([.\d]+)([bKMGTPE])$/) {
391         $size = sizebytes ($1, $2);
392     } else {
393         die __x("virt-make-fs: cannot parse size parameter: {sz}\n",
394                 sz => $size);
395     }
396 }
397
398 $size = int ($size);
399
400 # Create the output disk.
401 # Take the unusual step of invoking qemu-img here.
402
403 my @cmd = ("qemu-img", "create", "-f", $format, $output, $size);
404 if ($debug) {
405     print STDERR ("running: ", join (" ", @cmd), "\n");
406 }
407 system (@cmd) == 0 or
408     die __"qemu-img create: failed to create disk image, see earlier error messages\n";
409
410 eval {
411     print STDERR "starting libguestfs ...\n" if $debug;
412
413     # Run libguestfs.
414     my $g = Sys::Guestfs->new ();
415     $g->add_drive_opts ($output, format => $format);
416     $g->launch ();
417
418     if ($type eq "ntfs" && !feature_available ($g, "ntfs3g", "ntfsprogs")) {
419         die __"virt-make-fs: NTFS support was disabled when libguestfs was compiled\n"
420     }
421
422     # Partition the disk.
423     my $dev = "/dev/sda";
424     if (defined $partition) {
425         $partition = "mbr" if $partition eq "";
426         $g->part_disk ($dev, $partition);
427         $dev = "/dev/sda1";
428
429         # Set the partition type byte if it's MBR and the filesystem
430         # type is one that we know about.
431         my $mbr_id;
432         if ($partition eq "mbr") {
433             if ($type =~ /^v?fat$/) {
434                 $mbr_id = 0xb;
435             } elsif ($type eq "ntfs") {
436                 $mbr_id = 0x7;
437             } elsif ($type =~ /^ext\d$/) {
438                 $mbr_id = 0x83;
439             } elsif ($type eq "minix") {
440                 $mbr_id = 0x81;
441             }
442         }
443         $g->part_set_mbr_id ("/dev/sda", 1, $mbr_id) if defined $mbr_id;
444     }
445
446     print STDERR "creating $type filesystem on $dev ...\n" if $debug;
447
448     # Create the filesystem.
449     $g->mkfs ($type, $dev);
450     $g->mount_options ("", $dev, "/");
451
452     # Copy the data in.
453     my $ifile;
454
455     if ($ifmt eq "directory") {
456         my $pfile = create_pipe ();
457         my $cmd = sprintf ("tar -C %s -cf - . > $pfile &",
458                            shell_quote ($input));
459         print STDERR "command: $cmd\n" if $debug;
460         system ($cmd) == 0 or die __"tar: failed, see earlier messages\n";
461         $ifile = $pfile;
462     } else {
463         if ($ifmt =~ /compress.d/) {
464             my $pfile = create_pipe ();
465             my $cmd;
466             if ($ifmt =~ /compress'd/) {
467                 $cmd = sprintf ("uncompress -c %s > $pfile",
468                                 shell_quote ($input));
469             } elsif ($ifmt =~ /gzip compressed/) {
470                 $cmd = sprintf ("gzip -cd %s", shell_quote ($input));
471             } elsif ($ifmt =~ /bzip2 compressed/) {
472                 $cmd = sprintf ("bzip2 -cd %s", shell_quote ($input));
473             } elsif ($ifmt =~ /xz compressed/) {
474                 $cmd = sprintf ("xz -cd %s", shell_quote ($input));
475             } else {
476                 die __x("{f}: unknown input format: {fmt}\n",
477                         f => $input, fmt => $ifmt);
478             }
479             $cmd .= " > $pfile &";
480             print STDERR "command: $cmd\n" if $debug;
481             system ($cmd) == 0 or
482                 die __"uncompress command failed, see earlier messages\n";
483             $ifile = $pfile;
484         } else {
485             print STDERR "reading directly from $input\n" if $debug;
486             $ifile = $input;
487         }
488     }
489
490     if ($debug) {
491         # For debugging, print statvfs before and after doing
492         # the tar-in.
493         my %stat = $g->statvfs ("/");
494         print STDERR "Before uploading ...\n";
495         print STDERR Dumper(\%stat);
496     }
497
498     print STDERR "Uploading from $ifile to / ...\n" if $debug;
499     $g->tar_in ($ifile, "/");
500
501     if ($debug) {
502         my %stat = $g->statvfs ("/");
503         print STDERR "After uploading ...\n";
504         print STDERR Dumper(\%stat);
505     }
506
507     print STDERR "finishing off\n" if $debug;
508     $g->umount_all ();
509     $g->sync ();
510     undef $g;
511 };
512 if ($@) {
513     # Error: delete the output before exiting.
514     my $err = $@;
515     unlink $output;
516     if ($err =~ /tar_in/) {
517         print STDERR __"virt-make-fs: error copying contents into filesystem\nAn error here usually means that the program did not estimate the\nfilesystem size correctly.  Please read the BUGS section of the manpage.\n";
518     }
519     print STDERR $err;
520     exit 1;
521 }
522
523 exit 0;
524
525 sub sizebytes
526 {
527     local $_ = shift;
528     my $unit = shift;
529
530     $_ *= 1024 if $unit =~ /[KMGTPE]/;
531     $_ *= 1024 if $unit =~ /[MGTPE]/;
532     $_ *= 1024 if $unit =~ /[GTPE]/;
533     $_ *= 1024 if $unit =~ /[TPE]/;
534     $_ *= 1024 if $unit =~ /[PE]/;
535     $_ *= 1024 if $unit =~ /[E]/;
536
537     return floor($_);
538 }
539
540 sub create_pipe
541 {
542     local $_;
543     my $dir = tempdir (CLEANUP => 1);
544     my $pipe = "$dir/pipe";
545     mkfifo ($pipe, 0600) or
546         die "mkfifo: $pipe: $!";
547     return $pipe;
548 }
549
550 =head1 SHELL QUOTING
551
552 Libvirt guest names can contain arbitrary characters, some of which
553 have meaning to the shell such as C<#> and space.  You may need to
554 quote or escape these characters on the command line.  See the shell
555 manual page L<sh(1)> for details.
556
557 =head1 SEE ALSO
558
559 L<guestfish(1)>,
560 L<virt-resize(1)>,
561 L<virt-tar-in(1)>,
562 L<mkisofs(1)>,
563 L<genisoimage(1)>,
564 L<mksquashfs(1)>,
565 L<mke2fs(8)>,
566 L<resize2fs(8)>,
567 L<guestfs(3)>,
568 L<Sys::Guestfs(3)>,
569 L<http://libguestfs.org/>.
570
571 =head1 BUGS
572
573 When reporting bugs, please enable debugging and capture the
574 I<complete> output:
575
576  export LIBGUESTFS_DEBUG=1
577  virt-make-fs --debug [...] > /tmp/virt-make-fs.log 2>&1
578
579 Attach /tmp/virt-make-fs.log to a new bug report at
580 L<https://bugzilla.redhat.com/>
581
582 =head1 AUTHOR
583
584 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
585
586 =head1 COPYRIGHT
587
588 Copyright (C) 2010-2011 Red Hat Inc.
589
590 This program is free software; you can redistribute it and/or modify
591 it under the terms of the GNU General Public License as published by
592 the Free Software Foundation; either version 2 of the License, or
593 (at your option) any later version.
594
595 This program is distributed in the hope that it will be useful,
596 but WITHOUT ANY WARRANTY; without even the implied warranty of
597 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
598 GNU General Public License for more details.
599
600 You should have received a copy of the GNU General Public License
601 along with this program; if not, write to the Free Software
602 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.