view release on metacpan or  search on metacpan

lib/DJabberd/Delivery/ComponentConnection.pm  view on Meta::CPAN

    $self->_prepare_connection();
}

sub deliver {
    my ($self, $vhost, $cb, $stanza) = @_;

    if ($self->_can_deliver_stanza($stanza)) {
        if (my $conn = $self->connection) {
            $conn->write_stanza($stanza);
        }
        else {
            # If we've currently got no connection at all,
            # let's throw a wobbly.
            # FIXME: Could this get into an infinite loop in some cases? Probably.
            $stanza->make_error_response('503', 'cancel', 'service-unavailable')->deliver($vhost);
        }
        return $cb->delivered;
    }
    else {
        return $cb->decline;
    }

}

sub _i_am_the_component {
    return $_[0]->{i_am_the_component};
}

sub _can_deliver_stanza {
    my ($self, $stanza) = @_;
    
    # If we're the component, we want to offload anything with a domain
    # other than our own. If we aren't the component, the reverse is true.
    my $same_host = ($stanza->to_jid->domain eq $self->vhost->server_name);
    
    return $self->_i_am_the_component ? ! $same_host : $same_host;
}

sub connection {
    return $_[0]->{connection};
}

sub _prepare_connection {
    my ($self) = @_;
    
    if ($self->_i_am_the_component) {
        $self->_start_connection($self);
    }
    else {
        $self->_start_listener($self);
    }
}

sub _start_connection {
    my ($self) = @_;
    
    my $vhost = $self->vhost;
    
    my $connection = DJabberd::Connection::ComponentOut->new(
        endpoint => DJabberd::IPEndPoint->new($self->{remoteaddr}, $self->{remoteport}),
        vhost => $vhost,
        secret => $self->{secret},
    );
    $connection->watch_read(1);
    $connection->add_connect_handler(sub {
        $logger->debug("Connection established and channel open.");
        $self->{connection} = $connection;
    });
    $connection->add_disconnect_handler(sub {
        # FIXME: Maybe this delay should get exponentially longer each retry?
        # We're probably only connecting to localhost anyway, so I shant bother for now.
        $logger->debug("Outgoing connection was lost. Will attempt to re-establish it in 30 seconds.");

        Danga::Socket->AddTimer(30, sub {
            $self->{connection} = undef;
            $self->_prepare_connection();
        });
    });

}

sub _start_listener {
    my ($self) = @_;
    my $vhost = $self->vhost;
    
    my $bindaddr = $self->{listenaddr};

    # FIXME: Maybe shouldn't duplicate all of this code out of DJabberd.pm.
    
    my $server;
    my $not_tcp = 0;
    if ($bindaddr =~ m!^/!) {
        $not_tcp = 1;
        $server = IO::Socket::UNIX->new(
            Type   => SOCK_STREAM,
            Local  => $bindaddr,
            Listen => 10
        );
        $logger->logdie("Error creating UNIX domain socket $bindaddr: $@") unless $server;
        $logger->info("Started listener for component ".$self->domain." on UNIX domain socket $bindaddr");
    } else {
        $server = IO::Socket::INET->new(
            LocalAddr => $bindaddr,
            Type      => SOCK_STREAM,
            Proto     => IPPROTO_TCP,
            Blocking  => 0,
            Reuse     => 1,
            Listen    => 10
        );
        $logger->logdie("Error creating listen socket for <$bindaddr>: $@") unless $server;
        $logger->info("Started listener for component ".$self->domain." on TCP socket <$bindaddr>");
    }

    # Brad thinks this is necessary under Perl 5.6, and who am I to argue?
    IO::Handle::blocking($server, 0);
    
    $self->{listener} = $server;

    my $accept_handler = sub {
        my $csock = $server->accept;