has
[
qw(auto_relax relaxed skip_body)
];
has
headers
=>
sub
{ Mojo::Headers->new };
has
max_buffer_size
=>
sub
{
$ENV
{MOJO_MAX_BUFFER_SIZE} || 262144 };
has
max_leftover_size
=>
sub
{
$ENV
{MOJO_MAX_LEFTOVER_SIZE} || 262144 };
sub
body_contains {
croak
'Method "body_contains" not implemented by subclass'
;
}
sub
body_size { croak
'Method "body_size" not implemented by subclass'
}
sub
boundary {
return
undef
unless
my
$type
=
shift
->headers->content_type;
$type
=~ m!multipart.
*boundary
\s*=\s*(?:
"([^"
]+)"|([\w'(),.:?\-+/]+))!i
and
return
$1 // $2;
return
undef
;
}
sub
build_body {
shift
->_build(
'get_body_chunk'
) }
sub
build_headers {
shift
->_build(
'get_header_chunk'
) }
sub
charset {
my
$type
=
shift
->headers->content_type //
''
;
return
$type
=~ /charset\s*=\s*
"?([^"
\s;]+)"?/i ? $1 :
undef
;
}
sub
clone {
my
$self
=
shift
;
return
undef
if
$self
->is_dynamic;
return
$self
->new(
headers
=>
$self
->headers->clone);
}
sub
generate_body_chunk {
my
(
$self
,
$offset
) =
@_
;
$self
->emit(
drain
=>
$offset
)
if
!
delete
$self
->{delay} && !
length
(
$self
->{body_buffer} //
''
);
my
$chunk
=
delete
$self
->{body_buffer} //
''
;
return
$self
->{
eof
} ?
''
:
undef
unless
length
$chunk
;
return
$chunk
;
}
sub
get_body_chunk {
croak
'Method "get_body_chunk" not implemented by subclass'
;
}
sub
get_header_chunk {
my
(
$self
,
$offset
) =
@_
;
unless
(
defined
$self
->{header_buffer}) {
my
$headers
=
$self
->headers->to_string;
$self
->{header_buffer}
=
$headers
?
"$headers\x0d\x0a\x0d\x0a"
:
"\x0d\x0a"
;
}
return
substr
$self
->{header_buffer},
$offset
, 131072;
}
sub
header_size {
length
shift
->build_headers }
sub
is_chunked { !!
shift
->headers->transfer_encoding }
sub
is_compressed { (
shift
->headers->content_encoding //
''
) =~ /^gzip$/i }
sub
is_dynamic {
$_
[0]{dynamic} && !
defined
$_
[0]->headers->content_length }
sub
is_finished { (
shift
->{state} //
''
) eq
'finished'
}
sub
is_limit_exceeded { !!
shift
->{limit} }
sub
is_multipart {
undef
}
sub
is_parsing_body { (
shift
->{state} //
''
) eq
'body'
}
sub
leftovers {
shift
->{buffer} }
sub
parse {
my
$self
=
shift
;
$self
->_parse_until_body(
@_
);
return
$self
if
$self
->{state} eq
'headers'
;
$self
->emit(
'body'
)
unless
$self
->{body}++;
$self
->{real_size} //= 0;
if
(
$self
->is_chunked &&
$self
->{state} ne
'headers'
) {
$self
->_parse_chunked;
$self
->{state} =
'finished'
if
(
$self
->{chunk_state} //
''
) eq
'finished'
;
}
else
{
$self
->{real_size} +=
length
$self
->{pre_buffer};
my
$limit
=
$self
->is_finished
&&
length
(
$self
->{buffer}) >
$self
->max_leftover_size;
$self
->{buffer} .=
$self
->{pre_buffer}
unless
$limit
;
$self
->{pre_buffer} =
''
;
}
if
(
$self
->skip_body) {
$self
->{state} =
'finished'
;
return
$self
;
}
my
$headers
=
$self
->headers;
if
(
$self
->auto_relax) {
my
$connection
=
$headers
->connection //
''
;
my
$len
=
$headers
->content_length //
''
;
$self
->relaxed(1)
if
!
length
$len
&& (
$connection
=~ /
close
/i ||
$headers
->content_type);
}
if
(
$self
->is_chunked ||
$self
->relaxed) {
$self
->{size} +=
length
(
$self
->{buffer} //=
''
);
$self
->_uncompress(
$self
->{buffer});
$self
->{buffer} =
''
;
}
else
{
my
$len
=
$headers
->content_length || 0;
$self
->{size} ||= 0;
if
((
my
$need
=
$len
-
$self
->{size}) > 0) {
my
$len
=
length
$self
->{buffer};
my
$chunk
=
substr
$self
->{buffer}, 0,
$need
>
$len
?
$len
:
$need
,
''
;
$self
->_uncompress(
$chunk
);
$self
->{size} +=
length
$chunk
;
}
$self
->{state} =
'finished'
if
$len
<=
$self
->progress;
}
return
$self
;
}
sub
parse_body {
my
$self
=
shift
;
$self
->{state} =
'body'
;
return
$self
->parse(
@_
);
}
sub
progress {
my
$self
=
shift
;
return
0
unless
my
$state
=
$self
->{state};
return
0
unless
$state
eq
'body'
||
$state
eq
'finished'
;
return
$self
->{raw_size} - (
$self
->{header_size} || 0);
}
sub
write
{
my
(
$self
,
$chunk
,
$cb
) =
@_
;
$self
->{dynamic} = 1;
if
(
defined
$chunk
) {
$self
->{body_buffer} .=
$chunk
}
else
{
$self
->{delay} = 1 }
$self
->once(
drain
=>
$cb
)
if
$cb
;
$self
->{
eof
} = 1
if
defined
$chunk
&&
$chunk
eq
''
;
return
$self
;
}
sub
write_chunk {
my
(
$self
,
$chunk
,
$cb
) =
@_
;
$self
->headers->transfer_encoding(
'chunked'
)
unless
$self
->is_chunked;
$self
->
write
(
defined
$chunk
?
$self
->_build_chunk(
$chunk
) :
$chunk
,
$cb
);
$self
->{
eof
} = 1
if
defined
$chunk
&&
$chunk
eq
''
;
return
$self
;
}
sub
_build {
my
(
$self
,
$method
) =
@_
;
my
$buffer
=
''
;
my
$offset
= 0;
while
(1) {
next
unless
defined
(
my
$chunk
=
$self
->
$method
(
$offset
));
last
unless
my
$len
=
length
$chunk
;
$offset
+=
$len
;
$buffer
.=
$chunk
;
}
return
$buffer
;
}
sub
_build_chunk {
my
(
$self
,
$chunk
) =
@_
;
return
"\x0d\x0a0\x0d\x0a\x0d\x0a"
if
length
$chunk
== 0;
my
$crlf
=
$self
->{chunks}++ ?
"\x0d\x0a"
:
''
;
return
$crlf
.
sprintf
(
'%x'
,
length
$chunk
) .
"\x0d\x0a$chunk"
;
}
sub
_parse_chunked {
my
$self
=
shift
;
return
$self
->_parse_chunked_trailing_headers
if
(
$self
->{chunk_state} //
''
) eq
'trailing_headers'
;
while
(
my
$len
=
length
$self
->{pre_buffer}) {
unless
(
$self
->{chunk_len}) {
last
unless
$self
->{pre_buffer} =~ s/^(?:\x0d?\x0a)?([0-9a-fA-F]+).*\x0a//;
next
if
$self
->{chunk_len} =
hex
$1;
$self
->{chunk_state} =
'trailing_headers'
;
last
;
}
$len
=
$self
->{chunk_len}
if
$self
->{chunk_len} <
$len
;
$self
->{buffer} .=
substr
$self
->{pre_buffer}, 0,
$len
,
''
;
$self
->{real_size} +=
$len
;
$self
->{chunk_len} -=
$len
;
}
$self
->_parse_chunked_trailing_headers
if
(
$self
->{chunk_state} //
''
) eq
'trailing_headers'
;
$self
->{limit} =
$self
->{state} =
'finished'
if
length
(
$self
->{pre_buffer} //
''
) >
$self
->max_buffer_size;
}
sub
_parse_chunked_trailing_headers {
my
$self
=
shift
;
my
$headers
=
$self
->headers->parse(
delete
$self
->{pre_buffer});
return
unless
$headers
->is_finished;
$self
->{chunk_state} =
'finished'
;
$headers
->remove(
'Transfer-Encoding'
);
$headers
->content_length(
$self
->{real_size})
unless
$headers
->content_length;
}
sub
_parse_headers {
my
$self
=
shift
;
my
$headers
=
$self
->headers->parse(
delete
$self
->{pre_buffer});
return
unless
$headers
->is_finished;
$self
->{state} =
'body'
;
my
$leftovers
=
$self
->{pre_buffer} =
$headers
->leftovers;
$self
->{header_size} =
$self
->{raw_size} -
length
$leftovers
;
$self
->emit(
'body'
)
unless
$self
->{body}++;
}
sub
_parse_until_body {
my
(
$self
,
$chunk
) =
@_
;
$self
->{raw_size} +=
length
(
$chunk
//=
''
);
$self
->{pre_buffer} .=
$chunk
;
unless
(
$self
->{state}) {
$self
->{header_size} =
$self
->{raw_size} -
length
$self
->{pre_buffer};
$self
->{state} =
'headers'
;
}
$self
->_parse_headers
if
(
$self
->{state} //
''
) eq
'headers'
;
}
sub
_uncompress {
my
(
$self
,
$chunk
) =
@_
;
return
$self
->emit(
read
=>
$chunk
)
unless
$self
->is_compressed;
$self
->{post_buffer} .=
$chunk
;
my
$gz
=
$self
->{gz}
//= Compress::Raw::Zlib::Inflate->new(
WindowBits
=> WANT_GZIP);
my
$status
=
$gz
->inflate(\
$self
->{post_buffer},
my
$out
);
$self
->emit(
read
=>
$out
)
if
defined
$out
;
$self
->headers->content_length(
$gz
->total_out)->remove(
'Content-Encoding'
)
if
$status
== Z_STREAM_END;
$self
->{limit} =
$self
->{state} =
'finished'
if
length
(
$self
->{post_buffer} //
''
) >
$self
->max_buffer_size;
}
1;