??????????????????????????????? ??????????????????????????????? ??????????????????????????????? >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>. ??????????????????????????????? ??????????????????????????????? ??????????????????????????????? ??????????????????????????????? ??????????????????????????????? ??????????????????????????????? >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>. >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< PK!" SNMP_util.pmnu[### - *- mode: Perl -*- ###################################################################### ### SNMP_util -- SNMP utilities using SNMP_Session.pm and BER.pm ###################################################################### ### Copyright (c) 1998-2010, Mike Mitchell. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### Created by: Mike Mitchell ### ### Contributions and fixes by: ### ### Tobias Oetiker : Basic layout ### Simon Leinen : SNMP_session.pm/BER.pm ### Jeff Allen : length() of undefined value ### Johannes Demel : MIB file parse problem ### Simon Leinen : more OIDs from Interface MIB ### Jacques Supcik : Specify local IP, port ### Tobias Oetiker : HASH as first OID to set SNMP options ### Simon Leinen : 'undefined port' bug ### Daniel McDonald : request for getbulk support ### Laurent Girod : code for snmpwalkhash ### Ian Duplisse : MIB parsing suggestions ### Jakob Ilves : return_array_refs for snmpwalk() ### Valerio Bontempi : IPv6 support ### Lorenzo Colitti : IPv6 support ### Joerg Kummer : TimeTicks support in snmpset() ### Christopher J. Tengi : Gauge32 support in snmpset() ### Nicolai Petri : hashref passing for snmpwalkhash() ### : parse NOTIFICATION-TYPE in MIB ### Dan Thorson : handle quotes in MIB comments better ###################################################################### package SNMP_util; require 5.004; use strict; use vars qw(@ISA @EXPORT $VERSION); use Exporter; use Carp; use BER "1.02"; use SNMP_Session "1.00"; use Socket; $VERSION = '1.15'; @ISA = qw(Exporter); @EXPORT = qw(snmpget snmpgetnext snmpwalk snmpset snmptrap snmpgetbulk snmpmaptable snmpmaptable4 snmpwalkhash snmpmapOID snmpMIB_to_OID snmpLoad_OID_Cache snmpQueue_MIB_File); # The OID numbers from RFC1213 (MIB-II) and RFC1315 (Frame Relay) # are pre-loaded below. %SNMP_util::OIDS = ( 'iso' => '1', 'org' => '1.3', 'dod' => '1.3.6', 'internet' => '1.3.6.1', 'directory' => '1.3.6.1.1', 'mgmt' => '1.3.6.1.2', 'mib-2' => '1.3.6.1.2.1', 'system' => '1.3.6.1.2.1.1', 'sysDescr' => '1.3.6.1.2.1.1.1.0', 'sysObjectID' => '1.3.6.1.2.1.1.2.0', 'sysUpTime' => '1.3.6.1.2.1.1.3.0', 'sysUptime' => '1.3.6.1.2.1.1.3.0', 'sysContact' => '1.3.6.1.2.1.1.4.0', 'sysName' => '1.3.6.1.2.1.1.5.0', 'sysLocation' => '1.3.6.1.2.1.1.6.0', 'sysServices' => '1.3.6.1.2.1.1.7.0', 'interfaces' => '1.3.6.1.2.1.2', 'ifNumber' => '1.3.6.1.2.1.2.1.0', 'ifTable' => '1.3.6.1.2.1.2.2', 'ifEntry' => '1.3.6.1.2.1.2.2.1', 'ifIndex' => '1.3.6.1.2.1.2.2.1.1', 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', 'ifInUcastPkts' => '1.3.6.1.2.1.2.2.1.11', 'ifInNUcastPkts' => '1.3.6.1.2.1.2.2.1.12', 'ifInDiscards' => '1.3.6.1.2.1.2.2.1.13', 'ifInErrors' => '1.3.6.1.2.1.2.2.1.14', 'ifInUnknownProtos' => '1.3.6.1.2.1.2.2.1.15', 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16', 'ifOutUcastPkts' => '1.3.6.1.2.1.2.2.1.17', 'ifOutNUcastPkts' => '1.3.6.1.2.1.2.2.1.18', 'ifOutDiscards' => '1.3.6.1.2.1.2.2.1.19', 'ifDescr' => '1.3.6.1.2.1.2.2.1.2', 'ifOutErrors' => '1.3.6.1.2.1.2.2.1.20', 'ifOutQLen' => '1.3.6.1.2.1.2.2.1.21', 'ifSpecific' => '1.3.6.1.2.1.2.2.1.22', 'ifType' => '1.3.6.1.2.1.2.2.1.3', 'ifMtu' => '1.3.6.1.2.1.2.2.1.4', 'ifSpeed' => '1.3.6.1.2.1.2.2.1.5', 'ifPhysAddress' => '1.3.6.1.2.1.2.2.1.6', 'ifAdminHack' => '1.3.6.1.2.1.2.2.1.7', 'ifAdminStatus' => '1.3.6.1.2.1.2.2.1.7', 'ifOperHack' => '1.3.6.1.2.1.2.2.1.8', 'ifOperStatus' => '1.3.6.1.2.1.2.2.1.8', 'ifLastChange' => '1.3.6.1.2.1.2.2.1.9', 'at' => '1.3.6.1.2.1.3', 'atTable' => '1.3.6.1.2.1.3.1', 'atEntry' => '1.3.6.1.2.1.3.1.1', 'atIfIndex' => '1.3.6.1.2.1.3.1.1.1', 'atPhysAddress' => '1.3.6.1.2.1.3.1.1.2', 'atNetAddress' => '1.3.6.1.2.1.3.1.1.3', 'ip' => '1.3.6.1.2.1.4', 'ipForwarding' => '1.3.6.1.2.1.4.1', 'ipOutRequests' => '1.3.6.1.2.1.4.10', 'ipOutDiscards' => '1.3.6.1.2.1.4.11', 'ipOutNoRoutes' => '1.3.6.1.2.1.4.12', 'ipReasmTimeout' => '1.3.6.1.2.1.4.13', 'ipReasmReqds' => '1.3.6.1.2.1.4.14', 'ipReasmOKs' => '1.3.6.1.2.1.4.15', 'ipReasmFails' => '1.3.6.1.2.1.4.16', 'ipFragOKs' => '1.3.6.1.2.1.4.17', 'ipFragFails' => '1.3.6.1.2.1.4.18', 'ipFragCreates' => '1.3.6.1.2.1.4.19', 'ipDefaultTTL' => '1.3.6.1.2.1.4.2', 'ipAddrTable' => '1.3.6.1.2.1.4.20', 'ipAddrEntry' => '1.3.6.1.2.1.4.20.1', 'ipAdEntAddr' => '1.3.6.1.2.1.4.20.1.1', 'ipAdEntIfIndex' => '1.3.6.1.2.1.4.20.1.2', 'ipAdEntNetMask' => '1.3.6.1.2.1.4.20.1.3', 'ipAdEntBcastAddr' => '1.3.6.1.2.1.4.20.1.4', 'ipAdEntReasmMaxSize' => '1.3.6.1.2.1.4.20.1.5', 'ipRouteTable' => '1.3.6.1.2.1.4.21', 'ipRouteEntry' => '1.3.6.1.2.1.4.21.1', 'ipRouteDest' => '1.3.6.1.2.1.4.21.1.1', 'ipRouteAge' => '1.3.6.1.2.1.4.21.1.10', 'ipRouteMask' => '1.3.6.1.2.1.4.21.1.11', 'ipRouteMetric5' => '1.3.6.1.2.1.4.21.1.12', 'ipRouteInfo' => '1.3.6.1.2.1.4.21.1.13', 'ipRouteIfIndex' => '1.3.6.1.2.1.4.21.1.2', 'ipRouteMetric1' => '1.3.6.1.2.1.4.21.1.3', 'ipRouteMetric2' => '1.3.6.1.2.1.4.21.1.4', 'ipRouteMetric3' => '1.3.6.1.2.1.4.21.1.5', 'ipRouteMetric4' => '1.3.6.1.2.1.4.21.1.6', 'ipRouteNextHop' => '1.3.6.1.2.1.4.21.1.7', 'ipRouteType' => '1.3.6.1.2.1.4.21.1.8', 'ipRouteProto' => '1.3.6.1.2.1.4.21.1.9', 'ipNetToMediaTable' => '1.3.6.1.2.1.4.22', 'ipNetToMediaEntry' => '1.3.6.1.2.1.4.22.1', 'ipNetToMediaIfIndex' => '1.3.6.1.2.1.4.22.1.1', 'ipNetToMediaPhysAddress' => '1.3.6.1.2.1.4.22.1.2', 'ipNetToMediaNetAddress' => '1.3.6.1.2.1.4.22.1.3', 'ipNetToMediaType' => '1.3.6.1.2.1.4.22.1.4', 'ipRoutingDiscards' => '1.3.6.1.2.1.4.23', 'ipInReceives' => '1.3.6.1.2.1.4.3', 'ipInHdrErrors' => '1.3.6.1.2.1.4.4', 'ipInAddrErrors' => '1.3.6.1.2.1.4.5', 'ipForwDatagrams' => '1.3.6.1.2.1.4.6', 'ipInUnknownProtos' => '1.3.6.1.2.1.4.7', 'ipInDiscards' => '1.3.6.1.2.1.4.8', 'ipInDelivers' => '1.3.6.1.2.1.4.9', 'icmp' => '1.3.6.1.2.1.5', 'icmpInMsgs' => '1.3.6.1.2.1.5.1', 'icmpInTimestamps' => '1.3.6.1.2.1.5.10', 'icmpInTimestampReps' => '1.3.6.1.2.1.5.11', 'icmpInAddrMasks' => '1.3.6.1.2.1.5.12', 'icmpInAddrMaskReps' => '1.3.6.1.2.1.5.13', 'icmpOutMsgs' => '1.3.6.1.2.1.5.14', 'icmpOutErrors' => '1.3.6.1.2.1.5.15', 'icmpOutDestUnreachs' => '1.3.6.1.2.1.5.16', 'icmpOutTimeExcds' => '1.3.6.1.2.1.5.17', 'icmpOutParmProbs' => '1.3.6.1.2.1.5.18', 'icmpOutSrcQuenchs' => '1.3.6.1.2.1.5.19', 'icmpInErrors' => '1.3.6.1.2.1.5.2', 'icmpOutRedirects' => '1.3.6.1.2.1.5.20', 'icmpOutEchos' => '1.3.6.1.2.1.5.21', 'icmpOutEchoReps' => '1.3.6.1.2.1.5.22', 'icmpOutTimestamps' => '1.3.6.1.2.1.5.23', 'icmpOutTimestampReps' => '1.3.6.1.2.1.5.24', 'icmpOutAddrMasks' => '1.3.6.1.2.1.5.25', 'icmpOutAddrMaskReps' => '1.3.6.1.2.1.5.26', 'icmpInDestUnreachs' => '1.3.6.1.2.1.5.3', 'icmpInTimeExcds' => '1.3.6.1.2.1.5.4', 'icmpInParmProbs' => '1.3.6.1.2.1.5.5', 'icmpInSrcQuenchs' => '1.3.6.1.2.1.5.6', 'icmpInRedirects' => '1.3.6.1.2.1.5.7', 'icmpInEchos' => '1.3.6.1.2.1.5.8', 'icmpInEchoReps' => '1.3.6.1.2.1.5.9', 'tcp' => '1.3.6.1.2.1.6', 'tcpRtoAlgorithm' => '1.3.6.1.2.1.6.1', 'tcpInSegs' => '1.3.6.1.2.1.6.10', 'tcpOutSegs' => '1.3.6.1.2.1.6.11', 'tcpRetransSegs' => '1.3.6.1.2.1.6.12', 'tcpConnTable' => '1.3.6.1.2.1.6.13', 'tcpConnEntry' => '1.3.6.1.2.1.6.13.1', 'tcpConnState' => '1.3.6.1.2.1.6.13.1.1', 'tcpConnLocalAddress' => '1.3.6.1.2.1.6.13.1.2', 'tcpConnLocalPort' => '1.3.6.1.2.1.6.13.1.3', 'tcpConnRemAddress' => '1.3.6.1.2.1.6.13.1.4', 'tcpConnRemPort' => '1.3.6.1.2.1.6.13.1.5', 'tcpInErrs' => '1.3.6.1.2.1.6.14', 'tcpOutRsts' => '1.3.6.1.2.1.6.15', 'tcpRtoMin' => '1.3.6.1.2.1.6.2', 'tcpRtoMax' => '1.3.6.1.2.1.6.3', 'tcpMaxConn' => '1.3.6.1.2.1.6.4', 'tcpActiveOpens' => '1.3.6.1.2.1.6.5', 'tcpPassiveOpens' => '1.3.6.1.2.1.6.6', 'tcpAttemptFails' => '1.3.6.1.2.1.6.7', 'tcpEstabResets' => '1.3.6.1.2.1.6.8', 'tcpCurrEstab' => '1.3.6.1.2.1.6.9', 'udp' => '1.3.6.1.2.1.7', 'udpInDatagrams' => '1.3.6.1.2.1.7.1', 'udpNoPorts' => '1.3.6.1.2.1.7.2', 'udpInErrors' => '1.3.6.1.2.1.7.3', 'udpOutDatagrams' => '1.3.6.1.2.1.7.4', 'udpTable' => '1.3.6.1.2.1.7.5', 'udpEntry' => '1.3.6.1.2.1.7.5.1', 'udpLocalAddress' => '1.3.6.1.2.1.7.5.1.1', 'udpLocalPort' => '1.3.6.1.2.1.7.5.1.2', 'egp' => '1.3.6.1.2.1.8', 'egpInMsgs' => '1.3.6.1.2.1.8.1', 'egpInErrors' => '1.3.6.1.2.1.8.2', 'egpOutMsgs' => '1.3.6.1.2.1.8.3', 'egpOutErrors' => '1.3.6.1.2.1.8.4', 'egpNeighTable' => '1.3.6.1.2.1.8.5', 'egpNeighEntry' => '1.3.6.1.2.1.8.5.1', 'egpNeighState' => '1.3.6.1.2.1.8.5.1.1', 'egpNeighStateUps' => '1.3.6.1.2.1.8.5.1.10', 'egpNeighStateDowns' => '1.3.6.1.2.1.8.5.1.11', 'egpNeighIntervalHello' => '1.3.6.1.2.1.8.5.1.12', 'egpNeighIntervalPoll' => '1.3.6.1.2.1.8.5.1.13', 'egpNeighMode' => '1.3.6.1.2.1.8.5.1.14', 'egpNeighEventTrigger' => '1.3.6.1.2.1.8.5.1.15', 'egpNeighAddr' => '1.3.6.1.2.1.8.5.1.2', 'egpNeighAs' => '1.3.6.1.2.1.8.5.1.3', 'egpNeighInMsgs' => '1.3.6.1.2.1.8.5.1.4', 'egpNeighInErrs' => '1.3.6.1.2.1.8.5.1.5', 'egpNeighOutMsgs' => '1.3.6.1.2.1.8.5.1.6', 'egpNeighOutErrs' => '1.3.6.1.2.1.8.5.1.7', 'egpNeighInErrMsgs' => '1.3.6.1.2.1.8.5.1.8', 'egpNeighOutErrMsgs' => '1.3.6.1.2.1.8.5.1.9', 'egpAs' => '1.3.6.1.2.1.8.6', 'transmission' => '1.3.6.1.2.1.10', 'frame-relay' => '1.3.6.1.2.1.10.32', 'frDlcmiTable' => '1.3.6.1.2.1.10.32.1', 'frDlcmiEntry' => '1.3.6.1.2.1.10.32.1.1', 'frDlcmiIfIndex' => '1.3.6.1.2.1.10.32.1.1.1', 'frDlcmiState' => '1.3.6.1.2.1.10.32.1.1.2', 'frDlcmiAddress' => '1.3.6.1.2.1.10.32.1.1.3', 'frDlcmiAddressLen' => '1.3.6.1.2.1.10.32.1.1.4', 'frDlcmiPollingInterval' => '1.3.6.1.2.1.10.32.1.1.5', 'frDlcmiFullEnquiryInterval' => '1.3.6.1.2.1.10.32.1.1.6', 'frDlcmiErrorThreshold' => '1.3.6.1.2.1.10.32.1.1.7', 'frDlcmiMonitoredEvents' => '1.3.6.1.2.1.10.32.1.1.8', 'frDlcmiMaxSupportedVCs' => '1.3.6.1.2.1.10.32.1.1.9', 'frDlcmiMulticast' => '1.3.6.1.2.1.10.32.1.1.10', 'frCircuitTable' => '1.3.6.1.2.1.10.32.2', 'frCircuitEntry' => '1.3.6.1.2.1.10.32.2.1', 'frCircuitIfIndex' => '1.3.6.1.2.1.10.32.2.1.1', 'frCircuitDlci' => '1.3.6.1.2.1.10.32.2.1.2', 'frCircuitState' => '1.3.6.1.2.1.10.32.2.1.3', 'frCircuitReceivedFECNs' => '1.3.6.1.2.1.10.32.2.1.4', 'frCircuitReceivedBECNs' => '1.3.6.1.2.1.10.32.2.1.5', 'frCircuitSentFrames' => '1.3.6.1.2.1.10.32.2.1.6', 'frCircuitSentOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frOutOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frCircuitReceivedFrames' => '1.3.6.1.2.1.10.32.2.1.8', 'frCircuitReceivedOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frInOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frCircuitCreationTime' => '1.3.6.1.2.1.10.32.2.1.10', 'frCircuitLastTimeChange' => '1.3.6.1.2.1.10.32.2.1.11', 'frCircuitCommittedBurst' => '1.3.6.1.2.1.10.32.2.1.12', 'frCircuitExcessBurst' => '1.3.6.1.2.1.10.32.2.1.13', 'frCircuitThroughput' => '1.3.6.1.2.1.10.32.2.1.14', 'frErrTable' => '1.3.6.1.2.1.10.32.3', 'frErrEntry' => '1.3.6.1.2.1.10.32.3.1', 'frErrIfIndex' => '1.3.6.1.2.1.10.32.3.1.1', 'frErrType' => '1.3.6.1.2.1.10.32.3.1.2', 'frErrData' => '1.3.6.1.2.1.10.32.3.1.3', 'frErrTime' => '1.3.6.1.2.1.10.32.3.1.4', 'frame-relay-globals' => '1.3.6.1.2.1.10.32.4', 'frTrapState' => '1.3.6.1.2.1.10.32.4.1', 'snmp' => '1.3.6.1.2.1.11', 'snmpInPkts' => '1.3.6.1.2.1.11.1', 'snmpInBadValues' => '1.3.6.1.2.1.11.10', 'snmpInReadOnlys' => '1.3.6.1.2.1.11.11', 'snmpInGenErrs' => '1.3.6.1.2.1.11.12', 'snmpInTotalReqVars' => '1.3.6.1.2.1.11.13', 'snmpInTotalSetVars' => '1.3.6.1.2.1.11.14', 'snmpInGetRequests' => '1.3.6.1.2.1.11.15', 'snmpInGetNexts' => '1.3.6.1.2.1.11.16', 'snmpInSetRequests' => '1.3.6.1.2.1.11.17', 'snmpInGetResponses' => '1.3.6.1.2.1.11.18', 'snmpInTraps' => '1.3.6.1.2.1.11.19', 'snmpOutPkts' => '1.3.6.1.2.1.11.2', 'snmpOutTooBigs' => '1.3.6.1.2.1.11.20', 'snmpOutNoSuchNames' => '1.3.6.1.2.1.11.21', 'snmpOutBadValues' => '1.3.6.1.2.1.11.22', 'snmpOutGenErrs' => '1.3.6.1.2.1.11.24', 'snmpOutGetRequests' => '1.3.6.1.2.1.11.25', 'snmpOutGetNexts' => '1.3.6.1.2.1.11.26', 'snmpOutSetRequests' => '1.3.6.1.2.1.11.27', 'snmpOutGetResponses' => '1.3.6.1.2.1.11.28', 'snmpOutTraps' => '1.3.6.1.2.1.11.29', 'snmpInBadVersions' => '1.3.6.1.2.1.11.3', 'snmpEnableAuthenTraps' => '1.3.6.1.2.1.11.30', 'snmpInBadCommunityNames' => '1.3.6.1.2.1.11.4', 'snmpInBadCommunityUses' => '1.3.6.1.2.1.11.5', 'snmpInASNParseErrs' => '1.3.6.1.2.1.11.6', 'snmpInTooBigs' => '1.3.6.1.2.1.11.8', 'snmpInNoSuchNames' => '1.3.6.1.2.1.11.9', 'ifName' => '1.3.6.1.2.1.31.1.1.1.1', 'ifInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.2', 'ifInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.3', 'ifOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.4', 'ifOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.5', 'ifHCInOctets' => '1.3.6.1.2.1.31.1.1.1.6', 'ifHCInUcastPkts' => '1.3.6.1.2.1.31.1.1.1.7', 'ifHCInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.8', 'ifHCInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.9', 'ifHCOutOctets' => '1.3.6.1.2.1.31.1.1.1.10', 'ifHCOutUcastPkts' => '1.3.6.1.2.1.31.1.1.1.11', 'ifHCOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.12', 'ifHCOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.13', 'ifLinkUpDownTrapEnable' => '1.3.6.1.2.1.31.1.1.1.14', 'ifHighSpeed' => '1.3.6.1.2.1.31.1.1.1.15', 'ifPromiscuousMode' => '1.3.6.1.2.1.31.1.1.1.16', 'ifConnectorPresent' => '1.3.6.1.2.1.31.1.1.1.17', 'ifAlias' => '1.3.6.1.2.1.31.1.1.1.18', 'ifCounterDiscontinuityTime' => '1.3.6.1.2.1.31.1.1.1.19', 'experimental' => '1.3.6.1.3', 'private' => '1.3.6.1.4', 'enterprises' => '1.3.6.1.4.1', ); # GIL my %revOIDS = (); # Reversed %SNMP_util::OIDS hash my $RevNeeded = 1; my $agent_start_time = time; undef $SNMP_util::Host; undef $SNMP_util::Session; undef $SNMP_util::Version; undef $SNMP_util::LHost; undef $SNMP_util::IPv4only; $SNMP_util::Debug = 0; $SNMP_util::CacheFile = "OID_cache.txt"; $SNMP_util::CacheLoaded = 0; $SNMP_util::Return_array_refs = 0; $SNMP_util::Return_hash_refs = 0; srand(time + $$); ### Prototypes sub snmpget ($@); sub snmpgetnext ($@); sub snmpopen ($$$); sub snmpwalk ($@); sub snmpwalk_flg ($$@); sub snmpset ($@); sub snmptrap ($$$$$@); sub snmpgetbulk ($$$@); sub snmpmaptable ($$@); sub snmpmaptable4 ($$$@); sub snmpwalkhash ($$@); sub toOID (@); sub snmpmapOID (@); sub snmpMIB_to_OID ($); sub encode_oid_with_errmsg ($); sub Check_OID ($); sub snmpLoad_OID_Cache ($); sub snmpQueue_MIB_File (@); sub MIB_fill_OID ($); sub version () { $VERSION; } # # Start an snmp session # sub snmpopen ($$$) { my($host, $type, $vars) = @_; my($nhost, $port, $community, $lhost, $lport, $nlhost); my($timeout, $retries, $backoff, $version); my $v4onlystr; $type = 0 if (!defined($type)); $community = "public"; $nlhost = ""; ($community, $host) = ($1, $2) if ($host =~ /^(.*)@([^@]+)$/); # We can't split on the : character because a numeric IPv6 # address contains a variable number of :'s my $opts; if( ($host =~ /^(\[.*\]):(.*)$/) or ($host =~ /^(\[.*\])$/) ) { # Numeric IPv6 address between [] ($host, $opts) = ($1, $2); } else { # Hostname or numeric IPv4 address ($host, $opts) = split(':', $host, 2); } ($port, $timeout, $retries, $backoff, $version, $v4onlystr) = split(':', $opts, 6) if(defined($opts) and (length $opts > 0) ); undef($version) if (defined($version) and length($version) <= 0); $v4onlystr = "" unless defined $v4onlystr; $version = '1' unless defined $version; if (defined($port) and ($port =~ /^([^!]*)!(.*)$/)) { ($port, $lhost) = ($1, $2); $nlhost = $lhost; ($lhost, $lport) = ($1, $2) if ($lhost =~ /^(.*)!(.*)$/); undef($lhost) if (defined($lhost) and (length($lhost) <= 0)); undef($lport) if (defined($lport) and (length($lport) <= 0)); } undef($port) if (defined($port) and length($port) <= 0); $port = 162 if ($type == 1 and !defined($port)); $nhost = "$community\@$host"; $nhost .= ":" . $port if (defined($port)); if ((!defined($SNMP_util::Session)) or ($SNMP_util::Host ne $nhost) or ($SNMP_util::Version ne $version) or ($SNMP_util::LHost ne $nlhost) or ($SNMP_util::IPv4only ne $v4onlystr)) { if (defined($SNMP_util::Session)) { $SNMP_util::Session->close(); undef $SNMP_util::Session; undef $SNMP_util::Host; undef $SNMP_util::Version; undef $SNMP_util::LHost; undef $SNMP_util::IPv4only; } $SNMP_util::Session = ($version =~ /^2c?$/i) ? SNMPv2c_Session->open($host, $community, $port, undef, $lport, undef, $lhost, ($v4onlystr eq 'v4only') ? 1:0 ) : SNMP_Session->open($host, $community, $port, undef, $lport, undef, $lhost, ($v4onlystr eq 'v4only') ? 1:0 ); ($SNMP_util::Host = $nhost, $SNMP_util::Version = $version, $SNMP_util::LHost = $nlhost, $SNMP_util::IPv4only = $v4onlystr) if defined($SNMP_util::Session); } if (defined($SNMP_util::Session)) { if (ref $vars->[0] eq 'HASH') { my $opts = shift @$vars; foreach $type (keys %$opts) { if ($type eq 'return_array_refs') { $SNMP_util::Return_array_refs = $opts->{$type}; } elsif ($type eq 'return_hash_refs') { $SNMP_util::Return_hash_refs = $opts->{$type}; } else { if (exists $SNMP_util::Session->{$type}) { if ($type eq 'timeout') { $SNMP_util::Session->set_timeout($opts->{$type}); } elsif ($type eq 'retries') { $SNMP_util::Session->set_retries($opts->{$type}); } elsif ($type eq 'backoff') { $SNMP_util::Session->set_backoff($opts->{$type}); } else { $SNMP_util::Session->{$type} = $opts->{$type}; } } else { carp "SNMPopen Unknown SNMP Option Key '$type'\n" unless ($SNMP_Session::suppress_warnings > 1); } } } } $SNMP_util::Session->set_timeout($timeout) if (defined($timeout) and (length($timeout) > 0)); $SNMP_util::Session->set_retries($retries) if (defined($retries) and (length($retries) > 0)); $SNMP_util::Session->set_backoff($backoff) if (defined($backoff) and (length($backoff) > 0)); } return $SNMP_util::Session; } # # A restricted snmpget. # sub snmpget ($@) { my($host, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding, $value, $oid, @retvals); my $session; @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGET Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } @enoid = &toOID(@vars); if ($#enoid < 0) { return wantarray ? @retvals : undef; } if ($session->get_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($value); push @retvals, $tempo; } return wantarray ? @retvals : $retvals[0]; } $var = join(' ', @vars); carp "SNMPGET Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } # # A restricted snmpgetnext. # sub snmpgetnext ($@) { my($host, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals); my($noid); my $session; @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETNEXT Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } @enoid = &toOID(@vars); if ($#enoid < 0) { return wantarray ? @retvals : undef; } undef @vars; undef @retvals; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } if ($session->getnext_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($oid); my $tempv = pretty_print($value); push @retvals, "$tempo:$tempv"; } return wantarray ? @retvals : $retvals[0]; } else { $var = join(' ', @vars); carp "SNMPGETNEXT Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } } # # A restricted snmpwalk. # sub snmpwalk ($@) { my($host, @vars) = @_; return(&snmpwalk_flg($host, undef, @vars)); } # # Walk the MIB, putting everything you find into hashes. # sub snmpwalkhash($$@) { # my($host, $hash_sub, @vars) = @_; return(&snmpwalk_flg( @_ )); } sub snmpwalk_flg ($$@) { my($host, $hash_sub, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals, @retvaltmprefs); my($got, @nnoid, $noid, $ok, $ix, @avars); my $session; my(%soid); my(%done, %rethash, $h_ref); $h_ref = (ref $vars[$#vars] eq "HASH") ? pop(@vars) : \%rethash; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPWALK Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } @enoid = toOID(@vars); if ($#enoid < 0) { if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } # GIL # # Create/Refresh a reversed hash with oid -> name # if (defined($hash_sub) and ($RevNeeded)) { %revOIDS = reverse %SNMP_util::OIDS; $RevNeeded = 0; } $got = 0; @nnoid = @enoid; undef @vars; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } # @vars is the original set of walked variables. # @avars is the current set of walked variables as the # walk goes on. # @vars stays static while @avars may shrink as we reach end # of walk for individual variables during PDU exchange. @avars = @vars; # IlvJa # # Create temporary array of refs to return vals. if ($SNMP_util::Return_array_refs) { for($ix = 0;$ix < scalar @vars; $ix++) { my $tmparray = []; $retvaltmprefs[$ix] = $tmparray; $retvals[$ix] = $tmparray; } } while(($SNMP_util::Version ne '1' and $session->{'use_getbulk'}) ? $session->getbulk_request_response(0, $session->default_max_repetitions(), @nnoid) : $session->getnext_request_response(@nnoid)) { $got = 1; $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); $ix = 0; while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); unless ($nnoid[$ix]) { # IlvJa $ix = ++$ix % (scalar @avars); next; } ($oid, $value) = decode_by_template($binding, "%O%@"); $ok = 0; my $tempo = pretty_print($oid); $noid = $avars[$ix]; # IlvJa if ($tempo =~ /^$noid\./ or $tempo eq $noid ) { $ok = 1; $upoid = $noid; } else { # IlvJa # # The walk for variable $vars[$ix] has been finished as # $nnoid[$ix] no longer is in the $avar[$ix] OID tree. # So we exclude this variable from further requests. $avars[$ix] = ""; $nnoid[$ix] = ""; $retvaltmprefs[$ix] = undef if $SNMP_util::Return_array_refs; } if ($ok) { my $tmp = encode_oid_with_errmsg ($tempo); if (!defined $tmp) { if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } if (exists($done{$tmp})) { # GIL, Ilvja # # We've detected a loop for $nnoid[$ix], so mark it as finished. # Exclude this variable from further requests. # $avars[$ix] = ""; $nnoid[$ix] = ""; $retvaltmprefs[$ix] = undef if $SNMP_util::Return_array_refs; next; } $nnoid[$ix] = $tmp; # Keep on walking. (IlvJa) my $tempv = pretty_print($value); if (defined($hash_sub)) { # # extract name of the oid, if possible, the rest becomes the instance # my $inst = ""; my $upo = $upoid; while (!exists($revOIDS{$upo}) and length($upo)) { $upo =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $upo = ""; last; } } if (length($upo) and exists($revOIDS{$upo})) { $upo = $revOIDS{$upo} . $inst; } else { $upo = $upoid; } $inst = ""; while (!exists($revOIDS{$tempo}) and length($tempo)) { $tempo =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $tempo = ""; last; } } if (length($tempo) and exists($revOIDS{$tempo})) { $var = $revOIDS{$tempo}; } else { $var = pretty_print($oid); } # # call hash_sub # &$hash_sub($h_ref, $host, $var, $tempo, $inst, $tempv, $upo); } else { if ($SNMP_util::Return_array_refs) { $tempo=~s/^$upoid\.//; push @{$retvaltmprefs[$ix]}, "$tempo:$tempv"; } else { $tempo=~s/^$upoid\.// if ($#enoid <= 0); push @retvals, "$tempo:$tempv"; } } $done{$tmp} = 1; # GIL } $ix = ++$ix % (scalar @avars); } # Ok, @nnoid should contain the remaining variables for the # next request. Some or all entries in @nnoid might be the empty # string. If the nth element in @nnoid is "" that means that # the walk related to the nth variable in the last request has been # completed and we should not include that var in subsequent reqs. # Clean up both @nnoid and @avars so "" elements are removed. @nnoid = grep (($_), @nnoid); @avars = grep (($_), @avars); @retvaltmprefs = grep (($_), @retvaltmprefs); last if ($#nnoid < 0); # @nnoid empty means we are done walking. } if (!$got) { $var = join(' ', @vars); carp "SNMPWALK Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); @retvals = (); } if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { return (@retvals); } } # # A restricted snmpset. # sub snmpset($@) { my($host, @vars) = @_; my(@enoid, $response, $bindings, $binding); my($oid, @retvals, $type, $value, $val); my $session; @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPSET Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } while(@vars) { ($oid) = toOID((shift @vars)); $type = shift @vars; $value = shift @vars; $type =~ tr/A-Z/a-z/; if ($type eq "int") { $val = encode_int($value); } elsif ($type eq "integer") { $val = encode_int($value); } elsif ($type eq "string") { $val = encode_string($value); } elsif ($type eq "octetstring") { $val = encode_string($value); } elsif ($type eq "octet string") { $val = encode_string($value); } elsif ($type eq "oid") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "object id") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "object identifier") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "ipaddr") { $val = encode_ip_address($value); } elsif ($type eq "ip address") { $val = encode_ip_address($value); } elsif ($type eq "timeticks") { $val = encode_timeticks($value); } elsif ($type eq "uint") { $val = encode_uinteger32($value); } elsif ($type eq "uinteger") { $val = encode_uinteger32($value); } elsif ($type eq "uinteger32") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned int") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned integer") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned integer32") { $val = encode_uinteger32($value); } elsif ($type eq "counter") { $val = encode_counter32($value); } elsif ($type eq "counter32") { $val = encode_counter32($value); } elsif ($type eq "counter64") { $val = encode_counter64($value); } elsif ($type eq "gauge") { $val = encode_gauge32($value); } elsif ($type eq "gauge32") { $val = encode_gauge32($value); } else { carp "unknown SNMP type: $type\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } if (!defined($val)) { carp "SNMP type $type value $value didn't encode properly\n" unless ($SNMP_Session::suppress_warnings > 1); return wantarray ? @retvals : undef; } push @enoid, [$oid,$val]; } if ($#enoid < 0) { return wantarray ? @retvals : undef; } if ($session->set_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($value); push @retvals, $tempo; } return wantarray ? @retvals : $retvals[0]; } return wantarray ? @retvals : undef; } # # Send an SNMP trap # sub snmptrap($$$$$@) { my($host, $ent, $agent, $gen, $spec, @vars) = @_; my($oid, @retvals, $type, $value); my(@enoid); my $session; $session = &snmpopen($host, 1, \@vars); if (!defined($session)) { carp "SNMPTRAP Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } if ($agent =~ /^\d+\.\d+\.\d+\.\d+(.*)/ ) { $agent = pack("C*", split /\./, $agent); } else { $agent = inet_aton($agent); } push @enoid, toOID(($ent)); push @enoid, encode_ip_address($agent); push @enoid, encode_int($gen); push @enoid, encode_int($spec); push @enoid, encode_timeticks((time-$agent_start_time) * 100); while(@vars) { ($oid) = toOID((shift @vars)); $type = shift @vars; $value = shift @vars; if ($type =~ /string/i) { $value = encode_string($value); push @enoid, [$oid,$value]; } elsif ($type =~ /ipaddr/i) { $value = encode_ip_address($value); push @enoid, [$oid,$value]; } elsif ($type =~ /int/i) { $value = encode_int($value); push @enoid, [$oid,$value]; } elsif ($type =~ /oid/i) { my $tmp = encode_oid_with_errmsg($value); return undef unless defined $tmp; push @enoid, [$oid,$tmp]; } else { carp "unknown SNMP type: $type\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } } return($session->trap_request_send(@enoid)); } # # A restricted snmpgetbulk. # sub snmpgetbulk ($$$@) { my($host, $nr, $mr, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals); my($noid); my $session; @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETBULK Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return @retvals; } @enoid = &toOID(@vars); return @retvals if ($#enoid < 0); undef @vars; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } if ($session->getbulk_request_response($nr, $mr, @enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($oid); my $tempv = pretty_print($value); push @retvals, "$tempo:$tempv"; } return @retvals; } else { $var = join(' ', @vars); carp "SNMPGETBULK Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return @retvals; } } # # walk a table, calling a user-supplied function for each # column of a table. # sub snmpmaptable($$@) { my($host, $fun, @vars) = @_; return snmpmaptable4($host, $fun, 0, @vars); } sub snmpmaptable4($$$@) { my($host, $fun, $max_reps, @vars) = @_; my(@enoid, $var, $session); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPMAPTABLE Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } foreach $var (toOID(@vars)) { push(@enoid, [split('\.', pretty_print($var))]); } $max_reps = $session->default_max_repetitions() if ($max_reps <= 0); return $session->map_table_start_end( [@enoid], sub() { my ($ind, @vals) = @_; my (@pvals, $val); foreach $val (@vals) { push(@pvals, pretty_print($val)); } &$fun($ind, @pvals); }, "", undef, $max_reps); } # # Given an OID in either ASN.1 or mixed text/ASN.1 notation, return an # encoded OID. # sub toOID(@) { my(@vars) = @_; my($oid, $var, $tmp, $tmpv, @retvar); undef @retvar; foreach $var (@vars) { ($oid, $tmp) = &Check_OID($var); if (!$oid and $SNMP_util::CacheLoaded == 0) { $tmp = $SNMP_Session::suppress_warnings; $SNMP_Session::suppress_warnings = 1000; &snmpLoad_OID_Cache($SNMP_util::CacheFile); $SNMP_util::CacheLoaded = 1; $SNMP_Session::suppress_warnings = $tmp; ($oid, $tmp) = &Check_OID($var); } while (!$oid and $#SNMP_util::MIB_Files >= 0) { $tmp = $SNMP_Session::suppress_warnings; $SNMP_Session::suppress_warnings = 1000; snmpMIB_to_OID(shift(@SNMP_util::MIB_Files)); $SNMP_Session::suppress_warnings = $tmp; ($oid, $tmp) = &Check_OID($var); if ($oid) { open(CACHE, ">>$SNMP_util::CacheFile"); print CACHE "$tmp\t$oid\n"; close(CACHE); } } if ($oid) { $var =~ s/^$tmp/$oid/; } else { carp "Unknown SNMP var $var\n" unless ($SNMP_Session::suppress_warnings > 1); next; } while ($var =~ /\"([^\"]*)\"/) { $tmp = sprintf("%d.%s", length($1), join(".", map(ord, split(//, $1)))); $var =~ s/\"$1\"/$tmp/; } print "toOID: $var\n" if $SNMP_util::Debug; $tmp = encode_oid_with_errmsg($var); if (!defined($tmp)) { my @empty = (); return @empty; } push(@retvar, $tmp); } return @retvar; } # # Add passed-in text, OID pairs to the OID mapping table. # sub snmpmapOID(@) { my(@vars) = @_; my($oid, $txt); while($#vars >= 0) { $txt = shift @vars; $oid = shift @vars; next unless($txt =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-])*$/); next unless($oid =~ /^\d+(\.\d+)*$/); $SNMP_util::OIDS{$txt} = $oid; $RevNeeded = 1; print "snmpmapOID: $txt => $oid\n" if $SNMP_util::Debug; } return undef; } # # Open the passed-in file name and read it in to populate # the cache of text-to-OID map table. It expects lines # with two fields, the first the textual string like "ifInOctets", # and the second the OID value, like "1.3.6.1.2.1.2.2.1.10". # # blank lines and anything after a '#' or between '--' is ignored. # sub snmpLoad_OID_Cache ($) { my($arg) = @_; my($txt, $oid); if (!open(CACHE, $arg)) { carp "snmpLoad_OID_Cache: Can't open $arg: $!" unless ($SNMP_Session::suppress_warnings > 1); return -1; } while() { s/#.*//; # '#' starts a comment s/--.*?--/ /g; # comment delimited by '--', like MIBs s/--.*//; # comment started by '--' next if (/^$/); next unless (/\s/); # must have whitespace as separator chomp; ($txt, $oid) = split(' ', $_, 2); $txt = $1 if ($txt =~ /^[\'\"](.*)[\'\"]/); $oid = $1 if ($oid =~ /^[\'\"](.*)[\'\"]/); if (($txt =~ /^\.?\d+(\.\d+)*\.?$/) and ($oid !~ /^\.?\d+(\.\d+)*\.?$/)) { my($a) = $oid; $oid = $txt; $txt = $a; } $oid =~ s/^\.//; $oid =~ s/\.$//; &snmpmapOID($txt, $oid); } close(CACHE); return 0; } # # Check to see if an OID is in the text-to-OID cache. # Returns the OID and the corresponding text as two separate # elements. # sub Check_OID ($) { my($var) = @_; my($tmp, $tmpv, $oid); if ($var =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-]*)*/) { $tmp = $&; $tmpv = $tmp; for (;;) { last if exists($SNMP_util::OIDS{$tmpv}); last if !($tmpv =~ s/^[^\.]*\.//); } $oid = $SNMP_util::OIDS{$tmpv}; if ($oid) { return ($oid, $tmp); } else { my @empty = (); return @empty; } } return ($var, $var); } # # Save the passed-in list of MIB files until an OID can't be # found in the existing table. At that time the MIB file will # be loaded, and the lookup attempted again. # sub snmpQueue_MIB_File (@) { my(@files) = @_; my($file); foreach $file (@files) { push(@SNMP_util::MIB_Files, $file); } } # # Read in the passed MIB file, parsing it # for their text-to-OID mappings # sub snmpMIB_to_OID ($) { my($arg) = @_; my($cnt, $quote, $buf, %tOIDs, $tgot); my($var, @parts, $strt, $indx, $ind, $val); if (!open(MIB, $arg)) { carp "snmpMIB_to_OID: Can't open $arg: $!" unless ($SNMP_Session::suppress_warnings > 1); return -1; } print "snmpMIB_to_OID: loading $arg\n" if $SNMP_util::Debug; $cnt = 0; $quote = 0; $tgot = 0; $buf = ''; while() { if ($quote) { next unless /"/; $quote = 0; } chomp; $buf .= ' ' . $_; $buf =~ s/"[^"]*"//g; # throw away quoted strings $buf =~ s/--.*?--/ /g; # throw away comments (-- anything --) $buf =~ s/--.*//; # throw away comments (-- anything to EOL) $buf =~ s/\s+/ /g; # clean up multiple spaces if ($buf =~ /"/) { # look for quoted string $quote = 1; next; } if ($buf =~ /DEFINITIONS *::= *BEGIN/) { $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $buf = ''; %tOIDs = (); $tgot = 0; next; } $buf =~ s/OBJECT-TYPE/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-GROUP/OBJECT IDENTIFIER/; $buf =~ s/MODULE-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/NOTIFICATION-TYPE/OBJECT IDENTIFIER/; $buf =~ s/ IMPORTS .*\;//; $buf =~ s/ SEQUENCE *{.*}//; $buf =~ s/ SYNTAX .*//; $buf =~ s/ [\w\-]+ *::= *OBJECT IDENTIFIER//; $buf =~ s/ OBJECT IDENTIFIER.*::= *{/ OBJECT IDENTIFIER ::= {/; if ($buf =~ / ([\w\-]+) OBJECT IDENTIFIER *::= *{([^}]+)}/) { $var = $1; $buf = $2; $buf =~ s/ +$//; $buf =~ s/\s+\(/\(/g; # remove spacing around '(' $buf =~ s/\(\s+/\(/g; $buf =~ s/\s+\)/\)/g; # remove spacing before ')' @parts = split(' ', $buf); $strt = ''; foreach $indx (@parts) { if ($indx =~ /([\w\-]+)\((\d+)\)/) { $ind = $1; $val = $2; if (exists($tOIDs{$strt})) { $tOIDs{$ind} = $tOIDs{$strt} . '.' . $val; } elsif ($strt ne '') { $tOIDs{$ind} = "${strt}.${val}"; } else { $tOIDs{$ind} = $val; } $strt = $ind; $tgot = 1; } elsif ($indx =~ /^\d+$/) { if (exists($tOIDs{$strt})) { $tOIDs{$var} = $tOIDs{$strt} . '.' . $indx; } else { $tOIDs{$var} = "${strt}.${indx}"; } $tgot = 1; } else { $strt = $indx; } } $buf = ''; } } $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $RevNeeded = 1 if ($cnt > 0); return $cnt; } # # Fill the OIDS hash with results from the MIB parsing # sub MIB_fill_OID ($) { my($href) = @_; my($cnt, $changed, @del, $var, $val, @parts, $indx); my(%seen); $cnt = 0; do { $changed = 0; @del = (); foreach $var (keys %$href) { $val = $href->{$var}; @parts = split('\.', $val); $val = ''; foreach $indx (@parts) { if ($indx =~ /^\d+$/) { $val .= '.' . $indx; } else { if (exists($SNMP_util::OIDS{$indx})) { $val = $SNMP_util::OIDS{$indx}; } else { $val .= '.' . $indx; } } } if ($val =~ /^[\d\.]+$/) { $val =~ s/^\.+//; if (!exists($SNMP_util::OIDS{$var}) || (length($val) > length($SNMP_util::OIDS{$var}))) { $SNMP_util::OIDS{$var} = $val; print "'$var' => '$val'\n" if $SNMP_util::Debug; $changed = 1; $cnt++; } push @del, $var; } } foreach $var (@del) { delete $href->{$var}; } } while($changed); $Carp::CarpLevel++; foreach $var (sort keys %$href) { $val = $href->{$var}; $val =~ s/\..*//; next if (exists($seen{$val})); $seen{$val} = 1; $seen{$var} = 1; carp "snmpMIB_to_OID: prefix \"$val\" unknown, load the parent MIB first.\n" unless ($SNMP_Session::suppress_warnings > 1); } $Carp::CarpLevel--; return $cnt; } sub encode_oid_with_errmsg ($) { my ($oid) = @_; my $tmp = encode_oid(split(/\./, $oid)); if (! defined $tmp) { carp "cannot encode Object ID $oid: $BER::errmsg" unless ($SNMP_Session::suppress_warnings > 1); return undef; } return $tmp; } 1; PK!mSNMP_Session.pmnu[### -*- mode: Perl -*- ###################################################################### ### SNMP Request/Response Handling ###################################################################### ### Copyright (c) 1995-2008, Simon Leinen. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### The abstract class SNMP_Session defines objects that can be used ### to communicate with SNMP entities. It has methods to send ### requests to and receive responses from an agent. ### ### Two instantiable subclasses are defined: ### SNMPv1_Session implements SNMPv1 (RFC 1157) functionality ### SNMPv2c_Session implements community-based SNMPv2. ###################################################################### ### Created by: Simon Leinen ### ### Contributions and fixes by: ### ### Matthew Trunnell ### Tobias Oetiker ### Heine Peters ### Daniel L. Needles ### Mike Mitchell ### Clinton Wong ### Alan Nichols ### Mike McCauley ### Andrew W. Elble ### Brett T Warden : pretty UInteger32 ### Michael Deegan ### Sergio Macedo ### Jakob Ilves (/IlvJa) : PDU capture ### Valerio Bontempi : IPv6 support ### Lorenzo Colitti : IPv6 support ### Philippe Simonet : Export avoid... ### Luc Pauwels : use_16bit_request_ids ### Andrew Cornford-Matheson : inform ### Gerry Dalton : strict subs bug ### Mike Fischer : pass MSG_DONTWAIT to recv() ###################################################################### package SNMP_Session; require 5.002; use strict; use Exporter; use vars qw(@ISA $VERSION @EXPORT $errmsg $suppress_warnings $default_avoid_negative_request_ids $default_use_16bit_request_ids); use Socket; use BER '1.05'; use Carp; sub map_table ($$$ ); sub map_table_4 ($$$$); sub map_table_start_end ($$$$$$); sub index_compare ($$); sub oid_diff ($$); $VERSION = '1.12'; @ISA = qw(Exporter); @EXPORT = qw(errmsg suppress_warnings index_compare oid_diff recycle_socket ipv6available); my $default_debug = 0; ### Default initial timeout (in seconds) waiting for a response PDU ### after a request is sent. Note that when a request is retried, the ### timeout is increased by BACKOFF (see below). ### my $default_timeout = 2.0; ### Default number of attempts to get a reply for an SNMP request. If ### no response is received after TIMEOUT seconds, the request is ### resent and a new response awaited with a longer timeout (see the ### documentation on BACKOFF below). The "retries" value should be at ### least 1, because the first attempt counts, too (the name "retries" ### is confusing, sorry for that). ### my $default_retries = 5; ### Default backoff factor for SNMP_Session objects. This factor is ### used to increase the TIMEOUT every time an SNMP request is ### retried. ### my $default_backoff = 1.0; ### Default value for maxRepetitions. This specifies how many table ### rows are requested in getBulk requests. Used when walking tables ### using getBulk (only available in SNMPv2(c) and later). If this is ### too small, then a table walk will need unnecessarily many ### request/response exchanges. If it is too big, the agent may ### compute many variables after the end of the table. It is ### recommended to set this explicitly for each table walk by using ### map_table_4(). ### my $default_max_repetitions = 12; ### Default value for "avoid_negative_request_ids". ### ### Set this to non-zero if you have agents that have trouble with ### negative request IDs, and don't forget to complain to your agent ### vendor. According to the spec (RFC 1905), the request-id is an ### Integer32, i.e. its range is from -(2^31) to (2^31)-1. However, ### some agents erroneously encode the response ID as an unsigned, ### which prevents this code from matching such responses to requests. ### $SNMP_Session::default_avoid_negative_request_ids = 0; ### Default value for "use_16bit_request_ids". ### ### Set this to non-zero if you have agents that use 16bit request IDs, ### and don't forget to complain to your agent vendor. ### $SNMP_Session::default_use_16bit_request_ids = 0; ### Whether all SNMP_Session objects should share a single UDP socket. ### $SNMP_Session::recycle_socket = 0; ### IPv6 initialization code: check that IPv6 libraries are available, ### and if so load them. ### We store the length of an IPv6 socket address structure in the class ### so we can determine if a socket address is IPv4 or IPv6 just by checking ### its length. The proper way to do this would be to use sockaddr_family(), ### but this function is only available in recent versions of Socket.pm. my $ipv6_addr_len; ### Flags to be passed to recv() when non-blocking behavior is ### desired. On most POSIX-like systems this will be set to ### MSG_DONTWAIT, on other systems we leave it at zero. ### my $dont_wait_flags; BEGIN { $ipv6_addr_len = undef; $SNMP_Session::ipv6available = 0; $dont_wait_flags = 0; if (eval {local $SIG{__DIE__};require Socket6;} && eval {local $SIG{__DIE__};require IO::Socket::INET6; IO::Socket::INET6->VERSION("1.26");}) { Socket6->import(qw(inet_pton getaddrinfo inet_ntop)); $ipv6_addr_len = length(pack_sockaddr_in6(161, inet_pton(AF_INET6(), "::1"))); $SNMP_Session::ipv6available = 1; } eval 'local $SIG{__DIE__};local $SIG{__WARN__};$dont_wait_flags = MSG_DONTWAIT();'; } my $the_socket; $SNMP_Session::errmsg = ''; $SNMP_Session::suppress_warnings = 0; sub get_request { 0 | context_flag () }; sub getnext_request { 1 | context_flag () }; sub get_response { 2 | context_flag () }; sub set_request { 3 | context_flag () }; sub trap_request { 4 | context_flag () }; sub getbulk_request { 5 | context_flag () }; sub inform_request { 6 | context_flag () }; sub trap2_request { 7 | context_flag () }; sub standard_udp_port { 161 }; sub open { return SNMPv1_Session::open (@_); } sub timeout { $_[0]->{timeout} } sub retries { $_[0]->{retries} } sub backoff { $_[0]->{backoff} } sub set_timeout { my ($session, $timeout) = @_; croak ("timeout ($timeout) must be a positive number") unless $timeout > 0.0; $session->{'timeout'} = $timeout; } sub set_retries { my ($session, $retries) = @_; croak ("retries ($retries) must be a non-negative integer") unless $retries == int ($retries) && $retries >= 0; $session->{'retries'} = $retries; } sub set_backoff { my ($session, $backoff) = @_; croak ("backoff ($backoff) must be a number >= 1.0") unless $backoff == int ($backoff) && $backoff >= 1.0; $session->{'backoff'} = $backoff; } sub encode_request_3 ($$$@) { my($this, $reqtype, $encoded_oids_or_pairs, $i1, $i2) = @_; my($request); local($_); $this->{request_id} = ($this->{request_id} == 0x7fffffff) ? -0x80000000 : $this->{request_id}+1; $this->{request_id} += 0x80000000 if ($this->{avoid_negative_request_ids} && $this->{request_id} < 0); $this->{request_id} &= 0x0000ffff if ($this->{use_16bit_request_ids}); foreach $_ (@{$encoded_oids_or_pairs}) { if (ref ($_) eq 'ARRAY') { $_ = &encode_sequence ($_->[0], $_->[1]) || return $this->ber_error ("encoding pair"); } else { $_ = &encode_sequence ($_, encode_null()) || return $this->ber_error ("encoding value/null pair"); } } $request = encode_tagged_sequence ($reqtype, encode_int ($this->{request_id}), defined $i1 ? encode_int ($i1) : encode_int_0 (), defined $i2 ? encode_int ($i2) : encode_int_0 (), encode_sequence (@{$encoded_oids_or_pairs})) || return $this->ber_error ("encoding request PDU"); return $this->wrap_request ($request); } sub encode_get_request { my($this, @oids) = @_; return encode_request_3 ($this, get_request, \@oids); } sub encode_getnext_request { my($this, @oids) = @_; return encode_request_3 ($this, getnext_request, \@oids); } sub encode_getbulk_request { my($this, $non_repeaters, $max_repetitions, @oids) = @_; return encode_request_3 ($this, getbulk_request, \@oids, $non_repeaters, $max_repetitions); } sub encode_set_request { my($this, @encoded_pairs) = @_; return encode_request_3 ($this, set_request, \@encoded_pairs); } sub encode_trap_request ($$$$$$@) { my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_; my($request); local($_); foreach $_ (@pairs) { if (ref ($_) eq 'ARRAY') { $_ = &encode_sequence ($_->[0], $_->[1]) || return $this->ber_error ("encoding pair"); } else { $_ = &encode_sequence ($_, encode_null()) || return $this->ber_error ("encoding value/null pair"); } } $request = encode_tagged_sequence (trap_request, $ent, $agent, $gen, $spec, $dt, encode_sequence (@pairs)) || return $this->ber_error ("encoding trap PDU"); return $this->wrap_request ($request); } sub encode_v2_trap_request ($@) { my($this, @pairs) = @_; return encode_request_3($this, trap2_request, \@pairs); } sub decode_get_response { my($this, $response) = @_; my @rest; @{$this->{'unwrapped'}}; } sub decode_trap_request ($$) { my ($this, $trap) = @_; my ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt, $request_id, $error_status, $error_index, $bindings); ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt, $bindings) = decode_by_template ($trap, "%{%i%s%*{%O%A%i%i%u%{%@", trap_request); if (!defined $snmp_version) { ($snmp_version, $community, $request_id, $error_status, $error_index, $bindings) = decode_by_template ($trap, "%{%i%s%*{%i%i%i%{%@", trap2_request); if (!defined $snmp_version) { ($snmp_version, $community,$request_id, $error_status, $error_index, $bindings) = decode_by_template ($trap, "%{%i%s%*{%i%i%i%{%@", inform_request); } return $this->error_return ("v2 trap/inform request contained errorStatus/errorIndex " .$error_status."/".$error_index) if defined $error_status && defined $error_index && ($error_status != 0 || $error_index != 0); } if (!defined $snmp_version) { return $this->error_return ("BER error decoding trap:\n ".$BER::errmsg); } return ($community, $ent, $agent, $gen, $spec, $dt, $bindings); } sub wait_for_response { my($this) = shift; my($timeout) = shift || 10.0; my($rin,$win,$ein) = ('','',''); my($rout,$wout,$eout); vec($rin,$this->sockfileno,1) = 1; select($rout=$rin,$wout=$win,$eout=$ein,$timeout); } sub get_request_response ($@) { my($this, @oids) = @_; return $this->request_response_5 ($this->encode_get_request (@oids), get_response, \@oids, 1); } sub set_request_response ($@) { my($this, @pairs) = @_; return $this->request_response_5 ($this->encode_set_request (@pairs), get_response, \@pairs, 1); } sub getnext_request_response ($@) { my($this,@oids) = @_; return $this->request_response_5 ($this->encode_getnext_request (@oids), get_response, \@oids, 1); } sub getbulk_request_response ($$$@) { my($this,$non_repeaters,$max_repetitions,@oids) = @_; return $this->request_response_5 ($this->encode_getbulk_request ($non_repeaters,$max_repetitions,@oids), get_response, \@oids, 1); } sub trap_request_send ($$$$$$@) { my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_; my($req); $req = $this->encode_trap_request ($ent, $agent, $gen, $spec, $dt, @pairs); ## Encoding may have returned an error. return undef unless defined $req; $this->send_query($req) || return $this->error ("send_trap: $!"); return 1; } sub v2_trap_request_send ($$$@) { my($this, $trap_oid, $dt, @pairs) = @_; my @sysUptime_OID = ( 1,3,6,1,2,1,1,3 ); my @snmpTrapOID_OID = ( 1,3,6,1,6,3,1,1,4,1 ); my($req); unshift @pairs, [encode_oid (@snmpTrapOID_OID,0), encode_oid (@{$trap_oid})]; unshift @pairs, [encode_oid (@sysUptime_OID,0), encode_timeticks ($dt)]; $req = $this->encode_v2_trap_request (@pairs); ## Encoding may have returned an error. return undef unless defined $req; $this->send_query($req) || return $this->error ("send_trap: $!"); return 1; } sub request_response_5 ($$$$$) { my ($this, $req, $response_tag, $oids, $errorp) = @_; my $retries = $this->retries; my $timeout = $this->timeout; my ($nfound, $timeleft); ## Encoding may have returned an error. return undef unless defined $req; $timeleft = $timeout; while ($retries > 0) { $this->send_query ($req) || return $this->error ("send_query: $!"); # IlvJa # Add request pdu to capture_buffer push @{$this->{'capture_buffer'}}, $req if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # wait_for_response: ($nfound, $timeleft) = $this->wait_for_response($timeleft); if ($nfound > 0) { my($response_length); $response_length = $this->receive_response_3 ($response_tag, $oids, $errorp, 1); if ($response_length) { # IlvJa # Add response pdu to capture_buffer push (@{$this->{'capture_buffer'}}, substr($this->{'pdu_buffer'}, 0, $response_length) ) if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # return $response_length; } elsif (defined ($response_length)) { goto wait_for_response; # A response has been received, but for a different # request ID or from a different IP address. } else { return undef; } } else { ## No response received - retry --$retries; $timeout *= $this->backoff; $timeleft = $timeout; } } # IlvJa # Add empty packet to capture_buffer push @{$this->{'capture_buffer'}}, "" if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # $this->error ("no response received"); } sub map_table ($$$) { my ($session, $columns, $mapfn) = @_; return $session->map_table_4 ($columns, $mapfn, $session->default_max_repetitions ()); } sub map_table_4 ($$$$) { my ($session, $columns, $mapfn, $max_repetitions) = @_; return $session->map_table_start_end ($columns, $mapfn, "", undef, $max_repetitions); } sub map_table_start_end ($$$$$$) { my ($session, $columns, $mapfn, $start, $end, $max_repetitions) = @_; my @encoded_oids; my $call_counter = 0; my $base_index = $start; do { foreach (@encoded_oids = @{$columns}) { $_=encode_oid (@{$_},split '\.',$base_index) || return $session->ber_error ("encoding OID $base_index"); } if ($session->getnext_request_response (@encoded_oids)) { my $response = $session->pdu_buffer; my ($bindings) = $session->decode_get_response ($response); my $smallest_index = undef; my @collected_values = (); my @bases = @{$columns}; while ($bindings ne '') { my ($binding, $oid, $value); my $base = shift @bases; ($binding, $bindings) = decode_sequence ($bindings); ($oid, $value) = decode_by_template ($binding, "%O%@"); my $out_index; $out_index = &oid_diff ($base, $oid); my $cmp; if (!defined $smallest_index || ($cmp = index_compare ($out_index,$smallest_index)) == -1) { $smallest_index = $out_index; grep ($_=undef, @collected_values); push @collected_values, $value; } elsif ($cmp == 1) { push @collected_values, undef; } else { push @collected_values, $value; } } (++$call_counter, &$mapfn ($smallest_index, @collected_values)) if defined $smallest_index; $base_index = $smallest_index; } else { return undef; } } while (defined $base_index && (!defined $end || index_compare ($base_index, $end) < 0)); $call_counter; } sub index_compare ($$) { my ($i1, $i2) = @_; $i1 = '' unless defined $i1; $i2 = '' unless defined $i2; if ($i1 eq '') { return $i2 eq '' ? 0 : 1; } elsif ($i2 eq '') { return 1; } elsif (!$i1) { return $i2 eq '' ? 1 : !$i2 ? 0 : 1; } elsif (!$i2) { return -1; } else { my ($f1,$r1) = split('\.',$i1,2); my ($f2,$r2) = split('\.',$i2,2); if ($f1 < $f2) { return -1; } elsif ($f1 > $f2) { return 1; } else { return index_compare ($r1,$r2); } } } sub oid_diff ($$) { my($base, $full) = @_; my $base_dotnot = join ('.',@{$base}); my $full_dotnot = BER::pretty_oid ($full); return undef unless substr ($full_dotnot, 0, length $base_dotnot) eq $base_dotnot && substr ($full_dotnot, length $base_dotnot, 1) eq '.'; substr ($full_dotnot, length ($base_dotnot)+1); } # Pretty_address returns a human-readable representation of an IPv4 or IPv6 address. sub pretty_address { my($addr) = shift; my($port, $addrunpack, $addrstr); # Disable strict subs to stop old versions of perl from # complaining about AF_INET6 when Socket6 is not available if( (defined $ipv6_addr_len) && (length $addr == $ipv6_addr_len)) { ($port,$addrunpack) = Socket6::unpack_sockaddr_in6 ($addr); $addrstr = inet_ntop (AF_INET6(), $addrunpack); } else { ($port,$addrunpack) = unpack_sockaddr_in ($addr); $addrstr = inet_ntoa ($addrunpack); } return sprintf ("[%s].%d", $addrstr, $port); } sub version { $VERSION; } sub error_return ($$) { my ($this,$message) = @_; $SNMP_Session::errmsg = $message; unless ($SNMP_Session::suppress_warnings) { $message =~ s/^/ /mg; carp ("Error:\n".$message."\n"); } return undef; } sub error ($$) { my ($this,$message) = @_; my $session = $this->to_string; $SNMP_Session::errmsg = $message."\n".$session; unless ($SNMP_Session::suppress_warnings) { $session =~ s/^/ /mg; $message =~ s/^/ /mg; carp ("SNMP Error:\n".$SNMP_Session::errmsg."\n"); } return undef; } sub ber_error ($$) { my ($this,$type) = @_; my ($errmsg) = $BER::errmsg; $errmsg =~ s/^/ /mg; return $this->error ("$type:\n$errmsg"); } package SNMPv1_Session; use strict qw(vars subs); # see above use vars qw(@ISA); use SNMP_Session; use Socket; use BER; use IO::Socket; use Carp; BEGIN { if($SNMP_Session::ipv6available) { import IO::Socket::INET6; Socket6->import(qw(inet_pton getaddrinfo inet_ntop)); } } @ISA = qw(SNMP_Session); sub snmp_version { 0 } # Supports both IPv4 and IPv6. # Numeric IPv6 addresses must be passed between square brackets [] sub open { my($this, $remote_hostname,$community,$port, $max_pdu_len,$local_port,$max_repetitions, $local_hostname,$ipv4only) = @_; my($remote_addr,$socket,$sockfamily); $ipv4only = 1 unless defined $ipv4only; $sockfamily = AF_INET; $community = 'public' unless defined $community; $port = SNMP_Session::standard_udp_port unless defined $port; $max_pdu_len = 8000 unless defined $max_pdu_len; $max_repetitions = $default_max_repetitions unless defined $max_repetitions; if ($ipv4only || ! $SNMP_Session::ipv6available) { # IPv4-only code, uses only Socket and INET calls if (defined $remote_hostname) { $remote_addr = inet_aton ($remote_hostname) or return $this->error_return ("can't resolve \"$remote_hostname\" to IP address"); } if ($SNMP_Session::recycle_socket && defined $the_socket) { $socket = $the_socket; } else { $socket = IO::Socket::INET->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); $the_socket = $socket if $SNMP_Session::recycle_socket; } $remote_addr = pack_sockaddr_in ($port, $remote_addr) if defined $remote_addr; } else { # IPv6-capable code. Will use IPv6 or IPv4 depending on the address. # Uses Socket6 and INET6 calls. # If it's a numeric IPv6 addresses, remove square brackets if ($remote_hostname =~ /^\[(.*)\]$/) { $remote_hostname = $1; } my (@res, $socktype_tmp, $proto_tmp, $canonname_tmp); @res = getaddrinfo($remote_hostname, $port, AF_UNSPEC, SOCK_DGRAM); ($sockfamily, $socktype_tmp, $proto_tmp, $remote_addr, $canonname_tmp) = @res; if (scalar(@res) < 5) { return $this->error_return ("can't resolve \"$remote_hostname\" to IPv6 address"); } if ($SNMP_Session::recycle_socket && defined $the_socket) { $socket = $the_socket; } elsif ($sockfamily == AF_INET) { $socket = IO::Socket::INET->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); } else { $socket = IO::Socket::INET6->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); $the_socket = $socket if $SNMP_Session::recycle_socket; } } bless { 'sock' => $socket, 'sockfileno' => fileno ($socket), 'community' => $community, 'remote_hostname' => $remote_hostname, 'remote_addr' => $remote_addr, 'sockfamily' => $sockfamily, 'max_pdu_len' => $max_pdu_len, 'pdu_buffer' => '\0' x $max_pdu_len, 'request_id' => (int (rand 0x10000) << 16) + int (rand 0x10000) - 0x80000000, 'timeout' => $default_timeout, 'retries' => $default_retries, 'backoff' => $default_backoff, 'debug' => $default_debug, 'error_status' => 0, 'error_index' => 0, 'default_max_repetitions' => $max_repetitions, 'use_getbulk' => 1, 'lenient_source_address_matching' => 1, 'lenient_source_port_matching' => 1, 'avoid_negative_request_ids' => $SNMP_Session::default_avoid_negative_request_ids, 'use_16bit_request_ids' => $SNMP_Session::default_use_16bit_request_ids, 'capture_buffer' => undef, }; } sub open_trap_session (@) { my ($this, $port) = @_; $port = 162 unless defined $port; return $this->open (undef, "", 161, undef, $port); } sub sock { $_[0]->{sock} } sub sockfileno { $_[0]->{sockfileno} } sub remote_addr { $_[0]->{remote_addr} } sub pdu_buffer { $_[0]->{pdu_buffer} } sub max_pdu_len { $_[0]->{max_pdu_len} } sub default_max_repetitions { defined $_[1] ? $_[0]->{default_max_repetitions} = $_[1] : $_[0]->{default_max_repetitions} } sub debug { defined $_[1] ? $_[0]->{debug} = $_[1] : $_[0]->{debug} } sub close { my($this) = shift; ## Avoid closing the socket if it may be shared with other session ## objects. if (! defined $the_socket || $this->sock ne $the_socket) { close ($this->sock) || $this->error ("close: $!"); } } sub wrap_request { my($this) = shift; my($request) = shift; encode_sequence (encode_int ($this->snmp_version), encode_string ($this->{community}), $request) || return $this->ber_error ("wrapping up request PDU"); } my @error_status_code = qw(noError tooBig noSuchName badValue readOnly genErr noAccess wrongType wrongLength wrongEncoding wrongValue noCreation inconsistentValue resourceUnavailable commitFailed undoFailed authorizationError notWritable inconsistentName); sub unwrap_response_5b { my ($this,$response,$tag,$oids,$errorp) = @_; my ($community,$request_id,@rest,$snmpver); ($snmpver,$community,$request_id, $this->{error_status}, $this->{error_index}, @rest) = decode_by_template ($response, "%{%i%s%*{%i%i%i%{%@", $tag); return $this->ber_error ("Error decoding response PDU") unless defined $snmpver; return $this->error ("Received SNMP response with unknown snmp-version field $snmpver") unless $snmpver == $this->snmp_version; if ($this->{error_status} != 0) { if ($errorp) { my ($oid, $errmsg); $errmsg = $error_status_code[$this->{error_status}] || $this->{error_status}; $oid = $oids->[$this->{error_index}-1] if $this->{error_index} > 0 && $this->{error_index}-1 <= $#{$oids}; $oid = $oid->[0] if ref($oid) eq 'ARRAY'; return ($community, $request_id, $this->error ("Received SNMP response with error code\n" ." error status: $errmsg\n" ." index ".$this->{error_index} .(defined $oid ? " (OID: ".&BER::pretty_oid($oid).")" : ""))); } else { if ($this->{error_index} == 1) { @rest[$this->{error_index}-1..$this->{error_index}] = (); } } } ($community, $request_id, @rest); } sub send_query ($$) { my ($this,$query) = @_; send ($this->sock,$query,0,$this->remote_addr); } ## Compare two sockaddr_in structures for equality. This is used when ## matching incoming responses with outstanding requests. Previous ## versions of the code simply did a bytewise comparison ("eq") of the ## two sockaddr_in structures, but this didn't work on some systems ## where sockaddr_in contains other elements than just the IP address ## and port number, notably FreeBSD. ## ## We allow for varying degrees of leniency when checking the source ## address. By default we now ignore it altogether, because there are ## agents that don't respond from UDP port 161, and there are agents ## that don't respond from the IP address the query had been sent to. ## ## The address family is stored in the session object. We could use ## sockaddr_family() to determine it from the sockaddr, but this function ## is only available in recent versions of Socket.pm. sub sa_equal_p ($$$) { my ($this, $sa1, $sa2) = @_; my ($p1,$a1,$p2,$a2); # Disable strict subs to stop old versions of perl from # complaining about AF_INET6 when Socket6 is not available if($this->{'sockfamily'} == AF_INET) { # IPv4 addresses ($p1,$a1) = unpack_sockaddr_in ($sa1); ($p2,$a2) = unpack_sockaddr_in ($sa2); } elsif($this->{'sockfamily'} == AF_INET6()) { # IPv6 addresses ($p1,$a1) = Socket6::unpack_sockaddr_in6 ($sa1); ($p2,$a2) = Socket6::unpack_sockaddr_in6 ($sa2); } else { return 0; } use strict "subs"; if (! $this->{'lenient_source_address_matching'}) { return 0 if $a1 ne $a2; } if (! $this->{'lenient_source_port_matching'}) { return 0 if $p1 != $p2; } return 1; } sub receive_response_3 { my ($this, $response_tag, $oids, $errorp, $dont_block_p) = @_; my ($remote_addr); my $flags = 0; $flags = $dont_wait_flags if defined $dont_block_p and $dont_block_p; $remote_addr = recv ($this->sock,$this->{'pdu_buffer'},$this->max_pdu_len,$flags); return $this->error ("receiving response PDU: $!") unless defined $remote_addr; return $this->error ("short (".length $this->{'pdu_buffer'} ." bytes) response PDU") unless length $this->{'pdu_buffer'} > 2; my $response = $this->{'pdu_buffer'}; ## ## Check whether the response came from the address we've sent the ## request to. If this is not the case, we should probably ignore ## it, as it may relate to another request. ## if (defined $this->{'remote_addr'}) { if (! $this->sa_equal_p ($remote_addr, $this->{'remote_addr'})) { if ($this->{'debug'} && !$SNMP_Session::recycle_socket) { carp ("Response came from ".&SNMP_Session::pretty_address($remote_addr) .", not ".&SNMP_Session::pretty_address($this->{'remote_addr'})) unless $SNMP_Session::suppress_warnings; } return 0; } } $this->{'last_sender_addr'} = $remote_addr; my ($response_community, $response_id, @unwrapped) = $this->unwrap_response_5b ($response, $response_tag, $oids, $errorp); if ($response_community ne $this->{community} || $response_id ne $this->{request_id}) { if ($this->{'debug'}) { carp ("$response_community != $this->{community}") unless $SNMP_Session::suppress_warnings || $response_community eq $this->{community}; carp ("$response_id != $this->{request_id}") unless $SNMP_Session::suppress_warnings || $response_id == $this->{request_id}; } return 0; } if (!defined $unwrapped[0]) { $this->{'unwrapped'} = undef; return undef; } $this->{'unwrapped'} = \@unwrapped; return length $this->pdu_buffer; } sub receive_trap { my ($this) = @_; my ($remote_addr, $iaddr, $port, $trap); $remote_addr = recv ($this->sock,$this->{'pdu_buffer'},$this->max_pdu_len,0); return undef unless $remote_addr; if( (defined $ipv6_addr_len) && (length $remote_addr == $ipv6_addr_len)) { ($port,$iaddr) = Socket6::unpack_sockaddr_in6($remote_addr); } else { ($port,$iaddr) = unpack_sockaddr_in($remote_addr); } $trap = $this->{'pdu_buffer'}; return ($trap, $iaddr, $port); } sub describe { my($this) = shift; print $this->to_string (),"\n"; } sub to_string { my($this) = shift; my ($class,$prefix); $class = ref($this); $prefix = ' ' x (length ($class) + 2); ($class .(defined $this->{remote_hostname} ? " (remote host: \"".$this->{remote_hostname}."\"" ." ".&SNMP_Session::pretty_address ($this->remote_addr).")" : " (no remote host specified)") ."\n" .$prefix." community: \"".$this->{'community'}."\"\n" .$prefix." request ID: ".$this->{'request_id'}."\n" .$prefix."PDU bufsize: ".$this->{'max_pdu_len'}." bytes\n" .$prefix." timeout: ".$this->{timeout}."s\n" .$prefix." retries: ".$this->{retries}."\n" .$prefix." backoff: ".$this->{backoff}.")"); ## sprintf ("SNMP_Session: %s (size %d timeout %g)", ## &SNMP_Session::pretty_address ($this->remote_addr),$this->max_pdu_len, ## $this->timeout); } ### SNMP Agent support ### contributed by Mike McCauley ### sub receive_request { my ($this) = @_; my ($remote_addr, $iaddr, $port, $request); $remote_addr = recv($this->sock, $this->{'pdu_buffer'}, $this->{'max_pdu_len'}, 0); return undef unless $remote_addr; if( (defined $ipv6_addr_len) && (length $remote_addr == $ipv6_addr_len)) { ($port,$iaddr) = Socket6::unpack_sockaddr_in6($remote_addr); } else { ($port,$iaddr) = unpack_sockaddr_in($remote_addr); } $request = $this->{'pdu_buffer'}; return ($request, $iaddr, $port); } sub decode_request { my ($this, $request) = @_; my ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings); ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::get_request); if (defined $snmp_version) { # Its a valid get_request return(SNMP_Session::get_request, $requestid, $bindings, $community); } ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::getnext_request); if (defined $snmp_version) { # Its a valid getnext_request return(SNMP_Session::getnext_request, $requestid, $bindings, $community); } ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::set_request); if (defined $snmp_version) { # Its a valid set_request return(SNMP_Session::set_request, $requestid, $bindings, $community); } # Something wrong with this packet # Decode failed return undef; } package SNMPv2c_Session; use strict qw(vars subs); # see above use vars qw(@ISA); use SNMP_Session; use BER; use Carp; @ISA = qw(SNMPv1_Session); sub snmp_version { 1 } sub open { my $session = SNMPv1_Session::open (@_); return undef unless defined $session; return bless $session; } ## map_table_start_end using get-bulk ## sub map_table_start_end ($$$$$$) { my ($session, $columns, $mapfn, $start, $end, $max_repetitions) = @_; my @encoded_oids; my $call_counter = 0; my $base_index = $start; my $ncols = @{$columns}; my @collected_values = (); if (! $session->{'use_getbulk'}) { return SNMP_Session::map_table_start_end ($session, $columns, $mapfn, $start, $end, $max_repetitions); } $max_repetitions = $session->default_max_repetitions unless defined $max_repetitions; for (;;) { foreach (@encoded_oids = @{$columns}) { $_=encode_oid (@{$_},split '\.',$base_index) || return $session->ber_error ("encoding OID $base_index"); } if ($session->getbulk_request_response (0, $max_repetitions, @encoded_oids)) { my $response = $session->pdu_buffer; my ($bindings) = $session->decode_get_response ($response); my @colstack = (); my $k = 0; my $j; my $min_index = undef; my @bases = @{$columns}; my $n_bindings = 0; my $binding; ## Copy all bindings into the colstack. ## The colstack is a vector of vectors. ## It contains one vector for each "repeater" variable. ## while ($bindings ne '') { ($binding, $bindings) = decode_sequence ($bindings); my ($oid, $value) = decode_by_template ($binding, "%O%@"); push @{$colstack[$k]}, [$oid, $value]; ++$k; $k = 0 if $k >= $ncols; } ## Now collect rows from the column stack: ## ## Iterate through the column stacks to find the smallest ## index, collecting the values for that index in ## @collected_values. ## ## As long as a row can be assembled, the map function is ## called on it and the iteration proceeds. ## $base_index = undef; walk_rows_from_pdu: for (;;) { my $min_index = undef; for ($k = 0; $k < $ncols; ++$k) { $collected_values[$k] = undef; my $pair = $colstack[$k]->[0]; unless (defined $pair) { $min_index = undef; last walk_rows_from_pdu; } my $this_index = SNMP_Session::oid_diff ($columns->[$k], $pair->[0]); if (defined $this_index) { my $cmp = !defined $min_index ? -1 : SNMP_Session::index_compare ($this_index, $min_index); if ($cmp == -1) { for ($j = 0; $j < $k; ++$j) { unshift (@{$colstack[$j]}, [$min_index, $collected_values[$j]]); $collected_values[$j] = undef; } $min_index = $this_index; } if ($cmp <= 0) { $collected_values[$k] = $pair->[1]; shift @{$colstack[$k]}; } } } ($base_index = undef), last if !defined $min_index; last if defined $end and SNMP_Session::index_compare ($min_index, $end) >= 0; &$mapfn ($min_index, @collected_values); ++$call_counter; $base_index = $min_index; } } else { return undef; } last if !defined $base_index; last if defined $end and SNMP_Session::index_compare ($base_index, $end) >= 0; } $call_counter; } 1; PK!ۭlocales_mrtg.pmnu[# -*- mode: Perl -*- ###################################################################### ### Localization of mrtg output pages ###################################################################### # # # This is a generated perl module file. # # Please see the perl script mergelocale.pl and the language # # databasefiles skelton.pm0 and locale.*.pmd in translate/. # # If you want to contribute to mrtg change in the *.pmd files. # # If you just want to change your own mrtg: Go ahead and edit! # # # ###################################################################### ### Defines programs which handles centralized pattern matching and pattern ### replacements in order to translate the given strings ###################################################################### ### Created by: Morten Storgaard Nielsen ################################################################### # # Distributed under the GNU copyleft # ################################################################### ### Locale by: ### Belarusian/Беларуская ### => Глеб Валошка <375gnu@gmail.com> ### Chinese/c ### => Tate Chen @ ### => Ryan Huang F ### Brazil/Brazilian Portuguese ### => Luiz Felipe R E ### => Gleydson Mazoli da Silva (Atualizao) ### Bulgarian/ ### => Yovko Lambrev ### catalan/Catal ### => LLus Gras ### Simplified Chinese/ ### => ƻ ### => QQ:582955 ӭFreeBSD ### => ԭĴ.°汾. ### cn/ĺ ### =>  ### => MSN:chenguang2001@hotmail.com FreeBSD Fan ### => MRTG. ### Croatian/Hrvatski ### => Dinko Korunic ### Czech/esky ### => Martin Och ### Czech/Česky ### => David Toman ### Danish/Dansk ### => Morten Storgaard Nielsen ### Dutch/Nederlands ### => Barry van Dijk ### Estonian/Eesti ### => Klemens Kasemaa ### ܸ(EUC-JP) ### => Fuminori Uematsu ### Finnish/Suomi ### => Jussi Siponen ### French/Francais ### => Fabrice Prigent ### and Stphane Marzloff ### Galician/Galego ### => David Garabana Barro ### Chinese/庺 ### => Zhanghui Ż ### Chinese/ļ ### => Peter Wong ### German/Deutsch ### => Ilja Pavkovic ### Greek/Ellinika ### => Simos Xenitellis ### Hungarian/Magyar ### => Levente Nagy ### Icelandic/Islenska ### => Halldor Karl Hgnason ### Indonesian/Indonesia ### => Jamaludin Ahmad ### taken from malaysian translation ### by Assakhof Ab. Satar ### $BF|K\8l(B(ISO-2022-JP) ### => Fuminori Uematsu ### Italian/Italiano ### => Andrea Rossi ### Korean ### => Kensoon Hwang ### CHOI Junho ### Lithuanian/Lietuvikai ### => ve ### Macedonian/Makedonski ### => Delev Zoran ### Malaysian/Malay ### => Assakhof Ab. Satar ### Norwegian/norsk ### => Knut Grneng Lukasz Jokiel ### Portuguese/Portugus ### => Diogo Gomes ### Romn/Romanian ### => Jzsef Szilgyi ### Russian/ ### => ### Russian1251/1251 ### => ### Serbian/Srpski ### => Ratko Bucic ### Slovak/Slovensky ### => Ladislav Mihok ### Slovenian/Slovensko ### => Aljosa Us ### Spanish/Espaol ### => Marcelo Roccasalva ### Swedish/Svenska ### => Clas Mayer ### Turkish/Trke ### => zgr C. Demir ### Ukrainian/ ### => Ǧ ͦΦ ### Ukrainian/ ### => Olexander Kunytsa ### ### Contributions and fixes by: ### ### 0.05 fixed DARK GREEN entry (msn@ipt.dtu.dk) ### fixed credits for native language (msn@ipt.dtu.dk) ### 0.06 added the PATCHTAGs (msn@ipt.dtu.dk) ### fixed several small errors (msn@ipt.dtu.dk) ### 0.07 changed PATCHTAG to support ### mergelocale.pl (msn@ipt.dtu.dk) ### ###################################################################### ### package locales_mrtg; require 5.002; # make sure we do not get hit by UTF-8 here no locale; use strict; use vars qw(@ISA @EXPORT $VERSION); use Exporter; $VERSION = '0.07'; @ISA = qw(Exporter); @EXPORT = qw ( &english &belarusian &big5 &brazilian &bulgarian &catalan &chinese &cn &croatian &czech &czechutf8 &danish &dutch &estonian &eucjp &german &french &galician &gb &gb2312 &german &greek &hungarian &icelandic &indonesia &iso2022jp &italian &korean &lithuanian &macedonian &malay &norwegianh &polish &portuguese &romanian &russian &russian1251 &serbian &slovak &slovenian &spanish &swedish &turkish &ukrainian &ukrainian1251 ); %lang2tran::LOCALE= ( 'english' => \&english, 'default' => \&english, 'belarusian' => \&belarusian, 'беларуская' => \&belarusian, 'big5' => \&big5, 'c' => \&big5, 'brazil' => \&brazilian, 'brazilian' => \&brazilian, 'bulgarian' => \&bulgarian, '' => \&bulgarian, 'catalan' => \&catalan, 'catalan' => \&catalan, 'chinese' => \&chinese, '' => \&chinese, 'cn' => \&cn, 'ĺ' => \&cn, 'croatian' => \&croatian, 'hrvatski' => \&croatian, 'czech' => \&czech, 'czechutf8' => \&czechutf8, 'danish' => \&danish, 'dansk' => \&danish, 'dutch' => \&dutch, 'nederlands' => \&dutch, 'estonian' => \&estonian, 'eesti' => \&estonian, 'eucjp' => \&eucjp, 'euc-jp' => \&eucjp, 'finnish' => \&finnish, 'suomi' => \&finnish, 'french' => \&french, 'francais' => \&french, 'galician' => \&galician, 'galego' => \&galician, 'gb' => \&gb, '庺' => \&gb, 'gb2312' => \&gb2312, 'ļ' => \&gb2312, 'german' => \&german, 'german' => \&german, 'greek' => \&greek, 'ellinika' => \&greek, 'hungarian' => \&hungarian, 'magyar' => \&hungarian, 'icelandic' => \&icelandic, 'islenska' => \&icelandic, 'indonesia' => \&indonesia, 'indonesian' => \&indonesia, 'iso2022jp' => \&iso2022jp, 'iso-2022-jp' => \&iso2022jp, 'italian' => \&italian, 'italiano' => \&italian, 'korean' => \&korean, 'lithuanian' => \&lithuanian, 'lietuvikai' => \&lithuanian, 'macedonian' => \&macedonian, 'makedonski' => \&macedonian, 'malay' => \&malay, 'malaysian' => \&malay, 'norwegian' => \&norwegian, 'norsk' => \&norwegian, 'polish' => \&polish, 'polski' => \&polish, 'portuguese' => \&portuguese, 'romanian' => \&romanian, 'romn' => \&romanian, 'russian' => \&russian, '' => \&russian, 'russian1251' => \&russian1251, '1251' => \&russian1251, 'serbian' => \&serbian, 'slovak' => \&slovak, 'slovenian' => \&slovenian, 'spanish' => \&spanish, 'espanol' => \&spanish, 'swedish' => \&swedish, 'svenska' => \&swedish, 'turkish' => \&turkish, 'turkce' => \&turkish, 'ukrainian' => \&ukrainian, '' => \&ukrainian, 'ukrainian1251' => \&ukrainian1251, '1251' => \&ukrainian1251, ); %credits::LOCALE= ( # default 'default' => "Prepared for localization by Morten S. Nielsen <msn\@ipt.dtu.dk>", # Belarusian/беларуская 'belarusian' => "Беларускі пераклад: Глеб Валошка <375gnu\@gmail.com>", # Chinese/c 'big5' => "Ƨ@ Tate Chen <tate\@joy-tech.com.tw>
and F <ryan\@asplord.com>", # Brazil/brazilian 'brazilian' => "Localização efetuada por Luiz Felipe R E <luizfelipe\@encarnacao.com>
atualizao por Gleydson Mazioli da Silva <gleydson\@debian.org>", # Bulgarian/ 'bulgarian' => " : <yovko\@sdf.lonestar.org>", # catalan/catalan 'catalan' => "Preparat per a localitzaci per: LLus Gras", # Simplified Chinese/ 'chinese' => "ȫ¼ĺ ƻ <webmaster\@kingisme.com>", # cn/ĺ 'cn' => "
MRTG <zurkabsd\@yahoo.com.cn>", # Croatian/hrvatski 'croatian' => "Hrvatska lokalizacija - Dinko Korunic <kreator\@fly.srk.fer.hr>", # Czech/esky 'czech' => "esk peklad pipravil Martin Och <martin\@och.cz>", # Czechutf8/Česky 'czechutf8' => "Český překlad do UTF-8 připravil David Toman <david\@idkfa.cz>", # Danish/dansk 'danish' => "Forberedt for sprog samt oversat til dansk af Morten S. Nielsen <msn\@ipt.dtu.dk>", # the danish string means: "Prepared for languages and translated to danish by" # Dutch/nederlands 'dutch' => "Vertaald naar het Nederlands door Barry van Dijk <barry\@dijk.com>
; Aangepast door Paul Slootman <paul\@debian.org>", # Estonian/Eesti 'estonian' => "Tõlge eesti keelde Klemens Kasemaa <klem\@linux.ee>", # the estonian string means: "Translation to estonian by" # eucjp/euc-jp 'eucjp' => "ܸ(EUC-JP) ʸ <uematsu\@kgz.com>", # Finnish/Suomi 'finnish' => "Lokalisoinut Jussi Siponen <jussi.siponen\@online.tietokone.fi>", # the Finnish string means: "Localized by" # French/francais 'french' => "Localisation effectuée par Fabrice Prigent <fabrice.prigent\@univ-tlse1.fr>", # Galician/Galego 'galician' => "Traducido ao galego por David Garabana Barro <dgaraban\@arrakis.es>", # Chinese/庺 'gb' => "Ƨ@ Hui Zhang <zhanghui\@asiainfo.com>", # Chinese/ļ 'gb2312' => "Ļ Peter Wong &webmaster\@tcpip.com.cn>", # German/deutsch 'german' => "Vorbereitet für die Lokalisation von Ilja Pavkovic <illsen\@gumblfarz.de>", # Greek/Ellinika 'greek' => " <S.Xenitellis\@hellug.gr>", # Hungarian/magyar 'hungarian' => "Magyarosította Nagy Levente <levinet\@euroweb.hu>", # the hungarian string means: "Prepared for languages and translated to Hungarian by" # Icelandic/islenska 'icelandic' => "Þýtt yfir á íslensku af Halldór Karl Högnason <halldor.hognason\@islandssimi.is>", # Indonesian/Indonesia 'indonesia' => "Terjemahan ke bahasa Indonesia oleh: Jamaludin Ahmad <jamaludin\@jamalinux.com>", # iso2022jp/iso-2022-jp 'iso2022jp' => "\e\$BF|K\\8lLu\e(B(ISO-2022-JP)\e\$B:n\@.\e(B \e\$B?\">>\e(B \e\$BJ8FA\e(B <uematsu\@kgz.com>", # Italian/Italiano 'italian' => "Localizzazione effettuata da Andrea Rossi <rouge\@shiny.it>", # korean ,'korean' => "ѱ۸޽ : ȲǼ, ȣ", # Lithuanian/lietuvikai 'lithuanian' => "Paruo ir lietuvi kalb ivert ve <ve\@hardcore.lt>", # the lithuanian string means: "Prepared for languages and translated to lithuanian by" # Macedonian/makedonski 'macedonian' => "Makedonska lokalizacija - Delev D Zoran <delevz\@esmak.com.mk>", # the macedonian string means: "Prepared for languages and translated to macedonian by" # Malaysian/Malay 'malay' => "Terjemahan ke bahasa Malaysia/Indonesia oleh: Assakhof Ab. Satar <assakhof\@mimos.my>", # Danish/dansk 'norwegian' => "Oversatt til norsk av Knut Grneng <knut.groneng\@merkantildata.no>", # the norwegian string means: "Translated to norwegian by" # Polish/polski 'polish' => "Polska lokalizacja Lukasz Jokiel <Lukasz.Jokiel\@klonex.com.pl>", # Portugus/portuguese 'portuguese' => "Traduzido por Diogo Gomes <etdgomes\@ua.pt>", # Romn/romanian 'romanian' => "Tradus de Jzsef Szilgyi <jozsi\@maxiq.ro>", # Russian/ 'russian' => " : <mitya\@cavia.pp.ru>", # Russian1251/1251 'russian1251' => " ( 1251): <aredyuk\@irmcity.com>", # Serbian/Srpski 'serbian' => "Ported to Serbian by / Srpski prevod uradio: Ratko Bui <ratko\@ni.ac.yu>", # Slovak/Slovensky 'slovak' => "Slovensk preklad pripravil Ing. Ladislav Mihok <laco\@mrokh.shmu.sk>", # Slovenian/Slovensko 'slovenian' => "Slovenski prevod pripravil Ragnar Belial Us <us\@sweet-sorrow.com>", # Spanish/espaol 'spanish' => "Preparado para localizacin por Marcelo Roccasalva", # Swedish/Svenska 'swedish' => "Översatt till svenska av Clas Mayer <clas\@mayer.se>", # the Swedish string means: "Prepared for languages and translated to Swedish by" # Turkish/Trke 'turkish' => "Trkeletiren zgr C. Demir", # Ukrainian/ 'ukrainian' => " : Ǧ ͦΦ <gray\@arte-fact.net>", # Ukrainian1251/1251 'ukrainian1251' => " (cp1251): <xakep\@snark.ukma.kiev.ua>", ); $credits::LOCALE{'беларуская'}=$credits::LOCALE{'belarusian'}; $credits::LOCALE{'c'}=$credits::LOCALE{'big5'}; $credits::LOCALE{'brazil'}=$credits::LOCALE{'brazilian'}; $credits::LOCALE{''}=$credits::LOCALE{'bulgarian'}; $credits::LOCALE{'catalan'}=$credits::LOCALE{'catalan'}; $credits::LOCALE{''}=$credits::LOCALE{'Chinese'}; $credits::LOCALE{'ĺ'}=$credits::LOCALE{'cn'}; $credits::LOCALE{'hrvatski'}=$credits::LOCALE{'croatian'}; $credits::LOCALE{'czech'}=$credits::LOCALE{'czech'}; $credits::LOCALE{'czechutf8'}=$credits::LOCALE{'czechutf8'}; $credits::LOCALE{'dansk'}=$credits::LOCALE{'danish'}; $credits::LOCALE{'nederlands'}=$credits::LOCALE{'dutch'}; $credits::LOCALE{'eesti'}=$credits::LOCALE{'estonian'}; $credits::LOCALE{'euc-jp'}=$credits::LOCALE{'eucjp'}; $credits::LOCALE{'finnish'}=$credits::LOCALE{'finnish'}; $credits::LOCALE{'francais'}=$credits::LOCALE{'french'}; $credits::LOCALE{'galego'}=$credits::LOCALE{'galician'}; $credits::LOCALE{'庺'}=$credits::LOCALE{'gb'}; $credits::LOCALE{'ļ'}=$credits::LOCALE{'gb2312'}; $credits::LOCALE{'deutsch'}=$credits::LOCALE{'german'}; $credits::LOCALE{'ellinika'}=$credits::LOCALE{'greek'}; $credits::LOCALE{'magyar'}=$credits::LOCALE{'hungarian'}; $credits::LOCALE{'islenska'}=$credits::LOCALE{'icelandic'}; $credits::LOCALE{'indonesian'}=$credits::LOCALE{'indonesia'}; $credits::LOCALE{'iso-2022-jp'}=$credits::LOCALE{'iso2022jp'}; $credits::LOCALE{'italiano'}=$credits::LOCALE{'italian'}; $credits::LOCALE{'korean'}=$credits::LOCALE{'korean'}; $credits::LOCALE{'lietuvikai'}=$credits::LOCALE{'lithuanian'}; $credits::LOCALE{'macedonian'}=$credits::LOCALE{'macedonian'}; $credits::LOCALE{'malaysian'}=$credits::LOCALE{'malay'}; $credits::LOCALE{'norsk'}=$credits::LOCALE{'norwegian'}; $credits::LOCALE{'polski'}=$credits::LOCALE{'polish'}; $credits::LOCALE{'portuguese'}=$credits::LOCALE{'portuguese'}; $credits::LOCALE{'romn'}=$credits::LOCALE{'romanian'}; $credits::LOCALE{''}=$credits::LOCALE{'russian'}; $credits::LOCALE{'1251'}=$credits::LOCALE{'russian1251'}; $credits::LOCALE{'serbian'}=$credits::LOCALE{'serbian'}; $credits::LOCALE{'slovak'}=$credits::LOCALE{'slovak'}; $credits::LOCALE{'slovenian'}=$credits::LOCALE{'slovenian'}; $credits::LOCALE{'espanol'}=$credits::LOCALE{'spanish'}; $credits::LOCALE{'svenska'}=$credits::LOCALE{'swedish'}; $credits::LOCALE{'turkce'}=$credits::LOCALE{'turkish'}; $credits::LOCALE{''}=$credits::LOCALE{'ukrainian'}; $credits::LOCALE{'1251'}=$credits::LOCALE{'ukrainian1251'}; # English - default sub english { return shift; }; # Belarusian sub belarusian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=utf-8 %translations = ( 'iso-8859-1' => 'utf-8', 'Maximal 5 Minute Incoming Traffic' => 'Найбольшы ўваходны трафік за 5 хвілін', 'Maximal 5 Minute Outgoing Traffic' => 'Найбольшы выходны трафік за 5 хвілін', 'the device' => 'прылада', 'The statistics were last updated(.*)' => 'Апошні раз статыстыка абнаўлялася: $1', ' Average\)' => ')', 'Average' => 'спасярэднены', 'Max' => 'найбольшы', 'Current' => 'бягучы', 'version' => 'вэрсія', '`Daily\' Graph \((.*) Minute' => 'Графік трафіку за суткі (за $1 хвілін ', '`Weekly\' Graph \(30 Minute' => 'Графік трафіку за тыдзень (за 30 хвілін ', '`Monthly\' Graph \(2 Hour' => 'Графік трафіку за месяц (за 2 гадзіны ', '`Yearly\' Graph \(1 Day' => 'Графік трафіку за год (за 1 дзень ', 'Incoming Traffic in (\S+) per Second' => 'Уваходны трафік $1 за сэкунду', 'Outgoing Traffic in (\S+) per Second' => 'Выходны трафік $1 за сэкунду', 'Incoming Traffic in (\S+) per Minute' => 'Уваходны трафік $1 за хвіліну', 'Outgoing Traffic in (\S+) per Minute' => 'Выходны трафік $1 за хвіліну', 'Incoming Traffic in (\S+) per Hour' => 'Уваходны трафік $1 за гадзіну', 'Outgoing Traffic in (\S+) per Hour' => 'Выходны трафік $1 за гадзіну', 'at which time (.*) had been up for(.*)' => 'калі $1 працаваў $2', '(\S+) per minute' => '$1 за хвіліну', '(\S+) per hour' => '$1 за гадзіну', '(.+)/s$' => '$1/с', '(.+)/min' => '$1/хв', '(.+)/h$' => '$1/г', '([kMG]?)([bB])/s' => '$1$2/с', '([kMG]?)([bB])/min' => '$1$2/хв', '([kMG]?)([bB])/h' => '$1$2/г', 'Bits' => 'бітах', 'Bytes' => 'байтах', 'In' => 'Уваходны', 'Out' => 'Выходны', 'Percentage' => 'Адсоткі', 'Ported to OpenVMS Alpha by' => 'Перанос на OpenVMS:', 'Ported to WindowsNT by' => 'Перанос на WindowsNT:', 'and' => 'і', '^GREEN' => 'ЗЯЛЁНЫ', 'BLUE' => 'СІНІ', 'DARK GREEN' => 'ЦЁМНАЗЯЛЁНЫ', 'MAGENTA' => 'РУЖОВЫ', 'AMBER' => 'БУРШТЫНАВЫ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Нядзеля', 'Sun' => 'Нд', 'Monday' => 'Панядзелак', 'Mon' => 'Пн', 'Tuesday' => 'Аўторак', 'Tue' => 'Аў', 'Wednesday' => 'Серада', 'Wed' => 'Ср', 'Thursday' => 'Чацьвер', 'Thu' => 'Чц', 'Friday' => 'Пятніца', 'Fri' => 'Пт', 'Saturday' => 'Субота', 'Sat' => 'Сб' ); %month = ( 'January' => 'Студзень', 'February' => 'Люты' , 'March' => 'Сакавік', 'Jan' => 'Сту', 'Feb' => 'Лют', 'Mar' => 'Сак', 'April' => 'Красавік', 'May' => 'Травень', 'June' => 'Чэрвень', 'Apr' => 'Кра', 'May' => 'Тра', 'Jun' => 'Чэр', 'July' => 'Ліпень', 'August' => 'Жнівень', 'September' => 'Верасень', 'Jul' => 'Ліп', 'Aug' => 'Жні', 'Sep' => 'Вер', 'October' => 'Кастрычнік','November' => 'Лістапад', 'December' => 'Сьнежань', 'Oct' => 'Кас', 'Nov' => 'Ліс', 'Dec' => 'Сьн' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." у ".$quux[1]; }; return "$wday{$foo[0]}, $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Chinese Big5 Code sub big5 { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'big5', 'Maximal 5 Minute Incoming Traffic' => '5̤jyJq', 'Maximal 5 Minute Outgoing Traffic' => '5̤jyXq', 'the device' => '˸m', 'The statistics were last updated(.*)' => 'Wέpsɶ: $1', ' Average\)' => ' )', 'Average' => '', 'Max$' => '̤j', 'Current' => 'ثe', 'version' => '', '`Daily\' Graph \((.*) Minute' => 'C Ϫ ($1 ', '`Weekly\' Graph \(30 Minute' => 'Cg Ϫ (30 ' , '`Monthly\' Graph \(2 Hour' => 'C Ϫ (2 p', '`Yearly\' Graph \(1 Day' => 'C~ Ϫ (1 ', 'Incoming Traffic in (\S+) per Second' => 'CyJq ( $1)', 'Outgoing Traffic in (\S+) per Second' => 'CyXq ( $1)', 'Incoming Traffic in (\S+) per Minute' => 'CyJq ( $1)', 'Outgoing Traffic in (\S+) per Minute' => 'CyXq ( $1)', 'Incoming Traffic in (\S+) per Hour' => 'CpɬyJq ( $1)', 'Outgoing Traffic in (\S+) per Hour' => 'CpɬyXq ( $1)', 'at which time (.*) had been up for(.*)' => ']ƦW $1AwB@ɶ(UPTIME): $2', '(\S+) per minute' => '$1/', '(\S+) per hour' => '$1/p', '(.+)/s$' => '$1/', '(.+)/min$' => '$1/', '(.+)/h$' => '$1/p', #'([kMG]?)([bB])/s' => '$1$2/s', #'([kMG]?)([bB])/min' => '$1$2/min', #'([kMG]?)([bB])/h' => '$1$2/std', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'yJ', 'Out$' => 'yX', 'Percentage' => 'ʤ', 'Ported to OpenVMS Alpha by' => 'Ө OpenVM Alpha @', 'Ported to WindowsNT by' => 'Ө WindowsNT @', 'and' => '', '^GREEN' => '', 'BLUE' => 'Ŧ', 'DARK GREEN' => '', 'MAGENTA' => '', 'AMBER' => '[Ħ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'P', 'Sun' => '', 'Monday' => 'P@', 'Mon' => '@', 'Tuesday' => 'PG', 'Tue' => 'G', 'Wednesday' => 'PT', 'Wed' => 'T', 'Thursday' => 'P|', 'Thu' => '|', 'Friday' => 'P', 'Fri' => '', 'Saturday' => 'P', 'Sat' => '' ); %month = ( 'January' => '@', 'February' => 'G', 'March' => 'T', 'Jan' => '@', 'Feb' => 'G', 'Mar' => 'T', 'April' => '|', 'May' => '', 'June' => '', 'Apr' => '|', 'May' => '', 'Jun' => '', 'July' => 'C', 'August' => 'K', 'September' => 'E', 'Jul' => 'C', 'Aug' => 'K', 'Sep' => 'E', 'October' => 'Q', 'November' => 'Q@', 'December' => 'QG', 'Oct' => 'Q', 'Nov' => 'Q@', 'Dec' => 'QG' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return "$foo[3] ~ $month{$foo[2]} $foo[1] $wday{$foo[0]} $foo[4]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Brazilian (Portugues) sub brazilian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tráfego Máximo de Entrada em 5 minutos', 'Maximal 5 Minute Outgoing Traffic' => 'Tráfego Máximo de Saída em 5 minutos', 'the device' => 'dispositivo', 'The statistics were last updated (.*)' => 'Última atualização das estatísticas: $1', ' Average\)' => ' - média)', 'Average' => 'Média', 'Max' => 'Máx', 'Current' => 'Atual', 'version' => 'versão', '`Daily\' Graph \((.*) Minute' => 'Gráfico `Diário\' ($1 minutos', '`Weekly\' Graph \(30 Minute' => 'Gráfico `Semanal\' (30 minutos' , '`Monthly\' Graph \(2 Hour' => 'Gráfico `Mensal\' (2 horas', '`Yearly\' Graph \(1 Day' => 'Gráfico `Anual\' (1 dia', 'Incoming Traffic in (\S+) per Second' => 'Tráfego de Entrada em $1 por segundo', 'Outgoing Traffic in (\S+) per Second' => 'Tráfego de Saída em $1 por segundo', 'at which time (.*) had been up for(.*)' => 'nesta hora $1 estava ativo por $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Entr.', 'Out' => 'Saí', 'Percentage' => 'Porc.', 'Ported to OpenVMS Alpha by' => 'Adaptado para o Alpha OpenVMS por', 'Ported to WindowsNT by' => 'Adaptado para o WindowsNT por', 'and' => 'e', '^GREEN' => 'VERDE', 'BLUE' => 'AZUL', 'DARK GREEN' => 'VERDE ESCURO', 'MAGENTA' => 'LILÁS', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Domingo', 'Sun' => 'Dom', 'Monday' => 'Segunda', 'Mon' => 'Seg', 'Tuesday' => 'Terça', 'Tue' => 'Ter', 'Wednesday' => 'Quarta', 'Wed' => 'Qua', 'Thursday' => 'Quinta', 'Thu' => 'Qui', 'Friday' => 'Sexta', 'Fri' => 'Sex', 'Saturday' => 'Sábado', 'Sat' => 'Sáb' ); %month = ( 'January' => 'Janeiro', 'February' => 'Fevereiro' , 'March' => 'Março', 'Jan' => 'Jan', 'Feb' => 'Fev', 'Mar' => 'Mar', 'April' => 'Abril', 'May' => 'Maio', 'June' => 'Junho', 'Apr' => 'Abr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Julho', 'August' => 'Agosto', 'September' => 'Setembro', 'Jul' => 'Jul', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Outubro', 'November' => 'Novembro', 'December' => 'Dezembro', 'Oct' => 'Out', 'Nov' => 'Nov', 'Dec' => 'Dez' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." às ".$quux[1]; }; return "$wday{$foo[0]}, $foo[1] de $month{$foo[2]} de $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Bulgarian sub bulgarian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1251', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => '', 'The statistics were last updated(.*)' => ' : $1', ' Average\)' => ' )', 'Average' => '', 'Max' => '.', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => ' ( $1 ', '`Weekly\' Graph \(30 Minute' => ' ( 30 ' , '`Monthly\' Graph \(2 Hour' => ' ( 2 ', '`Yearly\' Graph \(1 Day' => ' ( 1 ', 'Incoming Traffic in (\S+) per Second' => ' $1 ', 'Outgoing Traffic in (\S+) per Second' => ' $1 ', 'at which time (.*) had been up for(.*)' => ' $1 $2', #'([kMG]?)([bB])/s' => '$1$1/', #'([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', 'Bits' => '', 'Bytes' => '', 'In' => '.', 'Out' => '.', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha ', 'Ported to WindowsNT by' => ' WindowsNT ', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => '', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => ' ', 'Sun' => '', 'Monday' => ' ', 'Mon' => '', 'Tuesday' => ' ', 'Tue' => '', 'Wednesday' => ' ', 'Wed' => '', 'Thursday' => ' ', 'Thu' => '', 'Friday' => ' ', 'Fri' => '', 'Saturday' => ' ', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].". ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # catalan sub catalan { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tràfic entrant màxim en 5 minuts', 'Maximal 5 Minute Outgoing Traffic' => 'Tràfic sortint màxim en 5 minuts', 'the device' => 'el dispositiu', 'The statistics were last updated(.*)' => 'Estadístiques actualitzades el $1', ' Average\)' => ' Promig)', 'Average' => 'Promig', 'Max' => 'Màxim', 'Current' => 'Actual', 'version' => 'versió', '`Daily\' Graph \((.*) Minute' => 'Gràfic diari ($1 minuts :', '`Weekly\' Graph \(30 Minute' => 'Gràfic setmanal (30 minuts :' , '`Monthly\' Graph \(2 Hour' => 'Gràfic mensual (2 hores :', '`Yearly\' Graph \(1 Day' => 'Gràfic anual (1 dia :', 'Incoming Traffic in (\S+) per Second' => 'Tràfic entrant en $1 per segon', 'Outgoing Traffic in (\S+) per Second' => 'Tràfic sortint en $1 per segon', 'at which time (.*) had been up for(.*)' => '$1 ha estat funcionant durant $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Entrant', 'Out' => 'Sortint', 'Percentage' => 'Percentatge', 'Ported to OpenVMS Alpha by' => 'Portat a OpenVMS Alpha per', 'Ported to WindowsNT by' => 'Portat a WindowsNT per', 'and' => 'i', '^GREEN' => 'VERD', 'BLUE' => 'BLAU', 'DARK GREEN' => 'VERD FOSC', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Diumenge', 'Sun' => 'Dg', 'Monday' => 'Dilluns', 'Mon' => 'Dl', 'Tuesday' => 'Dimarts', 'Tue' => 'Dm', 'Wednesday' => 'Dimecres', 'Wed' => 'Dc', 'Thursday' => 'Dijous', 'Thu' => 'Dj', 'Friday' => 'Divendres', 'Fri' => 'Dv', 'Saturday' => 'Dissabte', 'Sat' => 'Ds' ); %month = ( 'January' => 'Gener', 'February' => 'Febrer' , 'March' => 'Mar', 'Jan' => 'Gen', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'Abril', 'May' => 'Maig', 'June' => 'Juny', 'Apr' => 'Abr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Juliol', 'August' => 'Agost', 'September' => 'Setembre', 'Jul' => 'Jul', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Octubre', 'November' => 'Novembre', 'December' => 'Desembre', 'Oct' => 'Oct', 'Nov' => 'Nov', 'Dec' => 'Des' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." a les ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] de $month{$foo[2]} de $foo[3]"; }; return $string; }; # Simplified Chinese sub chinese { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( 'iso-8859-1' => 'gb2312', 'Maximal 5 Minute Incoming Traffic' => '5', 'Maximal 5 Minute Outgoing Traffic' => '5', 'the device' => '豸', 'The statistics were last updated(.*)' => 'ͳƸʱ䣺$1', ' Average\)' => ' ƽ)', 'Average' => 'ƽ', 'Max' => '', 'Current' => 'ǰ', 'version' => '汾', '`Daily\' Graph \((.*) Minute' => 'ÿ ͼ ($1 ', '`Weekly\' Graph \(30 Minute' => 'ÿ ͼ (30 ' , '`Monthly\' Graph \(2 Hour' => 'ÿ ͼ (2 Сʱ', '`Yearly\' Graph \(1 Day' => 'ÿ ͼ (1 ', 'Incoming Traffic in (\S+) per Second' => 'ÿ (λ $1 )', 'Outgoing Traffic in (\S+) per Second' => 'ÿ (λ $1 )', 'at which time (.*) had been up for(.*)' => ' $1 ˣ $2 ', '(.+)/s$' => '$1/', '(.+)/min$' => '$1/', '(.+)/h$' => '$1/ʱ', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => '룺', 'Out' => '', 'Percentage' => 'ٷֱȣ', 'Ported to OpenVMS Alpha by' => 'ֲ OpenVMS ', 'Ported to WindowsNT by' => 'ֲ WindowsNT ', 'and' => '', '^GREEN' => 'ɫ', 'BLUE' => 'ɫ', 'DARK GREEN' => 'ī', 'MAGENTA' => 'ɫ', 'AMBER' => 'ɫ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => 'һ', 'Mon' => 'һ', 'Tuesday' => 'ڶ', 'Tue' => '', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => ' һ ', 'February' => ' ', 'March' => ' ', 'April' => ' ', 'May' => ' ', 'June' => ' ', 'July' => ' ', 'August' => ' ', 'September' => ' ', 'October' => ' ʮ ', 'November' => 'ʮһ', 'December' => 'ʮ', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return "$foo[3] $month{$foo[2]} $foo[1] $wday{$foo[0]} $foo[4]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # cn s-Chinese sub cn { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( 'charset=iso-8859-1' => 'charset=gb2312', 'Maximal 5 Minute Incoming Traffic' => '5', 'Maximal 5 Minute Outgoing Traffic' => '5', 'the device' => '豸', 'The statistics were last updated(.*)' => 'ͳʱ䣺$1', ' Average\)
' => ' ƽ)
', 'Average(.*)' => 'ƽ$1', 'Max(.*)' => '$1', 'Current(.*)' => 'ǰ$1', 'version' => '汾', '`Daily\' Graph \((.*) Minute' => '"ÿ" ͼ ($1 ', '`Weekly\' Graph \(30 Minute' => '"ÿ" ͼ (30 ' , '`Monthly\' Graph \(2 Hour' => '"ÿ" ͼ (2 Сʱ', '`Yearly\' Graph \(1 Day' => '"ÿ" ͼ (1 ', 'Incoming Traffic in (\S+) per Second' => 'ÿ $1 ', 'Outgoing Traffic in (\S+) per Second' => 'ÿ $1 ', 'at which time (.*) had been up for(.*)' => 'ʱ $1 ˣ $2 ', '(.+)/s$' => '$1/', '(.+)/min$' => '$1/', '(.+)/h$' => '$1/ʱ', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' ' In:' => ' 룺', ' Out:' => ' ', ' Percentage' => ' ٷֱȣ', 'Ported to OpenVMS Alpha by' => 'ֲ OpenVMS ', 'Ported to WindowsNT by' => 'ֲ WindowsNT ', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => 'ī', 'MAGENTA' => '', 'AMBER' => 'ɫ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => 'һ', 'Mon' => 'һ', 'Tuesday' => 'ڶ', 'Tue' => '', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => ' һ ', 'February' => ' ', 'March' => ' ', 'April' => ' ', 'May' => ' ', 'June' => ' ', 'July' => ' ', 'August' => ' ', 'September' => ' ', 'October' => ' ʮ ', 'November' => 'ʮһ', 'December' => 'ʮ', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return "$foo[3] $month{$foo[2]} $foo[1] $wday{$foo[0]} $foo[4]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; sub croatian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'iso-8859-2', 'Maximal 5 Minute Incoming Traffic' => 'Maksimalni ulazni promet unutar 5 minuta', 'Maximal 5 Minute Outgoing Traffic' => 'Maksimalni izlazni promet unutar 5 minuta', 'the device' => 'ureaj', 'The statistics were last updated(.*)' => 'Statistike su zadnji puta izmijenjene $1', ' Average\)' => ' prosjena vrijednost)', 'Average' => 'Prosjeno', 'Max' => 'Maksimalno', 'Current' => 'Trenutno', 'version' => 'verzija', '`Daily\' Graph \((.*) Minute' => 'Dnevne statistike (svakih $1 minuta', '`Weekly\' Graph \(30 Minute' => 'Tjedne statistike (svakih 30 minuta' , '`Monthly\' Graph \(2 Hour' => 'Mjesene statistike (svakih 2 sata', '`Yearly\' Graph \(1 Day' => 'Godinje statistike (svaki 1 dan', 'Incoming Traffic in (\S+) per Second' => 'Ulazni promet - $1 po sekundi', 'Outgoing Traffic in (\S+) per Second' => 'Izlazni promet - $1 po sekundi', 'at which time (.*) had been up for(.*)' => 'gdje $1 je bio aktivan $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/g', 'Bits' => 'Bitova', 'Bytes' => 'Bajtova', 'In' => 'Unutra', 'Out' => 'Van', 'Percentage' => 'Postotak', 'Ported to OpenVMS Alpha by' => 'Port na OpenVMS Alpha od', 'Ported to WindowsNT by' => 'Post od WindowsNT od', 'and' => 'i', '^GREEN' => 'ZELENA', 'BLUE' => 'PLAVA', 'DARK GREEN' => 'TAMNO ZELENA', 'MAGENTA' => 'LJUBIASTA', 'AMBER' => 'AMBER' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Nedjelja', 'Sun' => 'Ned', 'Monday' => 'Ponedjeljak', 'Mon' => 'Pon', 'Tuesday' => 'Utorak', 'Tue' => 'Uto', 'Wednesday' => 'Srijeda', 'Wed' => 'Sri', 'Thursday' => 'etvrtak', 'Thu' => 'et', 'Friday' => 'Petak', 'Fri' => 'Pet', 'Saturday' => 'Subota', 'Sat' => 'Sub' ); %month = ( 'January' => 'Sijeanj', 'February' => 'Veljaa', 'March' => 'Oujak', 'Jan' => 'Sij', 'Feb' => 'Vel', 'Mar' => 'Ou', 'April' => 'Travanj', 'May' => 'Svibanj', 'June' => 'Lipanj', 'Apr' => 'Tra', 'May' => 'Svi', 'Jun' => 'Lip', 'July' => 'Srpanj', 'August' => 'Kolovoz', 'September' => 'Rujan', 'Jul' => 'Srp', 'Aug' => 'Kol', 'Sep' => 'Ruj', 'October' => 'Listopad', 'November' => 'Studeni', 'December' => 'Prosinac', 'Oct' => 'Lis', 'Nov' => 'Stu', 'Dec' => 'Pro' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." godine"." u".$quux[1]; }; return "$wday{$foo[0]} dana $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Czech sub czech { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1250', 'Maximal 5 Minute Incoming Traffic' => 'Maximln 5 minutov pchoz tok', 'Maximal 5 Minute Outgoing Traffic' => 'Maximln 5 minutov odchoz tok', 'the device' => 'zazen', 'The statistics were last updated(.*)' => 'Posledn aktualizace statistiky:$1', ' Average\)' => ' prmr)', 'Average' => 'Prm.', 'Max' => 'Max.', 'Current' => 'Akt.', 'version' => 'verze', '`Daily\' Graph \((.*) Minute' => 'Denn graf ($1 minutov', '`Weekly\' Graph \(30 Minute' => 'Tdenn graf (30 minutov' , '`Monthly\' Graph \(2 Hour' => 'Msn graf (2 hodinov', '`Yearly\' Graph \(1 Day' => 'Ron graf (1 denn', 'Incoming Traffic in (\S+) per Second' => 'Pchoz tok v $1 za sec.', 'Outgoing Traffic in (\S+) per Second' => 'Odchoz tok v $1 za sec.', 'at which time (.*) had been up for(.*)' => 'od poslednho restartu $1 ubhlo: $2', #'([kMG]?)([bB])/s' => '\$1\$2/s', #'([kMG]?)([bB])/min' => '\$1\$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bitech', 'Bytes' => 'bajtech', #' In:' => ' In:', #' Out:' => ' Out:', 'Percentage' => 'Proc.', 'Ported to OpenVMS Alpha by' => 'Na OpenVMS portoval', 'Ported to WindowsNT by' => 'Na WindowsNT portoval', 'and' => 'a', '^GREEN' => 'Zelen', 'BLUE' => 'Modr', 'DARK GREEN' => 'Tmav zelen', 'MAGENTA' => 'Fialov', 'AMBER' => 'lut' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Nedle', 'Sun' => 'Ne', 'Monday' => 'Pondli', 'Mon' => 'Po', 'Tuesday' => 'ter', 'Tue' => 't', 'Wednesday' => 'Steda', 'Wed' => 'St', 'Thursday' => 'tvrtek', 'Thu' => 't', 'Friday' => 'Ptek', 'Fri' => 'P', 'Saturday' => 'Sobota', 'Sat' => 'So' ); %month = ( 'January' => 'Leden', 'February' => 'nor', 'March' => 'Bezen', 'Jan' => 'Leden', 'Feb' => 'nor', 'Mar' => 'Bezen', 'April' => 'Duben', 'May' => 'Kvten', 'June' => 'erven', 'Apr' => 'Duben', 'May' => 'Kvten', 'Jun' => 'erven', 'July' => 'ervenec','August' => 'Srpen', 'September' => 'Z', 'Jul' => 'ervenec','Aug' => 'Srpen', 'Sep' => 'Z', 'October' => 'jen', 'November' => 'Listopad', 'December' => 'Prosinec', 'Oct' => 'jen', 'Nov' => 'Listopad', 'Dec' => 'Prosinec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].",".$quux[1]." hod."; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; } # # Czechutf8 sub czechutf8 { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'utf-8', 'Maximal 5 Minute Incoming Traffic' => 'Maximální 5 minutový příchozí tok', 'Maximal 5 Minute Outgoing Traffic' => 'Maximální 5 minutový odchozí tok', 'the device' => 'zařízení', 'The statistics were last updated(.*)' => 'Poslední aktualizace statistiky:$1', ' Average\)' => ' průměr)', 'Average' => 'Prům.', 'Max' => 'Max.', 'Current' => 'Akt.', 'version' => 'verze', '`Daily\' Graph \((.*) Minute' => 'Denní graf ($1 minutový', '`Weekly\' Graph \(30 Minute' => 'Týdenní graf (30 minutový' , '`Monthly\' Graph \(2 Hour' => 'Měsíční graf (2 hodinový', '`Yearly\' Graph \(1 Day' => 'Roční graf (1 denní', 'Incoming Traffic in (\S+) per Second' => 'Příchozí tok v $1 za sec.', 'Outgoing Traffic in (\S+) per Second' => 'Odchozí tok v $1 za sec.', 'at which time (.*) had been up for(.*)' => 'od posledního restartu $1 uběhlo: $2', #'([kMG]?)([bB])/s' => '\$1\$2/s', #'([kMG]?)([bB])/min' => '\$1\$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bitech', 'Bytes' => 'bajtech', #' In:' => ' In:', #' Out:' => ' Out:', 'Percentage' => 'Proc.', 'Ported to OpenVMS Alpha by' => 'Na OpenVMS portoval', 'Ported to WindowsNT by' => 'Na WindowsNT portoval', 'and' => 'a', '^GREEN' => 'Zelená', 'BLUE' => 'Modrá', 'DARK GREEN' => 'Tmavě zelená', 'MAGENTA' => 'Fialová', 'AMBER' => 'Žlutá' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Neděle', 'Sun' => 'Ne', 'Monday' => 'Pondělí', 'Mon' => 'Po', 'Tuesday' => 'Úterý', 'Tue' => 'Út', 'Wednesday' => 'Středa', 'Wed' => 'St', 'Thursday' => 'Čtvrtek', 'Thu' => 'Čt', 'Friday' => 'Pátek', 'Fri' => 'Pá', 'Saturday' => 'Sobota', 'Sat' => 'So' ); %month = ( 'January' => 'Leden', 'February' => 'Únor', 'March' => 'Březen', 'Jan' => 'Leden', 'Feb' => 'Únor', 'Mar' => 'Březen', 'April' => 'Duben', 'May' => 'Květen', 'June' => 'Červen', 'Apr' => 'Duben', 'May' => 'Květen', 'Jun' => 'Červen', 'July' => 'Červenec','August' => 'Srpen', 'September' => 'Září', 'Jul' => 'Červenec','Aug' => 'Srpen', 'Sep' => 'Září', 'October' => 'Říjen', 'November' => 'Listopad', 'December' => 'Prosinec', 'Oct' => 'Říjen', 'Nov' => 'Listopad', 'Dec' => 'Prosinec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].",".$quux[1]." hod."; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; } # # Danish sub danish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maksimal indgående trafik i 5 minutter', 'Maximal 5 Minute Outgoing Traffic' => 'Maksimal udgående trafik i 5 minutter', 'the device' => 'enheden', 'The statistics were last updated(.*)' => 'Statistikken blev sidst opdateret$1', ' Average\)' => ' Middel)', 'Average' => 'Middel', 'Max' => 'Max', 'Current' => 'Nu', 'version' => 'version', '`Daily\' Graph \((.*) Minute' => '`Daglig\' graf ($1 minuts', '`Weekly\' Graph \(30 Minute' => '`Ugentlig\' graf (30 minuts' , '`Monthly\' Graph \(2 Hour' => '`Månedlig\' graf (2 times', '`Yearly\' Graph \(1 Day' => '`Årlig\' graf (1 dags', 'Incoming Traffic in (\S+) per Second' => 'Indgående trafik i $1 per sekund', 'Outgoing Traffic in (\S+) per Second' => 'Udgående trafik i $1 per sekund', 'at which time (.*) had been up for(.*)' => 'hvor $1 havde været oppe i$2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Ind', 'Out' => 'Ud', 'Percentage' => 'Procent', 'Ported to OpenVMS Alpha by' => 'Port til OpenVMS af', 'Ported to WindowsNT by' => 'Port til WindowsNT af', 'and' => 'og', '^GREEN' => 'GRØN', 'BLUE' => 'BLÅ', 'DARK GREEN' => 'MØRKEGRØN', 'MAGENTA' => 'LYSLILLA', 'AMBER' => 'RAV' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Søndag', 'Sun' => 'Søn', 'Monday' => 'Mandag', 'Mon' => 'Man', 'Tuesday' => 'Tirsdag', 'Tue' => 'Tir', 'Wednesday' => 'Onsdag', 'Wed' => 'Ons', 'Thursday' => 'Torsdag', 'Thu' => 'Tor', 'Friday' => 'Fredag', 'Fri' => 'Fre', 'Saturday' => 'Lørdag', 'Sat' => 'Lør' ); %month = ( 'January' => 'Januar', 'February' => 'Februar' , 'March' => 'Marts', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'April', 'May' => 'Maj', 'June' => 'Juni', 'Apr' => 'Apr', 'May' => 'Maj', 'Jun' => 'Jun', 'July' => 'Juli', 'August' => 'August', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Aug', 'Sep' => 'Sep', 'October' => 'Oktober', 'November' => 'November', 'December' => 'December', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]} den $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Dutch sub dutch { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maximaal inkomend verkeer per 5 minuten', 'Maximal 5 Minute Outgoing Traffic' => 'Maximaal uitgaand verkeer per 5 minuten', 'the device' => 'het apparaat', 'The statistics were last updated(.*)' => 'Statistieken voor het laatst bijgewerkt op$1', ' Average\)' => ' gemiddeld)', 'Average' => 'Gemiddeld', 'Max' => 'Max', 'Current' => 'Actueel', 'version' => 'versie', '`Daily\' Graph \((.*) Minute' => '`Dagelijkse\' grafiek ($1 minuten', '`Weekly\' Graph \(30 Minute' => '`Wekelijkse\' grafiek (30 minuten' , '`Monthly\' Graph \(2 Hour' => '`Maandelijkse\' grafiek (2 uur', '`Yearly\' Graph \(1 Day' => '`Jaarlijkse\' grafiek (1 dag', 'Incoming Traffic in (\S+) per Second' => 'Inkomend verkeer in $1 per seconde', 'Outgoing Traffic in (\S+) per Second' => 'Uitgaand verkeer in $1 per seconde', 'at which time (.*) had been up for(.*)' => 'op het moment dat $1 reeds actief was voor$2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/u', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' # ' In:' => ' In:', 'Out' => 'Uit', 'Percentage' => 'Procent', 'Ported to OpenVMS Alpha by' => 'Ported naar OpenVMS door', 'Ported to WindowsNT by' => 'Ported naar WindowsNT door', 'and' => 'en', 'DARK GREEN' => 'DONKER GROEN', '^GREEN' => 'GROEN', 'BLUE' => 'BLAUW', 'MAGENTA' => 'LILA', 'AMBER' => 'AMBER' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'zondag', 'Sun' => 'zon', 'Monday' => 'maandag', 'Mon' => 'maa', 'Tuesday' => 'dinsdag', 'Tue' => 'din', 'Wednesday' => 'woensdag', 'Wed' => 'woe', 'Thursday' => 'donderdag', 'Thu' => 'don', 'Friday' => 'vrijdag', 'Fri' => 'vri', 'Saturday' => 'zaterdag', 'Sat' => 'zat' ); %month = ( 'January' => 'januari', 'February' => 'februari', 'March' => 'maart', 'Jan' => 'jan', 'Feb' => 'feb', 'Mar' => 'mrt', 'April' => 'april', 'May' => 'mei', 'June' => 'juni', 'Apr' => 'apr', 'May' => 'mei', 'Jun' => 'jun', 'July' => 'juli', 'August' => 'augustus', 'September' => 'september', 'Jul' => 'jul', 'Aug' => 'aug', 'Sep' => 'sep', 'October' => 'oktober', 'November' => 'november', 'December' => 'december', 'Oct' => 'okt', 'Nov' => 'nov', 'Dec' => 'dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." om".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Estonian sub estonian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => '5 minuti maksimaalne sisenev liiklus', 'Maximal 5 Minute Outgoing Traffic' => '5 minuti maksimaalne väljuv liiklus', 'the device' => 'seade', 'The statistics were last updated(.*)' => 'Statistikat uuendati viimati$1', ' Average\)' => ' keskmine)', 'Average' => 'Keskmine', #'Max' => 'Max', 'Current' => 'Hetkel', 'version' => 'versioon', '`Daily\' Graph \((.*) Minute' => '`Päevane\' graafik ($1 minuti', '`Weekly\' Graph \(30 Minute' => '`Nädala\' graafik (30 minuti' , '`Monthly\' Graph \(2 Hour' => '`Kuu \' graafik (2 tunni', '`Yearly\' Graph \(1 Day' => '`Aasta\' graafik (1 päeva', 'Incoming Traffic in (\S+) per Second' => 'Sisenev liiklus $1 sekundi kohta', 'Outgoing Traffic in (\S+) per Second' => 'Väljuv liiklus $1 sekundi kohta', 'at which time (.*) had been up for(.*)' => 'kui $1 on katkematult töötanud$2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', 'Bits' => 'bitti', 'Bytes' => 'baiti', 'In' => 'sisse', 'Out' => 'välja', 'Percentage' => 'protsent', 'Ported to OpenVMS Alpha by' => 'portis OpenVMS-le:', 'Ported to WindowsNT by' => 'portis WindowsNT-le:', 'and' => 'ja', '^GREEN' => 'ROHELINE', 'BLUE' => 'SININE', 'DARK GREEN' => 'TUMEROHELINE', 'MAGENTA' => 'LILLA', 'AMBER' => 'HELEROHELINE' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'pühapäev', 'Sun' => 'P', 'Monday' => 'esmaspäev', 'Mon' => 'E', 'Tuesday' => 'teisipäev', 'Tue' => 'T', 'Wednesday' => 'kolmapäev', 'Wed' => 'K', 'Thursday' => 'neljapäev', 'Thu' => 'N', 'Friday' => 'reede', 'Fri' => 'R', 'Saturday' => 'laupäev', 'Sat' => 'L' ); %month = ( 'January' => 'jaanuar', 'February' => 'veebruar' , 'March' => 'märts', 'Jan' => 'jaan', 'Feb' => 'veebr', 'Mar' => 'märts', 'April' => 'aprill', 'May' => 'mai', 'June' => 'juuni', 'Apr' => 'aprill', 'May' => 'mai', 'Jun' => 'juuni', 'July' => 'juuli', 'August' => 'august', 'September' => 'september', 'Jul' => 'juuli', 'Aug' => 'aug', 'Sep' => 'sept', 'October' => 'oktoober', 'November' => 'november', 'December' => 'detsember', 'Oct' => 'okt', 'Nov' => 'nov', 'Dec' => 'dets' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]}, $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # eucjp sub eucjp { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( '^iso-8859-1' => 'euc-jp', '^Maximal 5 Minute Incoming Traffic' => '5ʬ', '^Maximal 5 Minute Outgoing Traffic' => '5ʬ', '^the device' => 'ǥХ', '^The statistics were last updated (.*)' => ' $1', '^Average\)' => 'ʿ)', '^Average$' => 'ʿ', '^Max$' => '', '^Current' => 'ǿ', '^`Daily\' Graph \((.*) Minute' => '($1ʬ', '^`Weekly\' Graph \(30 Minute' => '(30ʬ', '^`Monthly\' Graph \(2 Hour' => '(2', '^`Yearly\' Graph \(1 Day' => 'ǯ(1', '^Incoming Traffic in (\S+) per Second' => 'äμ$1', '^Incoming Traffic in (\S+) per Minute' => 'ʬμ$1', '^Incoming Traffic in (\S+) per Hour' => 'μ$1', '^Outgoing Traffic in (\S+) per Second' => 'ä$1', '^Outgoing Traffic in (\S+) per Minute' => 'ʬ$1', '^Outgoing Traffic in (\S+) per Hour' => '$1', '^at which time (.*) had been up for (.*)' => '$1βƯ $2', '^Average max 5 min values for `Daily\' Graph \((.*) Minute interval\):' => 'դǤκ5ʬͤʿ($1ʬֳ):', '^Average max 5 min values for `Weekly\' Graph \(30 Minute interval\):' => 'դǤκ5ʬͤʿ(30ʬֳ):', '^Average max 5 min values for `Monthly\' Graph \(2 Hour interval\):' => 'դǤκ5ʬͤʿ(2ֳִ):', '^Average max 5 min values for `Yearly\' Graph \(1 Day interval\):' => 'ǯդǤκ5ʬͤʿ(1ֳ):', #'^([kMG]?)([bB])/s' => '$1$2/', #'^([kMG]?)([bB])/min' => '$1$2/ʬ', #'^([kMG]?)([bB])/h' => '$1$2/', '^Bits$' => 'ӥå', '^Bytes$' => 'Х', '^In$' => '', '^Out$' => '', '^Percentage' => 'Ψ', '^Ported to OpenVMS Alpha by' => 'OpenVMS Alphaؤΰܿ', '^Ported to WindowsNT by' => 'WindowsNTؤΰܿ', #'^and' => 'and', '^GREEN' => '', '^BLUE' => '', '^DARK GREEN' => '', '^MAGENTA' => 'ޥ', '^AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '()', 'Monday' => '()', 'Tuesday' => '()', 'Wednesday' => '()', 'Thursday' => '()', 'Friday' => '()', 'Saturday' => '()', ); %month = ( 'January' => '1', 'February' => '2', 'March' => '3', 'April' => '4', 'May' => '5', 'June' => '6', 'July' => '7', 'August' => '8', 'September' => '9', 'October' => '10', 'November' => '11', 'December' => '12', ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)\s+(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~/at/) { @quux=split(/\s+at\s+/,$foo[3]); } else { @quux=split(/ /,$foo[3],2); }; return "$quux[0]ǯ$month{$foo[2]}$foo[1]$wday{$foo[0]} $quux[1]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Finnish sub finnish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tulevan liikenteen maksimi 5 minuutin aikana', 'Maximal 5 Minute Outgoing Traffic' => 'Lähtevän liikenteen maksimi 5 minuutin aikana', 'the device' => 'laite', 'The statistics were last updated(.*)' => 'Tiedot päivitetty viimeksi $1', ' Average\)' => '', 'Average' => 'Keskimäärin', 'Max' => 'Maksimi', 'Current' => 'Tällä hetkellä', 'version' => 'versio', '`Daily\' Graph \((.*) Minute' => 'Päiväraportti (skaala $1 minuutti(a))', '`Weekly\' Graph \(30 Minute' => 'Viikkoraportti (skaala 30 minuuttia)' , '`Monthly\' Graph \(2 Hour' => 'Kuukausiraportti (skaala 2 tuntia)', '`Yearly\' Graph \(1 Day' => 'Vuosiraportti (skaala 1 vuorokausi)', 'Incoming Traffic in (\S+) per Second' => 'Tuleva liikenne $1 sekunnissa', 'Outgoing Traffic in (\S+) per Second' => 'Lähtevä liikenne $1 sekunnissa', 'Incoming Traffic in (\S+) per Minute' => 'Tuleva liikenne $1 minuutissa', 'Outgoing Traffic in (\S+) per Minute' => 'Lähtevä liikenne $1 minuutissa', 'Incoming Traffic in (\S+) per Hour' => 'Tuleva liikenne $1 tunnissa', 'Outgoing Traffic in (\S+) per Hour' => 'Lähtevä liikenne $1 tunnissa', 'at which time (.*) had been up for(.*)' => 'jolloin $1 on toiminut yhtäjaksoisesti $2', '(\S+) per minute' => '$1 minuutissa', '(\S+) per hour' => '$1 tunnissa', '(.+)/s$' => '$1/s', # '(.+)/min' => '$1/min', #'(.+)/h$' => '$1/h', #'([kMG]?)([bB])/s' => '$1$2/s', #'([kMG]?)([bB])/min' => '$1$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bittiä', 'Bytes' => 'tavua', 'In' => 'Tuleva', 'Out' => 'Lähtevä', 'Percentage' => 'Prosenttia', 'Ported to OpenVMS Alpha by' => 'OpenVMS -järjestelmälle sovittanut', 'Ported to WindowsNT by' => 'WindowsNT -järjestelmälle sovittanut', 'and' => 'ja', '^GREEN' => 'VIHREÄ', 'BLUE' => 'SININEN', 'DARK GREEN' => 'TUMMANVIHREÄ', 'MAGENTA' => 'PINKKI', 'AMBER' => 'PUNAINEN', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Sunnuntai', 'Sun' => 'Su', 'Monday' => 'Maanantai', 'Mon' => 'Ma', 'Tuesday' => 'Tiistai', 'Tue' => 'Ti', 'Wednesday' => 'Keskiviikko', 'Wed' => 'Ke', 'Thursday' => 'Torstai', 'Thu' => 'To', 'Friday' => 'Perjantai', 'Fri' => 'Pe', 'Saturday' => 'Lauantai', 'Sat' => 'La' ); %month = ( 'January' => 'Tammi', 'February' => 'Helmi' , 'March' => 'Maalis', 'Jan' => 'Tam', 'Feb' => 'Hel', 'Mar' => 'Maa', 'April' => 'Huhti', 'May' => 'Touko', 'June' => 'Kesä', 'Apr' => 'Huh', 'May' => 'Tou', 'Jun' => 'Kes', 'July' => 'Heinä', 'August' => 'Elo', 'September' => 'Syys', 'Jul' => 'Hei', 'Aug' => 'Elo', 'Sep' => 'Syy', 'October' => 'Loka', 'November' => 'Marras', 'December' => 'Joulu', 'Oct' => 'Lok', 'Nov' => 'Mar', 'Dec' => 'Kou' ); # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if( $wday{$foo[0]} && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kello ".$quux[1]; }; return "$wday{$foo[0]}, $foo[1]. $month{$foo[2]} $foo[3]"; }; # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # French sub french { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Trafic maximal en entrée sur 5 minutes', 'Maximal 5 Minute Outgoing Traffic' => 'Trafic maximal en sortie sur 5 minutes', 'the device' => 'le matériel', 'The statistics were last updated(.*)' => 'Les statistiques ont été mises à jour le $1', ' Average\)' => ' Moyenne)', 'Average' => 'Moyenne', '>Max' => 'Max', 'Current' => 'Actuel', #'version' => 'version', '`Daily\' Graph \((.*) Minute' => 'Graphique quotidien (sur $1 minutes :', '`Weekly\' Graph \(30 Minute' => 'Graphique hebdomadaire (sur 30 minutes :' , '`Monthly\' Graph \(2 Hour' => 'Graphique mensuel (sur 2 heures :', '`Yearly\' Graph \(1 Day' => 'Graphique annuel (sur 1 jour :', 'Incoming Traffic in (\S+) per Second' => 'Trafic d\'entrée en $1 par seconde', 'Outgoing Traffic in (\S+) per Second' => 'Trafic de sortie en $1 par seconde', 'at which time (.*) had been up for(.*)' => '$1 était alors en marche depuis $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Entrée', 'Out' => 'Sortie', 'Percentage' => 'Pourcentage', 'Ported to OpenVMS Alpha by' => 'Porté sur OpenVMS Alpha par', 'Ported to WindowsNT by' => 'Porté sur WindowsNT par', 'and' => 'et', '^GREEN' => 'VERT', 'BLUE' => 'BLEU', 'DARK GREEN' => 'VERT SOMBRE', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'AMBRE' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Dimanche', 'Sun' => 'Dim', 'Monday' => 'Lundi', 'Mon' => 'Lun', 'Tuesday' => 'Mardi', 'Tue' => 'Mar', 'Wednesday' => 'Mercredi', 'Wed' => 'Mer', 'Thursday' => 'Jeudi', 'Thu' => 'Jeu', 'Friday' => 'Vendredi', 'Fri' => 'Ven', 'Saturday' => 'Samedi', 'Sat' => 'Sam' ); %month = ( 'January' => 'Janvier', 'February' => 'Février' , 'March' => 'Mars', 'Jan' => 'Jan', 'Feb' => 'Fev', 'Mar' => 'Mar', 'April' => 'Avril', 'May' => 'Mai', 'June' => 'Juin', 'Apr' => 'Avr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Juillet', 'August' => 'Août', 'September' => 'Septembre', 'Jul' => 'Jul', 'Aug' => 'Aou', 'Sep' => 'Sep', 'October' => 'Octobre', 'November' => 'Novembre', 'December' => 'Décembre', 'Oct' => 'Oct', 'Nov' => 'Nov', 'Dec' => 'Dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." à ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." à $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Galician sub galician { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tr&áfico entrante máximo en 5 minutos', 'Maximal 5 Minute Outgoing Traffic' => 'Tr&áfico saínte máximo en 5 minutos', 'the device' => 'o dispositivo', 'The statistics were last updated(.*)' => 'Estas estatísticas actualizáronse o $1', ' Average\)' => ' de Media)', 'Average' => 'Media', 'Max' => 'Máx', 'Current' => 'Actual', 'version' => 'versión', '`Daily\' Graph \((.*) Minute' => 'Gráfica diaria ($1 minutos', '`Weekly\' Graph \(30 Minute' => 'Gráfica semanal (30 minutos' , '`Monthly\' Graph \(2 Hour' => 'Gráfica mensual (2 horas', '`Yearly\' Graph \(1 Day' => 'Gráfica anual (1 día', 'Incoming Traffic in (\S+) per Second' => 'Tráfico entrante en $1 por segundo', 'Outgoing Traffic in (\S+) per Second' => 'Tráfico saínte en $1 por segundo', 'at which time (.*) had been up for(.*)' => 'nese intre $1 levaba prendida $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/h', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Entrante', 'Out' => 'Saínte', 'Percentage' => 'Tanto por ciento', 'Ported to OpenVMS Alpha by' => 'Portado a OpenVMS Alpha por', 'Ported to WindowsNT by' => 'Portado a Windows NT por', 'and' => 'e', '^GREEN' => 'VERDE', 'BLUE' => 'AZUL', 'DARK GREEN' => 'VERDE OSCURO', 'MAGENTA' => 'ROSA', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Domingo', 'Sun' => 'Dom', 'Monday' => 'Luns', 'Mon' => 'Lun', 'Tuesday' => 'Martes', 'Tue' => 'Mar', 'Wednesday' => 'Mércores', 'Wed' => 'mér', 'Thursday' => 'Xoves', 'Thu' => 'Xov', 'Friday' => 'Venres', 'Fri' => 'Ven', 'Saturday' => 'Sábado', 'Sat' => 'Sáb' ); %month = ( 'January' => 'Xaneiro', 'February' => 'Febreiro' , 'March' => 'Marzo', 'Jan' => 'Xan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'Abril', 'May' => 'Maio', 'June' => 'Xuño', 'Apr' => 'Abr', 'May' => 'Mai', 'Jun' => 'Xuñ', 'July' => 'Xullo', 'August' => 'Agosto', 'September' => 'Setembro', 'Jul' => 'Xul', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Outubro', 'November' => 'Novembro', 'December' => 'Decembro', 'Oct' => 'Out', 'Nov' => 'Nov', 'Dec' => 'Dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." ás ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] de $month{$foo[2]} de $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Chinese gb Code sub gb { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'gb', 'Maximal 5 Minute Incoming Traffic' => '5', 'Maximal 5 Minute Outgoing Traffic' => '5', 'the device' => 'ǰ豸', 'The statistics were last updated(.*)' => 'ͳϢ: $1', ' Average\)' => 'ƽ)', 'Average' => 'ƽ', 'Max' => '', 'Current' => 'ǰ', 'version' => '汾', '`Daily\' Graph \((.*) Minute' => 'շͼ($1', '`Weekly\' Graph \(30 Minute' => 'ܷͼ(30' , '`Monthly\' Graph \(2 Hour' => '·ͼ(2Сʱ', '`Yearly\' Graph \(1 Day' => 'ͼ(1', 'Incoming Traffic in (\S+) per Second' => 'ÿ(λ$1)', 'Outgoing Traffic in (\S+) per Second' => 'ÿ(λ$1)', 'at which time (.*) had been up for(.*)' => 'ʱ $1Ѿ(UPTIME): $2', '([kMG]?)([bB])/s' => '$1$2/s', '([kMG]?)([bB])/min' => '$1$2/m', '([kMG]?)([bB])/h' => '$1$2/h', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => '', 'Out' => '', 'Percentage' => 'ٷֱ', 'Ported to OpenVMS Alpha by' => 'OpenVMSĶ˿', 'Ported to WindowsNT by' => 'WindowsNTĶ˿', 'and' => '', '^GREEN' => 'ɫ', 'BLUE' => 'ɫ', 'DARK GREEN' => '', 'MAGENTA' => 'ɫ', 'AMBER' => 'ɫ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => 'һ', 'Mon' => 'һ@', 'Tuesday' => 'ܶ', 'Tue' => 'ܶG', 'Wednesday' => '', 'Wed' => 'T', 'Thursday' => '', 'Thu' => 'ĥ|', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => '1', 'February' => '2', 'March' => '3', 'Jan' => '1', 'Feb' => '2', 'Mar' => '3', 'April' => '4', 'May' => '5', 'June' => '6', 'Apr' => '4', 'May' => '5', 'Jun' => '6', 'July' => '7', 'August' => '8', 'September' => '9', 'Jul' => '7', 'Aug' => '8', 'Sep' => '9', 'October' => '10', 'November' => '11', 'December' => '12', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { @quux=split(/at/,$foo[3]); if($foo[3]=~(/(.*)at(.*)/)) { $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return "$foo[3] $month{$foo[2]} $foo[1], $wday{$foo[0]}, $foo[4]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Chinese gb2312 Code sub gb2312 { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'gb2312', 'Maximal 5 Minute Incoming Traffic' => '5', 'Maximal 5 Minute Outgoing Traffic' => '5', 'the device' => 'װ', 'The statistics were last updated(.*)' => 'ϴͳƸʱ: $1', ' Average\)' => ' ƽ)', 'Average' => 'ƽ', 'Max' => '', 'Current' => 'Ŀǰ', 'version' => '汾', '`Daily\' Graph \((.*) Minute' => 'ÿ ͼ ($1 ', '`Weekly\' Graph \(30 Minute' => 'ÿ ͼ (30 ' , '`Monthly\' Graph \(2 Hour' => 'ÿ ͼ (2 Сʱ', '`Yearly\' Graph \(1 Day' => 'ÿ ͼ (1 ', 'Incoming Traffic in (\S+) per Second' => 'ÿ (λ $1)', 'Outgoing Traffic in (\S+) per Second' => 'ÿ (λ $1)', 'at which time (.*) had been up for(.*)' => '豸 $1ʱ(UPTIME): $2', '([kMG]?)([bB])/s' => '\$1\$2/', '([kMG]?)([bB])/min' => '\$1\$2/', '([kMG]?)([bB])/h' => '$1$2/ʱ', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => '', 'Out' => '', 'Percentage' => 'ٷֱ', 'Ported to OpenVMS Alpha by' => 'ֲ OpenVM Alpha ', 'Ported to WindowsNT by' => 'ֲ WindowsNT ', 'and' => '', '^GREEN' => 'ɫ', 'BLUE' => 'ɫ', 'DARK GREEN' => 'īɫ', 'MAGENTA' => 'ɫ', 'AMBER' => 'ɫ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => 'һ', 'Mon' => 'һ', 'Tuesday' => 'ڶ', 'Tue' => '', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => 'һ', 'February' => '', 'March' => '', 'Jan' => 'һ', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => 'ʮ', 'November' => 'ʮһ', 'December' => 'ʮ', 'Oct' => 'ʮ', 'Nov' => 'ʮһ', 'Dec' => 'ʮ' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { @quux=split(/at/,$foo[3]); if($foo[3]=~(/(.*)at(.*)/)) { $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return "$foo[3] $month{$foo[2]} $foo[1] , $wday{$foo[0]}, $foo[4]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # German sub german { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maximaler hereinkommender Traffic in 5 Minuten', 'Maximal 5 Minute Outgoing Traffic' => 'Maximaler hinausgehender Traffic in 5 Minuten', 'the device' => 'das Gert', 'The statistics were last updated(.*)' => 'Die Statistiken wurden am $1 zuletzt aktualisiert', ' Average\)' => '', 'Average' => 'Mittel', 'Max' => 'Maximal', 'Current' => 'Aktuell', 'version' => 'Version', '`Daily\' Graph \((.*) Minute' => 'Tagesübersicht (Skalierung $1 Minute(n)', '`Weekly\' Graph \(30 Minute' => 'Wochenübersicht (Skalierung 30 Minuten', '`Monthly\' Graph \(2 Hour' => 'Monatsübersicht (Skalierung 2 Stunden', '`Yearly\' Graph \(1 Day' => 'Jahresübersicht (Skalierung 1 Tag', 'Incoming Traffic in (\S+) per Second' => 'Hereinkommender Traffic in $1 pro Sekunde', 'Outgoing Traffic in (\S+) per Second' => 'Hinausgehender Traffic in $1 pro Sekunde', 'Incoming Traffic in (\S+) per Minute' => 'Hereinkommender Traffic in $1 pro Minute', 'Outgoing Traffic in (\S+) per Minute' => 'Hinausgehender Traffic in $1 pro Minute', 'Incoming Traffic in (\S+) per Hour' => 'Hereinkommender Traffic in $1 pro Stunde', 'Outgoing Traffic in (\S+) per Hour' => 'Hinausgehender Traffic in $1 pro Stunde', 'at which time (.*) had been up for(.*)' => 'zu diesem Zeitpunkt lief $1 seit $2', '(\S+) per minute' => '$1 pro Minute', '(\S+) per hour' => '$1 pro Stunde', '(.+)/s$' => '$1/s', # '(.+)/min' => '$1/min', '(.+)/h$' => '$1/std', #'([kMG]?)([bB])/s' => '$1$2/s', #'([kMG]?)([bB])/min' => '$1$2/min', #'([kMG]?)([bB])/h' => '$1$2/std', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Herein', 'Out' => 'Hinaus', 'Percentage' => 'Prozent', 'Ported to OpenVMS Alpha by' => 'Portierung nach OpenVMS von', 'Ported to WindowsNT by' => 'Portierung nach WindowsNT von', 'and' => 'und', '^GREEN' => 'GRÜN', 'BLUE' => 'BLAU', 'DARK GREEN' => 'DUNKELGRÜN', # 'MAGENTA' => 'ROSA', # 'AMBER' => 'AMBER', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Sonntag', 'Sun' => 'So', 'Monday' => 'Montag', 'Mon' => 'Mo', 'Tuesday' => 'Dienstag', 'Tue' => 'Di', 'Wednesday' => 'Mittwoch', 'Wed' => 'Mi', 'Thursday' => 'Donnerstag', 'Thu' => 'Do', 'Friday' => 'Freitag', 'Fri' => 'Fr', 'Saturday' => 'Samstag', 'Sat' => 'Sa' ); %month = ( 'January' => 'Januar', 'February' => 'Februar' , 'March' => 'März', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mär', 'April' => 'April', 'May' => 'Mai', 'June' => 'Juni', 'Apr' => 'Apr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Juli', 'August' => 'August', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Aug', 'Sep' => 'Sep', 'October' => 'Oktober', 'November' => 'November', 'December' => 'Dezember', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Dez' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." um ".$quux[1]; }; return "$wday{$foo[0]}, den $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Greek sub greek { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'iso-8859-7', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => ' ', 'The statistics were last updated(.*)' => ' ()/ $1', ' Average\)' => ' )', 'Average' => ' ', 'Max' => '', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => ' ( $1 :', '`Weekly\' Graph \(30 Minute' => ' ( 30 :' , '`Monthly\' Graph \(2 Hour' => ' ( 2 :', '`Yearly\' Graph \(1 Day' => ' ( 1 :', 'Incoming Traffic in (\S+) per Second' => ' $1 ', 'Outgoing Traffic in (\S+) per Second' => ' $1 ', 'at which time (.*) had been up for(.*)' => ' $1 $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => '', 'Out' => '', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha ', 'Ported to WindowsNT by' => ' WindowsNT ', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => ' ', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => '', 'Mon' => '', 'Tuesday' => '', 'Tue' => '', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." à $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Hungarian sub hungarian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-2', 'Maximal 5 Minute Incoming Traffic' => 'Maximális bejövõ forgalom 5 perc alatt', 'Maximal 5 Minute Outgoing Traffic' => 'Maximális kimenõ forgalom 5 perc alatt', 'the device' => 'az eszköz', 'The statistics were last updated(.*)' => 'A statisztika utolsó frissítése:$1', ' Average\)' => ' átlag)', 'Average' => 'Átlagos', 'Max' => 'Maximum', 'Current' => 'Pillanatnyi', 'version' => 'verzió', '`Daily\' Graph \((.*) Minute' => '`Napi\' grafikon ($1 perces', '`Weekly\' Graph \(30 Minute' => '`Heti\' grafikon (30 perces' , '`Monthly\' Graph \(2 Hour' => '`Havi\' grafikon (2 órás', '`Yearly\' Graph \(1 Day' => '`Éves\' grafikon (1 napos', 'Incoming Traffic in (\S+) per Second' => 'Bejövõ forgalom $1 per másodpercben', 'Outgoing Traffic in (\S+) per Second' => 'Kimenõ forgalom $1 per másodpercben', 'at which time (.*) had been up for(.*)' => 'amikor a $1 üzemideje $2 volt.', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', 'Bits' => 'Bit', 'Bytes' => 'Byte', 'In' => 'be', 'Out' => 'ki', 'Percentage' => 'százale´k', 'Ported to OpenVMS Alpha by' => 'OpenVMS-re portolta', 'Ported to WindowsNT by' => 'WindowsNT-re portolta', 'and' => 'és', '^GREEN' => 'ZÖLD', 'BLUE' => 'KÉK', 'DARK GREEN' => 'SÖTÉT ZÖLD', 'MAGENTA' => 'BÍBOR', 'AMBER' => 'SÁRGA' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'vasárnap', 'Sun' => 'vas', 'Monday' => 'hétfõ', 'Mon' => 'hét', 'Tuesday' => 'kedd', 'Tue' => 'kedd', 'Wednesday' => 'szerda', 'Wed' => 'sze', 'Thursday' => 'csütörtök','Thu' => 'csüt', 'Friday' => 'péntek', 'Fri' => 'pén', 'Saturday' => 'szombat', 'Sat' => 'szo' ); %month = ( 'January' => 'január', 'February' => 'február' , 'March' => 'március', 'Jan' => 'jan', 'Feb' => 'feb', 'Mar' => 'marc', 'April' => 'április', 'May' => 'május', 'June' => 'június', 'Apr' => 'apr', 'May' => 'maj', 'Jun' => 'jun', 'July' => 'július', 'August' => 'augusztus', 'September' => 'szeptember', 'Jul' => 'jul', 'Aug' => 'aug', 'Sep' => 'szept', 'October' => 'október', 'November' => 'november', 'December' => 'december', 'Oct' => 'okt', 'Nov' => 'nov', 'Dec' => 'dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$quux[0]. $month{$foo[2]} $foo[1]., $wday{$foo[0]} $quux[1]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Icelandic sub icelandic { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Hámarks 5 mínútna umferð inn', 'Maximal 5 Minute Outgoing Traffic' => 'Hámarks 5 mínútna umferð út', 'the device' => 'tkið', 'The statistics were last updated(.*)' => 'Gögnin voru síðast uppfærð$1', ' Average\)' => ' Meðaltal)', 'Average' => 'Meðaltal', 'Max' => 'Hámark', 'Current' => 'Nú', 'version' => 'útgáfa', '`Daily\' Graph \((.*) Minute' => '`Dagleg\' staða ($1 mínútur', '`Weekly\' Graph \(30 Minute' => '`Vikuleg\' staða (30 mínútur', '`Monthly\' Graph \(2 Hour' => '`Mánaðarleg\' staða (2 klst.', '`Yearly\' Graph \(1 Day' => '`&Aarleg\' staða (1 dags', 'Incoming Traffic in (\S+) per Second' => 'Umferð inn í $1 á sekúndu', 'Outgoing Traffic in (\S+) per Second' => 'Umferð út í $1 á sekúndu', 'at which time (.*) had been up for(.*)' => 'þegar $1 hafði verið uppi í$2', # '([kMG]?)([bB])/s' => '\$1\$2/sek', # '([kMG]?)([bB])/min' => '\$1\$2/mín', '([kMG]?)([bB])/h' => '$1$2/klst', # 'Bits' => 'Bitar', # 'Bytes' => 'Bæti' 'In' => 'Inn', 'Out' => 'Út', 'Percentage' => 'Prósent', 'Ported to OpenVMS Alpha by' => 'Staðfært á OpenVMS af', 'Ported to WindowsNT by' => 'Staðfært á WindowsNT af', 'and' => 'og', '^GREEN' => 'GRÆNt', 'BLUE' => 'BLÁTT', 'DARK GREEN' => 'DÖKK GRÆNN', 'MAGENTA' => 'BLÁRAUÐUR', 'AMBER' => 'GULBRÚNN' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Sunnudagur', 'Sun' => 'Sun', 'Monday' => 'Mánudagur', 'Mon' => 'Mán', 'Tuesday' => 'Þriðjudagur', 'Tue' => 'Þri', 'Wednesday' => 'Miðvikudagur', 'Wed' => 'Mið', 'Thursday' => 'Fimmtudagur', 'Thu' => 'Fim', 'Friday' => 'Föstudagur', 'Fri' => 'Fös', 'Saturday' => 'Laugardagur', 'Sat' => 'Lau' ); %month = ( 'January' => 'Janúar', 'February' => 'Febrúar' , 'March' => 'Mars', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'Apríl', 'May' => 'Maí', 'June' => 'Júní', 'Apr' => 'Apr', 'May' => 'Maí', 'Jun' => 'Jún', 'July' => 'Júlí', 'August' => 'Ágúst', 'September' => 'September', 'Jul' => 'Júl', 'Aug' => 'Ágú', 'Sep' => 'Sep', 'October' => 'Október', 'November' => 'Nóvember', 'December' => 'Desember', 'Oct' => 'Okt', 'Nov' => 'Nóv', 'Dec' => 'Des' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]} den $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Malaysian/Indonesian/Malay sub indonesia { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Trafik Masuk Maksimum dalam 5 Menit', 'Maximal 5 Minute Outgoing Traffic' => 'Trafik Keluar Maksimum dalam 5 Menit', 'the device' => 'device', 'The statistics were last updated(.*)' => 'Statistik ini terakhir kali diupdate pada $1', ' Average\)' => ')', 'Average' => 'Rata-rata', 'Max' => 'Maksimum', 'Current' => 'Sekarang', 'version' => 'versi', '`Daily\' Graph \((.*) Minute' => 'Grafik Harian (Rata-rata per $1 menit', '`Weekly\' Graph \(30 Minute' => 'Grafik Mingguan (Rata-rata per 30 menit', '`Monthly\' Graph \(2 Hour' => 'Grafik Bulanan (Rata-rata per 2 jam', '`Yearly\' Graph \(1 Day' => 'Grafik Tahunan (Rata-rata per hari', 'Incoming Traffic in (\S+) per Second' => 'Trafik Masuk $1 per detik', 'Outgoing Traffic in (\S+) per Second' => 'Trafik Keluar $1 per detik', 'at which time (.*) had been up for(.*)' => 'Pada saat $1 telah aktif selama $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/j', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Masuk', 'Out' => 'Keluar', 'Percentage' => 'Persentase', 'Ported to OpenVMS Alpha by' => 'Porting ke OpenVMS Alpha oleh', 'Ported to WindowsNT by' => 'Porting ke WindowsNT oleh', 'and' => 'dan', '^GREEN' => 'HIJAU', 'BLUE' => 'BIRU', 'DARK GREEN' => 'HIJAU GELAP', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Ahad', 'Sun' => 'Aha', 'Monday' => 'Senin', 'Mon' => 'Sen', 'Tuesday' => 'Selasa', 'Tue' => 'Sel', 'Wednesday' => 'Rabu', 'Wed' => 'Rab', 'Thursday' => 'Kamis', 'Thu' => 'Kam', 'Friday' => 'Jumat', 'Fri' => 'Jum', 'Saturday' => 'Sabtu', 'Sat' => 'Sab' ); %month = ( 'January' => 'Januari', 'February' => 'Februari' , 'March' => 'Maret', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'April', 'May' => 'Mei', 'June' => 'Juni', 'Apr' => 'Apr', 'May' => 'Mei', 'Jun' => 'Jun', 'July' => 'Juli', 'August' => 'Agustus', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Ags', 'Sep' => 'Sep', 'October' => 'Oktober', 'November' => 'November', 'December' => 'Desember', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Des' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." pada ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # iso2022jp sub iso2022jp { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( '^iso-8859-1' => 'iso-2022-jp', '^Maximal 5 Minute Incoming Traffic' => '\e\\$B:GBg\e(B5\e\\$BJ, '\e\\$B:GBg\e(B5\e\\$BJ,Aw?.NL\e(B', '^the device' => '\e\\$B%G%P%\\$%9\e(B', '^The statistics were last updated (.*)' => '\e\\$B99?7F|;~\e(B $1', '^Average\)' => '\e\\$BJ?6Q\e(B)', '^Average$' => '\e\\$BJ?6Q\e(B', '^Max$' => '\e\\$B:GBg\e(B', '^Current' => '\e\\$B:G?7\e(B', '^`Daily\' Graph \((.*) Minute' => '\e\\$BF|%0%i%U\e(B($1\e\\$BJ,4V\e(B', '^`Weekly\' Graph \(30 Minute' => '\e\\$B=5%0%i%U\e(B(30\e\\$BJ,4V\e(B', '^`Monthly\' Graph \(2 Hour' => '\e\\$B7n%0%i%U\e(B(2\e\\$B;~4V\e(B', '^`Yearly\' Graph \(1 Day' => '\e\\$BG/%0%i%U\e(B(1\e\\$BF|\e(B', '^Incoming Traffic in (\S+) per Second' => '\e\\$BKhIC\\$N '\e\\$BKhJ,\\$N '\e\\$BKh;~\\$N '\e\\$BKhIC\\$NAw?.\e(B$1\e\\$B?t\e(B', '^Outgoing Traffic in (\S+) per Minute' => '\e\\$BKhJ,\\$NAw?.\e(B$1\e\\$B?t\e(B', '^Outgoing Traffic in (\S+) per Hour' => '\e\\$BKh;~\\$NAw?.\e(B$1\e\\$B?t\e(B', '^at which time (.*) had been up for (.*)' => '$1\e\\$B\\$N2TF/;~4V\e(B $2', '^Average max 5 min values for `Daily\' Graph \((.*) Minute interval\):' => '\e\\$BF|%0%i%U\\$G\\$N:GBg\e(B5\e\\$BJ,CM\\$NJ?6Q\e(B($1\e\\$BJ,4V3V\e(B):', '^Average max 5 min values for `Weekly\' Graph \(30 Minute interval\):' => '\e\\$B=5%0%i%U\\$G\\$N:GBg\e(B5\e\\$BJ,CM\\$NJ?6Q\e(B(30\e\\$BJ,4V3V\e(B):', '^Average max 5 min values for `Monthly\' Graph \(2 Hour interval\):' => '\e\\$B7n%0%i%U\\$G\\$N:GBg\e(B5\e\\$BJ,CM\\$NJ?6Q\e(B(2\e\\$B;~4V4V3V\e(B):', '^Average max 5 min values for `Yearly\' Graph \(1 Day interval\):' => '\e\\$BG/%0%i%U\\$G\\$N:GBg\e(B5\e\\$BJ,CM\\$NJ?6Q\e(B(1\e\\$BF|4V3V\e(B):', #'^([kMG]?)([bB])/s' => '$1$2/\e\\$BIC\e(B', #'^([kMG]?)([bB])/min' => '$1$2/\e\\$BJ,\e(B', #'^([kMG]?)([bB])/h' => '$1$2/\e\\$B;~\e(B', '^Bits$' => '\e\\$B%S%C%H\e(B', '^Bytes$' => '\e\\$B%P%\\$%H\e(B', '^In$' => '\e\\$B '\e\\$BAw?.\e(B', '^Percentage' => '\e\\$BHfN(\e(B', '^Ported to OpenVMS Alpha by' => 'OpenVMS Alpha\e\\$B\\$X\\$N0\\\?"\e(B', '^Ported to WindowsNT by' => 'WindowsNT\e\\$B\\$X\\$N0\\\?"\e(B', #'^and' => 'and', '^GREEN' => '\e\\$BNP\e(B', '^BLUE' => '\e\\$B\\@D\e(B', '^DARK GREEN' => '\e\\$B? '\e\\$B%^%<%s%?\e(B', '^AMBER' => '\e\\$B`h`a\e(B' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => "(\e\$BF|\e(B)", 'Monday' => "(\e\$B7n\e(B)", 'Tuesday' => "(\e\$B2P\e(B)", 'Wednesday' => "(\e\$B?e\e(B)", 'Thursday' => "(\e\$BLZ\e(B)", 'Friday' => "(\e\$B6b\e(B)", 'Saturday' => "(\e\$BEZ\e(B)", ); %month = ( 'January' => "1\e\$B7n\e(B", 'February' => "2\e\$B7n\e(B", 'March' => "3\e\$B7n\e(B", 'April' => "4\e\$B7n\e(B", 'May' => "5\e\$B7n\e(B", 'June' => "6\e\$B7n\e(B", 'July' => "7\e\$B7n\e(B", 'August' => "8\e\$B7n\e(B", 'September' => "9\e\$B7n\e(B", 'October' => "10\e\$B7n\e(B", 'November' => "11\e\$B7n\e(B", 'December' => "12\e\$B7n\e(B", ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)\s+(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~/at/) { @quux=split(/\s+at\s+/,$foo[3]); } else { @quux=split(/ /,$foo[3],2); }; return "$quux[0]\e\$BG/\e(B$month{$foo[2]}$foo[1]\e\$BF|\e(B$wday{$foo[0]} $quux[1]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Italian sub italian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Traffico massimo in entrata su 5 minuti', 'Maximal 5 Minute Outgoing Traffic' => 'Traffico massimo in uscita su 5 minuti', 'the device' => 'Il dispositivo', 'The statistics were last updated(.*)' => 'Le statistiche l\' ultima volta sono state aggiornate $1', ' Average\)' => ' Media)', 'Average' => 'Media', 'Max' => 'Max', 'Current' => 'Attuale', 'version' => 'versione', '`Daily\' Graph \((.*) Minute' => 'Grafico giornaliero (su $1 minuti:', '`Weekly\' Graph \(30 Minute' => 'Grafico settimanale (su 30 minuti:' , '`Monthly\' Graph \(2 Hour' => 'Grafico mensile (su 2 ore:', '`Yearly\' Graph \(1 Day' => 'Grafico annuale (su 1 giorno:', 'Incoming Traffic in (\S+) per Second' => 'Traffico in ingresso in $1 per Secondo', 'Outgoing Traffic in (\S+) per Second' => 'Traffico in uscita in $1 per Secondo', 'Incoming Traffic in (\S+) per Minute' => 'Traffico in ingresso in $1 per Minuto', 'Outgoing Traffic in (\S+) per Minute' => 'Traffico in uscita $1 per Minuto', 'Incoming Traffic in (\S+) per Hour' => 'Traffico in ingresso $1 per Ora', 'Outgoing Traffic in (\S+) per Hour' => 'Traffico in uscita $1 per Ora', 'at which time (.*) had been up for(.*)' => '$1 é attivo da $2', '(\S+) per minute' => '$1 per Minuto', '(\S+) per hour' => '$1 per Ora', '(.+)/s$' => '$1/s', # '(.+)/min' => '$1/min', '(.+)/h$' => '$1/ora', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Ingresso', 'Out' => 'Uscita', 'Percentage' => 'Percentuale', 'Ported to OpenVMS Alpha by' => 'Ported su OpenVMS Alpha da', 'Ported to WindowsNT by' => 'Ported su WindowsNT da', 'and' => 'e', '^GREEN' => 'VERDE', 'BLUE' => 'BLU', 'DARK GREEN' => 'VERDE SCURO', #'MAGENTA' => 'MAGENTA', #'AMBER' => 'AMBRA' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Domenica', 'Sun' => 'Dom', 'Monday' => 'Lunedi', 'Mon' => 'Lun', 'Tuesday' => 'Martedi', 'Tue' => 'Mar', 'Wednesday' => 'Mercoledi', 'Wed' => 'Mer', 'Thursday' => 'Giovedi', 'Thu' => 'Gio', 'Friday' => 'Venerdi', 'Fri' => 'Ven', 'Saturday' => 'Sabato', 'Sat' => 'Sab' ); %month = ( 'January' => 'Gennaio', 'February' => 'Febbraio' , 'March' => 'Marzo', 'Jan' => 'Gen', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'Aprile', 'May' => 'Maggio', 'June' => 'Giugno', 'Apr' => 'Apr', 'May' => 'Mag', 'Jun' => 'Giu', 'July' => 'Luglio', 'August' => 'Agosto', 'September' => 'Settembre', 'Jul' => 'Lug', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Ottobre', 'November' => 'Novembre', 'December' => 'Dicembre', 'Oct' => 'Ott', 'Nov' => 'Nov', 'Dec' => 'Dic' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." alle ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." à $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Korean sub korean { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'euc-kr', 'Maximal 5 Minute Incoming Traffic' => '5а ִ ', 'Maximal 5 Minute Outgoing Traffic' => '5а ִ ۽', 'the device' => 'ġ', 'The statistics were last updated(.*)' => ' Ͻ: $1', ' Average\)' => ' հ )', 'Average' => '', 'Max' => 'ִ', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => 'ϰ ׷ ($1 ', '`Weekly\' Graph \(30 Minute' => 'ְ ׷ (30 ' , '`Monthly\' Graph \(2 Hour' => ' ׷ (2 ð ', '`Yearly\' Graph \(1 Day' => ' ׷ (1 ', 'Incoming Traffic in (\S+) per Second' => 'ʴ ŵ Ʈ ($1)', 'Outgoing Traffic in (\S+) per Second' => 'ʴ ۽ŵ Ʈ ($1)', 'at which time (.*) had been up for(.*)' => '$1 ð: $2', '([kMG]?)([bB])/s' => '$1$2/', '([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', 'Bits' => 'Ʈ', 'Bytes' => 'Ʈ', 'In' => '', 'Out' => '۽', 'Percentage' => 'ۼƮ', 'Ported to OpenVMS Alpha by' => 'OpenVMS Alpha ', 'Ported to WindowsNT by' => 'WindowsNT ', 'and' => '', '^GREEN' => '', 'BLUE' => 'û', 'DARK GREEN' => 'ѳ', 'MAGENTA' => 'ȫ', 'AMBER' => 'Ȳ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Ͽ', 'Sun' => '', 'Monday' => '', 'Mon' => '', 'Tuesday' => 'ȭ', 'Tue' => 'ȭ', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => 'ݿ', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => '1', 'February' => '2' , 'March' => '3', 'Jan' => '1', 'Feb' => '2', 'Mar' => '3', 'April' => '4', 'May' => '5', 'June' => '6', 'Apr' => '4', 'May' => '5', 'Jun' => '6', 'July' => '7', 'August' => '8', 'September' => '9', 'Jul' => '7', 'Aug' => '8', 'Sep' => '9', 'October' => '10', 'November' => '11', 'December' => '12', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); # $foo[3]=$quux[0]." kl.".$quux[1]; $foo[3]=$quux[0]; $foo[4]=$quux[1]; }; return $foo[3]." $month{$foo[2]} $foo[1] $wday{$foo[0]} $foo[4]"; # return "$wday{$foo[0]} den $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Lithuanian sub lithuanian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1257', 'Maximal 5 Minute Incoming Traffic' => 'Maksimalus 5 minui einantis srautas', 'Maximal 5 Minute Outgoing Traffic' => 'Maksimalus 5 minui ieinantis srautas', 'the device' => 'renginys', 'The statistics were last updated(.*)' => 'Statistika atnaujinta$1', ' Average\)' => ' vidurkis)', 'Average' => 'vid', 'Max' => 'max', 'Current' => 'dabar', 'version' => 'versija', '`Daily\' Graph \((.*) Minute' => '\'dienos\' grafikas ($1 min.', '`Weekly\' Graph \(30 Minute' => '\'savaits\' grafikas (30 min.' , '`Monthly\' Graph \(2 Hour' => '\'mnesio\' grafikas (2 val.', '`Yearly\' Graph \(1 Day' => '\'met\' grafikas (1 d.', 'Incoming Traffic in (\S+) per Second' => 'einantis srautas, $1 per sekund', 'Outgoing Traffic in (\S+) per Second' => 'Ieinantis srautas i $1 per sekund', 'at which time (.*) had been up for(.*)' => '$1 veikia jau $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bitai', 'Bytes' => 'baitai', 'In' => '', 'Out' => 'i', 'Percentage' => 'procentai', 'Ported to OpenVMS Alpha by' => 'Perkl OpenVMS Alpha:', 'Ported to WindowsNT by' => 'Perkl WindowsNT:', 'and' => 'ir', '^GREEN' => 'ALIA ', 'BLUE' => 'MLYNA ', 'DARK GREEN' => 'TAMSIAI ALIA ', 'MAGENTA' => 'RAUDONA ', 'AMBER' => 'GINTARIN ' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'sekmadien', 'Sun' => 'Sek', 'Monday' => 'pirmadien', 'Mon' => 'Pir', 'Tuesday' => 'antradien', 'Tue' => 'Ant', 'Wednesday' => 'treiadien', 'Wed' => 'Tre', 'Thursday' => 'ketvirtadien', 'Thu' => 'Ket', 'Friday' => 'penktadien', 'Fri' => 'Pen', 'Saturday' => 'etadien', 'Sat' => 'e' ); %month = ( 'January' => 'sausio', 'February' => 'vasario' , 'March' => 'kovo', 'Jan' => 'Sau', 'Feb' => 'Vas', 'Mar' => 'Kov', 'April' => 'balandio', 'May' => 'gegus', 'June' => 'birelio', 'Apr' => 'Bal', 'May' => 'Geg', 'Jun' => 'Bir', 'July' => 'liepos', 'August' => 'rugpjio', 'September' => 'rugsjo', 'Jul' => 'Lie', 'Aug' => 'Rgp', 'Sep' => 'Rgs', 'October' => 'spalio', 'November' => 'lapkriio', 'December' => 'gruodio', 'Oct' => 'Spa', 'Nov' => 'Lap', 'Dec' => 'Gru' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[1].", ".$quux[0]; }; return "$foo[3] $month{$foo[2]} $foo[1], $wday{$foo[0]}" ; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Macedonian sub macedonian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=windows-1251', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => '', 'The statistics were last updated(.*)' => ' $1', ' Average\)' => ' )', 'Average' => '', 'Max' => '', 'Current' => 'o', 'version' => '', '`Daily\' Graph \((.*) Minute' => '`\' ($1 ', '`Weekly\' Graph \(30 Minute' => '`\' (30 ' , '`Monthly\' Graph \(2 Hour' => '`\' (2 ', '`Yearly\' Graph \(1 Day' => '`\' (1 ', 'Incoming Traffic in (\S+) per Second' => ' - $1 ', 'Outgoing Traffic in (\S+) per Second' => ' - $1 ', 'at which time (.*) had been up for(.*)' => ' $1 : $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/h', # 'Bits' => '', # 'Bytes' => '' 'In' => '', 'Out' => '', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS ', 'Ported to WindowsNT by' => ' WindowsNT ', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => ' ', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => '', 'Sun' => '', 'Monday' => '', 'Mon' => '', 'Tuesday' => '', 'Tue' => '', 'Wednesday' => '', 'Wed' => '', 'Thursday' => '', 'Thu' => '', 'Friday' => '', 'Fri' => '', 'Saturday' => '', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; };# Malaysian/Malay sub malay { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maksimum 5 Minit Trafik Masuk', 'Maximal 5 Minute Outgoing Traffic' => 'Maksimum 5 Minit Trafik Keluar', 'the device' => 'alatan', 'The statistics were last updated(.*)' => 'Statistik ini kali terakhir dikemaskini pada $1', ' Average\)' => ' secara purata)', 'Average' => 'Purata', 'Max' => 'Maksimum', 'Current' => 'Kini', 'version' => 'versi', '`Daily\' Graph \((.*) Minute' => 'Graf `Harian\' ($1 minit :', '`Weekly\' Graph \(30 Minute' => 'Graf `Mingguan\' (30 minit :' , '`Monthly\' Graph \(2 Hour' => 'Graf `Bulanan\' (2 jam :', '`Yearly\' Graph \(1 Day' => 'Graf `Tahunan\' (1 hari :', 'Incoming Traffic in (\S+) per Second' => 'Trafik Masuk $1 per saat', 'Outgoing Traffic in (\S+) per Second' => 'Traffic Keluar $1 per saat', 'at which time (.*) had been up for(.*)' => 'Sehingga waktu $1 ia telah aktif selama $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/j', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Masuk', 'Out' => 'Keluar', 'Percentage' => 'Peratus', 'Ported to OpenVMS Alpha by' => 'Pengubahsuaian ke OpenVMS Alpha oleh', 'Ported to WindowsNT by' => 'Pengubahsuaian ke WindowsNT oleh', 'and' => 'dan', '^GREEN' => 'HIJAU', 'BLUE' => 'BIRU', 'DARK GREEN' => 'HIJAU GELAP', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Ahad', 'Sun' => 'Aha', 'Monday' => 'Isnin', 'Mon' => 'Isn', 'Tuesday' => 'Selasa', 'Tue' => 'Sel', 'Wednesday' => 'Rabu', 'Wed' => 'Rab', 'Thursday' => 'Khamis', 'Thu' => 'Kha', 'Friday' => 'Jumaat', 'Fri' => 'Jum', 'Saturday' => 'Sabtu', 'Sat' => 'Sab' ); %month = ( 'January' => 'Januari', 'February' => 'Februari' , 'March' => 'Mac', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mac', 'April' => 'April', 'May' => 'Mei', 'June' => 'Jun', 'Apr' => 'Apr', 'May' => 'Mei', 'Jun' => 'Jun', 'July' => 'Julai', 'August' => 'Ogos', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Ogo', 'Sep' => 'Sep', 'October' => 'Oktober', 'November' => 'November', 'December' => 'Disember', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Dis' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." pada ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Norwegian sub norwegian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maksimal inngående trafikk i 5 minutter', 'Maximal 5 Minute Outgoing Traffic' => 'Maksimal utgående trafikk i 5 minutter', 'the device' => 'enhetden', 'The statistics were last updated(.*)' => 'Statistikken ble sist oppdatert $1', ' Average\)' => ' gjennomsnitt)', 'Average' => 'Gjennomsnitt', 'Max' => 'Max', 'Current' => 'Nå', 'version' => 'versjon', '`Daily\' Graph \((.*) Minute' => '`Daglig\' graf ($1 minutts', '`Weekly\' Graph \(30 Minute' => '`Ukentlig\' graf (30 minutts' , '`Monthly\' Graph \(2 Hour' => '`Månedlig\' graf (2 times', '`Yearly\' Graph \(1 Day' => '`Årlig\' graf (1 dags', 'Incoming Traffic in (\S+) per Second' => 'Inngående trafikk i $1 per sekund', 'Outgoing Traffic in (\S+) per Second' => 'Utgående trafikk i $1 per sekund', 'at which time (.*) had been up for(.*)' => 'hvor $1 hadde vært oppe i $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Inn', 'Out' => 'Ut', 'Percentage' => 'Prosent', 'Ported to OpenVMS Alpha by' => 'Port til OpenVMS av', 'Ported to WindowsNT by' => 'Port til WindowsNT av', 'and' => 'og', '^GREEN' => 'GRØNN', 'BLUE' => 'BLÅ', 'DARK GREEN' => 'MØRKEGRØNN', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'GUL' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Søndag', 'Sun' => 'Søn', 'Monday' => 'Mandag', 'Mon' => 'Man', 'Tuesday' => 'Tirsdag', 'Tue' => 'Tir', 'Wednesday' => 'Onsdag', 'Wed' => 'Ons', 'Thursday' => 'Torsdag', 'Thu' => 'Tor', 'Friday' => 'Fredag', 'Fri' => 'Fre', 'Saturday' => 'Lørdag', 'Sat' => 'Lør' ); %month = ( 'January' => 'Januar', 'February' => 'Februar' , 'March' => 'Mars', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'April', 'May' => 'Mai', 'June' => 'Juni', 'Apr' => 'Apr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Juli', 'August' => 'August', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Aug', 'Sep' => 'Sep', 'October' => 'Oktober', 'November' => 'November', 'December' => 'Desember', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Des' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]} den $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; sub polish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'iso-8859-2', 'Maximal 5 Minute Incoming Traffic' => 'Maksymalny ruch przychodzcy w cigu 5 minut', 'Maximal 5 Minute Outgoing Traffic' => 'Maksymalny ruch wychodzcy w cigu 5 minut', 'the device' => 'urzdzenie', 'The statistics were last updated(.*)' => 'Ostatnie uaktualnienie statystyki $1', ' Average\)' => ' rednia)', 'Average' => 'rednio', 'Max' => 'Maksymalnie', 'Current' => 'Aktualnie', 'version' => 'wersja', '`Daily\' Graph \((.*) Minute' => '`Dzienny\' Graf w cigu ($1 Minut/y - ', '`Weekly\' Graph \(30 Minute' => '`Tygodniowy\' Graf w cigu (30 minut - ' , '`Monthly\' Graph \(2 Hour' => '`Miesiczny\' Graf w cigu (2 Godzin - ', '`Yearly\' Graph \(1 Day' => '`Roczny\' Graf w cigu (1 Dnia - ', 'Incoming Traffic in (\S+) per Second' => 'Ruch przychodzcy - $1 na sekund', 'Outgoing Traffic in (\S+) per Second' => 'Ruch wychodzcy - $1 na sekund', 'at which time (.*) had been up for(.*)' => 'gdy $1 by wczony przez $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/g', 'Bits' => 'Bity', 'Bytes' => 'Bajty', 'In' => 'Do', 'Out' => 'Z', 'Percentage' => 'Procent', 'Ported to OpenVMS Alpha by' => 'Port dla OpenVMS Alpha dziki', 'Ported to WindowsNT by' => 'Port dla WindowsNT dziki', 'and' => 'i', '^GREEN' => 'ZIELONY', 'BLUE' => 'NIEBIESKI', 'DARK GREEN' => 'CIEMNO ZIELONY', 'MAGENTA' => 'KARMAZYNOWY', 'AMBER' => 'BURSZTYNOWY' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Niedziela', 'Sun' => 'Nie', 'Monday' => 'Poniedziaek', 'Mon' => 'Pon', 'Tuesday' => 'Wtorek', 'Tue' => 'Wto', 'Wednesday' => 'roda', 'Wed' => 'ro', 'Thursday' => 'Czwartek', 'Thu' => 'Czw', 'Friday' => 'Pitek', 'Fri' => 'Pi', 'Saturday' => 'Sobota', 'Sat' => 'Sob' ); %month = ( 'January' => 'Stycznia', 'February' => 'Lutego', 'March' => 'Marca', 'Jan' => 'Sty', 'Feb' => 'Lut', 'Mar' => 'Mar', 'April' => 'Kwietnia', 'May' => 'Maja', 'June' => 'Czerwca', 'Apr' => 'Kwi', 'May' => 'Maj', 'Jun' => 'Cze', 'July' => 'Lipca', 'August' => 'Sierpnia', 'September' => 'Wrzenia', 'Jul' => 'Lip', 'Aug' => 'Sie', 'Sep' => 'Wrz', 'October' => 'Padziernika', 'November' => 'Listopada', 'December' => 'Grudnia', 'Oct' => 'Pa', 'Nov' => 'Lis', 'Dec' => 'Gru' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." o godzinie".$quux[1]; }; return "$wday{$foo[0]} dzie $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Portugus sub portuguese { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tráfego Maximal Recebido em 5 minutos', 'Maximal 5 Minute Outgoing Traffic' => 'Tráfego Maximal Enviado em 5 minutos', 'the device' => 'o dispositivo', 'The statistics were last updated(.*)' => 'As Estatísticas foram actualizadas pela última vez na $1', ' Average\)
' => '', 'Average' => 'Média', 'Max' => 'Max.', 'Current' => 'Actual', 'version' => 'Versão', '`Daily\' Graph \((.*) Minute' => 'Gráfico Diário (em intervalos de $1 Minutos)
', '`Weekly\' Graph \(30 Minute' => 'Gráfico Semanal (em intervalos de 30 Minutos)' , '`Monthly\' Graph \(2 Hour' => 'Gráfico Mensal (em intervalos de 2 horas)', '`Yearly\' Graph \(1 Day' => 'Gráfico Anual (em intervalos de 24 horas)', 'Incoming Traffic in (\S+) per Second' => 'Tráfego recebido em $1/segundo', 'Outgoing Traffic in (\S+) per Second' => 'Tráfego enviado em $1/segundo', 'Incoming Traffic in (\S+) per Minute' => 'Tráfego recebido em $1/minuto', 'Outgoing Traffic in (\S+) per Minute' => 'Tráfego enviado em $1/minuto', 'Incoming Traffic in (\S+) per Hour' => 'Tráfego recebido em $1/hora', 'Outgoing Traffic in (\S+) per Hour' => 'Tráfego recebido em $1/hora', 'at which time (.*) had been up for(.*)' => 'quando o $1, tinha um uptime de $2', '(\S+) per minute' => '$1/minuto', '(\S+) per hour' => '$1/hora', '(.+)/s$' => '$1/s', # '(.+)/min' => '$1/min', '(.+)/h$' => '$1/h', #'([kMG]?)([bB])/s' => '$1$2/s', #'([kMG]?)([bB])/min' => '$1$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Rec.', 'Out' => 'Env.', 'Percentage' => 'Perc.', 'Ported to OpenVMS Alpha by' => 'Portado para OpenVMS Alpha por', 'Ported to WindowsNT by' => 'Portado para WindowsNT por', 'and' => 'e', '^GREEN' => 'VERDE', 'BLUE' => 'AZUL', 'DARK GREEN' => 'VERDE ESCURO', # 'MAGENTA' => 'MAGENTA', # 'AMBER' => 'AMBAR', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Domingo', 'Sun' => 'Dom', 'Monday' => 'Segunda-Feira', 'Mon' => 'Seg', 'Tuesday' => 'Terça-Feira', 'Tue' => 'Ter', 'Wednesday' => 'Quarta-Feira', 'Wed' => 'Qua', 'Thursday' => 'Quinta-Feira', 'Thu' => 'Qui', 'Friday' => 'Sexta-Feira', 'Fri' => 'Sex', 'Saturday' => 'Sábado', 'Sat' => 'Sab' ); %month = ( 'January' => 'Janeiro', 'February' => 'Fevereiro' , 'March' => 'Março', 'Jan' => 'Jan', 'Feb' => 'Fev', 'Mar' => 'Mar', 'April' => 'Abril', 'May' => 'Maio', 'June' => 'Junho', 'Apr' => 'Abr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Julho', 'August' => 'Agosto', 'September' => 'Setembro', 'Jul' => 'Jul', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Outubro', 'November' => 'Novembro', 'December' => 'Dezembro', 'Oct' => 'Out', 'Nov' => 'Nov', 'Dec' => 'Dez' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." pelas ".$quux[1]; }; return "$wday{$foo[0]}, $foo[1] de $month{$foo[2]} de $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Romanian sub romanian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-8859-2 %translations = ( 'iso-8859-1' => 'iso-8859-2', 'Maximal 5 Minute Incoming Traffic' => 'Traficul Maxim de intrare pe 5 Minute', 'Maximal 5 Minute Outgoing Traffic' => 'Traficul Maxim de iesire pe 5 Minute', 'the device' => 'echipamentul', 'The statistics were last updated(.*)' => 'Ultima actualizare :$1', ' Average\)' => '', 'Average' => 'Medie', 'Max' => 'Maxim', 'Current' => 'Curent', 'version' => 'versiunea', '`Daily\' Graph \((.*) Minute' => 'Graficul \'Zilnic\' (medie pe $1 minute)', '`Weekly\' Graph \(30 Minute' => 'Graficul \'Sptmnal\' (medie pe 30 de minute)' , '`Monthly\' Graph \(2 Hour' => 'Graficul \'Lunar\' (medie pe 2 ore)', '`Yearly\' Graph \(1 Day' => 'Graficul \'Anual\' (medie pe 1 zi)', 'Incoming Traffic in (\S+) per Second' => 'Traficul de intrare [$1/secund]', 'Outgoing Traffic in (\S+) per Second' => 'Traficul de ieire [$1/secund]', 'at which time (\S+) had been up for (\S+)' => 'cnd $1 funciona de $2', 'at which time (\S+) had been up for (\S+) day, (\S+)' => 'cnd $1 funciona de $2 zi, $3', 'at which time (\S+) had been up for (\S+) days, (\S+)' => 'cnd $1 funciona de $2 zile, $3', #'(.+)/s$' => '$1/s', #'(.+)/min' => '$1/min', '(.+)/h$' => '$1/ora', #'([kMG]?)([bB])/s' => '$1$2/s', #'([kMG]?)([bB])/min' => '$1$2/min', '([kMG]?)([bB])/h' => '$1$2/ora', 'Bits' => 'Bii', 'Bytes' => 'Octei', 'In' => 'int', 'Out' => 'ie', 'Percentage' => 'procent', 'Ported to OpenVMS Alpha by' => 'Translatat sub OpenVMS de', 'Ported to WindowsNT by' => 'Translatat sub WindowsNT de', 'and' => 'i', '^GREEN' => 'VERDE', 'BLUE' => 'ALBASTRU', 'DARK GREEN' => 'VERDE NCHIS', 'MAGENTA' => 'PURPURIU', 'AMBER' => 'GALBEN', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'duminic', 'Sun' => 'lu', 'Monday' => 'luni', 'Mon' => 'ma', 'Tuesday' => 'mari', 'Tue' => 'mi', 'Wednesday' => 'miercuri', 'Wed' => 'jo', 'Thursday' => 'joi', 'Thu' => 'vi', 'Friday' => 'vineri', 'Fri' => 's', 'Saturday' => 'smbt', 'Sat' => 'du' ); %month = ( 'January' => 'ianuarie', 'February' => 'februarie' , 'March' => 'martie', 'Jan' => 'ian', 'Feb' => 'feb', 'Mar' => 'mar', 'April' => 'aprilie', 'May' => 'mai', 'June' => 'iunie', 'Apr' => 'apr', 'May' => 'mai', 'Jun' => 'iun', 'July' => 'iulie', 'August' => 'august', 'September' => 'septembrie', 'Jul' => 'iul', 'Aug' => 'aug', 'Sep' => 'sep', 'October' => 'octombrie', 'November' => 'noiembrie', 'December' => 'decembrie', 'Oct' => 'oct', 'Nov' => 'noi', 'Dec' => 'dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].", ora ".$quux[1]; }; return "$wday{$foo[0]}, $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Russian sub russian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'koi8-r', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => '', 'The statistics were last updated(.*)' => ' : $1', ' Average\)' => ')', 'Average' => '', 'Max' => '.', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => ' ( $1 ', '`Weekly\' Graph \(30 Minute' => ' ( 30 ' , '`Monthly\' Graph \(2 Hour' => ' ( 2 ', '`Yearly\' Graph \(1 Day' => ' ( 1 ', 'Incoming Traffic in (\S+) per Second' => ' $1 ', 'Outgoing Traffic in (\S+) per Second' => ' $1 ', 'at which time (.*) had been up for(.*)' => ' $1 $2', #'([kMG]?)([bB])/s' => '$1$1/', #'([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', 'Bits' => '', 'Bytes' => '', 'In' => '', 'Out' => '', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha', 'Ported to WindowsNT by' => ' WindowsNT', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => '', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => ' ', 'Sun' => '', 'Monday' => ' ', 'Mon' => '', 'Tuesday' => ' ', 'Tue' => '', 'Wednesday' => ' ', 'Wed' => '', 'Thursday' => ' ', 'Thu' => '', 'Friday' => ' ', 'Fri' => '', 'Saturday' => ' ', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].". ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Russian1251 Code sub russian1251 { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1251', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => '', 'The statistics were last updated(.*)' => ' : $1', ' Average\)' => ')', 'Average' => ' ', 'Max' => '', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => ' ( $1 ', '`Weekly\' Graph \(30 Minute' => ' ( 30 ' , '`Monthly\' Graph \(2 Hour' => ' ( 2 ', '`Yearly\' Graph \(1 Day' => ' ( 1 ', 'Incoming Traffic in (\S+) per Second' => ' $1 ', 'Outgoing Traffic in (\S+) per Second' => ' $1 ', 'at which time (\S+) had been up for (\S+)' => ' $1: $2.', 'at which time (\S+) had been up for (\S+) day, (\S+)' => ' $1: $2 , $3.', 'at which time (\S+) had been up for (\S+) days, (\S+)' => ' $1: $2 , $3.', #'([kMG]?)([bB])/s' => '$1$1/', #'([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', 'Bits' => '', 'Bytes' => '', 'In' => '', 'Out' => '', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha', 'Ported to WindowsNT by' => ' WindowsNT', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => '', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => ' ', 'Sun' => '', 'Monday' => ' ', 'Mon' => '', 'Tuesday' => ' ', 'Tue' => '', 'Wednesday' => ' ', 'Wed' => '', 'Thursday' => ' ', 'Thu' => '', 'Friday' => ' ', 'Fri' => '', 'Saturday' => ' ', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].". ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Serbian sub serbian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1250', 'Maximal 5 Minute Incoming Traffic' => 'Najvei 5 minutni ulazni saobraaj', 'Maximal 5 Minute Outgoing Traffic' => 'Najvei 5 minutni izlazni saobraaj', 'the device' => 'uredjaj', 'The statistics were last updated(.*)' => 'Poslednje auriranje podataka:$1', ' Average\)' => ' prosek)', 'Average' => 'Proseni', 'Max' => 'Maksimalni', 'Current' => 'Trenutni', 'version' => 'verzija', '`Daily\' Graph \((.*) Minute' => 'Dnevni graf ($1 minutni ', '`Weekly\' Graph \(30 Minute' => 'Nedeljni graf (30 minutni ' , '`Monthly\' Graph \(2 Hour' => 'Meseni graf (2 sata ', '`Yearly\' Graph \(1 Day' => 'Godinji graf (1 dnevni ', 'Incoming Traffic in (\S+) per Second' => 'Ulazni saobraaj - $1 u sekundi.', 'Outgoing Traffic in (\S+) per Second' => 'Izlazni saobraaj - $1 u sekundi.', 'Incoming Traffic in (\S+) per Minute' => 'Ulazni saobraaj - $1 u minutu', 'Outgoing Traffic in (\S+) per Minute' => 'Izlazni saobraaj - $1 u minutu', 'Incoming Traffic in (\S+) per Hour' => 'Ulazni saobraaj - $1 na sat', 'Outgoing Traffic in (\S+) per Hour' => 'Izlazni saobraaj - $1 na sat', 'at which time (.*) had been up for(.*)' => 'Vreme neprekidnog rada sistema $1 : $2', #'([kMG]?)([bB])/s' => '\$1\$2/s', #'([kMG]?)([bB])/min' => '\$1\$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'Bita', 'Bytes' => 'Bajta', 'In' => 'Ulaz', 'Out' => 'Izlaz', 'Percentage' => 'Procenat', 'Ported to OpenVMS Alpha by' => 'Na OpenVMS portovao', 'Ported to WindowsNT by' => 'Na WindowsNT portovao', 'and' => 'i', '^GREEN' => 'Zeleno', 'BLUE' => 'Plavo', 'DARK GREEN' => 'Tamnozeleno', 'MAGENTA' => 'Ljubiasto', 'AMBER' => 'Narandasto' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Nedelja', 'Sun' => 'Ned', 'Monday' => 'Ponedeljak', 'Mon' => 'Pon', 'Tuesday' => 'Utorak', 'Tue' => 'Uto', 'Wednesday' => 'Sreda', 'Wed' => 'Sre', 'Thursday' => 'etvrtak', 'Thu' => 'et', 'Friday' => 'Petak', 'Fri' => 'Pet', 'Saturday' => 'Subota', 'Sat' => 'Sub' ); %month = ( 'January' => 'januar', 'February' => 'februar', 'March' => 'mart', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'april', 'May' => 'maj', 'June' => 'jun', 'Apr' => 'Apr', 'May' => 'Maj', 'Jun' => 'Jun', 'July' => 'jul', 'August' => 'avgust', 'September' => 'septembar', 'Jul' => 'Jul', 'Aug' => 'Avg', 'Sep' => 'Sep', 'October' => 'oktobar','November' => 'novembar','December' => 'decembar', 'Oct' => 'Okt', 'Nov' => 'Nov', 'Dec' => 'Dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].",".$quux[1]." "; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; } # # Slovak sub slovak { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'iso-8859-2', 'Maximal 5 Minute Incoming Traffic' => 'Maximlny 5 mintov prichdzajci tok', 'Maximal 5 Minute Outgoing Traffic' => 'Maximlny 5 mintov odchdzajci tok', 'the device' => 'zariadenie', 'The statistics were last updated(.*)' => 'Posledn aktualizcia tatistk:$1', ' Average\)' => ' priemer)', 'Average' => 'Priem.', 'Max' => 'Max.', 'Current' => 'Akt.', 'version' => 'verzia', '`Daily\' Graph \((.*) Minute' => 'Denn graf ($1 mintov', '`Weekly\' Graph \(30 Minute' => 'Tdenn graf (30 mintov' , '`Monthly\' Graph \(2 Hour' => 'Mesan graf (2 hodinov', '`Yearly\' Graph \(1 Day' => 'Ron graf (1 denn', 'Incoming Traffic in (\S+) per Second' => 'Prichdzajci tok v $1 za sekundu.', 'Outgoing Traffic in (\S+) per Second' => 'Odchdzajci tok v $1 za sekundu.', 'at which time (.*) had been up for(.*)' => 'as od poslednho retartu $1 : $2', #'([kMG]?)([bB])/s' => '\$1\$2/s', #'([kMG]?)([bB])/min' => '\$1\$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bitoch', 'Bytes' => 'bytoch', #' In:' => ' In:', #' Out:' => ' Out:', 'Percentage' => 'Perc.', 'Ported to OpenVMS Alpha by' => 'Na OpenVMS portoval', 'Ported to WindowsNT by' => 'Na WindowsNT portoval', 'and' => 'a', '^GREEN' => 'Zelen', 'BLUE' => 'Modr', 'DARK GREEN' => 'Tmavozelen', 'MAGENTA' => 'Fialov', 'AMBER' => 'lt' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Nedea', 'Sun' => 'Ne', 'Monday' => 'Pondelok', 'Mon' => 'Po', 'Tuesday' => 'Utorok', 'Tue' => 'Ut', 'Wednesday' => 'Streda', 'Wed' => 'St', 'Thursday' => 'tvrtok', 'Thu' => 't', 'Friday' => 'Piatok', 'Fri' => 'Pi', 'Saturday' => 'Sobota', 'Sat' => 'So' ); %month = ( 'January' => 'Janur', 'February' => 'Februr', 'March' => 'Marec', 'Jan' => 'Janur', 'Feb' => 'Februr', 'Mar' => 'Marec', 'April' => 'Aprl', 'May' => 'Mj', 'June' => 'Jn', 'Apr' => 'Aprl', 'May' => 'Mj', 'Jun' => 'Jn', 'July' => 'Jl', 'August' => 'August', 'September' => 'September', 'Jul' => 'Jl', 'Aug' => 'August', 'Sep' => 'September', 'October' => 'Oktber','November' => 'November','December' => 'December', 'Oct' => 'Oktber','Nov' => 'November','Dec' => 'December' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].",".$quux[1]." hod."; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; } # # Slovenian sub slovenian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'windows-1250', 'Maximal 5 Minute Incoming Traffic' => 'Najvecji petminutni vhodni promet', 'Maximal 5 Minute Outgoing Traffic' => 'Najvecji petminutni izhodni promet', 'the device' => 'naprava', 'The statistics were last updated(.*)' => 'Zadnja posodobitev podatkov:$1', ' Average\)' => ' povprecje)', 'Average' => 'Povprecje', 'Max' => 'Maksimalno', 'Current' => 'Trenutno', 'version' => 'verzija', '`Daily\' Graph \((.*) Minute' => 'Dnevni graf ($1 min.', '`Weekly\' Graph \(30 Minute' => 'Tedenski graf (30 min.' , '`Monthly\' Graph \(2 Hour' => 'Mesecni graf (2 urno', '`Yearly\' Graph \(1 Day' => 'Letni graf (1 dnevno', 'Incoming Traffic in (\S+) per Second' => 'Vhodni promet v $1 na sekundo.', 'Outgoing Traffic in (\S+) per Second' => 'Izhodni promet v $1 na sekundo.', 'at which time (.*) had been up for(.*)' => 'Cas od zadnjega restarta sistema $1 : $2', #'([kMG]?)([bB])/s' => '\$1\$2/s', #'([kMG]?)([bB])/min' => '\$1\$2/min', #'([kMG]?)([bB])/h' => '$1$2/h', 'Bits' => 'bitov', 'Bytes' => 'bytov', 'In' => 'Vhod', 'Out' => 'Izhod', 'Percentage' => 'Proc.', 'Ported to OpenVMS Alpha by' => 'Na OpenVMS portiral', 'Ported to WindowsNT by' => 'Na WindowsNT portiral', 'and' => 'in', '^GREEN' => 'Zeleno', 'BLUE' => 'Modro', 'DARK GREEN' => 'Temnozeleno', 'MAGENTA' => 'Vijolicasto', 'AMBER' => 'Oranzno' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Nedelja', 'Sun' => 'Ne', 'Monday' => 'Ponedeljek', 'Mon' => 'Po', 'Tuesday' => 'Torek', 'Tue' => 'To', 'Wednesday' => 'Sreda', 'Wed' => 'Sr', 'Thursday' => 'Cetrtek', 'Thu' => 'Ce', 'Friday' => 'Petek', 'Fri' => 'Po', 'Saturday' => 'Sobota', 'Sat' => 'So' ); %month = ( 'January' => 'Januar', 'February' => 'Februar', 'March' => 'Marec', 'Jan' => 'Jan', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'April', 'May' => 'Maj', 'June' => 'Jun', 'Apr' => 'Apr', 'May' => 'Maj', 'Jun' => 'Jun', 'July' => 'Julij', 'August' => 'Avgust', 'September' => 'September', 'Jul' => 'Jul', 'Aug' => 'Avg', 'Sep' => 'Sep', 'October' => 'Oktober','November' => 'November','December' => 'December', 'Oct' => 'Okt','Nov' => 'Nov','Dec' => 'Dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].",".$quux[1]." "; }; return "$wday{$foo[0]} $foo[1]. $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; } # # Spanish sub spanish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( #'iso-8859-1' => 'iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Tráfico entrante máximo en 5 minutos', 'Maximal 5 Minute Outgoing Traffic' => 'Tráfico saliente máximo en 5 minutos', 'the device' => 'el dispositivo', 'The statistics were last updated(.*)' => 'Estadísticas actualizadas el $1', ' Average\)' => ' Promedio)', 'Average' => 'Promedio', 'Max' => 'Máx', 'Current' => 'Actual', 'version' => 'version', '`Daily\' Graph \((.*) Minute' => 'Gráfico diario ($1 minutos :', '`Weekly\' Graph \(30 Minute' => 'Gráfico semanal (30 minutos :' , '`Monthly\' Graph \(2 Hour' => 'Gráfico mensual (2 horas :', '`Yearly\' Graph \(1 Day' => 'Gráfico anual (1 día :', 'Incoming Traffic in (\S+) per Second' => 'Tráfico entrante en $1 por segundo', 'Outgoing Traffic in (\S+) per Second' => 'Tráfico saliente en $1 por segundo', 'at which time (.*) had been up for(.*)' => '$1 ha estado funcionando durante $2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes' 'In' => 'Entrante:', 'Out' => 'Saliente:', 'Percentage' => 'Porcentaje:', 'Ported to OpenVMS Alpha by' => 'Portado a OpenVMS Alpha por', 'Ported to WindowsNT by' => 'Portado a WindowsNT por', 'and' => 'y', '^GREEN' => 'VERDE', 'BLUE' => 'AZUL', 'DARK GREEN' => 'VERDE OSCURO', 'MAGENTA' => 'MAGENTA', 'AMBER' => 'AMBAR' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Domingo', 'Sun' => 'Dom', 'Monday' => 'Lunes', 'Mon' => 'Lun', 'Tuesday' => 'Martes', 'Tue' => 'Mar', 'Wednesday' => 'Miércoles','Wed' => 'Mié', 'Thursday' => 'Jueves', 'Thu' => 'Jue', 'Friday' => 'Viernes', 'Fri' => 'Vie', 'Saturday' => 'Sábado', 'Sat' => 'Sab' ); %month = ( 'January' => 'Enero', 'February' => 'Febrero' , 'March' => 'Marzo', 'Jan' => 'Ene', 'Feb' => 'Feb', 'Mar' => 'Mar', 'April' => 'Abril', 'May' => 'Mayo', 'June' => 'Junio', 'Apr' => 'Abr', 'May' => 'Mai', 'Jun' => 'Jun', 'July' => 'Julio', 'August' => 'Agosto', 'September' => 'Setiembre', 'Jul' => 'Jul', 'Aug' => 'Ago', 'Sep' => 'Set', 'October' => 'Octubre', 'November' => 'Noviembre', 'December' => 'Diciembre', 'Oct' => 'Oct', 'Nov' => 'Nov', 'Dec' => 'Dic' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." a las ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] de $month{$foo[2]} de $foo[3]"; }; return $string; } # Swedish sub swedish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( #'charset=iso-8859-1' => 'charset=iso-8859-1', 'Maximal 5 Minute Incoming Traffic' => 'Maximalt inkommande trafik i 5 minuter', 'Maximal 5 Minute Outgoing Traffic' => 'Maximalt utgående trafik i 5 minuter', 'the device' => 'enheten', 'The statistics were last updated(.*)' => 'Statistiken blev senast uppdaterad$1', ' Average\)' => ')', 'Average' => 'Medel', #'Max' => 'Max', 'Current' => 'Senaste', 'version' => 'version', '`Daily\' Graph \((.*) Minute' => 'Daglig graf (samplingsintervall $1 minut(er)', '`Weekly\' Graph \(30 Minute' => 'Veckovis graf (medelvrde per 30 minuter' , '`Monthly\' Graph \(2 Hour' => 'Månatlig graf (medelvrde per 2 timmar', '`Yearly\' Graph \(1 Day' => 'Årlig graf (medelvrde per dygn', 'Incoming Traffic in (\S+) per Second' => 'Inkommande trafik i $1 per sekund', 'Outgoing Traffic in (\S+) per Second' => 'Utgende trafik i $1 per sekund', 'at which time (.*) had been up for(.*)' => 'd $1 varit igång i$2', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bits', # 'Bytes' => 'Bytes', #'In' => 'In', 'Out' => 'Ut', 'Percentage' => 'Procent', 'Ported to OpenVMS Alpha by' => 'Portad till OpenVMS av', 'Ported to WindowsNT by' => 'Portad till WindowsNT av', 'and' => 'och', '^GREEN' => 'GRÖN', 'BLUE' => 'BLÅ', 'DARK GREEN' => 'MÖRKGRÖN', 'MAGENTA' => 'MANGENTA', 'AMBER' => 'BRUN', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'söndag', 'Sun' => 'sön', 'Monday' => 'måndag', 'Mon' => 'mån', 'Tuesday' => 'tisdag', 'Tue' => 'tis', 'Wednesday' => 'onsdag', 'Wed' => 'ons', 'Thursday' => 'torsdag', 'Thu' => 'tor', 'Friday' => 'fredag', 'Fri' => 'fre', 'Saturday' => 'lördag', 'Sat' => 'lör' ); %month = ( 'January' => 'januari', 'February' => 'februari', 'March' => 'mars', 'Jan' => 'jan', 'Feb' => 'feb', 'Mar' => 'mar', 'April' => 'april', 'May' => 'maj', 'June' => 'juni', 'Apr' => 'apr', 'May' => 'maj', 'Jun' => 'jun', 'July' => 'juli', 'August' => 'augusti', 'September' => 'september', 'Jul' => 'jul', 'Aug' => 'aug', 'Sep' => 'sep', 'October' => 'oktober', 'November' => 'november', 'December' => 'december', 'Oct' => 'okt', 'Nov' => 'nov', 'Dec' => 'dec' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." kl.".$quux[1]; }; return "$wday{$foo[0]} den $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Turkish sub turkish { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... %translations = ( 'iso-8859-1' => 'iso-8859-9', 'Maximal 5 Minute Incoming Traffic' => '5 dakika iin en yksek giri trafii', 'Maximal 5 Minute Outgoing Traffic' => '5 dakika iin en yksek k trafii', 'the device' => 'aygt', 'The statistics were last updated(.*)' => 'statistiklerin en son gncellenmesi $1', ' Average\)' => ' Ortalama)', 'Average' => 'Ortalama', 'Max' => 'EnYksek;x', 'Current' => 'uAnki', 'version' => 'srm', '`Daily\' Graph \((.*) Minute' => 'Gnlk ($1 dakika :', '`Weekly\' Graph \(30 Minute' => 'Haftalk (30 dakika :' , '`Monthly\' Graph \(2 Hour' => 'Aylk (2 saat :', '`Yearly\' Graph \(1 Day' => 'Yllk (1 gn :', 'Incoming Traffic in (\S+) per Second' => '$1 deki saniyelik giri trafii', 'Outgoing Traffic in (\S+) per Second' => '$1 deki saniyelik k trafii', 'at which time (.*) had been up for(.*)' => '$1 Ne zamandan $2 beri ayakta', # '([kMG]?)([bB])/s' => '\$1\$2/s', # '([kMG]?)([bB])/min' => '\$1\$2/min', # '([kMG]?)([bB])/h' => '$1$2/t', # 'Bits' => 'Bit', # 'Bytes' => 'Byte' 'In' => 'Giri', 'Out' => 'k', 'Percentage' => 'Yzge', 'Ported to OpenVMS Alpha by' => 'OpenVMS Alpha ya uyarlayan', 'Ported to WindowsNT by' => 'WindowsNT ye uyarlayan', 'and' => 've', '^GREEN' => 'YEL', 'BLUE' => 'MAV', 'DARK GREEN' => 'KOYU YEL', 'MAGENTA' => 'MACENTA', 'AMBER' => 'AMBER' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => 'Pazar', 'Pzr' => 'Dom', 'Monday' => 'Pazartesi', 'Pzt' => 'Lun', 'Tuesday' => 'Sal', 'Sal' => 'Mar', 'Wednesday' => 'aramba', 'r' => 'Mié', 'Thursday' => 'Perembe', 'Pr' => 'Jue', 'Friday' => 'Cuma', 'Cum' => 'Vie', 'Saturday' => 'Cumartesi', 'Cmr' => 'Sab' ); %month = ( 'January' => 'Ocak', 'February' => 'ubat', 'March' => 'Mart', 'Jan' => 'Ock', 'Feb' => 'ub', 'Mar' => 'Mar', 'April' => 'Nisan', 'May' => 'Mays', 'June' => 'Haziran', 'Apr' => 'Nis', 'May' => 'May', 'Jun' => 'Hzr', 'July' => 'Temmuz', 'August' => 'Agustos', 'September' => 'Eyll', 'Jul' => 'Tem', 'Aug' => 'Agu', 'Sep' => 'Eyl', 'October' => 'Ekim', 'November' => 'Kasm', 'December' => 'Aralk', 'Oct' => 'Ekm', 'Nov' => 'Kas', 'Dec' => 'Ara' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0]." a las ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] de $month{$foo[2]} de $foo[3]"; }; } # Ukrainian sub ukrainian { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); # regexp => replacement string NOTE does not use autovars $1,$2... # charset=iso-2022-jp %translations = ( 'iso-8859-1' => 'koi8-u', 'Maximal 5 Minute Incoming Traffic' => ' Ȧ Ʀ 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' Ȧ Ʀ 5 ', 'the device' => 'Ҧ', 'The statistics were last updated(.*)' => 'Τ : $1', ' Average\)' => ')', 'Average' => 'Φ', 'Max' => '.', 'Current' => '', 'version' => 'Ӧ', '`Daily\' Graph \((.*) Minute' => ' Ʀ (Τ $1 ', '`Weekly\' Graph \(30 Minute' => ' Ʀ (Τ 30 ' , '`Monthly\' Graph \(2 Hour' => ' Ʀ (Τ 2 ', '`Yearly\' Graph \(1 Day' => ' Ʀ (Τ 1 ', 'Incoming Traffic in (\S+) per Second' => 'Ȧ Ʀ $1 ', 'Outgoing Traffic in (\S+) per Second' => 'Ȧ Ʀ $1 ', 'at which time (.*) had been up for(.*)' => '$1 $2', #'([kMG]?)([bB])/s' => '$1$1/', #'([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', 'Bits' => '¦', 'Bytes' => '', 'In' => '', 'Out' => '', 'Percentage' => '', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha', 'Ported to WindowsNT by' => ' WindowsNT', 'and' => '', '^GREEN' => '', 'BLUE' => '', 'DARK GREEN' => '', 'MAGENTA' => '', 'AMBER' => '' ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => ' Ħ', 'Sun' => '', 'Monday' => ' Ħ', 'Mon' => '', 'Tuesday' => ' ', 'Tue' => '', 'Wednesday' => ' ', 'Wed' => '', 'Thursday' => ' ', 'Thu' => '', 'Friday' => ' \'', 'Fri' => '', 'Saturday' => ' ', 'Sat' => '' ); %month = ( 'January' => '', 'February' => '' , 'March' => '', 'Jan' => '', 'Feb' => '', 'Mar' => '', 'April' => 'צ', 'May' => '', 'June' => '', 'Apr' => 'צ', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].". ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; # Ukrainian1251 - windowze encoding sub ukrainian1251 { my $string = shift; return "" unless defined $string; my(%translations,%month,%wday); my($i,$j); my(@dollar,@quux,@foo); %translations = ( 'iso-8859-1' => 'windows-1251', 'Maximal 5 Minute Incoming Traffic' => ' 5 ', 'Maximal 5 Minute Outgoing Traffic' => ' 5 ', 'the device' => '', 'The statistics were last updated(.*)' => ' : $1', ' Average\)' => ')', 'Average' => '', 'Max' => '', 'Current' => '', 'version' => '', '`Daily\' Graph \((.*) Minute' => ' ( $1 ', '`Weekly\' Graph \(30 Minute' => ' ( 30 ' , '`Monthly\' Graph \(2 Hour' => '̳ ( i ', '`Yearly\' Graph \(1 Day' => 'г ( ', 'Incoming Traffic in (\S+) per Second' => ' $1 ', 'Outgoing Traffic in (\S+) per Second' => ' $1 ', 'at which time (.*) had been up for(.*)' => '$1 䳿: $2', '([kMG]?)([bB])/s' => '$1$1/', '([kMG]?)([bB])/min' => '$1$2/', '([kMG]?)([bB])/h' => '$1$2/', '([bB])/s' => '$1/', '([bB])/min' => '$1/', '([bB])/h' => '$1/', 'Bits' => '', 'Bytes' => '', 'In' => '', 'Out' => '', 'Percentage' => '³', 'Ported to OpenVMS Alpha by' => ' OpenVMS Alpha', 'Ported to WindowsNT by' => ' WindowsNT', 'and' => '', 'RED' => '', '^GREEN' => '', 'BLUE' => 'Ͳ', 'DARK GREEN' => '', 'MAGENTA' => 'Բ', 'AMBER' => '', ); # maybe expansions with replacement of whitespace would be more appropriate foreach $i (keys %translations) { my $trans = $translations{$i}; $trans =~ s/\|/\|/; return $string if eval " \$string =~ s|\${i}|${trans}| "; }; %wday = ( 'Sunday' => ' ', 'Sun' => '', 'Monday' => ' ', 'Mon' => '', 'Tuesday' => ' ³', 'Tue' => '', 'Wednesday' => ' ', 'Wed' => '', 'Thursday' => ' ', 'Thu' => '', 'Friday' => ' \'', 'Fri' => '', 'Saturday' => ' ', 'Sat' => '' ); %month = ( 'January' => 'ѳ', 'February' => '' , 'March' => '', 'Jan' => 'ѳ', 'Feb' => '', 'Mar' => '', 'April' => '', 'May' => '', 'June' => '', 'Apr' => '', 'May' => '', 'Jun' => '', 'July' => '', 'August' => '', 'September' => '', 'Jul' => '', 'Aug' => '', 'Sep' => '', 'October' => '', 'November' => '', 'December' => '', 'Oct' => '', 'Nov' => '', 'Dec' => '' ); @foo=($string=~/(\S+),\s+(\S+)\s+(\S+)(.*)/); if($foo[0] && $wday{$foo[0]} && $foo[2] && $month{$foo[2]} ) { if($foo[3]=~(/(.*)at(.*)/)) { @quux=split(/at/,$foo[3]); $foo[3]=$quux[0].". ".$quux[1]; }; return "$wday{$foo[0]} $foo[1] $month{$foo[2]} $foo[3]"; }; # # handle two different time/date formats: # return "$wday, $mday $month ".($year+1900)." at $hour:$min"; # return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; # # handle nontranslated strings which ought to be translated # print STDERR "$_\n" or print DEBUG "not translated $_"; # but then again we might not want/need to translate all strings return $string; }; PK!ojҋllBER.pmnu[### -*- mode: Perl -*- ###################################################################### ### BER (Basic Encoding Rules) encoding and decoding. ###################################################################### ### Copyright (c) 1995-2008, Simon Leinen. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### This module implements encoding and decoding of ASN.1-based data ### structures using the Basic Encoding Rules (BER). Only the subset ### necessary for SNMP is implemented. ###################################################################### ### Created by: Simon Leinen ### ### Contributions and fixes by: ### ### Andrzej Tobola : Added long String decode ### Tobias Oetiker : Added 5 Byte Integer decode ... ### Dave Rand : Added SysUpTime decode ### Philippe Simonet : Support larger subids ### Yufang HU : Support even larger subids ### Mike Mitchell : New generalized encode_int() ### Mike Diehn : encode_ip_address() ### Rik Hoorelbeke : encode_oid() fix ### Brett T Warden : pretty UInteger32 ### Bert Driehuis : Handle SNMPv2 exception codes ### Jakob Ilves (/IlvJa) : PDU decoding ### Jan Kasprzak : Fix for PDU syntax check ### Milen Pavlov : Recognize variant length for ints ###################################################################### package BER; require 5.002; use strict; use vars qw(@ISA @EXPORT $VERSION $pretty_print_timeticks %pretty_printer %default_printer $errmsg); use Exporter; $VERSION = '1.05'; @ISA = qw(Exporter); @EXPORT = qw(context_flag constructor_flag encode_int encode_int_0 encode_null encode_oid encode_sequence encode_tagged_sequence encode_string encode_ip_address encode_timeticks encode_uinteger32 encode_counter32 encode_counter64 encode_gauge32 decode_sequence decode_by_template pretty_print pretty_print_timeticks hex_string hex_string_of_type encoded_oid_prefix_p errmsg register_pretty_printer unregister_pretty_printer); ### Variables ## Bind this to zero if you want to avoid that TimeTicks are converted ## into "human readable" strings containing days, hours, minutes and ## seconds. ## ## If the variable is zero, pretty_print will simply return an ## unsigned integer representing hundredths of seconds. ## $pretty_print_timeticks = 1; ### Prototypes sub encode_header ($$); sub encode_int_0 (); sub encode_int ($); sub encode_oid (@); sub encode_null (); sub encode_sequence (@); sub encode_tagged_sequence ($@); sub encode_string ($); sub encode_ip_address ($); sub encode_timeticks ($); sub pretty_print ($); sub pretty_using_decoder ($$); sub pretty_string ($); sub pretty_intlike ($); sub pretty_unsignedlike ($); sub pretty_oid ($); sub pretty_uptime ($); sub pretty_uptime_value ($); sub pretty_ip_address ($); sub pretty_generic_sequence ($); sub register_pretty_printer ($); sub unregister_pretty_printer ($); sub hex_string ($); sub hex_string_of_type ($$); sub decode_oid ($); sub decode_by_template; sub decode_by_template_2; sub decode_sequence ($); sub decode_int ($); sub decode_intlike ($); sub decode_unsignedlike ($); sub decode_intlike_s ($$); sub decode_string ($); sub decode_length ($@); sub encoded_oid_prefix_p ($$); sub decode_subid ($$$); sub decode_generic_tlv ($); sub error (@); sub template_error ($$$); sub version () { $VERSION; } ### Flags for different types of tags sub universal_flag { 0x00 } sub application_flag { 0x40 } sub context_flag { 0x80 } sub private_flag { 0xc0 } sub primitive_flag { 0x00 } sub constructor_flag { 0x20 } ### Universal tags sub boolean_tag { 0x01 } sub int_tag { 0x02 } sub bit_string_tag { 0x03 } sub octet_string_tag { 0x04 } sub null_tag { 0x05 } sub object_id_tag { 0x06 } sub sequence_tag { 0x10 } sub set_tag { 0x11 } sub uptime_tag { 0x43 } ### Flag for length octet announcing multi-byte length field sub long_length { 0x80 } ### SNMP specific tags sub snmp_ip_address_tag { 0x00 | application_flag () } sub snmp_counter32_tag { 0x01 | application_flag () } sub snmp_gauge32_tag { 0x02 | application_flag () } sub snmp_timeticks_tag { 0x03 | application_flag () } sub snmp_opaque_tag { 0x04 | application_flag () } sub snmp_nsap_address_tag { 0x05 | application_flag () } sub snmp_counter64_tag { 0x06 | application_flag () } sub snmp_uinteger32_tag { 0x07 | application_flag () } ## Error codes (SNMPv2 and later) ## sub snmp_nosuchobject { context_flag () | 0x00 } sub snmp_nosuchinstance { context_flag () | 0x01 } sub snmp_endofmibview { context_flag () | 0x02 } ### pretty-printer initialization code. Create a hash with ### the most common types of pretty-printer routines. BEGIN { $default_printer{int_tag()} = \&pretty_intlike; $default_printer{snmp_counter32_tag()} = \&pretty_unsignedlike; $default_printer{snmp_gauge32_tag()} = \&pretty_unsignedlike; $default_printer{snmp_counter64_tag()} = \&pretty_unsignedlike; $default_printer{snmp_uinteger32_tag()} = \&pretty_unsignedlike; $default_printer{octet_string_tag()} = \&pretty_string; $default_printer{object_id_tag()} = \&pretty_oid; $default_printer{snmp_ip_address_tag()} = \&pretty_ip_address; %pretty_printer = %default_printer; } #### Encoding sub encode_header ($$) { my ($type,$length) = @_; return pack ("C C", $type, $length) if $length < 128; return pack ("C C C", $type, long_length | 1, $length) if $length < 256; return pack ("C C n", $type, long_length | 2, $length) if $length < 65536; return error ("Cannot encode length $length yet"); } sub encode_int_0 () { return pack ("C C C", 2, 1, 0); } sub encode_int ($) { return encode_intlike ($_[0], int_tag); } sub encode_uinteger32 ($) { return encode_intlike ($_[0], snmp_uinteger32_tag); } sub encode_counter32 ($) { return encode_intlike ($_[0], snmp_counter32_tag); } sub encode_counter64 ($) { return encode_intlike ($_[0], snmp_counter64_tag); } sub encode_gauge32 ($) { return encode_intlike ($_[0], snmp_gauge32_tag); } sub encode_intlike ($$) { my ($int, $tag)=@_; my ($sign, $val, @vals); $sign = ($int >= 0) ? 0 : 0xff; if (ref $int && $int->isa ("Math::BigInt")) { for(;;) { $val = $int->copy()->bmod (256); unshift(@vals, $val); return encode_header ($tag, $#vals + 1).pack ("C*", @vals) if ($int >= -128 && $int < 128); $int->bsub ($sign)->bdiv (256); } } else { for(;;) { $val = $int & 0xff; unshift(@vals, $val); return encode_header ($tag, $#vals + 1).pack ("C*", @vals) if ($int >= -128 && $int < 128); $int -= $sign, $int = int($int / 256); } } } sub encode_oid (@) { my @oid = @_; my ($result,$subid); $result = ''; ## Ignore leading empty sub-ID. The favourite reason for ## those to occur is that people cut&paste numeric OIDs from ## CMU/UCD SNMP including the leading dot. shift @oid if $oid[0] eq ''; return error ("Object ID too short: ", join('.',@oid)) if $#oid < 1; ## The first two subids in an Object ID are encoded as a single ## byte in BER, according to a funny convention. This poses ## restrictions on the ranges of those subids. In the past, I ## didn't check for those. But since so many people try to use ## OIDs in CMU/UCD SNMP's format and leave out the mib-2 or ## enterprises prefix, I introduced this check to catch those ## errors. ## return error ("first subid too big in Object ID ", join('.',@oid)) if $oid[0] > 2; $result = shift (@oid) * 40; $result += shift @oid; return error ("second subid too big in Object ID ", join('.',@oid)) if $result > 255; $result = pack ("C", $result); foreach $subid (@oid) { if ( ($subid>=0) && ($subid<128) ){ #7 bits long subid $result .= pack ("C", $subid); } elsif ( ($subid>=128) && ($subid<16384) ){ #14 bits long subid $result .= pack ("CC", 0x80 | $subid >> 7, $subid & 0x7f); } elsif ( ($subid>=16384) && ($subid<2097152) ) {#21 bits long subid $result .= pack ("CCC", 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } elsif ( ($subid>=2097152) && ($subid<268435456) ){ #28 bits long subid $result .= pack ("CCCC", 0x80 | (($subid>>21) & 0x7f), 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } elsif ( ($subid>=268435456) && ($subid<4294967296) ){ #32 bits long subid $result .= pack ("CCCCC", 0x80 | (($subid>>28) & 0x0f), #mask the bits beyond 32 0x80 | (($subid>>21) & 0x7f), 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } else { return error ("Cannot encode subid $subid"); } } encode_header (object_id_tag, length $result).$result; } sub encode_null () { encode_header (null_tag, 0); } sub encode_sequence (@) { encode_tagged_sequence (sequence_tag, @_); } sub encode_tagged_sequence ($@) { my ($tag,$result); $tag = shift @_; $result = join '',@_; return encode_header ($tag | constructor_flag, length $result).$result; } sub encode_string ($) { my ($string)=@_; return encode_header (octet_string_tag, length $string).$string; } sub encode_ip_address ($) { my ($addr)=@_; my @octets; if (length $addr == 4) { ## Four bytes... let's suppose that this is a binary IP address ## in network byte order. return encode_header (snmp_ip_address_tag, length $addr).$addr; } elsif (@octets = ($addr =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/)) { return encode_ip_address (pack ("CCCC", @octets)); } else { return error ("IP address must be four bytes long or a dotted-quad"); } } sub encode_timeticks ($) { my ($tt) = @_; return encode_intlike ($tt, snmp_timeticks_tag); } #### Decoding sub pretty_print ($) { my ($packet) = @_; return undef unless defined $packet; my $result = ord (substr ($packet, 0, 1)); if (exists ($pretty_printer{$result})) { my $c_ref = $pretty_printer{$result}; return &$c_ref ($packet); } return ($pretty_print_timeticks ? pretty_uptime ($packet) : pretty_unsignedlike ($packet)) if $result == uptime_tag; return "(null)" if $result == null_tag; return error ("Exception code: noSuchObject") if $result == snmp_nosuchobject; return error ("Exception code: noSuchInstance") if $result == snmp_nosuchinstance; return error ("Exception code: endOfMibView") if $result == snmp_endofmibview; # IlvJa # pretty print sequences and their contents. my $ctx_cons_flags = context_flag | constructor_flag; if($result == (&constructor_flag | &sequence_tag) # sequence || $result == (0 | $ctx_cons_flags) #get_request || $result == (1 | $ctx_cons_flags) #getnext_request || $result == (2 | $ctx_cons_flags) #response || $result == (3 | $ctx_cons_flags) #set_request || $result == (4 | $ctx_cons_flags) #trap_request || $result == (5 | $ctx_cons_flags) #getbulk_request || $result == (6 | $ctx_cons_flags) #inform_request || $result == (7 | $ctx_cons_flags) #trap2_request ) { my $pretty_result = pretty_generic_sequence($packet); $pretty_result =~ s/^/ /gm; #Indent. my $seq_type_desc = { (constructor_flag | sequence_tag) => "Sequence", (0 | $ctx_cons_flags) => "GetRequest", (1 | $ctx_cons_flags) => "GetNextRequest", (2 | $ctx_cons_flags) => "Response", (3 | $ctx_cons_flags) => "SetRequest", (4 | $ctx_cons_flags) => "Trap", (5 | $ctx_cons_flags) => "GetBulkRequest", (6 | $ctx_cons_flags) => "InformRequest", (7 | $ctx_cons_flags) => "SNMPv2-Trap", (8 | $ctx_cons_flags) => "Report", }->{($result)}; return $seq_type_desc . "{\n" . $pretty_result . "\n}"; } return sprintf ("#", $result); } sub pretty_using_decoder ($$) { my ($decoder, $packet) = @_; my ($decoded,$rest); ($decoded,$rest) = &$decoder ($packet); return error ("Junk after object") unless $rest eq ''; return $decoded; } sub pretty_string ($) { pretty_using_decoder (\&decode_string, $_[0]); } sub pretty_intlike ($) { my $decoded = pretty_using_decoder (\&decode_intlike, $_[0]); $decoded; } sub pretty_unsignedlike ($) { return pretty_using_decoder (\&decode_unsignedlike, $_[0]); } sub pretty_oid ($) { my ($oid) = shift; my ($result,$subid,$next); my (@oid); $result = ord (substr ($oid, 0, 1)); return error ("Object ID expected") unless $result == object_id_tag; ($result, $oid) = decode_length ($oid, 1); return error ("inconsistent length in OID") unless $result == length $oid; @oid = (); $subid = ord (substr ($oid, 0, 1)); push @oid, int ($subid / 40); push @oid, $subid % 40; $oid = substr ($oid, 1); while ($oid ne '') { $subid = ord (substr ($oid, 0, 1)); if ($subid < 128) { $oid = substr ($oid, 1); push @oid, $subid; } else { $next = $subid; $subid = 0; while ($next >= 128) { $subid = ($subid << 7) + ($next & 0x7f); $oid = substr ($oid, 1); $next = ord (substr ($oid, 0, 1)); } $subid = ($subid << 7) + $next; $oid = substr ($oid, 1); push @oid, $subid; } } join ('.', @oid); } sub pretty_uptime ($) { my ($packet,$uptime); ($uptime,$packet) = &decode_unsignedlike (@_); pretty_uptime_value ($uptime); } sub pretty_uptime_value ($) { my ($uptime) = @_; my ($seconds,$minutes,$hours,$days,$result); ## We divide the uptime by hundred since we're not interested in ## sub-second precision. $uptime = int ($uptime / 100); $days = int ($uptime / (60 * 60 * 24)); $uptime %= (60 * 60 * 24); $hours = int ($uptime / (60 * 60)); $uptime %= (60 * 60); $minutes = int ($uptime / 60); $seconds = $uptime % 60; if ($days == 0){ $result = sprintf ("%d:%02d:%02d", $hours, $minutes, $seconds); } elsif ($days == 1) { $result = sprintf ("%d day, %d:%02d:%02d", $days, $hours, $minutes, $seconds); } else { $result = sprintf ("%d days, %d:%02d:%02d", $days, $hours, $minutes, $seconds); } return $result; } sub pretty_ip_address ($) { my $pdu = shift; my ($length, $rest); return error ("IP Address tag (".snmp_ip_address_tag.") expected") unless ord (substr ($pdu, 0, 1)) == snmp_ip_address_tag; ($length,$pdu) = decode_length ($pdu, 1); return error ("Length of IP address should be four") unless $length == 4; sprintf "%d.%d.%d.%d", unpack ("CCCC", $pdu); } # IlvJa # Returns a string with the pretty prints of all # the elements in the sequence. sub pretty_generic_sequence ($) { my ($pdu) = shift; my $rest; my $type = ord substr ($pdu, 0 ,1); my $flags = context_flag | constructor_flag; return error (sprintf ("Tag 0x%x is not a valid sequence tag",$type)) unless ($type == (&constructor_flag | &sequence_tag) # sequence || $type == (0 | $flags) #get_request || $type == (1 | $flags) #getnext_request || $type == (2 | $flags) #response || $type == (3 | $flags) #set_request || $type == (4 | $flags) #trap_request || $type == (5 | $flags) #getbulk_request || $type == (6 | $flags) #inform_request || $type == (7 | $flags) #trap2_request ); my $curelem; my $pretty_result; # Holds the pretty printed sequence. my $pretty_elem; # Holds the pretty printed current elem. my $first_elem = 'true'; # Cut away the first Tag and Length from $packet and then # init $rest with that. (undef, $rest) = decode_length ($pdu, 1); while($rest) { ($curelem,$rest) = decode_generic_tlv($rest); $pretty_elem = pretty_print($curelem); $pretty_result .= "\n" if not $first_elem; $pretty_result .= $pretty_elem; # The rest of the iterations are not related to the # first element of the sequence so.. $first_elem = '' if $first_elem; } return $pretty_result; } sub hex_string ($) { &hex_string_of_type ($_[0], octet_string_tag); } sub hex_string_of_type ($$) { my ($pdu, $wanted_type) = @_; my ($length); return error ("BER tag ".$wanted_type." expected") unless ord (substr ($pdu, 0, 1)) == $wanted_type; ($length,$pdu) = decode_length ($pdu, 1); hex_string_aux ($pdu); } sub hex_string_aux ($) { my ($binary_string) = @_; my ($c, $result); $result = ''; for $c (unpack "C*", $binary_string) { $result .= sprintf "%02x", $c; } $result; } sub decode_oid ($) { my ($pdu) = @_; my ($result,$pdu_rest); my (@result); $result = ord (substr ($pdu, 0, 1)); return error ("Object ID expected") unless $result == object_id_tag; ($result, $pdu_rest) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu_rest; @result = (substr ($pdu, 0, $result + (length ($pdu) - length ($pdu_rest))), substr ($pdu_rest, $result)); @result; } # IlvJa # This takes a PDU and returns a two element list consisting of # the first element found in the PDU (whatever it is) and the # rest of the PDU sub decode_generic_tlv ($) { my ($pdu) = @_; my (@result); my ($elemlength,$pdu_rest) = decode_length ($pdu, 1); @result = (# Extract the first element. substr ($pdu, 0, $elemlength + (length ($pdu) - length ($pdu_rest) ) ), #Extract the rest of the PDU. substr ($pdu_rest, $elemlength) ); @result; } sub decode_by_template { my ($pdu) = shift; local ($_) = shift; return decode_by_template_2 ($pdu, $_, 0, 0, @_); } my $template_debug = 0; sub decode_by_template_2 { my ($pdu, $template, $pdu_index, $template_index); local ($_); $pdu = shift; $template = $_ = shift; $pdu_index = shift; $template_index = shift; my (@results); my ($length,$expected,$read,$rest); return undef unless defined $pdu; while (0 < length ($_)) { if (substr ($_, 0, 1) eq '%') { print STDERR "template $_ ", length $pdu," bytes remaining\n" if $template_debug; $_ = substr ($_,1); ++$template_index; if (($expected) = /^(\d*|\*)\{(.*)/) { ## %{ $template_index += length ($expected) + 1; print STDERR "%{\n" if $template_debug; $_ = $2; $expected = shift | constructor_flag if ($expected eq '*'); $expected = sequence_tag | constructor_flag if $expected eq ''; return template_error ("Unexpected end of PDU", $template, $template_index) if !defined $pdu or $pdu eq ''; return template_error ("Expected sequence tag $expected, got ". ord (substr ($pdu, 0, 1)), $template, $template_index) unless (ord (substr ($pdu, 0, 1)) == $expected); (($length,$pdu) = decode_length ($pdu, 1)) || return template_error ("cannot read length", $template, $template_index); return template_error ("Expected length $length, got ".length $pdu , $template, $template_index) unless length $pdu == $length; } elsif (($expected,$rest) = /^(\*|)s(.*)/) { ## %s $template_index += length ($expected) + 1; ($expected = shift) if $expected eq '*'; (($read,$pdu) = decode_string ($pdu)) || return template_error ("cannot read string", $template, $template_index); print STDERR "%s => $read\n" if $template_debug; if ($expected eq '') { push @results, $read; } else { return template_error ("Expected $expected, read $read", $template, $template_index) unless $expected eq $read; } $_ = $rest; } elsif (($rest) = /^A(.*)/) { ## %A $template_index += 1; { my ($tag, $length, $value); $tag = ord (substr ($pdu, 0, 1)); return error ("Expected IP address, got tag ".$tag) unless $tag == snmp_ip_address_tag; ($length, $pdu) = decode_length ($pdu, 1); return error ("Inconsistent length of InetAddress encoding") if $length > length $pdu; return template_error ("IP address must be four bytes long", $template, $template_index) unless $length == 4; $read = substr ($pdu, 0, $length); $pdu = substr ($pdu, $length); } print STDERR "%A => $read\n" if $template_debug; push @results, $read; $_ = $rest; } elsif (/^O(.*)/) { ## %O $template_index += 1; $_ = $1; (($read,$pdu) = decode_oid ($pdu)) || return template_error ("cannot read OID", $template, $template_index); print STDERR "%O => ".pretty_oid ($read)."\n" if $template_debug; push @results, $read; } elsif (($expected,$rest) = /^(\d*|\*|)i(.*)/) { ## %i $template_index += length ($expected) + 1; print STDERR "%i\n" if $template_debug; $_ = $rest; (($read,$pdu) = decode_int ($pdu)) || return template_error ("cannot read int", $template, $template_index); if ($expected eq '') { push @results, $read; } else { $expected = int (shift) if $expected eq '*'; return template_error (sprintf ("Expected %d (0x%x), got %d (0x%x)", $expected, $expected, $read, $read), $template, $template_index) unless ($expected == $read) } } elsif (($rest) = /^u(.*)/) { ## %u $template_index += 1; print STDERR "%u\n" if $template_debug; $_ = $rest; (($read,$pdu) = decode_unsignedlike ($pdu)) || return template_error ("cannot read uptime", $template, $template_index); push @results, $read; } elsif (/^\@(.*)/) { ## %@ $template_index += 1; print STDERR "%@\n" if $template_debug; $_ = $1; push @results, $pdu; $pdu = ''; } else { return template_error ("Unknown decoding directive in template: $_", $template, $template_index); } } else { if (substr ($_, 0, 1) ne substr ($pdu, 0, 1)) { return template_error ("Expected ".substr ($_, 0, 1).", got ".substr ($pdu, 0, 1), $template, $template_index); } $_ = substr ($_,1); $pdu = substr ($pdu,1); } } return template_error ("PDU too long", $template, $template_index) if length ($pdu) > 0; return template_error ("PDU too short", $template, $template_index) if length ($_) > 0; @results; } sub decode_sequence ($) { my ($pdu) = @_; my ($result); my (@result); $result = ord (substr ($pdu, 0, 1)); return error ("Sequence expected") unless $result == (sequence_tag | constructor_flag); ($result, $pdu) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu; @result = (substr ($pdu, 0, $result), substr ($pdu, $result)); @result; } sub decode_int ($) { my ($pdu) = @_; my $tag = ord (substr ($pdu, 0, 1)); return error ("Integer expected, found tag ".$tag) unless $tag == int_tag; decode_intlike ($pdu); } sub decode_intlike ($) { decode_intlike_s ($_[0], 1); } sub decode_unsignedlike ($) { decode_intlike_s ($_[0], 0); } my $have_math_bigint_p = 0; sub decode_intlike_s ($$) { my ($pdu, $signedp) = @_; my ($length,$result); ($length,$pdu) = decode_length ($pdu, 1); my $ptr = 0; $result = unpack ($signedp ? "c" : "C", substr ($pdu, $ptr++, 1)); if ($length > 5 || ($length == 5 && $result > 0)) { require 'Math/BigInt.pm' unless $have_math_bigint_p++; $result = new Math::BigInt ($result); } while (--$length > 0) { $result *= 256; $result += unpack ("C", substr ($pdu, $ptr++, 1)); } ($result, substr ($pdu, $ptr)); } sub decode_string ($) { my ($pdu) = shift; my ($result); $result = ord (substr ($pdu, 0, 1)); return error ("Expected octet string, got tag ".$result) unless $result == octet_string_tag; ($result, $pdu) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu; return (substr ($pdu, 0, $result), substr ($pdu, $result)); } sub decode_length ($@) { my ($pdu) = shift; my $index = shift || 0; my ($result); my (@result); $result = ord (substr ($pdu, $index, 1)); if ($result & long_length) { if ($result == (long_length | 1)) { @result = (ord (substr ($pdu, $index+1, 1)), substr ($pdu, $index+2)); } elsif ($result == (long_length | 2)) { @result = ((ord (substr ($pdu, $index+1, 1)) << 8) + ord (substr ($pdu, $index+2, 1)), substr ($pdu, $index+3)); } else { return error ("Unsupported length"); } } else { @result = ($result, substr ($pdu, $index+1)); } @result; } # This takes a hashref that specifies functions to call when # the specified value type is being printed. It returns the # number of functions that were registered. sub register_pretty_printer($) { my ($h_ref) = shift; my ($type, $val, $cnt); $cnt = 0; while(($type, $val) = each %$h_ref) { if (ref $val eq "CODE") { $pretty_printer{$type} = $val; $cnt++; } } return($cnt); } # This takes a hashref that specifies functions to call when # the specified value type is being printed. It removes the # functions from the list for the types specified. # It returns the number of functions that were unregistered. sub unregister_pretty_printer($) { my ($h_ref) = shift; my ($type, $val, $cnt); $cnt = 0; while(($type, $val) = each %$h_ref) { if ((exists ($pretty_printer{$type})) && ($pretty_printer{$type} == $val)) { if (exists($default_printer{$type})) { $pretty_printer{$type} = $default_printer{$type}; } else { delete $pretty_printer{$type}; } $cnt++; } } return($cnt); } #### OID prefix check ### encoded_oid_prefix_p OID1 OID2 ### ### OID1 and OID2 should be BER-encoded OIDs. ### The function returns non-zero iff OID1 is a prefix of OID2. ### This can be used in the termination condition of a loop that walks ### a table using GetNext or GetBulk. ### sub encoded_oid_prefix_p ($$) { my ($oid1, $oid2) = @_; my ($i1, $i2); my ($l1, $l2); my ($subid1, $subid2); return error ("OID tag expected") unless ord (substr ($oid1, 0, 1)) == object_id_tag; return error ("OID tag expected") unless ord (substr ($oid2, 0, 1)) == object_id_tag; ($l1,$oid1) = decode_length ($oid1, 1); ($l2,$oid2) = decode_length ($oid2, 1); for ($i1 = 0, $i2 = 0; $i1 < $l1 && $i2 < $l2; ++$i1, ++$i2) { ($subid1,$i1) = &decode_subid ($oid1, $i1, $l1); ($subid2,$i2) = &decode_subid ($oid2, $i2, $l2); return 0 unless $subid1 == $subid2; } return $i2 if $i1 == $l1; return 0; } ### decode_subid OID INDEX ### ### Decodes a subid field from a BER-encoded object ID. ### Returns two values: the field, and the index of the last byte that ### was actually decoded. ### sub decode_subid ($$$) { my ($oid, $i, $l) = @_; my $subid = 0; my $next; while (($next = ord (substr ($oid, $i, 1))) >= 128) { $subid = ($subid << 7) + ($next & 0x7f); ++$i; return error ("decoding object ID: short field") unless $i < $l; } return (($subid << 7) + $next, $i); } sub error (@) { $errmsg = join ("",@_); return undef; } sub template_error ($$$) { my ($errmsg, $template, $index) = @_; return error ($errmsg."\n ".$template."\n ".(' ' x $index)."^"); } 1; PK!B/Net_SNMP_util.pmnu[### - *- mode: Perl -*- ###################################################################### ### Net_SNMP_util -- SNMP utilities using Net::SNMP ###################################################################### ### Copyright (c) 2005-2011 Mike Mitchell. ### ### This program is free software; you can redistribute it under the ### "Artistic License" included in this distribution (file "Artistic"). ###################################################################### ### Created by: Mike Mitchell ### ### Contributions and fixes by: ### ### Laszlo Herczeg ### ignore unimplemented SNMP_Session.pm options ### ### Daniel McDonald ### make sure snmpwalk_flg stops when last instance in table is fetched ### ### Alexander Kozlov ### Leave snmpwalk_flg early if no OIDs are returned ### ### ### parse NOTIFICATION-TYPE in MIB ### ### Dan Thorson ### Handle quotes in MIB comments better ### ### Daniel J McDonald ### fix getbulk_request -> get_bulk_request typo ### ### Tobias Oetiker ### fix '-privpassword' error against snmpv2 hosts ### ###################################################################### package Net_SNMP_util; =head1 NAME Net_SNMP_util - SNMP utilities based on Net::SNMP =head1 SYNOPSIS The Net_SNMP_util module implements SNMP utilities using the Net::SNMP module. It implements snmpget, snmpgetnext, snmpwalk, snmpset, snmptrap, and snmpgetbulk. The Net_SNMP_util module assumes that the user has a basic understanding of the Simple Network Management Protocol and related network management concepts. =head1 DESCRIPTION The Net_SNMP_util module simplifies SNMP queries even more than Net::SNMP alone. Easy-to-use "get", "getnext", "walk", "set", "trap", and "getbulk" routines are provided, hiding all the details of a SNMP query. =cut # ========================================================================== use strict; ## Validate the version of Perl BEGIN { die('Perl version 5.6.0 or greater is required') if ($] < 5.006); } ## Handle importing/exporting of symbols use vars qw( @ISA @EXPORT $VERSION $ErrorMessage); use Exporter; our @ISA = qw( Exporter ); our @EXPORT = qw( snmpget snmpgetnext snmpwalk snmpset snmptrap snmpgetbulk snmpmaptable snmpmaptable4 snmpwalkhash snmpmapOID snmpMIB_to_OID snmpLoad_OID_Cache snmpQueue_MIB_File ErrorMessage ); ## Version of the Net_SNMP_util module our $VERSION = v1.0.20; use Carp; use Net::SNMP v5.0; # The OID numbers from RFC1213 (MIB-II) and RFC1315 (Frame Relay) # are pre-loaded below. %Net_SNMP_util::OIDS = ( 'iso' => '1', 'org' => '1.3', 'dod' => '1.3.6', 'internet' => '1.3.6.1', 'directory' => '1.3.6.1.1', 'mgmt' => '1.3.6.1.2', 'mib-2' => '1.3.6.1.2.1', 'system' => '1.3.6.1.2.1.1', 'sysDescr' => '1.3.6.1.2.1.1.1.0', 'sysObjectID' => '1.3.6.1.2.1.1.2.0', 'sysUpTime' => '1.3.6.1.2.1.1.3.0', 'sysUptime' => '1.3.6.1.2.1.1.3.0', 'sysContact' => '1.3.6.1.2.1.1.4.0', 'sysName' => '1.3.6.1.2.1.1.5.0', 'sysLocation' => '1.3.6.1.2.1.1.6.0', 'sysServices' => '1.3.6.1.2.1.1.7.0', 'interfaces' => '1.3.6.1.2.1.2', 'ifNumber' => '1.3.6.1.2.1.2.1.0', 'ifTable' => '1.3.6.1.2.1.2.2', 'ifEntry' => '1.3.6.1.2.1.2.2.1', 'ifIndex' => '1.3.6.1.2.1.2.2.1.1', 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', 'ifInUcastPkts' => '1.3.6.1.2.1.2.2.1.11', 'ifInNUcastPkts' => '1.3.6.1.2.1.2.2.1.12', 'ifInDiscards' => '1.3.6.1.2.1.2.2.1.13', 'ifInErrors' => '1.3.6.1.2.1.2.2.1.14', 'ifInUnknownProtos' => '1.3.6.1.2.1.2.2.1.15', 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16', 'ifOutUcastPkts' => '1.3.6.1.2.1.2.2.1.17', 'ifOutNUcastPkts' => '1.3.6.1.2.1.2.2.1.18', 'ifOutDiscards' => '1.3.6.1.2.1.2.2.1.19', 'ifDescr' => '1.3.6.1.2.1.2.2.1.2', 'ifOutErrors' => '1.3.6.1.2.1.2.2.1.20', 'ifOutQLen' => '1.3.6.1.2.1.2.2.1.21', 'ifSpecific' => '1.3.6.1.2.1.2.2.1.22', 'ifType' => '1.3.6.1.2.1.2.2.1.3', 'ifMtu' => '1.3.6.1.2.1.2.2.1.4', 'ifSpeed' => '1.3.6.1.2.1.2.2.1.5', 'ifPhysAddress' => '1.3.6.1.2.1.2.2.1.6', 'ifAdminHack' => '1.3.6.1.2.1.2.2.1.7', 'ifAdminStatus' => '1.3.6.1.2.1.2.2.1.7', 'ifOperHack' => '1.3.6.1.2.1.2.2.1.8', 'ifOperStatus' => '1.3.6.1.2.1.2.2.1.8', 'ifLastChange' => '1.3.6.1.2.1.2.2.1.9', 'at' => '1.3.6.1.2.1.3', 'atTable' => '1.3.6.1.2.1.3.1', 'atEntry' => '1.3.6.1.2.1.3.1.1', 'atIfIndex' => '1.3.6.1.2.1.3.1.1.1', 'atPhysAddress' => '1.3.6.1.2.1.3.1.1.2', 'atNetAddress' => '1.3.6.1.2.1.3.1.1.3', 'ip' => '1.3.6.1.2.1.4', 'ipForwarding' => '1.3.6.1.2.1.4.1', 'ipOutRequests' => '1.3.6.1.2.1.4.10', 'ipOutDiscards' => '1.3.6.1.2.1.4.11', 'ipOutNoRoutes' => '1.3.6.1.2.1.4.12', 'ipReasmTimeout' => '1.3.6.1.2.1.4.13', 'ipReasmReqds' => '1.3.6.1.2.1.4.14', 'ipReasmOKs' => '1.3.6.1.2.1.4.15', 'ipReasmFails' => '1.3.6.1.2.1.4.16', 'ipFragOKs' => '1.3.6.1.2.1.4.17', 'ipFragFails' => '1.3.6.1.2.1.4.18', 'ipFragCreates' => '1.3.6.1.2.1.4.19', 'ipDefaultTTL' => '1.3.6.1.2.1.4.2', 'ipAddrTable' => '1.3.6.1.2.1.4.20', 'ipAddrEntry' => '1.3.6.1.2.1.4.20.1', 'ipAdEntAddr' => '1.3.6.1.2.1.4.20.1.1', 'ipAdEntIfIndex' => '1.3.6.1.2.1.4.20.1.2', 'ipAdEntNetMask' => '1.3.6.1.2.1.4.20.1.3', 'ipAdEntBcastAddr' => '1.3.6.1.2.1.4.20.1.4', 'ipAdEntReasmMaxSize' => '1.3.6.1.2.1.4.20.1.5', 'ipRouteTable' => '1.3.6.1.2.1.4.21', 'ipRouteEntry' => '1.3.6.1.2.1.4.21.1', 'ipRouteDest' => '1.3.6.1.2.1.4.21.1.1', 'ipRouteAge' => '1.3.6.1.2.1.4.21.1.10', 'ipRouteMask' => '1.3.6.1.2.1.4.21.1.11', 'ipRouteMetric5' => '1.3.6.1.2.1.4.21.1.12', 'ipRouteInfo' => '1.3.6.1.2.1.4.21.1.13', 'ipRouteIfIndex' => '1.3.6.1.2.1.4.21.1.2', 'ipRouteMetric1' => '1.3.6.1.2.1.4.21.1.3', 'ipRouteMetric2' => '1.3.6.1.2.1.4.21.1.4', 'ipRouteMetric3' => '1.3.6.1.2.1.4.21.1.5', 'ipRouteMetric4' => '1.3.6.1.2.1.4.21.1.6', 'ipRouteNextHop' => '1.3.6.1.2.1.4.21.1.7', 'ipRouteType' => '1.3.6.1.2.1.4.21.1.8', 'ipRouteProto' => '1.3.6.1.2.1.4.21.1.9', 'ipNetToMediaTable' => '1.3.6.1.2.1.4.22', 'ipNetToMediaEntry' => '1.3.6.1.2.1.4.22.1', 'ipNetToMediaIfIndex' => '1.3.6.1.2.1.4.22.1.1', 'ipNetToMediaPhysAddress' => '1.3.6.1.2.1.4.22.1.2', 'ipNetToMediaNetAddress' => '1.3.6.1.2.1.4.22.1.3', 'ipNetToMediaType' => '1.3.6.1.2.1.4.22.1.4', 'ipRoutingDiscards' => '1.3.6.1.2.1.4.23', 'ipInReceives' => '1.3.6.1.2.1.4.3', 'ipInHdrErrors' => '1.3.6.1.2.1.4.4', 'ipInAddrErrors' => '1.3.6.1.2.1.4.5', 'ipForwDatagrams' => '1.3.6.1.2.1.4.6', 'ipInUnknownProtos' => '1.3.6.1.2.1.4.7', 'ipInDiscards' => '1.3.6.1.2.1.4.8', 'ipInDelivers' => '1.3.6.1.2.1.4.9', 'icmp' => '1.3.6.1.2.1.5', 'icmpInMsgs' => '1.3.6.1.2.1.5.1', 'icmpInTimestamps' => '1.3.6.1.2.1.5.10', 'icmpInTimestampReps' => '1.3.6.1.2.1.5.11', 'icmpInAddrMasks' => '1.3.6.1.2.1.5.12', 'icmpInAddrMaskReps' => '1.3.6.1.2.1.5.13', 'icmpOutMsgs' => '1.3.6.1.2.1.5.14', 'icmpOutErrors' => '1.3.6.1.2.1.5.15', 'icmpOutDestUnreachs' => '1.3.6.1.2.1.5.16', 'icmpOutTimeExcds' => '1.3.6.1.2.1.5.17', 'icmpOutParmProbs' => '1.3.6.1.2.1.5.18', 'icmpOutSrcQuenchs' => '1.3.6.1.2.1.5.19', 'icmpInErrors' => '1.3.6.1.2.1.5.2', 'icmpOutRedirects' => '1.3.6.1.2.1.5.20', 'icmpOutEchos' => '1.3.6.1.2.1.5.21', 'icmpOutEchoReps' => '1.3.6.1.2.1.5.22', 'icmpOutTimestamps' => '1.3.6.1.2.1.5.23', 'icmpOutTimestampReps' => '1.3.6.1.2.1.5.24', 'icmpOutAddrMasks' => '1.3.6.1.2.1.5.25', 'icmpOutAddrMaskReps' => '1.3.6.1.2.1.5.26', 'icmpInDestUnreachs' => '1.3.6.1.2.1.5.3', 'icmpInTimeExcds' => '1.3.6.1.2.1.5.4', 'icmpInParmProbs' => '1.3.6.1.2.1.5.5', 'icmpInSrcQuenchs' => '1.3.6.1.2.1.5.6', 'icmpInRedirects' => '1.3.6.1.2.1.5.7', 'icmpInEchos' => '1.3.6.1.2.1.5.8', 'icmpInEchoReps' => '1.3.6.1.2.1.5.9', 'tcp' => '1.3.6.1.2.1.6', 'tcpRtoAlgorithm' => '1.3.6.1.2.1.6.1', 'tcpInSegs' => '1.3.6.1.2.1.6.10', 'tcpOutSegs' => '1.3.6.1.2.1.6.11', 'tcpRetransSegs' => '1.3.6.1.2.1.6.12', 'tcpConnTable' => '1.3.6.1.2.1.6.13', 'tcpConnEntry' => '1.3.6.1.2.1.6.13.1', 'tcpConnState' => '1.3.6.1.2.1.6.13.1.1', 'tcpConnLocalAddress' => '1.3.6.1.2.1.6.13.1.2', 'tcpConnLocalPort' => '1.3.6.1.2.1.6.13.1.3', 'tcpConnRemAddress' => '1.3.6.1.2.1.6.13.1.4', 'tcpConnRemPort' => '1.3.6.1.2.1.6.13.1.5', 'tcpInErrs' => '1.3.6.1.2.1.6.14', 'tcpOutRsts' => '1.3.6.1.2.1.6.15', 'tcpRtoMin' => '1.3.6.1.2.1.6.2', 'tcpRtoMax' => '1.3.6.1.2.1.6.3', 'tcpMaxConn' => '1.3.6.1.2.1.6.4', 'tcpActiveOpens' => '1.3.6.1.2.1.6.5', 'tcpPassiveOpens' => '1.3.6.1.2.1.6.6', 'tcpAttemptFails' => '1.3.6.1.2.1.6.7', 'tcpEstabResets' => '1.3.6.1.2.1.6.8', 'tcpCurrEstab' => '1.3.6.1.2.1.6.9', 'udp' => '1.3.6.1.2.1.7', 'udpInDatagrams' => '1.3.6.1.2.1.7.1', 'udpNoPorts' => '1.3.6.1.2.1.7.2', 'udpInErrors' => '1.3.6.1.2.1.7.3', 'udpOutDatagrams' => '1.3.6.1.2.1.7.4', 'udpTable' => '1.3.6.1.2.1.7.5', 'udpEntry' => '1.3.6.1.2.1.7.5.1', 'udpLocalAddress' => '1.3.6.1.2.1.7.5.1.1', 'udpLocalPort' => '1.3.6.1.2.1.7.5.1.2', 'egp' => '1.3.6.1.2.1.8', 'egpInMsgs' => '1.3.6.1.2.1.8.1', 'egpInErrors' => '1.3.6.1.2.1.8.2', 'egpOutMsgs' => '1.3.6.1.2.1.8.3', 'egpOutErrors' => '1.3.6.1.2.1.8.4', 'egpNeighTable' => '1.3.6.1.2.1.8.5', 'egpNeighEntry' => '1.3.6.1.2.1.8.5.1', 'egpNeighState' => '1.3.6.1.2.1.8.5.1.1', 'egpNeighStateUps' => '1.3.6.1.2.1.8.5.1.10', 'egpNeighStateDowns' => '1.3.6.1.2.1.8.5.1.11', 'egpNeighIntervalHello' => '1.3.6.1.2.1.8.5.1.12', 'egpNeighIntervalPoll' => '1.3.6.1.2.1.8.5.1.13', 'egpNeighMode' => '1.3.6.1.2.1.8.5.1.14', 'egpNeighEventTrigger' => '1.3.6.1.2.1.8.5.1.15', 'egpNeighAddr' => '1.3.6.1.2.1.8.5.1.2', 'egpNeighAs' => '1.3.6.1.2.1.8.5.1.3', 'egpNeighInMsgs' => '1.3.6.1.2.1.8.5.1.4', 'egpNeighInErrs' => '1.3.6.1.2.1.8.5.1.5', 'egpNeighOutMsgs' => '1.3.6.1.2.1.8.5.1.6', 'egpNeighOutErrs' => '1.3.6.1.2.1.8.5.1.7', 'egpNeighInErrMsgs' => '1.3.6.1.2.1.8.5.1.8', 'egpNeighOutErrMsgs' => '1.3.6.1.2.1.8.5.1.9', 'egpAs' => '1.3.6.1.2.1.8.6', 'transmission' => '1.3.6.1.2.1.10', 'frame-relay' => '1.3.6.1.2.1.10.32', 'frDlcmiTable' => '1.3.6.1.2.1.10.32.1', 'frDlcmiEntry' => '1.3.6.1.2.1.10.32.1.1', 'frDlcmiIfIndex' => '1.3.6.1.2.1.10.32.1.1.1', 'frDlcmiState' => '1.3.6.1.2.1.10.32.1.1.2', 'frDlcmiAddress' => '1.3.6.1.2.1.10.32.1.1.3', 'frDlcmiAddressLen' => '1.3.6.1.2.1.10.32.1.1.4', 'frDlcmiPollingInterval' => '1.3.6.1.2.1.10.32.1.1.5', 'frDlcmiFullEnquiryInterval' => '1.3.6.1.2.1.10.32.1.1.6', 'frDlcmiErrorThreshold' => '1.3.6.1.2.1.10.32.1.1.7', 'frDlcmiMonitoredEvents' => '1.3.6.1.2.1.10.32.1.1.8', 'frDlcmiMaxSupportedVCs' => '1.3.6.1.2.1.10.32.1.1.9', 'frDlcmiMulticast' => '1.3.6.1.2.1.10.32.1.1.10', 'frCircuitTable' => '1.3.6.1.2.1.10.32.2', 'frCircuitEntry' => '1.3.6.1.2.1.10.32.2.1', 'frCircuitIfIndex' => '1.3.6.1.2.1.10.32.2.1.1', 'frCircuitDlci' => '1.3.6.1.2.1.10.32.2.1.2', 'frCircuitState' => '1.3.6.1.2.1.10.32.2.1.3', 'frCircuitReceivedFECNs' => '1.3.6.1.2.1.10.32.2.1.4', 'frCircuitReceivedBECNs' => '1.3.6.1.2.1.10.32.2.1.5', 'frCircuitSentFrames' => '1.3.6.1.2.1.10.32.2.1.6', 'frCircuitSentOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frOutOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frCircuitReceivedFrames' => '1.3.6.1.2.1.10.32.2.1.8', 'frCircuitReceivedOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frInOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frCircuitCreationTime' => '1.3.6.1.2.1.10.32.2.1.10', 'frCircuitLastTimeChange' => '1.3.6.1.2.1.10.32.2.1.11', 'frCircuitCommittedBurst' => '1.3.6.1.2.1.10.32.2.1.12', 'frCircuitExcessBurst' => '1.3.6.1.2.1.10.32.2.1.13', 'frCircuitThroughput' => '1.3.6.1.2.1.10.32.2.1.14', 'frErrTable' => '1.3.6.1.2.1.10.32.3', 'frErrEntry' => '1.3.6.1.2.1.10.32.3.1', 'frErrIfIndex' => '1.3.6.1.2.1.10.32.3.1.1', 'frErrType' => '1.3.6.1.2.1.10.32.3.1.2', 'frErrData' => '1.3.6.1.2.1.10.32.3.1.3', 'frErrTime' => '1.3.6.1.2.1.10.32.3.1.4', 'frame-relay-globals' => '1.3.6.1.2.1.10.32.4', 'frTrapState' => '1.3.6.1.2.1.10.32.4.1', 'snmp' => '1.3.6.1.2.1.11', 'snmpInPkts' => '1.3.6.1.2.1.11.1', 'snmpInBadValues' => '1.3.6.1.2.1.11.10', 'snmpInReadOnlys' => '1.3.6.1.2.1.11.11', 'snmpInGenErrs' => '1.3.6.1.2.1.11.12', 'snmpInTotalReqVars' => '1.3.6.1.2.1.11.13', 'snmpInTotalSetVars' => '1.3.6.1.2.1.11.14', 'snmpInGetRequests' => '1.3.6.1.2.1.11.15', 'snmpInGetNexts' => '1.3.6.1.2.1.11.16', 'snmpInSetRequests' => '1.3.6.1.2.1.11.17', 'snmpInGetResponses' => '1.3.6.1.2.1.11.18', 'snmpInTraps' => '1.3.6.1.2.1.11.19', 'snmpOutPkts' => '1.3.6.1.2.1.11.2', 'snmpOutTooBigs' => '1.3.6.1.2.1.11.20', 'snmpOutNoSuchNames' => '1.3.6.1.2.1.11.21', 'snmpOutBadValues' => '1.3.6.1.2.1.11.22', 'snmpOutGenErrs' => '1.3.6.1.2.1.11.24', 'snmpOutGetRequests' => '1.3.6.1.2.1.11.25', 'snmpOutGetNexts' => '1.3.6.1.2.1.11.26', 'snmpOutSetRequests' => '1.3.6.1.2.1.11.27', 'snmpOutGetResponses' => '1.3.6.1.2.1.11.28', 'snmpOutTraps' => '1.3.6.1.2.1.11.29', 'snmpInBadVersions' => '1.3.6.1.2.1.11.3', 'snmpEnableAuthenTraps' => '1.3.6.1.2.1.11.30', 'snmpInBadCommunityNames' => '1.3.6.1.2.1.11.4', 'snmpInBadCommunityUses' => '1.3.6.1.2.1.11.5', 'snmpInASNParseErrs' => '1.3.6.1.2.1.11.6', 'snmpInTooBigs' => '1.3.6.1.2.1.11.8', 'snmpInNoSuchNames' => '1.3.6.1.2.1.11.9', 'ifName' => '1.3.6.1.2.1.31.1.1.1.1', 'ifInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.2', 'ifInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.3', 'ifOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.4', 'ifOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.5', 'ifHCInOctets' => '1.3.6.1.2.1.31.1.1.1.6', 'ifHCInUcastPkts' => '1.3.6.1.2.1.31.1.1.1.7', 'ifHCInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.8', 'ifHCInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.9', 'ifHCOutOctets' => '1.3.6.1.2.1.31.1.1.1.10', 'ifHCOutUcastPkts' => '1.3.6.1.2.1.31.1.1.1.11', 'ifHCOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.12', 'ifHCOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.13', 'ifLinkUpDownTrapEnable' => '1.3.6.1.2.1.31.1.1.1.14', 'ifHighSpeed' => '1.3.6.1.2.1.31.1.1.1.15', 'ifPromiscuousMode' => '1.3.6.1.2.1.31.1.1.1.16', 'ifConnectorPresent' => '1.3.6.1.2.1.31.1.1.1.17', 'ifAlias' => '1.3.6.1.2.1.31.1.1.1.18', 'ifCounterDiscontinuityTime' => '1.3.6.1.2.1.31.1.1.1.19', 'experimental' => '1.3.6.1.3', 'private' => '1.3.6.1.4', 'enterprises' => '1.3.6.1.4.1', ); # GIL my %revOIDS = (); # Reversed %Net_SNMP_util::OIDS hash my $RevNeeded = 1; undef $Net_SNMP_util::Host; undef $Net_SNMP_util::Session; undef $Net_SNMP_util::Version; undef $Net_SNMP_util::LHost; undef $Net_SNMP_util::IPv4only; undef $Net_SNMP_util::ContextEngineID; undef $Net_SNMP_util::ContextName; $Net_SNMP_util::Debug = 0; $Net_SNMP_util::SuppressWarnings = 0; $Net_SNMP_util::CacheFile = "OID_cache.txt"; $Net_SNMP_util::CacheLoaded = 0; $Net_SNMP_util::ReturnArrayRefs = 0; $Net_SNMP_util::ReturnHashRefs = 0; $Net_SNMP_util::MaxRepetitions = 12; ### Prototypes sub snmpget ($@); sub snmpgetnext ($@); sub snmpopen ($$$); sub snmpwalk ($@); sub snmpwalk_flg ($$@); sub snmpset ($@); sub snmptrap ($$$$$@); sub snmpgetbulk ($$$@); sub snmpwalkhash ($$@); sub toOID (@); sub snmpmapOID (@); sub snmpMIB_to_OID ($); sub Check_OID ($); sub snmpLoad_OID_Cache ($); sub snmpQueue_MIB_File (@); sub ASNtype ($); sub error_msg ($); sub MIB_fill_OID ($); sub version () { $VERSION; } =head1 Option Notes =over =item host Parameter SNMP parameters can be specified as part of the hostname/ip address passed as the first argument. The syntax is community@host:port:timeout:retries:backoff:version If the community is left off, it defaults to "public". If the port is left off, it defaults to 161 for everything but snmptrap(). The snmptrap() routine uses a default port of 162. Timeout and retries defaults to whatever Net::SNMP uses, currently 5.0 seconds and 1 retry (2 tries total). The backoff parameter is currently unimplemented. The version parameter defaults to SNMP version 1. Some SNMP values such as 64-bit counters have to be queried using SNMP version 2. Specifying "2" or "2c" as the version parameter will accomplish this. The snmpgetbulk routine is only supported in SNMP version 2 and higher. Additional security features are available under SNMP version 3. Some machines have additional security features that only allow SNMP queries to come from certain IP addresses. If the host doing the query has multiple interfaces, it may be necessary to specify the interface the query should come from. The port parameter is further broken down into remote_port!local_address!local_port Here are some examples: somehost somehost:161 somehost:161!192.168.2.4!4000 use 192.168.2.4 and port 4000 as source somehost:!192.168.2.4 use 192.168.2.4 as source somehost:!!4000 use port 4000 as source Most people will only need to use the first form ("somehost"). =item OBJECT IDENTIFIERs To further simplify SNMP queries, the query routines use a small table that maps the textual representation of OBJECT IDENTIFIERs to their dotted notation. The OBJECT IDENTIFIERs from RFC1213 (MIB-II) and RFC1315 (Frame Relay) are preloaded. This allows OBJECT IDENTIFIERs like "ifInOctets.4" to be used instead of the more cumbersome "1.3.6.1.2.1.2.2.1.10.4". Several functions are provided to manage the mapping table. Mapping entries can be added directly, SNMP MIB files can be read, and a cache file with the text-to-OBJECT-IDENTIFIER mappings are maintained. By default, the file "OID_cache.txt" is loaded, but it can by changed by setting the variable $Net_SNMP_util::CacheFile to the desired file name. The functions to manipulate the mappings are: snmpmapOID Add a textual OID mapping directly snmpMIB_to_OID Read a SNMP MIB file snmpLoad_OID_Cache Load an OID-mapping cache file snmpQueue_MIB_File Queue a SNMP MIB file for loading on demand =item Net::SNMP extensions This module is built on top of Net::SNMP. Net::SNMP has a different method of specifying SNMP parameters. To support this different method, this module will accept an optional hash reference containing the SNMP parameters. The hash may contain the following: [-port => $port,] [-localaddr => $localaddr,] [-localport => $localport,] [-version => $version,] [-domain => $domain,] [-timeout => $seconds,] [-retries => $count,] [-maxmsgsize => $octets,] [-debug => $bitmask,] [-community => $community,] # v1/v2c [-username => $username,] # v3 [-authkey => $authkey,] # v3 [-authpassword => $authpasswd,] # v3 [-authprotocol => $authproto,] # v3 [-privkey => $privkey,] # v3 [-privpassword => $privpasswd,] # v3 [-privprotocol => $privproto,] # v3 [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 Please see the documentation for Net::SNMP for a description of these parameters. =item SNMPv3 Arguments A SNMP context is a collection of management information accessible by a SNMP entity. An item of management information may exist in more than one context and a SNMP entity potentially has access to many contexts. The combination of a contextEngineID and a contextName unambiguously identifies a context within an administrative domain. In a SNMPv3 message, the contextEngineID and contextName are included as part of the scopedPDU. All methods that generate a SNMP message optionally take a B<-contextengineid> and B<-contextname> argument to configure these fields. =over =item Context Engine ID The B<-contextengineid> argument expects a hexadecimal string representing the desired contextEngineID. The string must be 10 to 64 characters (5 to 32 octets) long and can be prefixed with an optional "0x". Once the B<-contextengineid> is specified it stays with the object until it is changed again or reset to default by passing in the undefined value. By default, the contextEngineID is set to match the authoritativeEngineID of the authoritative SNMP engine. =item Context Name The contextName is passed as a string which must be 0 to 32 octets in length using the B<-contextname> argument. The contextName stays with the object until it is changed. The contextName defaults to an empty string which represents the "default" context. =back =back =cut # [public methods] --------------------------------------------------- =head1 Functions =head2 snmpget() - send a SNMP get-request to the remote agent @result = snmpget( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], [\%param_hash], @oids ); This function performs a SNMP get-request query to gather data from the remote agent on the host specified. The message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetRequest-PDU in the same order that it held in the original list. The requested values are returned in an array in the same order as they were requested. In scalar context the first requested value is returned. =cut # # snmpget. # sub snmpget ($@) { my($host, @vars) = @_; my($session, @enoid, %args, $ret, $oid, @retvals); @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGET Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return wantarray ? @retvals : undef; } @enoid = &toOID(@vars); if ($#enoid < 0) { return wantarray ? @retvals : undef; } $args{'-varbindlist'} = \@enoid; if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } $ret = $session->get_request(%args); if ($ret) { foreach $oid (@enoid) { push @retvals, $ret->{$oid} if (exists($ret->{$oid})); } return wantarray ? @retvals : $retvals[0]; } $ret = join(' ', @vars); error_msg("SNMPGET Problem for $ret on ${host}: " . $session->error()); return wantarray ? @retvals : undef; } =head2 snmpgetnext() - send a SNMP get-next-request to the remote agent @result = snmpgetnext( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], [\%param_hash], @oids ); This function performs a SNMP get-next-request query to gather data from the remote agent on the host specified. The message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. The requested values are returned in an array in the same order as they were requested. The OBJECT IDENTIFIER number is added as a prefix to each value using a colon as a separator, like '1.3.6.1.2.1.2.2.1.2.1:ethernet'. In scalar context the first requested value is returned. =cut # # snmpgetnext. # sub snmpgetnext ($@) { my($host, @vars) = @_; my($session, @enoid, %args, $ret, $oid, @retvals); @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETNEXT Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return wantarray ? @retvals : undef; } @enoid = &toOID(@vars); if ($#enoid < 0) { return wantarray ? @retvals : undef; } $args{'-varbindlist'} = \@enoid; if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } $ret = $session->get_next_request(%args); if ($ret) { foreach $oid (@enoid) { push @retvals, $oid . ':' . $ret->{$oid} if (exists($ret->{$oid})); } return wantarray ? @retvals : $retvals[0]; } $ret = join(' ', @vars); error_msg("SNMPGETNEXT Problem for $ret on ${host}: " . $session->error()); return wantarray ? @retvals : undef; } =head2 snmpgetbulk() - send a SNMP get-bulk-request to the remote agent @result = snmpgetbulk( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], $nonrepeaters, $maxrepetitions, [\%param_hash], @oids ); This function performs a SNMP get-bulk-request query to gather data from the remote agent on the host specified. =over =item * The B<$nonrepeaters> value specifies the number of variables in the @oids list for which a single successor is to be returned. If it is null or undefined, a value of 0 is used. =item * The B<$maxrepetitions> value specifies the number of successors to be returned for the remaining variables in the @oids list. If it is null or undefined, the default value of 12 is used. =item * The message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. =back The requested values are returned in an array in the same order as they were requested. B This function can only be used when the SNMP version is set to SNMPv2c or SNMPv3. =cut # # snmpgetbulk. # sub snmpgetbulk ($$$@) { my($host, $nr, $mr, @vars) = @_; my($session, %args, @enoid, $ret); my($oid, @retvals); @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETBULK Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return @retvals; } if ($Net_SNMP_util::Version < 2) { carp "SNMPGETBULK Problem for $host : must use SNMP version > 1" unless ($Net_SNMP_util::SuppressWarnings > 1); return @retvals; } $args{'-nonrepeaters'} = $nr if ($nr > 0); $mr = $Net_SNMP_util::MaxRepetitions if ($mr <= 0); $args{'-maxrepetitions'} = $mr; if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } @enoid = &toOID(@vars); return @retvals if ($#enoid < 0); $args{'-varbindlist'} = \@enoid; $ret = $session->get_bulk_request(%args); if ($ret) { @enoid = &Net::SNMP::oid_lex_sort(keys %$ret); foreach $oid (@enoid) { push @retvals, $oid . ":" . $ret->{$oid}; } return @retvals; } else { $ret = join(' ', @vars); error_msg("SNMPGETBULK Problem for $ret on ${host}: " . $session->error()); return @retvals; } } =head2 snmpwalk() - walk OBJECT IDENTIFIER tree(s) on the remote agent @result = snmpwalk( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], [\%param_hash], @oids ); This function performs a sequence of SNMP get-next-request or get-bulk-request (if the SNMP version is 2 or higher) queries to gather data from the remote agent on the host specified. The initial message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. Queries continue until all the returned OBJECT IDENTIFIERs are no longer a child of the base OBJECT IDENTIFIERs. The requested values are returned in an array in the same order as they were requested. The OBJECT IDENTIFIER number is added as a prefix to each value using a colon as a separator, like '1.3.6.1.2.1.2.2.1.2.1:ethernet'. If only one OBJECT IDENTIFIER is requested, just the "instance" part of the OBJECT IDENTIFIER is added as a prefix, like '1:ethernet', '2:ethernet', '3:fddi'. =cut # # snmpwalk. # sub snmpwalk ($@) { my($host, @vars) = @_; return(&snmpwalk_flg($host, undef, @vars)); } =head2 snmpset() - send a SNMP set-request to the remote agent @result = snmpset( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], [\%param_hash], $oid1, $type1, $value1, [$oid2, $type2, $value2 ...] ); This function is used to modify data on the remote agent using a SNMP set-request. The message is built using the list of values consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value to be set. The object type can be one of the following strings: integer | int string | octetstring | octet string oid | object id | object identifier ipaddr | ip addr4ess timeticks uint | uinteger | uinteger32 | unsigned int | unsigned integer | unsigned integer32 counter | counter 32 counter64 gauge | gauge32 The object type may also be an octet corresponding to the ASN.1 type. See the Net::SNMP documentation for more information. The requested values are returned in an array in the same order as they were requested. In scalar context the first requested value is returned. =cut # # snmpset. # sub snmpset($@) { my($host, @vars) = @_; my($session, @vals, %args, $ret); my($oid, $type, $value, @enoid, @retvals); @retvals = (); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPSET Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return wantarray ? @retvals : undef; } if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } while(@vars) { ($oid) = toOID((shift @vars)); $ret = shift @vars; $value = shift @vars; $type = ASNtype($ret); if (!defined($type)) { carp "Unknown SNMP type: $type\n" unless ($Net_SNMP_util::SuppressWarnings > 1); } push @vals, $oid, $type, $value; push @enoid, $oid; } if ($#vals < 0) { return wantarray ? @retvals : undef; } $args{'-varbindlist'} = \@vals; $ret = $session->set_request(%args); if ($ret) { foreach $oid (@enoid) { push @retvals, $ret->{$oid} if (exists($ret->{$oid})); } return wantarray ? @retvals : $retvals[0]; } $ret = join(' ', @enoid); error_msg("SNMPSET Problem for $ret on ${host}: " . $session->error()); return wantarray ? @retvals : undef; } =head2 snmptrap() - send a SNMP trap to the remote manager @result = snmptrap( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], $enterprise, $agentaddr, $generictrap, $specifictrap, [\%param_hash], $oid1, $type1, $value1, [$oid2, $type2, $value2 ...] ); This function sends a SNMP trap to the remote manager on the host specified. The message is built using the list of values consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value to be set. The object type can be one of the following strings: integer | int string | octetstring | octet string oid | object id | object identifier ipaddr | ip addr4ess timeticks uint | uinteger | uinteger32 | unsigned int | unsigned integer | unsigned integer32 counter | counter 32 counter64 gauge | gauge32 The object type may also be an octet corresponding to the ASN.1 type. See the Net::SNMP documentation for more information. A true value is returned if sending the trap is successful. The undefined value is returned when a failure has occurred. When the trap is sent as SNMPv2c, the B<$enterprise>, B<$agentaddr>, B<$generictrap>, and B<$specifictrap> arguments are ignored. Furthermore, the first two (oid, type, value) tuples should be: =over =item * sysUpTime.0 - ('1.3.6.1.2.1.1.3.0', 'timeticks', $timeticks) =item * snmpTrapOID.0 - ('1.3.6.1.6.3.1.1.4.1.0', 'oid', $oid) =back B This function can only be used when the SNMP version is set to SNMPv1 or SNMPv2c. =cut # # Send an SNMP trap # sub snmptrap($$$$$@) { my($host, $ent, $agent, $gen, $spec, @vars) = @_; my($oid, $type, $value, $ret, @enoid, @vals); my($session, %args); $session = &snmpopen($host, 1, \@vars); if (!defined($session)) { carp "SNMPTRAP Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return undef; } if ($Net_SNMP_util::Version == 1) { $args{'-enterprise'} = $ent if (defined($ent) and (length($ent) > 0)); $args{'-agentaddr'} = $agent if (defined($agent) and (length($agent) > 0)); $args{'-generictrap'} = $gen if (defined($gen) and (length($gen) > 0)); $args{'-specifictrap'} = $spec if (defined($spec) and (length($spec) > 0)); } elsif ($Net_SNMP_util::Version > 2) { carp "SNMPTRAP Problem for $host : must use SNMP version 1 or 2" unless ($Net_SNMP_util::SuppressWarnings > 1); } while(@vars) { ($oid) = toOID((shift @vars)); $ret = shift @vars; $value = shift @vars; $type = ASNtype($ret); if (!defined($type)) { carp "unknown SNMP type: $type" unless ($Net_SNMP_util::SuppressWarnings > 1); } push @vals, $oid, $type, $value; push @enoid, $oid; } return undef unless defined $vals[0]; $args{'-varbindlist'} = \@vals; if ($Net_SNMP_util::Version == 1) { $ret = $session->trap_request(%args); } else { $ret = $session->snmpv2_trap(%args); } if (!$ret) { $ret = join(' ', @enoid); error_msg("SNMPTRAP Problem for $ret on ${host}: " . $session->error()); } return $ret; } =head2 snmpmaptable() - walk OBJECT IDENTIFIER tree(s) on the remote agent $result = snmpmaptable( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], \&function, [\%param_hash], @oids ); This function performs a sequence of SNMP get-next-request or get-bulk-request (if the SNMP version is 2 or higher) queries to gather data from the remote agent on the host specified. The initial message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. Queries continue until all the returned OBJECT IDENTIFIERs are no longer a child of the base OBJECT IDENTIFIERs. The OBJECT IDENTIFIERs must correspond to column entries for a conceptual row in a table. They may however be columns in different tables as long as each table is indexed the same way. =over =item * The B<\&function> argument will be called once per row of the table. It will be passed the row index as a partial OBJECT IDENTIFIER in dotted notation, e.g. "1.3" or "10.0.1.34", and the values of the requested table columns in that row. =back The number of rows in the table is returned on success. The undefined value is returned when a failure has occurred. =cut # # walk a table, calling a user-supplied function for each # column of a table. # sub snmpmaptable($$@) { my($host, $fun, @vars) = @_; return snmpmaptable4($host, $fun, 0, @vars); } =head2 snmpmaptable4() - walk OBJECT IDENTIFIER tree(s) on the remote agent $result = snmpmaptable4( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], \&function, $maxrepetitions, [\%param_hash], @oids ); This function performs a sequence of SNMP get-next-request or get-bulk-request (if the SNMP version is 2 or higher) queries to gather data from the remote agent on the host specified. The initial message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. Queries continue until all the returned OBJECT IDENTIFIERs are no longer a child of the base OBJECT IDENTIFIERs. The OBJECT IDENTIFIERs must correspond to column entries for a conceptual row in a table. They may however be columns in different tables as long as each table is indexed the same way. =over =item * The B<\&function> argument will be called once per row of the table. It will be passed the row index as a partial OBJECT IDENTIFIER in dotted notation, e.g. "1.3" or "10.0.1.34", and the values of the requested table columns in that row. =item * The B<$maxrepetitions> argument specifies the number of rows to be returned by a single get-bulk-request. If it is null or undefined, the default value of 12 is used. =back The number of rows in the table is returned on success. The undefined value is returned when a failure has occurred. =cut sub snmpmaptable4($$$@) { my($host, $fun, $max_reps, @vars) = @_; my($session, @enoid, %args, $ret); my($oid, $soid, $toid, $inst, @row, $nr); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPMAPTABLE Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); return undef; } @enoid = toOID(@vars); return undef unless defined $enoid[0]; if ($Net_SNMP_util::Version > 1) { $max_reps = $Net_SNMP_util::MaxRepetitions if ($max_reps <= 0); $args{'-maxrepetitions'} = $max_reps; } if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } $args{'-columns'} = \@enoid; $ret = $session->get_entries(%args); if ($ret) { $soid = $enoid[0]; $nr = 0; foreach $oid (&Net::SNMP::oid_lex_sort(keys %$ret)) { if (&Net::SNMP::oid_base_match($soid, $oid)) { $inst = substr($oid, length($soid)+1); undef @row; foreach $toid (@enoid) { push @row, $ret->{$toid . "." . $inst}; } &$fun($inst, @row); $nr++; } else { return($nr) if ($nr > 0); } } return($nr); } else { $ret = join(' ', @vars); error_msg("SNMPMAPTABLE Problem for $ret on ${host}: " . $session->error()); return undef; } } =head2 snmpwalkhash() - send a SNMP get-next-request to the remote agent @result = snmpwalkhash( [community@]host[:port[:timeout[:retries[:backoff[:version]]]]], \&function(), [\%param_hash], @oids, [\%hash] ); This function performs a sequence of SNMP get-next-request or get-bulk-request (if the SNMP version is 2 or higher) queries to gather data from the remote agent on the host specified. The message is built using the list of OBJECT IDENTIFIERs passed as an array. Each OBJECT IDENTIFIER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. Queries continue until all the returned OBJECT IDENTIFIERs are outside of the tree specified by the initial OBJECT IDENTIFIERs. The B<\&function> is called once for every returned value. It is passed a reference to a hash, the hostname, the textual OBJECT IDENTIFIER, the dotted-numberic OBJECT IDENTIFIER, the instance, the value and the requested textual OBJECT IDENTIFIER. That function can customize the result so the values can be extracted later by hosts, by oid_names, by oid_numbers, by instances... like these: $hash{$host}{$name}{$inst} = $value; $hash{$host}{$oid}{$inst} = $value; $hash{$name}{$inst} = $value; $hash{$oid}{$inst} = $value; $hash{$oid . '.' . $ints} = $value; $hash{$inst} = $value; ... If the last argument to B is a reference to a hash, that hash reference is passed to the passed-in function instead of a local hash reference. That way the function can look up other objects unrelated to the current invocation of B. The snmpwalkhash routine returns the hash. =cut # # Walk the MIB, putting everything you find into hashes. # sub snmpwalkhash($$@) { # my($host, $hash_sub, @vars) = @_; return(&snmpwalk_flg( @_ )); } =head2 snmpmapOID() - add texual OBJECT INDENTIFIER mapping snmpmapOID( $text1, $oid1, [ $text2, $oid2 ...] ); This routine adds entries to the table that maps textual representation of OBJECT IDENTIFIERs to their dotted notation. For example, snmpmapOID('ciscoCPU', '1.3.6.1.4.1.9.9.109.1.1.1.1.5.1'); allows the string 'ciscoCPU' to be used as an OBJECT IDENTIFIER in any SNMP query routine. This routine doesn't return anything. =cut # # Add passed-in text, OID pairs to the OID mapping table. # sub snmpmapOID(@) { my(@vars) = @_; my($oid, $txt); $Net_SNMP_util::ErrorMessage = ''; while($#vars >= 0) { $txt = shift @vars; $oid = shift @vars; next unless($txt =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-])*$/); next unless($oid =~ /^\d+(\.\d+)*$/); $Net_SNMP_util::OIDS{$txt} = $oid; $RevNeeded = 1; print "snmpmapOID: $txt => $oid\n" if $Net_SNMP_util::Debug; } return undef; } =head2 snmpLoad_OID_Cache() - Read a file of cached OID mappings $result = snmpLoad_OID_Cache( $file ); This routine opens the file named by the B<$file> argument and reads it. The file should contain text, OBJECT IDENTIFIER pairs, one pair per line. It adds the pairs as entries to the table that maps textual representation of OBJECT IDENTIFIERs to their dotted notation. Blank lines and anything after a '#' or between '--' is ignored. This routine returns 0 on success and -1 if the B<$file> could not be opened. =cut # # Open the passed-in file name and read it in to populate # the cache of text-to-OID map table. It expects lines # with two fields, the first the textual string like "ifInOctets", # and the second the OID value, like "1.3.6.1.2.1.2.2.1.10". # # blank lines and anything after a '#' or between '--' is ignored. # sub snmpLoad_OID_Cache ($) { my($arg) = @_; my($txt, $oid); $Net_SNMP_util::ErrorMessage = ''; if (!open(CACHE, $arg)) { error_msg("snmpLoad_OID_Cache: Can't open ${arg}: $!"); return -1; } while() { s/#.*//; # '#' starts a comment s/--.*?--/ /g; # comment delimited by '--', like MIBs s/--.*//; # comment started by '--' next if (/^$/); next unless (/\s/); # must have whitespace as separator chomp; ($txt, $oid) = split(' ', $_, 2); $txt = $1 if ($txt =~ /^[\'\"](.*)[\'\"]/); $oid = $1 if ($oid =~ /^[\'\"](.*)[\'\"]/); if (($txt =~ /^\.?\d+(\.\d+)*\.?$/) and ($oid !~ /^\.?\d+(\.\d+)*\.?$/)) { my($a) = $oid; $oid = $txt; $txt = $a; } $oid =~ s/^\.//; $oid =~ s/\.$//; &snmpmapOID($txt, $oid); } close(CACHE); return 0; } =head2 snmpMIB_to_OID() - Read a MIB file for textual OID mappings $result = snmpMIB_to_OID( $file ); This routine opens the file named by the B<$file> argument and reads it. The file should be an SNMP Management Information Base (MIB) file that describes OBJECT IDENTIFIERs supported by an SNMP agent. per line. It adds the textual representation of the OBJECT IDENTIFIERs to the text-to-OID mapping table. This routine returns the number of entries added to the table or -1 if the B<$file> could not be opened. =cut # # Read in the passed MIB file, parsing it # for their text-to-OID mappings # sub snmpMIB_to_OID ($) { my($arg) = @_; my($cnt, $quote, $buf, %tOIDs, $tgot); my($var, @parts, $strt, $indx, $ind, $val); $Net_SNMP_util::ErrorMessage = ''; if (!open(MIB, $arg)) { error_msg("snmpMIB_to_OID: Can't open ${arg}: $!"); return -1; } print "snmpMIB_to_OID: loading $arg\n" if $Net_SNMP_util::Debug; $cnt = 0; $quote = 0; $tgot = 0; $buf = ''; while() { if ($quote) { next unless /"/; $quote = 0; } chomp; $buf .= ' ' . $_; $buf =~ s/"[^"]*"//g; # throw away quoted strings $buf =~ s/--.*?--/ /g; # throw away comments (-- anything --) $buf =~ s/--.*//; # throw away comments (-- anything to EOL) $buf =~ s/\s+/ /g; # clean up multiple spaces if ($buf =~ /"/) { $quote = 1; next; } if ($buf =~ /DEFINITIONS *::= *BEGIN/) { $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $buf = ''; %tOIDs = (); $tgot = 0; next; } $buf =~ s/OBJECT-TYPE/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-GROUP/OBJECT IDENTIFIER/; $buf =~ s/MODULE-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/NOTIFICATION-TYPE/OBJECT IDENTIFIER/; $buf =~ s/ IMPORTS .*\;//; $buf =~ s/ SEQUENCE *{.*}//; $buf =~ s/ SYNTAX .*//; $buf =~ s/ [\w\-]+ *::= *OBJECT IDENTIFIER//; $buf =~ s/ OBJECT IDENTIFIER.*::= *{/ OBJECT IDENTIFIER ::= {/; if ($buf =~ / ([\w\-]+) OBJECT IDENTIFIER *::= *{([^}]+)}/) { $var = $1; $buf = $2; $buf =~ s/ +$//; $buf =~ s/\s+\(/\(/g; # remove spacing around '(' $buf =~ s/\(\s+/\(/g; $buf =~ s/\s+\)/\)/g; # remove spacing before ')' @parts = split(' ', $buf); $strt = ''; foreach $indx (@parts) { if ($indx =~ /([\w\-]+)\((\d+)\)/) { $ind = $1; $val = $2; if (exists($tOIDs{$strt})) { $tOIDs{$ind} = $tOIDs{$strt} . '.' . $val; } elsif ($strt ne '') { $tOIDs{$ind} = "${strt}.${val}"; } else { $tOIDs{$ind} = $val; } $strt = $ind; $tgot = 1; } elsif ($indx =~ /^\d+$/) { if (exists($tOIDs{$strt})) { $tOIDs{$var} = $tOIDs{$strt} . '.' . $indx; } else { $tOIDs{$var} = "${strt}.${indx}"; } $tgot = 1; } else { $strt = $indx; } } $buf = ''; } } $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $RevNeeded = 1 if ($cnt > 0); return $cnt; } =head2 snmpQueue_MIB_File() - queue a MIB file for reading "on demand" snmpQueue_MIB_File( $file1, [$file2, ...] ); This routine queues the list of SNMP MIB files for later processing. Whenever a text-to-OBJECT IDENTIFIER lookup fails, the list of queued MIB files is consulted. If it isn't empty, the first MIB file in the list is removed and passed to B. The lookup is attempted again, and if that still fails the next MIB file in the list is removed and passed to B. This process continues until the lookup succeeds or the list is exhausted. This routine doesn't return anything. =cut # # Save the passed-in list of MIB files until an OID can't be # found in the existing table. At that time the MIB file will # be loaded, and the lookup attempted again. # sub snmpQueue_MIB_File (@) { my(@files) = @_; my($file); $Net_SNMP_util::ErrorMessage = ''; foreach $file (@files) { push(@Net_SNMP_util::MIB_Files, $file); } } # [private methods] ------------------------------------- # # Start an snmp session # sub snmpopen ($$$) { my($host, $type, $vars) = @_; my($nhost, $port, $community, $lhost, $lport, $nlhost); my($timeout, $retries, $backoff, $version, $v4onlystr); my($opts, %args, $tmp, $sess); my($debug, $maxmsgsize); $type = 0 if (!defined($type)); $community = "public"; $nlhost = ""; ($community, $host) = ($1, $2) if ($host =~ /^(.*)@([^@]+)$/); # We can't split on the : character because a numeric IPv6 # address contains a variable number of :'s if( ($host =~ /^(\[.*\]):(.*)$/) or ($host =~ /^(\[.*\])$/) ) { # Numeric IPv6 address between [] ($host, $opts) = ($1, $2); } else { # Hostname or numeric IPv4 address ($host, $opts) = split(':', $host, 2); } ($port, $timeout, $retries, $backoff, $version, $v4onlystr) = split(':', $opts, 6) if(defined($opts) and (length $opts > 0) ); undef($timeout) if (defined($timeout) and length($timeout) <= 0); undef($retries) if (defined($retries) and length($retries) <= 0); undef($backoff) if (defined($backoff) and length($backoff) <= 0); undef($version) if (defined($version) and length($version) <= 0); $v4onlystr = "" unless defined $v4onlystr; if (defined($port) and ($port =~ /^([^!]*)!(.*)$/)) { ($port, $lhost) = ($1, $2); $nlhost = $lhost; ($lhost, $lport) = ($1, $2) if ($lhost =~ /^(.*)!(.*)$/); undef($lport) if (defined($lport) and (length($lport) <= 0)); } undef($port) if (defined($port) and length($port) <= 0); if (ref $vars->[0] eq 'HASH') { undef($debug); undef($maxmsgsize); undef $Net_SNMP_util::ContextEngineID; undef $Net_SNMP_util::ContextName; $opts = shift @$vars; foreach $type (keys %$opts) { if ($type =~ /^-?return_array_refs$/i) { $Net_SNMP_util::ReturnArrayRefs = $opts->{$type}; } elsif ($type =~ /^-?return_hash_refs$/i) { $Net_SNMP_util::ReturnHashRefs = $opts->{$type}; } elsif ($type =~ /^-?contextengineid$/i) { $Net_SNMP_util::ContextEngineID = $opts->{$type}; } elsif ($type =~ /^-?contextname$/i) { $Net_SNMP_util::ContextName = $opts->{$type}; } elsif ($type =~ /^-?maxrepetitions$/i) { $Net_SNMP_util::MaxRepetitions = $opts->{$type}; } elsif ($type =~ /^-?default_max_repetitions$/i) { $Net_SNMP_util::MaxRepetitions = $opts->{$type}; } elsif ($type =~ /^-?version$/i) { $version = $opts->{$type}; } elsif ($type =~ /^-?port$/i) { $port = $opts->{$type}; } elsif ($type =~ /^-?localaddr$/i) { $lhost = $opts->{$type}; } elsif ($type =~ /^-?community$/i) { $community = $opts->{$type}; } elsif ($type =~ /^-?timeout$/i) { $timeout = $opts->{$type}; } elsif ($type =~ /^-?retries$/i) { $retries = $opts->{$type}; } elsif ($type =~ /^-?maxmsgsize$/i) { $maxmsgsize = $opts->{$type}; } elsif ($type =~ /^-?debug$/i) { $debug = $opts->{$type}; } elsif ($type =~ /^-?backoff$/i) { next; # XXXX not implemented in Net::SNMP } elsif ($type =~ /^-?avoid_negative_request_ids$/i) { next; # XXXX not implemented in Net::SNMP } elsif ($type =~ /^-?lenient_source_/i) { next; # XXXX not implemented in Net::SNMP } elsif ($type =~ /^-?use_16bit_request_ids$/i) { next; # XXXX not implemented in Net::SNMP } elsif ($type =~ /^-?use_getbulk$/i) { next; # XXXX not implemented in Net::SNMP } else { $tmp = $type; $tmp = '-' . $tmp unless ($tmp =~ /^-/); $args{$tmp} = $opts->{$type}; } } } $port = 162 if ($type == 1 and !defined($port)); $nhost = "$community\@$host"; $nhost .= ":" . $port if (defined($port)); undef($lhost) if (defined($lhost) and (length($lhost) <= 0)); $version = '1' unless defined $version; if ($version =~ /1/) { $version = 1; } elsif ($version =~ /2/) { $version = 2; } elsif ($version =~ /3/) { $version = 3; } $Net_SNMP_util::ErrorMessage = ''; if ((!defined($Net_SNMP_util::Session)) or ($Net_SNMP_util::Host ne $nhost) or ($Net_SNMP_util::Version ne $version) or ($Net_SNMP_util::LHost ne $nlhost) or ($Net_SNMP_util::IPv4only ne $v4onlystr)) { if (defined($Net_SNMP_util::Session)) { $Net_SNMP_util::Session->close(); undef $Net_SNMP_util::Session; undef $Net_SNMP_util::Host; undef $Net_SNMP_util::Version; undef $Net_SNMP_util::LHost; undef $Net_SNMP_util::IPv4only; } $args{'-hostname'} = $host; $args{'-port'} = $port if (defined($port)); $args{'-localaddr'} = $lhost if (defined($lhost)); $args{'-localport'} = $lport if (defined($lport)); $args{'-version'} = $version; $args{'-domain'} = "udp/ipv4" if (length($v4onlystr) > 0); $args{'-timeout'} = $timeout if (defined($timeout)); $args{'-retries'} = $retries if (defined($retries)); $args{'-maxmsgsize'} = $maxmsgsize if (defined($maxmsgsize)); $args{'-debug'} = $debug if (defined($debug)); $args{'-community'} = $community unless ($community eq "public"); if ($version == 3) { delete $args{'-community'} } else { delete $args{'-username'}; delete $args{'-authkey'}; delete $args{'-authpassword'}; delete $args{'-authprotocol'}; delete $args{'-privkey'}; delete $args{'-privpassword'}; delete $args{'-privprotocol'}; } ($sess, $tmp) = Net::SNMP->session(%args); if (defined($sess)) { $Net_SNMP_util::Session = $sess; $Net_SNMP_util::Host = $nhost; $Net_SNMP_util::Version = $version; $Net_SNMP_util::LHost = $nlhost; $Net_SNMP_util::IPv4only = $v4onlystr; } else { error_msg("SNMPopen failed: $tmp\n"); return(undef); } return $Net_SNMP_util::Session; } else { $Net_SNMP_util::Session->timeout($timeout) if (defined($timeout) and (length($timeout) > 0)); $Net_SNMP_util::Session->retries($retries) if (defined($retries) and (length($retries) > 0)); $Net_SNMP_util::Session->maxmsgsize($maxmsgsize) if (defined($maxmsgsize) and (length($maxmsgsize) > 0)); $Net_SNMP_util::Session->debug($debug) if (defined($debug) and (length($debug) > 0)); $Net_SNMP_util::Session->{_context_engine_id} = undef if (!defined($Net_SNMP_util::ContextEngineID)); $Net_SNMP_util::Session->{_context_name} = undef if (!defined($Net_SNMP_util::ContextName)); } return $Net_SNMP_util::Session; } # # Given an OID in either ASN.1 or mixed text/ASN.1 notation, return an OID. # sub toOID(@) { my(@vars) = @_; my($oid, $var, $tmp, $tmpv, @retvar); @retvar = (); foreach $var (@vars) { ($oid, $tmp) = &Check_OID($var); if (!$oid and $Net_SNMP_util::CacheLoaded == 0) { $tmp = $Net_SNMP_util::SuppressWarnings; $Net_SNMP_util::SuppressWarnings = 1000; &snmpLoad_OID_Cache($Net_SNMP_util::CacheFile); $Net_SNMP_util::CacheLoaded = 1; $Net_SNMP_util::SuppressWarnings = $tmp; ($oid, $tmp) = &Check_OID($var); } while (!$oid and $#Net_SNMP_util::MIB_Files >= 0) { $tmp = $Net_SNMP_util::SuppressWarnings; $Net_SNMP_util::SuppressWarnings = 1000; snmpMIB_to_OID(shift(@Net_SNMP_util::MIB_Files)); $Net_SNMP_util::SuppressWarnings = $tmp; ($oid, $tmp) = &Check_OID($var); if ($oid) { open(CACHE, ">>$Net_SNMP_util::CacheFile"); print CACHE "$tmp\t$oid\n"; close(CACHE); } } if ($oid) { $var =~ s/^$tmp/$oid/; } else { carp("Unknown SNMP var $var\n") unless ($Net_SNMP_util::SuppressWarnings > 1); next; } while ($var =~ /\"([^\"]*)\"/) { $tmp = sprintf("%d.%s", length($1), join(".", map(ord, split(//, $1)))); $var =~ s/\"$1\"/$tmp/; } print "toOID: $var\n" if $Net_SNMP_util::Debug; push(@retvar, $var); } return @retvar; } # # Check to see if an OID is in the text-to-OID cache. # Returns the OID and the corresponding text as two separate # elements. # sub Check_OID ($) { my($var) = @_; my($tmp, $tmpv, $oid); if ($var =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-]*)*/) { $tmp = $&; $tmpv = $tmp; for (;;) { last if exists($Net_SNMP_util::OIDS{$tmpv}); last if !($tmpv =~ s/^[^\.]*\.//); } $oid = $Net_SNMP_util::OIDS{$tmpv}; if ($oid) { return ($oid, $tmp); } else { my @empty = (); return @empty; } } return ($var, $var); } sub snmpwalk_flg ($$@) { my($host, $hash_sub, @vars) = @_; my($session, %args, @enoid, @poid, $toid, $oid, $got); my($val, $ret, %soid, %nsoid, @retvals, $tmp); my(%rethash, $h_ref, @tmprefs); my($stop); $h_ref = (ref $vars[$#vars] eq "HASH") ? pop(@vars) : \%rethash; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPWALK Problem for $host" unless ($Net_SNMP_util::SuppressWarnings > 1); if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } @enoid = toOID(@vars); if ($#enoid < 0) { if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } # # Create/Refresh a reversed hash with oid -> name # if (defined($hash_sub) and ($RevNeeded)) { %revOIDS = reverse %Net_SNMP_util::OIDS; $RevNeeded = 0; } # # Create temporary array of refs to return values # foreach $oid (0..$#enoid) { my $tmparray = []; $tmprefs[$oid] = $tmparray; $nsoid{$oid} = $oid; } $got = 0; @poid = @enoid; if ($Net_SNMP_util::Version > 1 and $Net_SNMP_util::MaxRepetitions > 0) { $args{'-maxrepetitions'} = $Net_SNMP_util::MaxRepetitions; } if ($Net_SNMP_util::Version > 2) { $args{'-contextengineid'} = $Net_SNMP_util::ContextEngineID if (defined($Net_SNMP_util::ContextEngineID)); $args{'-contextname'} = $Net_SNMP_util::ContextName if (defined($Net_SNMP_util::ContextName)); } while($#poid >= 0) { $args{'-varbindlist'} = \@poid; if (($Net_SNMP_util::Version > 1) and ($Net_SNMP_util::MaxRepetitions > 1)) { $ret = $session->get_bulk_request(%args); } else { $ret = $session->get_next_request(%args); } last if (!defined($ret)); %soid = %nsoid; undef %nsoid; $stop = 0; foreach $oid (&Net::SNMP::oid_lex_sort(keys %$ret)) { $got = 1; $tmp = -1; foreach $toid (@enoid) { $tmp++; if (&Net::SNMP::oid_base_match($toid, $oid) and (!exists($soid{$toid}) or ($oid ne $soid{$toid}))) { $nsoid{$toid} = $oid; if (defined($hash_sub)) { # # extract name of the oid, if possible, the rest becomes the # instance # my $inst = ""; my $upo = $toid; while (!exists($revOIDS{$upo}) and length($upo)) { $upo =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $upo = ""; last; } } if (length($upo) and exists($revOIDS{$upo})) { $upo = $revOIDS{$upo} . $inst; } else { $upo = $toid; } my $qoid = $oid; my $tmpo; $inst = ""; while (!exists($revOIDS{$qoid}) and length($qoid)) { $qoid =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $qoid = ""; last; } } if (length($qoid) and exists($revOIDS{$qoid})) { $tmpo = $qoid; $qoid = $revOIDS{$qoid}; } else { $qoid = $oid; $tmpo = $toid; $inst = substr($oid, length($tmpo)+1); } # # call hash_sub # &$hash_sub($h_ref, $host, $qoid, $tmpo, $inst, $ret->{$oid}, $upo); } else { my $tmpo; my $tmpv = $ret->{$oid}; $tmpo = substr($oid, length($toid)+1); push @{$tmprefs[$tmp]}, "$tmpo:$tmpv"; } } else { $stop = 1 if ($#enoid == 0); } } } undef @poid; @poid = values %nsoid if (!$stop); } if ($got) { if (defined($hash_sub)) { return ($h_ref) if ($Net_SNMP_util::ReturnHashRefs); return (%$h_ref); } elsif ($Net_SNMP_util::Return_array_refs) { return (@tmprefs); } else { do { $got = 0; foreach $toid (0..$#enoid) { next if (scalar(@{$tmprefs[$toid]}) <= 0); $got = 1; $oid = shift(@{$tmprefs[$toid]}); if ($#enoid > 0) { ($oid, $val) = split(':', $oid, 2); $oid = $enoid[$toid] . '.' . $oid; push(@retvals, "$oid:$val"); } else { push(@retvals, $oid); } } } while($got); return (@retvals); } } else { $ret = join(' ', @vars); error_msg("SNMPWALK Problem for $ret on ${host}: " . $session->error()); if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { @retvals = (); return (@retvals); } } } # # When passed a string, return the ASN.1 type that corresponds to the # string. # sub ASNtype($) { my($type) = @_; $type =~ tr/A-Z/a-z/; if ($type eq "int") { $type = 0x02; } elsif ($type eq "integer") { $type = 0x02; } elsif ($type eq "string") { $type = 0x04; } elsif ($type eq "octetstring") { $type = 0x04; } elsif ($type eq "octet string") { $type = 0x04; } elsif ($type eq "oid") { $type = 0x06; } elsif ($type eq "object id") { $type = 0x06; } elsif ($type eq "object identifier") { $type = 0x06; } elsif ($type eq "ipaddr") { $type = 0x40; } elsif ($type eq "ip address") { $type = 0x40; } elsif ($type eq "timeticks") { $type = 0x43; } elsif ($type eq "uint") { $type = 0x47; } elsif ($type eq "uinteger") { $type = 0x47; } elsif ($type eq "uinteger32") { $type = 0x47; } elsif ($type eq "unsigned int") { $type = 0x47; } elsif ($type eq "unsigned integer") { $type = 0x47; } elsif ($type eq "unsigned integer32") { $type = 0x47; } elsif ($type eq "counter") { $type = 0x41; } elsif ($type eq "counter32") { $type = 0x41; } elsif ($type eq "counter64") { $type = 0x46; } elsif ($type eq "gauge") { $type = 0x42; } elsif ($type eq "gauge32") { $type = 0x42; } elsif (($type <= 0) or ($type > 255)) { return undef; } return $type; } # # set the ErrorMessage global and print an error message # sub error_msg($) { my($msg) = @_; $Net_SNMP_util::ErrorMessage = $msg; if ($Net_SNMP_util::SuppressWarnings <= 1) { $Carp::CarpLevel++; carp($msg); $Carp::CarpLevel--; } } # # Fill the OIDS hash with results from the MIB parsing # sub MIB_fill_OID($) { my($href) = @_; my($cnt, $changed, @del, $var, $val, @parts, $indx); my(%seen); $cnt = 0; do { $changed = 0; @del = (); foreach $var (keys %$href) { $val = $href->{$var}; @parts = split('\.', $val); $val = ''; foreach $indx (@parts) { if ($indx =~ /^\d+$/) { $val .= '.' . $indx; } else { if (exists($Net_SNMP_util::OIDS{$indx})) { $val = $Net_SNMP_util::OIDS{$indx}; } else { $val .= '.' . $indx; } } } if ($val =~ /^[\d\.]+$/) { $val =~ s/^\.+//; if (!exists($Net_SNMP_util::OIDS{$var}) || (length($val) > length($Net_SNMP_util::OIDS{$var}))) { $Net_SNMP_util::OIDS{$var} = $val; print "'$var' => '$val'\n" if $Net_SNMP_util::Debug; $changed = 1; $cnt++; } push @del, $var; } } foreach $var (@del) { delete $href->{$var}; } } while($changed); $Carp::CarpLevel++; foreach $var (sort keys %$href) { $val = $href->{$var}; $val =~ s/\..*//; next if (exists($seen{$val})); $seen{$val} = 1; $seen{$var} = 1; error_msg( "snmpMIB_to_OID: prefix \"$val\" unknown, load the parent MIB first.\n" ); } $Carp::CarpLevel--; return $cnt; } # [documentation] ------------------------------------------------------------ =head1 EXPORTS The Net_SNMP_util module uses the F module to export useful constants and subroutines. These exportable symbols are defined below and follow the rules and conventions of the F module (see L). =over =item Exportable &snmpget, &snmpgetnext, &snmpgetbulk, &snmpwalk, &snmpset, &snmptrap, &snmpmaptable, &snmpmaptable4, &snmpwalkhash, &snmpmapOID, &snmpMIB_to_OID, &snmpLoad_OID_Cache, &snmpQueue_MIB_File, ErrorMessage =back =head1 EXAMPLES =head2 1. SNMPv1 get-request for sysUpTime This example gets the sysUpTime from a remote host. #! /usr/local/bin/perl use strict; use Net_SNMP_util; my ($host, $ret) $host = shift || 'localhost'; $ret = snmpget($host, 'sysUpTime'); print("sysUpTime for $host is $ret\n"); exit 0; =head2 2. SNMPv3 set-request of sysContact This example sets the sysContact information on the remote host to "Help Desk x911". The parameters passed to the snmpset function are for the demonstration of syntax only. These parameters will need to be set according to the SNMPv3 parameters of the remote host used by the script. #! /usr/local/bin/perl use strict; use Net_SNMP_util; my($host, %v3hash, $ret); $host = shift || 'localhost'; $v3hash{'-version'} = 'snmpv3'; $v3hash{'-username'} = 'myv3Username'; $v3hash{'-authkey'} = '0x05c7fbde31916f64da4d5b77156bdfa7'; $v3hash{'-authprotocol'} = 'md5'; $v3hash{'-privkey'} = '0x93725fd3a02a48ce02df4e065a1c1746'; $ret = snmpset($host, \%v3hash, 'sysContact', 'string', 'Help Desk x911'); print "sysContact on $host is now $ret\n"; exit 0; =head2 3. SNMPv2c walk for ifTable This example gets the contents of the ifTable by sending get-bulk-requests until the responses are no longer part of the ifTable. The ifTable can also be retrieved using C. #! /usr/local/bin/perl use strict; use Net_SNMP_util; my($host, @ret, $oid, $val); $host = shift || 'localhost'; @ret = snmpwalk($host . ':::::2', 'ifTable'); foreach $val (@ret) { ($oid, $val) = split(':', $val, 2); print "$oid => $val\n"; } exit 0; =head2 4. SNMPv2c maptable collecting ifDescr, ifInOctets, and ifOutOctets. This example collects a table containing the columns ifDescr, ifInOctets, and ifOutOctets. A printing function is called once per row. #! /usr/local/bin/perl use strict; use Net_SNMP_util; sub printfun($$$$) { my($inst, $desc, $in, $out) = @_; printf "%3d %-52.52s %10d %10d\n", $inst, $desc, $in, $out; } my($host, @ret); $host = shift || 'localhost'; printf "%-3s %-52s %10s %10s\n", "Int", "Description", "In", "Out"; @ret = snmpmaptable($host . ':::::2', \&printfun, 'ifDescr', 'ifInOctets', 'ifOutOctets'); exit 0; =head1 REQUIREMENTS =over =item * The Net_SNMP_util module uses syntax that is not supported in versions of Perl earlier than v5.6.0. =item * The Net_SNMP_util module uses the F module, and as such may depend on other modules. Please see the documentaion on F for more information. =back =head1 AUTHOR Mike Mitchell =head1 ACKNOWLEGEMENTS The original concept for this module was based on F written by Simon Leinen =head1 COPYRIGHT Copyright (c) 2007 Mike Mitchell. All rights reserved. This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut # ====================================================================== 1; # [end Net_SNMP_util] PK!EE MRTG_lib.pmnu[# -*- mode: Perl -*- package MRTG_lib; ################################################################### # MRTG 2.17.7 Support library MRTG_lib.pm ################################################################### # Created by Tobias Oetiker # and Dave Rand # # For individual Contributers check the CHANGES file # ################################################################### # # Distributed under the GNU General Public License # ################################################################### require 5.005; use strict; use Fcntl qw(O_WRONLY O_CREAT O_EXCL); use vars qw($OS $SL $PS @EXPORT @ISA $VERSION %timestrpospattern); my %mrtgrules; BEGIN { # Automatic OS detection ... do NOT touch if ( $^O =~ /^(?:(ms)?(dos|win(32|nt)?))/i ) { $OS = 'NT'; $SL = '\\'; $PS = ';'; } elsif ( $^O =~ /^NetWare$/i ) { $OS = 'NW'; $SL = '/'; $PS = ';'; } elsif ( $^O =~ /^VMS$/i ) { $OS = 'VMS'; $SL = '.'; $PS = ':'; } elsif ( $^O =~ /^os2$/i ) { $OS = 'OS2'; $SL = '/'; $PS = ';'; } else { $OS = 'UNIX'; $SL = '/'; $PS = ':'; } } require Exporter; @ISA = qw(Exporter); @EXPORT = qw(readcfg cfgcheck setup_loghandlers datestr expistr ensureSL timestamp create_pid demonize_me debug log2rrd storeincache readfromcache clearfromcache cleanhostkey populateconfcache readconfcache writeconfcache v4onlyifnecessary); $VERSION = 2.100016; %timestrpospattern = ( 'NO' => 0, 'LU' => 1, 'RU' => 2, 'LL' => 3, 'RL' => 4 ); %mrtgrules = ( # General CFG 'workdir' => [sub{$_[0] && (-d $_[0])}, sub{"Working directory $_[0] does not exist"}], 'htmldir' => [sub{$_[0] && (-d $_[0])}, sub{"Html directory $_[0] does not exist"}], 'imagedir' => [sub{$_[0] && (-d $_[0])}, sub{"Image directory $_[0] does not exist"}], 'logdir' => [sub{$_[0] && (-d $_[0] )}, sub{"Log directory $_[0] does not exist"}], 'forks' => [sub{$_[0] && (int($_[0]) > 0 and $MRTG_lib::OS eq 'UNIX')}, sub{"Less than 1 fork or not running on Unix/Linux"}], 'refresh' => [sub{int($_[0]) >= 300}, sub{"$_[0] should be 300 seconds or more"}], 'enablesnmpv3' => [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}], 'enableipv6' => [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}], 'interval' => [sub{$_[0] =~ /(\d+)(?::(\d+))?/ ; my $int = $1*60; $int += $2 if $2; $int >= 1 and $int <= 60*60}, sub{"$_[0] should be at least 1 Second (0:01) and no more than 60 Minutes (60)"}], 'writeexpires' => [sub{1}, sub{"Internal Error"}], 'nomib2' => [sub{1}, sub{"Internal Error"}], 'singlerequest' => [sub{1}, sub{"Internal Error"}], 'icondir' => [sub{$_[0]}, sub{"Directory argument missing"}], 'language' => [sub{1}, sub{"Mrtg not localized for $_[0] - defaulting to english"}], 'loadmibs' => [sub{$_[0]}, sub{"No MIB Files specified"}], 'userrdtool' => [sub{0}, sub{"UseRRDtool is not valid any more. Use LogFormat, PathAdd and LibAdd instead"}], 'userrdtool[]' => [sub{0}, sub{"UseRRDtool[] is not valid any more. Check the new xyz*bla[] syntax for passing parameters to tool xyz who reads the mrtg.cfg"}], 'logformat' => [sub{$_[0] =~ /^(rateup|rrdtool)$/}, sub{"Invalid Logformat '$_[0]'"}], 'pathadd' => [sub{-d $_[0]}, sub{"$_[0] is not the name of a directory"}], 'libadd' => [sub{-d $_[0]}, sub{"$_[0] is not the name of a directory"}], 'runasdaemon' => [sub{1}, sub{"Internal Error"}], 'nodetach' => [sub{1}, sub{"Internal Error"}], 'maxage' => [sub{(($_[0] =~ /^[0-9]+$/) and ($_[0] > 0)) }, sub{"$_[0] must be a Number bigger than 0"}], 'nospacechar' => [sub{length($_[0]) == 1}, sub{"$_[0] must be one character long"}], 'snmpoptions' => [sub{ debug('eval',"snmpotions $_[0]");local $SIG{__DIE__}; eval( '{'.$_[0].'}' ); return not $@}, sub{"Must have the format \"OptA => Number, OptB => 'String', ... \""}], 'conversioncode' => [sub{-r $_[0]}, sub{"Cannot read conversion code file $_[0]"}], # Check for an environment setting for RRDCACHED_ADDRESS # Steve Shipway, Sep 2010 'rrdcached' => # [sub{(($_[0] =~ /^unix:(\S+)/)and(-w $1))}, sub{"Currently, only UNIX domain sockets are supported for RRDCached, and must exist and be writeable."}], [sub{1},sub{"Internal Error"}], # Get graphite server name/ip and port 'sendtographite' => [sub{$_[0] =~ /^.*,\d+$/}, sub{"Invalid Graphite Destination '$_[0]'"}], # Per Router CFG 'target[]' => [sub{1}, sub{"Internal Error"}], #will test this later 'snmpoptions[]' => [sub{ debug('eval',"snmpotions[] $_[0]");local $SIG{__DIE__}; eval('{'.$_[0].'}' ); return not $@}, sub{"Must have the format \"OptA => Number, OptB => 'String', ... \""}], 'routeruptime[]' => [sub{1}, sub{"Internal Error"}], #will test this later 'routername[]' => [sub{1}, sub{"Internal Error"}], #will test this later 'nohc[]' => [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}], 'maxbytes[]' => [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0)) }, sub{"$_[0] must be a Number bigger than 0"}], 'maxbytes1[]' => [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0))}, sub{"$_[0] must be numerical and larger than 0"}], 'maxbytes2[]' => [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0))}, sub{"$_[0] must a number bigger than 0"}], 'ipv4only[]' => [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}], 'absmax[]' => [sub{($_[0] =~ /^[0-9]+$/)}, sub{"$_[0] must be a Number"}], 'title[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'directory[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'clonedirectory[]' => [sub{($_[0] =~ /[^,]\s*$/)}, sub{"$_[0] with comma must have the second parameter"}], 'pagetop[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'bodytag[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'pagefoot[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'addhead[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'rrdrowcount[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'rrdrowcount30m[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'rrdrowcount2h[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'rrdrowcount1d[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'rrdhwrras[]' => [sub{$_[0] =~ /^RRA:(HWPREDICT|SEASONAL|DEVPREDICT|DEVSEASONAL|FAILURES):\S+(\s+RRA:(HWPREDICT|SEASONAL|DEVPREDICT|DEVSEASONAL|FAILURES):\S+)*$/}, sub{"This does not look like rrdtool HW RRAs. Check the rrdcreate manual page for inspiration. ($_[0])"}], 'extension[]' => [sub{1}, sub{"Internal Error"}], #what ever the user chooses. 'unscaled[]' => [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}], 'weekformat[]' => [sub{$_[0] =~ /[UVW]/}, sub{"Must be either W, V, or U"}], 'withpeak[]' => [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}], 'suppress[]' => [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}], 'xsize[]' => [sub{((int($_[0]) >= 30) && (int($_[0]) <= 600))}, sub{"$_[0] must be between 30 and 600 pixels"}], 'ysize[]' => [sub{(int($_[0]) >= 30)}, sub{"Must be >= 30 pixels"}], 'ytics[]' => [sub{(int($_[0]) >= 1) }, sub{"Must be >= 1"}], 'yticsfactor[]' => [sub{$_[0] =~ /[-+0-9.efg]+/}, sub{"Should be a numerical value"}], 'factor[]' => [sub{$_[0] =~ /[-+0-9.efg]+/}, sub{"Should be a numerical value"}], 'step[]' => [sub{(int($_[0]) >= 0)}, sub{"$_[0] must be > 0"}], 'timezone[]' => [sub{1}, sub{"Internal Error"}], 'options[]' => [sub{1}, sub{"Internal Error"}], 'colours[]' => [sub{1}, sub{"Internal Error"}], 'background[]' => [sub{1}, sub{"Internal Error"}], 'kilo[]' => [sub{($_[0] =~ /^[0-9]+$/)}, sub{"$_[0] must be a Integer Number"}], #define whatever k should be (1000, 1024, ???) 'kmg[]' => [sub{1}, sub{"Internal Error"}], 'pngtitle[]' => [sub{1}, sub{"Internal Error"}], 'ylegend[]' => [sub{1}, sub{"Internal Error"}], 'shortlegend[]' => [sub{1}, sub{"Internal Error"}], 'legend1[]' => [sub{1}, sub{"Internal Error"}], 'legend2[]' => [sub{1}, sub{"Internal Error"}], 'legend3[]' => [sub{1}, sub{"Internal Error"}], 'legend4[]' => [sub{1}, sub{"Internal Error"}], 'legend5[]' => [sub{1}, sub{"Internal Error"}], 'legendi[]' => [sub{1}, sub{"Internal Error"}], 'legendo[]' => [sub{1}, sub{"Internal Error"}], 'setenv[]' => [sub{$_[0] =~ /^(?:[-\w]+=\"[^"]*"(?:\s+|$))+$/}, sub{"$_[0] must be XY=\"dddd\" AASD=\"kjlkj\" ... "}], 'xzoom[]' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'yzoom[]' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'xscale[]' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'yscale[]' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'threshdir' => [sub{$_[0] && (-d $_[0])}, sub{"Threshold directory $_[0] does not exist"}], 'threshhyst' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'hwthreshhyst' => [sub{($_[0] =~ /^[0-9]+(?:\.[0-9]+)?$/)}, sub{"$_[0] must be a Number xxx.xxx"}], 'threshmailserver' => [sub{$_[0] && gethostbyname($_[0])}, sub{"Unknown mailserver hostname $_[0]"}], 'threshmailsender' => [sub{$_[0] && ($_[0] =~ /\S+\@\S+/)}, sub{"ThreshMailAddress $_[0] does not look like an email address at all"}], 'threshmini[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'threshmino[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'threshmaxi[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'threshmaxo[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'threshdesc[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'threshprogi[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'threshprogo[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'threshprogoki[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'threshprogoko[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'threshmailaddress[]' => [sub{$_[0] && ($_[0] =~ /\S+\@\S+/)}, sub{"ThreshMailAddress $_[0] does not look like an email address at all"}], 'hwthreshmini[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'hwthreshmino[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'hwthreshmaxi[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'hwthreshmaxo[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'hwthreshdesc[]' => [sub{1}, sub{"Internal Threshold Config Error"}], 'hwthreshprogi[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'hwthreshprogo[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'hwthreshprogoki[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'hwthreshprogoko[]' => [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}], 'hwthreshmailaddress[]' => [sub{$_[0] && ($_[0] =~ /\S+\@\S+/)}, sub{"ThreshMailAddress $_[0] does not look like an email address at all"}], 'timestrpos[]' => [sub{$_[0] =~ /^(no|[lr][ul])$/i}, sub{"Must be a string of NO, LU, RU, LL, RL"}], 'timestrfmt[]' => [sub{1}, sub{"Internal Error"}] #what ever the user chooses. ); # config file reading sub readcfg ($$$$;$$) { my $cfgfile = shift; my $routers = shift; my $cfg = shift; my $rcfg = shift; my $extprefix = shift || ''; my $extrules = shift; my ($first,$second,$key,$userules); my (%seen); my (%pre,%post,%deflt,%defaulted); unless ($cfgfile) { die "ERROR: readfg: no configfile specified\n"; } unless (ref($routers) eq 'ARRAY' and ref($cfg) eq 'HASH' and ref($rcfg) eq 'HASH') { die "ERROR: readcfg called with wrong arguments\n"; } if ($extprefix and ref($extrules) ne 'HASH') { die "ERROR: readcfg called with wrong args for mrtg extension\n"; } my $hand; my $file; my @filestack; local *CFG; if ($cfgfile eq '-'){$cfgfile = '<&STDIN'}; open (CFG, $cfgfile) || die "ERROR: unable to open config file: $cfgfile\n"; $hand = *CFG; my @handstack; my $nextfile = $cfgfile; my %routerhash; while (1) { if (eof $hand || not defined ($_ = <$hand>) ) { close $hand; if (scalar @handstack){ $hand = pop @handstack; $nextfile = pop @filestack; next; } else { last; } } $file=$nextfile; chomp; my $line = $.; if (/^include:\s*(.*?\S)\s*$/i){ my $newhandle; my @nextfiles; $nextfile = $1; if( $nextfile =~ /\*/ ) { @nextfiles = glob( $nextfile ); @nextfiles = glob( ($cfgfile =~ m#(.+)${MRTG_lib::SL}[^${MRTG_lib::SL}]+$#)[0] . ${MRTG_lib::SL} . $nextfile ) if(!@nextfiles); } else { $nextfile = ($cfgfile =~ m#(.+)${MRTG_lib::SL}[^${MRTG_lib::SL}]+$#)[0] . ${MRTG_lib::SL} . $nextfile if(!-r $nextfile); @nextfiles = ( $nextfile ); } foreach $nextfile ( @nextfiles ) { open my $newhandle, '<', $nextfile or die "ERROR: unable to open include file: $nextfile\n"; push @handstack, $hand; push @filestack, $file; $hand = $newhandle; $file = $nextfile; } next; } debug('cfg',"$file\[$.\]: $_"); s/\t/ /g; #replace tab by space s/\r$//; # kill dos newlines ... s/ +$//g; #remove space at the end of the line next if /^ *\#/; #ignore comment lines next if /^ *$/; #ignore empty lines # oops spelling error s/^supress/suppress/gi; # the line we got starts with white space so it is to be appended to what ever # was on the previous line. if (defined $first && /^\s+(.*\S)\s*$/) { if (defined $second) { $second eq '^' && do { $pre{$first} .= "\n".$1; next}; $second eq '$' && do { $post{$first} .= "\n".$1; next}; $second eq '_' && do { $deflt{$first} .= "\n".$1; next}; $$rcfg{$first}{$second} .= " ".$1; } else { $$cfg{$first} .= "\n".$1; } next; } if (defined $first && defined $second && defined $post{$first} && ($second !~ /^[\$^_]$/)) { if (defined $defaulted{$first}{$second}) { $$rcfg{$first}{$second} = $post{$first}; delete $defaulted{$first}{$second}; } else { $$rcfg{$first}{$second} .= ( defined $$cfg{nospacechar} and $post{$first} =~ /(.*)\Q$$cfg{nospacechar}\E$/) ? $1 : " ".$post{$first} ; } } if (defined $first and $first =~ m/^([^*]+)\*(.+)$/) { $userules = ($1 eq $extprefix ? $extrules : ''); } else { $userules = \%mrtgrules; } if ($first && defined $deflt{$first} && ($second eq '_')) { quickcheck($first,$second,$deflt{$first},$file,$line,$userules) } elsif ($first && $second && ($second !~ /^[\$^_]$/)) { quickcheck($first,$second,$$rcfg{$first}{$second},$file,$line,$userules) } elsif ($first && not $second) { quickcheck($first,0,$$cfg{$first},$file, $line,$userules) } if (/^([A-Za-z0-9*]+)\[(\S+)\]\s*:\s*(.*\S?)\s*$/) { $first = lc($1); $second = lc($2); # For us spelling-handicapped Americans. ;) # James Overbeck, grendel@gmo.jp, 2003/01/19 if ($first eq 'colors') { $first = 'colours' }; if ($second eq '^') { if ($3 ne '') { $pre{$first}=$3; } else { delete $pre{$first}; } next; } if ($second eq '$') { if ($3 ne '') { $post{$first}=$3; } else { delete $post{$first}; } next; } if ($second eq '_') { if ($3 ne '') { $deflt{$first}=$3; } else { delete $deflt{$first}; } next; } if (not defined $routerhash{$second}) { push (@{$routers}, $second); $routerhash{$second} = 1; } # make sure that default tags spring into existance upon first # call of a router foreach $key (keys %deflt) { if (! defined $$rcfg{$key}{$second}) { $$rcfg{$key}{$second} = $deflt{$key}; $defaulted{$key}{$second} = 1; } } # make sure that prefix-only tags spring into existance upon first # call of a router foreach $key (keys %pre) { if (! defined $$rcfg{$key}{$second}) { delete $defaulted{$key}{$second} if $defaulted{$key}{$second}; $$rcfg{$key}{$second} = ( defined $$cfg{nospacechar} && $pre{$key} =~ m/(.*)\Q$$cfg{nospacechar}\E$/ ) ? $1 : $pre{$key}." "; } } if ($seen{$first}{$second}) { die ("ERROR: Line $line ($_) in CFG file ($file)\n". "contains a duplicate definition for $first\[$second].\n". "First definition is on line $seen{$first}{$second}\n") } else { $seen{$first}{$second} = $line; } if ($defaulted{$first}{$second}) { $$rcfg{$first}{$second} = ''; delete $defaulted{$first}{$second}; } $$rcfg{$first}{$second} .= $3; next; } if (/^(\S+):\s*(.*\S)\s*$/) { $first = lc($1); $$cfg{$first} = $2; $second = ''; next; } die "ERROR: Line $line ($_) in CFG file ($file) does not make sense\n"; } # append $ stuff to the very last tag in cfg file if necessary if (defined $first && defined $second && defined $post{$first} && ($second !~ /^[\$^_]$/)) { if ($defaulted{$first}{$second}) { $$rcfg{$first}{$second} = $post{$first}; delete $defaulted{$first}{$second}; } else { $$rcfg{$first}{$second} .= ( defined $$cfg{'nospacechar'} && $post{$first} =~ /(.*)\Q$$cfg{nospacechar}\E$/ ) ? $1 : " ".$post{$first} ; } } #check the last input line if ($first =~ m/^([^*]+)\*(.+)$/) { $userules = ($1 eq $extprefix ? $extrules : ''); } else { $userules = \%mrtgrules; } if ($first && defined $deflt{$first} && ($second eq '_')) { quickcheck($first,$second,$deflt{$first},$file,$.,$userules) } elsif ($first && $second && ($second !~ /^[\$^_]$/)) { quickcheck($first,$second,$$rcfg{$first}{$second},$file,$.,$userules) } elsif ($first && not $second) { quickcheck($first,0,$$cfg{$first},$file,$.,$userules) } close (CFG); # Check for an environment setting for RRDCACHED_ADDRESS # Steve Shipway, Sep 2010 if( $ENV{RRDCACHED_ADDRESS} and not exists $cfg->{ rrdcached } ) { warn("WARNING: Using environment variable RRDCACHED_ADDRESS\n"); $cfg->{ rrdcached } = $ENV{RRDCACHED_ADDRESS}; quickcheck('rrdcached',0,$ENV{RRDCACHED_ADDRESS},'Environment variable RRDCACHED_ADDRESS','n/a',\%mrtgrules); } if( exists $cfg->{ rrdcached } ) { warn ("WARNING: You are running with RRDCached enabled (".$cfg->{ rrdcached }."). This will disable all Threshold checking, since RRDCached does not support updatev and an update/fetch will cancel out the caching benefits.\n"); if( $cfg->{ rrdcached } !~ /^unix:/ ) { warn("WARNING: You are running RRDCached in TCP mode. This means that it will use its own Base Directory instead of WorkDir for storing the RRD files. Also, changes to MaxBytes and DS Type will not be actioned after the RRD file has been created.\n"); } } if ($cfg->{enablesnmpv3} and $cfg->{enablesnmpv3} eq 'yes' and eval {local $SIG{__DIE__}; require Net_SNMP_util} ) { import Net_SNMP_util; } else { require SNMP_util; import SNMP_util; } } # quick checks sub quickcheck ($$$$$$) { my ($first,$second,$arg,$file,$line,$rules) = @_; return unless ref($rules) eq 'HASH'; my $braces = $second ? '[]':''; if (exists $rules->{$first.$braces}) { if (&{$rules->{$first.$braces}[0]}($arg)) { return 1; } else { if ($second) { die "ERROR: CFG Error in \"$first\[$second\]\", file $file line $line: ". &{$rules->{$first.$braces}[1]}($arg)."\n\n"; } else { die "ERROR: CFG Error in \"$first\", file $file line $line: ". &{$rules->{$first.$braces}[1]}($arg)."\n\n"; } } } die "ERROR: CFG Error Unknown Option \"$first\" in file $file on line $line or above.\n". " Check /usr/share/doc/mrtg/mrtg-reference.txt.gz for Help\n\n"; } # complex config checks sub mkdirhier ($){ my @dirs = split /\Q${MRTG_lib::SL}\E+/, shift; my $path = ""; while (@dirs){ $path .= shift @dirs; $path .= ${MRTG_lib::SL}; if (! -d $path){ warn ("WARNING: $path did not exist I will create it now\n"); mkdir $path, 0777 or die ("ERROR: mkdir $path: $!\n"); } } } sub cfgcheck ($$$$;$) { my $routers = shift; my $cfg = shift; my $rcfg = shift; my $target = shift; my $opts = shift || {}; my ($rou, $confname, $one_option); # Target index hash. Keys are "int:community@router" target definition # strings and values are indices of the @$target array. Used to avoid # duplicate entries in @$target. my $targIndex = { }; my $error="no"; my(@known_options) = qw(growright bits noinfo absolute gauge nopercent avgpeak derive integer perhour perminute transparent dorelpercent unknaszero withzeroes noborder noarrow noi noo nobanner nolegend logscale secondmean pngdate printrouter expscale); snmpmapOID('hrSystemUptime' => '1.3.6.1.2.1.25.1.1'); if (defined $$cfg{workdir}) { die ("ERROR: WorkDir must not contain spaces when running on Windows. (Yeat another reason to get Linux)\n") if ($OS eq 'NT' or $OS eq 'OS2') and $$cfg{workdir} =~ /\s/; ensureSL(\$$cfg{workdir}); $$cfg{logdir}=$$cfg{htmldir}=$$cfg{imagedir}=$$cfg{workdir}; mkdirhier "$$cfg{workdir}" unless $opts->{check}; } elsif ( not (defined $$cfg{logdir} or defined $$cfg{htmldir} or defined $$cfg{imagedir})) { die ("ERROR: \"WorkDir\" not specified in mrtg config file\n"); $error = "yes"; } else { if (! defined $$cfg{logdir}) { warn ("WARNING: \"LogDir\" not specified\n"); $error = "yes"; } else { ensureSL(\$$cfg{logdir}); mkdirhier $$cfg{logdir} unless $opts->{check}; } if (! defined $$cfg{htmldir}) { warn ("WARNING: \"HtmlDir\" not specified\n"); $error = "yes"; } else { ensureSL(\$$cfg{htmldir}); mkdirhier $$cfg{htmldir} unless $opts->{check}; } if (! defined $$cfg{imagedir}) { warn ("WARNING: \"ImageDir\" not specified\n"); $error = "yes"; } else { ensureSL(\$$cfg{imagedir}); mkdirhier $$cfg{imagedir} unless $opts->{check}; } } if ($cfg->{threshmailserver} and not $cfg->{threshmailsender}){ warn ("WARNING: If \"ThreshMailServer\" is defined, then \"ThreshMailSender\" must be defined too.\n"); $error = "yes"; } if ($cfg->{threshmailsender} and not $cfg->{threshmailserver}){ warn ("WARNING: If \"ThreshMailSender\" is defined, then \"ThreshMailServer\" must be defined too.\n"); $error = "yes"; } # default ThreshHyst to 0.1 if ThreshDir is defined if ($cfg->{threshdir}){ $cfg->{threshhyst} = 0.1 unless $cfg->{threshhyst}; } # build relativ path from htmldir to image dir. my @htmldir = split /\Q${MRTG_lib::SL}\E+/, $$cfg{htmldir}; my @imagedir = split /\Q${MRTG_lib::SL}\E+/, $$cfg{imagedir}; while (scalar @htmldir > 0 and $htmldir[0] eq $imagedir[0]) { shift @htmldir; shift @imagedir; } # this is for the webpages so we use / path separator always $$cfg{imagehtml} = ""; foreach my $dir ( @htmldir ) { $$cfg{imagehtml} .= "../" if $dir; } map {$$cfg{imagehtml} .= "$_/" } @imagedir; # relative path is built debug('dir', "imagehtml = $$cfg{imagehtml}"); $SNMP_util::CacheFile = "$$cfg{'logdir'}oid-mib-cache.txt"; $Net_SNMP_util::CacheFile = "$$cfg{'logdir'}oid-mib-cache.txt"; if (defined $$cfg{loadmibs}) { my($mibFile); foreach $mibFile (split /[,\s]+/, $$cfg{loadmibs}) { snmpQueue_MIB_File($mibFile); } } if(defined $$cfg{pathadd}){ ensureSL(\$$cfg{pathadd}); $ENV{PATH} = "$$cfg{pathadd}${MRTG_lib::PS}$ENV{PATH}"; } if(defined $$cfg{libadd}){ ensureSL(\$$cfg{libadd}); debug('eval',"libadd $$cfg{libadd}\n"); local $SIG{__DIE__}; eval "use lib qw( $$cfg{libadd} )"; my @match; foreach my $dir (@INC){ push @match, $dir if -f "$dir/RRDs.pm"; } warn "WARN: found several copies of RRDs.pm in your path: ". (join ", ", @match)." I will be using $match[0]. This could ". "be a problem if this is an old copy and you think I would be using a newer one!\n" if $#match > 0; } $$cfg{logformat} = 'rateup' unless defined $$cfg{logformat}; if($$cfg{logformat} eq 'rrdtool') { my ($name); if ($MRTG_lib::OS eq 'NT' or $MRTG_lib::OS eq 'OS2'){ $name = "rrdtool.exe"; } elsif ($MRTG_lib::OS eq 'NW'){ $name = "rrdtool.nlm"; } else { $name = "rrdtool"; } foreach my $path (split /\Q${MRTG_lib::PS}\E/, $ENV{PATH}) { ensureSL(\$path); -f "$path$name" && do { $$cfg{'rrdtool'} = "$path$name"; last;} }; die "ERROR: could not find $name. Use PathAdd: in mrtg.cfg to help mrtg find rrdtool\n" unless defined $$cfg{rrdtool}; debug ('rrd',"found rrdtool in $$cfg{rrdtool}"); my $found; foreach my $path (@INC) { ensureSL(\$path); -f "${path}RRDs.pm" && do { $found=1; last;} }; die "ERROR: could not find RRDs.pm. Use LibAdd: in mrtg.cfg to help mrtg find RRDs.pm\n" unless defined $found; } if (defined $$cfg{snmpoptions}) { debug('eval',"redef snmpotions $cfg->{snmpoptions}"); local $SIG{__DIE__}; $cfg->{snmpoptions} = eval('{'.$cfg->{snmpoptions}.'}'); } # default interval is 5 minutes if ($cfg->{interval} and $cfg->{interval} =~ /(\d+)(?::(\d+))?/){ $cfg->{interval} = $1; $cfg->{interval} += $2/60.0 if $2; } else { $cfg->{interval} = 5; } unless ($$cfg{logformat} eq 'rrdtool') { # interval has to be 5 minutes at least without userrdtool if ($$cfg{interval} < 5.0) { die "ERROR: CFG Error in \"Interval\": should be at least 5 Minutes (unless you use rrdtool)"; } } # Check for a Conversion Code file and evaluate its contents, which # should consist of one or more subroutine definitions. The code goes # into the MRTGConversion name space. if( exists $cfg->{ conversioncode } ) { open CONV, $cfg->{ conversioncode } or die "ERROR: Can't open file $cfg->{ conversioncode }\n"; my $code = "local \$SIG{__DIE__};package MRTGConversion;\n". join( '', ) . "1;\n"; close CONV; debug('eval',"covnversioncode $cfg->{ conversioncode }"); die "ERROR: File $cfg->{ conversioncode } conversion code evaluation failed\n$@\n" unless eval $code; } my $thresh_error; # sendtographite directive parsing # sanity check for , or , if ($cfg->{sendtographite}){ my @a = split ",",$cfg->{sendtographite}; # is this an IP address? unless($a[0] =~ /^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/) { # maybe we were passed a DNS name? unless(gethostbyname($a[0])) { die "ERROR: cannot find graphite server name $a[0] in DNS\n"; } } # if we got this far, now check the port number range unless($a[1] > 0 and $a[1] < 65536) { die "ERROR: invalid port number $a[1] in sendtographite directive\n"; } } foreach $rou (@$routers) { # and now for the testing if (defined $rcfg->{threshmailaddress}{$rou}){ if (not defined $cfg->{threshmailserver} and not $thresh_error){ warn (qq{ERROR: ThreshMailAddress[$rou]: specified without "ThreshMailServer:"}); $error = "yes"; $thresh_error = "yes"; } # the dependency between sender and server is taken care of already } if (! defined $rcfg->{snmpoptions}{$rou}) { $rcfg->{snmpoptions}{$rou} = {%{$cfg->{snmpoptions}}} if defined $cfg->{snmpoptions}; } else { debug('eval',"redef snmpoptions[$rou] $rcfg->{snmpoptions}{$rou}"); local $SIG{__DIE__}; $rcfg->{snmpoptions}{$rou} = eval('{'.$rcfg->{snmpoptions}{$rou}.'}'); } $rcfg->{snmpoptions}{$rou}{avoid_negative_request_ids} = 1; # $rcfg->{snmpoptions}{$rou}{domain} = 'udp'; if (! defined $$rcfg{"title"}{$rou}) { warn ("WARNING: \"Title[$rou]\" not specified\n"); $error = "yes"; } if (defined $$rcfg{'directory'}{$rou} and $$rcfg{'directory'}{$rou} ne "") { # They specified a directory for this router. Append the # pathname seperator to it (so that it can either be present or # absent, and the rules for including it are the same). ensureSL(\$$rcfg{'directory'}{$rou}); for my $x (qw(imagedir logdir htmldir)) { mkdirhier $$cfg{$x}.$$rcfg{directory}{$rou} unless $opts->{check}; } $$rcfg{'directory_web'}{$rou} = $$rcfg{'directory'}{$rou}; $$rcfg{'directory_web'}{$rou} =~ s/\Q${MRTG_lib::SL}\E+/\//g; debug('dir', "directory for $rou '$$rcfg{'directory_web'}{$rou}'"); } else { $$rcfg{'directory'}{$rou}=""; $$rcfg{'directory_web'}{$rou}=""; } if (defined $$rcfg{"pagetop"}{$rou}) { $$rcfg{"pagetop"}{$rou} =~ s/\\n/\n/g; } if (defined $$rcfg{"pagefoot"}{$rou}) { # allow for linebreaks $$rcfg{"pagefoot"}{$rou} =~ s/\\n/\n/g; } $$rcfg{"maxbytes1"}{$rou} = $$rcfg{"maxbytes"}{$rou} unless defined $$rcfg{"maxbytes1"}{$rou}; $$rcfg{"maxbytes2"}{$rou} = $$rcfg{"maxbytes"}{$rou} unless defined $$rcfg{"maxbytes2"}{$rou}; if ( not defined $$rcfg{"maxbytes"}{$rou} and not defined $$rcfg{"maxbytes1"}{$rou} and not defined $$rcfg{"maxbytes2"}{$rou}) { warn ("WARNING: \"MaxBytes[$rou]\" not specified\n"); $error = "yes"; } else { if (not defined $$rcfg{"maxbytes1"}{$rou}) { warn ("WARNING: \"MaxBytes1[$rou]\" not specified\n"); $error = "yes"; } if (not defined $$rcfg{"maxbytes2"}{$rou}) { warn ("WARNING: \"MaxBytes2[$rou]\" not specified\n"); $error = "yes"; } } # set default extension if (! defined $$rcfg{"extension"}{$rou}) { $$rcfg{"extension"}{$rou}="html"; } # set default size if (! defined $$rcfg{"xsize"}{$rou}) { $$rcfg{"xsize"}{$rou}=400; } if (! defined $$rcfg{"ysize"}{$rou}) { $$rcfg{"ysize"}{$rou}=100; } if (! defined $$rcfg{"ytics"}{$rou}) { $$rcfg{"ytics"}{$rou}=4; } if (! defined $$rcfg{"yticsfactor"}{$rou}) { $$rcfg{"yticsfactor"}{$rou}=1; } if (! defined $$rcfg{"factor"}{$rou}) { $$rcfg{"factor"}{$rou}=1; } if (defined $$rcfg{"options"}{$rou}) { my $opttemp = lc($$rcfg{"options"}{$rou}); delete $$rcfg{"options"}{$rou}; foreach $one_option (split /[,\s]+/, $opttemp) { if (grep {$one_option eq $_} @known_options) { $$rcfg{'options'}{$one_option}{$rou} = 1; } else { warn ("WARNING: Option[$rou]: \"$one_option\" is unknown\n"); $error="yes"; } } if ($rcfg->{'options'}{derive}{$rou} and not $cfg->{logformat} eq 'rrdtool'){ warn ("WARNING: Option[$rou]: \"derive\" works only with rrdtool logformat\n"); $error="yes"; } } # # Check out routeruptime definition # if (defined $$rcfg{"routeruptime"}{$rou}) { ($$rcfg{"community"}{$rou},$$rcfg{"router"}{$rou}) = split(/@/,$$rcfg{"routeruptime"}{$rou}); } # # Check out target definition # if (defined $$rcfg{"target"}{$rou}) { $$rcfg{targorig}{$rou} = $$rcfg{target}{$rou}; debug ('tarp',"Starting $rou -> $$rcfg{target}{$rou}"); # Decide whether to turn on IPv6 support for this target. # IPv6 support is turned on only if the EnableIPv6 global # setting is yes and the IPv4Only per-target setting is no. # If IPv6 is disabled, we set IPv4Only to true for all # targets, thus disabling all IPv6-related code. my $ipv4only = 1; if ($$cfg{enableipv6} and $$cfg{enableipv6} eq 'yes') { # IPv4Only is off by default $ipv4only = 0 unless (defined $$rcfg{ipv4only}{$rou}) && (lc($$rcfg{ipv4only}{$rou}) eq 'yes'); } # Check if nohc has been set, designating a low-speed interface # without working HC counters. Default is that high-speed # counters exist. my $nohc = 0; $nohc = 1 if (defined $$rcfg{nohc}{$rou}) && (lc($$rcfg{nohc}{$rou}) eq 'yes'); ( $$rcfg{target}{$rou}, $$rcfg{uniqueTarget}{$rou} ) = targparser( $$rcfg{target}{$rou}, $target, $targIndex, $ipv4only, $rcfg->{snmpoptions}{$rou}, $nohc ); } else { warn ("WARNING: I can't find a \"target[$rou]\" definition\n"); $error = "yes"; } # colors format: name#hexcol, if (defined $$rcfg{"colours"}{$rou}) { if ($$rcfg{'options'}{'dorelpercent'}{$rou}) { if ($$rcfg{"colours"}{$rou} =~ /^([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})/ix) { ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou}, $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou}, $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou}, $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}, $$rcfg{'col5'}{$rou}, $$rcfg{'rgb5'}{$rou}) = ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10); } else { warn ("WARNING: \"colours[$rou]\" for colour definition\n". " use the format: Name#hexcolour, Name#Hexcolour,...\n", " note, that dorelpercent requires 5 colours"); $error="yes"; } } else { if ($$rcfg{"colours"}{$rou} =~ /^([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})\s*,\s* ([^\#]+)(\#[0-9a-f]{6})/ix) { ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou}, $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou}, $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou}, $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) = ($1, $2, $3, $4, $5, $6, $7, $8); } else { warn "WARNING: \"colours[$rou]\" for colour definition\n". " use the format: Name#hexcolour, Name#Hexcolour,...\n"; $error="yes"; } } } else { if (defined $$rcfg{'options'}{'dorelpercent'}{$rou}) { ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou}, $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou}, $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou}, $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}, $$rcfg{'col5'}{$rou}, $$rcfg{'rgb5'}{$rou}) = ("GREEN","#00cc00", "BLUE","#0000ff", "DARK GREEN","#006600", "MAGENTA","#ff00ff", "AMBER","#ef9f4f"); } else { ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou}, $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou}, $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou}, $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) = ("GREEN","#00cc00", "BLUE","#0000ff", "DARK GREEN","#006600", "MAGENTA","#ff00ff"); } } # Background color, format: #rrggbb if (! defined $$rcfg{'background'}{$rou}) { $$rcfg{'background'}{$rou} = "#ffffff"; } if ($$rcfg{'background'}{$rou} =~ /^(\#[0-9a-f]{6})/i) { $$rcfg{'backgc'}{$rou} = "$1"; } else { warn "WARNING: \"background[$rou]: ". "$$rcfg{'background'}{$rou}\" for colour definition\n". " use the format: #rrggbb\n"; $error="yes"; } if (! defined $$rcfg{'kilo'}{$rou}) { $$rcfg{'kilo'}{$rou} = 1000; } if (defined $$rcfg{'kmg'}{$rou}) { $$rcfg{'kmg'}{$rou} =~ s/\s+//g; } if (! defined $$rcfg{'xzoom'}{$rou}) { $$rcfg{'xzoom'}{$rou} = 1.0; } if (! defined $$rcfg{'yzoom'}{$rou}) { $$rcfg{'yzoom'}{$rou} = 1.0; } if (! defined $$rcfg{'xscale'}{$rou}) { $$rcfg{'xscale'}{$rou} = 1.0; } if (! defined $$rcfg{'yscale'}{$rou}) { $$rcfg{'yscale'}{$rou} = 1.0; } if (defined $$rcfg{'options'}{'pngdate'}{$rou}) { $$rcfg{'timestrpos'}{$rou} = 'RU'; $$rcfg{'timestrfmt'}{$rou} = $$rcfg{'timezone'}{$rou} ? "%Y-%m-%d %H:%M %Z" : "%Y-%m-%d %H:%M"; delete $$rcfg{'options'}{'pntdate'}{$rou} } if (! defined $$rcfg{'timestrpos'}{$rou}) { $$rcfg{'timestrpos'}{$rou} = 'NO'; } if (! defined $$rcfg{'timestrfmt'}{$rou}) { $$rcfg{'timestrfmt'}{$rou} = "%Y-%m-%d %H:%M"; } if ($error eq "yes") { die "ERROR: Please fix the error(s) in your config file\n"; } } } # make sure string ends with a slash. sub ensureSL($) { # return; my $ref = shift; return if not $$ref; debug('dir',"ensure path IN: '$$ref'"); if (${MRTG_lib::SL} eq '\\'){ # two slashes at the start of the string are OK $$ref =~ s/(.)\Q${MRTG_lib::SL}\E+/$1${MRTG_lib::SL}/g; } else { $$ref =~ s/\Q${MRTG_lib::SL}\E+/${MRTG_lib::SL}/g; } $$ref =~ s/\Q${MRTG_lib::SL}\E*$/${MRTG_lib::SL}/; debug('dir',"ensure path OUT: '$$ref'"); } # convert current supplied time into a nice date string sub datestr ($) { my ($time) = shift || return 0; my ($wday) = ('Sunday','Monday','Tuesday','Wednesday', 'Thursday','Friday','Saturday')[(localtime($time))[6]]; my ($month) = ('January','February' ,'March' ,'April' , 'May' , 'June' , 'July' , 'August' , 'September' , 'October' , 'November' , 'December' )[(localtime($time))[4]]; my ($mday,$year,$hour,$min) = (localtime($time))[3,5,2,1]; if ($min<10) { $min = "0$min"; } return "$wday, $mday $month ".($year+1900)." at $hour:$min"; } # create expire date for expiery in ARG Minutes sub expistr ($) { my ($time) = time+int($_[0]*60)+5; my ($wday) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[(gmtime($time))[6]]; my ($month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', 'Oct','Nov','Dec')[(gmtime($time))[4]]; my ($mday,$year,$hour,$min,$sec) = (gmtime($time))[3,5,2,1,0]; if ($mday<10) { $mday = "0$mday"; } ; if ($hour<10) { $hour = "0$hour"; } ; if ($min<10) { $min = "0$min"; } if ($sec<10) { $sec = "0$sec"; } return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT"; } sub create_pid ($;$$) { my ($pidfile, $uid, $gid) = @_; return if ($OS eq 'NT' ); # Security: refuse to operate on a symlink. When mrtg is started as root # in daemon mode with a writable pid path, an attacker who pre-places a # symlink here could otherwise make us create or chown an arbitrary file # (CWE-59). A plain stat/-e on the path would follow the link, so check # the link itself first. if (-l $pidfile) { warn "refusing to use pid file $pidfile: it is a symbolic link\n"; return; } return if -e $pidfile; # O_CREAT|O_EXCL creates the file atomically and fails if anything # (including a symlink that was raced in after the check above) already # exists at the path, closing the symlink-follow / TOCTOU window. if ( sysopen(my $fh, $pidfile, O_WRONLY|O_CREAT|O_EXCL, 0644) ) { # chown the open handle (fchown) rather than the path, so the # ownership change cannot be redirected through a swapped-in symlink. chown $uid, $gid, $fh if defined $uid and defined $gid; close $fh; } else { warn "cannot create pid file $pidfile: $!\n"; } } sub demonize_me ($) { my $pidfile = shift; my $cfgfile = shift; print "Daemonizing MRTG ...\n"; if ( $OS eq 'NT' ) { print "Do Not close this window. Or MRTG will die\n"; # require Win32::Console; # my $CONSOLE = new Win32::Console; # detach process from Console # $CONSOLE->Flush(); # $CONSOLE->Free(); # $CONSOLE->Alloc(); # $CONSOLE->Mode() } elsif( $OS eq 'OS2') { require OS2::Process; if (my_type() eq 'VIO'){ $main::Cleanfile3 = $pidfile; print "MRTG detached. PID=".system(P_DETACH(),$^X." ".$0." ".$cfgfile); exit; } } else { # Check out if there is another mrtg running before forking if (defined $pidfile && open(READPID, "<$pidfile")){ if (not eof READPID) { chomp(my $input = ); # read process id in pidfile my ($pid) = $input =~ /^(\d+)$/; # to improve taint-safe code if ($pid && kill 0 => $pid) {# oops - the pid actually exists die "ERROR: I Quit! Another copy of mrtg seems to be running. Check $pidfile\n"; } } close READPID; } defined (my $pid = fork) or die "Can't fork: $!"; if ($pid) { exit; } else { if (defined $pidfile){ $main::Cleanfile3 = $pidfile; if (-l $pidfile) { warn "refusing to write pid file $pidfile: it is a symbolic link\n"; } elsif (open(PIDFILE,">$pidfile")) { print PIDFILE "$$\n"; close PIDFILE; } else { warn "cannot write to $pidfile: $!\n"; } } require 'POSIX.pm'; POSIX::setsid() or die "Can't start a new session: $!"; open STDOUT,'>/dev/null' or die "ERROR: Redirecting STDOUT to /dev/null: $!"; open STDERR,'>/dev/null' or die "ERROR: Redirecting STDERR to /dev/null: $!"; open STDIN, '{ Methode } = 'SNMP'; $targ->{ Community } = $if->{ComStr}; $targ->{ Host } = ( defined $if->{HostIPv6} ) ? $if->{HostIPv6} : $if->{HostName}; $targ->{ SnmpOpt } = $if->{SnmpInfo}; $targ->{ snmpoptions} = $if->{snmpoptions}; $targ->{ Conversion } = ( defined $if->{ConvSub} ) ? $if->{ConvSub} : ''; for my $i( 0..1 ) { die 'ERROR: Malformed ', $i ? 'output ' : 'input ', "ifSpec in '$t'\n" if not defined $if->{OID}[$i] and not defined $if->{Alt}[$i]; $targ->{OID}[$i] = $if->{OID}[$i]; if( defined $if->{Alt}[$i] ) { if( defined $if->{Num}[$i] ) { $targ->{IfSel}[$i] = 'If'; $targ->{Key}[$i] = $if->{Num}[$i]; } elsif( defined $if->{IP}[$i] ) { $targ->{IfSel}[$i] = 'Ip'; $targ->{Key}[$i] = $if->{IP}[$i]; } elsif( defined $if->{Desc}[$i] ) { $targ->{IfSel}[$i] = 'Descr'; $targ->{Key}[$i] = $if->{Desc}[$i]; } elsif( defined $if->{Name}[$i] ) { $targ->{IfSel}[$i] = 'Name'; $targ->{Key}[$i] = $if->{Name}[$i]; } elsif( defined $if->{Eth}[$i] ) { $targ->{IfSel}[$i] = 'Eth'; $targ->{Key}[$i] = join( '-', map( { sprintf '%02x', hex $_ } split( /-/, $if->{Eth}[$i] ) ) ); } elsif( defined $if->{Type}[$i] ) { $targ->{IfSel}[$i] = 'Type'; $targ->{Key}[$i] = $if->{Type}[$i]; } else { die "ERROR: Internal error parsing ifSpec in '$t'\n"; } } else { $targ->{IfSel}[$i] = 'None'; $targ->{Key}[$i] = ''; } # Remove escaped characters and trailing space from Descr or Name Key $targ->{Key}[$i] =~ s/\\([\s:&@])/$1/g if $targ->{IfSel}[$i] eq 'Descr' or $targ->{IfSel}[$i] eq 'Name'; $targ->{Key}[$i] =~ s/[\0- ]+$//; } # Remove escaped characters from community $targ->{ Community } =~ s/\\([ @])/$1/g; return $targ; # Return new target closure } # ( $string, $unique ) = targparser( $string, $target, $targIndex, $ipv4only ) # Walk amd analyze the target string $string. $target is a reference to the # array of targets being built. $targIndex is a reference to a hash of targets # previously encountered indexed by target string. When $ipv4only is nonzero, # only IPv4 is in use. Returns the modifed target string and the index of the # @$target array to which the target refers if that index is unique. If the # index is not unique, i.e. the target definition is a calculation involving # two or more different targets, then the value -1 is returned for $unique. # Targparser updates the target array avoiding duplicate targets. The goal is # to substitute all target definitions with strings of the form # "$t1$thisTarg$t2", where $thisTarg is the target index, and $t1 and $t2 are # as defined below. The intended result is a target string that can be eval'ed # in its entirety later on when monitoring data has been collected. This # evaluation occurs in sub getcurrent in the main mrtg script. # Note: In the regular expressions in &targparser, we have avoided m/.../i # and the variables &`, $&, and $'. Use of these makes regex processing less # efficient. See Friedl, J.E.F. Mastering Regular Expressions. O'Reilly. # p. 273 sub targparser( $$$$$$ ) { # Target string (int:community@router, etc.) my $string = shift; # Reference to target array my $target = shift; # Reference to target index hash my $targIndex = shift; # Nonzero if only IPv4 is in use my $ipv4only = shift; # options passed per target. my $snmpoptions = shift; # Highspeed Counter test my $nohc = shift; # Next available index in the @$target array my $idx = @$target; # Common match strings: pre-target, target, post-target my( $pre, $t, $post ); # Portion of string already parsed my $parsed = ''; # Initialize $unique to undefined. It will take on the $targIndex value # of the first target encountered. $otherTargCount will count the # number of other targets (targets with different values of $targIndex) # encountered during the parse. $unique will be returned as undef # unless $otherTargCount remains 0. my $unique = -1; my $otherTargCount = 0; # Components of the target expression that are substituted into the # target string each time a target is identified. The substitution # string is the interpolated value of "$t1$targIndex$t2". At present # $t1 and $t2 are set to create a new BigFloat object. # my $t1 = ' Math::BigFloat->new($target->['; # my $t2 = ']{$mode}) '; # this gives problems with perl 5.005 so bigfloat is introduces in mrtg itself my $t1 = ' $target->['; my $t2 = ']{$mode} '; # Find and substitute all external program targets while( ( $pre, $t, $post ) = $string =~ m< ^(.*?) # capture pre-target string ` # beginning of program target ((?:\\`|[^`])+) # capture target contents (\` allowed) ` # end of program target (.*)$ # capture post-target string >x ) { # Total of 3 captures my $thisTarg; if( exists $targIndex->{ $t } ) { # This program target has been encountered previously $thisTarg = $targIndex->{ $t }; debug( 'tarp', "Existing program target [$thisTarg]" ); } else { # A new program target is needed my $targ = { }; $targ->{ Methode } = 'EXEC'; $targ->{ Command } = $t; # Remove escaped backticks $targ->{ Command } =~ s/\\\`/\`/g; $target->[ $idx ] = $targ; $thisTarg = $idx++; $targIndex->{ $t } = $thisTarg; debug( 'tarp', "New program target [$thisTarg] '$t'" ); } $parsed .= "$pre$t1$thisTarg$t2"; $string = $post; if( $unique < 0 ) { $unique = $thisTarg; } else { $otherTargCount++ unless $thisTarg == $unique; } }; # Reset $string for new target type search $string = $parsed . $string; $parsed = ''; debug( 'tarp', "&targparser external done: '$string'" ); # Common interface specification regex components # Simple interface specification regex component. Matches interface # specification by IPv4 address, description, name, Ethernet address, or # type. my $ifSimple = ' (\d+)|' . # by number ($if->{Num}) ' / (\d+(?:\.\d+)+)|' . # by IPv4 address ($if->{IP}) ' \\\\ ((?:\\\\[\s:&@]|[^\s:&@])+)|' . # by description (allow \ \: \& \@) ($if->{Desc}) ' \# ((?:\\\\[\s:&@]|[^\s:&@])+)|' . # by name (allow \ \: \& \@) ($if->{Name}) ' ! ([a-fA-F0-9]+(?:-[a-fA-F0-9]+)+)|' . # by Ethernet address ($if->{Eth}) ' % (\d+)'; # by type ($if->{Type}) # Complex interface specification regex component. Note that a null string # will match. Therefore the match must be postprocessed to check that # $ifOID and $ifAlt are not both null. my $ifComplex = '((?:\.\d+)*?\.?[-a-zA-Z0-9]*(?:\.\d+)*?)' . # OID possibly starting with a MIB name ($if->{OID}) '(' . # Interface specification alternatives: ($if->{Alt}) '\.' . # separator $ifSimple . # simple alternatives (6 variables) ')?'; # maybe none of the above # Community-host interface specification regex component. my $ifComHost = '((?:\\\\[@ ]|[^\s@])+)' . # community string ('\@' and '\ ' allowed) ($if->{ComStr}) '@' . # separator '(?:(\[[a-fA-F0-9:]*\])|' . # hostname as IPv6 address ($if->{HostIPv6}) '([-\w]+(?:\.[-\w]+)*))' . # or DNS name ($if->{HostName}) '((?::[\d.!]*)*)' . # SNMP session configuration ($if->{SnmpInfo}) '(?:\|([a-zA-Z_][\w]*))?'; # numeric conversion subroutine ($if->{ConvSub}) # Match strings for simple and complex interface specifications. Entries # are of the form $if->{k1}[i], where k1 is OID, Alt, Num, IP, Desc, # Name, Eth, or Type, and i is 0 or 1 (input or output). Entries may also # have the form $if->{k1}, where k1 is Rev, ComStr, HostIPv6, HostName, # SnmpInfo, or ConvSub, with no [i] in these cases. my $if; # Find and substitute all complex OID targets while( ( $pre, $t, $if->{OID}[0], $if->{Alt}[0], $if->{Num}[0], $if->{IP}[0], $if->{Desc}[0], $if->{Name}[0], $if->{Eth}[0], $if->{Type}[0], $if->{OID}[1], $if->{Alt}[1], $if->{Num}[1], $if->{IP}[1], $if->{Desc}[1], $if->{Name}[1], $if->{Eth}[1], $if->{Type}[1], $if->{ComStr}, $if->{HostIPv6}, $if->{HostName}, $if->{SnmpInfo}, $if->{ConvSub}, $post ) = $string =~ m< ^(.*?) # capture pre-target string ( # capture entire target ${ifComplex} # input interface specification (8 captures) & # separator ${ifComplex} # output interface specification (8 captures) : # separator ${ifComHost} # community-host specification (5 captures) ) # end of entire target capture (.*)$ # capture post-target string >x ) { # Total of 24 captures my $thisTarg; # Exception: skip and try to parse later as a simple target if # $if->{Desc}[0], $if->{Name}[0], $if->{Desc}[1], or $if->{Name}[1] # ends with a backslash character if( ( defined $if->{Desc}[0] and $if->{Desc}[0] =~ m<\\$> ) or ( defined $if->{Name}[0] and $if->{Name}[0] =~ m<\\$> ) or ( defined $if->{Desc}[1] and $if->{Desc}[1] =~ m<\\$> ) or ( defined $if->{Name}[1] and $if->{Name}[1] =~ m<\\$> ) ) { $parsed .= "$pre$t"; $string = $post; next; } if( exists $targIndex->{ $t } ) { # This complex target has been encountered previously $thisTarg = $targIndex->{ $t }; debug( 'tarp', "Existing complex target [$thisTarg]" ); } else { # A new complex target is needed my $targ = newSnmpTarg( $t, $if ); $targ->{ ipv4only } = $ipv4only; $targ->{ snmpoptions } = $snmpoptions; $target->[ $idx ] = $targ; $thisTarg = $idx++; $targIndex->{ $t } = $thisTarg; debug( 'tarp', "New complex target [$thisTarg] '$t':\n" . " Comu: $targ->{Community}, Host: $targ->{Host}\n" . " Opt: $targ->{SnmpOpt}, IPv4: $targ->{ipv4only}\n" . " Conv: $targ->{Conversion}\n" . " OID: $targ->{OID}[0], $targ->{OID}[1]\n" . " IfSel: $targ->{IfSel}[0], $targ->{IfSel}[1]\n" . " Key: $targ->{Key}[0], $targ->{Key}[1]" ); } $parsed .= "$pre$t1$thisTarg$t2"; $string = $post; if( $unique < 0 ) { $unique = $thisTarg; } else { $otherTargCount++ unless $thisTarg == $unique; } } # Reset $string and $parsedfor new target type search $string = $parsed . $string; $parsed = ''; debug( 'tarp', "&targparser complex done: '$string'" ); # Find and substitute all simple targets while( ( $pre, $t, $if->{Rev}, $if->{Num}[0], $if->{IP}[0], $if->{Desc}[0], $if->{Name}[0], $if->{Eth}[0], $if->{Type}[0], $if->{ComStr}, $if->{HostIPv6}, $if->{HostName}, $if->{SnmpInfo}, $if->{ConvSub}, $post ) = $string =~ m< ^(.*?) # capture pre-target string ( # capture entire target (-)? # capture direction reversal (?: ${ifSimple} ) # simple interface specification (6 captures) : # separator ${ifComHost} # community-host specification (5 captures) ) # end of entire target capture (.*)$ # capture post-target string >x ) { # Total of 15 captures my $thisTarg; if( exists $targIndex->{ $t } ) { # This simple target has been encountered previously $thisTarg = $targIndex->{ $t }; debug( 'tarp', "Existing simple target [$thisTarg]" ); } else { # A new simple target is needed # Reverse interface directions if indicated by $if->{Rev}. # The sense of $d1 and $d2 is 0 for input and 1 for output my $d1 = ( defined $if->{Rev} and $if->{Rev} eq '-' ) ? 1 : 0; my $d2 = 1 - $d1; # Set the OIDs depending on whether SNMPv2 has been specified # and on the direction if( $if->{SnmpInfo} =~ m/(?::[^:]*){4}:[32][Cc]?/ and $nohc == 0 ) { $if->{OID}[$d1] = 'ifHCInOctets'; $if->{OID}[$d2] = 'ifHCOutOctets'; } else { $if->{OID}[$d1] = 'ifInOctets'; $if->{OID}[$d2] = 'ifOutOctets'; } # Give $if->{Alt}[i] an arbitrary defined value so that # &newSnmpTarg works correctly $if->{Alt}[0] = 1; $if->{Alt}[1] = 1; # Copy input specification to output $if->{Num}[1] = $if->{Num}[0]; $if->{IP}[1] = $if->{IP}[0]; $if->{Desc}[1] = $if->{Desc}[0]; $if->{Name}[1] = $if->{Name}[0]; $if->{Eth}[1] = $if->{Eth}[0]; $if->{Type}[1] = $if->{Type}[0]; my $targ = newSnmpTarg( $t, $if ); $targ->{ snmpoptions} = $snmpoptions; $targ->{ ipv4only } = $ipv4only; $target->[ $idx ] = $targ; $thisTarg = $idx++; $targIndex->{ $t } = $thisTarg; debug( 'tarp', "New simple target [$thisTarg] '$t':\n" . " Comu: $targ->{Community}, Host: $targ->{Host}\n" . " Opt: $targ->{SnmpOpt}, IPv4: $targ->{ipv4only}\n" . " Conv: $targ->{Conversion}\n" . " OID: $targ->{OID}[0], $targ->{OID}[1]\n" . " IfSel: $targ->{IfSel}[0], $targ->{IfSel}[1]\n" . " Key: $targ->{Key}[0], $targ->{Key}[1]" ); } $parsed .= "$pre$t1$thisTarg$t2"; $string = $post; if( $unique < 0 ) { $unique = $thisTarg; } else { $otherTargCount++ unless $thisTarg == $unique; } } # Assemble string to be returned $string = $parsed . $string; # Set $unique undefined if more than one target is referred to in the # target string $unique = -1 if $otherTargCount; debug( 'tarp', "&targparser simple done: '$string'" ); debug( 'tarp', "&targparser returning: unique = $unique" ); return ( $string, $unique ); } # Display of &targparser intermediate values for debugging purposes. Call as # showMatch( $string, $pre, $t, $post, $if ) from within &targparser. sub showMatch( $$$$$ ) { my( $string, $pre, $t, $post, $if ) = @_; warn "# Matching on string '$string'\n"; warn "# Prematch: '$pre'\n"; warn "# Target: '$t'\n"; warn "# Postmatch: '$post'\n"; warn "# Captured:\n"; foreach my $k( keys %$if ) { if( ref( $if->{$k} ) eq 'ARRAY' ) { warn "# \$if->{$k}[0,1]: '", ( defined $if->{$k}[0] ) ? $if->{$k}[0] : 'undef', "', '", ( defined $if->{$k}[1] ) ? $if->{$k}[1] : 'undef', "'\n"; } else { warn "# \$if->{$k}: '", ( defined $if->{$k} ) ? $if->{$k} : 'undef', "'\n"; } } } sub readconfcache ($) { my $cfgfile = shift; my %confcache; if (open (CFGOK,"<$cfgfile")) { while () { chomp; next unless /\t/; #ignore odd lines next if /^\S+:/; #ignore legacy lines my ($host,$method,$key,$if) = split (/\t/, $_); $key =~ s/[\0- ]+$//; # no trailing whitespace in keys realy ! $key =~ s/[\0- ]/ /g; # all else becomes a normal space ... get a life $confcache{$host}{$method}{$key} = $if; } close CFGOK; } return \%confcache; } sub writeconfcache ($$) { my $confcache = shift; my $cfgfile = shift; if ($cfgfile ne '&STDOUT'){ open (CFGOK,">$cfgfile") or die "ERROR: writing $cfgfile.ok: $!"; } my @hosts; if (defined $$confcache{___updated}) { @hosts = @{$$confcache{___updated}} ; delete $$confcache{___updated}; } else { @hosts = grep !/^___/, keys %{$confcache} } foreach my $host (sort @hosts) { foreach my $method (sort keys %{$$confcache{$host}}) { foreach my $key (sort keys %{$$confcache{$host}{$method}}) { if ($cfgfile ne '&STDOUT'){ print CFGOK "$host\t$method\t$key\t". $$confcache{$host}{$method}{$key},"\n"; } else { print "$host\t$method\t$key\t". $$confcache{$host}{$method}{$key},"\n"; } } } } close CFGOK; } sub cleanhostkey ($){ my $host = shift; return undef unless defined $host; $host =~ s/(:\d*)(?:(:\d*)(?:(:\d*)(?:(:\d*)(?:(:\d*)))))$/$1$5/ or $host =~ s/(:\d*)(?:(:\d*)(?:(:\d*)(?:(:\d*)?)?)?)$/$1/; $host =~ s/:/_/g; # make sure that double invocations do not kill us return $host; } sub storeincache ($$$$$){ my($confcache,$host,$method,$key,$value) = @_; $host = cleanhostkey $host; if (not defined $value ){ $$confcache{$host}{$method}{$key} = undef; return; } $value =~ s/[\0- ]/ /g; # all else becomes a normal space ... get a life $value =~ s/ +$//; # no trailing spaces if (defined $$confcache{$host}{$method}{$key} and $$confcache{$host}{$method}{$key} ne $value) { $$confcache{$host}{$method}{$key} = "Dup"; debug('coca',"store in confcache $host $method $key --> $value (duplicate)"); } else { $$confcache{$host}{$method}{$key} = $value; debug('coca',"store in confcache $host $method $key --> $value"); } } sub readfromcache ($$$$){ my($confcache,$host,$method,$key) = @_; $host = cleanhostkey $host; return $$confcache{$host}{$method}{$key}; } sub clearfromcache ($$){ my($confcache,$host) = @_; $host = cleanhostkey $host; delete $$confcache{$host}; debug('coca',"clear confcache $host"); } sub populateconfcache ($$$$$) { my $confcache = shift; my $host = shift; my $ipv4only = shift; my $reread = shift; my $snmpoptions = shift || {}; my $hostkey = cleanhostkey $host; return if defined $$confcache{$hostkey} and not $reread; my $snmp_errlevel = $SNMP_Session::suppress_warnings; my $net_snmp_errlevel = $Net_SNMP_util::suppress_warnings; $SNMP_Session::suppress_warnings = 3; $Net_SNMP_util::suppress_warnings = 3; debug('coca',"populate confcache $host"); # clear confcache for host; delete $$confcache{$hostkey}; my @ret; my %tables = ( ifDescr => 'Descr', ifName => 'Name', ifType => 'Type', ipAdEntIfIndex => 'Ip' ); my @nodes = qw (ifName ifDescr ifType ipAdEntIfIndex); # it seems that some devices only give back sensible data if their tables # are walked in the right ordere .... foreach my $node (@nodes) { next if $confcache->{___deadhosts}{$hostkey} and time - $confcache->{___deadhosts}{$hostkey} < 300; $SNMP_Session::errmsg = undef; $Net_SNMP_util::ErrorMessage = undef; @ret = &main::snmpwalk(v4onlyifnecessary($host, $ipv4only), $snmpoptions, $node); unless ( $SNMP_Session::errmsg or $Net_SNMP_util::ErrorMessage){ foreach my $ret (@ret) { my ($oid, $desc) = split(':', $ret, 2); if ($tables{$node} eq 'Ip') { storeincache($confcache,$host,$tables{$node},$oid,$desc); } else { $desc =~ s/[\0- ]+$//; #trailing whitespace is too sick for us $desc =~ s/[\0- ]/ /g; #whitespace is just whitespace storeincache($confcache,$host,$tables{$node},$desc,$oid); } }; } else { $confcache->{___deadhosts}{$hostkey} = time if defined($SNMP_Session::errmsg) and $SNMP_Session::errmsg =~ /no response received/; $confcache->{___deadhosts}{$hostkey} = time if defined($Net_SNMP_util::ErrorMessage) and $Net_SNMP_util::ErrorMessage =~ /No response from remote/; debug('coca',"Skipping $node scanning because $host does not seem to support it"); } } if ($confcache->{___deadhosts}{$hostkey} and time - $confcache->{___deadhosts}{$hostkey} < 300){ $SNMP_Session::suppress_warnings = $snmp_errlevel; $Net_SNMP_util::suppress_warnings = $snmp_errlevel; return; } $SNMP_Session::errmsg = undef; $Net_SNMP_util::ErrorMessage = undef; @ret = &main::snmpwalk(v4onlyifnecessary($host, $ipv4only), $snmpoptions, "ifPhysAddress"); unless ( $SNMP_Session::errmsg or $Net_SNMP_util::ErrorMessage){ foreach my $ret (@ret) { my ($oid, $bin) = split(':', $ret, 2); my $eth = unpack 'H*', $bin; my @eth; while ($eth =~ s/^..//){ push @eth, $&; } my $phys=join '-', @eth; storeincache($confcache,$host,"Eth",$phys,$oid); } } else { debug('coca',"Skipping ifPhysAddress scanning because $host does not seem to support it"); } if (ref $$confcache{___updated} ne 'ARRAY') { $$confcache{___updated} = []; #init to empty array } push @{$$confcache{___updated}}, $hostkey; $SNMP_Session::suppress_warnings = $snmp_errlevel; $Net_SNMP_util::supress_warnings = $net_snmp_errlevel; } sub log2rrd ($$$) { my $router = shift; my $cfg = shift; my $rcfg = shift; my %mark; my %incomp; my %elapsed_time; my %rate; my %store; my %first_step; my %cur; my %next; my $rrd; my @steps = qw(300 1800 7200 86400); my %sizes = ( 300 => 600, 1800 => 700, 7200 => 775, 86400 => 797); open R, "<$$cfg{logdir}$$rcfg{'directory'}{$router}$router.log" or die "ERROR: opening $$cfg{logdir}$$rcfg{'directory'}{$router}$router.log: $!"; debug('rrd',"converting $$cfg{logdir}$$rcfg{'directory'}{$router}$router.log"); my $latest_timestamp; my %latest_counter; chomp($_ = ); my $time; my $next_time; ($latest_timestamp,$latest_counter{in},$latest_counter{out}) = split /\s+/; chomp($_ = ); ($time,$cur{in},$cur{out},$cur{maxin},$cur{maxout}) = split /\s+/; foreach my $s (@steps) { $mark{$s} = $latest_timestamp - ($latest_timestamp % $s) + $s; $first_step{$s} = $latest_timestamp - ($mark{$s} - $s); $elapsed_time{$s} = $s - $first_step{$s}; $rate{in}{$s}=$cur{in}; $rate{out}{$s}=$cur{out}; $rate{maxin}{$s}=$cur{maxin}; $rate{maxout}{$s}=$cur{maxout}; } while(){ chomp; ($next_time,$next{in},$next{out},$next{maxin},$next{maxout}) = split /\s+/; foreach my $s (@steps) { # bail if we have enough entries next if ref $store{in}{$s} and scalar @{$store{in}{$s}} > $sizes{$s}; # ok we are still here. If next mark is before the next time # we take a short step, else we gobble up my $next_stop; do { if ($elapsed_time{$s} + $time - $next_time > $s) { $next_stop = $mark{$s}-$s; } else { $next_stop = $next_time; } my $time_diff = $time-$next_stop; foreach my $d (qw(in out)) { $rate{$d}{$s} = ($rate{$d}{$s} * $elapsed_time{$s} + $cur{$d} * $time_diff) / ($elapsed_time{$s} + $time_diff); } foreach my $d (qw(maxin maxout)){ $rate{$d}{$s} = $cur{$d} if $rate{$d}{$s} < $cur{$d}; } $elapsed_time{$s} += $time_diff; # print "$time $next_stop\n" if $s == 300; if ($next_stop == $mark{$s}-$s) { foreach my $t (qw(in out maxin maxout)){ $rate{$t}{$s}/=3600 if (defined $$rcfg{'options'}{'perhour'}{$router}); $rate{$t}{$s}/=60 if (defined $$rcfg{'options'}{'perminute'}{$router}); push @{$store{$t}{$s}}, $rate{$t}{$s}; } $mark{$s} -= $s; $rate{maxin}{$s} = 0; $rate{maxout}{$s} = 0; $elapsed_time{$s} = 0; } } while ($next_stop > $next_time ); } ($time,$cur{in},$cur{out},$cur{maxin},$cur{maxout}) = ($next_time,$next{in},$next{out},$next{maxin},$next{maxout}); } close R; # lets see if we have rrdtool 1.2 at our hands my $VERSION = '0001'; if ($RRDs::VERSION >= 1.2){ $VERSION = '0003'; } my $DST; my $pdprepin = (shift @{$store{in}{300}})*($first_step{300}); my $pdprepout = (shift @{$store{out}{300}})*($first_step{300}); if (defined $$rcfg{'options'}{'absolute'}{$router}) { $DST = 'ABSOLUTE' } elsif (defined $$rcfg{'options'}{'gauge'}{$router}) { $DST = 'GAUGE' } else { $DST = 'COUNTER' } my $MHB = int($$cfg{interval} * 60 * 2); my $MAX1 = $$rcfg{'absmax'}{$router} || $$rcfg{'maxbytes1'}{$router} || 'U'; my $MAX2 = $$rcfg{'absmax'}{$router} || $$rcfg{'maxbytes2'}{$router} || 'U'; $rrd = < $VERSION 300 $latest_timestamp ds0 $DST $MHB 0 $MAX1 $latest_counter{in} $pdprepin 0 ds1 $DST $MHB 0 $MAX2 $latest_counter{out} $pdprepout 0 RRD $first_step{300} = 0; # invalidate addarch(1,'AVERAGE','in','out',\%store,\%first_step,\$rrd); addarch(6,'AVERAGE','in','out',\%store,\%first_step,\$rrd); addarch(24,'AVERAGE','in','out',\%store,\%first_step,\$rrd); addarch(288,'AVERAGE','in','out',\%store,\%first_step,\$rrd); addarch(1,'MAX','maxin','maxout',\%store,\%first_step,\$rrd); addarch(6,'MAX','maxin','maxout',\%store,\%first_step,\$rrd); addarch(24,'MAX','maxin','maxout',\%store,\%first_step,\$rrd); addarch(288,'MAX','maxin','maxout',\%store,\%first_step,\$rrd); $rrd .= < RRD if ( $OS eq 'NT' or $OS eq 'OS2') { open (R, "|$$cfg{rrdtool} restore - $$cfg{logdir}$$rcfg{'directory'}{$router}$router.rrd"); } else { open (R, "|-") or exec "$$cfg{rrdtool}","restore","-","$$cfg{logdir}$$rcfg{'directory'}{$router}$router.rrd"; } print R $rrd; close R; } sub addarch($$$$$$$){ my $steps = shift; my $cons = shift; my $in = shift; my $out = shift; my $store = shift; my $first_step = shift; my $rrd = shift; my $cdpin = 'NaN'; my $cdpout = 'NaN'; my $param_start = ''; my $param_end = ''; my $extra_ds = ''; if ($RRDs::VERSION >= 1.2){ $param_start = ''; $param_end = ''; $extra_ds = ' 0.0000000000e+00 0.0000000000e+00 '; } if ($steps != 300) { $cdpin = shift @{$$store{$in}{300*$steps}}; $cdpout = shift @{$$store{$out}{300*$steps}}; }; $$rrd .= < $cons $steps $param_start 0.5 $param_end $extra_ds $cdpin 0 $extra_ds $cdpout 0 RRD while (@{$$store{$in}{$steps*300}}){ # we take zero as UNKNOWN my $inr = pop @{$$store{$in}{$steps*300}} || 'NaN'; my $outr = pop @{$$store{$out}{$steps*300}} || 'NaN'; $$rrd .= < $inr $outr RRD } $$rrd .= < RRD } # debug if the relevant debug tag is active print the debug message sub debug ($$) { return unless scalar @main::DEBUG; my $tag = shift; my $msg = shift; return unless grep {$_ eq $tag} @main::DEBUG; warn "--".$tag.": ".$msg."\n"; return; } # timestamp sub timestamp () { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year += 1900; $mon += 1; return sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year,$mon,$mday,$hour,$min,$sec; } # configure __DIE__ and __WARN__ sub setup_loghandlers ($){ $::global_logfile = $_[0]; for($_[0]){ /^eventlog$/i && do { require Win32::EventLog; $SIG{__WARN__} = sub { my $EventLog = Win32::EventLog->new('MRTG'); my $Type = ($_[0] =~ /warning/) ? &Win32::EventLog::EVENTLOG_WARNING_TYPE : &Win32::EventLog::EVENTLOG_INFORMATION_TYPE; my $Msg = $_[0]; $Msg =~ s/\n/\r\n/g; $Msg =~ s/[\n\r]$//g; $EventLog->Report({ EventID => 1000, Category => "WARN", EventType => $Type, Data => '', Strings => $Msg }); $EventLog->Close; }; $SIG{__DIE__} = sub { return if $^S ; # no handler in eval my $EventLog = Win32::EventLog->new('MRTG'); my $Msg = $_[0]; $Msg =~ s/\n/\r\n/g; $Msg =~ s/[\n\r]$//g; $EventLog->Report({ EventID => 1000, Category => "ERROR", EventType => &Win32::EventLog::EVENTLOG_ERROR_TYPE, Data => '', Strings => $Msg }); $EventLog->Close; exit 1; }; last; }; $SIG{__WARN__} = sub { if (open DEB, ">>$::global_logfile") { print DEB timestamp." -- $_[0]"; close DEB; } else { print STDERR timestamp." -- $_[0]" } }; $SIG{__DIE__} = sub { return if $^S ; # no handler in eval if ( open DEB, ">>$::global_logfile") { print DEB timestamp." -- $_[0]"; close DEB; } else { print STDERR timestamp." -- $_[0]" } exit 1 }; } } # Adds the v4only attribute to a target if the caller requests it. # (this includes targets specified using numeric IPv6 addresses...) sub v4onlyifnecessary ($$) { my $target = shift; my $add = shift; my ($v6addr, $temptarget); if($add) { # Catch numeric IPv6 addresses if ( $target =~ /(\[[\w:]*\])(.*)/) { ($v6addr, $temptarget) = ($1,$2); } else { $temptarget = $target; } return $target.(":" x (5 - ($temptarget =~ tr/://))).":v4only"; } else { return $target; } } __END__ =pod =head1 NAME MRTG_lib.pm - Library for MRTG and support scripts =head1 SYNOPSIS use MRTG_lib; my ($configfile, @target_names, %globalcfg, %targetcfg); readcfg($configfile, \@target_names, \%globalcfg, \%targetcfg); my (@parsed_targets); cfgcheck(\@target_names, \%globalcfg, \%targetcfg, \@parsed_targets); =head1 DESCRIPTION MRTG_lib is part of MRTG, the Multi Router Traffic Grapher. It was separated from MRTG to allow other programs to easily use the same config files. The main part of MRTG_lib is the config file parser but some other funcions are there too. =over 4 =item C<$MRTG_lib::OS> Type of OS: WIN, UNIX, VMS =item C<$MRTG_lib::SL> I in the current OS. =item C<$MRTG_lib::PS> Path separator in PATH variable =item C C Reads a config file, parses it and fills some arrays and hashes. The mandatory arguments are: the name of the config file, a ref to an array which will be filled with a list of the target names, a hashref for the global configuration, a hashref for the target configuration. The configuration file syntax is: globaloption: value targetoption[targetname]: value aprefix*extglobal: value aprefix*exttarget[target2]: value E.g. workdir: /var/stat/mrtg target[router1]: 2:public@router1.local.net 14all*columns: 2 The global config hash has the structure $globalcfg{configoption} = 'value' The target config hash has the structure $targetcfg{configoption}{targetname} = 'value' See L for more information about the MRTG configuration syntax. C can take two additional arguments to extend the config file syntax. This allows programs to put their configuration into the mrtg config file. The fifth argument is the prefix of the extension, the sixth argument is a hash with the checkrules for these extension settings. E.g. if the prefix is "14all" C will check config lines that begin with "14all*", i.e. all lines like 14all*columns: 2 14all*graphsize[target3]: 500 200 against the rules in %extrules. The format of this hash is: $extrules{option} = [sub{$_[0] =~ m/^\d+$/}, sub{"Error message for $_[0]"}] i.e. $extrules{option}[0] -> a test expression $extrules{option}[1] -> error message if test fails The first part of the array is a perl expression to test the value of the option. The test can access this value in the variable "$arg". The second part of the array is an error message to display when the test fails. The failed value can be integrated by using the variable "$arg". Config settings with an different prefix than the one given in the C call are not checked but inserted into I<%globalcfg> and I<%targetcfg>. Prefixed settings keep their prefix in the config hashes: $targetcfg{'14all*graphsize'}{'target3'} = '500 200' =item C C Checks the configuration read by C. Checks the values in the config for syntactical and/or semantical errors. Sets defaults for some options. Parses the "target[...]" options and filles the array @parsed_targets ready for mrtg functions. The first three arguments are the same as for C. The fourth argument is an arrayref which will be filled with the parsed target defs. C converts the values of target settings I, e.g. options[router1]: bits, growright to a hash: $targetcfg{'option'}{'bits'}{'router1'} = 1 $targetcfg{'option'}{'growright'}{'router1'} = 1 This is not done by C so if you don't use C you have to check the scalar variable I<$targetcfg{'option'}{'router1'}> (MRTG allows options to be separated by space or ','). =item C C Checks that the I does not contain double path separators and ends with a path separator. It uses $MRTG_lib::SL as path separator which will be / or \ depending on the OS. =item C C Convert log file to rrd format. Needs rrdtool. =item C C Returns the time given in the argument as a nicely formated date string. The argument has to be in UNIX time format (seconds since 1970-1-1). =item C C Return a string representing the current time. =item C C Install signalhandlers for __DIE__ and __WARN__ making the errors go the the specified destination. If filename is 'eventlog' mrtg will log to the windows event logger. =item C C Returns the time given in the argument formatted suitable for HTTP Expire-Headers. =item C C Creates a pid file for the mrtg daemon =item C C Puts the running program into background, detaching it from the terminal. =item C C Reads the SNMP variables I, I, I, I from the I and stores the values in I<%confcache> as follows: $confcache{$host}{'Descr'}{ifDescr}{oid} = (ifDescr or 'Dup') $confcache{$host}{'IP'}{ipAdEntIfIndex}{oid} = (ipAdEntIfIndex or 'Dup') $confcache{$host}{'Eth'}{ifPhysAddress}{oid} = (ifPhysAddress or 'Dup') $confcache{$host}{'Name'}{ifName}{oid} = (ifName or 'Dup') $confcache{$host}{'Type'}{ifType}{oid} = (ifType or 'Dup') The value (at the right side of =) is 'Dup' if a value was retrieved muliple times, the retrieved value else. =item C C Preload the confcache from a file. =item C C Store the current confcache into a file. =item C C Store the current confcache into a file. =item C C =item C C =item C C =item C C Prints the I on STDERR if debugging is enabled for type I. A debug type is enabled if I is in array @main::DEBUG. =back =head1 AUTHORS Rainer Bawidamann ERainer.Bawidamann@rz.uni-ulm.deE (This Manpage) =cut PK!" SNMP_util.pmnu[PK!mSNMP_Session.pmnu[PK!ۭ.locales_mrtg.pmnu[PK!ojҋllBER.pmnu[PK!B/Net_SNMP_util.pmnu[PK!EE  MRTG_lib.pmnu[PKf