root/trunk/lib/Mungo/MultipartFormData.pm

Revision 17, 4.2 kB (checked in by jesus, 6 years ago)

first whack at resolving mod_perl2 support. refs #8

Line 
1 package Mungo::MultipartFormData;
2
3 # Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
4 # For information on licensing see:
5 #   https://labs.omniti.com/zetaback/trunk/LICENSE
6
7 use strict;
8 use IO::Scalar;
9 use Mungo;
10 use Mungo::Request;
11 eval "use Apache2::RequestIO;";
12
13 sub new {
14   my $class = shift;
15   my $self = bless {}, $class;
16   $self->load(@_);
17
18   # Now merge up the parts into the hash itself, so it looks "normal"
19   foreach my $part (@{$self->{parts}}) {
20     if($part->{name}) {
21       if($part->{filename}) {
22         $self->{$part->{name}} = $part;
23         # Make this payload into an IO::Scalar
24         if(exists($part->{payload})) {
25           $part->{handle} = IO::Scalar->new(\$part->{payload});
26           delete $part->{payload};
27         }
28         $part->{handle}->seek(0,0) if(UNIVERSAL::can($part->{handle}, 'seek'));
29       }
30       else {
31         $self->{$part->{name}} = $part->{payload};
32       }
33     }
34     delete $part->{maxmem};
35     delete $part->{name};
36   }
37   delete $self->{parts};
38   $self;
39 }
40
41 sub load {
42   my ($self, $r, $cl, $b) = @_;
43   my $BLOCK = $r->dir_config('PostBlockSize') || $Mungo::DEFAULT_POST_BLOCK;
44   my $MAXSIZE = $r->dir_config('PostMaxSize') || $Mungo::DEFAULT_POST_MAX_SIZE;
45   my $MAXPART = $r->dir_config('PostMaxPart') || $Mungo::DEFAULT_POST_MAX_PART;
46   my $MAXMEM = $r->dir_config('PostMaxInMemory') ||
47                  $Mungo::DEFAULT_POST_MAX_IN_MEMORY;
48
49   # I expect to see the boundary as the first thing.. so $BLOCK has to be
50   # at least the length of boundary + CR LF
51   $BLOCK = length($b) + 2 unless($BLOCK > length($b) + 2);
52
53   my $bytes_read = 0;
54   my $part = '';
55   my $buffer = "\r\n";
56   my $new_buffer = '';
57   my $current_part;
58   while($bytes_read < $cl) {
59     my $to_read = ($BLOCK < $cl - $bytes_read) ? $BLOCK : ($cl - $bytes_read);
60     $r->read($new_buffer, $to_read);
61     $buffer .= $new_buffer;
62     my $pos;
63     while(($pos = index($buffer, "\r\n--$b\r\n")) >= 0) {
64       if($current_part) {
65         $current_part->append(substr($buffer, 0, $pos));
66       }
67       $current_part = Mungo::MultipartFormData::Part->new($MAXMEM);
68       push @{$self->{parts}}, $current_part;
69       substr($buffer, 0, $pos + length($b) + 6) = '';
70     }
71     if(!$current_part) {
72       $current_part = Mungo::MultipartFormData::Part->new($MAXMEM);
73       push @{$self->{parts}}, $current_part;
74     }
75     if(($pos = index($buffer, "\r\n--$b--")) >= 0) {
76       $current_part->append(substr($buffer, 0, $pos));
77       $buffer = '';
78     }
79     elsif(length($buffer) > length($b) + 6) {
80       # This is to make sure we leave enough to index() in the next pass
81       $current_part->append(substr($buffer, 0,
82                                    length($buffer) - length($b) - 6));
83       substr($buffer, 0, length($buffer) - length($b) - 6) = '';
84     }
85     $bytes_read += length($new_buffer);
86   }
87 }
88
89 package Mungo::MultipartFormData::Part;
90
91 use strict;
92 use File::Temp qw/:POSIX/;
93
94 sub new {
95   my $class = shift;
96   my $maxmem = shift;
97   return bless { payload => '', maxmem => $maxmem }, $class;
98 }
99
100 sub extract_headers {
101   my $self = shift;
102   # We already extracted out headers
103   return if($self->{name});
104   my $pos = index($self->{payload}, "\r\n\r\n");
105   my @headers = split(/\r\n/, substr($self->{payload}, 0, $pos));
106   # Consume it
107   substr($self->{payload}, 0, $pos + 4) = '';
108   $self->{size} = length($self->{payload});
109   foreach my $header (@headers) {
110     my ($k, $v) = split(/:\s+/, $header, 2);
111     $self->{lc $k} = $v;
112     if(lc $k eq 'content-disposition') {
113       if($v =~ /^form-data;/) {
114         $self->{name} = $1 if($v =~ / name="([^;]*)"/);
115         $self->{filename} = $1 if($v =~ / filename="([^;]*)"/);
116       }
117     }
118   }
119 }
120 sub append {
121   my $self = shift;
122   my $buffer = shift;
123   $self->{size} += length($buffer);
124   if(exists($self->{handle})) {
125     $self->{handle}->print($buffer);
126   }
127   else {
128     $self->{payload} .= $buffer;
129     $self->extract_headers();
130     if(length($self->{payload}) > $self->{maxmem}) {
131       my($fh, $file) = tmpnam();
132       if(!$fh) {
133         print STDERR "Could not create tmpfile (for POST storage)\n";
134         return undef;
135       }
136       unlink($file);
137       $self->{handle} = $fh;
138       $self->{handle}->print($self->{payload});
139       delete $self->{payload};
140     }
141   }
142 }
143
144 1;
Note: See TracBrowser for help on using the browser.