[Popcon-commits] cvs commit to popularity-contest by pere

pere at cvs.alioth.debian.org pere at cvs.alioth.debian.org
Wed Jul 20 07:52:30 UTC 2005


Update of /cvsroot/popcon/popularity-contest
In directory haydn:/tmp/cvs-serv30717

Modified Files:
	popcon-upload 
Log Message:
Rewrote popcon-upload to submit reports using MIME-encoded file uploads to match the common practice for browser-based file uploads.

Change popcon-submit.cgi to handle uploads in both the old upload format and
the new upload format, as well as the ubuntu (uncompressed) format.


Index: popcon-upload
===================================================================
RCS file: /cvsroot/popcon/popularity-contest/popcon-upload,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- popcon-upload	4 Jul 2005 15:09:24 -0000	1.4
+++ popcon-upload	20 Jul 2005 07:52:28 -0000	1.5
@@ -7,13 +7,28 @@
 use Getopt::Std;
 
 my %opts;
-getopt("uf", \%opts);
+getopts("Cdu:f:", \%opts);
+
+sub usage {
+    print <<"EOF";
+Usage: $0 [-Cd] [-u <url>] [-f <file>]
+  -C        send submissions in clear text, and not compressed
+  -d        enable debugging
+  -u <url>  submit to the given URL (default popcon.debian.org)
+  -f <file> read popcon report from file (default stdin)
+EOF
+}
+
+my $compressed = 1; # Submit reports in a compressed form?
 
 my ($submiturl)  = $opts{'u'} || "http://popcon.debian.org/cgi-bin/popcon.cgi";
 my ($file)  = $opts{'f'} || "-";
+$compressed = 0 if ($opts{'C'});
 
 my ($host) = $submiturl =~ m%http://([^/]+)%;
 
+print "Unable to parse url\n" if ($opts{'d'} && ! $host);
+
 # Configure the proxy:
 my ($http_proxy,$proxy,$port,$remote);
 
@@ -30,9 +45,16 @@
 
 # Compress the report:
 my ($str,$len);
-open GZIP, "gzip -c $file |" or die "gzip -c $file";
-$str .= $_ while(<GZIP>); 
-close(GZIP);
+my $encoding;
+if ($compressed) {
+    open FILE, "gzip -c $file |" or die "gzip -c $file";
+    $encoding = "x-gzip";
+} else {
+    open FILE, "< $file" or die "reading from '$file'";
+    $encoding = "identity";
+}
+$str .= $_ while(<FILE>); 
+close(FILE);
 $len = length($str);
 
 # 30 second timeout on http connections
@@ -44,20 +66,38 @@
                                                 PeerPort => $port); 
 unless ($remote) { die "cannot connect to $proxy:$port" }
 
+my $boundary = "----------ThIs_Is_tHe_bouNdaRY_\$";
+
+#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=\"popcondata\"; filename=\"popcon-data\"$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 <<"EOF";
 POST $submiturl HTTP/1.1
+User-Agent: popcon-upload
 Host: $host
-Content-Type: text/plain; charset=utf-8
-Content-Encoding: x-gzip
-Content-Length: $len
+content-type: multipart/form-data; boundary=$boundary
+content-length: $formlen
 
+$form
 EOF
-print $remote $str;
 
 #Get answer
 my($answer)="";
 $answer.=$_ while(<$remote>);
 close ($remote);
 #Check answer
-exit (($answer =~ m/DEBIAN POPCON HTTP-POST OK/)?0:1);
+my $status = ($answer =~ m/DEBIAN POPCON HTTP-POST OK/) ? 0 : 1;
+print "Failed to upload, answer '$answer'\n" if $status && $opts{'d'};
+exit $status;




More information about the Popcon-commits mailing list