root/trunk/lib/Mungo/MultipartFormData.pm

Revision 2, 4.1 kB (checked in by jesus, 7 years ago)

Initial import from Theo's private repository. From here on out it is open to the world.

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