File Coverage

blib/lib/POE/Component/SNMP.pm

Criterion	Covered	Total	%
statement	60	126	47.6
branch	16	44	36.3
condition	4	7	57.1
subroutine	11	28	39.2
pod	1	16	6.2
total	92	221	41.6

package POE::Component::SNMP;

use strict;

our $VERSION = '1.1006';

package POE::Net::SNMP;

use base q/Net::SNMP/;

# use Net::SNMP::XS;

our %localport;

# {{{ session

sub session {
    my $class = shift;
    my @arg = @_;
    my ($session, $error);

    # see if there is a localport supplied stash it on our list.
    my ($localport, %arg) = POE::Component::SNMP::_arg_scan(localport => @arg);

    if (defined $localport) {

        if (exists $localport{$localport}) {
            ($session, $error) = (undef, "Address already in use");
        } else {
            ($session, $error) =
              $class->SUPER::session( -nonblocking => 1,
                                      -localport => $localport,
                                      %arg,
                                    );
        }

    } else {

        # each session binds to a different local port/socket.  This
        # do..while loop catches potential port conflicts.
        do {

            # pick a port that's not already in use by *us*
            do {
		$localport = int(rand(65536 - 1025) + 1025)
	    } while (exists $localport{$localport});

            ($session, $error) =
              $class->SUPER::session( -nonblocking => 1,
                                      -localport => $localport,
                                      %arg,
                                    );

        } while ($error =~ /bind|already/);

    }

    if ($session) {
        # remember it
        $localport{$localport} = 1;
        $session->{_poe_component_snmp_localport} = $localport;
    }

    ($session, $error);
}

# }}} session
# {{{ DESTROY

sub DESTROY {
    my $session = shift;
    if ((my $localport = delete $session->{_poe_component_snmp_localport})) {
        delete $localport{$localport};
    }
}

# }}} DESTROY

package POE::Component::SNMP;

use Carp;
use POE::Session;
use POE::Component::SNMP::Dispatcher; # the real magic starts here

our $DISPATCHER;

# {{{ BEGIN

BEGIN
{
   # Validate the creation of the Dispatcher object.

   if (!defined($DISPATCHER = $Net::SNMP::DISPATCHER = POE::Component::SNMP::Dispatcher->instance)) {
      die('FATAL: Failed to create Dispatcher instance');
   }
}

# }}} BEGIN

# {{{ create

sub create {
    my $class = shift;
    my @arg = @_;
    my %arg; # = @_;

    my $alias;

    # we don't do alias dupe checks anymore, we leave that to POE
    ($alias, %arg) = _arg_scan(alias => @arg);
    $alias ||= 'snmp';

    # die unless we get a hostname
    unless ( (_arg_scan(hostname => @arg))[0] ) {
        croak "hostname parameter required";
    }

    # make sure we have a dispatcher!
    if (!defined($DISPATCHER = $Net::SNMP::DISPATCHER = POE::Component::SNMP::Dispatcher->instance)) {
        die('FATAL: Failed to create Dispatcher instance');
    }

    my ($session, $error);
    ($session, $error) = POE::Net::SNMP->session( %arg );

    # use Data::Dumper; print Dumper([ $session->transport, $Net::SNMP::Transport::SOCKETS ]);

    # delete $Net::SNMP::Transport::SOCKETS->{$session->transport->{_sock_name}};

    croak $error unless $session;

    POE::Session->create( inline_states => { _start        => \&start_snmp_session,
                                             _stop         => \&end_snmp_session,
                                             finish        => \&close_snmp_session,

                                             get           => \&snmp_get,
                                             getnext       => \&snmp_getnext,
                                             walk          => \&snmp_walk,
                                             getbulk       => \&snmp_getbulk,
                                             getentries    => \&snmp_getentries,
                                             trap          => \&snmp_trap,
                                             trap2c        => \&snmp_trap2c,
                                             inform        => \&snmp_inform,
                                             set           => \&snmp_set,

                                             errmsg        => \&snmp_errmsg,
					     callback_args => \&snmp_callback_args,
                                           },
                          args => [
                                   $alias,   # component alias
                                   $session, # Net::SNMP session
                                  ],
			);
}

# }}} create
# {{{ start_snmp_session

sub start_snmp_session {
    my ($kernel, $heap, $alias, $session) = @_[KERNEL, HEAP, ARG0..$#_];

    # make sure we aren't duplicating component aliases!
    if ( ! ($POE::VERSION <= 0.95 and POE::Kernel::ASSERT_DATA) and
         defined $kernel->alias_resolve($alias)
       ) {
        local $Carp::CarpLevel = 4; # munge up to the right level of code

        croak "A ", __PACKAGE__, " instance called '$alias' already exists!";
    }

    $kernel->alias_set($alias);
    # $heap->{comp_alias}   = $alias;    # component alias
    $heap->{snmp_session} = $session;  # Net::SNMP session
    $heap->{postback_args} = [ $alias, $session->hostname ];
}

# }}} start_snmp_session
# {{{ close_snmp_session

sub close_snmp_session {
    my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
    my $snmp_session = $heap->{snmp_session};

    return unless defined $snmp_session;

    if ($snmp_session->debug & 0x08) {
        print "debug: [", __LINE__, "] ", __PACKAGE__, "::close_snmp_session: calling __clear_pending\n";
    }

    # cancel all current and pending requests
    my $rv = $kernel->call(_poe_component_snmp_dispatcher => __clear_pending => $snmp_session);

    # remove our alias... since we have no more pending requests, we
    # will go away now.
    $kernel->alias_remove($_) for $kernel->alias_list( $session );


    # use Data::Dumper; print Dumper $snmp_session;
    # now the only thing keeping this session alive are any postback
    # references that have yet to be delivered.
}

# }}} close_snmp_session
# {{{ end_snmp_session

sub end_snmp_session {
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    $heap->{snmp_session}->close;
}

# }}} end_snmp_session

# {{{ requests

sub snmp_get        { snmp_request( get_request      => @_ ) }
sub snmp_getnext    { snmp_request( get_next_request => @_ ) }
sub snmp_walk       { snmp_request( get_table        => @_ ) }
sub snmp_getbulk    { snmp_request( get_bulk_request => @_ ) }
sub snmp_getentries { snmp_request( get_entries      => @_ ) }
sub snmp_inform     { snmp_request( inform_request   => @_ ) }
sub snmp_set        { snmp_request( set_request      => @_ ) }

# }}} requests
# {{{ snmp_request

sub snmp_request {
    # first parameter is the Net::SNMP method to call
    my $method = shift;
    # then standard POE args
    my ($kernel, $heap, $sender, $target_state, @snmp_args) = @_[KERNEL, HEAP, SENDER, ARG0..$#_];

    # extract the PoCo::SNMP request method called, for diagnostics
    # 'POE::Component::SNMP::snmp_get' => 'get'
    my $action = (caller(1))[3]; $action =~ s/POE::Component::SNMP::snmp_//;

    my (@callback_args, $callback_args);
    ($callback_args, @snmp_args) = _arg_scan(callback_args => @snmp_args);

    my $ok = 1;
    # if $callback_args is defined, we got a callback_args in the request.
    if (defined $callback_args) {
        if (ref $callback_args eq 'ARRAY') {
            @callback_args = @$callback_args;
        } else {
            $ok = 0;
            $heap->{snmp_session}->_error("Argument to -callback_args must be an arrayref");
            @callback_args = ($callback_args); # stash the "bad" argument to return with the error
        }
    }

    # do this before the 'set' logic to return an original copy of
    # @snmp_args to the callback.
    my @postback_args = (@{$heap->{postback_args}}, $action, @snmp_args);

    if ($ok) {
        if ($method eq 'set_request') {
            # string => numeric constant processing
            @snmp_args = _dwim_set_request_args(@snmp_args);
        }

	# this $postback is a closure.  it goes away after firing.
        my $postback = $sender->postback($target_state => @postback_args);
        $ok = $heap->{snmp_session}->$method( @snmp_args,
                                              -callback =>
                                              [ sub { $postback->( ( defined ($_[0]->var_bind_list) ?
                                                                     $_[0]->var_bind_list : $_[0]->error
                                                                   )
                                                                   # x 0,
                                                                   # $_[0],
                                                                   ,
                                                                   @callback_args,
                                                                 );
                                                  }
                                              ]
                                            );

    }


    unless ($ok) {
        $kernel->post( $sender => $target_state => \@postback_args,
                       [ $heap->{snmp_session}->error,
                         @callback_args,
                       ]
                     );
    }

}

# }}} snmp_request

# {{{ snmp_trap

# invoke with: $status = $kernel->call( $alias => trap );
sub snmp_trap {
    my ($kernel, $heap, @snmp_args) = @_[KERNEL, HEAP, ARG0..$#_];
    $heap->{snmp_session}->trap( @snmp_args );
}

# }}} snmp_trap
# {{{ snmp_trap2c

# invoke with: $error = $kernel->call( $alias => trap2c );
sub snmp_trap2c {
    my ($kernel, $heap, @snmp_args) = @_[KERNEL, HEAP, ARG0..$#_];
    $heap->{snmp_session}->snmpv2_trap( @snmp_args );
}

# }}} snmp_trap2c

# {{{ snmp_errmsg

# invoke with: $error = $kernel->call( $alias => error );
sub snmp_errmsg { $_[HEAP]{snmp_session}->error }

# }}} snmp_errmsg
# {{{ snmp_callback_args

# invoke with: $kernel->post( $alias => callback_args => @args );
sub snmp_callback_args {
    my ($heap, @args) = @_[HEAP, ARG0..$#_];

    $heap->{callback_args} = \@args;
}

# }}} snmp_callback_args

# internal methods
# {{{ _arg_scan

# scan an array for a key matching qw/ -key key Key KEY / and fetch
# the value. return the value and the remaining arg list minus the
# key/value pair.
sub _arg_scan_old {
    my ($key, @arg) = @_;

    my $value;
    # scan the @arg for any keys that are callback args.
    for (0..$#arg) {
        next unless defined $arg[$_];
        if ($arg[$_] =~ /^-?$key$/i) {
            $value = $arg[$_ + 1];

            # splice out the key and value from @arg:
            splice @arg, $_, 2;
        }
    }

    ($value, @arg);
}

sub _arg_scan {
    my ($key, @arg) = @_;
    my ($value, $k_idx, $v_idx, @ret_arg);

    # scan the @arg for any keys that are callback args.
    for $k_idx ( map { $_*2 } (0..(@arg/2-1)) ) {
        $v_idx = ($k_idx+1);
        if ($arg[$k_idx] =~ m/^-?$key$/i) {
            $value = $arg[$v_idx];
        } else {
            # we only return args that didn't match our scan.
            push @ret_arg, @arg[$k_idx, $v_idx];
        }
    }

    ($value, @ret_arg);

}

# }}} _arg_scan
# {{{ _dwim_set_request_args

# change string constant like 'OCTET_STRING' to a number by calling
# OCTET_STRING()
#
# For a set request, the 2nd item of the varbindlist should be a
# string constant indicating the value type.  This block does a lookup
# of the numeric equivalent and replaces it in the parameter list.
sub _dwim_set_request_args {
    my %snmp_args = @_;

    # extract the varbindlist from args
    my ($vbl) = _arg_scan(varbindlist => @_);

    # make $type refer to the string in $vbl->[1]
    my $type = ref($vbl) eq 'ARRAY' ? \$vbl->[1] : \ 'foo';

    # if Net::SNMP::Message knows about it, use it to replace the
    # string with its numeric equivalent, e.g. 'OCTET_STRING' => 4
    if ( Net::SNMP::Message->can($$type) ) {
        $$type = Net::SNMP::Message->${$type}();
    }

    %snmp_args; # flatten back to a simple list.
}

# }}} _dwim_set_request_args

1;

__END__