sub _parse_multipart { my $self = shift; my ($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/; unless ($boundary) { $self->cgi_error( '400 No boundary supplied for multipart/form-data' ); return 0; } # BUG: IE 3.01 on the Macintosh uses just the boundary, forgetting the -- $boundary = '--'.$boundary unless $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+3\.0[12];\s*Mac/i; $boundary = quotemeta $boundary; my $got_data = 0; my $data = ''; my $length = $ENV{'CONTENT_LENGTH'} || 0; my $CRLF = $self->crlf; READ: while ( $got_data < $length ) { last READ unless sysread( STDIN, my $buffer, 4096 ); $data .= $buffer; $got_data += length $buffer; BOUNDARY: while ( $data =~ m/^$boundary$CRLF/ ) { next READ unless $data =~ m/^([\040-\176$CRLF]+?$CRLF$CRLF)/o; my $header = $1; (my $unfold = $1) =~ s/$CRLF\s+/ /og; my ($param) = $unfold =~ m/form-data;\s+name="?([^\";]*)"?/; my ($filename) = $unfold =~ m/name="?\Q$param\E"?;\s+filename="?([^\"]*)"?/; if (defined $filename ) { my ($mime) = $unfold =~ m/Content-Type:\s+([-\w\/]+)/io; $data =~ s/^\Q$header\E//; ( $got_data, $data, my $fh, my $size ) = $self->_save_tmpfile( $boundary, $filename, $got_data, $data ); $self->_add_param( $param, $filename ); $self->{'.filehandles'}->{$filename} = $fh if $fh; $self->{'.tmpfiles'}->{$filename} = {'size'=>$size, 'mime'=>$mime } if $size; next BOUNDARY; } next READ unless $data =~ s/^\Q$header\E(.*?)$CRLF(?=$boundary)//s; $self->_add_param( $param, $1 ); } } return $got_data; } sub _save_tmpfile { my ( $self, $boundary, $filename, $got_data, $data ) = @_; my $fh; my $CRLF = $self->crlf; my $length = $ENV{'CONTENT_LENGTH'} || 0; my $file_size = 0; if ( $self->{'.globals'}->{'DISABLE_UPLOADS'} ) { $self->cgi_error("405 Not Allowed - File uploads are disabled"); } elsif ( $filename ) { eval { require IO::File }; $self->cgi_error("500 IO::File is not available $@") if $@; $fh = new_tmpfile IO::File; $self->cgi_error("500 IO::File can't create new temp_file") unless $fh; } # read in data until closing boundary found. buffer to catch split boundary # we do this regardless of whether we save the file or not to read the file # data from STDIN. if either uploads are disabled or no file has been sent # $fh will be undef so only do file stuff if $fh is true using $fh && syntax $fh && binmode $fh; while ( $got_data < $length ) { my $buffer = $data; last unless sysread( STDIN, $data, 4096 ); # fixed hanging bug if browser terminates upload part way through # thanks to Brandon Black unless ( $data ) { $self->cgi_error('400 Malformed multipart, no terminating boundary'); undef $fh; return $got_data; } $got_data += length $data; if ( "$buffer$data" =~ m/$boundary/ ) { $data = $buffer.$data; last; } # we do not have partial boundary so print to file if valid $fh $fh && print $fh $buffer; $file_size += length $buffer; } $data =~ s/^(.*?)$CRLF(?=$boundary)//s; $fh && print $fh $1; # print remainder of file if valid $fh $file_size += length $1; return $got_data, $data, $fh, $file_size; }