Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

SSL support using Net::Server::Proto::SSLEAY #35

Open
wants to merge 1 commit into from

5 participants

@alladdin

I made some changes in Starman for support SSL protocol.

  • with the changes which You suggested

miyagawa wrote:

  • Use perlstyle styles (instead of }else{ use } else {)
  • HTTP::Server::PSGI uses the following options, it would be nice to keep in sync with that: --enable-ssl --ssl-key-file=.. --ssl-cert-file=...
@alladdin

I made changes that You requested.

For enabling SSL is used $self->{ssl} parameter.

@exodist

I would find this very useful, but if I were to use it at work I would need it to get merged into the main tree and sent to cpan so that the sysadmins could install it. Can I add a vote to have this merged in?

@miyagawa
Owner

The reason this is not merged is that simply it hasn't been tested by anyone (or at least it looks like). Bring in more people to test it and give +1 on this patch, and it will be hopefully merged.

@und3f

Patched Starman works well, but the ifs that selects between $conn->print($data) and syswrite($conn, $data) doesn't look well. Also ->print uses write() call instead of syswrite.
Possible we can bring syswrite() support to Net::Server::Proto::SSLEAY and simplify this path

@dpetrov

I've seen a lot of questions about starman and ssl any hints what have/must be done to merge that particular pull request?

@ap ap referenced this pull request
Closed

SSL suport, take 2 #45

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Oct 7, 2011
  1. SSL support using Net::Server::Proto::SSLEAY

    Ladislav Dokulil authored
This page is out of date. Refresh to see the latest.
Showing with 82 additions and 13 deletions.
  1. +16 −1 bin/starman
  2. +66 −12 lib/Starman/Server.pm
View
17 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.
+TCP, SSL and UNIX domain sockets.
+:SSL in listen string indicates that https protocol is enabled on
+this port.
Defaults to any IP address and port 5000.
@@ -176,6 +179,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 https protocol for all connections.
+
=back
Starman passes through other options given to L<Plack::Runner>, the
View
78 lib/Starman/Server.pm
@@ -41,13 +41,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}) || ($opt eq 'SSL'))?'ssleay':'tcp';
} else {
push @$host, 'localhost';
push @$port, $listen;
@@ -149,7 +157,8 @@ sub process_request {
SCRIPT_NAME => '',
'psgi.version' => [ 1, 1 ],
'psgi.errors' => *STDERR,
- 'psgi.url_scheme' => 'http',
+ 'psgi.url_scheme' => $self->{'server'}->{'client'}->NS_proto eq
+ 'SSLEAY' ? 'https' : 'http',
'psgi.nonblocking' => Plack::Util::FALSE,
'psgi.streaming' => Plack::Util::TRUE,
'psgi.run_once' => Plack::Util::FALSE,
@@ -194,7 +203,11 @@ 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;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print('HTTP/1.1 100 Continue' . $CRLF . $CRLF);
+ } else {
+ syswrite $conn, 'HTTP/1.1 100 Continue' . $CRLF . $CRLF;
+ }
DEBUG && warn "[$$] Sent 100 Continue response\n";
}
else {
@@ -278,7 +291,21 @@ 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);
+
+ if ($self->{server}->{client}->NS_proto eq 'SSLEAY'){
+ my $ok;
+ ( $ok, $buf ) =
+ $self->{server}->{client}
+ ->read_until( CHUNKSIZE, qr{\n\r?\n} );
+
+ if ($ok == 1) {
+ $read = length($buf);
+ }
+
+ } else {
+ $read = sysread $self->{server}->{client}, $buf, CHUNKSIZE;
+ }
if ( !defined $read || $read == 0 ) {
die "Read error: $!\n";
@@ -339,8 +366,15 @@ 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);
+ if ($self->{server}->{client}->NS_proto eq 'SSLEAY'){
+ my ( $ok, $chunk ) =
+ $self->{server}->{client}
+ ->read_until( $env->{CONTENT_LENGTH}, undef, 1 );
+ return ($chunk, length($chunk));
+ } else {
+ my $read = sysread $self->{server}->{client}, my($chunk), CHUNKSIZE;
+ return ($chunk, $read);
+ }
};
my $chunked = do { no warnings; lc delete $env->{HTTP_TRANSFER_ENCODING} eq 'chunked' };
@@ -457,7 +491,11 @@ 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;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print(join( $CRLF, @headers, '' ) . $CRLF);
+ } else {
+ syswrite $conn, join( $CRLF, @headers, '' ) . $CRLF;
+ }
if (defined $res->[2]) {
Plack::Util::foreach($res->[2], sub {
@@ -467,11 +505,19 @@ sub _finalize_response {
return unless $len;
$buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
}
- syswrite $conn, $buffer;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print($buffer);
+ } else {
+ syswrite $conn, $buffer;
+ }
DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
});
- syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print("0$CRLF$CRLF") if $chunked;
+ } else {
+ syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ }
} else {
return Plack::Util::inline_object
write => sub {
@@ -481,11 +527,19 @@ sub _finalize_response {
return unless $len;
$buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
}
- syswrite $conn, $buffer;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print($buffer);
+ } else {
+ syswrite $conn, $buffer;
+ }
DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
},
close => sub {
- syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ if ($conn->NS_proto eq 'SSLEAY'){
+ $conn->print("0$CRLF$CRLF") if $chunked;
+ } else {
+ syswrite $conn, "0$CRLF$CRLF" if $chunked;
+ }
};
}
}
Something went wrong with that request. Please try again.