POE::Component::SNMP - POE interface to Net::SNMP

  # this script is included in the distribution as eg/snmp_sample.pl
  use POE qw/Component::SNMP/;

  my %system = ( sysUptime   => '.1.3.6.1.2.1.1.3.0',
                 sysName     => '.1.3.6.1.2.1.1.5.0',
                 sysLocation => '.1.3.6.1.2.1.1.6.0',
               );
  my @oids = values %system;
  my $base_oid = '.1.3.6.1.2.1.1'; # system.*

  POE::Session->create( inline_states =>
                        { _start       => \&_start,
                          snmp_handler => \&snmp_handler,
                        }
                      );

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

    POE::Component::SNMP->create( alias     => 'snmp', # same as default
                                  hostname  => 'localhost',
                                  community => 'public',
                                  version   => 'snmpv2c',
                                  # debug => 0x0A,
                                );

    $kernel->post( snmp => get     => snmp_handler =>
                   -varbindlist    => \@oids );

    # ... or maybe ...

    $kernel->post( snmp => walk    => snmp_handler =>
                   -baseoid        => $base_oid );

    # ... or possibly even ...

    my @callback_args = (1, 2, 3);
    $kernel->post( snmp => getbulk => snmp_handler =>
                   -varbindlist    => [ $base_oid ],
                   -maxrepetitions => 6,
		   -callback_args  => \@callback_args
                 );

    $heap->{pending} = 3;
  }

  sub snmp_handler {
    my ($kernel, $heap, $request, $response) = @_[KERNEL, HEAP, ARG0, ARG1];
    my ($alias, $host, $cmd, @args) = @$request;
    my ($results, @callback_args)   = @$response;

    if (ref $results) {
      print "$host SNMP config ($cmd):\n";
      print "sysName:     $results->{$system{sysName}}\n";
      print "sysUptime:   $results->{$system{sysUptime}}\n";
      print "sysLocation: $results->{$system{sysLocation}}\n";
    } else {
      print "$host SNMP error ($cmd => @args):\n$results\n";
    }

    print "Additional args: @callback_args\n";

    if (--$heap->{pending} == 0) {
      $kernel->post( $alias => 'finish' );
    }
  }

  $poe_kernel->run();

  # see the eg/ folder in the distribution archive for more samples

  $poe_kernel->post( $session_alias => $request =>
                     $callback_state => @snmp_args );

  Net::SNMP
  POE

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__

# vi:set foldmethod=marker: