root/lang/perl/Moobal/trunk/lib/Moobal/Listener/TCP.pm @ 11949

######################################################################
# TCP listener on a given port
#
# Copyright 2004, Danga Interactive, Inc.
# Copyright 2005-2007, Six Apart, Ltd.


package Moobal::Listener::TCP;

use Moose;

with 'Moobal::Role::Listener';
with 'Moobal::Role::WithContext';

around 'new' => sub {
    my $next = shift;
    my $self = $next->(@_);
    $self->start_listen();
    return $self;
};

has 'service' => (
    is => 'rw',
    isa => 'Moobal::Service'
);

has 'hostport' => (
    is =>'rw',
    isa => 'Str'
);

has 'sslopts' => (
    is => 'rw'
);

use Danga::Socket::Callback;
use Moobal;
use IO::Socket::INET;
use Socket qw(IPPROTO_TCP SOL_SOCKET SO_SNDBUF);
use UNIVERSAL::require;

sub start_listen
{
    my $self = shift;

    my $sock = IO::Socket::INET->new(
        LocalAddr => $self->hostport,
        Proto     => IPPROTO_TCP,
        Listen    => 1024,
        ReuseAddr => 1,
    );

    return die ("Error creating listening socket: " . ($@ || $!))
        unless $sock;

    if (&Moobal::RUNNING_IN_HELL) {
        # On Windows, we have to do this a bit differently.
        # IO::Socket should really do this for us, but whatever.
        my $do = 1;
        ioctl($sock, 0x8004667E, \$do) or 
            die ("Unable to make listener on @{[$self->hostport]} non-blocking: $!");
    }
    else {
        # IO::Socket::INET's Blocking => 0 just doesn't seem to work
        # on lots of perls.  who knows why.
        IO::Handle::blocking($sock, 0) or
            die ("Unable to make listener on @{[$self->hostport]} non-blocking: $!");
    }

    # Create a Danga::Socket callback 
    Danga::Socket::Callback->new(
        handle        => $sock,
        on_read_ready => sub { $self->accept_client( @_ ) }
    );

    return $self;
}

# TCPListener: accepts a new client connection
sub accept_client {
    my ($self, $dsocket) = @_;

    # accept as many connections as we can
    while (my ($psock, $peeraddr) = $dsocket->{sock}->accept) {
        IO::Handle::blocking($psock, 0);

        if (my $sndbuf = $self->service->{client_sndbuf_size}) {
            my $rv = setsockopt($psock, SOL_SOCKET, SO_SNDBUF, pack("L", $sndbuf));
        }

        if (&Moobal::DEBUG >= 1) {
            my ($pport, $pipr) = Socket::sockaddr_in($peeraddr);
            my $pip = Socket::inet_ntoa($pipr);
            print "Got new conn: $psock ($pip:$pport) for " . $self->service->role . "\n";
        }

        # SSL promotion if necessary
        if ($self->{sslopts}) {
            if (&Moobal::SSL_AVAILABLE) {
                # try to upgrade to SSL, this does no IO it just reblesses
                # and prepares the SSL engine for handling us later
                IO::Socket::SSL->start_SSL(
                    $psock,
                    SSL_server => 1,
                    SSL_startHandshake => 0,
                    %{ $self->{sslopts} },
                );
                print "  .. socket upgraded to SSL!\n" if &Moobal::DEBUG >= 1;

                # safety checking to ensure we got upgraded
                return $psock->close
                    unless ref $psock eq 'IO::Socket::SSL';

                # class into new package and run with it
                my $sslsock = new Moobal::SocketSSL($psock, $self);
                $sslsock->try_accept;

                # all done from our point of view
                next;
            }
        }

        # puts this socket into the right class
        $self->class_new_socket($psock);
    }
}

my %ROLE2CLIENTCLASS = (
    reverse_proxy => 'Moobal::Component::Proxy',
    management    => 'Moobal::Component::Management',
    web_server    => 'Moobal::Component::ClientHTTP',
    selector      => 'Moobal::Component::HTTP'
);

sub class_new_socket {
    my ( $self, $psock ) = @_;

    my $service      = $self->service;
    my $service_role = $service->role;
    my $client_class = $ROLE2CLIENTCLASS{ $service_role };

    my $ret;
    if ($client_class) {
        if (! Class::MOP::is_class_loaded($client_class) ) {
            $client_class->require or die;
        }
        $ret = $client_class->new( 
            context => $service->context,
            service => $service, socket => $psock );
#    } elsif (my $creator = Moobal::Service::get_role_creator($service_role)) {
#        # was defined by a plugin, so we want to return one of these
#        $ret = $creator->( service => $service, socket => $psock);
    }

    return $ret;
}

# XXX TODO LATER
#sub as_string {
#    my Moobal::TCPListener $self = shift;
#    my $ret = $self->SUPER::as_string;
#    my Moobal::Service $svc = $self->service;
#    $ret .= ": listening on $self->{hostport} for service '$svc->{name}'";
#    return $ret;
#}
#
#sub as_string_html {
#    my Moobal::TCPListener $self = shift;
#    my $ret = $self->SUPER::as_string_html;
#    my Moobal::Service $svc = $self->service;
#    $ret .= ": listening on $self->{hostport} for service <b>$svc->{name}</b>";
#    return $ret;
#}
#
#sub die_gracefully {
#    # die off so we stop waiting for new connections
#    my $self = shift;
#    $self->close('graceful_death');
#}

1;


# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: