sitesummary 0.1.20 / usr / lib / cgi-bin / sitesummary-collector.cgi

#!/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;
use Sys::Syslog;
use SiteSummary;

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

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

print "Content-Type: text/plain\n\n";

my ($peeripaddr, $peername) = get_peerinfo(\*STDIN);

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 $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 {
    return get_unique_ether_id("system/ifconfig-a") || die "Unable to read ifconfig-a";
}

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);
    if ("ether-unknown" eq $id) {
        syslog('warning', "%s", "ignoring client without MAC address connected from \[$peeripaddr\]");
        chdir "..";
        `rm -r $dirname`;
        return;
    }
    my $newdir = "$basedir/entries/$id";

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

    rename $dirname, $newdir || die;

    $ENV{"PATH"} = "";
    for my $handler (<$handlerdir/*>) {
        # Untaint script path
        $handler =~ m/^([^;]*)$/; $handler = $1;
        system("$handler", "$newdir", "$status");
    }
}

sub get_peerinfo {
    my $sockethandle = shift;
    my ($peeripstr, $peername) = ("", "");

    if ($ENV{'REMOTE_ADDR'}) { # CGI variable
        $peeripstr = $ENV{'REMOTE_ADDR'};
        $peeripstr =~ m/(\d+).(\d+).(\d+).(\d+)/; # Untaint
        $peeripstr = "$1.$2.$3.$4";
        $peeripaddr = inet_aton($peeripstr);
        $peername = gethostbyaddr($peeripaddr, AF_INET);
    } elsif (my $sockaddr = getpeername($sockethandle)) {
        my $peerport;
        ($peerport, $peeripaddr) = sockaddr_in($sockaddr);
        $peername = gethostbyaddr($peeripaddr, AF_INET);
        $peeripstr = inet_ntoa($peeripaddr);
    } else {
        # Running on the command line, use test host
        $peeripstr = "127.0.0.1";
        $peername = "localhost";
    }
    if ("" eq $peername) {
        syslog('warning', "%s", "client without DNS entry connected from \[$peeripstr\]");
        $peername = "$peeripstr";
    }
    return ($peeripstr, $peername);
}