home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 July / PCWorld_2000-07_cd.bin / Komunik / sambar / _SETUP.1 / dumpenv.pl < prev    next >
Text File  |  1999-08-19  |  3KB  |  152 lines
  1. print "Sambar Server CGI Environment Variables<P>";
  2. print "<PRE>";
  3.  
  4. #
  5. # Only allow localhost to dump environment variables 
  6. # (ONLY remove after reading the syshelp/security.htm documentation)
  7. #
  8. $host_test = $ENV{'REMOTE_ADDR'};
  9. if (!($host_test eq '127.0.0.1'))
  10. {
  11.     print "Only localhost is allowed to use this script!\n";
  12.     exit(1);
  13. }
  14.  
  15. while(($key,$val) = each(ENV))
  16. {
  17.     print "<B>$key</B>: $val \n";
  18. }
  19.  
  20. print "</PRE>";
  21.  
  22.  
  23.     # Buffer the POST content
  24.     binmode STDIN;
  25.     read(STDIN, $buffer, $content_len);
  26.  
  27.     if ((!$content_type) ||
  28.         ($content_type eq 'application/x-www-form-urlencoded'))
  29.     {
  30.         # Process the name=value argument pairs
  31.         @args = split(/&/, $buffer);
  32.  
  33.         $data = '';
  34.         foreach $pair (@args) 
  35.         {
  36.             ($name, $value) = split(/=/, $pair);
  37.     
  38.             # Unescape the argument value 
  39.             $value =~ tr/+/ /;
  40.             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  41.  
  42.             # Save the name=value pair for use below.
  43.             $FORM{$name} = $value;
  44.         }
  45.     }
  46.     elsif ($content_type =~ m#^multipart/form-data#)
  47.     {
  48.         # find boundary
  49.         # Eric Poulsen fixed the following to allow for quotes.
  50.         #
  51.         # ($boundary = $content_type) =~ s/^.*boundary=(.*)$/\1/;
  52.         ($boundary = $content_type) =~ s/^.*boundary="?(.*?)"?$/\1/;
  53.  
  54.         @pairs = split(/--$boundary/, $buffer);
  55.         @pairs = splice(@pairs,1,$#pairs-1);
  56.  
  57.         for $part (@pairs) 
  58.         {
  59.             ($dump,$fline,$value) = split(/\r\n/,$part,3);
  60.             next if $fline =~ /filename=\"\"/;
  61.             $fline =~ s/^Content-Disposition: form-data; //;
  62.             (@columns) = split(/;\s+/, $fline);
  63.             ($name = $columns[0]) =~ s/^name="([^"]+)"$/\1/g;
  64.  
  65.             if ($#columns > 0) 
  66.             {
  67.                 if ($value =~ /^Content-Type:/) 
  68.                 {
  69.                     ($dump,$dump,$value) = split(/\r\n/,$value,3);
  70.                 }
  71.                 else 
  72.                 {
  73.                     ($dump,$value) = split(/\r\n/,$value,2);
  74.                 }
  75.             }
  76.             else 
  77.             {
  78.                 ($dump,$value) = split(/\r\n/,$value,2);
  79.                 if (grep(/^$name$/, keys(%CGI))) 
  80.                 {
  81.                     if (@{$FORM{$name}} > 0) 
  82.                     {
  83.                         push(@{$FORM{$name}}, $value);
  84.                     }
  85.                     else 
  86.                     {
  87.                         $arrvalue = $FORM{$name};
  88.                         undef $FORM{$name};
  89.                         $FORM{$name}[0] = $arrvalue;
  90.                         push(@{$FORM{$name}}, $value);
  91.                     }
  92.                 }
  93.                 else 
  94.                 {
  95.                     next if $value =~ /^\s*$/;
  96.                     $FORM{$name} = $value;
  97.                 }
  98.                 next;
  99.             }
  100.  
  101.             $FORM{$name} = $value;
  102.         }
  103.     }
  104.     else
  105.     {
  106.         print "Invalid content type!\n";
  107.         exit(1);
  108.     }
  109.  
  110. #
  111. # VERIFY THE FORM DATA
  112. #
  113.     $upfile = $FORM{'upfile'};
  114.     $upname = $FORM{'upname'};
  115.     if (!($upfile) || !($upname))
  116.     {
  117.         print "<HTML><TITLE>Missing fields</TITLE><BODY>\n";
  118.         print "No upload file specified!\n";
  119.         print "</BODY></HTML>\n";
  120.         exit(1);
  121.     }
  122.  
  123.  
  124. #
  125. # CLOSE SECURITY PROBLEMS.
  126. #
  127.     if ($upname =~ /[;><&\*'\|\/\\]/ )
  128.     {
  129.         print "<HTML><TITLE>Invalid file name</TITLE><BODY>\n";
  130.         print "The upload file name is invalid.\n";
  131.         print "</BODY></HTML>\n";
  132.         exit(1);
  133.     }
  134.  
  135. #
  136. # Write out the upload file
  137. #
  138.     $filename = "../docs/upload/".$upname;
  139.     open(FILE, ">$filename") || exit(1);
  140.     binmode FILE;
  141.  
  142.     print FILE $upfile;
  143.     close FILE;
  144.  
  145.  
  146. #
  147. # DONE
  148. #
  149.     print "Upload of ".$upname." succeeded.\n";
  150.  
  151. exit(0);
  152.