Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

support SSL

  • Loading branch information...
commit 19a29bdc9989b1d6697caec7c961d4d0ee17d357 1 parent 7a795a1
@ap ap authored
Showing with 58 additions and 12 deletions.
  1. +15 −0 bin/starman
  2. +43 −12 lib/Starman/Server.pm
View
15 bin/starman
@@ -45,10 +45,13 @@ starman - Starman launcher
=item -l, --listen
--listen HOST:PORT --listen :PORT --listen UNIX_SOCKET
+ --listen HOST:PORT:ssl
Specifies the TCP address, ports and UNIX domain sockets to bind to
wait for requests. You can repeat as many times as you want and mix
TCP and UNIX domain sockets.
+For TCP sockets you can append C<:ssl> after the port to specify that
+connections on that port should use SSL.
Defaults to any IP address and port 5000.
@@ -180,6 +183,18 @@ described in C<plackup -h>.
Specify the pathname of a file where the error log should be written.
This enables you to still have access to the errors when using C<--daemonize>.
+=item --ssl-cert-file
+
+Specify the path to SSL certificate file.
+
+=item --ssl-key-file
+
+Specify the path to SSL key file.
+
+=item --enable-ssl
+
+Enable SSL on I<all> TCP sockets.
+
=back
Starman passes through other options given to L<Plack::Runner>, the
View
55 lib/Starman/Server.pm
@@ -47,13 +47,21 @@ sub run {
$options->{keepalive_timeout} = 1;
}
+ if ( exists $options->{ssl_cert_file} ) {
+ push @{$options->{argv}}, '--SSL_cert_file', $options->{ssl_cert_file};
+ }
+
+ if ( exists $options->{ssl_key_file} ) {
+ push @{$options->{argv}}, '--SSL_key_file', $options->{ssl_key_file};
+ }
+
my($host, $port, $proto);
for my $listen (@{$options->{listen} || [ "$options->{host}:$options->{port}" ]}) {
if ($listen =~ /:/) {
- my($h, $p) = split /:/, $listen, 2;
+ my($h, $p, $opt) = split /:/, $listen, 3;
push @$host, $h || '*';
push @$port, $p;
- push @$proto, 'tcp';
+ push @$proto, ($options->{ssl} || 'ssl' eq lc $opt) ? 'ssleay' : 'tcp';
} else {
push @$host, 'localhost';
push @$port, $listen;
@@ -181,7 +189,7 @@ sub process_request {
SCRIPT_NAME => '',
'psgi.version' => [ 1, 1 ],
'psgi.errors' => *STDERR,
- 'psgi.url_scheme' => 'http',
+ 'psgi.url_scheme' => ($conn->NS_proto eq 'SSLEAY' ? 'https' : 'http'),
'psgi.nonblocking' => Plack::Util::FALSE,
'psgi.streaming' => Plack::Util::TRUE,
'psgi.run_once' => Plack::Util::FALSE,
@@ -226,7 +234,7 @@ sub process_request {
# Do we need to send 100 Continue?
if ( $env->{HTTP_EXPECT} ) {
if ( $env->{HTTP_EXPECT} eq '100-continue' ) {
- syswrite $conn, 'HTTP/1.1 100 Continue' . $CRLF . $CRLF;
+ $self->_write('HTTP/1.1 100 Continue' . $CRLF . $CRLF);
DEBUG && warn "[$$] Sent 100 Continue response\n";
}
else {
@@ -295,6 +303,14 @@ sub process_request {
DEBUG && warn "[$$] Closing connection\n";
}
+# XXX workaround for the lack of syswrite support in any released Net::Server::Proto::SSLEAY
+# can be taken out when ::SSLEAY is up to snuff
+sub _write {
+ my $self = shift;
+ my $conn = $self->{server}->{client};
+ return $conn->NS_proto eq 'SSLEAY' ? $conn->print($_[0]) : syswrite $conn, $_[0];
+}
+
sub _read_headers {
my $self = shift;
@@ -310,7 +326,16 @@ sub _read_headers {
last if defined $self->{client}->{inputbuf} && $self->{client}->{inputbuf} =~ /$CRLF$CRLF/s;
# If not, read some data
- my $read = sysread $self->{server}->{client}, my $buf, CHUNKSIZE;
+ my ($read, $buf);
+
+ my $conn = $self->{server}->{client};
+ if ($conn->NS_proto eq 'SSLEAY') {
+ (my $ok, $buf) = $conn->read_until(CHUNKSIZE, qr{\n\r?\n});
+ $read = length($buf) if $ok == 1;
+ } else {
+ $read = sysread $conn, $buf, CHUNKSIZE;
+ }
+
if ( !defined $read || $read == 0 ) {
die "Read error: $!\n";
@@ -371,8 +396,14 @@ sub _prepare_env {
my $chunk = delete $self->{client}->{inputbuf};
return ($chunk, length $chunk);
}
- my $read = sysread $self->{server}->{client}, my($chunk), CHUNKSIZE;
- return ($chunk, $read);
+ my $conn = $self->{server}->{client};
+ if ($conn->NS_proto eq 'SSLEAY') {
+ my $chunk = $conn->read_until($env->{CONTENT_LENGTH}, undef, 1);
+ return ($chunk, length($chunk));
+ } else {
+ my $read = sysread $conn, my($chunk), CHUNKSIZE;
+ return ($chunk, $read);
+ }
};
my $chunked = do { no warnings; lc delete $env->{HTTP_TRANSFER_ENCODING} eq 'chunked' };
@@ -489,7 +520,7 @@ sub _finalize_response {
# Buffer the headers so they are sent with the first write() call
# This reduces the number of TCP packets we are sending
- syswrite $conn, join( $CRLF, @headers, '' ) . $CRLF;
+ $self->_write(join( $CRLF, @headers, '' ) . $CRLF);
if (defined $res->[2]) {
Plack::Util::foreach($res->[2], sub {
@@ -499,11 +530,11 @@ sub _finalize_response {
return unless $len;
$buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
}
- syswrite $conn, $buffer;
+ $self->_write($buffer);
DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
});
- syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ $self->_write("0$CRLF$CRLF") if $chunked;
} else {
return Plack::Util::inline_object
write => sub {
@@ -513,11 +544,11 @@ sub _finalize_response {
return unless $len;
$buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
}
- syswrite $conn, $buffer;
+ $self->_write($buffer);
DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
},
close => sub {
- syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ $self->_write("0$CRLF$CRLF") if $chunked;
};
}
}
Please sign in to comment.
Something went wrong with that request. Please try again.