File Coverage

blib/lib/Net/IMP/Remote.pm

Criterion	Covered	Total	%
statement	46	97	47.4
branch	1	30	3.3
condition	0	10	0.0
subroutine	15	27	55.5
pod	5	5	100.0
total	67	169	39.6

use strict;
use warnings;

package Net::IMP::Remote;
use base 'Net::IMP::Base';
use fields qw(factory pid interface);
use Net::IMP::Remote::Client;
use Net::IMP::Remote::Connection;
use Net::IMP::Remote::Protocol;
use IO::Socket::INET;
use IO::Socket::UNIX;
use Net::IMP::Debug;
use Scalar::Util 'weaken';
use Carp;

our $VERSION = '0.010';

my $INETCLASS = 'IO::Socket::INET';
BEGIN {
    for(qw(IO::Socket::IP IO::Socket::INET6)) {
	eval "require $_" or next;
	$INETCLASS = $_;
	last;
    }
}

sub validate_cfg {
    my ($class,%args) = @_;
    my @err;
    push @err,"no address given" if ! delete $args{addr};
    push @err,"invalid value for 'fail'"
	if ( delete $args{fail} // 'hard' ) !~m{^(soft|hard)$};
    eval { Net::IMP::Remote::Protocol->load_implementation(delete $args{impl})}
	or push @err,$@;
    return (@err,$class->SUPER::validate_cfg(%args));
}

sub new_factory {
    my ($class,%args) = @_;
    my $self = $class->SUPER::new_factory(%args);
    $self->_factory();
    return $self;
}

sub set_interface {
    my ($self,$if) = @_;
    $self->{interface} = $if; # store for reconnects
    return $self->_factory->set_interface($if);
}

sub get_interface {
    my $self = shift;
    return $self->_factory->get_interface(@_);
}

sub new_analyzer {
    my ($self,%args) = @_;
    return $self->_factory->new_analyzer(%args);
}

sub _factory {
    my $self = shift;

    # close and reconnect after fork
    my $f = $self->{factory};
    $f = undef if $f and $self->{pid} != $$;
    if ( ! $f ) {
	$f = $self->{factory} = $self->_reconnect();
	$self->{pid} = $$;
    }
    # successful connected to IMP server
    return $f if $f;

    # return dummy factory object which supports no interface
    # and where each analyzer just issues IMP_FATAL
    return Net::IMP::Remote::_Fail->new_factory(%{ $self->{factory_args}});
}

sub _reconnect {
    my $self = shift;
    my $addr = $self->{factory_args}{addr} or croak("no addr given");
    my $ev = $self->{factory_args}{eventlib} or croak(
	"data provider does not offer integration into its event loop with eventlib argument");
    my $fd = $addr =~m{/}
	? IO::Socket::UNIX->new(Peer => $addr, Type => SOCK_STREAM, Timeout => 10)
	: $INETCLASS->new( PeerAddr => $addr, Timeout => 10)
	or return;
    $fd->blocking(0);
    debug("connected to $addr");
    my $conn = Net::IMP::Remote::Connection->new($fd,0,
	impl => $self->{factory_args}{impl},
	eventlib => $ev,
    );
    weaken(my $wself=$self);
    $conn->onClose(sub {
	my $why = shift;
	$wself->{factory} = undef; # reconnect on new_analyzer
    });
    my $factory = Net::IMP::Remote::Client->new_factory(
	%{ $self->{factory_args}},
	conn => $conn,
    ) or die "cannot create factory";

    # set last used interface again
    $factory = $factory->set_interface($self->{interface})
	if $self->{interface};
    return $factory;
}


{
    package Net::IMP::Remote::_Fail;
    use base 'Net::IMP::Base';
    use Net::IMP qw(:DEFAULT :log);
    sub set_interface { return shift } # no change factory
    sub get_interface { return ()    } # we don't support anything
    sub data { return }

    sub new_analyzer {
	my $class = shift;
	my $self = $class->SUPER::new_analyzer(@_) or return;
	my $fail = $self->{factory_args}{fail} || 'hard';
	my $err = $self->{factory_args}{connect_error} || $!;
	$self->run_callback(
	    $fail eq 'soft' ? (
		[ IMP_LOG,0,0,0,IMP_LOG_ERR,
		    "connect to IMP server failed ($err): pass all" ],
		[ IMP_PASS,0,IMP_MAXOFFSET ],
		[ IMP_PASS,1,IMP_MAXOFFSET ],
	    ):(
		[ IMP_FATAL,"connect to IMP server failed ($err)" ]
	    )
	);
	return $self;
    }
}

1;
__END__