diff --git a/lib/HTTP/Message.rakumod b/lib/HTTP/Message.rakumod index 56865e6..f1e7f2f 100644 --- a/lib/HTTP/Message.rakumod +++ b/lib/HTTP/Message.rakumod @@ -6,6 +6,7 @@ use Encode; has HTTP::Header $.header = HTTP::Header.new; has $.content is rw; +has Int:D $.chunk-size is rw = 4096; has $.protocol is rw = 'HTTP/1.1'; @@ -103,6 +104,45 @@ method is-text(--> Bool:D) { method is-binary(--> Bool:D) { !self.is-text } +# TODO : proposed method to set request to chunked and specify the chunk size +# TODO : how to keep synced with Transfer-Encoding if user adds chunked there ? +# TODO : specify in UserAgent ? +# set size 0 for non-chunked +method set-chunked(Int:D $size = 4096) { + if $size { + $!chunk-size = $size; + self.push-field: Transfer-Encoding => 'chunked' + unless self.is-chunked; + } + else { + # make non-chunked + $!chunk-size = 0; + if self.is-chunked { + my Str $te = .Str with self.field: 'Transfer-Encoding'; + $te ~~ s/[\s*\,\s*]?chunked\s*$//; + $te .=trim; + if $te { + self.field: 'Transfer-Encoding', $te; + } + else { + self.remove-field: 'Transfer-Encoding'; + } + } + } +} + +method is-chunked(--> Bool:D) { +# multiple transfer-codings can be listed; chunked should be last +# https://datatracker.ietf.org/doc/html/rfc2616#section-14.41 +# https://datatracker.ietf.org/doc/html/rfc7230#section-4 + + # TODO : uncomment after confirming testcase + my $enc = self.field('Transfer-Encoding'); + so $enc and $enc.Str.trim.lc.ends-with: 'chunked' +# # TODO : remove after implementing +# ... +} + method content-encoding() { $!header.field('Content-Encoding'); } @@ -158,7 +198,6 @@ method decoded-content(:$bin) { $decoded_content } - multi method field(Str $f) { $.header.field($f) } @@ -191,7 +230,8 @@ method parse($raw_message) { else { # is a response $.protocol = $first; } - + + my Bool:D $tec = False; loop { last until @lines; @@ -199,12 +239,21 @@ method parse($raw_message) { if $line { my ($k, $v) = $line.split(/\:\s*/, 2); if $k and $v { + $tec = True if $k eq 'Transfer-Encoding' + and $v.trim.lc.ends-with: 'chunked'; if $.header.field($k) { $.header.push-field: |($k => $v.split(',')>>.trim); } else { $.header.field: |($k => $v.split(',')>>.trim); } } + } elsif $tec { + # chunked, add zero-length Str to end as size 0 chunk + @lines.push: '' if +@lines % 2; + $!content = join '', + grep *, + @lines.map: -> $s, $d { $s ~~ /^\d/ ?? $d !! '' }; + last; } else { $.content = @lines.grep({ $_ }).join("\n"); last; @@ -214,14 +263,56 @@ method parse($raw_message) { self } +# proposed method for partitioning into chunks +method chunked-content { + # TODO : how to handle call when non-chunked ? + return unless self.is-chunked and $!chunk-size; + # TODO : handle binary + unless self.is-binary { + # TODO : consider encoding ? + my Str:D @c = $!content.comb: $!chunk-size; + my Str:D $s = join $CRLF, '0', $CRLF; # last chunk + given @c.elems { + when 0 { + # just last chunk, nothing to do + } + when 1..* { + $s = join $CRLF, + @c[*-1].chars.base(16), + @c[*-1], + $s; + proceed; + } + when 2..* { + my Str $cs = $!chunk-size.base: 16; + $s = join $CRLF, ( ( $cs xx * ) Z @c[0..*-2] ).flat, $s; + } + } + $s; + } +} + method Str($eol = "\n", :$debug, Bool :$bin) { my constant $max_size = 300; + # TODO : reference relevant section of relevant RFC + # TODO : need to consider Str vs Buf length ? + self.field(Content-Length => ( $!content.?encode or $!content ).bytes.Str) + if $!content and not self.field: 'Transfer-Encoding'; my $s = $.header.Str($eol); $s ~= $eol if $.content; # The :bin will be passed from the H::UA if not $bin { - $s ~= $.content ~ $eol if $.content and !$debug; + # do not append eol unless chunked + # https://datatracker.ietf.org/doc/html/rfc2616#section-4.3 + # https://datatracker.ietf.org/doc/html/rfc2616#section-7.2 + # https://datatracker.ietf.org/doc/html/rfc2616#section-14.41 + +# # TODO : replace following line with code following it +# $s ~= $.content ~ $eol if $.content and !$debug; + # TODO : uncomment following code for final implementation + $s ~= self.is-chunked ?? self.chunked-content !! $!content + if $!content; } if $.content and $debug { if $bin || self.is-binary { diff --git a/lib/HTTP/Request.rakumod b/lib/HTTP/Request.rakumod index a5af450..95e4e85 100644 --- a/lib/HTTP/Request.rakumod +++ b/lib/HTTP/Request.rakumod @@ -120,7 +120,10 @@ proto method add-content(|) {*} multi method add-content(Str:D $content) { self.content ~= $content; - self.header.field(Content-Length => self.content.encode.bytes.Str); + # TODO : move calculation to end of Message ( Message.Str method ) + # and only if not chunked +# self.header.field(Content-Length => self.content.encode.bytes.Str) +# unless self.is-chunked; } proto method add-form-data(|) {*} @@ -133,6 +136,7 @@ multi method add-form-data(%data, :$multipart) { self.add-form-data(%data.sort.Array, :$multipart); } +# TODO : verify presence of Content-Length multi method add-form-data(Array $data, :$multipart) { my $ct = do { my $f = self.header.field('Content-Type'); diff --git a/lib/HTTP/Response.rakumod b/lib/HTTP/Response.rakumod index 7dcd253..b7dbee4 100644 --- a/lib/HTTP/Response.rakumod +++ b/lib/HTTP/Response.rakumod @@ -55,10 +55,11 @@ method has-content(--> Bool:D) { (204, 304).grep({ $!code eq $_ }) ?? False !! True; } -method is-chunked(--> Bool:D) { - self.field('Transfer-Encoding') - && self.field('Transfer-Encoding') eq 'chunked' -} +# TODO : remove once Message.is-chunked is implemented +# method is-chunked(--> Bool:D) { +# self.field('Transfer-Encoding') +# && self.field('Transfer-Encoding') eq 'chunked' +# } method set-code(Int:D $code) { $!code = $code; diff --git a/lib/HTTP/UserAgent.rakumod b/lib/HTTP/UserAgent.rakumod index d1100e9..d589b6b 100644 --- a/lib/HTTP/UserAgent.rakumod +++ b/lib/HTTP/UserAgent.rakumod @@ -23,7 +23,9 @@ role Connection { self.print($request.Str(:bin)); self.write($request.content); } - else { + elsif $request.method.Str eq 'POST' | 'PUT' { + self.print($request.Str); + } else { self.print($request.Str ~ "\r\n"); } } @@ -276,7 +278,6 @@ method get-response(HTTP::Request $request, Connection $conn, Bool :$bin --> HTT # Header can be longer than one chunk while my $t = $conn.recv( :bin ) { $first-chunk ~= $t; - # Find the header/body separator in the chunk, which means # we can parse the header seperately and are able to figure # out the correct encoding of the body. @@ -296,17 +297,13 @@ method get-response(HTTP::Request $request, Connection $conn, Bool :$bin --> HTT # didn't send it we're stuffed anyway $first-chunk; } - - my HTTP::Response $response = HTTP::Response.new($header-chunk); $response.request = $request; - if $response.has-content { if !$msg-body-pos.defined { X::HTTP::Internal.new(rc => 500, reason => "server returned no data").throw; } - my $content = $first-chunk.subbuf($msg-body-pos); # Turn the inner exceptions to ours # This may really want to be outside diff --git a/t/021-message-issue-226.rakutest b/t/021-message-issue-226.rakutest new file mode 100644 index 0000000..21f8e3b --- /dev/null +++ b/t/021-message-issue-226.rakutest @@ -0,0 +1,115 @@ +use Test; +use HTTP::Request; +use HTTP::Response; + +plan 3; + +my constant $CRLF = "\r\n"; + +# construct request - move to request 042-request-issue-226.rakutest +# my $m = HTTP::Message.new: +# 'four', +# Content-Type => 'text/plain', +# Transfer-Encoding => 'chunked' +# ; +subtest { + plan 13; + my Str:D $expected = join $CRLF, + 'POST /site HTTP/1.1', # request line + 'Content-Type: text/plain', # header + 'Transfer-Encoding: chunked', # header + '', # end of header + '6', # chunk size + '- four', # chunk data + '0', # last chunk + $CRLF, # end of chunk body + ; # FIXME : does not test: trailer, chunk extension, binary + my HTTP::Request:D $m = HTTP::Request.new.parse: $expected; + + is $m.protocol, 'HTTP/1.1', 'protocol'; + is $m.field('Transfer-Encoding'), 'chunked', 'parsed header'; + is $m.content, '- four', 'parsed content'; + ok $m.is-chunked, 'chunked'; + ok $m.is-text, 'text'; + nok $m.is-binary, 'not binary data'; + $m.set-chunked; + ok $m.is-chunked, 'chunked after (implicitly) setting chunk size'; + is $m.chunk-size, 4096, 'default chunk size'; + is $m.Str, $expected, 'chunked Str'; + + # add-content + $m.add-content: "\n- five"; + is $m.content, "- four\n- five", 'add-content'; + + $expected = join $CRLF, + 'POST /site HTTP/1.1', # request line + 'Content-Type: text/plain', # header + 'Transfer-Encoding: chunked', # header + '', # end of header + '4', # chunk size + '- fo', # chunk data + '4', # chunk size + "ur\n-",# chunk data + '4', # chunk size + ' fiv', # chunk data + '1', # final content chunk size + 'e', # final content chunk data + '0', # last chunk + $CRLF, # end of chunked body + ; # FIXME : does not test: trailer, chunk extension, binary + $m.set-chunked: 4; + is $m.chunk-size, 4, 'chunk size set'; + is $m.Str, $expected, 'chunked Str with multiple chunks'; + + # switch to non-chunked; use Content-Length + # $m.remove-field: 'Transfer-Encoding'; + $m.set-chunked: 0; + + $expected = join $CRLF, + 'POST /site HTTP/1.1', # request line + 'Content-Type: text/plain', # header + 'Content-Length: 13', # header + '', # end of header + "- four\n- five", # content + ; # FIXME : does not test: trailer, chunk extension, binary + is $m.Str, $expected, 'non-chunked Str'; +}, 'chunked request'; + + + +subtest { + plan 5; + # parse + my Str:D $to_parse = "HTTP/1.1 200 OK\r\n" + ~ "Content-Length: 3\r\n" + ~ "\r\n" + ~ "a\nb"; + my HTTP::Response:D $m2 = HTTP::Response.new.parse($to_parse); + nok $m2.is-chunked, 'not chunked'; + ok $m2.is-text, 'text'; + nok $m2.is-binary, 'not binary'; + is $m2.field('Content-Length'), '3', 'Content-Length'; + is $m2.Str, $to_parse, 'non-chunked Str'; +}, 'parse non-chunked response'; + + + +subtest { + plan 4; + # parse + my Str:D $to_parse = "HTTP/1.1 200 OK\r\n" + ~ "Transfer-Encoding: chunked\r\n" + ~ "\r\n" + ~ "3\r\n" + ~ "a\nb\r\n" + ~ "0\r\n" + ~ "\r\n" + ; + my HTTP::Response:D $m2 = HTTP::Response.new.parse($to_parse); + ok $m2.is-chunked, 'chunked'; + ok $m2.is-text, 'text'; + nok $m2.is-binary, 'not binary'; + is $m2.Str, $to_parse, 'chunked Str'; +}, 'parse chunked response'; + +# vim: expandtab shiftwidth=4 diff --git a/t/042-request-issue-226.rakutest b/t/042-request-issue-226.rakutest new file mode 100644 index 0000000..d7202df --- /dev/null +++ b/t/042-request-issue-226.rakutest @@ -0,0 +1,47 @@ +use Test; +use URI; +use HTTP::Request; + +plan 2; + +my constant $CRLF = "\r\n"; + +my Str:D $host = 'dne.site'; +my Str:D $resource = 'resource'; +my $url = "http://$host/$resource"; + +my Str:D $expected = join $CRLF, + "POST /$resource HTTP/1.1", # request line + 'Content-Type: text/plain; charset=UTF-8', # header + 'Transfer-Encoding: chunked', # header + "Host: $host", # header + '', # end of header + 'D', # chunk size + "- four\n- five", # chunk data + '0', # last chunk + $CRLF, # end of chunk body +; # FIXME : does not test: trailer, chunk extension, binary + +my HTTP::Request $r = + HTTP::Request.new: + POST => $url, + Content-Type => 'text/plain; charset=UTF-8', + Transfer-Encoding => 'chunked'; +$r.add-content: "- four\n- five"; +is $r.Str, $expected, 'build chunked post'; + +$expected = join $CRLF, + "POST /$resource HTTP/1.1", # request line + "Host: $host", # header + 'Content-Length: 13', # header + '', # end of header + "- four\n- five", # content +; # FIXME : does not test: trailer, chunk extension, binary + +$r = + HTTP::Request.new: + POST => $url; +$r.add-content: "- four\n- five"; +is $r.Str, $expected, 'build non-chunked post'; + +# vim: expandtab shiftwidth=4 diff --git a/t/051-response-issue-226.rakutest b/t/051-response-issue-226.rakutest new file mode 100644 index 0000000..b6c8988 --- /dev/null +++ b/t/051-response-issue-226.rakutest @@ -0,0 +1,49 @@ +use Test; +use HTTP::Response; + +plan 2; + +my constant $CRLF = "\r\n"; + +subtest { + plan 5; + my $r = HTTP::Response.new; + my Str:D $expected = join $CRLF, + 'HTTP/1.1 200 OK', # status line + 'Content-Type: text/plain', # header + 'Transfer-Encoding: chunked', # header + '', # end header + '7', # chunk size + 'content', # chunk data + '0', # last chunk + $CRLF # end chunk body + ; + $r.field: Content-Type => 'text/plain', Transfer-Encoding => 'chunked'; + $r.add-content: 'content'; + ok $r.is-text, 'is text'; + nok $r.is-binary, 'not binary'; + ok $r.is-chunked, 'chunked'; + is $r.content, 'content', 'content'; + is $r.Str, $expected, 'Str'; +}, 'build chunked Str'; + +subtest { + plan 5; + my $r = HTTP::Response.new; + my Str:D $expected = join $CRLF, + 'HTTP/1.1 200 OK', # status line + 'Content-Length: 7', # header + 'Content-Type: text/plain', # header + '', # end header + 'content', # content + ; + $r.field: Content-Type => 'text/plain', Content-Length => '7'; + $r.add-content: 'content'; + ok $r.is-text, 'is text'; + nok $r.is-binary, 'not binary'; + nok $r.is-chunked, 'not chunked'; + is $r.content, 'content', 'content'; + is $r.Str, $expected, 'Str'; +}, 'build non-chunked Str'; + +# vim: expandtab shiftwidth=4