#!/usr/bin/perl -w
#
# Unpack disks from TCP transport.
#
# Copyright (C) 2007 Red Hat Inc.
# Written by Richard W.M. Jones <rjones@redhat.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id$

use strict;

use Getopt::Long;
use Pod::Usage;

my $outputdir = ".";
my $force = 0;
my $noninteractive = 0;

sub main {
    my $help = 0;
    my $man = 0;

    Getopt::Long::Configure ("bundling");

    GetOptions (
	"d|directory=s",    \$outputdir,
	"f|force",          \$force,
	"n|noninteractive", \$noninteractive,
	"<>" =>             \&process,
	"help" => \$help, man => \$man,
    ) or pod2usage (2);
    pod2usage (1) if $help;
    pod2usage (-exitstatus => 0, -verbose => 2) if $man;

    exit 0
}

# Process each input file.

sub process {
    my $filename = shift;

    open DISKS,"$filename" or die "$filename: $!";
    my $zcat_open = 0;		# If we have a pipe open to zcat now.
    my $newline_chomped = 0;	# If we need to add a \n
    my $lineno = 0;		# Current line number.
    while (<DISKS>) {
	$lineno++;
	chomp;

	# Is it a header for the next disk image?
	if (/^p2v (.*) (\d+)$/) {
	    my $imagename = $1;
	    my $sectors = $2;

	    # Close the previous file (if open).
	    close ZCAT if $zcat_open;

	    # Check the image name.
	    if (!$force &&
		($imagename =~ /\.\./ || $imagename =~ m{/} ||
		 $imagename !~ /^[-.A-Za-z0-9]+$/)) {
		print "$filename: bad image name at line $lineno: $imagename\n";
		exit 2;
	    }
	    $imagename = $outputdir . "/" . $imagename;

	    if (!$force && -f $imagename) {
		print "$filename: disk image already exists at line $lineno: $imagename\n";
		exit 2;
	    }

	    if (!$noninteractive) {
		print "Write disk image $imagename ($sectors sectors)? (y/n) ";
		my $key = <STDIN>;
		exit 3 if $key =~ /^n/i;
	    }

	    open ZCAT, "| zcat > $imagename" or die "zcat: $!";
	    $zcat_open = 1;
	    $newline_chomped = 0;
	}
	# Otherwise we're in the middle of data.
	else {
	    if (!$zcat_open) {
		print "$filename: corrupt data at line $lineno\n";
		exit 2
	    }
	    print ZCAT "\n" if $newline_chomped;
	    print ZCAT;
	    $newline_chomped = 1; # For the next newline.
	}
    }

    close ZCAT if $zcat_open;
    close DISKS;


}

main ()