#!/usr/bin/perl -wT
#
# Receive HTTP post request with a file upload and process it as a
# sitesummary submission.
#
# Handle three different submission methods
#  - mime-encoded upload with sitesummary report in compressed form

use strict;
use CGI;
use POSIX qw(strftime);
use Socket;

my $basedir   = "/var/lib/sitesummary";
my $handlerdir = "/usr/lib/sitesummary/handler.d";

$ENV{PATH} = "/bin:/usr/bin";

print "Content-Type: text/plain\n\n";
if (exists $ENV{REQUEST_METHOD} && $ENV{REQUEST_METHOD} ne "POST")
{
    print "Sitesummary  HTTP-POST submission URL\n";
    print "Visit http://debian-edu.alioth.debian.org/ for more info.\n";
    exit 0;
}

# Extract post data, handle both simple and multipart way
my @entry;
my $filename = "unknown";
if (exists $ENV{CONTENT_TYPE} && $ENV{CONTENT_TYPE} =~ m%multipart/form-data%){
    my $query = new CGI;
    my $fh = $query->upload("sitesummary");
    if ($fh) {
        $filename = $query->param("sitesummary");
        my $type = $query->uploadInfo($filename)->{'Content-Type'};
        if ("application/octet-stream" ne $type) {
            print "Only 'application/octet-stream' is supported (not $type)!";
            die;
        } else {
            my $encoding = $query->uploadInfo($filename)->{'Content-Encoding'};
            if ("x-gzip" eq $encoding || "gzip" eq $encoding) {
                # Uncompress
                print "Compressed ($encoding) encoding detected.\n";
                my $data;
                # $data = join("", <$fh>);
                my $len = (stat($fh))[7];
                read $fh, $data, $len;
                $data = Compress::Zlib::memGunzip($data);
                @entry = ($data);
            } else { # Pass throught
                #print STDERR "Identity encoding detected.\n";
                @entry = <$fh>;
            }
        }
    } else {
        print $query->cgi_error;
        die;
    }
} else {
    print <<EOF;
Unsupported submission method.
EOF
}

my ($peeripaddr, $peername) = get_peerinfo(\*STDIN);
my $timestamp = strftime("%Y-%m-%dT%H:%M:%S", gmtime());

if ($filename =~ m/.tar.gz$/) {
    $filename = "sitesummary.tar.gz";
} elsif ($filename =~ m/.tar.gz.gpg$/) {
    $filename = "sitesummary.tar.gz.gpg";
} else {
    die "Unhandled file type '$filename'"
}

# XXX Come up with some unique file name.
my $savefile = "$basedir/tmpstorage/$peeripaddr-$timestamp-$$-$filename";

open(SITESUMMARY, ">$savefile") or die "Unable to write to $savefile";
print SITESUMMARY @entry;
close SITESUMMARY;

print "Thanks for your submission to site-summary!\n";
print "SITESUMMARY HTTP-POST OK\n";

process_entry($peeripaddr, $peername, $savefile);

unlink $savefile;

exit 0;

sub extract_unique_id {
    my $eth0mac;
    open(IFCONFIG, "system/ifconfig-a") || die;
    while (<IFCONFIG>) {
	chomp;
	$eth0mac = $1 if (m/eth0\s+Link encap:Ethernet  HWaddr (\S+)/);
    }
    close (IFCONFIG);
    #print STDERR "MAC: $eth0mac\n";
    return "ether-$eth0mac";
}

sub process_entry {
    my ($peeripaddr, $peername, $filename) = @_;
    my $dirname;
    if ($filename =~ m/(.+).tar.gz$/) {
	$dirname = $1;
	mkdir $dirname;
	chdir $dirname;
	`tar zxf $filename`;
    } else {
	die "Unhandled file format '$filename'";
    }

    open(PEERINFO, ">peerinfo") || die;
    print PEERINFO "$peeripaddr $peername\n";
    close(PEERINFO) || die;

    my $id = extract_unique_id($dirname);
    my $newdir = "$basedir/entries/$id";

    my $status = "new";
    if ( -d $newdir ) {
	`rm -r $newdir`;
	my $status = "update";
    }

    rename $dirname, $newdir || die;
    for my $handler (<$handlerdir/*>) {
	`$handler $newdir $status`;
    }
}

sub get_peerinfo {
    my $sockethandle = shift;

    # Return something while this function do not work.
    return ("127.0.0.1", "localhost");

    # XXX The call to sockaddr_in trigger "Bad arg length for
    # Socket::unpack_sockaddr_in, length is 2, should be 16 at
    # /usr/lib/perl/5.8/Socket.pm line 198."  No idea why.
    my ($peerport, $peeripaddr) = sockaddr_in(getpeername($sockethandle));
    if ($peerport) {
	my $peername = gethostbyaddr($peeripaddr, AF_INET);

	if ("" eq $peername) {
	    syslog('warning', "client without DNS entry connected from \[$peeripaddr\]");
	    $peername = "$peeripaddr";
	}
    } else {
        # Running on the command line, use test host
        $peeripaddr = "127.0.0.1";
        $peername = "localhost";
    }
    return ($peeripaddr, $peername);
}