home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 January / PCWorld_2001-01_cd.bin / Software / Topware / sambar / _SETUP.1 / dumpenv.pl < prev    next >
Encoding:
Text File  |  2000-06-05  |  2.7 KB  |  122 lines
  1. print "<HTML><BODY>";
  2. print "<font size=+2 color=#990033><B><CENTER>";
  3. print "Sambar Server CGI Environment Variables\n";
  4. print "</CENTER></B></font><P>";
  5.  
  6. #
  7. # Only allow localhost to dump environment variables 
  8. # (ONLY remove after reading the syshelp/security.htm documentation)
  9. #
  10. $content_type = $ENV{'CONTENT_TYPE'};
  11. $content_len = $ENV{'CONTENT_LENGTH'};
  12. $host_test = $ENV{'REMOTE_ADDR'};
  13. if (!($host_test eq '127.0.0.1'))
  14. {
  15.     print "Only localhost is allowed to use this script!\n";
  16.     exit(1);
  17. }
  18.  
  19. #
  20. # Parse and display the FORM data.
  21. #
  22. print "<font size=+1 color=#990033><B>CGI FORM Variables</B></font><BR><PRE>\n";
  23.  
  24.     # Buffer the POST content
  25.     binmode STDIN;
  26.     read(STDIN, $buffer, $content_len);
  27.  
  28.     if ((!$content_type) ||
  29.         ($content_type eq 'application/x-www-form-urlencoded'))
  30.     {
  31.         # Process the name=value argument pairs
  32.         @args = split(/&/, $buffer);
  33.  
  34.         $data = '';
  35.         foreach $pair (@args) 
  36.         {
  37.             ($name, $value) = split(/=/, $pair);
  38.     
  39.             # Unescape the argument value 
  40.             $value =~ tr/+/ /;
  41.             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  42.  
  43.             # Print the name=value pair
  44.             print "<B>$name</B>: $value\n";
  45.         }
  46.     }
  47.     elsif ($content_type =~ m#^multipart/form-data#)
  48.     {
  49.         # find boundary
  50.         # Eric Poulsen fixed the following to allow for quotes.
  51.         #
  52.         # ($boundary = $content_type) =~ s/^.*boundary=(.*)$/\1/;
  53.         ($boundary = $content_type) =~ s/^.*boundary="?(.*?)"?$/\1/;
  54.  
  55.         @pairs = split(/--$boundary/, $buffer);
  56.         @pairs = splice(@pairs,1,$#pairs-1);
  57.  
  58.         for $part (@pairs) 
  59.         {
  60.             ($dump,$fline,$value) = split(/\r\n/,$part,3);
  61.             next if $fline =~ /filename=\"\"/;
  62.             $fline =~ s/^Content-Disposition: form-data; //;
  63.             (@columns) = split(/;\s+/, $fline);
  64.             ($name = $columns[0]) =~ s/^name="([^"]+)"$/\1/g;
  65.  
  66.             if ($#columns > 0) 
  67.             {
  68.                 if ($value =~ /^Content-Type:/) 
  69.                 {
  70.                     ($dump,$dump,$value) = split(/\r\n/,$value,3);
  71.                 }
  72.                 else 
  73.                 {
  74.                     ($dump,$value) = split(/\r\n/,$value,2);
  75.                 }
  76.             }
  77.             else 
  78.             {
  79.                 ($dump,$value) = split(/\r\n/,$value,2);
  80.                 if (grep(/^$name$/, keys(%CGI))) 
  81.                 {
  82.                     # Print the name=value pair
  83.                     print "<B>$name</B>: $value\n";
  84.                 }
  85.                 else 
  86.                 {
  87.                     next if $value =~ /^\s*$/;
  88.                     
  89.                     # Print the name=value pair
  90.                     print "<B>$name</B>: $value\n";
  91.                 }
  92.                 next;
  93.             }
  94.  
  95.             $FORM{$name} = $value;
  96.         }
  97.     }
  98.     else
  99.     {
  100.         print "Invalid content type (expecting POST)!\n";
  101.         exit(1);
  102.     }
  103.  
  104. #
  105. # Display the shell environment variables first
  106. #
  107. print "</PRE><P>\n";
  108. print "<font size=+1 color=#990033><B>Shell Environment</B></font><BR><PRE>\n";
  109. while(my($key,$val) = each(ENV))
  110. {
  111.     print "<B>$key</B>: $val \n";
  112. }
  113.  
  114.  
  115. #
  116. # DONE
  117. #
  118. print "</PRE>";
  119. print "</BODY></HTML>";
  120.  
  121. exit(0);
  122.