Daily update.
[virt-p2v.git] / virt-p2v-unpack
1 #!/usr/bin/perl -w
2 #
3 # Unpack disks from TCP transport.
4 #
5 # Copyright (C) 2007 Red Hat Inc.
6 # Written by Richard W.M. Jones <rjones@redhat.com>
7 #
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2 of the License, or
11 # (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
21 #
22 # $Id$
23
24 use strict;
25
26 use Getopt::Long;
27 use Pod::Usage;
28
29 XXX This needs a rewrite
30
31 my $outputdir = ".";
32 my $force = 0;
33 my $noninteractive = 0;
34
35 sub main {
36     my $help = 0;
37     my $man = 0;
38
39     Getopt::Long::Configure ("bundling");
40
41     GetOptions (
42         "d|directory=s",    \$outputdir,
43         "f|force",          \$force,
44         "n|noninteractive", \$noninteractive,
45         "<>" =>             \&process,
46         "help" => \$help, man => \$man,
47     ) or pod2usage (2);
48     pod2usage (1) if $help;
49     pod2usage (-exitstatus => 0, -verbose => 2) if $man;
50
51     exit 0
52 }
53
54 # Process each input file.
55
56 sub process {
57     my $filename = shift;
58
59     open DISKS,"$filename" or die "$filename: $!";
60     my $zcat_open = 0;          # If we have a pipe open to zcat now.
61     my $newline_chomped = 0;    # If we need to add a \n
62     my $lineno = 0;             # Current line number.
63     while (<DISKS>) {
64         $lineno++;
65         chomp;
66
67         # Is it a header for the next disk image?
68         if (/^p2v (.*) (\d+)$/) {
69             my $imagename = $1;
70             my $sectors = $2;
71
72             # Close the previous file (if open).
73             close ZCAT if $zcat_open;
74
75             # Check the image name.
76             if (!$force &&
77                 ($imagename =~ /\.\./ || $imagename =~ m{/} ||
78                  $imagename !~ /^[-.A-Za-z0-9]+$/)) {
79                 print "$filename: bad image name at line $lineno: $imagename\n";
80                 exit 2;
81             }
82             $imagename = $outputdir . "/" . $imagename;
83
84             if (!$force && -f $imagename) {
85                 print "$filename: disk image already exists at line $lineno: $imagename\n";
86                 exit 2;
87             }
88
89             if (!$noninteractive) {
90                 print "Write disk image $imagename ($sectors sectors)? (y/n) ";
91                 my $key = <STDIN>;
92                 exit 3 if $key =~ /^n/i;
93             }
94
95             open ZCAT, "| zcat > $imagename" or die "zcat: $!";
96             $zcat_open = 1;
97             $newline_chomped = 0;
98         }
99         # Otherwise we're in the middle of data.
100         else {
101             if (!$zcat_open) {
102                 print "$filename: corrupt data at line $lineno\n";
103                 exit 2
104             }
105             print ZCAT "\n" if $newline_chomped;
106             print ZCAT;
107             $newline_chomped = 1; # For the next newline.
108         }
109     }
110
111     close ZCAT if $zcat_open;
112     close DISKS;
113
114
115 }
116
117 main ()