From c73cc9d6f2485541ca6f51f9fb7b12ae8c40f8a0 Mon Sep 17 00:00:00 2001
From: Masahiro Nagano <kazeburo@gmail.com>
Date: Tue, 13 Aug 2013 14:46:05 +0900
Subject: [PATCH 1/2] add test for large body

---
 t/ssl_largebody.t | 54 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 t/ssl_largebody.t

diff --git a/t/ssl_largebody.t b/t/ssl_largebody.t
new file mode 100644
index 0000000..a947dac
--- /dev/null
+++ b/t/ssl_largebody.t
@@ -0,0 +1,54 @@
+use strict;
+use Test::More;
+use Test::Requires 'LWP::Protocol::https';
+use Test::TCP;
+use LWP::UserAgent;
+use FindBin '$Bin';
+use Starman::Server;
+
+# https://github.com/miyagawa/Starman/issues/78
+
+my $host       = 'localhost';
+my $ca_cert    = "$Bin/ssl_ca.pem";
+my $server_pem = "$Bin/ssl_key.pem";
+my $body = 'x'x32*1024; # > 16KB
+
+my ($success, $status, $content);
+
+test_tcp(
+    client => sub {
+        my $port = shift;
+
+        my $ua = LWP::UserAgent->new(
+            timeout  => 2,
+            ssl_opts => {
+                verify_hostname => 1,
+                SSL_ca_file     => $ca_cert,
+            },
+        );
+
+        my $res = $ua->get("https://$host:$port");
+        $success = $res->is_success;
+        $status  = $res->status_line;
+        $content = $res->decoded_content;
+    },
+    server => sub {
+        my $port = shift;
+        Starman::Server->new->run(
+            sub { [ 200, [], [$body] ] },
+            {
+                host     => $host,
+                port     => $port,
+                ssl      => 1,
+                ssl_key  => $server_pem,
+                ssl_cert => $server_pem,
+            },
+        );
+    }
+);
+
+ok $success, 'HTTPS connection succeeded';
+diag $status if not $success;
+is $content, $body;
+
+done_testing;

From 4080365a3129dd7602e8f6ba37c88380d746337e Mon Sep 17 00:00:00 2001
From: Masahiro Nagano <kazeburo@gmail.com>
Date: Tue, 13 Aug 2013 14:37:41 +0900
Subject: [PATCH 2/2] ssl socket could not write content of 16KB or more in a
 single syswrite

---
 lib/Starman/Server.pm | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm
index e728f6b..d480276 100644
--- a/lib/Starman/Server.pm
+++ b/lib/Starman/Server.pm
@@ -516,7 +516,11 @@ sub _finalize_response {
                 return unless $len;
                 $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
             }
-            syswrite $conn, $buffer;
+            while ( length $buffer ) {
+                my $len = syswrite $conn, $buffer;
+                die "write error: $!" if ! defined $len;
+                substr( $buffer, 0, $len, '');
+            }
             DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
         });
 
@@ -530,7 +534,11 @@ sub _finalize_response {
                     return unless $len;
                     $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
                 }
-                syswrite $conn, $buffer;
+                while ( length $buffer ) {
+                    my $len = syswrite $conn, $buffer;
+                    die "write error: $!" if ! defined $len;
+                    substr( $buffer, 0, $len, '');
+                }
                 DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
             },
             close => sub {