root/trunk/lib/Mungo/MultipartFormData.pm

Revision 67, 7.5 kB (checked in by clinton, 4 years ago)

Fixed bug introduced in r66 in which all file uploads got the empty string as a name

Line 
1 package Mungo::MultipartFormData;
2
3 # Copyright (c) 2007-2009 OmniTI Computer Consulting, Inc. All rights reserved.
4 # For information on licensing see:
5 #   https://labs.omniti.com/mungo/trunk/LICENSE
6
7 use strict;
8 use Mungo;
9 use Mungo::Request;
10 use File::Temp;
11 use IO::File;
12 eval "use Apache2::RequestIO;";
13
14 =head2 $mpfd = Mungo::MultipartFormData->new($req, $length, $boundary);
15
16 Parses the incoming content. $req should be an Apache2::RequestRec.
17
18 =cut
19
20 sub new {
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->{$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->{$name} = $part->{payload};
71                 }
72             }
73         } else {
74             # Drop nameless parts?
75         }
76     }
77     delete $self->{parts};
78
79   return $self;
80 }
81
82 sub load {
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     }
138 }
139
140 package Mungo::MultipartFormData::Part;
141
142 use strict;
143 use File::Temp qw/:POSIX/;
144
145 sub new {
146   my $class = shift;
147   my $maxmem = shift;
148   return bless { payload => '', maxmem => $maxmem }, $class;
149 }
150
151 sub extract_headers {
152   my $self = shift;
153   # We already extracted out headers
154   return if($self->{name});
155   my $pos = index($self->{payload}, "\r\n\r\n");
156   my @headers = split(/\r\n/, substr($self->{payload}, 0, $pos));
157   # Consume it
158   substr($self->{payload}, 0, $pos + 4) = '';
159   $self->{size} = length($self->{payload});
160   foreach my $header (@headers) {
161     my ($k, $v) = split(/:\s+/, $header, 2);
162     $self->{lc $k} = $v;
163     if(lc $k eq 'content-disposition') {
164       if($v =~ /^form-data;/) {
165         $self->{name} = $1 if($v =~ / name="([^;]*)"/);
166         $self->{filename} = $1 if($v =~ / filename="([^;]*)"/);
167       }
168     }
169   }
170 }
171 sub append {
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     }
206 }
207
208 1;
Note: See TracBrowser for help on using the browser.