package Mojo::IOLoop::Server; use Mojo::Base 'Mojo::IOLoop::EventEmitter'; use Carp 'croak'; use File::Spec; use IO::File; use IO::Socket::INET; use Scalar::Util 'weaken'; use Socket qw/IPPROTO_TCP TCP_NODELAY/; # IPv6 support requires IO::Socket::IP use constant IPV6 => $ENV{MOJO_NO_IPV6} ? 0 : eval 'use IO::Socket::IP 0.06 (); 1'; # TLS support requires IO::Socket::SSL use constant TLS => $ENV{MOJO_NO_TLS} ? 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; # Default TLS cert (20.03.2010) # (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300) use constant CERT => <<EOF; -----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 # Default TLS key (20.03.2010) # (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300) use constant KEY => <<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 { require Mojo::IOLoop; 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}}; } # "And I gave that man directions, even though I didn't know the way, # because that's the kind of guy I am this week." sub listen { my $self = shift; my $args = ref $_[0] ? $_[0] : {@_}; # Look for reusable file descriptor my $reuse = my $port = $args->{port} || 3000; $ENV{MOJO_REUSE} ||= ''; my $fd; if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 } # Allow file descriptor inheritance local $^F = 1000; # Reuse file descriptor 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: $!"; } # New socket 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; # TLS if ($args->{tls}) { # No TLS support croak "IO::Socket::SSL 1.43 required for TLS support" unless TLS; # Options 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 { # Try random ports 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; # Accept my $handle = $self->{handle}->accept; # Non-blocking $handle->blocking(0); # Disable Nagle's algorithm setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1; # Start TLS handshake 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; # Check if temporary TLS cert file already exists my $cert = $self->{cert}; return $cert if $cert && -r $cert; # Create temporary TLS cert file $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; # Check if temporary TLS key file already exists my $key = $self->{key}; return $key if $key && -r $key; # Create temporary TLS key file $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; } # "Where on my badge does it say anything about protecting people? # Uh, second word, chief." sub _tls { my ($self, $handle) = @_; # Accepted if ($handle->accept_SSL) { $self->iowatcher->remove($handle); delete $self->{handles}->{$handle}; return $self->emit(accept => $handle); } # Switch between reading and writing 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; __END__ =head1 NAME Mojo::IOLoop::Server - IOLoop Socket Server =head1 SYNOPSIS use Mojo::IOLoop::Server; # Create listen socket my $server = Mojo::IOLoop::Server->new; $server->on(accept => sub { my ($self, $handle) = @_; ... }); $server->listen(port => 3000); # Start and stop accepting connections $server->resume; $server->pause; =head1 DESCRIPTION L<Mojo::IOLoop::Server> accepts incoming socket connections for L<Mojo::IOLoop>. Note that this module is EXPERIMENTAL and might change without warning! =head1 EVENTS L<Mojo::IOLoop::Server> can emit the following events. =head2 C<accept> Emitted for each accepted connection. =head1 ATTRIBUTES L<Mojo::IOLoop::Server> implements the following attributes. =head2 C<iowatcher> my $watcher = $server->iowatcher; $server = $server->iowatcher(Mojo::IOWatcher->new); Low level event watcher, usually a L<Mojo::IOWatcher> or L<Mojo::IOWatcher::EV> object. =head1 METHODS L<Mojo::IOLoop::Server> inherits all methods from L<Mojo::IOLoop::EventEmitter> and implements the following new ones. =head2 C<listen> $server->listen(port => 3000); Create a new listen socket. Note that TLS support depends on L<IO::Socket::SSL> and IPv6 support on L<IO::Socket::IP>. These options are currently available: =over 2 =item C<address> Local address to listen on, defaults to all. =item C<backlog> Maximum backlog size, defaults to C<SOMAXCONN>. =item C<port> Port to listen on. =item C<tls> Enable TLS. =item C<tls_cert> Path to the TLS cert file, defaulting to a built-in test certificate. =item C<tls_key> Path to the TLS key file, defaulting to a built-in test key. =item C<tls_ca> Path to TLS certificate authority file or directory. =back =head2 C<generate_port> my $port = $server->generate_port; Find a free TCP port. =head2 C<pause> $server->pause; Stop accepting connections. =head2 C<resume> $server->resume; Start accepting connections. =head1 SEE ALSO L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. =cut