use strict;
use SNMP;
# use Spiffy qw/:XXX/;
use Carp;
# use base qw/SNMP::Session/;
# use Smart::Comments qw/####/;
use Time::HiRes qw/time/;
our $INSTANCE; # reference to our Singleton object
# our $MESSAGE_PROCESSING; # reference to single MP object
use constant VERBOSE => 0; # debugging, that is
use constant SNMP_DEBUG => 0; # set to 2 for output, 3 includes packet dumps
use constant SNMP_SELECT_DEBUG => 0; # set to 2 or 3 to see anything.
# sub DEBUG_INFO() { }
# sub DEBUG_INFO { my $pat = shift; printf "$pat\n", @_ }
our $DEBUG = 0;
our $DO_DISPATCH = 0;
# $SNMP::verbose = $DEBUG;
# $SNMP::debugging = 0;
# $SNMP::debug_internals = $DEBUG;
# {{{ instance methods and constructor
sub instance { $INSTANCE ||= POE::Component::SNMP::Session::Dispatcher->_new }
sub new { _new(@_) };
# sub _new { shift->SUPER::_new(@_)->_new_session() }
sub _new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self->_new_session();
}
sub _new_session {
my $this = shift;
#### constructor: $this
# $this->{_active} = Net::SNMP::Message::TRUE;
# $this->{_active} = 1;
# $MESSAGE_PROCESSING = $Net::SNMP::Dispatcher::MESSAGE_PROCESSING;
POE::Session->create( object_states =>
[ $this => [
qw/
_start
_stop
__timeout_callback
__socket_callback
__clear_pending
__create_pdu
__listen
_send_pdu
/
],
# __schedule_event
# __dispatch_pdu
]);
return $this;
}
sub _alias {'_poe_component_snmp_session_dispatcher'}
# }}} instance methods and constructor
# {{{ POE EVENTS
# By convention, all POE states, except _start and _stop, have
# two leading underscores.
# {{{ _start and _stop
sub _start {
$_[KERNEL]->alias_set($_[OBJECT]->_alias);
return;
}
sub _stop {
$_[KERNEL]->alias_remove($_[OBJECT]->_alias);
undef $INSTANCE;
return; # dang perl critic!
}
# }}} _start and _stop
# {{{ __listen
sub __listen {
my ($this, $session, $fd) = @_[OBJECT, ARG0..$#_];
$this->_fd_from_session($session => $fd);
$this->_session_from_fd($fd => $session);
$this->_watch_socket($this->_sock_from_fd($fd));
return;
}
# }}} __listen
# {{{ __create_pdu
sub __create_pdu {
my ($this, $kernel,
$session, $method, $snmp_args, $postback, $callback_args,
@args) = @_[OBJECT, KERNEL, ARG0..$#_];
# $callback_args = [ $session => $method => \@snmp_args, $callback ]
my $callback =
sub {
# Perl Hacks #57
local *__ANON__ = __PACKAGE__ . ":: session callback";
DEBUG_INFO("{{{{ callback start");
# deliver response
DEBUG_INFO(" sending POE postback");
# print STDOUT Dump($DISPATCHER);
$postback->(@_,
@$callback_args,
);
# handle cleanups
my $fd = $this->_fd_from_session($session);
my $pending = $this->_dec_pending($session);
if ($pending == 0 and exists $this->{_unwatch}{$fd}) {
delete $this->{_unwatch}{$fd};
$this->_unwatch_socket($this->_sock_from_fd($fd));
}
DEBUG_INFO("}}}} callback done");
};
my $ok;
## send an SNMP request. If error free, check with the API about
## timeouts. otherwise return the error.
DEBUG_INFO("sending request");
$this->_inc_pending($session);
{
local $SNMP::debugging = SNMP_DEBUG if SNMP_DEBUG;
$ok = $session->$method( @$snmp_args,
$callback
);
# $SNMP::debugging = 0;
}
unless ($ok) {
DEBUG_INFO("request returns: (%d) %s", $session->{ErrorNum}, $session->{ErrorStr});
# invoke the callback with nothing. the session object is
# available via the calling args, to retrieve the actual
# error.
$callback->();
# calling return here makes the assumption that since
# the request failed, nothing will have changed as far
# as what needs to be managed by us.
return;
}
DEBUG_INFO("sent request");
# check timeouts, set delays. delays WILL have changed after
# making the request.
$this->_timeout_check();
return $ok;
}
# }}} __create_pdu
### ... time passes. then either a socket comes live, or a timeout occurs.
# {{{ __socket_callback
sub __socket_callback {
my ($this, $kernel, $heap, $socket) = @_[OBJECT, KERNEL, HEAP, ARG0];
### ah-HAH, we got a response!
my $fd = $socket->fileno;
DEBUG_INFO('{-------- invoking callback for [%d]', $fd);
{
local $SNMP::debugging = SNMP_DEBUG if SNMP_DEBUG;
SNMP::reply_cb($fd);
}
DEBUG_INFO(' --------} callback complete for [%d]', $fd);
$this->_timeout_check();
return;
}
# }}} __socket_callback
# {{{ __timeout_callback
sub __timeout_callback {
# my ($session, @args) = @_;
### oh NO!! We timed out!
my ($this, $kernel) = @_[OBJECT, KERNEL];
DEBUG_INFO('{-------- invoking scheduled callback id %d',
$this->_timeout_id());
# clear the timeout that just fired
$this->_timeout_id(undef);
# check for timeout callbacks or retrigger
$this->_timeout_check();
DEBUG_INFO(' --------} callback complete' );
return;
}
# }}} __timeout_callback
# {{{ __clear_pending
# account for a 'finish' request to a parent snmp session. Cancels
# any *pending* requests for the specified session. However, if
# 'finish' is called on a session while the Dispatcher is currently
# listening for a reply to that session, that reply *will* be
# delivered when it arrives.
#
# this event is invoked from P::C::S::close_snmp_session(), to help us
# keep in sync.
#
# This event exists as an event so that _unwatch_socket() will live in
# the right POE session.
sub __clear_pending {
my ($this, $session) = @_[OBJECT, ARG0];
my $fd = $this->_fd_from_session($session);
# if a response is still pending, defer unwatch and make it a part
# of the socket callback.
# if ($this->_current_pdu($session)) {
if ($this->_get_pending($session)) {
DEBUG_INFO('%d response still pending for [%d], deferring _unwatch_socket()', $this->{_pending}{$fd}, $fd);
$this->{_unwatch}{$fd}++;
} else {
$this->_unwatch_socket($this->_sock_from_fd($fd));
}
return;
}
# }}} __clear_pending
# }}} POE EVENTS
# {{{ PRIVATE METHODS
# {{{ _timeout_check
sub _timeout_check {
my $this = shift;
my $delay_id = $this->_timeout_id();
my $delay;
DEBUG_INFO(' start');
# iro e n nes a voki select_info() ir, t e kud & l tav i miutz
# e urd.
#
# there is no need to call select_info() here, it is included
# in the api call and the delay in seconds is returned.
# local $SNMP::debugging = 3;
0 and $delay = SNMP::check_timeout();
if (defined $delay_id) {
# $delay_id is defined. adjust it.
if ($delay = SNMP::check_timeout()) {
# $delay is non-0, which means we've just gotten a
# different value from previous. Adjust our global
# timeout $delay seconds out.
POE::Kernel->delay_adjust($this->_timeout_id() => $delay);
DEBUG_INFO(' adjusted delay id %d %f seconds', $this->_timeout_id(), $delay);
} else {
# $delay is 0, which means there is nothing pending.
# Remove our timeout.
POE::Kernel->alarm_remove($delay_id);
$this->_timeout_id(undef);
DEBUG_INFO(' removed delay id %d', $delay_id);
}
} elsif ($delay = SNMP::check_timeout()) {
# $delay_id is NOT defined. define it.
# we try to set this alarm as soon after $delay is
# returned as possible. we end up slow by a few usecs.
$delay_id = POE::Kernel->alarm_set(__timeout_callback => $delay + time,
# $callback, $session
);
$this->_timeout_id($delay_id);
DEBUG_INFO(' set delay id %d %f seconds', $delay_id, $delay);
}
return $delay;
}
# }}} _timeout_check
# {{{ _timeout_id
sub _timeout_id {
my ($this) = @_;
# using a global timeout!
if (@_ > 1) {
# DEBUG_INFO("Setting timeout_id to [%d]", $_[1]);
$this->{_timeout_id} = $_[1];
}
# DEBUG_INFO("returning timeout_id [%d]", $this->{_timeout_id});
return $this->{_timeout_id};
}
# }}} _timeout_id
# {{{ _send_pdu
# this method exists to create sugar, so that we can say:
#
# $DISPATCHER->_send_pdu(@args)
#
# instead of
#
# $kernel->call( $DISPATCHER->_alias => __create_pdu => @args)
sub _send_pdu {
my $this = shift;
POE::Kernel->call($this->_alias() => __create_pdu => @_);
}
# }}} _send_pdu
# {{{ _clear_session
sub _clear_session {
my ($this, $session) = @_;
# warn "XXX have to finish clear_current";
# WWW { c => $this, sede => $session };
my $fd = delete $this->{_s_to_fd}{$session};
my $sock = delete $this->{_fd_to_sock}{$fd};
delete $this->{_fd_to_s}{$fd};
# WWW { c => $this, sede => $session };
return;
}
# }}} _clear_session
# {{{ _session_from_fd
sub _session_from_fd {
my ($this, $fd) = @_;
if (@_ > 2) {
$this->{_fd_to_s}{$fd} = $_[2];
}
return $this->{_fd_to_s}{$fd};
}
# }}} _session_from_fd
# {{{ _fd_from_session
sub _fd_from_session {
my ($this, $session) = @_;
if (@_ > 2) {
$this->{_s_to_fd}{$session} = $_[2];
}
return $this->{_s_to_fd}{$session};
}
# }}} _fd_from_session
##### socket methods
#
## These two methods are the only place in this module where the
## socket refcounting is done, so it's all self-contained.
#
# {{{ _watch_socket
# socket listen with refcount. If socket refcount, increment it. Else
# set refcount and listen on the socket.
#
# accesses global kernel.
sub _watch_socket {
my ($this, $socket, @args) = @_;
my $fd = $socket->fileno;
if (not $this->{_refcount}{$fd}) {
# don't need the per-request reference.
$this->{_refcount}{$fd} = 1;
DEBUG_INFO('[%d] refcount %d, select', $fd, $this->{_refcount}{$fd});
POE::Kernel->select_read($socket, '__socket_callback', @args);
} else {
# $this->{_refcount}{$fd}++;
# DEBUG_INFO('[%d] refcount %d, resume', $fd, $this->{_refcount}{$fd});
# POE::Kernel->select_resume_read($socket);
die __PACKAGE__, "::_watch_socket(): SHOULD NOT HAVE GOTTEN HERE!";
}
return $this->{_refcount}{$fd};
}
# }}} _watch_socket
# {{{ _unwatch_socket
# decrement the socket refcount. unlisten if refcount == 0.
# accesses global kernel.
sub _unwatch_socket {
my ($this, $socket) = @_;
DEBUG_INFO("{{{ enter");
# WWW ([ caller(0), [ caller(1), [ caller(2), [ caller(3) ]]]]);
my $fd = $socket->fileno;
if (--$this->{_refcount}{$fd} <= 0) {
DEBUG_INFO('[%d] refcount %d, unselect', $fd, $this->{_refcount}{$fd});
# stop listening on this socket
POE::Kernel->select_read($socket, undef);
delete $this->{_refcount}{$fd};
# _unwatch_socket used to be a per-request operation. Now it
# is a destructor, so:
$this->_clear_session($this->_session_from_fd($fd));
} else {
# DEBUG_INFO('[%d] refcount %d, pause %s',
# $fd, $this->{_refcount}{$fd}, ''
# # ('(deferred)') x defined $this->_current_pdu($fd)
# );
# POE::Kernel->select_pause_read($socket) # unless $this->_current_pdu($fd);
die __PACKAGE__, "::_unwatch_socket(): SHOULD NOT HAVE GOTTEN HERE!";
}
DEBUG_INFO("}}} leave");
return $this->{_refcount}{$fd}
}
# }}} _unwatch_socket
#####
# {{{ pending requests
sub _inc_pending {
my ($this, $session) = @_;
++$this->{_pending}{$this->_fd_from_session($session)};
}
sub _dec_pending {
my ($this, $session) = @_;
--$this->{_pending}{$this->_fd_from_session($session)};
}
sub _get_pending {
my ($this, $session) = @_;
$this->{_pending}{$this->_fd_from_session($session)};
}
# }}} pending requests
#####
# {{{ _fileno
sub _fileno {
if (@_ == 2) {
$_[0]->{_fileno} = $_[1];
}
$_[0]->{_fileno};
}
# }}} _fileno
# {{{ _sock_from_fd
# return a socket attached to a supplied fd
use Symbol qw/gensym/;
sub _sock_from_fd {
my $this = shift;
my $fd = shift;
carp "_sock_from_fd: undefined $fd!", return unless $fd;
return $this->{_fd_to_sock}{$fd} if exists $this->{_fd_to_sock}{$fd};
my $socket = gensym;
open $socket, "<&=", $fd;
# -- perl critic complains I don't check the return value of
# open()
return $this->{_fd_to_sock}{$fd} ||= $socket;
}
# NOTE: this version killed POE+Tk, even though it supposedly does the
# same as the above.
#
# specifically, the code calls:
# my $fd = _fd_from_session($session);
# my $socket = $this->_sock_from_fd($fd);
sub _sock_from_session {
my $this = shift;
my $session = shift;
carp "_sock_from_session: undefined $session!", return unless $session;
# return $this->{_fd_to_sock}{$fd} if exists $this->{_fd_to_sock}{$fd};
return $this->{_session_to_sock}{$session} if exists $this->{_session_to_sock}{$session};
my $socket = gensym;
open $socket, "<&=", $this->_fd_from_session($session);
return $this->{_session_to_sock}{$session} ||= $socket;
}
# }}} _sock_from_fd
# }}} PRIVATE METHODS
# {{{ DEBUG_INFO
sub DEBUG_INFO
{
return unless $DEBUG;
printf(
sprintf('debug: [%d] %s(): ', (caller(0))[2], (caller(1))[3]) .
((@_ > 1) ? shift(@_) : '%s') .
"\n",
@_
);
$DEBUG;
}
# }}} DEBUG_INFO
1;
__END__
# {{{ END Data
package SNMP::Session;
use Inline C => DATA =>
# Config => ENABLE => AUTOWRAP =>
LIBS => '-lnetsnmp' =>
AUTO_INCLUDE => [ '#include <net-snmp/net-snmp-config.h>',
'#include <net-snmp/net-snmp-includes.h>'
];
1;
__DATA__
__C__
int _fileno(SV *sess_ref) {
SV **sess_ptr_sv = hv_fetch((HV*)SvRV(sess_ref), "SessPtr", 7, 1);
netsnmp_session *ss = (netsnmp_session *)SvIV((SV*)SvRV(*sess_ptr_sv));
int fileno = 0;
netsnmp_transport *transport;
if ((transport = snmp_sess_transport(snmp_sess_pointer(ss))) != NULL)
fileno = transport->sock;
/* printf("#### fileno: %d\\n", fileno); */
return fileno;
}
# }}} END Data
# vi:foldmethod=marker: