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 ()