#!/usr/bin/perl -w ############################################################################# ## This machine-generated file was created Tue Jul 9 14:02:28 2002. ## It was built from the following files: ## rpatd.p (dated Tue Jul 9 11:50:30 2002) ## logprint.pm (dated Tue Jul 9 14:02:22 2002) ## SNMPWorker.pm (dated Tue Jul 9 11:50:30 2002) ## lookup_hostname.pm (dated Sun Jul 7 11:20:10 2002) ## pdudata.pm (dated Sun Jul 7 11:20:10 2002) ## pdutree.pm (dated Sun Jul 7 11:20:10 2002) ## snmpmib.pm (dated Sun Jul 7 11:20:10 2002) ## snmp.pm (dated Sun Jul 7 11:20:10 2002) ## ## Changes to this file will be lost when it is rebuilt ############################################################################# # # $Id: //pentools/main/rpat/rpatd.p#5 $ # # Realtime Proxy Abuse Triangulation Daemon # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This is the daemon for the Realtime Proxy Abuse Triangulation. See # the web site for the full details. http://www.unixwiz.net/rpat/ # # COMMAND LINE PARAMETERS # ----------------------- # # --help show a small help listing # # --verbose show some more debugging # # --timeout=N when sending a UDP respone to the other end, wait up to # "N" seconds for a response. If this timer expires, it # triggers a retry or (eventually) ultimate failure of the # target # # --tries=N Each UDP packet will be sent up to N times in the hopes # of getting a response: this allows for network loss. But # it shouldn't be so high as to just waste a lot of time. # # --pkmax=N Send no more than "N" packets per second - this is a rate # limiter. If N=0, then no limits are imposed. # # --workport=P Listen on UDP port "P" for work requests from the RPAT # client. # # --comm=C add "C" to the list of community strings we're to try. # This list always includes "public", but we can add a couple # more if desired. It's pointless to have no community # strings. NOT IMPLEMENTED # # --save save each snapshot into a RSP file (NOT IMPLEMENTED) # # --log=FILE Save the output to FILE (in addition to standard output) # use strict; use English; use IO::Socket; use IO::Select; use IO::File; { # start require logprint from rpatd.p line 54 # # $Id: //pentools/main/rpat/logprint.pm#2 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This code does the logging for the RPAT daemon. We're very weak on # the IO::File business use strict; use FileHandle; use FileHandle; my $logf; sub log_open { my $fname = shift; $logf->close if $logf; print "Opening $fname\n"; $logf = new IO::File $fname, O_WRONLY|O_APPEND|O_CREAT; if ( not $logf ) { die "ERROR: cannot create $fname\n"; } } sub log_close { if ($logf) { $logf->close; $logf = undef; } } sub log_print { my $str = join(" ", @_); $str =~ s/\s+$//; # dump trailing whitespace $logf = new FileHandle ">&STDOUT" if not $logf; $logf->print( $str . "\n" ); $logf->flush; } 1; } # end require logprint from rpatd.p line 54 { # start require SNMPWorker from rpatd.p line 55 # # $Id: //pentools/main/rpat/SNMPWorker.pm#6 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # The UDP engine (in the snmpcrank module) knows nothing about SNMP # transactions, so we have encapsulated all of this knowledge here. # When the user wants to work with a "target", it's encapculated into # this object that holds the remote IP address, the community string, # plus the algorithm for what we're doing. # # We really need to break this up into several pieces: the low-level # SNMP handler in general (timeouts, retries, "finished"), plus the # task-specific handlers. We will probably do this once we have # a better idea of how this is supposed to work. # # TCP CONNECTION TABLE STUFF # -------------------------- # # The main goal of this particular module is to fetch the remote TCP # connection table from the target machine. This is found in the MIB as # # tcpConnTable # tcpConnEntry # tcpConnState INTEGER (enumerated type) # tcpConnLocalAddress IPADDRESS # tcpConnLocalPort INTEGER # tcpConnRemoteAddress IPADDRESS # tcpConnRemotePort INTEGER # # Conceptually the data are organized in a table: # # LocalAddr LocalPort RemoteAddr RemotePort State # ------------------- --------------------- ------------ # 172.27.217.6:143 172.27.217.9:4168 ESTABLISHED # 172.27.217.6:25 208.186.238.12:1779 ESTABLISHED # 172.27.217.6:3148 172.27.217.254:23 ESTABLISHED # 172.27.217.6:22 172.27.217.9:4747 ESTABLISHED # 172.27.217.6:22 172.27.217.9:1912 ESTABLISHED # 172.27.217.6:22 172.27.217.9:1114 ESTABLISHED # 172.27.217.6:22 172.27.217.3:1680 ESTABLISHED # 172.27.217.6:143 172.27.217.4:1077 ESTABLISHED # 0.0.0.0:1666 0.0.0.0:* LISTEN # 0.0.0.0:22 0.0.0.0:* LISTEN # 0.0.0.0:587 0.0.0.0:* LISTEN # 0.0.0.0:25 0.0.0.0:* LISTEN # 127.0.0.1:953 0.0.0.0:* LISTEN # 172.27.217.6:53 0.0.0.0:* LISTEN # 127.0.0.1:53 0.0.0.0:* LISTEN # 0.0.0.0:515 0.0.0.0:* LISTEN # 0.0.0.0:143 0.0.0.0:* LISTEN # 0.0.0.0:110 0.0.0.0:* LISTEN # 0.0.0.0:513 0.0.0.0:* LISTEN # 0.0.0.0:514 0.0.0.0:* LISTEN # 0.0.0.0:37 0.0.0.0:* LISTEN # # To fetch a table's contents, we start with a "GETNEXTREQUEST" # on the OID tcpConnTable, and the return value is the first entry # of the "status" column. # # --> [ OID=tcpConnTable, NULL ] # # The "NULL" is a placeholder for the return value, and the response from # the other end includes a much longer OID that encodes most of the # interesting information. # # <-- [ OID=tcpConnTable.{LCLIP}.{LCLPORT}.{RMTIP}.{RMTPORT}, STATUS ] # # We use this (long) OID in a second GETNEXTREQUEST that returns the # next next status entry in the table (where "next" is strictly # lexicographiclly). Because the OID encodes everything except the # status (but the statis is the actual return value), we only have # to fetch the first column's worth of data. # package SNMPWorker; use strict; use Carp; use English; { # start require lookup_hostname from SNMPWorker.pm line 86 # # $Id: //pentools/main/rpat/lookup_hostname.pm#3 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This takes a "target", which could be a hostname or an IP address, # into a string version of an IP address. The gethostbyname() stuff # is not that hard to use, but we get tired of doing these steps # every time we need something. # # If the "target" looks like an IP address (all digits), then we # presume it's OK as an IP address and be done with it. Otherwise # we look it up in the DNS and return the IP address *as a string*. # # On error, we return undef and set $@ ($EVAL_ERROR) to the reason # for failure. use strict; use English; use Socket; sub lookup_hostname { my $target = shift; # ---------------------------------------------------------------- # See if it's a valid IP address: we grab four sets of numbers # and assume it's IP if so, but also do at least a little bit # of error checking to make sure the digits are at least in the # range 0..255. # if ( $target =~ m/^ (\d+) \. (\d+) \. (\d+) \. (\d+) $/x ) { if ($1 > 255 or $2 > 255 or $3 > 255 or $4 > 255 ) { $EVAL_ERROR = "Bogus IP address digits"; return (); } return $target; } my @answer = gethostbyname($target); if ( not @answer ) { $EVAL_ERROR = "cannot find IP addr for $target"; return (); } my @ips = map{ inet_ntoa($_) } @answer[ 4 .. $#answer ]; if ( not @ips ) { $EVAL_ERROR = "No IP address assocated iwth $target"; return (); } return shift @ips; } 1; } # end require lookup_hostname from SNMPWorker.pm line 86 { # start require pdudata from SNMPWorker.pm line 87 # # $Id: //pentools/main/rpat/pdudata.pm#2 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This section operates on PDU data: we encode and decode each type # with separate handler methods to make it easier to document. The # low-level splitting of the raw PDUs (with uninterpreted data) is # done in the pdutree module, but this one knows how to translate # into the "higher level" form. # # The "packing" and "unpacking" operations are *only* done on the # PDU payload data, not on the entire PDU as a whole. The idea is # that for any given PDU, we see # # [ PDUTYPE, PDUDATA ] # # we swap the PDUDATA part between the binary notation and the # "external" notation. Sometimes this is a no-op. # package SNMP; use strict; use Socket; my %PDUINFO; my @PDUERRORS; my $verbose; sub INTEGER () { 0x02; } sub OCTETSTRING () { 0x04; } sub NULL () { 0x05; } sub OID () { 0x06; } sub SEQUENCE () { 0x30; } sub IPADDRESS () { 0x40; } sub COUNTER () { 0x41; } sub GAUGE () { 0x42; } sub TIMETICKS () { 0x43; } sub OPAQUE () { 0x44; } sub GETREQUEST () { 0xA0; } sub GETNEXTREQUEST () { 0xA1; } sub GETRESPONSE () { 0xA2; } sub SETREQUEST () { 0xA3; } sub TRAP () { 0xA4; } BEGIN { @PDUERRORS = ( 'noError', # 0 'tooBig', # 1 'noSuchName', # 2 'badValue', # 3 'readOnly', # 4 'genErr' # 5 ); %PDUINFO = ( INTEGER , { Name => "INTEGER", Packer => \&pdu_pack_INTEGER, Unpacker => \&pdu_unpack_INTEGER, }, OCTETSTRING , { Name => "OCTETSTRING", # NOTHING TO PACK }, NULL , { Name => "NULL", # NOTHING TO PACK }, OID , { Name => "OID", Packer => \&pdu_pack_OID, Unpacker => \&pdu_unpack_OID, }, IPADDRESS , { Name => "IPADDRESS", Packer => \&pdu_pack_IPADDRESS, Unpacker => \&pdu_unpack_IPADDRESS, }, COUNTER , { Name => "COUNTER", Packer => \&pdu_pack_INTEGER, Unpacker => \&pdu_unpack_INTEGER, }, GAUGE , { Name => "GAUGE", Packer => \&pdu_pack_INTEGER, Unpacker => \&pdu_unpack_INTEGER, }, TIMETICKS , { Name => "TIMETICKS", Packer => \&pdu_pack_TIMETICKS, Unpacker => \&pdu_unpack_TIMETICKS, }, OPAQUE , { Name => "OPAQUE", }, SEQUENCE , { Name => "SEQUENCE", }, GETREQUEST , { Name => "GETREQUEST", }, GETNEXTREQUEST , { Name => "GETNEXTREQUEST", }, GETRESPONSE , { Name => "GETRESPONSE", }, SETREQUEST , { Name => "SETREQUEST", }, TRAP , { Name => "TRAP", }, ); } # # pdu_is_sequence # # # Any PDU type that has bit 6 set is a "constructed" type - it's # a sequence. # sub pdu_is_sequence { my $pdu = shift; return !!( $pdu & 0x20 ); } sub pduname { my $pdu = shift; if ( defined( my $x = $PDUINFO{$pdu} ) ) { return $x->{Name}; } else { return sprintf("-%02X-", $pdu); } } sub pdu_errorname { my $ecode = shift; if ( $ecode >= 0 and $ecode < @PDUERRORS ) { return $PDUERRORS[$ecode]; } return "-unknown-"; } # # make_binary # # Given a string containing a list of bytes, treate it as a # big-endian integer and return the "native" int # sub make_binary { my $n = 0; foreach my $byte ( split( m//, shift @_ ) ) { $n <<= 8; $n += ord($byte); } return $n; } # ------------------------------------------------------------------------ # OID - Object ID # # An OID (Object ID) is a sequence of "subidentifiers" -- integers # -- that are strung together to specify an entity in the MIB. These # are textually represented as: # # 1.3.6.1.2.1.1.1 # # (which is the system name). The packing into the PDU is done by # encoding each integer using the normal BER rules, and there is a # final zero byte to mark the end. # # The BER rules say that a value <128 is just encoded as a single # byte, but anything larger than that is encoded as a series of # *SEVEN BIT* integers, each byte of which has the high bit set. # A zero 8th bit means it's the last byte in the sequence. # # 127 -> 01111111 -> 0111_1111 # 128 -> 10000000 -> 1000_0001 0111_1111 # # It seems that we always have to present a trailing zero to the # other end when construcing the OID we're requesting, but we have # decided to leave this requirement to the caller. # sub pdu_pack_OID { my $pref = shift; my @OIDPARTS = split( m/\./, $pref->{Data} ); # ---------------------------------------------------------------- # The first two subidentifiers can be encoded into a single byte # if they are within a certain range (they always are). # if ( @OIDPARTS >= 2 and $OIDPARTS[0] < 6 and $OIDPARTS[1] < 40 ) { my $n1 = shift @OIDPARTS; my $n2 = shift @OIDPARTS; unshift @OIDPARTS, ($n1 * 40) + $n2; } $pref->{Data} = pack("w*", @OIDPARTS ); } # # pdu_unpack_OID # # Given a raw OID buffer (with implied length), unpack it into # the string format. This does NOT include the leading PDU part, # just the string of OID data. # sub pdu_unpack_OID { my $pref = shift; my @OIDPARTS = unpack("w*", $pref->{Data}); if ( defined $OIDPARTS[0] and $OIDPARTS[0] == 43 ) { shift @OIDPARTS; # dump first one unshift @OIDPARTS, 1, 3; } $pref->{Data} = join(".", @OIDPARTS); } # ------------------------------------------------------------------------ # TIMETICKS # # These are integers, but are measured in 100th of a second and should # always be packed into four bytes. The external representation is a # float. # sub pdu_unpack_TIMETICKS { my $pref = shift; $pref->{Data} = make_binary( $pref->{Data} ) / 100.; } sub pdu_pack_TIMETICKS { my $pref = shift; my $ticks = $pref->{Data}; $pref->{Data} = pack("N", int( $ticks * 100 ) ); } # ------------------------------------------------------------------------ # IPADDRESS # # These are integers, but our external representation is the normal # dotted-quad notation. # sub pdu_unpack_IPADDRESS { my $pref = shift; $pref->{Data} = inet_ntoa( $pref->{Data} ); } sub pdu_pack_IPADDRESS { my $pref = shift; $pref->{Data} = inet_aton( $pref->{Data} ); } # ------------------------------------------------------------------------ # INTEGER # # Integers are just packed big-endian data - very easy to get right. We # don't believe they use any particular special encoding: they're just # byte long, always big-endian. So we assemble or disassemble as # needed. # sub pdu_unpack_INTEGER { my $pref = shift; $pref->{Data} = make_binary( $pref->{Data} ); } sub pdu_pack_INTEGER { my $pref = shift; my $n = $pref->{Data}; if ( $n < 256 ) { $pref->{Data} = pack("C", $n); } elsif ( $n < 65536 ) { $pref->{Data} = pack("n", $n); } else { $pref->{Data} = pack("N", $n); } } # # pdudata_unpack_tree # # Given a ref to an array of PDUs (as in a tree at the top level # or the ref as a body of a SEQUENCE, run through the array and # recursively unpack all the elements. This only works on the # data portion, not the overall PDU. # sub pdudata_unpack_treedata { my $aref = shift; $aref = [ $aref ] if ref($aref) eq 'HASH'; foreach my $pref ( @{ $aref } ) { my $pdu = $pref->{PDU}; my $piref = $PDUINFO{$pdu}; if ( pdu_is_sequence( $pdu ) ) { pdudata_unpack_treedata( $pref->{Data} ); } elsif ( $piref and $piref->{Unpacker} ) { &{ $piref->{Unpacker} }( $pref ); } } } sub pdudata_pack_treedata { my $aref = shift; $aref = [ $aref ] if ref($aref) eq 'HASH'; foreach my $pref ( @{ $aref } ) { my $pdu = $pref->{PDU}; my $piref = $PDUINFO{$pdu}; if ( pdu_is_sequence( $pdu ) ) { pdudata_pack_treedata( $pref->{Data} ); } elsif ( $piref and $piref->{Packer} ) { &{ $piref->{Packer} }( $pref ); } } } 1; } # end require pdudata from SNMPWorker.pm line 87 { # start require pdutree from SNMPWorker.pm line 88 # # $Id: //pentools/main/rpat/pdutree.pm#3 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This module does low-level decoding of SNMP data packets. We # take a raw binary buffer received from UDP and split it into # individual PDUs (Protocol Data Units) with *very* little actual # interpretation of that data. # # Each PDU is represented by a small hash: # # { PDU => INTEGER, Data => 123 } # # For SEQUENCE-type PDUs, the "Data" is either a ref to an array # of PDUs, or it can be a ref to a PDU itself: this lets us save # one level of indirection at times. # # The pdutype is just an integer 0..255, and the data (initially) # the raw binary value found in the SNMP packet. The exception is # any sequence-like PDU (SEQUENCE, GETREQUEST, etc.), in which the # data portion is a reference to array of PDUs. # # This structure is flexible but has a LOT of references to arrays: # we think this is the best we can do under the circumstances. We # considered using hashes or even objects for the PDUs, but that may # for another day. # # my $rc = pdudata_maketree( $SNMPbuffer ); # # The return value is a hashref with a couple of parts: # # $rc->{Errors} - list of error messages # $rc->{PDUs} - ref to top of PDU tree # $rc->{Remainder} - what's left if we didn't consume everything # # If {Errors} is defined, it means we were not able to properly decode # the PDU data, and the format of the tree is probably undefined. We # are not sure if {Remainder} is ever really even interesting, but we # always add an error message if there is one (no need to check for # the remainder). # # A PDUtree can be displayed with pdutree_show: # # my $rc = pdudata_maketree( $SNMPbuffer ); # # pdutree_show( rc->{PDUs} ) if not rc->{Errors}; # # It doesn't show the data, just the structure. # package SNMP; use strict; # # split_raw_pdudata # # Given a raw binary buffer full of a string of SNMP PDUs, split it # into separate pieces and return them. The format of a PDU is # # type - a single byte that describes the contents of this type. # This routine never inspects the type: it's just a byte. # The real processing is done by other places. # # length - # of bytes in the PDU, but it's in a specially encoded # format. # # body - a possibly empty data portion that contains the value # described by the type. We don't ever look at what the # body bytes mean - we just collect them up. # # LENGTH ENCODING # --------------- # # This uses a special encoding that's really annoying. # # +---------+ # |0| n | # +---------+ # # +---------+ +--------+ # |1| 1 | | n | # +---------+ +--------+ # # +---------+ +--------+--------+ # |1| 2 | | n | # +---------+ +--------+--------+ # # +---------+ +--------+--------+--------+ # |1| 3 | | n | # +---------+ +--------+--------+--------+ # # +---------+ +--------+--------+--------+--------+ # |1| 4 | | n | # +---------+ +--------+--------+--------+--------+ # # Multibyte counts are always big-endianaa, and we don't think # that any of these lengths are allowed to be longer than 4 - # would make for a *monstrous* PDU. So "4" is probably more than # we ever really need. # # RECURSIVE? # ---------- # # No, it's not. This is a raw data processing function, and we simply # do not recurse. # # Return is: # # return { # PDU => [ list of PDU items ] # Errors => [ errors ] # Remainder => "part not consumed", # }; # sub split_raw_pdudata { my $buf = shift; my $ref = { PDUs => [ ], # list of PDUs Errors => undef, # list of error msgs Remainder => "" # the part not processed }; while ( length $buf >= 2 and $buf =~ s/^(.)// ) { my $pdutype = ord($1); my $pdulen = 0; if ( $buf =~ s/^([\x00-\x7f])// ) { $pdulen = ord( $1 ); } elsif ( $buf =~ s/^(\x80)// ) { $pdulen = 0; } elsif ( $buf =~ s/^\x81(.)// ) { $pdulen = ord($1); } elsif ( $buf =~ s/^\x82(.)(.)// ) { $pdulen = ( ord($1) << 8 ) + ( ord($2) << 0 ); } elsif ( $buf =~ s/^\x83(.)(.)(.)// ) { $pdulen = ( ord($1) << 16 ) + ( ord($2) << 8 ) + ( ord($3) << 0 ); } elsif ( $buf =~ s/^\x84(.)(.)(.)(.)// ) { $pdulen = ( ord($1) << 24 ) + ( ord($2) << 16 ) + ( ord($3) << 8 ) + ( ord($4) << 0 ); } else { my $byte = ord( substr($buf, 0, 10) ); push @{ $ref->{Errors} }, sprintf("can't parse size %02X for PDU %02X", $pdutype, $byte); last; } # extract as much of the body as we can if ( $pdulen <= length $buf ) { my $pdudata = substr($buf, 0, $pdulen); if ( $pdulen == 0 ) { $buf = ""; } else { $buf = substr($buf, $pdulen); } push @{ $ref->{PDUs} }, { PDU => $pdutype, Data => $pdudata }; } else { push @{ $ref->{Errors} }, sprintf("need %d bytes for PDU %02X, have %d", $pdulen, $pdutype, length $buf); last; } } $ref->{Remainder} = $buf; return $ref; } # # pdu_makelength # # This takes an integer and encodes it in "long definite form", which # is an efficient way of representing a count in as small a number of # bytes as possibe. # # +---------+ # |0| n | 0..127 # +---------+ # # +---------+ +--------+ # |1| 1 | | n | 0..255 # +---------+ +--------+ # # +---------+ +--------+--------+ # |1| 2 | | n | 0..65536 # +---------+ +--------+--------+ # # +---------+ +--------+--------+--------+ # |1| 3 | | n | 0..16777216 # +---------+ +--------+--------+--------+ # # +---------+ +--------+--------+--------+--------+ # |1| 4 | | n | 0..4294967296 # +---------+ +--------+--------+--------+--------+ # sub pdu_makelength { my $n = shift; return pack("C", $n) if $n < 128; return pack("CC", 0x81, $n) if $n < 256; return pack("Cn", 0x82, $n) if $n < 65536; # too lazy for 24 bit encoding return pack("CN", 0x84, $n); } # # pdudata_maketree() # # Given an SNMP buffer, split it apart into PDUs: it's done # recursively: each time we find a SEQUENCE-type PDU, we split # that data as well. # sub pdudata_maketree { my $str = shift; my $lvl = shift; $lvl = 0 if not defined $lvl; my $indent = " " x $lvl++; my $pref = split_raw_pdudata( $str ); foreach my $r ( @{ $pref->{PDUs} } ) { my $pdu = $r->{PDU}; my $pdudata = $r->{Data}; if ( pdu_is_sequence( $pdu ) ) { my $rc = pdudata_maketree( $pdudata, $lvl); $r->{Data} = $rc->{PDUs}; if ( $rc->{Errors} ) { push @{ $pref->{Errors} }, @{ $rc->{Errors} }; } } } # print $indent . "Leave recursive_splitPDUs\n"; return $pref; } # # pdutree_pack_tree # # Given a ref to an array of PDUs (as might be found as the # body of a SEQUENCE, or even as a top-level tree), pack it # to form a single binary string and return it. This string # represents the entire contents of the array, but does not # contain any surrounding PDU data - that's up to the caller. # sub pdutree_pack_tree { my $aref = shift; my $pdudata = ""; $aref = [ $aref ] if ref($aref) eq 'HASH'; foreach ( @{ $aref } ) { $pdudata .= pdutree_pack_one( $_ ); } return $pdudata; } # # pdutree_pack_one # # Given a ref to a single PDU, pack it to form a single binary # string that forms the binary data required to represent the # whole PDU. If it's a sequence type, we recursively visit all # the individual PDUs that compose it, then join them all # together. # # NOTE: we don't know anything about the format of the actual # PDU data types (other than sequences). Instead we simply use # the raw binary data associated with the PDU - the user gets # to deal with the transformation into and out of "non-binary" # form. # sub pdutree_pack_one { my $pref = shift; # ref to a PDU my $pdu = $pref->{PDU}; my $pdudata; if ( pdu_is_sequence( $pdu ) ) { $pdudata = pdutree_pack_tree( $pref->{Data} ); } else { $pdudata = $pref->{Data}; } $pdudata = "" if not defined $pdudata; return pack("C", $pdu) . pdu_makelength(length $pdudata). $pdudata; } # # pdutree_showtree # # Given a ref to an array of PDU items, display it in a hierarchical # format. This doesn't include the actual data (sorry) as it has not # yet been decoded. But it shows the tree structure. It's shown in a # hierarchical format. # sub pdutree_show { my $pref = shift; my $all = shift; my $level = shift; $level = 0 if not defined $level; my $indent = " " x $level++; foreach my $r ( @{ $pref } ) { my $pdu = $r->{PDU}; print $indent . pduname( $pdu ); if ( pdu_is_sequence( $r->{PDU} ) ) { print "\n"; pdutree_show( $r->{Data}, $all, $level ); } else { # printf " (L=%d)", length $r->{Data}; print "\t", $r->{Data} if $all; print "\n"; } } } # # hexify # # Given a bit of raw data, # sub hexify { my $s = shift; $s =~ s/(.)/sprintf(" %02X", ord($1))/gxe; return $s; } 1; } # end require pdutree from SNMPWorker.pm line 88 { # start require snmpmib from SNMPWorker.pm line 89 # # $Id: //pentools/main/rpat/snmpmib.pm#3 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This silly module is used to define the few items in the SNMP # MIB that we actually care about. We are not even close to doing # any kind of "real" MIB support -- this is a hacker tool -- but # we don't want to dot ourselves crazy. # # So we just define the things in here that we find useful and # allow only those names. We'll add over time... # package SNMP; use strict; use English; my $MIB2; my %MIB; BEGIN { $MIB2 = "1.3.6.1.2.1."; %MIB = ( sysDescr => $MIB2 . "1.1", sysObjectID => $MIB2 . "1.2", sysUptime => $MIB2 . "1.3", sysContact => $MIB2 . "1.4", sysName => $MIB2 . "1.5", sysLocation => $MIB2 . "1.6", sysServices => $MIB2 . "1.7", tcpConnTable => $MIB2 . "6.13", tcpConnEntry => $MIB2 . "6.13.1", tcpConnState => $MIB2 . "6.13.1.1", tcpConnLocalAddress => $MIB2 . "6.13.1.2", tcpConnLocalPort => $MIB2 . "6.13.1.3", tcpConnRemAddress => $MIB2 . "6.13.1.4", tcpConnRemPort => $MIB2 . "6.13.1.5", ); } # # translate_OID # # Given the simple name of an object ID in our quasi-MIB, return # the string containing the dotted decimal notation for it. This # *INCLUDES* the dot-zero that seems to be required at the end of # all OIDs (though we're not quite sure why). # # Return is UNDEF if the name is not known. # sub translate_OID { my $name = shift; return $MIB{ $name } . ".0" if defined $MIB{ $name }; $EVAL_ERROR = "Cannot find {$name} in MIB"; return (); } # # translate_OIDs # # ... ditto for the *list* # sub translate_OIDs { return map { translate_OID($_) } @_; } 1; } # end require snmpmib from SNMPWorker.pm line 89 { # start require snmp from SNMPWorker.pm line 90 # # $Id: //pentools/main/rpat/snmp.pm#4 $ # # written by : Stephen J. Friedl # Software Consultant # Tustin, California USA # steve@unixwiz.net / www.unixwiz.net # # === This code is in the public domain === # # This module is used for higher-level support for SNMP datagrams: # We take the user-level parameters (community string, OID, request # type, etc.) and returns an SNMP tree that is suitable for building # into an SNMP datagram. # package SNMP; use strict; use English; # # snmp_create_request() # # Given a hash with the OID values to query, create the SNMP tree # that tree that represents the whole thing. The return is a ref # to the tree that must be packed into the SNMP datagram. # sub snmp_create_request { my %Args = @_; my $pdu = $Args{PDU} || GETREQUEST; my $community = $Args{Community} || 'public'; my $sequence = $Args{Sequence} || 1000; my $listref = $Args{OIDList}; if ( not defined $listref ) { $EVAL_ERROR = "OIDList required"; return (); } # ---------------------------------------------------------------- # the main "payload" of the SNMP datagram is the varbind list of # OID/NULL pairs. For each OID that the user provides, we build # the full list of all of them that will later go inside a # the sequence of same. # my @OIDLIST = (); foreach my $oid ( @{ $listref } ) { push @OIDLIST, { PDU => SEQUENCE, Data => [ { PDU => OID, Data => $oid }, # OID to query { PDU => NULL, Data => undef } # NULL filler ] }; } return { PDU => SEQUENCE, Data => [ { PDU => INTEGER, Data => 0 }, # version, { PDU => OCTETSTRING, Data => $community }, # community { PDU => $pdu, Data => [ { PDU => INTEGER, Data => $sequence }, # sequence { PDU => INTEGER, Data => 0 }, # err code { PDU => INTEGER, Data => 0 }, # err index { PDU => SEQUENCE, Data => [ @OIDLIST ] } # body of PDU ] } ] }; } # # snmp_unpack_response # # This is tricky: we take a tree that came from the user and unpack # it to an "SNMP Response". The tree that came from the other end is # structurally OK - it's a "tree" - but we have no idea if it's built # correctly for SNMP. We have to do it slowly. # # There are two parts to this. The "real" work is done by the # "internal_" version, and it tries everything it can to make sure # the tree is semantically correct. If it's not, then it returns # an error string with the reason for failure. # # The "public" version simply assigns the error return (if any) to # the $EVAL_ERROR variable and returns failure. Otherwise we return # a ref to the response. # # sub snmp_unpack_response { my $rc = internal_snmp_unpack_response(@_); return $rc if ref($rc); $EVAL_ERROR = $rc; return (); } sub internal_snmp_unpack_response { my $tref = shift; # ref to picked-apart tree my $rsp = { Version => undef, Community => undef, PDU => undef, SequenceID => undef, ErrorCode => undef, ErrorIndex => undef, OIDList => [ ] }; # ---------------------------------------------------------------- # FIRST DECODE # # $tref is the handle of an array of PDUs, and that array should have # only one item in it. It's an arror return "tree param is not a ref to array" if ref($tref) ne 'ARRAY'; return "tree param has no items" if @{ $tref } == 0; return "tree param has >1 item" if @{ $tref } > 1; # ---------------------------------------------------------------- # so tref really *IS* just an array of one PDU. Throw away the outer # array and reference the first PDU directly. This PDU has to be a # SEQUENCE and the data param must be a reference as well. # $tref = $tref->[0]; # working our way down return "first PDU is not a SEQUENCE" if $tref->{PDU} != SEQUENCE; return "first PDU has no tree ref" if ref($tref->{Data}) ne 'ARRAY'; # ---------------------------------------------------------------- # Since tref now points to a SEQUENCE, throw it away and just use # the array of PDUs that are found in the data portion. # # This array of PDUs should have three members: # # [0] Version # [1] community # [2] sequence response (GETRESPONSE, etc.) # $tref = $tref->{Data}; return "first SEQUENCE doesn't have 3 members" if @{ $tref } != 3; return "Version PDU not INTEGER" if $tref->[0]->{PDU} != INTEGER; return "Community PDU not OCTETSTRING" if $tref->[1]->{PDU} != OCTETSTRING; return "Main PDU not SEQUENCE" if ! pdu_is_sequence($tref->[2]->{PDU}); $rsp->{Version} = $tref->[0]->{Data}; $rsp->{Community} = $tref->[1]->{Data}; $rsp->{PDU} = $tref->[2]->{PDU}; # get the PDU type,not value # ---------------------------------------------------------------- # So we have the Version & Community, and the third element is a # GETRESPONSE or the like. Work our way down into this sequence, # which has to have four elements: # # [0] SequenceID # [1] ErrorCode # [2] Error Index # [3] SEQUENCE of varbindlist $tref = $tref->[2]->{Data}; return "Secondary SEQUENCE doesn't have 4 items" if @{$tref} != 4; return "SequenceID is not an INTEGER" if $tref->[0]->{PDU} != INTEGER; return "ErrorCode is not an INTEGER" if $tref->[1]->{PDU} != INTEGER; return "ErrorIndex is not an INTEGER" if $tref->[2]->{PDU} != INTEGER; return "VarBind is not a SEQUENCE" if $tref->[3]->{PDU} != SEQUENCE; $rsp->{SequenceID} = $tref->[0]->{Data}; $rsp->{ErrorCode} = $tref->[1]->{Data}; $rsp->{ErrorIndex} = $tref->[2]->{Data}; $tref = $tref->[3]->{Data}; # list of variables # ---------------------------------------------------------------- # Now we should have an array of PDUs, each of which is a SEQUENCE # that contains an OID and a valid. Process each in turn. # foreach my $pref ( @{ $tref } ) { return "VARBIND is not SEQUENCE" if $pref->{PDU} != SEQUENCE; return "VARBIND has non-two count" if @{ $pref->{Data} } != 2; $pref = $pref->{Data}; # now refs the real PDU push @{ $rsp->{OIDList} }, [ $pref->[0]->{Data}, $pref->[1]->{Data} ]; } return $rsp; } # # printresponse # # Given a reference to a response from the other end, print it in # a hierarchical format. This is mainly for debugging only. # sub printresponse { my $rsp = shift; printf "RESPONSE\n"; printf " Version = %d\n", $rsp->{Version}; printf " Community = {%s}\n", $rsp->{Community}; printf " PDU = %s\n", pduname( $rsp->{PDU} ); printf " Sequence = %d\n", $rsp->{SequenceID}; printf " ErrorCode = %d (%s)\n", $rsp->{ErrorCode}, pdu_errorname( $rsp->{ErrorCode} ); printf " ErrorIdx = %d\n", $rsp->{ErrorIndex}; foreach my $pref ( @{ $rsp->{OIDList} } ) { printf " %s -> %s\n", $pref->[0], $pref->[1]; } } 1; } # end require snmp from SNMPWorker.pm line 90 my $Sequence = 1000; $SNMPWorker::fullinfo = 0; # ------------------------------------------------------------------------ # The "status" is the numeric value fetched from tcpConnStatus, and we # translate this info the printable string to make it easier to read. # my %TCPStates = ( 1 => 'closed', 2 => 'listen', 3 => 'synSent', 4 => 'synReceived', 5 => 'established', 6 => 'finWait1', 7 => 'finWait2', 8 => 'closeWait', 9 => 'lastAck', 10 => 'closing', 11 => 'timeWait', 12 => 'deleteTCB' ); sub tcpStateName { my $state = shift; my $rc = $TCPStates{ $state }; return "unknown" if not defined $rc; return $rc; } # # SNMPWorker::new # # Create a new SNMPWorker object that does all the processing of our I/O. # We MUST be given a "target" - IP address or hostname - and there are a # handful of other parameters that guide the behavior of our I/O. # sub new { my $class = shift; # standard first arg is package name # ---------------------------------------------------------------- # We *must* have some parameters, and we can't have an odd number. # if ( @_ == 0 or (@_ % 2) != 0 ) { carp("Odd or missing params"); return (); } my %Args = @_; my $hostname = $Args{Hostname}; # hostname or IP addr if ( not $hostname ) { carp "Missing Remote parameter"; return (); } # ---------------------------------------------------------------- # If the "remote" looks like a hostname, we have to look it up. # If it looks like an IP address, leave it alone. # return () if not( my $ipaddr = lookup_hostname($hostname) ); my $item = bless { Debug => $Args{Debug}, IPAddress => $ipaddr, Hostname => $hostname, Port => 161, # snmp Community => $Args{Community}, LastOID => undef, SentTime => undef, # when we sent the last one ExpireTime => undef, # when we're done Tries => 0, # updated on physical I/O write MaxTries => $Args{MaxTries}, Timeout => $Args{Timeout}, Error => 0, Replies => 0, # SNMP datagrams rcvd Result => "", # what happened? }, $class; $item->{Debug} = 0 if not defined $item->{Debug}; $item->{MaxTries} = 3 if not defined $item->{MaxTries}; $item->{Timeout} = 4.0 if not defined $item->{Timeout}; $item->{Community} = 'public' if not defined $item->{Community}; $item->reset; return $item; } # # SNMPWorker::reset # # Reset this object to a "like new" state so something can go from # the done list to the work list. # sub reset { my $item = shift; $item->{Error} = 0; $item->{Replies} = 0; $item->{LastOID} = undef; $item->{SentTime} = undef; $item->{ExpireTime} = undef; $item->{Tries} = undef; $item->{Result} = undef; } # # SNMPWorker::Debug # # Query or set the debugging flag, which is just an integer. The # new debug value is always returned. # sub Debug($;$) { my $item = shift; $item->{Debug} = shift if @_; return $item->{Debug}; } # # SNMPWorker::RecordSend() # # Note the fact and the time that we just sent this data to the # other end. We do increment the attempt count, but we take no # action on it until we've gotten a dispostion: either a timeout # or a response. sub RecordSend ($) { my $item = shift; $item->{Tries}++; $item->{SentTime} = time; $item->{ExpireTime} = time + $item->Timeout; } sub Result { my $item = shift; $item->{Result} = shift if @_; return $item->{Result}; } # # SNMPWorker::Timeout # # Set or get the how-long-to-wait-for-network-I/O timeout value for # this worker. The timeout is measured in seconds, and is allowed # to be fractional (though at the moment we don't think we use the # fractional part). # # This can set or fetch the timeout. # sub Timeout ($;$) { my $item = shift; $item->{Timeout} = shift if @_; return $item->{Timeout}; } sub Hostname ($) { my $item = shift; return $item->{Hostname}; } sub IPAddress($) { my $item = shift; return $item->{IPAddress}; } sub ExpireTime { my $item = shift; return $item->{ExpireTime}; } sub Community { my $item = shift; return $item->{Community}; } # # SNMPWorker::Port # # Each item includes the remote port we're trying to talk to, as this # takes "SNMP" out of the knowledge of what the UDP engine has to know # about. # sub Port { my $item = shift; $item->{Port} = shift if @_; return $item->{Port}; } # # SNMPWorker::TimedOut # # This is a callback by the UDP engine when we have a timeout on the # given channel. We use this information to either schedule a retry # or to just give up. # # Return is the item itself if we're to be put back on the worker # list, or undef if we're ready to give up. # sub TimeoutCallback($) { my $item = shift; if ( $item->{Tries} >= $item->{MaxTries} ) { # too many - bummer log_print(sprintf("remote %s expired - too many tries", $item->Hostname)); $item->{Error} = 1; return (); } return $item; } # # SNMPWorker::processTCPConn() # # When we get an OID from the other end in response to our # GetNextRequest, we see if it's in the same "family" as the # one that got this started: the "tcpConnState" group. If so, # the rest of the OID describes the connection information # # tcpConnEntry.tcpConnState.{lclIP}.{lclPort}.{remoteIP}.{remotePort} # sub processTCPConn($$$) { my $item = shift; my $oid = shift; my $state = shift; # always save the last OID for the "next loop" $item->{LastOID} = $oid; # ---------------------------------------------------------------- # The leading part of the OID should be constant - only the TCP # addresses and the like should change. If it *does*, we've moved # past the end of the "states" are are finished with this scan. # # We also rip off that initial bit of state information so we are # left # if ( $oid =~ m/^1\.3\.6\.1\.2\.1\.6\.13\.1\.1 # tcpConnState-ugh \. ( \d+ \. \d+ \. \d+ \. \d+ ) # local address \. ( \d+ ) # local port \. ( \d+ \. \d+ \. \d+ \. \d+ ) # remote address \. ( \d+ )/x ) # remote port { my $locaddr = $1; my $locport = $2; my $remaddr = $3; my $remport = $4; # convert state $state = tcpStateName( $state ); # -------------------------------------------------------- # There are some kinds of connection info we simply don't # need, so we don't report them. # # LISTENERS: these can't be part of a current connection, # so we don't bother mentioning them. # # BOGUS IPS: if the local address is anything other than # the external IP, it can't be intersting. Skip it. # # INBOUND WEB/SMTP/FTP: couldn't be interesting. # if ( not $SNMPWorker::fullinfo ) { return 1 if $state eq 'listening'; return 1 if $locaddr ne $item->IPAddress; return 1 if $locport == '80'; return 1 if $locport == '25'; return 1 if $locport == '21'; } my $rtime = get_rptime(); log_print(sprintf("SNMP %s\t%s:%s\t%s:%s\t%s", $rtime, $locaddr, $locport, $remaddr, $remport, $state)); return 1; } else { # print "{$oid} no match\n"; } return 0; } # # SNMPWorker::ResponseCallback # # When we get UDP data from the other end, we pass it to the worker # to deal with - the UDP engine doesn't know anything about the # bytes that arrived. # # Also: since this is UDP, it's clearly just "one message", so we # can dispense with it in short order. # sub ResponseCallback($$) { my $item = shift; # ref to ourself my $response = shift; # UDP buffer received log_print("Got response from ", $item->Hostname) if $item->Debug; # ---------------------------------------------------------------- # Unpack the SNMP and see what we're to do with it. # my $ref = SNMP::pdudata_maketree($response); if ( not $ref ) { $item->Result("Cannot unpack SNMP data"); return $item; } SNMP::pdudata_unpack_treedata( $ref->{PDUs} ); SNMP::pdutree_show( $ref->{PDUs}, 1 ) if $item->Debug; my $rsp = SNMP::snmp_unpack_response( $ref->{PDUs} ); if ( $rsp ) { $item->{Replies}++; SNMP::printresponse($rsp) if $item->Debug; my $err = $rsp->{ErrorCode}; if ( $err == 0 ) { $item->{Tries} = 0; my $oid = $rsp->{OIDList}->[0]->[0]; my $data = $rsp->{OIDList}->[0]->[1]; if ( $item->processTCPConn($oid, $data) ) { return $item; } else { $item->{Result} = sprintf("End of scan (%d replies)", $item->{Replies}); return (); } } else { $item->Result("Response: ERROR " . SNMP::pdu_errorname( $err ) ); } } else { $item->Result("ERROR: $@"); } $item->{Error} = 1; return (); } # # getWorkBuffer() # # This is called by the UDP engine when it wants a new datagram to send # to the other end, and it doesn't care what's *in* the buffer: to the # caller it's just a chunk of bytes. But we obviously care - duh - and # build up our SNMP data gram based on the previous OID that we saw. # # The first trip we always ask for "tcpConnState", and the response # from the other end has its OID stored in the object to be used on # the next trip. # # NOTE: we should be allowed to return "undef" if we have actually # changed our minds and don't to send anything after all. # sub getWorkBuffer($) { my $item = shift; # ---------------------------------------------------------------- # If we've not been here before, we have to manufacuture the *first* # # if ( not defined $item->{LastOID} ) { $item->{LastOID} = SNMP::translate_OID('tcpConnState'); } my $tref = SNMP::snmp_create_request( PDU => SNMP::GETNEXTREQUEST, Community => $item->Community, Sequence => $Sequence++, OIDList => [ $item->{LastOID} ] ); SNMP::pdudata_pack_treedata( $tref ); my $pkt = SNMP::pdutree_pack_tree( $tref ) or die "ERROR: cannot pack"; return $pkt; } sub get_rptime { my @PARTS = localtime; return sprintf("%04d%02d%02d%02d%02d%02d", $PARTS[5]+1900, # YEAR $PARTS[4] + 1, # MONTH $PARTS[3], # MDAY $PARTS[2], # HOUR $PARTS[1], # MINS $PARTS[0]); # SECONDS } 1; } # end require SNMPWorker from rpatd.p line 55 package main; my @COMMUNITIES = ( 'public' ); my $verbose = 0; my $TIMEOUT = 3; my $MAXTRIES = 3; my $pkmax = 0; # rate limiter my $dosave = 0; my $workport = undef; # UDP port to listen for work on my %Stoplist = (); my $logfile = undef; my @TARGETS = (); # if provided on the command line foreach ( @ARGV ) { if ( m/^--help/i ) { print STDERR <new(Proto => 'udp') or die "ERROR: cannot create socket ($EVAL_ERROR)\n"; if ( $verbose ) { my $mysockaddr = $UDPSOCK->sockname(); my ($port, $myaddr) = unpack_sockaddr_in($mysockaddr); log_print("Bound to port $port/udp"); } # ------------------------------------------------------------------------ # If we've asked for a worker socket, do so here. # my $WORKSOCK = undef; if ( $workport ) { $WORKSOCK = IO::Socket::INET->new(Proto => 'udp', LocalPort => $workport); die "ERROR: cannot bind to $workport/udp [$!]\n" if not $WORKSOCK; log_print("Listening on $workport/udp"); } # ------------------------------------------------------------------------ # Create the list of targets - it could be a big list # my %Targets = (); # list of target objects my %Waiting = (); # list of jobs waiting for response my %Donelist = (); # list of jobs that are finished foreach my $remote ( @TARGETS ) { add_target( $remote ); } # ------------------------------------------------------------------------ # UDP ENGINE # # As long as we have targets not sent yet, or if we have any jobs that are # still waiting for a response, # my $MAXLEN = 9999; my $seqno = 0x10000; my @WORKLIST = values %Targets; my $counter = 0; my $last_time = 0; my $pkcount = 0; # packet count for sending my $bycount = 0; # byte count for sending while ( $WORKSOCK or @WORKLIST or %Waiting ) { # ---------------------------------------------------------------- # CHECK JOB-WAITING EXPIRY # # Run through the list of packets waiting for an answer and see if # any of them have expired. If the expire time has been reached, # they are "advanced" to the next state, which is either putting # them back on the list for retry, or selecting a new community # string, or simply saying "we're done now". # # If anything changes, we again check the lists to see if there is # still work to do. If not, we're done # my $now = time; last if %Waiting and check_timeouts($now) and not $WORKSOCK and not @WORKLIST and not %Waiting; # ---------------------------------------------------------------- # RESET RATE LIMITERS # # If we have a maximum number of packets sent per second, see if # we're in a new second now: if so, reset the counters to allow # sending again for a while. # if ( $now > $last_time ) { $last_time = $now; $pkcount = 0; $bycount = 0; } # ---------------------------------------------------------------- # COMPUTE SELECT LIST # # We are looking to read, write, or both: this figures out which # is which. The "read" part is easy, but writing is a bit more work. # # READING: we're basically always ready to read. Even though the # first time through the loop (where we've not sent anything yet), # there won't ever be anything waiting, there will be ever time # after that so there is no point turning this off. # # WRITING: we want to write only if there is work to do (@WORKLIST) # *and* our rate limiters permit additional writes on this go-round. # Rate limiting off ($pkmax == 0) means we always allow writes. # my $rselect = IO::Select->new( $UDPSOCK ); my $wselect = IO::Select->new(); if ( $WORKSOCK ) { $rselect->add( $WORKSOCK ); } if ( @WORKLIST and ( $pkmax == 0 or $pkcount <= $pkmax) ) { $wselect->add( $UDPSOCK ); } if ( $verbose ) { log_print(sprintf("waiting for select r=%d/w=%d WORK=%d WAIT=%d", $rselect->count(), $wselect->count(), scalar @WORKLIST, scalar keys %Waiting)); } # ---------------------------------------------------------------- # WAIT FOR I/O ! # # This blocks on I/O, returning when either we have a socket we're # allowed to operate on, or upon timeout. Our timeout is always one # second because that's the granularity of all our other time-based # activities. # # By waking up every second, we have a chance to expire the packets # that have been waiting too long, and to reset our rate limiters. # my @A = IO::Select->select( $rselect, $wselect, undef, 1 ); next if @A == 0; # TIMEOUT? my( $readable, $writable, $except ) = @A; if ( $verbose ) { log_print(sprintf("SELECT returns readable=%d, writable=%d", scalar @{$readable}, scalar @{$writable} )); } die "ERROR: exception list fired\n" if @{$except}; # ---------------------------------------------------------------- # HANDLE WRITES # # We have only one possible socket to write on, so we don't have # to really test which one it is: we just use it. We fetch the # next item from the work list and send it off to the other end. # if ( @{ $writable } and my $item = getwork() ) { my $fh = shift @{$writable}; my $ipa = $item->IPAddress; my $pkt = $item->getWorkBuffer; my $remote = sockaddr_in($item->Port, inet_aton($ipa)); if ( $fh->send($pkt, 0, $remote) ) { $pkcount ++; # for rate-limit calculations $bycount += length $pkt; $item->RecordSend(); $Waiting{$ipa} = $item; } else { log_print("ERROR: cannot send! [$!]"); $Donelist{$ipa} = $item; work_add_stop($ipa); $item->Result($!); } next; } # ---------------------------------------------------------------- # HANDLE READS # # We might have two sockets to read from: the "normal" SNMP response # socket, plus the work-to-do socket. I neither # foreach my $fh ( @{ $readable } ) { my $rcvbuf = ""; if ( my $sender = $fh->recv($rcvbuf, $MAXLEN, 0) ) { if ( defined $WORKSOCK and $fh == $WORKSOCK ) { process_work( $sender, $rcvbuf ); } else { process_snmp_response( $sender, $rcvbuf ); } } else { log_print("ERROR: cannot read from socket [$!]"); } } } log_print("Done!"); foreach my $ipa ( keys %Targets ) { my $r = $Targets{$ipa}->{Result} || "?"; log_print(sprintf("%-15s %s", $ipa, $r)); } # # check_timeouts # # Run through the current %Waiting list and see if any of the items # found there are too old. If so, move them either to the %Done list # (where they are out of the way), or back to the work list after # bumping their retry count. # # Return is 1 if we actually did anything and 0 if not. # sub check_timeouts { my $horizon = shift; my $mod = 0; foreach my $key ( keys %Waiting ) { my $item = $Waiting{$key}; next if $item->ExpireTime > $horizon; ++ $mod; delete $Waiting{$key}; if ( $item->TimeoutCallback ) { push @WORKLIST, $item; } elsif ( $item->{Error} ) { work_add_stop( $item->IPAddress ); } } if ( $verbose and $mod ) { log_print("check_timeouts modified $mod"); } return $mod; } # # getwork() # # Return the next item from the work list, but we take care to # exclude any items that are already finished! This won't happen # often, but if we get a response from the other end just after # we have expired a waiting-for-response packet, it will appear # in both the @WORKLIST and %Donelist. # # Return is a ref to the worker item, or undef if nothing. sub getwork { while ( @WORKLIST ) { my $item = shift @WORKLIST; return $item if not $Donelist{ $item->IPAddress }; } return undef; } # # process_snmp_response # # This is called for when we get an SNMP response from one of our # remotes, and we figure out the IP address it came from, unpack # the SNMP data, and call that worker's callback. # sub process_snmp_response { my $sender = shift; my $rcvbuf = shift; my ($portno, $ipaddr) = sockaddr_in($sender); my $ipa = inet_ntoa($ipaddr); if ( defined( my $item = $Waiting{$ipa} ) ) { delete $Waiting{$ipa}; if ( $item->ResponseCallback($rcvbuf) ) { push @WORKLIST, $item; } elsif ( $item->{Error} ) { work_add_stop( $item->IPAddress ); } } else { log_print("GOT UNEXPECTED RESPONSE FROM $ipa"); # nothing? } } # # work_add_stop # # Given an IP address (either from the other end or the local # machinery), add that IP to the stop list: we don't do this # IP again. # sub work_add_stop { my $ipa = shift; if ( not defined $Stoplist{$ipa} ) { log_print("Added $ipa to stop list"); $Stoplist{$ipa} = 1; # rewrite file? } } sub work_del_stop { my $ipa = shift; if ( defined $Stoplist{$ipa} ) { log_print("Deleted $ipa from stop list"); delete $Stoplist{$ipa}; # rewrite file? } } # # work_add_ip # # Given an IP address (in string format) from the work socket, attempt # to add that IP to the current worker list. But it's not something # that gets added in every case: # # The "stop list" are IPs that we simply should not contact: they have # failed and we won't bother them ever again. # sub work_add_ip { my $ipa = shift; # ---------------------------------------------------------------- # The "stop list" is a list of IP addresses we're not supposed to # contact again: if we failed to reach them, or the community string # was wrong, or we got an SNMP error - we should just not do that # target ever again. # if ( defined $Stoplist{$ipa} ) { log_print("WORK: can't add $ipa - on stop list"); } # ---------------------------------------------------------------- # # elsif ( defined $Waiting{$ipa} ) { log_print("WORK: can't add $ipa - already in progress"); } elsif ( defined $Donelist{$ipa} ) { my $item = $Donelist{$ipa}; delete $Donelist{$ipa}; $item->reset; push @WORKLIST, $item; } else { log_print("WORK: adding $ipa new"); push @WORKLIST, add_target( $ipa ); } } # # process_work # # This receives a "work" request from the command socket, and it's # presumably from the log scanner socket. The strings are pretty easy # to deal with, and we ignore those that are too long or not known. # sub process_work { my $sender = shift; my $rcvbuf = shift; $rcvbuf =~ s/\s+$//; # dump trailing whitespace log_print("--> got work cmd {$rcvbuf}"); if ( $rcvbuf =~ m/^work \s+ (\d+\.\d+\.\d+\.\d+)/xi ) { work_add_ip( $1 ); } elsif ( $rcvbuf =~ m/^addstop \s+ (\d+\.\d+\.\d+\.\d+)/xi ) { work_add_stop( $1 ); } elsif ( $rcvbuf =~ m/^delstop \s+ (\d+\.\d+\.\d+\.\d+)/xi ) { work_del_stop( $1 ); } elsif ( $rcvbuf =~ m/^shutdown/i ) { log_print("WORK: Closing worker socket"); undef $WORKSOCK; } elsif ( $rcvbuf =~ m/^halt/i ) { log_print("Halting now"); exit 0; } else { log_print("WORK: Don't know what to do with {$rcvbuf}"); } } # # add_target # # Given an IP address (or hostname), create a new SNMPWorker object # and stick it in the global target array. We also return the object # reference so the caller may add it to the @WORKLIST. # sub add_target { my $remote = shift; if ( my $item = new SNMPWorker( Hostname => $remote, MaxTries => $MAXTRIES ) ) { my $ipa = $item->IPAddress; $Targets{ $ipa } = $item; $item->Debug(0); return $item; } else { log_print("ERROR: $EVAL_ERROR"); return (); } }