PERL   29

success cgi

Guest on 10th July 2022 08:02:27 PM

  1. #!/usr/bin/perl
  2.  
  3. use Time::Local;
  4.  
  5. #$domain = "172.16.20.36";
  6. $domain = ".mixmedia.com";
  7. $optoutname = "RMOPTOUT";
  8.  
  9.  
  10.  
  11. $future_time = "Friday, 31-Dec-2010 23:59:59";
  12. $expire_time = "Tuesday, 2-Apr-1985 00:00:00";
  13. %itsNodeHash = 0;
  14.  
  15. sub Decode
  16. {
  17.         my ($words) = @_;
  18.         while ($words =~ /(\%[0-9A-F][0-9A-F])/)
  19.         {
  20.                 my ($decode) = &DecodeToken ($1);
  21.                 $words =~ s/$1/$decode/g;
  22.         }
  23.         $words =~ s/\+/ /g;
  24.         return $words;
  25. }
  26.  
  27. sub GetDataField
  28. {
  29.         my ($name) = @_;
  30.         my ($values) = $itsNodeHash{$name};
  31.         return pop (@$values);
  32. }
  33.  
  34. #
  35. # Main
  36. #
  37.  
  38. #create the headers
  39.  
  40.  
  41. my ($input);
  42. my ($node);
  43. if (! ($input = $ENV{"QUERY_STRING"}))
  44. {
  45.         $input = <STDIN>;
  46. }
  47. chomp ($input);
  48. foreach $node (split ('&', $input))
  49. {
  50.         my ($name, $value) = split ('=', $node);
  51.         my ($decodedName) = &Decode ($name);
  52.         my ($decodedValue) = &Decode ($value);
  53.         my ($values) = $itsNodeHash{$decodedName};
  54.         push (@$values, $decodedValue);
  55.         $itsNodeHash{$decodedName} = $values;
  56. }
  57. print %itsNodeHash;
  58.  
  59. #get the Domain
  60. $domainKey = "Domain";
  61. chomp ($tmpDomain = &GetDataField ($domainKey));
  62. if (length($tmpDomain) > 0) { $domain = $tmpDomain; }
  63.  
  64. # Get the action
  65. $actionKey = "Action";
  66. chomp ($actionVal = &GetDataField ($actionKey));
  67. #print "HTTP/1.1 302 Found\n";
  68. #print "Connection: close\n";
  69. print "Content-type:text/html\n\n";
  70.  
  71. #this is the second request. If there is no opt out cookie, or if there are other cookies in the domain, redirect to failure, otherwise redirect to success.
  72.  
  73.         $nopt_found = 0;
  74.         $opt_found = 1;
  75.         print "<br>opt_out_name=$optoutname\n";
  76.         print"<br>evn stuff ==>> $ENV{'HTTP_COOKIE'} \n\n";    
  77.         foreach $cookie (split ('; ', $ENV{'HTTP_COOKIE'}))
  78.         {
  79.                 my ($cookieName) = (split ('=', $cookie))[0];
  80.                 my ($cookieVal) = (split ('=', $cookie))[1];
  81.                 if ($cookieName ne $optoutname) { $nopt_found = 1;}
  82.                 else { $opt_found = 0; }
  83.                 print "<br>$cookieName = $cookieVal \n ";
  84.                
  85.         }
  86. print "<br>nopt_found = $nopt_found and opt_found=$opt_found\n";
  87.         if ( ($nopt_found + $opt_found) > 0) { print "<img src='/optout/opt_failure.gif'>\n\n"; }
  88.         else {print "Location: /optout/opt_success.gif\n\n"; }

Raw Paste


Login or Register to edit or fork this paste. It's free.