#!/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 <", $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); }