ossp-pkg/snmpdx/snmpdx.pl
1.14
#!@PERL@ -w
##
## OSSP snmpdx - SNMP Daemon Extension
## Copyright (c) 2003 The OSSP Project <http://www.ossp.org/>
## Copyright (c) 2003 Ralf S. Engelschall <rse@engelschall.com>
## Copyright (c) 2003 Cable & Wireless <http://www.cw.com/>
##
## This file is part of OSSP snmpdx, a SNMP daemon extension which
## can be found at http://www.ossp.org/pkg/tool/snmpdx/.
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version
## 2.0 of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this file; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
## USA, or contact Ralf S. Engelschall <rse@engelschall.com>.
##
## snmpdx.pl: framework program
##
# requirements
require 5;
use strict;
use warnings;
use FindBin;
use Getopt::Long;
use IO::Handle;
use IO::File;
# program information
my $prg = {
'name' => 'OSSP snmpdx',
'version' => '@V@',
'date' => '@D@'
};
## _________________________________________________________________________
##
## HELPER CLASS: LOGFILE WRITING
## _________________________________________________________________________
##
package My::Log;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY write);
sub new ($$) {
my $proto = shift @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
my $level = shift @_ || die "missing level argument";
my $filename = shift @_ || die "missing filename argument";
$self->{-level} = $level;
$self->{-io} = new IO::File ">>$filename"
or die "cannot open logfile \"$filename\" for writing";
$self->{-io}->autoflush(1);
return $self;
}
sub destroy ($) {
my ($self) = @_;
$self->{-io}->close() if (defined($self->{-io}));
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub printf ($;@) {
my $self = shift @_;
my $level = shift @_ || die "missing level argument";
my $fmt = shift @_ || die "missing format argument";
if ($self->{-level} >= $level) {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
my $id = sprintf("[%04d-%02d-%02d/%02d:%02d:%02d@%05d] ",
$year+1900, $mon+1, $mday, $hour, $min, $sec, $$);
$self->{-io}->printf($id . $fmt . "\n", @_);
}
return;
}
## _________________________________________________________________________
##
## HELPER CLASS: VALUE CACHING
## _________________________________________________________________________
##
package My::Cache;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY store fetch);
sub new ($) {
my ($proto) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
$self->{-cache} = {};
return $self;
}
sub destroy ($) {
my ($self) = @_;
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub store ($$$$) {
my ($self, $id, $expires, $value) = @_;
die "invalid id" if (not defined($id) or $id eq '');
if ($expires =~ m|^(\d+)[sS]?$|) { $expires = $1; }
elsif ($expires =~ m|^(\d+)[mM]$|) { $expires = $1 * 60; }
elsif ($expires =~ m|^(\d+)[hH]$|) { $expires = $1 * 60 * 60; }
elsif ($expires =~ m|^(\d+)[dD]$|) { $expires = $1 * 60 * 60 * 24; }
elsif ($expires =~ m|^(\d+)[wW]$|) { $expires = $1 * 60 * 60 * 24 * 7; }
elsif ($expires =~ m|^forever$|i) { $expires = 99999 * 365 * 24 * 60 * 60; }
else { die "invalid expire time"; }
$expires = time() + $expires;
$self->{-cache}->{$id} = { -expires => $expires, -value => $value };
return;
}
sub fetch ($$) {
my ($self, $id) = @_;
my $value;
if (defined($self->{-cache}->{$id})) {
if ($self->{-cache}->{$id}->{-expires} > time()) {
$value = $self->{-cache}->{$id}->{-value};
}
else {
undef $self->{-cache}->{$id};
}
}
return $value;
}
## _________________________________________________________________________
##
## HELPER CLASS: RUNNING SYSTEM COMMANDS
## _________________________________________________________________________
##
package My::System;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY run);
sub new ($;$) {
my ($proto, $log, $cache) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
$self->{-log} = $log;
$self->{-cache} = (defined($cache) ? $cache : new My::Cache);
return $self;
}
sub destroy ($) {
my ($self) = @_;
$self->{-cache}->destroy() if (defined($self->{-cache}));
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub run ($$;$) {
my ($self, $cmd, $expires) = @_;
$expires = "1m" if (not defined($expires));
my $result = $self->{-cache}->fetch($cmd);
if (defined($result)) {
$self->{-log}->printf(4, "system: run: \"%s\" ($expires) [CACHE HIT]", $cmd);
}
else {
$self->{-log}->printf(3, "system: run: \"%s\" ($expires) [CACHE MISS]", $cmd);
$self->{-log}->printf(5, "system: executing command: \"%s\"", $cmd);
$result = { -stdout => '', -rv => 0 };
$result->{-stdout} = `$cmd 2>/dev/null`;
$result->{-rv} = ($? >> 8);
$self->{-log}->printf(6, "system: return value: ". $result->{-rv});
$self->{-cache}->store($cmd, $expires, $result);
}
return $result;
}
## _________________________________________________________________________
##
## HELPER CLASS: PLATFORM IDENTIFICATION
## _________________________________________________________________________
##
package My::Platform;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY id);
sub new ($) {
my ($proto) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
$self->{-machine} = `(uname -m) 2>/dev/null`;
$self->{-machine} = `(uname -p) 2>/dev/null` if ($self->{-machine} eq '');
$self->{-machine} =~ s|^\s*(.+?)\s*$|$1|s;
$self->{-system} = `(uname -s) 2>/dev/null`;
$self->{-system} =~ s|^\s*(.+?)\s*$|$1|s;
$self->{-release} = `(uname -r) 2>/dev/null`;
$self->{-release} = `(uname -v) 2>/dev/null` if ($self->{-release} eq '');
$self->{-release} =~ s|^\s*(.+?)\s*$|$1|s;
return $self;
}
sub destroy ($) {
my ($self) = @_;
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub arch ($) {
my ($self) = @_;
return $self->{-machine};
}
sub os ($) {
my ($self) = @_;
return sprintf("%s%s", $self->{-system}, $self->{-release});
}
sub id ($) {
my ($self) = @_;
return sprintf("%s-%s%s", $self->{-machine}, $self->{-system}, $self->{-release});
}
## _________________________________________________________________________
##
## HELPER CLASS: MIB OID/NAME MAPPING
## _________________________________________________________________________
##
package My::MIB;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY oid2name name2oid oid2type);
sub new ($$$) {
my ($proto, $bindir, $mibdir, $mib) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
$self->{-oid2name} = {};
$self->{-name2oid} = {};
my @entries = `$bindir/snmptranslate -M $mibdir -m $mib -Tl`;
foreach my $entry (@entries) {
$entry =~ s|\n$||s;
my $name = $entry;
my $oid = '';
$name =~ s|\((\d+)\)|$oid .= ".$1", ''|sge;
my $out = `$bindir/snmptranslate -M $mibdir -m $mib -Td $oid`;
if ($out =~ m|\s+MAX-ACCESS\s+not-accessible\s*|si) {
next;
}
my $type;
if ($out =~ m|TEXTUAL\s+CONVENTION\s+(.+?)\n\s+SYNTAX|si) {
$type = $1;
}
elsif ($out =~ m|SYNTAX\s+(.+?)\s*\n|si) {
$type = $1;
$type =~ s|\s+\([^\)]+\)$||s;
}
else {
next;
}
if ($name =~ m|[^.]+TABLE\.[^.]+ENTRY\.[^.]+$|) {
$name .= ".#";
$oid .= ".#";
}
$self->{-oid2type}->{$oid} = $type;
$self->{-oid2name}->{$oid} = $name;
$self->{-name2oid}->{$name} = $oid;
}
return $self;
}
sub destroy ($) {
my ($self) = @_;
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub oid2name ($$) {
my ($self, $oid) = @_;
return $self->{-oid2name}->{$oid};
}
sub name2oid ($$) {
my ($self, $name) = @_;
return $self->{-name2oid}->{$name};
}
sub oid2type ($$) {
my ($self, $oid) = @_;
return $self->{-oid2type}->{$oid};
}
sub oids ($;@) {
my ($self, @patterns) = @_;
my $oids = [];
foreach my $pattern (@patterns) {
$pattern = "*" if (not defined($pattern));
$pattern =~ s/\./\\./sg;
$pattern =~ s/\*/.*/sg;
foreach my $name (keys(%{$self->{-name2oid}})) {
if ($name =~ m|^${pattern}$|si) {
push(@{$oids}, $self->{-name2oid}->{$name});
}
}
}
return $oids;
}
## _________________________________________________________________________
##
## HELPER CLASS: PROBE (abstract only)
## _________________________________________________________________________
##
package My::Probe;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY oids probe);
sub new ($$) {
my ($proto, $ctx) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
$self->{-ctx} = $ctx;
return $self;
}
sub destroy ($) {
my ($self) = @_;
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
sub oids ($) {
my ($self) = @_;
return [];
}
sub probe ($$$) {
my ($self, $ctx, $oid) = @_;
return {};
}
## _________________________________________________________________________
##
## HELPER CLASS: Encoding
## _________________________________________________________________________
##
package My::Enc;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY dat_encode dat_decode octet_encode octet_decode);
sub new ($$) {
my ($proto) = @_;
my $class = ref $proto || $proto;
my $self = {};
bless ($self, $class);
return $self;
}
sub destroy ($) {
my ($self) = @_;
return;
}
sub DESTROY ($) {
my ($self) = @_;
$self->destroy;
return;
}
# ASN.1 DateAndTime encoding/decoding
sub dat_encode ($$) {
my ($self, $asc) = @_;
my ($y, $m, $d, $H, $M, $S) = (0, 0, 0, 0, 0, 0);
if ($asc =~ m|^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$|) {
($y, $m, $d, $H, $M, $S) = ($1, $2, $3, $4, $5, $6);
}
return pack("nCCCCCCCCC", $y, $m, $d, $H, $M, $S, 0, 0, 0, 0);
}
sub dat_decode ($$) {
my ($self, $bin) = @_;
my ($y, $m, $d, $H, $M, $S) = unpack("nCCCCCCCCC", $bin);
return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S);
}
# snmpd(8) pass_persist protocol 'octet' encoding/decoding
sub octet_encode ($$) {
my ($self, $bin) = @_;
my $asc = '';
$bin =~ s|(.)|$asc .= sprintf("%02x ", ord($1)), ''|sge;
return $asc;
}
sub octet_decode ($$) {
my ($self, $asc) = @_;
my $bin = '';
$asc =~ s|([0-9a-zA-Z]{2})\s*|$bin .= chr(hex($1)), ''|sge;
return $bin;
}
## _________________________________________________________________________
##
## MAIN PROCEDURE
## _________________________________________________________________________
##
package main;
# parameters (defaults)
my $opt = {
'config' => "@sysconfdir@/snmpdx/snmpdx.cfg",
'version' => 0,
'help' => 0,
'tmpdir' => ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp"),
'get' => 0,
'next' => 0,
'set' => 0,
'bindir' => "@bindir@",
'probedir' => "@libexecdir@/snmpdx",
'probename' => "*",
'mibdir' => "@datadir@/snmpdx:@snmpmibdir@",
'mibname' => "snmpdx",
'logfile' => "@localstatedir@/snmpdx.log",
'loglevel' => 9,
'strict' => 0,
};
# command line parsing
my %options = (
'c|config=s' => \$opt->{'config'},
'V|version' => \$opt->{'version'},
'h|help' => \$opt->{'help'},
't|tmpdir=s' => \$opt->{'tmpdir'},
'g|get' => \$opt->{'get'},
'n|next' => \$opt->{'next'},
's|set' => \$opt->{'set'},
'b|bindir=s' => \$opt->{'bindir'},
'P|probedir=s' => \$opt->{'probedir'},
'p|probename=s' => \$opt->{'probename'},
'M|mibdir=s' => \$opt->{'mibdir'},
'm|mibname=s' => \$opt->{'mibname'},
'l|logfile=s' => \$opt->{'logfile'},
'L|loglevel=i' => \$opt->{'loglevel'},
'S|strict' => \$opt->{'strict'},
);
Getopt::Long::Configure("bundling");
my $result = GetOptions(%options) || die "option parsing failed";
if ($opt->{'help'}) {
print "Usage: $prg->{'name'} [options] [SPECFILE ...]\n" .
"Available options:\n" .
" -c,--config=PATH read command line options from configuration fil\n" .
" -V,--version print program version\n" .
" -h,--help print out this usage page\n" .
" -t,--tmpdir=PATH filesystem path to temporary directory\n" .
" -g,--get get value of this MIB OID\n" .
" -n,--next get value of next MIB OID\n" .
" -s,--set set value of next MIB OID (NOT IMPLEMENTED)\n" .
" -b,--bindir=PATH path to the net-snmp binaries\n" .
" -P,--probedir=PATH path to probe directory\n" .
" -p,--probename=NAME the pattern for probes to load\n" .
" -M,--mibdir=PATH path to MIB directory\n" .
" -m,--mibname=MIB the name of the MIB to act under\n" .
" -l,--logfile=PATH path to daemon logfile\n" .
" -L,--loglevel=NUM logging level (0...9)\n" .
" -S,--strict strict processing of unknown values\n";
exit(0);
}
if ($opt->{'version'}) {
print "$prg->{'name'} $prg->{'version'} ($prg->{'date'})\n";
exit(0);
}
# support external configuration file
if (-f $opt->{'config'}) {
my $cfg = new IO::File "<$opt->{'config'}";
my $line;
while (defined($line = $cfg->getline())) {
$line =~ s|\r?\n$||s;
next if ($line =~ m/^\s*(#.*)?$/s);
my ($option, $value) = ($line =~ m|^\s*(\S+)\s+(.+?)\s*$|s);
if ($value =~ m|^".*"$| or $value =~ m|^'.*'$|) {
$value =~ s|^.||;
$value =~ s|.$||;
}
die "invalid configuration line \"$line\""
if (not defined($option) or not defined($value));
my ($var) = map { $options{$_} }
grep { $_ =~ m/^.\|\Q$option\E(=[si])?$/s }
keys(%options);
die "invalid configuration option \"$option\""
if (not defined($var));
${$var} = $value;
}
$cfg->close;
}
# create daemon run-time context
my $ctx = {};
$ctx->{-prg} = $prg;
$ctx->{-opt} = $opt;
$ctx->{-log} = new My::Log ($opt->{'loglevel'}, $opt->{'logfile'});
$ctx->{-cache} = new My::Cache;
$ctx->{-sys} = new My::System ($ctx->{-log}, $ctx->{-cache});
$ctx->{-platform} = new My::Platform;
$ctx->{-mib} = new My::MIB ($opt->{'bindir'}, $opt->{'mibdir'}, $opt->{'mibname'});
$ctx->{-enc} = new My::Enc;
# startup information
$ctx->{-log}->printf(1, "startup %s %s (%s) on %s",
$prg->{'name'}, $prg->{'version'}, $prg->{'date'},
$ctx->{-platform}->id());
# exception handling support
$SIG{__DIE__} = sub {
my ($err) = @_;
$err =~ s|\r?\n$||s;
$ctx->{-log}->printf(1, "ERROR: $err ". ($! ? "($!)" : ""));
undef $ctx;
exit(1);
};
$SIG{__WARN__} = sub {
my ($err) = @_;
$err =~ s|\r?\n$||s;
$ctx->{-log}->printf(1, "WARNING: $err");
return;
};
# PROTOCOL MIB MIB TYPE net-snmp API CONVERT TYPE
# ---------- ---------- ------------------- -------------- ------- ------
# string SNMPv2-TC DisplayString ASN_OCTET_STR - char *
# integer ASN.1 Integer32 ASN_INTEGER strtol long
# unsigned SNMPv2-SMI Unsigned32 ASN_UNSIGNED strtoul long
# counter SNMPv2-SMI Counter32 ASN_COUNTER strtoul long
# octet ASN.1 OCTET STRING ASN_OCTET_STR asc2bin char *
# opaque SNMPv2-SMI Opaque ASN_OPAQUE asc2bin char *
# gauge SNMPv2-SMI Gauge32 ASN_GAUGE strtoul long
# objectid ASN.1 OBJECT IDENTIFIER ASN_OBJECT_ID - char *
# timetick SNMPv2-SMI TimeTicks ASN_TIMETICKS strtoul long
# ipaddress SNMPv2-SMI IpAddress ASN_IPADDRESS htonl long
# octet SNMPv2-TC DateAndTime ASN_OCTET_STR asc2bin char *
# load probes and determine their handled OIDs
my $oidtable = [];
my $oidhandler = {};
my $oidprobe = {};
my $oidtype = {
'DisplayString' => [ 'string', 'N.A.' ],
'Integer32' => [ 'integer', '-1' ],
'Unsigned32' => [ 'unsigned', '0' ],
'Counter32' => [ 'counter', '-1' ],
'OCTET STRING' => [ 'octet', 'N.A.' ],
'Opaque' => [ 'opaque', 'N.A.' ],
'Gauge32' => [ 'gauge', '-1' ],
'OBJECT IDENTIFIER' => [ 'objectid', '.0' ],
'TimeTicks' => [ 'timetick', '0' ],
'IpAddress' => [ 'ipaddress', '0.0.0.0' ],
'DateAndTime' => [ 'octet', $ctx->{-enc}->dat_encode("1970-01-01 01:02:03") ],
};
$ctx->{-log}->printf(1, "MIB id: %s", $opt->{'mibname'});
foreach my $probefile (glob($opt->{'probedir'}."/".$opt->{'probename'}.".pm")) {
my $probe = $probefile;
$probe =~ s|^.*/([^/]+)\.pm$|$1|sg;
my $p;
eval {
local $SIG{__DIE__} = 'DEFAULT';
eval "require \"$probefile\";";
die if ($@);
eval "\$p = new My::Probe::$probe (\$ctx);";
die if ($@);
};
if ($@) {
die "invalid probe \"$probe\": $@";
}
$ctx->{-log}->printf(2, "Probe: \"%s\"", $probe);
foreach my $oid (sort(@{$p->oids()})) {
push(@{$oidtable}, $oid);
$oidhandler->{$oid} = $p;
$oidprobe->{$oid} = $probe;
$ctx->{-log}->printf(1, "MIB OID: %s [%s] ::= %s (%s)",
$oid, $ctx->{-mib}->oid2name($oid),
$ctx->{-mib}->oid2type($oid),
$oidtype->{$ctx->{-mib}->oid2type($oid)}->[0]);
}
}
@{$oidtable} = sort(@{$oidtable});
# determine run-time mode
my $mode = "pass_persist";
if ($opt->{'get'} or $opt->{'next'} or $opt->{'set'}) {
$mode = "pass";
}
# connect I/O channels
my $stdin = new IO::Handle;;
$stdin->fdopen(fileno(STDIN), "r");
$stdin->blocking(1);
my $stdout = new IO::Handle;;
$stdout->fdopen(fileno(STDOUT), "w");
$stdout->autoflush(1);
open(STDERR, ">/dev/null");
# processing loop
while (1) {
# determine command
my $cmd;
if ($mode eq "pass_persist") {
# read next command from snmpd
$cmd = $stdin->getline;
if (not defined($cmd)) {
$ctx->{-log}->printf(4, "IO: EOF");
last;
}
$cmd =~ s|\n?$||s;
$ctx->{-log}->printf(4, "IO: recv: << \"%s\\n\"", $cmd);
}
else {
$cmd = ($opt->{'get'} ? 'get' :
($opt->{'next'} ? 'getnext' :
($opt->{'set'} ? 'set' : 'unknown')));
$ctx->{-log}->printf(4, "CMD: \"%s\\n\"", $cmd);
}
# act upon command
if ($cmd =~ m/^PING$/i) {
#
# the PING/PONG protocol part
#
$ctx->{-log}->printf(4, "IO: send: >> \"PONG\\n\"");
$stdout->printf("PONG\n");
}
elsif ($cmd =~ m/^GET$/i or $cmd =~ m/^GETNEXT$/i) {
#
# the GET/GETNEXT protocol part
#
my $error = 1;
# read requested OID
my $oid_request;
if ($mode eq "pass") {
$oid_request = $ARGV[0];
}
else {
$oid_request = $stdin->getline;
if (not defined($oid_request)) {
$ctx->{-log}->printf(1, "ERROR: EOF instead of OID");
goto ERROR;
}
$oid_request =~ s|\n?$||s;
}
$ctx->{-log}->printf(4, "IO: recv: << \"%s\\n\"", $oid_request);
if ($oid_request !~ m/^(\.\d+)+$/) {
$ctx->{-log}->printf(1, "ERROR: invalid query OID \"%s\"", $oid_request);
goto ERROR;
}
# re-entry point for OID processing
my $oid_search = $oid_request;
my $oid_action;
my $oid_handled;
my $oid_handler;
my $oid_next;
RETRY:
# determine acted/handled OID
$oid_action = undef;
$oid_handled = undef;
$oid_handler = undef;
$oid_next = undef;
if ($cmd =~ m/^GET$/i) {
# search for explicitly handled OID
for (my $i = 0; defined($oidtable->[$i]); $i++) {
if ($oidtable->[$i] eq $oid_search) {
$oid_action = $oidtable->[$i];
$oid_handled = $oidtable->[$i];
last;
}
}
# search for implicitly handled OID (sequence element)
if (not defined($oid_handled)) {
my $oid_parent = $oid_search;
$oid_parent =~ s|(\.\d+)$||s;
for (my $i = 0; defined($oidtable->[$i]); $i++) {
if ($oidtable->[$i] =~ m|^\Q$oid_parent\E\.#$|) {
$oid_action = $oid_search;
$oid_handled = $oidtable->[$i];
last;
}
}
}
}
elsif ($cmd =~ m/^GETNEXT$/i) {
# search for explicitly handled OID
for (my $i = 0; defined($oidtable->[$i]); $i++) {
if ($oidtable->[$i] =~ m|^\Q$oid_search\E(\.\d+)+$|) {
# OID starts with requested OID prefix, so use this OID
$oid_action = $oidtable->[$i];
$oid_handled = $oidtable->[$i];
$oid_next = $oidtable->[$i+1];
last;
}
elsif ($oidtable->[$i] eq $oid_search) {
# OID is the requested OID exactly, so use next OID
if (defined($oidtable->[$i+1])) {
$oid_action = $oidtable->[$i+1];
$oid_action =~ s|\.#$|.1|s;
$oid_handled = $oidtable->[$i+1];
$oid_next = $oidtable->[$i+2];
last;
}
else {
goto ERROR; # end-of-MIB
}
}
}
# search for implicitly handled OID (sequence element)
if (not defined($oid_handled)) {
my $oid_parent = $oid_search;
$oid_parent =~ s|(\.\d+)$||s;
for (my $i = 0; defined($oidtable->[$i]); $i++) {
# search for implicitly handled OID (sequence element)
if ($oidtable->[$i] =~ m|^\Q$oid_search\E(\.\d+)*\.#$|) {
# OID start with requested OID prefix, so use first OID in sequence
$oid_action = $oidtable->[$i];
$oid_action =~ s|\.#$|.1|s;
$oid_handled = $oidtable->[$i];
$oid_next = $oidtable->[$i+1];
last;
}
elsif ($oidtable->[$i] =~ m|^\Q$oid_parent\E\.#$|) {
# OID is the requested OID of a sequence exactly, so use next OID in sequence
$oid_action = $oid_search;
$oid_action =~ s|\.(\d+)$|".".($1+1)|se;
$oid_handled = $oidtable->[$i];
$oid_next = $oidtable->[$i+1];
last;
}
}
}
}
if (defined($oid_handled)) {
$oid_handler = $oidhandler->{$oid_handled};
}
else {
$ctx->{-log}->printf(1, "ERROR: no handler found for OID \"%s\"", $oid_request);
goto ERROR; # end-of-MIB
}
# prepare probe request object
my $obj = {
-oid => $oid_action,
-name => $ctx->{-mib}->oid2name($oid_handled),
-type => $ctx->{-mib}->oid2type($oid_handled),
-value => undef
};
# provide mixed name/OID for sequence index
if ($obj->{-name} =~ m|\.#$|) {
my ($idx) = ($obj->{-oid} =~ m|\.(\d+)$|);
$obj->{-name} =~ s|\.#$|.$idx|;
}
# probe value of OID
$ctx->{-log}->printf(2, "probing \"%s\" for OID \"%s\"", $oidprobe->{$oid_handled}, $oid_action);
$oid_handler->probe($obj);
# handle special "unknown OID value" situation
if (not defined($obj->{-value})) {
$ctx->{-log}->printf(1, "WARNING: handler was unable to provide probe value for OID \"%s\"", $oid_request);
if ($opt->{'strict'}) {
# strict processing: return ERROR on unknown value
# for GET request and skip unknown OIDs on GETNEXT.
if ($cmd =~ m/^GET$/i) {
goto ERROR; # no-value
}
else { # GETNEXT
if (defined($oid_next)) {
$oid_search = $oid_next;
$oid_search =~ s|\.#$||s;
goto RETRY;
}
else {
goto ERROR; # no-value
}
}
}
else {
# non-strict processing: return a reasonable default value
if ($oid_handled =~ m|\.#$|) {
if ($oid_action =~ m|\.1$|) {
$obj->{-value} = $oidtype->{$obj->{-type}}->[1];
}
else {
if (defined($oid_next)) {
$oid_search = $oid_next;
$oid_search =~ s|\.#$||s;
goto RETRY;
}
else {
goto ERROR; # end-of-MIB
}
}
}
else {
$obj->{-value} = $oidtype->{$obj->{-type}}->[1];
}
}
}
# optionally encode value to conform to snmpd(8) protocol
if ($oidtype->{$obj->{-type}}->[0] =~ m/^(octet|opaque)$/) {
$obj->{-value} = $ctx->{-enc}->octet_encode($obj->{-value});
}
# return result
$ctx->{-log}->printf(1, "QUERY: %s [%s] ::= %s \"%s\"",
$obj->{-name}, $obj->{-oid}, $obj->{-type}, $obj->{-value});
$stdout->printf("%s\n%s\n%s\n",
$obj->{-oid}, $oidtype->{$obj->{-type}}->[0], $obj->{-value});
$ctx->{-log}->printf(4, "IO: send: >> \"%s\\n%s\\n%s\\n\"",
$obj->{-oid}, $oidtype->{$obj->{-type}}->[0], $obj->{-value});
# end-of-MIB or no-value handling
$error = 0;
if ($error) {
ERROR:
if ($mode eq "pass_persist") {
$ctx->{-log}->printf(4, "IO: send: >> \"NONE\\n\"");
$stdout->printf("NONE\n");
}
}
}
elsif ($cmd =~ m/^SET$/i) {
#
# the SET protocol part
#
if ($mode eq "pass_persist") {
# read requested OID/TYPE/VALUE (and ignore)
my $oid = $stdin->getline;
my $oid_type = $stdin->getline;
my $oid_value = $stdin->getline;
$ctx->{-log}->printf(4, "IO: send: >> \"NONE\\n\"");
$stdout->printf("NONE\n");
}
else {
$ctx->{-log}->printf(4, "IO: send: >> \"not-writable\\n\"");
$stdout->printf("not-writable\n");
}
}
else {
# for anything else (not expected) just send at least
# "NONE" in case snmpd(8) expects something.
$ctx->{-log}->printf(4, "IO: send: >> \"NONE\\n\"");
$stdout->printf("NONE\n");
}
# stop processing on "pass" mode
last if ($mode eq "pass");
}
# shutdown gracefully
$ctx->{-log}->printf(1, "shutdown");
undef $ctx;
exit(0);
