request - response

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,20 +230,30 @@ method parse($raw_message) {
     else {               # is a response
         $.protocol = $first;
     }
-
+
+	my Bool:D $tec = False;
     loop {
         last until @lines;
 
         my $line = @lines.shift;
         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 {

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');

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;

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

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

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