add files
|
1 |
package Mojo::Content::MultiPart; |
2 |
use Mojo::Base 'Mojo::Content'; |
|
3 | ||
4 |
use Mojo::Util 'b64_encode'; |
|
5 | ||
6 |
has parts => sub { [] }; |
|
7 | ||
8 |
sub new { |
|
9 |
my $self = shift->SUPER::new(@_); |
|
10 |
$self->on(read => \&_read); |
|
11 |
return $self; |
|
12 |
} |
|
13 | ||
14 |
sub body_contains { |
|
15 |
my ($self, $chunk) = @_; |
|
16 |
for my $part (@{$self->parts}) { |
|
17 |
return 1 if index($part->build_headers, $chunk) >= 0; |
|
18 |
return 1 if $part->body_contains($chunk); |
|
19 |
} |
|
20 |
return undef; |
|
21 |
} |
|
22 | ||
23 |
sub body_size { |
|
24 |
my $self = shift; |
|
25 | ||
26 |
# Check for existing Content-Lenght header |
|
27 |
my $content_len = $self->headers->content_length; |
|
28 |
return $content_len if $content_len; |
|
29 | ||
30 |
# Calculate length of whole body |
|
31 |
my $boundary_len = length($self->build_boundary) + 6; |
|
32 |
my $len = $boundary_len - 2; |
|
33 |
$len += $_->header_size + $_->body_size + $boundary_len for @{$self->parts}; |
|
34 | ||
35 |
return $len; |
|
36 |
} |
|
37 | ||
38 |
sub build_boundary { |
|
39 |
my $self = shift; |
|
40 | ||
41 |
# Check for existing boundary |
|
42 |
if (defined(my $boundary = $self->boundary)) { return $boundary } |
|
43 | ||
44 |
# Generate and check boundary |
|
45 |
my $boundary; |
|
46 |
my $size = 1; |
|
47 |
while (1) { |
|
48 |
$boundary = b64_encode join('', map chr(rand 256), 1 .. $size++ * 3); |
|
49 |
$boundary =~ s/\W/X/g; |
|
50 |
last unless $self->body_contains($boundary); |
|
51 |
} |
|
52 | ||
53 |
# Add boundary to Content-Type header |
|
54 |
my $headers = $self->headers; |
|
55 |
($headers->content_type // '') =~ m!^(.*multipart/[^;]+)(.*)$!; |
|
56 |
my $before = $1 || 'multipart/mixed'; |
|
57 |
my $after = $2 || ''; |
|
58 |
$headers->content_type("$before; boundary=$boundary$after"); |
|
59 | ||
60 |
return $boundary; |
|
61 |
} |
|
62 | ||
63 |
sub clone { |
|
64 |
my $self = shift; |
|
65 |
return undef unless my $clone = $self->SUPER::clone(); |
|
66 |
return $clone->parts($self->parts); |
|
67 |
} |
|
68 | ||
69 |
sub get_body_chunk { |
|
70 |
my ($self, $offset) = @_; |
|
71 | ||
72 |
# Body generator |
|
73 |
return $self->generate_body_chunk($offset) if $self->{dynamic}; |
|
74 | ||
75 |
# First boundary |
|
76 |
my $boundary = $self->build_boundary; |
|
77 |
my $boundary_len = length($boundary) + 6; |
|
78 |
my $len = $boundary_len - 2; |
|
79 |
return substr "--$boundary\x0d\x0a", $offset if $len > $offset; |
|
80 | ||
81 |
# Prepare content part by part |
|
82 |
my $parts = $self->parts; |
|
83 |
for (my $i = 0; $i < @$parts; $i++) { |
|
84 |
my $part = $parts->[$i]; |
|
85 | ||
86 |
# Headers |
|
87 |
my $header_len = $part->header_size; |
|
88 |
return $part->get_header_chunk($offset - $len) |
|
89 |
if ($len + $header_len) > $offset; |
|
90 |
$len += $header_len; |
|
91 | ||
92 |
# Content |
|
93 |
my $content_len = $part->body_size; |
|
94 |
return $part->get_body_chunk($offset - $len) |
|
95 |
if ($len + $content_len) > $offset; |
|
96 |
$len += $content_len; |
|
97 | ||
98 |
# Boundary |
|
99 |
if (($len + $boundary_len) > $offset) { |
|
100 | ||
101 |
# Last boundary |
|
102 |
return substr "\x0d\x0a--$boundary--", $offset - $len |
|
103 |
if $#{$parts} == $i; |
|
104 | ||
105 |
# Middle boundary |
|
106 |
return substr "\x0d\x0a--$boundary\x0d\x0a", $offset - $len; |
|
107 |
} |
|
108 |
$len += $boundary_len; |
|
109 |
} |
|
110 |
} |
|
111 | ||
112 |
sub is_multipart {1} |
|
113 | ||
114 |
sub _parse_multipart_body { |
|
115 |
my ($self, $boundary) = @_; |
|
116 | ||
117 |
# Whole part in buffer |
|
118 |
my $pos = index $self->{multipart}, "\x0d\x0a--$boundary"; |
|
119 |
if ($pos < 0) { |
|
120 |
my $len = length($self->{multipart}) - (length($boundary) + 8); |
|
121 |
return undef unless $len > 0; |
|
122 | ||
123 |
# Store chunk |
|
124 |
my $chunk = substr $self->{multipart}, 0, $len, ''; |
|
125 |
$self->parts->[-1] = $self->parts->[-1]->parse($chunk); |
|
126 |
return undef; |
|
127 |
} |
|
128 | ||
129 |
# Store chunk |
|
130 |
my $chunk = substr $self->{multipart}, 0, $pos, ''; |
|
131 |
$self->parts->[-1] = $self->parts->[-1]->parse($chunk); |
|
132 |
return !!($self->{multi_state} = 'multipart_boundary'); |
|
133 |
} |
|
134 | ||
135 |
sub _parse_multipart_boundary { |
|
136 |
my ($self, $boundary) = @_; |
|
137 | ||
138 |
# Boundary begins |
|
139 |
if ((index $self->{multipart}, "\x0d\x0a--$boundary\x0d\x0a") == 0) { |
|
140 |
substr $self->{multipart}, 0, length($boundary) + 6, ''; |
|
141 | ||
142 |
# New part |
|
143 |
my $part = Mojo::Content::Single->new(relaxed => 1); |
|
144 |
$self->emit(part => $part); |
|
145 |
push @{$self->parts}, $part; |
|
146 |
return !!($self->{multi_state} = 'multipart_body'); |
|
147 |
} |
|
148 | ||
149 |
# Boundary ends |
|
150 |
my $end = "\x0d\x0a--$boundary--"; |
|
151 |
if ((index $self->{multipart}, $end) == 0) { |
|
152 |
substr $self->{multipart}, 0, length $end, ''; |
|
153 |
$self->{multi_state} = 'finished'; |
|
154 |
} |
|
155 | ||
156 |
return undef; |
|
157 |
} |
|
158 | ||
159 |
sub _parse_multipart_preamble { |
|
160 |
my ($self, $boundary) = @_; |
|
161 | ||
162 |
# No boundary yet |
|
163 |
return undef if (my $pos = index $self->{multipart}, "--$boundary") < 0; |
|
164 | ||
165 |
# Replace preamble with carriage return and line feed |
|
166 |
substr $self->{multipart}, 0, $pos, "\x0d\x0a"; |
|
167 | ||
168 |
# Parse boundary |
|
169 |
return !!($self->{multi_state} = 'multipart_boundary'); |
|
170 |
} |
|
171 | ||
172 |
sub _read { |
|
173 |
my ($self, $chunk) = @_; |
|
174 | ||
175 |
$self->{multipart} .= $chunk; |
|
176 |
my $boundary = $self->boundary; |
|
177 |
until (($self->{multi_state} //= 'multipart_preamble') eq 'finished') { |
|
178 | ||
179 |
# Preamble |
|
180 |
if ($self->{multi_state} eq 'multipart_preamble') { |
|
181 |
last unless $self->_parse_multipart_preamble($boundary); |
|
182 |
} |
|
183 | ||
184 |
# Boundary |
|
185 |
elsif ($self->{multi_state} eq 'multipart_boundary') { |
|
186 |
last unless $self->_parse_multipart_boundary($boundary); |
|
187 |
} |
|
188 | ||
189 |
# Body |
|
190 |
elsif ($self->{multi_state} eq 'multipart_body') { |
|
191 |
last unless $self->_parse_multipart_body($boundary); |
|
192 |
} |
|
193 |
} |
|
194 | ||
195 |
# Check buffer size |
|
196 |
$self->{limit} = $self->{state} = 'finished' |
|
197 |
if length($self->{multipart} // '') > $self->max_buffer_size; |
|
198 |
} |
|
199 | ||
200 |
1; |
|
201 | ||
202 |
=encoding utf8 |
|
203 | ||
204 |
=head1 NAME |
|
205 | ||
206 |
Mojo::Content::MultiPart - HTTP multipart content |
|
207 | ||
208 |
=head1 SYNOPSIS |
|
209 | ||
210 |
use Mojo::Content::MultiPart; |
|
211 | ||
212 |
my $multi = Mojo::Content::MultiPart->new; |
|
213 |
$multi->parse('Content-Type: multipart/mixed; boundary=---foobar'); |
|
214 |
my $single = $multi->parts->[4]; |
|
215 | ||
216 |
=head1 DESCRIPTION |
|
217 | ||
218 |
L<Mojo::Content::MultiPart> is a container for HTTP multipart content as |
|
219 |
described in RFC 2616. |
|
220 | ||
221 |
=head1 EVENTS |
|
222 | ||
223 |
L<Mojo::Content::Multipart> inherits all events from L<Mojo::Content> and can |
|
224 |
emit the following new ones. |
|
225 | ||
226 |
=head2 part |
|
227 | ||
228 |
$multi->on(part => sub { |
|
229 |
my ($multi, $single) = @_; |
|
230 |
... |
|
231 |
}); |
|
232 | ||
233 |
Emitted when a new L<Mojo::Content::Single> part starts. |
|
234 | ||
235 |
$multi->on(part => sub { |
|
236 |
my ($multi, $single) = @_; |
|
237 |
return unless $single->headers->content_disposition =~ /name="([^"]+)"/; |
|
238 |
say "Field: $1"; |
|
239 |
}); |
|
240 | ||
241 |
=head1 ATTRIBUTES |
|
242 | ||
243 |
L<Mojo::Content::MultiPart> inherits all attributes from L<Mojo::Content> and |
|
244 |
implements the following new ones. |
|
245 | ||
246 |
=head2 parts |
|
247 | ||
248 |
my $parts = $multi->parts; |
|
249 |
$multi = $multi->parts([]); |
|
250 | ||
251 |
Content parts embedded in this multipart content, usually |
|
252 |
L<Mojo::Content::Single> objects. |
|
253 | ||
254 |
=head1 METHODS |
|
255 | ||
256 |
L<Mojo::Content::MultiPart> inherits all methods from L<Mojo::Content> and |
|
257 |
implements the following new ones. |
|
258 | ||
259 |
=head2 new |
|
260 | ||
261 |
my $multi = Mojo::Content::MultiPart->new; |
|
262 | ||
263 |
Construct a new L<Mojo::Content::MultiPart> object and subscribe to L</"read"> |
|
264 |
event with default content parser. |
|
265 | ||
266 |
=head2 body_contains |
|
267 | ||
268 |
my $bool = $multi->body_contains('foobarbaz'); |
|
269 | ||
270 |
Check if content parts contain a specific string. |
|
271 | ||
272 |
=head2 body_size |
|
273 | ||
274 |
my $size = $multi->body_size; |
|
275 | ||
276 |
Content size in bytes. |
|
277 | ||
278 |
=head2 build_boundary |
|
279 | ||
280 |
my $boundary = $multi->build_boundary; |
|
281 | ||
282 |
Generate a suitable boundary for content and add it to C<Content-Type> header. |
|
283 | ||
284 |
=head2 clone |
|
285 | ||
286 |
my $clone = $multi->clone; |
|
287 | ||
288 |
Clone content if possible, otherwise return C<undef>. |
|
289 | ||
290 |
=head2 get_body_chunk |
|
291 | ||
292 |
my $bytes = $multi->get_body_chunk(0); |
|
293 | ||
294 |
Get a chunk of content starting from a specific position. |
|
295 | ||
296 |
=head2 is_multipart |
|
297 | ||
298 |
my $true = $multi->is_multipart; |
|
299 | ||
300 |
True. |
|
301 | ||
302 |
=head1 SEE ALSO |
|
303 | ||
304 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
305 | ||
306 |
=cut |