use
Socket
qw(IPPROTO_TCP TCP_NODELAY)
;
? 0
:
eval
'use IO::Socket::IP 0.16 (); 1'
;
use
constant
TLS
=>
$ENV
{MOJO_NO_TLS} ? 0
:
eval
(IPV6 ?
'use IO::Socket::SSL 1.75 (); 1'
:
'use IO::Socket::SSL 1.75 "inet4"; 1'
);
use
constant
TLS_READ
=> TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
use
constant
TLS_WRITE
=> TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
my
$CERT
= catfile dirname(__FILE__),
'server.crt'
;
my
$KEY
= catfile dirname(__FILE__),
'server.key'
;
has
multi_accept
=> 50;
has
reactor
=>
sub
{
Mojo::IOLoop->singleton->reactor;
};
sub
DESTROY {
my
$self
=
shift
;
if
(
my
$port
=
$self
->{port}) {
$ENV
{MOJO_REUSE} =~ s/(?:^|\,)${port}:\d+// }
return
unless
my
$reactor
=
$self
->{reactor};
$self
->stop
if
$self
->{handle};
$reactor
->remove(
$_
)
for
values
%{
$self
->{handles}};
}
sub
listen
{
my
$self
=
shift
;
my
$args
=
ref
$_
[0] ?
$_
[0] : {
@_
};
my
$reuse
=
my
$port
=
$self
->{port} =
$args
->{port} || 3000;
$ENV
{MOJO_REUSE} ||=
''
;
my
$fd
;
if
(
$ENV
{MOJO_REUSE} =~ /(?:^|\,)${reuse}:(\d+)/) {
$fd
= $1 }
local
$^F = 1000;
my
$handle
;
my
$class
= IPV6 ?
'IO::Socket::IP'
:
'IO::Socket::INET'
;
if
(
defined
$fd
) {
$handle
=
$class
->new;
$handle
->fdopen(
$fd
,
'r'
) or croak
"Can't open file descriptor $fd: $!"
;
}
else
{
my
%options
= (
Listen
=>
$args
->{backlog} // SOMAXCONN,
LocalAddr
=>
$args
->{address} ||
'0.0.0.0'
,
LocalPort
=>
$port
,
Proto
=>
'tcp'
,
ReuseAddr
=> 1,
Type
=> SOCK_STREAM
);
$options
{LocalAddr} =~ s/[\[\]]//g;
$handle
=
$class
->new(
%options
) or croak
"Can't create listen socket: $!"
;
$fd
=
fileno
$handle
;
$ENV
{MOJO_REUSE} .=
length
$ENV
{MOJO_REUSE} ?
",$reuse:$fd"
:
"$reuse:$fd"
;
}
$handle
->blocking(0);
$self
->{handle} =
$handle
;
return
unless
$args
->{tls};
croak
"IO::Socket::SSL 1.75 required for TLS support"
unless
TLS;
my
$options
=
$self
->{tls} = {
SSL_cert_file
=>
$args
->{tls_cert} ||
$CERT
,
SSL_cipher_list
=>
'!aNULL:!eNULL:!EXPORT:!DSS:!DES:!SSLv2:!LOW:RC4-SHA:RC4-MD5:ALL'
,
SSL_honor_cipher_order
=> 1,
SSL_key_file
=>
$args
->{tls_key} ||
$KEY
,
SSL_startHandshake
=> 0,
SSL_verify_mode
=> 0x00
};
return
unless
$args
->{tls_ca};
$options
->{SSL_ca_file} = -T
$args
->{tls_ca} ?
$args
->{tls_ca} :
undef
;
$options
->{SSL_verify_mode}
=
defined
$args
->{tls_verify} ?
$args
->{tls_verify} : 0x03;
}
sub
generate_port {
IO::Socket::INET->new(
Listen
=> 5,
LocalAddr
=>
'127.0.0.1'
,
Proto
=>
'tcp'
)
->sockport;
}
sub
start {
my
$self
=
shift
;
weaken
$self
;
$self
->reactor->io(
$self
->{handle} =>
sub
{
$self
->_accept
for
1 ..
$self
->multi_accept });
}
sub
stop {
$_
[0]->reactor->remove(
$_
[0]{handle}) }
sub
_accept {
my
$self
=
shift
;
return
unless
my
$handle
=
$self
->{handle}->
accept
;
$handle
->blocking(0);
setsockopt
$handle
, IPPROTO_TCP, TCP_NODELAY, 1;
return
$self
->emit_safe(
accept
=>
$handle
)
unless
my
$tls
=
$self
->{tls};
weaken
$self
;
$tls
->{SSL_error_trap} =
sub
{
return
unless
my
$handle
=
delete
$self
->{handles}{
shift
()};
$self
->reactor->remove(
$handle
);
close
$handle
;
};
return
unless
$handle
= IO::Socket::SSL->start_SSL(
$handle
,
%$tls
);
$self
->reactor->io(
$handle
=>
sub
{
$self
->_tls(
$handle
) });
$self
->{handles}{
$handle
} =
$handle
;
}
sub
_tls {
my
(
$self
,
$handle
) =
@_
;
if
(
$handle
->accept_SSL) {
$self
->reactor->remove(
$handle
);
delete
$self
->{handles}{
$handle
};
return
$self
->emit_safe(
accept
=>
$handle
);
}
my
$err
=
$IO::Socket::SSL::SSL_ERROR
;
if
(
$err
== TLS_READ) {
$self
->reactor->watch(
$handle
, 1, 0) }
elsif
(
$err
== TLS_WRITE) {
$self
->reactor->watch(
$handle
, 1, 1) }
}
1;