Changeset 66 for trunk

Show
Ignore:
Timestamp:
11/24/09 01:50:38 (4 years ago)
Author:
clinton
Message:

Improve commenting throughout MultiPartFormData?, document upload API in Request, and fix trac18 bug in which duplicate CGI params were overwritten, tid10737 tid10892

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lib/Mungo.pm

    r56 r66  
    261261 
    262262use vars qw/$VERSION 
    263             $DEFAULT_POST_BLOCK $DEFAULT_POST_MAX_SIZE 
     263            $DEFAULT_POST_BLOCK_SIZE $DEFAULT_POST_MAX_SIZE 
    264264            $DEFAULT_POST_MAX_PART $DEFAULT_POST_MAX_IN_MEMORY/; 
    265265 
    …… 
    268268$VERSION = "1.0.0.${SVN_VERSION}"; 
    269269 
    270 $DEFAULT_POST_BLOCK = 1024*32;          # 32k 
     270$DEFAULT_POST_BLOCK_SIZE = 1024*32;          # 32k 
    271271$DEFAULT_POST_MAX_SIZE = 0;             # unlimited post size 
    272272$DEFAULT_POST_MAX_PART = 0;             # and part size 

  • trunk/lib/Mungo/MultipartFormData.pm

    r28 r66  
    11package Mungo::MultipartFormData; 
    22 
    3 # Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved. 
     3# Copyright (c) 2007-2009 OmniTI Computer Consulting, Inc. All rights reserved. 
    44# For information on licensing see: 
    5 #   https://labs.omniti.com/zetaback/trunk/LICENSE 
     5#   https://labs.omniti.com/mungo/trunk/LICENSE 
    66 
    77use strict; 
    …… 
    1212eval "use Apache2::RequestIO;"; 
    1313 
    14 package Mungo::MultipartFormData; 
     14=head2 $mpfd = Mungo::MultipartFormData->new($req, $length, $boundary); 
     15 
     16Parses the incoming content. $req should be an Apache2::RequestRec. 
     17 
     18=cut 
     19 
    1520sub new { 
    16   my $class = shift; 
    17   my $self = bless {}, $class; 
    18   $self->load(@_); 
    19  
    20   # Now merge up the parts into the hash itself, so it looks "normal" 
    21   foreach my $part (@{$self->{parts}}) { 
    22     if($part->{name}) { 
    23       if($part->{filename}) { 
    24         $self->{$part->{name}} = $part; 
    25         if(exists($part->{payload})) { 
    26           open($part->{handle}, "<", \$part->{payload}); 
    27           delete $part->{payload}; 
    28         } 
    29         $part->{handle}->seek(0,0) if(UNIVERSAL::can($part->{handle}, 'seek')); 
    30       } 
    31       else { 
    32         $self->{$part->{name}} = $part->{payload}; 
    33       } 
    34     } 
    35     delete $part->{maxmem}; 
    36     delete $part->{name}; 
    37   } 
    38   delete $self->{parts}; 
    39   $self; 
     21    my $class = shift; 
     22    my $self = bless {}, $class; 
     23    $self->load(@_); 
     24 
     25    # Now merge up the parts into the hash itself, so it looks "normal" 
     26    foreach my $part (@{$self->{parts}}) { 
     27        if ($part->{name}) { 
     28            my $name = $part->{name}; 
     29 
     30            if ($part->{filename}) { 
     31                # Looks like a file.  Trim down the Part a bit. 
     32                delete $part->{maxmem}; 
     33                delete $part->{name}; 
     34 
     35                # Prep the Part for reading as a fielhandle. 
     36                if (exists($part->{payload}) && !exists($part->{handle})) { 
     37                    # So we have a payload, but not a handle?  Must have been a small file. 
     38                    # Create a new IO::Handle by opening the payload "in memory" 
     39                    # See perldoc -f open and perldoc perliol 
     40                    open($part->{handle}, "<", \$part->{payload}); 
     41                    delete $part->{payload}; 
     42                } 
     43                $part->{handle}->seek(0,0) if(UNIVERSAL::can($part->{handle}, 'seek')); 
     44 
     45                # OK, now store the whole Part. Be careful not to stomp on duplicates. 
     46                if (exists $self->{$name}) { 
     47                    # We already have a param with this name.  Promote to arrayref. 
     48                    if (ref($self->{$name}) eq 'ARRAY') { 
     49                        push @{$self->{$name}}, $part; 
     50                    } else { 
     51                        # Need to make it an arrayref. 
     52                        $self->{$name} = [ $self->{$name}, $part ]; 
     53                    } 
     54                } else { 
     55                    $self->{$part->{name}} = $part; 
     56                } 
     57 
     58            } else { 
     59                # Doesn't look like a file upload.  Drop all Part trappings, 
     60                # and just keep the payload. 
     61                if (exists $self->{$name}) { 
     62                    # We already have a param with this name.  Promote to arrayref. 
     63                    if (ref($self->{$name}) eq 'ARRAY') { 
     64                        push @{$self->{$name}}, $part->{payload}; 
     65                    } else { 
     66                        # Need to make it an arrayref. 
     67                        $self->{$name} = [ $self->{$name}, $part->{payload} ]; 
     68                    } 
     69                } else { 
     70                    $self->{$part->{name}} = $part->{payload}; 
     71                } 
     72            } 
     73        } else { 
     74            # Drop nameless parts? 
     75        } 
     76    } 
     77    delete $self->{parts}; 
     78 
     79  return $self; 
    4080} 
    4181 
    4282sub load { 
    43   my ($self, $r, $cl, $b) = @_; 
    44   my $BLOCK = $r->dir_config('PostBlockSize') || $Mungo::DEFAULT_POST_BLOCK; 
    45   my $MAXSIZE = $r->dir_config('PostMaxSize') || $Mungo::DEFAULT_POST_MAX_SIZE; 
    46   my $MAXPART = $r->dir_config('PostMaxPart') || $Mungo::DEFAULT_POST_MAX_PART; 
    47   my $MAXMEM = $r->dir_config('PostMaxInMemory') || 
    48                  $Mungo::DEFAULT_POST_MAX_IN_MEMORY; 
    49  
    50   # I expect to see the boundary as the first thing.. so $BLOCK has to be 
    51   # at least the length of boundary + CR LF 
    52   $BLOCK = length($b) + 2 unless($BLOCK > length($b) + 2); 
    53  
    54   my $bytes_read = 0; 
    55   my $part = ''; 
    56   my $buffer = "\r\n"; 
    57   my $new_buffer = ''; 
    58   my $current_part; 
    59   while($bytes_read < $cl) { 
    60     my $to_read = ($BLOCK < $cl - $bytes_read) ? $BLOCK : ($cl - $bytes_read); 
    61     $r->read($new_buffer, $to_read); 
    62     $buffer .= $new_buffer; 
    63     my $pos; 
    64     while(($pos = index($buffer, "\r\n--$b\r\n")) >= 0) { 
    65       if($current_part) { 
    66         $current_part->append(substr($buffer, 0, $pos)); 
    67       } 
    68       $current_part = Mungo::MultipartFormData::Part->new($MAXMEM); 
    69       push @{$self->{parts}}, $current_part; 
    70       substr($buffer, 0, $pos + length($b) + 6) = ''; 
    71     } 
    72     if(!$current_part) { 
    73       $current_part = Mungo::MultipartFormData::Part->new($MAXMEM); 
    74       push @{$self->{parts}}, $current_part; 
    75     } 
    76     if(($pos = index($buffer, "\r\n--$b--")) >= 0) { 
    77       $current_part->append(substr($buffer, 0, $pos)); 
    78       $buffer = ''; 
    79     } 
    80     elsif(length($buffer) > length($b) + 6) { 
    81       # This is to make sure we leave enough to index() in the next pass 
    82       $current_part->append(substr($buffer, 0, 
    83                                    length($buffer) - length($b) - 6)); 
    84       substr($buffer, 0, length($buffer) - length($b) - 6) = ''; 
    85     } 
    86     $bytes_read += length($new_buffer); 
    87   } 
     83    my ($self, $r, $cl, $boundary) = @_; 
     84    my $BLOCK_SIZE = $r->dir_config('PostBlockSize') || $Mungo::DEFAULT_POST_BLOCK_SIZE; 
     85    my $MAXSIZE = $r->dir_config('PostMaxSize') || $Mungo::DEFAULT_POST_MAX_SIZE; 
     86    my $MAXPART = $r->dir_config('PostMaxPart') || $Mungo::DEFAULT_POST_MAX_PART; 
     87    my $MAXMEM = $r->dir_config('PostMaxInMemory')  
     88      || $Mungo::DEFAULT_POST_MAX_IN_MEMORY; 
     89 
     90    # I expect to see the boundary as the first thing.. so $BLOCK_SIZE has to be 
     91    # at least the length of boundary + CR LF 
     92    $BLOCK_SIZE = length($boundary) + 2 unless($BLOCK_SIZE > length($boundary) + 2); 
     93 
     94    my $bytes_read = 0; 
     95    my $part = ''; 
     96    my $buffer = "\r\n"; 
     97    my $new_buffer = ''; 
     98    my $current_part; 
     99    while($bytes_read < $cl) { 
     100 
     101        # Read in a chunk 
     102        my $to_read = ($BLOCK_SIZE < $cl - $bytes_read) ? $BLOCK_SIZE : ($cl - $bytes_read); 
     103        $r->read($new_buffer, $to_read); 
     104        $buffer .= $new_buffer; 
     105 
     106        # The chunk may contain one or more inner boundaries, meaning we have  
     107        # reached the end of a Part. 
     108        my $pos; 
     109        while(($pos = index($buffer, "\r\n--$boundary\r\n")) >= 0) { 
     110            if($current_part) { 
     111                $current_part->append(substr($buffer, 0, $pos)); 
     112            } 
     113            $current_part = Mungo::MultipartFormData::Part->new($MAXMEM); 
     114            push @{$self->{parts}}, $current_part; 
     115            # Remove the processed portion of the buffer (lvalue form of substr) 
     116            substr($buffer, 0, $pos + length("\r\n--$boundary\r\n")) = ''; 
     117        } 
     118 
     119        # No (more) inner boundaries in the buffer.  Make sure  
     120        if(!$current_part) { 
     121            $current_part = Mungo::MultipartFormData::Part->new($MAXMEM); 
     122            push @{$self->{parts}}, $current_part; 
     123        } 
     124 
     125        # The last boundary will not have a \r\n at the end.  Check for that and 
     126        # append to the current part. 
     127        if(($pos = index($buffer, "\r\n--$boundary--")) >= 0) { 
     128            $current_part->append(substr($buffer, 0, $pos)); 
     129            $buffer = ''; 
     130        } elsif(length($buffer) > length("\r\n--$boundary--")) { 
     131            # This is to make sure we leave enough to index() in the next pass 
     132            $current_part->append(substr($buffer, 0, 
     133                                         length($buffer) - length($boundary) - 6)); 
     134            substr($buffer, 0, length($buffer) - length($boundary) - 6) = ''; 
     135        } 
     136        $bytes_read += length($new_buffer); 
     137    } 
    88138} 
    89139 
    …… 
    120170} 
    121171sub append { 
    122   my $self = shift; 
    123   my $buffer = shift; 
    124   $self->{size} += length($buffer); 
    125   if(exists($self->{handle})) { 
    126     $self->{handle}->print($buffer); 
    127   } 
    128   else { 
    129     $self->{payload} .= $buffer; 
    130     $self->extract_headers(); 
    131     if(length($self->{payload}) > $self->{maxmem}) { 
    132       my($fh, $file) = tmpnam(); 
    133       my $seekable = IO::File->new($file, "r+") if($fh); 
    134       if(!$seekable) { 
    135         print STDERR "Could not create tmpfile (for POST storage)\n"; 
    136         return undef; 
    137       } 
    138       $fh->close(); 
    139       unlink($file); 
    140       $self->{handle} = $seekable; 
    141       $self->{handle}->print($self->{payload}) || die "cannot write to tmpfile"; 
    142       delete $self->{payload}; 
    143     } 
    144   } 
     172    my $self = shift; 
     173    my $buffer = shift; 
     174    $self->{size} += length($buffer); 
     175 
     176    # If we've already gotten so big that we store in a tempfile, just write to it. 
     177    if (exists($self->{handle})) { 
     178        $self->{handle}->print($buffer); 
     179    } else { 
     180        $self->{payload} .= $buffer; 
     181        $self->extract_headers(); 
     182        if (length($self->{payload}) > $self->{maxmem}) { 
     183            # We've gotten too big for our britches. 
     184            my ($fh, $file) = tmpnam(); 
     185 
     186            # Upgrade the filehandle returned by tmpname so we can seek on it 
     187            my $seekable; 
     188            $seekable = IO::File->new($file, "r+") if ($fh); 
     189            if(!$seekable) { 
     190                print STDERR "Could not create tmpfile (for POST storage)\n"; 
     191                return undef; 
     192            } 
     193            $self->{handle} = $seekable; 
     194 
     195            # Cleanup 
     196            $fh->close();  # We're done with the fh returned by tmpname (we have a seekable version in $self->handle) 
     197            unlink($file); # Unlink the file.  Now the only reference is our handle; when that does away, the inode will be freed. 
     198 
     199            # OK, send the payload to the filehandle. 
     200            $self->{handle}->print($self->{payload}) || die "cannot write to tmpfile $file"; 
     201            delete $self->{payload}; 
     202 
     203            # Next time we append, since we have $self->{handle}, we'll print imemdiately. 
     204        } 
     205    } 
    145206} 
    146207 

  • trunk/lib/Mungo/Request.pm

    r50 r66  
    5050  %> 
    5151 
     52  <!-- Get uploaded file data --> 
     53  <% 
     54     # Assuming you have <input type="file" name="myfile" /> 
     55 
     56     my $param = $Request->Params->{myfile}; 
     57 
     58     my $handle = $param->{handle}; 
     59     my $filename_on_client = $param->{filename}; 
     60     my $total_size = $param->{size}; 
     61     my $content_type = $param->{'content-type'}; # Not entirely reliable - consider File::MMagic or similar 
     62 
     63     # $handle is a IO::Handle subclass 
     64     my ($content, $chunk); 
     65     while (my $bytes_read = $handle->read($chunk, 1024)) { 
     66        $content .= $chunk; 
     67     ) 
     68 
     69  %> 
     70 
     71 
     72 
    5273=head1 DESCRIPTION 
    5374 
    5475Represents the request side of a Mungo request cycle. 
    5576 
    56 See Mungo, and Mungo::Request. 
     77See Mungo, and Mungo::Response. 
    5778 
    5879=cut