home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / doc / popularity-contest / examples / popcon-submit.cgi < prev    next >
Encoding:
Text File  |  2006-05-11  |  3.0 KB  |  104 lines
  1. #!/usr/bin/perl -wT
  2. #
  3. # Receive HTTP post request with a file upload, uncompress it if
  4. # needed, and submit it as an email to the popcon collector.
  5. #
  6. # Handle three different submission methods
  7. #  - simple post message, where the complete body is the popcon report
  8. #    (used by popcon version 1.30).
  9. #  - mime-encoded upload with report in compressed form (used by
  10. #    popcon version 1.31 and newer).
  11. #  - mime-encoded upload with report in uncompressed form (used by
  12. #    ubuntu popcon).
  13.  
  14. use strict;
  15. use CGI;
  16. use Compress::Zlib;
  17.  
  18. my $email='survey@popcon.ubuntu.com';
  19.  
  20. my $directsave = 0; # Enable to store on disk instead of sending an email
  21. my $basedir   = "/var/lib/popcon";
  22. my $uploaddir = "$basedir/popcon-data/";
  23.  
  24. $ENV{PATH}="";
  25.  
  26. print "Content-Type: text/plain\n\n";
  27. if (exists $ENV{REQUEST_METHOD} && $ENV{REQUEST_METHOD} ne "POST")
  28. {
  29.     print "Debian Popularity-Contest HTTP-POST submission URL\n";
  30.     print "Visit http://popcon.ubuntu.com/ for more info.\n";
  31.     exit 0;
  32. }
  33.  
  34. # Extract post data, handle both simple and multipart way
  35. my @entry;
  36. if (exists $ENV{CONTENT_TYPE} && $ENV{CONTENT_TYPE} =~ m%multipart/form-data%){
  37.     # New method, used in popularity-contest after 1.30
  38.     my $query = new CGI;
  39.     my $fh = $query->upload("popcondata");
  40.     if ($fh) {
  41.     my $filename = $query->param("popcondata");
  42.     my $type = $query->uploadInfo($filename)->{'Content-Type'};
  43.     if ("text/plain; charset=utf-8" ne $type &&
  44.         "application/octet-stream" ne $type) { # Used by ubuntu script
  45.         print "Only 'text/plain; charset=utf-8' and 'application/octet-stream' is supported (not $type)!";
  46.         die;
  47.     } else {
  48.         my $encoding = $query->uploadInfo($filename)->{'Content-Encoding'};
  49.         if ("x-gzip" eq $encoding || "gzip" eq $encoding) {
  50.         # Uncompress
  51.         print "Compressed ($encoding) encoding detected.\n";
  52.         my $data;
  53.         # $data = join("", <$fh>);
  54.         my $len = (stat($fh))[7];
  55.         read $fh, $data, $len;
  56.         $data = Compress::Zlib::memGunzip($data);
  57.         @entry = ($data);
  58.         } else { # Pass throught
  59.         print "Identity encoding detected.\n";
  60.         @entry = <$fh>;
  61.         }
  62.     }
  63.     } else {
  64.     print $query->cgi_error;
  65.     die;
  66.     }
  67. } else {
  68.     # Old submit method, used in popularity-contest version 1.30
  69.     print "Old method detected.\n";
  70.     open GZIP, '/bin/gzip -dc|' or die "gzip";
  71.     close STDIN;
  72.     open STDIN, "<&GZIP";
  73.     @entry = <GZIP>;
  74. }
  75.  
  76. my ($id1, $id2) =
  77.     $entry[0] =~ m/POPULARITY-CONTEST-0 .+ ID:(\S\S)(\S+) /;
  78. if ($id1) {
  79.     if ($directsave) {
  80.     -d $uploaddir || mkdir $uploaddir;
  81.     my $dir = "$uploaddir/$id1";
  82.     -d $dir || mkdir $dir;
  83.     open(POPCON, ">$dir/$id1$id2") || die "Unable to write to '$dir/$id1$id2'";
  84.     print POPCON @entry;
  85.     close POPCON;
  86.     } else {
  87.     open POPCON, "|/usr/lib/sendmail -oi $email" or die "sendmail";
  88.     print POPCON <<"EOF";
  89. To: $email
  90. Subject: popularity-contest submission
  91.  
  92. EOF
  93.         print POPCON @entry;
  94.     close POPCON;
  95.     }
  96. }
  97. if ($id1) {
  98.     print "Thanks for your submission to Debian Popularity-Contest!\n";
  99.     print "DEBIAN POPCON HTTP-POST OK\n";
  100. } else {
  101.     print "The submission to Debian Popularity-Contest failed!\n";
  102. }
  103. exit 0;
  104.