ru.cgi.perl

 
 - RU.CGI.PERL ------------------------------------------------------------------
 From : Aleksey Udovydchenko                 2:5020/400     19 Nov 2001  16:12:01
 To : All
 Subject : dcboard 6.21
 -------------------------------------------------------------------------------- 
 

 переделываю сабж чтобы он записывал загружаемые файлы-приложения под их
 собственными именами и расширениями. столкнулся с тем, что его readparse не
 сохраняет имена файлов, если кто то имеет решение для нижеследующего кода
 (кусок readparse, что можно сделать чтобы получить имя файла с расширением в
 r_in?) или решил эту проблему как то еще, прошу помочь:
 
   } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
     # for efficiency, compile multipart code only if needed
 $errflag = !(eval <<'END_MULTIPART');
 
     local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
     local ($bpos, $lpos, $left, $amt, $fn, $ser);
     local ($bufsize, $maxbound, $writefiles) =
       ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
     # The following lines exist solely to eliminate spurious warning
 messages
     $buf = '';
 
     ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
     ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
     my_die("Boundary not provided: probably a bug in your server",$!)
       unless $boundary;
     $boundary =  "--" . $boundary;
     $blen = length ($boundary);
 
     if ($ENV{'REQUEST_METHOD'} ne 'POST') {
       my_die("Invalid request method for  multipart/form-data: $meth\n",$!);
     }
 
     if ($writefiles) {
       local($me);
       stat ($writefiles);
       $writefiles = "/tmp" unless  -d _ && -w _;
       # ($me) = $0 =~ m#([^/]*)$#;
       $writefiles .= "/$cgi_lib'filepre";
     }
 
     # read in the data and split into parts:
     # put headers in @in and data in %in
     # General algorithm:
     #   There are two dividers: the border and the '\r\n\r\n' between
     # header and body.  Iterate between searching for these
     #   Retain a buffer of size(bufsize+maxbound); the latter part is
     # to ensure that dividers don't get lost by wrapping between two bufs
     #   Look for a divider in the current batch.  If not found, then
     # save all of bufsize, move the maxbound extra buffer to the front of
     # the buffer, and read in a new bufsize bytes.  If a divider is found,
     # save everything up to the divider.  Then empty the buffer of
 everything
     # up to the end of the divider.  Refill buffer to bufsize+maxbound
     #   Note slightly odd organization.  Code before BODY: really goes with
     # code following HEAD:, but is put first to 'pre-fill' buffers.  BODY:
     # is placed before HEAD: because we first need to discard any 'preface,'
     # which would be analagous to a body without a preceeding head.
 
     $left = $len;
    PART: # find each part of the multi-part while reading data
     while (1) {
       die $@ if $errflag;
 
       $amt = ($left > $bufsize+$maxbound-length($buf)
        ?  $bufsize+$maxbound-length($buf): $left);
       $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
       die "Short Read: wanted $amt, got $got\n" if $errflag;
       $left -= $amt;
 
       $in{$name} .= "\0" if defined $in{$name};
       $in{$name} .= $fn if $fn;
 
       $name=~/([-\w]+)/;  # This allows $insfn{$name} to be untainted
       if (defined $1) {
         $insfn{$1} .= "\0" if defined $insfn{$1};
         $insfn{$1} .= $fn if $fn;
       }
 
      BODY:
       while (($bpos = index($buf, $boundary)) == -1) {
         if ($left == 0 && $buf eq '') {
    foreach $value (values %insfn) {
             unlink(split("\0",$value));
    }
    my_die("cgi-lib.pl: reached end of input while seeking boundary " .
     "of multipart. Format of CGI input is wrong.\n",$!);
         }
         die $@ if $errflag;
         if ($name) {  # if no $name, then it's the prologue -- discard
           if ($fn) { print FILE substr($buf, 0, $bufsize); }
           else     { $in{$name} .= substr($buf, 0, $bufsize); }
         }
         $buf = substr($buf, $bufsize);
         $amt = ($left > $bufsize ? $bufsize : $left);
 #$maxbound==length($buf);
         $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
  die "Short Read: wanted $amt, got $got\n" if $errflag;
         $left -= $amt;
       }
       if (defined $name) {  # if no $name, then it's the prologue -- discard
         if ($fn) { print FILE substr($buf, 0, $bpos-2); }
         else     { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last
 \r\n
       }
       close (FILE);
       last PART if substr($buf, $bpos + $blen, 2) eq "--";
       substr($buf, 0, $bpos+$blen+2) = '';
       $amt = ($left > $bufsize+$maxbound-length($buf)
        ? $bufsize+$maxbound-length($buf) : $left);
       $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
       die "Short Read: wanted $amt, got $got\n" if $errflag;
       $left -= $amt;
       undef $head;  undef $fn;
      HEAD:
       while (($lpos = index($buf, "\r\n\r\n")) == -1) {
         if ($left == 0  && $buf eq '') {
    foreach $value (values %insfn) {
             unlink(split("\0",$value));
    }
    my_die("cgi-lib: reached end of input while seeking end of " .
     "headers. Format of CGI input is wrong.\n$buf",$!);
         }
         die $@ if $errflag;
         $head .= substr($buf, 0, $bufsize);
         $buf = substr($buf, $bufsize);
         $amt = ($left > $bufsize ? $bufsize : $left);
 #$maxbound==length($buf);
         $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
         die "Short Read: wanted $amt, got $got\n" if $errflag;
         $left -= $amt;
       }
       $head .= substr($buf, 0, $lpos+2);
       push (@in, $head);
       @heads = split("\r\n", $head);
       ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
       ($ct) = grep (/^\s*Content-Type:/i, @heads);
 
       ($name) = $cd =~ /\bname="([^"]+)"/i; #";
       ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
 
       ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be
 null-str
       ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
       $incfn{$name} .= (defined $in{$name} ? "\0" : "") .
         (defined $fname ? $fname : "");
 
       ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i;  #";
       ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined
 $ctype;
       $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
 
       if ($writefiles && defined $fname) {
         $ser++;
  $fn = $writefiles . ".$$.$ser";
  open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
         binmode (FILE);  # write files accurately
       }
       substr($buf, 0, $lpos+4) = '';
       undef $fname;
       undef $ctype;
     }
 
 1;
 END_MULTIPART
 --- ifmail v.2.15dev5
  * Origin: Demos online service (2:5020/400)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор