File Coverage

blib/lib/Mojo/SNMP.pm

Criterion	Covered	Total	%
statement	122	194	62.8
branch	47	94	50.0
condition	17	33	51.5
subroutine	21	34	61.7
pod	9	9	100.0
total	216	364	59.3

package Mojo::SNMP;
use Mojo::Base 'Mojo::EventEmitter';
use Mojo::IOLoop;
use Mojo::SNMP::Dispatcher;
use Net::SNMP    ();
use Scalar::Util ();
use constant DEBUG => $ENV{MOJO_SNMP_DEBUG} ? 1 : 0;
use constant MAXREPETITIONS => 10;

our $VERSION = '0.13';

my $DISPATCHER;
my @EXCLUDE_METHOD_ARGS = qw(maxrepetitions);
my %EXCLUDE             = (
  v1  => [qw(username authkey authpassword authprotocol privkey privpassword privprotocol)],
  v2c => [qw(username authkey authpassword authprotocol privkey privpassword privprotocol)],
  v3  => [qw(community)],
);

my %SNMP_METHOD;
__PACKAGE__->add_custom_request_method(bulk_walk => \&_snmp_method_bulk_walk);
__PACKAGE__->add_custom_request_method(walk      => \&_snmp_method_walk);

$Net::SNMP::DISPATCHER = $Net::SNMP::DISPATCHER;    # avoid warning

has concurrent     => 20;
has defaults       => sub { +{} };
has master_timeout => 0;
has ioloop         => sub { Mojo::IOLoop->singleton };

# these attributes are experimental and therefore not exposed. Let me know if
# you use them...
has _dispatcher => sub { $DISPATCHER ||= Mojo::SNMP::Dispatcher->new(ioloop => shift->ioloop) };

sub add_custom_request_method {
  my ($class, $name, $cb) = @_;
  $SNMP_METHOD{$name} = $cb;
  $class;
}

sub prepare {
  my $cb    = ref $_[-1] eq 'CODE' ? pop : undef;       # internal usage. might change
  my $self  = shift;
  my $hosts = ref $_[0] eq 'ARRAY' ? shift : [shift];
  my $args  = ref $_[0] eq 'HASH' ? shift : {};
  my %args  = %$args;

  $hosts = [keys %{$self->{sessions} || {}}] if $hosts->[0] and $hosts->[0] eq '*';

  defined $args{$_} or $args{$_} = $self->defaults->{$_} for keys %{$self->defaults};
  $args{version} = $self->_normalize_version($args{version} || '');
  delete $args{$_} for @{$EXCLUDE{$args{version}}}, @EXCLUDE_METHOD_ARGS;
  delete $args{stash};

HOST:
  for my $key (@$hosts) {
    my ($host) = $key =~ /^([^|]+)/;
    local $args{hostname} = $host;
    my $key = $key eq $host ? $self->_calculate_pool_key(\%args) : $key;
    $self->{sessions}{$key} ||= $self->_new_session(\%args) or next HOST;

    local @_ = @_;
    while (@_) {
      my $method = shift;
      my $oid = ref $_[0] eq 'ARRAY' ? shift : [shift];
      push @{$self->{queue}{$key}}, [$key, $method, $oid, $args, $cb];
    }
  }

  $self->{n_requests} ||= 0;

  for ($self->{n_requests} .. $self->concurrent - 1) {
    my $queue = $self->_dequeue or last;
    $self->_prepare_request($queue);
  }

  $self->_setup if !$self->{_setup}++ and $self->ioloop->is_running;
  $self;
}

sub wait {
  my $self   = shift;
  my $ioloop = $self->ioloop;
  my $stop;

  $stop = sub {
    $_[0]->unsubscribe(finish  => $stop);
    $_[0]->unsubscribe(timeout => $stop);
    $ioloop->stop;
    undef $stop;
  };

  $self->_setup unless $self->{_setup}++;
  $self->once(finish  => $stop);
  $self->once(timeout => $stop);
  $ioloop->start;
  $self;
}

for my $method (qw(get get_bulk get_next set walk bulk_walk)) {
  eval <<"HERE" or die $@;
    sub $method {
      my (\$self, \$host) = (shift, shift);
      my \$args = ref \$_[0] eq 'HASH' ? shift : {};
      \$self->prepare(\$host, \$args, $method => \@_);
    }
    1;
HERE
}

sub _calculate_pool_key {
  join '|', map { defined $_[1]->{$_} ? $_[1]->{$_} : '' } qw(hostname version community username);
}

sub _dequeue {
  my $self = shift;
  my $key = (keys %{$self->{queue} || {}})[0] or return;
  return delete $self->{queue}{$key};
}

sub _finish {
  warn "[Mojo::SNMP] Finish\n" if DEBUG;
  $_[0]->emit('finish');
  $_[0]->{_setup} = 0;
}

sub _new_session {
  my ($self, $args) = @_;
  my ($session, $error) = Net::SNMP->new(%$args, nonblocking => 1);

  warn "[Mojo::SNMP] New session $args->{hostname}: ", ($error || 'OK'), "\n" if DEBUG;
  Mojo::IOLoop->next_tick(sub { $self->emit(error => "$args->{hostname}: $error") }) if $error;
  $session;
}

sub _normalize_version {
  $_[1] =~ /1/ ? 'v1' : $_[1] =~ /3/ ? 'v3' : 'v2c';
}

sub _prepare_request {
  my ($self, $queue) = @_;
  my $item = shift @$queue;

  unless ($item) {
    $queue = $self->_dequeue or return;
    $item = shift @$queue;
  }

  my ($key, $method, $list, $args, $cb) = @$item;
  my $session = $self->{sessions}{$key};
  my ($error, $success);

  # Dispatch to our mojo based dispatcher
  $Net::SNMP::DISPATCHER = $self->_dispatcher;

  unless ($session->transport) {
    warn "[Mojo::SNMP] <<< open connection\n" if DEBUG;
    unless ($session->open) {
      Mojo::IOLoop->next_tick(
        sub {
          return $self->$cb($session->error, undef) if $cb;
          return $self->emit(error => $session->error, $session, $args);
        },
      );
      return $self->{n_requests} || '0e0';
    }
  }

  warn "[Mojo::SNMP] <<< $method $key @$list\n" if DEBUG;
  Scalar::Util::weaken($self);
  $method = $SNMP_METHOD{$method} || "$method\_request";
  $success = $session->$method(
    $method =~ /bulk/ ? (maxrepetitions => $args->{maxrepetitions} || MAXREPETITIONS) : (),
    ref $method ? (%$args) : (),
    varbindlist => $list,
    callback    => sub {
      my $session = shift;

      eval {
        local @$args{qw(method request)} = @$item[1, 2];
        $self->{n_requests}--;
        if ($session->var_bind_list) {
          warn "[Mojo::SNMP] >>> success: $method $key @$list\n" if DEBUG;
          $cb ? $self->$cb('', $session) : $self->emit(response => $session, $args);
        }
        else {
          warn "[Mojo::SNMP] >>> error: $method $key @{[$session->error]}\n" if DEBUG;
          $cb ? $self->$cb($session->error, $session) : $self->emit(error => $session->error, $session, $args);
        }
        1;
      } or do {
        $self->emit(error => $@);
      };

      warn "[Mojo::SNMP] n_requests: $self->{n_requests}\n" if DEBUG;
      $self->_prepare_request($queue);
      warn "[Mojo::SNMP] n_requests: $self->{n_requests}\n" if DEBUG;
      $self->_finish unless $self->{n_requests};
    },
  );

  return ++$self->{n_requests} if $success;
  $self->emit(error => $session->error, $session);
  return $self->{n_requests} || '0e0';
}

sub _setup {
  my $self = shift;
  my $timeout = $self->master_timeout or return;
  my $tid;

  warn "[Mojo::SNMP] Timeout: $timeout\n" if DEBUG;
  Scalar::Util::weaken($self);

  $tid = $self->ioloop->timer(
    $timeout => sub {
      warn "[Mojo::SNMP] Timeout\n" if DEBUG;
      $self->ioloop->remove($tid);
      $self->emit('timeout');
      $self->{_setup} = 0;
    }
  );
}

sub _snmp_method_bulk_walk {
  my ($session, %args) = @_;
  my $base_oid       = $args{varbindlist}[0];
  my $last           = $args{callback};
  my $maxrepetitions = $args{maxrepetitions} || MAXREPETITIONS;
  my ($callback, $end, %tree, %types);

  $end = sub {
    if (scalar keys %tree) {
      $session->pdu->var_bind_list(\%tree, \%types);
    }
    else {
      $session->pdu->var_bind_list({$base_oid => 'noSuchObject'}, {$base_oid => Net::SNMP::NOSUCHOBJECT});
    }
    $session->$last;
    $end = $callback = undef;
  };

  $callback = sub {
    my ($session) = @_;
    my $res     = $session->var_bind_list    or return $end->();
    my @sortres = $session->var_bind_names() or return $end->();
    my $types   = $session->var_bind_types;
    my $next    = $sortres[-1];

    for my $oid (@sortres) {
      return $end->() if $types{$oid} or !Net::SNMP::oid_base_match($base_oid, $oid);
      $types{$oid} = $types->{$oid};
      $tree{$oid}  = $res->{$oid};
    }

    return $end->() unless $next;
    return $session->get_bulk_request(maxrepetitions => $maxrepetitions, varbindlist => [$next], callback => $callback);
  };

  $session->get_bulk_request(maxrepetitions => $maxrepetitions, varbindlist => [$base_oid], callback => $callback);
}

sub _snmp_method_walk {
  my ($session, %args) = @_;
  my $base_oid = $args{varbindlist}[0];
  my $last     = $args{callback};
  my ($callback, $end, %tree, %types);

  $end = sub {
    $session->pdu->var_bind_list(\%tree, \%types) if %tree;
    $session->$last;
    $end = $callback = undef;
  };

  $callback = sub {
    my ($session) = @_;
    my $res = $session->var_bind_list or return $end->();
    my $types = $session->var_bind_types;
    my @next;

    for my $oid (keys %$res) {
      if (!$types{$oid} and Net::SNMP::oid_base_match($base_oid, $oid)) {
        $types{$oid} = $types->{$oid};
        $tree{$oid}  = $res->{$oid};
        push @next, $oid;
      }
    }

    return $end->() unless @next;
    return $session->get_next_request(varbindlist => \@next, callback => $callback);
  };

  $session->get_next_request(varbindlist => [$base_oid], callback => $callback);
}

1;

=encoding utf8

=head1 NAME

Mojo::SNMP - Run SNMP requests with Mojo::IOLoop

=head1 VERSION

0.13

=head1 SYNOPSIS

=head2 Using methods with callbacks

  use Mojo::SNMP;
  my $snmp = Mojo::SNMP->new;

  $snmp->defaults({timeout => 3, community => "public"});

  $snmp->get_next(["10.0.0.1", "10.0.0.2"], ["1.3.6.1.2.1.1.3.0"], sub {
    my ($self, $err, $session) = @_;
  });

  $snmp->wait unless $snmp->ioloop->is_running;

=head2 Using prepare

  use Mojo::SNMP;
  my $snmp = Mojo::SNMP->new;
  my @response;

  $snmp->on(response => sub {
    my ($snmp, $session, $args) = @_;
    warn "Got response from $args->{hostname} on $args->{method}(@{$args->{request}})...\n";
    push @response, $session->var_bind_list;
  });

  $snmp->defaults({
    community => "public", # v1, v2c
    username  => "foo", # v3
    version   => "v2c", # v1, v2c or v3
  });

  $snmp->prepare("127.0.0.1", get_next => ["1.3.6.1.2.1.1.3.0"]);
  $snmp->prepare("localhost", {version => "v3"}, get => ["1.3.6.1.2.1.1.3.0"]);

  # start the IOLoop unless it is already running
  $snmp->wait unless $snmp->ioloop->is_running;

=head1 DESCRIPTION

L is an async library for fetching or writing data from/to many
SNMP agents. The module does its best to not get in your way, but rather
provide a simple API which allow you to extract information from multiple
servers at the same time.

This module uses L and L to fetch data from hosts
asynchronously. It does this by using a custom dispatcher,
L, which attach the sockets created by L
directly into the ioloop reactor.

If you want greater speed, you should check out L and make sure
L and L is installed.

L is supposed to be a replacement for a module I wrote earlier,
called L. Reason for the rewrite is that I'm using the
framework L which includes an awesome IO loop which allow me to
do cool stuff inside my web server.

=head1 EVENTS

=head2 error

  $self->on(error => sub { my ($self, $str, $session, $args) = @_; ... });

Emitted on errors which may occur. C<$session> is a L object and is
only available if the error is a result of a L method, such as
L.

See L for C<$args> description.

=head2 finish

  $self->on(finish => sub { my $self = shift; ... });

Emitted when all requests have completed.

=head2 response

  $self->on(response => sub { my ($self, $session, $args) = @_; ... });

Called each time a host responds. The C<$session> is the current L
object. C<$args> is a hash ref with the arguments given to L, with
some additional information:

  {
    method => $str, # get, get_next, ...
    request => [$oid, ...],
    ...
  }

=head2 timeout

  $self->on(timeout => sub { my $self = shift; ... })

Emitted if L has been running for more than L seconds.

=head1 ATTRIBUTES

=head2 concurrent

  $self = $self->concurrent(20);
  $int = $self->concurrent;

How many hosts to fetch data from at once. Default is 20. (The default may
change in later versions)

=head2 defaults

  $self = $self->defaults({community => "public"});
  $hash_ref = $self->community;

This attribute holds a hash ref with default arguments which will be passed
on to L. User-submitted C<%args> will be merged with the
defaults before being submitted to L. C will filter out
and ignore arguments that don't work for the SNMP C.

NOTE: SNMP version will default to "v2c".

=head2 master_timeout

  $self = $self->master_timeout(15);
  $int = $self->master_timeout;

How long to run in total before timeout. Note: This is NOT per host but for
the complete run. Default is 0, which means that it will never time out.

If you want to set a timeout per request request to a host, then this need
to be set in L or in C<$args> passed on to L or one of
the other request methods.

=head2 ioloop

  $self = $self->ioloop(Mojo::IOLoop->new);
  $ioloop = $self->ioloop;

Holds an instance of L.

=head1 METHODS

=head2 add_custom_request_method

  Mojo::SNMP->add_custom_request_method(my_custom_method => sub {
    my ($session, %args) = @_;
    # do custom stuff..
  });

L has defined basic methods to write/retrieve data from/to the SNMP
agent. L allow you to add support for custom
methods, which can be useful if you find yourself doing the same complicated
logic over and over again. L and L are custom methods
bundled with this module.

NOTE: This method will define the methods in a global scope, meaning the code
below will call the custom callback instead of L
for all instances of L:

  $self->add_custom_request_method(get_next => sub { ... });

=head2 bulk_walk

  $self->bulk_walk($host, $args, \@oids, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

This is a custom SNMP method added by L. See
L for generic information about the variables associated with this
method.

This method will run L until it receives an OID
which does not match the base OID. C in C<$args> will default
to 10, but could be overrided to potentially increase performance. Example:

  $self->bulk_walk("192.168.0.1" => {maxrepetitions => 25}, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

=head2 get

  $self->get($host, \%args, \@oids, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

Will send a SNMP get-request to the remote agent. See L
for details on which C<%args> you can pass on. See L for generic
information about the variables associated with this method.

=head2 get_bulk

  $self->get_bulk($host, \%args, \@oids, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

Will send a SNMP get-bulk-request to the remote agent. See
L for details on which C<%args> you can pass on.
See L for generic information about the variables associated with
this method.

=head2 get_next

  $self->get_next($host, \%args, \@oids, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

Will send a SNMP get-next-request to the remote agent. See
L for details on which C<$args> you can pass on.
See L for generic information about the variables associated with
this method.

=head2 prepare

  $self = $self->prepare($host, \%args, ...);
  $self = $self->prepare(\@hosts, \%args, ...);
  $self = $self->prepare(\@hosts, ...);
  $self = $self->prepare("*" => ...);

=over 4

=item * $host

This can either be an array ref or a single host. The "host" can be whatever
L can handle; generally a hostname or IP address.

=item * \%args

A hash ref of options which will be passed directly to L.
This argument is optional. See also L.

=item * dot-dot-dot

A list of key-value pairs of SNMP operations and bindlists which will be given
to L. The operations are the same as the method names available in
L, but without "_request" at end:

  get
  get_next
  set
  get_bulk
  inform
  walk
  bulk_walk
  ...

The special hostname "*" will apply the given operation to all previously
defined hosts.

=back

Examples:

  $self->prepare("192.168.0.1" => {version => "v2c"}, get_next => [$oid, ...]);
  $self->prepare("192.168.0.1" => {version => "v3"}, get => [$oid, ...]);
  $self->prepare(localhost => set => [$oid => OCTET_STRING, $value, ...]);
  $self->prepare("*" => get => [$oid, ...]);

Note: To get the C constant and friends you need to do:

  use Net::SNMP ":asn1";

=head2 set

  use Net::SNMP ":asn1"; # Export OCTET_STRING

  $self->set($host, $args => [$oid, OCTET_STRING, $value, ...], sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

Will send a SNMP set-request to the remote agent. See L
for details on which C<$args> you can pass on. See L for generic
information about the variables associated with this method.

=head2 walk

  $self->walk($host, $args, \@oids, sub {
    my ($self, $err, $session) = @_;
    return warn $err if $err;
    push @{$res{$host}}, $session->var_bind_list;
  });

This is a custom SNMP method added by L. See
L for generic information about the variables associated with this
method.

This method will run L until an oid retrieved does
not match the base OID, or if the tree is exhausted. You might want to use
L instead for better performance.

=head2 wait

  $self->wait;

This is useful if you want to block your code: C starts the ioloop and
runs until L or L is reached.

  my $snmp = Mojo::SNMP->new;
  $snmp->prepare(...)->wait; # blocks while retrieving data
  # ... your program continues after the SNMP operations have finished.

=head1 AUTHOR

Jan Henning Thorsen - C

=head1 CONTRIBUTORS

Espen Tallaksen - C

Joshua Keroes - C

Oliver Gorwits - C

Per Carlson - C

=head1 COPYRIGHT & LICENSE

Copyright (C) 2012-2018, L and L.

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut