use
Socket
qw/IPPROTO_TCP TCP_NODELAY/
;
? 0
:
eval
'use IO::Socket::IP 0.06 (); 1'
;
? 0
:
eval
'use IO::Socket::SSL 1.43 "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;
-----BEGIN CERTIFICATE-----
MIIDbzCCAtigAwIBAgIJAM+kFv1MwalmMA0GCSqGSIb3DQEBBQUAMIGCMQswCQYD
VQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2FjaHNlbjESMBAGA1UEBxMJSGFtYmVy
Z2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czESMBAGA1UEAxMJbG9jYWxob3N0MR0w
GwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9yZzAeFw0xMDAzMjAwMDQ1MDFaFw0z
MDAzMTUwMDQ1MDFaMIGCMQswCQYDVQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2Fj
aHNlbjESMBAGA1UEBxMJSGFtYmVyZ2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czES
MBAGA1UEAxMJbG9jYWxob3N0MR0wGwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9y
ZzCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAzu9mOiyUJB2NBuf1lZxViNM2
VISqRAoaXXGOBa6RgUoVfA/n81RQlgvVA0qCSQHC534DdYRk3CdyJR9UGPuxF8k4
CckOaHWgcJJsd8H0/q73PjbA5ItIpGTTJNh8WVpFDjHTJmQ5ihwddap4/offJxZD
dPrMFtw1ZHBRug5tHUECAwEAAaOB6jCB5zAdBgNVHQ4EFgQUo+Re5wuuzVFqH/zV
cxRGXL0j5K4wgbcGA1UdIwSBrzCBrIAUo+Re5wuuzVFqH/zVcxRGXL0j5K6hgYik
gYUwgYIxCzAJBgNVBAYTAkRFMRYwFAYDVQQIEw1OaWVkZXJzYWNoc2VuMRIwEAYD
VQQHEwlIYW1iZXJnZW4xFDASBgNVBAoTC01vam9saWNpb3VzMRIwEAYDVQQDEwls
b2NhbGhvc3QxHTAbBgkqhkiG9w0BCQEWDmtyYWloQGNwYW4ub3JnggkAz6QW/UzB
qWYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCZZcOeAobctD9wtPtO
40CKHpiGYEM3rh7VvBhjTcVnX6XlLvffIg3uTrVRhzmlEQCZz3O5TsBzfMAVnjYz
llhwgRF6Xn8ict9L8yKDoGSbw0Q7HaCb8/kOe0uKhcSDUd3PjJU0ZWgc20zcGFA9
R65bABoJ2vU1rlQFmjs0RT4UcQ==
-----END CERTIFICATE-----
EOF
-----BEGIN RSA PRIVATE KEY-----
MIICXAIBAAKBgQDO72Y6LJQkHY0G5/WVnFWI0zZUhKpEChpdcY4FrpGBShV8D+fz
VFCWC9UDSoJJAcLnfgN1hGTcJ3IlH1QY+7EXyTgJyQ5odaBwkmx3wfT+rvc+NsDk
i0ikZNMk2HxZWkUOMdMmZDmKHB11qnj+h98nFkN0+swW3DVkcFG6Dm0dQQIDAQAB
AoGAeLmd8C51tqQu1GqbEc+E7zAZsDE9jDhArWdELfhsFvt7kUdOUN1Nrlv0x9i+
LY2Dgb44kmTM2suAgjvGulSMOYBGosZcM0w3ES76nmeAVJ1NBFhbZTCJqo9svoD/
NKdctRflUuvFSWimoui+vj9D5p/4lvAMdBHUWj5FlQsYiOECQQD/FRXtsDetptFu
Vp8Kw+6bZ5+efcjVfciTp7fQKI2xZ2n1QyloaV4zYXgDC2y3fMYuRigCGrX9XeFX
oGHGMyYFAkEAz635I8f4WQa/wvyl/SR5agtDVnkJqMHMgOuykytiF8NFbDSkJv+b
1VfyrWcfK/PVsSGBI67LCMDoP+PZBVOjDQJBAIInoCjH4aEZnYNPb5duojFpjmiw
helpZQ7yZTgxeRssSUR8IITGPuq4sSPckHyPjg/OfFuWhYXigTjU/Q7EyoECQERT
Dykna9wWLVZ/+jgLHOq3Y+L6FSRxBc/QO0LRvgblVlygAPVXmLQaqBtGVuoF4WLS
DANqSR/LH12Nn2NyPa0CQBbzoHgx2i3RncWoq1EeIg2mSMevEcjA6sxgYmsyyzlv
AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
-----END RSA PRIVATE KEY-----
EOF
has
iowatcher
=>
sub
{
Mojo::IOLoop->singleton->iowatcher;
};
sub
DESTROY {
my
$self
=
shift
;
if
(
my
$cert
=
$self
->{cert}) {
unlink
$cert
if
-w
$cert
}
if
(
my
$key
=
$self
->{key}) {
unlink
$key
if
-w
$key
}
return
unless
my
$watcher
=
$self
->{iowatcher};
$self
->pause
if
$self
->{handle};
$watcher
->remove(
$_
)
for
values
%{
$self
->{handles}};
}
sub
listen
{
my
$self
=
shift
;
my
$args
=
ref
$_
[0] ?
$_
[0] : {
@_
};
my
$reuse
=
my
$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,
%{
$args
->{args} || {}}
);
$options
{LocalAddr} =~ s/[\[\]]//g;
$handle
=
$class
->new(
%options
)
or croak
"Can't create listen socket: $!"
;
$fd
=
fileno
$handle
;
$reuse
=
",$reuse"
if
length
$ENV
{MOJO_REUSE};
$ENV
{MOJO_REUSE} .=
"$reuse:$fd"
;
}
$self
->{handle} =
$handle
;
if
(
$args
->{tls}) {
croak
"IO::Socket::SSL 1.43 required for TLS support"
unless
TLS;
my
%options
= (
SSL_startHandshake
=> 0,
SSL_cert_file
=>
$args
->{tls_cert} ||
$self
->_cert_file,
SSL_key_file
=>
$args
->{tls_key} ||
$self
->_key_file,
);
%options
= (
SSL_verify_callback
=>
$args
->{tls_verify},
SSL_ca_file
=> -T
$args
->{tls_ca} ?
$args
->{tls_ca} :
undef
,
SSL_ca_path
=> -d
$args
->{tls_ca} ?
$args
->{tls_ca} :
undef
,
SSL_verify_mode
=>
$args
->{tls_ca} ? 0x03 :
undef
,
%options
)
if
$args
->{tls_ca};
$self
->{tls} = {
%options
, %{
$args
->{tls_args} || {}}};
}
}
sub
generate_port {
my
$port
= 1 .
int
(
rand
10) .
int
(
rand
10) .
int
(
rand
10) .
int
(
rand
10);
while
(
$port
++ < 30000) {
return
$port
if
IO::Socket::INET->new(
Listen
=> 5,
LocalAddr
=>
'127.0.0.1'
,
LocalPort
=>
$port
,
Proto
=>
'tcp'
);
}
return
;
}
sub
pause {
my
$self
=
shift
;
$self
->iowatcher->remove(
$self
->{handle});
}
sub
resume {
my
$self
=
shift
;
weaken
$self
;
$self
->iowatcher->add(
$self
->{handle},
on_readable
=>
sub
{
$self
->_accept });
}
sub
_accept {
my
$self
=
shift
;
my
$handle
=
$self
->{handle}->
accept
;
$handle
->blocking(0);
setsockopt
$handle
, IPPROTO_TCP, TCP_NODELAY, 1;
return
$self
->emit(
accept
=>
$handle
)
unless
my
$tls
=
$self
->{tls};
weaken
$self
;
$tls
->{SSL_error_trap} =
sub
{
my
$handle
=
delete
$self
->{handles}->{
$handle
};
$self
->iowatcher->remove(
$handle
);
close
$handle
;
};
$handle
= IO::Socket::SSL->start_SSL(
$handle
,
%$tls
);
$self
->iowatcher->add(
$handle
,
on_readable
=>
sub
{
$self
->_tls(
$handle
) },
on_writable
=>
sub
{
$self
->_tls(
$handle
) }
);
$self
->{handles}->{
$handle
} =
$handle
;
}
sub
_cert_file {
my
$self
=
shift
;
my
$cert
=
$self
->{cert};
return
$cert
if
$cert
&& -r
$cert
;
$cert
= File::Spec->catfile(
$ENV
{MOJO_TMPDIR} || File::Spec->tmpdir,
'mojocert.pem'
);
croak
qq/Can't create temporary TLS cert file "$cert"/
unless
my
$file
= IO::File->new(
"> $cert"
);
print
$file
CERT;
$self
->{cert} =
$cert
;
}
sub
_key_file {
my
$self
=
shift
;
my
$key
=
$self
->{key};
return
$key
if
$key
&& -r
$key
;
$key
= File::Spec->catfile(
$ENV
{MOJO_TMPDIR} || File::Spec->tmpdir,
'mojokey.pem'
);
croak
qq/Can't create temporary TLS key file "$key"/
unless
my
$file
= IO::File->new(
"> $key"
);
print
$file
KEY;
$self
->{key} =
$key
;
}
sub
_tls {
my
(
$self
,
$handle
) =
@_
;
if
(
$handle
->accept_SSL) {
$self
->iowatcher->remove(
$handle
);
delete
$self
->{handles}->{
$handle
};
return
$self
->emit(
accept
=>
$handle
);
}
my
$error
=
$IO::Socket::SSL::SSL_ERROR
;
if
(
$error
== TLS_READ) {
$self
->iowatcher->not_writing(
$handle
) }
elsif
(
$error
== TLS_WRITE) {
$self
->iowatcher->writing(
$handle
) }
}
1;