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