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 my $outputdir = ".";
  30 my $force = 0;
  31 my $noninteractive = 0;
  32
  33 sub main {
  34     my $help = 0;
  35     my $man = 0;
  36
  37     Getopt::Long::Configure ("bundling");
  38
  39     GetOptions (
  40         "d|directory=s",    \$outputdir,
  41         "f|force",          \$force,
  42         "n|noninteractive", \$noninteractive,
  43         "<>" =>             \&process,
  44         "help" => \$help, man => \$man,
  45     ) or pod2usage (2);
  46     pod2usage (1) if $help;
  47     pod2usage (-exitstatus => 0, -verbose => 2) if $man;
  48
  49     exit 0
  50 }
  51
  52 # Process each input file.
  53
  54 sub process {
  55     my $filename = shift;
  56
  57     open DISKS,"$filename" or die "$filename: $!";
  58     my $zcat_open = 0;          # If we have a pipe open to zcat now.
  59     my $newline_chomped = 0;    # If we need to add a \n
  60     my $lineno = 0;             # Current line number.
  61     while (<DISKS>) {
  62         $lineno++;
  63         chomp;
  64
  65         # Is it a header for the next disk image?
  66         if (/^p2v (.*) (\d+)$/) {
  67             my $imagename = $1;
  68             my $sectors = $2;
  69
  70             # Close the previous file (if open).
  71             close ZCAT if $zcat_open;
  72
  73             # Check the image name.
  74             if (!$force &&
  75                 ($imagename =~ /\.\./ || $imagename =~ m{/} ||
  76                  $imagename !~ /^[-.A-Za-z0-9]+$/)) {
  77                 print "$filename: bad image name at line $lineno: $imagename\n";
  78                 exit 2;
  79             }
  80             $imagename = $outputdir . "/" . $imagename;
  81
  82             if (!$force && -f $imagename) {
  83                 print "$filename: disk image already exists at line $lineno: $imagename\n";
  84                 exit 2;
  85             }
  86
  87             if (!$noninteractive) {
  88                 print "Write disk image $imagename ($sectors sectors)? (y/n) ";
  89                 my $key = <STDIN>;
  90                 exit 3 if $key =~ /^n/i;
  91             }
  92
  93             open ZCAT, "| zcat > $imagename" or die "zcat: $!";
  94             $zcat_open = 1;
  95             $newline_chomped = 0;
  96         }
  97         # Otherwise we're in the middle of data.
  98         else {
  99             if (!$zcat_open) {
 100                 print "$filename: corrupt data at line $lineno\n";
 101                 exit 2
 102             }
 103             print ZCAT "\n" if $newline_chomped;
 104             print ZCAT;
 105             $newline_chomped = 1; # For the next newline.
 106         }
 107     }
 108
 109     close ZCAT if $zcat_open;
 110     close DISKS;
 111
 112
 113 }
 114
 115 main ()