[Popcon-developers] HTTP POST support for popcon

[Bill Allombert]

--EdRE1UL8d3mMOE6m
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hello popcon developers,

This is mostly complete now:
1) popcon.debian.org now support HTTP POST (to the test mailbox
currently) (posted reports are mailed by the server internally).

2) A script using only perl-base is provided for uploading.
It handle the http_proxy variable.

Reports are sent compressed with gzip to save bandwidth.
There is no support on the server for uncompressed submissions.

Please find 2 files in attachment:
1) popcon.cgi: the CGI script
2) popcon-upload.pl: the client script.

I await your comments before further actions.

Cheers,
-- 
Bill. <ballombe@debian.org>

Imagine a large red swirl here. 

--EdRE1UL8d3mMOE6m
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="popcon.cgi"

#!/usr/bin/perl -wT

use strict;

my $email='test@popcon.debian.org';

$ENV{PATH}="";

print "Content-Type: text/plain\n\n";
if ($ENV{REQUEST_METHOD} ne "POST")
{
  print "Debian Popularity-Contest HTTP-POST submission URL\n";
  exit 0;
}
open POPCON, "|/usr/lib/sendmail -oi $email" or die "sendmail";
open GZIP, '/bin/gzip -dc|' or die "gzip";
close STDIN;
open STDIN, "<&GZIP";

print POPCON <<"EOF";
To: $email
Subject: popularity-contest submission

EOF
print POPCON while(<GZIP>);
close POPCON;

print "Thanks for your submission to Debian Popularity-Contest\n";
exit 0;

--EdRE1UL8d3mMOE6m
Content-Type: application/x-perl
Content-Disposition: attachment; filename="popcon-upload.pl"
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl -w=0A# Written by Bill Allombert for the Debian popularity-=
contest project.=0A# This file is placed in the public domain.=0A=0A=0Ause =
strict;=0Ause IO::Socket;=0Amy ($http_proxy,$host,$proxy,$port,$remote,$str=
,$len);=0A=0A$host  =3D "popcon.debian.org";=0A=0A# Configure the proxy:=0A=
$http_proxy=3D$ENV{'http_proxy'};=0Aif (defined($http_proxy))=0A{=0A  $http=
_proxy =3D~ m{http://([^:]*)(?::([0-9]+))?} =0A        or die ("unrecognize=
d http_proxy");=0A  $proxy=3D$1; $port=3D$2;=0A}=0A  =0A$proxy=3D$host unle=
ss (defined($proxy));=0A$port=3D80 unless (defined($port));=0A=0A# Compress=
 the report:=0Aopen GZIP, '/bin/gzip -c|' or die "gzip";=0Aclose STDIN;=0Ao=
pen STDIN, "<&GZIP";=0A$str .=3D $_ while(<GZIP>); $len =3D length($str);=
=0A=0A# Connect to server=0A$remote =3D IO::Socket::INET->new(Proto =3D> "t=
cp", PeerAddr =3D> $proxy, =0A                                             =
   PeerPort =3D> $port); =0Aunless ($remote) { die "cannot connect to $prox=
y:$port" }=0A=0A#Send data=0Aprint $remote <<"EOF";=0APOST http://$host/cgi=
-bin/popcon.cgi HTTP/1.1=0AHost: $host=0AContent-Type: application/octet-st=
ream=0AContent-Length: $len=0A=0AEOF=0Aprint $remote $str;=0Aclose ($remote=
)            || die "close: $!";=0Aexit;=0A
--EdRE1UL8d3mMOE6m--