home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / popularity-contest / popcon-upload < prev   
Encoding:
Text File  |  2006-05-11  |  2.6 KB  |  104 lines
  1. #!/usr/bin/perl -w
  2. # Written by Bill Allombert for the Debian popularity-contest project.
  3. # This file is placed in the public domain.
  4.  
  5. use strict;
  6. use IO::Socket;
  7. use Getopt::Std;
  8.  
  9. my %opts;
  10. getopts("Cdu:f:", \%opts);
  11.  
  12. sub usage {
  13.     print <<"EOF";
  14. Usage: $0 [-Cd] [-u <url>] [-f <file>]
  15.   -C        send submissions in clear text, and not compressed
  16.   -d        enable debugging
  17.   -u <url>  submit to the given URL (default popcon.ubuntu.com)
  18.   -f <file> read popcon report from file (default stdin)
  19. EOF
  20. }
  21.  
  22. my $compressed = 1; # Submit reports in a compressed form?
  23.  
  24. my ($submiturl)  = $opts{'u'} || "http://popcon.ubuntu.com/popcon-submit.cgi";
  25. my ($file)  = $opts{'f'} || "-";
  26. $compressed = 0 if ($opts{'C'});
  27.  
  28. my ($host) = $submiturl =~ m%http://([^/]+)%;
  29.  
  30. print "Unable to parse url\n" if ($opts{'d'} && ! $host);
  31.  
  32. # Configure the proxy:
  33. my ($http_proxy,$proxy,$port,$remote);
  34.  
  35. $http_proxy=$ENV{'http_proxy'};
  36. if (defined($http_proxy))
  37. {
  38.   $http_proxy =~ m{http://([^:]*)(?::([0-9]+))?} 
  39.         or die ("unrecognized http_proxy");
  40.   $proxy=$1; $port=$2;
  41. }
  42.   
  43. $proxy=$host unless (defined($proxy));
  44. $port=80 unless (defined($port));
  45.  
  46. # Compress the report:
  47. my ($str,$len);
  48. my $encoding;
  49. if ($compressed) {
  50.     open FILE, "gzip -c $file |" or die "gzip -c $file";
  51.     $encoding = "x-gzip";
  52. } else {
  53.     open FILE, "< $file" or die "reading from '$file'";
  54.     $encoding = "identity";
  55. }
  56. $str .= $_ while(<FILE>); 
  57. close(FILE);
  58. $len = length($str);
  59.  
  60. # 30 second timeout on http connections
  61. $SIG{ALRM} = sub { die "timeout in popcon-upload\n" };
  62. alarm(30);
  63.  
  64. # Connect to server
  65. $remote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $proxy, 
  66.                                                 PeerPort => $port); 
  67. unless ($remote) { die "cannot connect to $proxy:$port" }
  68.  
  69. my $boundary = "----------ThIs_Is_tHe_bouNdaRY_\$";
  70.  
  71. #Content-Length: $len
  72. # text/plain; charset=utf-8
  73. my $ORS = "\r\n"; # Use DOS line endings to make HTTP happy
  74. my $form;
  75. $form .= "--${boundary}$ORS";
  76. $form .= "Content-Disposition: form-data; name=\"popcondata\"; filename=\"popcon-data\"$ORS";
  77. $form .= "Content-Encoding: $encoding$ORS";
  78. $form .= "Content-Type: application/octet-stream$ORS$ORS";
  79. $form .= "$str$ORS";
  80. $form .= "--${boundary}--$ORS";
  81. $form .= "$ORS";
  82.  
  83. my $formlen = length($form);
  84.  
  85. #Send data
  86. print $remote <<"EOF";
  87. POST $submiturl HTTP/1.1
  88. User-Agent: popcon-upload
  89. Host: $host
  90. content-type: multipart/form-data; boundary=$boundary
  91. content-length: $formlen
  92.  
  93. $form
  94. EOF
  95.  
  96. #Get answer
  97. my($answer)="";
  98. $answer.=$_ while(<$remote>);
  99. close ($remote);
  100. #Check answer
  101. my $status = ($answer =~ m/Thanks!/) ? 0 : 1;
  102. print "Failed to upload, answer '$answer'\n" if $status && $opts{'d'};
  103. exit $status;
  104.