#!/cw/bin/perl ## ## OSSP snmpdx -- SNMP Daemon Extension ## Copyright (c) 2003 The OSSP Project ## Copyright (c) 2003 Ralf S. Engelschall ## Copyright (c) 2003 Cable & Wireless ## ## 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.1.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);