root/trunk/lib/Mungo/MultipartFormData.pm

Revision 68, 7.7 kB (checked in by clinton, 4 years ago)

Bless synthetic handle for small files to be an IO::Handle, so that the interface is consistent, tid10737 tid10892

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 use Data::Dumper;
13 eval "use Apache2::RequestIO;";
14
15 =head2 $mpfd = Mungo::MultipartFormData->new($req, $length, $boundary);
16
17 Parses the incoming content. $req should be an Apache2::RequestRec.
18
19 =cut
20
21 sub new {
22     my $class = shift;
23     my $self = bless {}, $class;
24     $self->load(@_);
25
26     # Now merge up the parts into the hash itself, so it looks "normal"
27     foreach my $part (@{$self->{parts}}) {
28         if ($part->{name}) {
29             my $name = $part->{name};
30
31             if ($part->{filename}) {
32                 # Looks like a file.  Trim down the Part a bit.
33                 delete $part->{maxmem};
34                 delete $part->{name};
35
36                 # Prep the Part for reading as a fielhandle.
37                 if (exists($part->{payload}) && !exists($part->{handle})) {
38                     # So we have a payload, but not a handle?  Must have been a small file.
39
40                     # Create a new IO::Handle by opening the payload "in memory"
41                     # See perldoc -f open and perldoc perliol
42                     # I would MUCH rather use IO::Scalar for this - it's much saner and more clear
43                     open($part->{handle}, "<", \$part->{payload}); # just threw up in my mouth a little
44                     bless $part->{handle}, 'IO::Handle'; # just threw up in my mouth a lot
45                     delete $part->{payload};
46                 }
47                 $part->{handle}->seek(0,0) if(UNIVERSAL::can($part->{handle}, 'seek'));
48
49                 # OK, now store the whole Part. Be careful not to stomp on duplicates.
50                 if (exists $self->{$name}) {
51                     # We already have a param with this name.  Promote to arrayref.
52                     if (ref($self->{$name}) eq 'ARRAY') {
53                         push @{$self->{$name}}, $part;
54                     } else {
55                         # Need to make it an arrayref.
56                         $self->{$name} = [ $self->{$name}, $part ];
57                     }
58                 } else {
59                     $self->{$name} = $part;
60                 }
61
62             } else {
63                 # Doesn't look like a file upload.  Drop all Part trappings,
64                 # and just keep the payload.
65                 if (exists $self->{$name}) {
66                     # We already have a param with this name.  Promote to arrayref.
67                     if (ref($self->{$name}) eq 'ARRAY') {
68                         push @{$self->{$name}}, $part->{payload};
69                     } else {
70                         # Need to make it an arrayref.
71                         $self->{$name} = [ $self->{$name}, $part->{payload} ];
72                     }
73                 } else {
74                     $self->{$name} = $part->{payload};
75                 }
76             }
77         } else {
78             # Drop nameless parts?
79         }
80     }
81     delete $self->{parts};
82
83   return $self;
84 }
85
86 sub load {
87     my ($self, $r, $cl, $boundary) = @_;
88     my $BLOCK_SIZE = $r->dir_config('PostBlockSize') || $Mungo::DEFAULT_POST_BLOCK_SIZE;
89     my $MAXSIZE = $r->dir_config('PostMaxSize') || $Mungo::DEFAULT_POST_MAX_SIZE;
90     my $MAXPART = $r->dir_config('PostMaxPart') || $Mungo::DEFAULT_POST_MAX_PART;
91     my $MAXMEM = $r->dir_config('PostMaxInMemory')
92       || $Mungo::DEFAULT_POST_MAX_IN_MEMORY;
93
94     # I expect to see the boundary as the first thing.. so $BLOCK_SIZE has to be
95     # at least the length of boundary + CR LF
96     $BLOCK_SIZE = length($boundary) + 2 unless($BLOCK_SIZE > length($boundary) + 2);
97
98     my $bytes_read = 0;
99     my $part = '';
100     my $buffer = "\r\n";
101     my $new_buffer = '';
102     my $current_part;
103     while($bytes_read < $cl) {
104
105         # Read in a chunk
106         my $to_read = ($BLOCK_SIZE < $cl - $bytes_read) ? $BLOCK_SIZE : ($cl - $bytes_read);
107         $r->read($new_buffer, $to_read);
108         $buffer .= $new_buffer;
109
110         # The chunk may contain one or more inner boundaries, meaning we have
111         # reached the end of a Part.
112         my $pos;
113         while(($pos = index($buffer, "\r\n--$boundary\r\n")) >= 0) {
114             if($current_part) {
115                 $current_part->append(substr($buffer, 0, $pos));
116             }
117             $current_part = Mungo::MultipartFormData::Part->new($MAXMEM);
118             push @{$self->{parts}}, $current_part;
119             # Remove the processed portion of the buffer (lvalue form of substr)
120             substr($buffer, 0, $pos + length("\r\n--$boundary\r\n")) = '';
121         }
122
123         # No (more) inner boundaries in the buffer.  Make sure
124         if(!$current_part) {
125             $current_part = Mungo::MultipartFormData::Part->new($MAXMEM);
126             push @{$self->{parts}}, $current_part;
127         }
128
129         # The last boundary will not have a \r\n at the end.  Check for that and
130         # append to the current part.
131         if(($pos = index($buffer, "\r\n--$boundary--")) >= 0) {
132             $current_part->append(substr($buffer, 0, $pos));
133             $buffer = '';
134         } elsif(length($buffer) > length("\r\n--$boundary--")) {
135             # This is to make sure we leave enough to index() in the next pass
136             $current_part->append(substr($buffer, 0,
137                                          length($buffer) - length($boundary) - 6));
138             substr($buffer, 0, length($buffer) - length($boundary) - 6) = '';
139         }
140         $bytes_read += length($new_buffer);
141     }
142 }
143
144 package Mungo::MultipartFormData::Part;
145
146 use strict;
147 use File::Temp qw/:POSIX/;
148
149 sub new {
150   my $class = shift;
151   my $maxmem = shift;
152   return bless { payload => '', maxmem => $maxmem }, $class;
153 }
154
155 sub extract_headers {
156   my $self = shift;
157   # We already extracted out headers
158   return if($self->{name});
159   my $pos = index($self->{payload}, "\r\n\r\n");
160   my @headers = split(/\r\n/, substr($self->{payload}, 0, $pos));
161   # Consume it
162   substr($self->{payload}, 0, $pos + 4) = '';
163   $self->{size} = length($self->{payload});
164   foreach my $header (@headers) {
165     my ($k, $v) = split(/:\s+/, $header, 2);
166     $self->{lc $k} = $v;
167     if(lc $k eq 'content-disposition') {
168       if($v =~ /^form-data;/) {
169         $self->{name} = $1 if($v =~ / name="([^;]*)"/);
170         $self->{filename} = $1 if($v =~ / filename="([^;]*)"/);
171       }
172     }
173   }
174 }
175 sub append {
176     my $self = shift;
177     my $buffer = shift;
178     $self->{size} += length($buffer);
179
180     # If we've already gotten so big that we store in a tempfile, just write to it.
181     if (exists($self->{handle})) {
182         $self->{handle}->print($buffer);
183     } else {
184         $self->{payload} .= $buffer;
185         $self->extract_headers();
186         if (length($self->{payload}) > $self->{maxmem}) {
187             # We've gotten too big for our britches.
188             my ($fh, $file) = tmpnam();
189
190             # Upgrade the filehandle returned by tmpname so we can seek on it
191             my $seekable;
192             $seekable = IO::File->new($file, "r+") if ($fh);
193             if(!$seekable) {
194                 print STDERR "Could not create tmpfile (for POST storage)\n";
195                 return undef;
196             }
197             $self->{handle} = $seekable;
198
199             # Cleanup
200             $fh->close();  # We're done with the fh returned by tmpname (we have a seekable version in $self->handle)
201             unlink($file); # Unlink the file.  Now the only reference is our handle; when that does away, the inode will be freed.
202
203             # OK, send the payload to the filehandle.
204             $self->{handle}->print($self->{payload}) || die "cannot write to tmpfile $file";
205             delete $self->{payload};
206
207             # Next time we append, since we have $self->{handle}, we'll print immediately.
208         }
209     }
210 }
211
212 1;
Note: See TracBrowser for help on using the browser.