home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / CHIPCD_9_99.iso / software / serwery_www / sambar / _setup.1 / UPLOAD.PL < prev    next >
Text File  |  1998-05-27  |  3KB  |  143 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.  
  17.     # Buffer the POST content
  18.     binmode STDIN;
  19.     read(STDIN, $buffer, $content_len);
  20.  
  21.     if ((!$content_type) ||
  22.         ($content_type eq 'application/x-www-form-urlencoded'))
  23.     {
  24.         # Process the name=value argument pairs
  25.         @args = split(/&/, $buffer);
  26.  
  27.         $data = '';
  28.         foreach $pair (@args) 
  29.         {
  30.             ($name, $value) = split(/=/, $pair);
  31.     
  32.             # Unescape the argument value 
  33.             $value =~ tr/+/ /;
  34.             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  35.  
  36.             # Save the name=value pair for use below.
  37.             $FORM{$name} = $value;
  38.         }
  39.     }
  40.     elsif ($content_type =~ m#^multipart/form-data#)
  41.     {
  42.         # find boundary
  43.         ($boundary = $content_type) =~ s/^.*boundary=(.*)$/\1/;
  44.  
  45.         @pairs = split(/--$boundary/, $buffer);
  46.         @pairs = splice(@pairs,1,$#pairs-1);
  47.  
  48.         for $part (@pairs) 
  49.         {
  50.             ($dump,$fline,$value) = split(/\r\n/,$part,3);
  51.             next if $fline =~ /filename=\"\"/;
  52.             $fline =~ s/^Content-Disposition: form-data; //;
  53.             (@columns) = split(/;\s+/, $fline);
  54.             ($name = $columns[0]) =~ s/^name="([^"]+)"$/\1/g;
  55.  
  56.             if ($#columns > 0) 
  57.             {
  58.                 if ($value =~ /^Content-Type:/) 
  59.                 {
  60.                     ($dump,$dump,$value) = split(/\r\n/,$value,3);
  61.                 }
  62.                 else 
  63.                 {
  64.                     ($dump,$value) = split(/\r\n/,$value,2);
  65.                 }
  66.             }
  67.             else 
  68.             {
  69.                 ($dump,$value) = split(/\r\n/,$value,2);
  70.                 if (grep(/^$name$/, keys(%CGI))) 
  71.                 {
  72.                     if (@{$FORM{$name}} > 0) 
  73.                     {
  74.                         push(@{$FORM{$name}}, $value);
  75.                     }
  76.                     else 
  77.                     {
  78.                         $arrvalue = $FORM{$name};
  79.                         undef $FORM{$name};
  80.                         $FORM{$name}[0] = $arrvalue;
  81.                         push(@{$FORM{$name}}, $value);
  82.                     }
  83.                 }
  84.                 else 
  85.                 {
  86.                     next if $value =~ /^\s*$/;
  87.                     $FORM{$name} = $value;
  88.                 }
  89.                 next;
  90.             }
  91.  
  92.             $FORM{$name} = $value;
  93.         }
  94.     }
  95.     else
  96.     {
  97.         print "Invalid content type!\n";
  98.         exit(1);
  99.     }
  100.  
  101. #
  102. # VERIFY THE FORM DATA
  103. #
  104.     $upfile = $FORM{'upfile'};
  105.     $upname = $FORM{'upname'};
  106.     if (!($upfile) || !($upname))
  107.     {
  108.         print "<HTML><TITLE>Missing fields</TITLE><BODY>\n";
  109.         print "No upload file specified!\n";
  110.         print "</BODY></HTML>\n";
  111.         exit(1);
  112.     }
  113.  
  114.  
  115. #
  116. # CLOSE SECURITY PROBLEMS.
  117. #
  118.     if ($upname =~ /[;><&\*'\|\/\\]/ )
  119.     {
  120.         print "<HTML><TITLE>Invalid file name</TITLE><BODY>\n";
  121.         print "The upload file name is invalid.\n";
  122.         print "</BODY></HTML>\n";
  123.         exit(1);
  124.     }
  125.  
  126. #
  127. # Write out the upload file
  128. #
  129.     $filename = "../docs/upload/".$upname;
  130.     open(FILE, ">$filename") || exit(1);
  131.     binmode FILE;
  132.  
  133.     print FILE $upfile;
  134.     close FILE;
  135.  
  136.  
  137. #
  138. # DONE
  139. #
  140.     print "Upload of ".$upname." succeeded.\n";
  141.  
  142. exit(0);
  143.