#!/usr/bin/perl -w # Written by Bill Allombert for the Debian popularity-contest project. # This file is placed in the public domain. # Rewritten for sitesummary by Petter Reinholdtsen use strict; use IO::Socket; use Getopt::Std; use File::Basename; my %opts; getopts("du:f:", \%opts); sub usage { print <<"EOF"; Usage: $0 [-Cd] [-u ] [-f ] -d enable debugging -u submit to the given URL (default localhost) -f read popcon report from file (default stdin) EOF } my ($submiturl) = $opts{'u'} || "http://localhost/cgi-bin/sitesummary-collector.cgi"; my ($file) = $opts{'f'} || "-"; my ($host) = $submiturl =~ m%https?://([^/]+)%; print "Unable to parse url\n" if ($opts{'d'} && ! $host); # Configure the proxy: my ($http_proxy,$proxy,$port,$remote); $http_proxy=$ENV{'http_proxy'}; if (defined($http_proxy) && length($http_proxy)) { $http_proxy =~ m{http://([^:]*)(?::([0-9]+))?} or die ("unrecognized http_proxy"); $proxy=$1; $port=$2; } $proxy=$host unless (defined($proxy)); $port=80 unless (defined($port)); # Compress the report: my ($str,$len); my $encoding; open FILE, "< $file" or die "reading from '$file'"; $encoding = "identity"; $str .= $_ while(); close(FILE); $len = length($str); # 30 second timeout on http connections $SIG{ALRM} = sub { die "timeout in sitesummary-upload\n" }; alarm(30); # Connect to server $remote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $proxy, PeerPort => $port); unless ($remote) { die "cannot connect to $proxy:$port" } my $boundary = "----------ThIs_Is_tHe_bouNdaRY_\$"; my $basefile = basename($file); #Content-Length: $len # text/plain; charset=utf-8 my $ORS = "\r\n"; # Use DOS line endings to make HTTP happy my $form; $form .= "--${boundary}$ORS"; $form .= "Content-Disposition: form-data; name=\"sitesummary\"; filename=\"$basefile\"$ORS"; $form .= "Content-Encoding: $encoding$ORS"; $form .= "Content-Type: application/octet-stream$ORS$ORS"; $form .= "$str$ORS"; $form .= "--${boundary}--$ORS"; $form .= "$ORS"; my $formlen = length($form); #Send data print $remote "POST $submiturl HTTP/1.1\r\n"; print $remote "User-Agent: sitesummary-upload\r\n"; print $remote "Host: $host\r\n"; print $remote "Content-Type: multipart/form-data; boundary=$boundary\r\n"; print $remote "Content-Length: $formlen\r\n"; print $remote "\r\n"; print $remote "$form"; #Get answer my($answer)=""; while(<$remote>) { $answer.=$_; m/SITESUMMARY HTTP-POST OK/ and last; } close ($remote); #Check answer my $status = ($answer =~ m/SITESUMMARY HTTP-POST OK/) ? 0 : 1; print "Failed to upload, answer '$answer'\n" if $status && $opts{'d'}; exit $status;