*** /dev/null Sun Apr 28 11:22:13 2024
--- - Sun Apr 28 11:22:30 2024
***************
*** 0 ****
--- 1,929 ----
+ #!@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/>
+ ##
+ ## Permission to use, copy, modify, and distribute this software for
+ ## any purpose with or without fee is hereby granted, provided that
+ ## the above copyright notice and this permission notice appear in all
+ ## copies.
+ ##
+ ## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
+ ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
+ ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+ ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+ ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ ## SUCH DAMAGE.
+ ##
+
+ # requirements
+ require 5;
+ use strict;
+ use warnings;
+ use FindBin;
+ use Getopt::Long;
+ use IO;
+
+ # program information
+ my $prg = {
+ 'name' => 'OSSP snmpdx',
+ 'version' => '0.2.0',
+ 'date' => '01-Sep-2003'
+ };
+
+ ## _________________________________________________________________________
+ ##
+ ## 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 = undef;
+ 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: \"$cmd\" ($expires) [CACHE HIT]");
+ }
+ else {
+ $self->{-log}->printf(3, "system: run: \"$cmd\" ($expires) [CACHE MISS]");
+ $self->{-log}->printf(5, "system: executing command: \"$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;
+
+ # find path to ourself
+ my $myroot = "$FindBin::Bin";
+
+ # parameters (defaults)
+ my $opt = {
+ 'config' => "$myroot/snmpdx.cfg",
+ 'version' => 0,
+ 'help' => 0,
+ 'tmpdir' => ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp"),
+ 'get' => 0,
+ 'next' => 0,
+ 'set' => 0,
+ 'bindir' => "/cw/bin",
+ 'probedir' => "$myroot/snmpdx.d",
+ 'probename' => "*",
+ 'mibdir' => "$myroot/snmpdx.mib",
+ 'mibname' => "snmpdx",
+ 'logfile' => "$myroot/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);
+ 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;
+ RETRY:
+
+ # determine acted/handled OID
+ my $oid_action = undef;
+ my $oid_handled = undef;
+ my $oid_handler = undef;
+ my $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);
+
|
