From 74e058c8a010ef6feb539248a550d0bb169c1e94 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 27 Dec 2010 00:04:44 +0000 Subject: import torrus 1.0.9 --- torrus/perllib/Makefile.am | 48 + torrus/perllib/Makefile.in | 366 +++++ torrus/perllib/Torrus/ACL.pm | 156 +++ torrus/perllib/Torrus/ACL/AuthLocalMD5.pm | 79 ++ torrus/perllib/Torrus/ACL/Edit.pm | 627 +++++++++ torrus/perllib/Torrus/ACL/Export.pm | 91 ++ torrus/perllib/Torrus/ACL/Import.pm | 157 +++ torrus/perllib/Torrus/Apache2Handler.pm | 62 + torrus/perllib/Torrus/ApacheHandler.pm | 46 + torrus/perllib/Torrus/CGI.pm | 423 ++++++ torrus/perllib/Torrus/Collector.pm | 695 ++++++++++ torrus/perllib/Torrus/Collector/CDef.pm | 120 ++ torrus/perllib/Torrus/Collector/CDef_Params.pm | 69 + torrus/perllib/Torrus/Collector/ExtDBI.pm | 128 ++ torrus/perllib/Torrus/Collector/ExternalStorage.pm | 415 ++++++ torrus/perllib/Torrus/Collector/RRDStorage.pm | 584 ++++++++ torrus/perllib/Torrus/Collector/SNMP.pm | 1261 ++++++++++++++++++ torrus/perllib/Torrus/Collector/SNMP_Params.pm | 149 +++ torrus/perllib/Torrus/ConfigBuilder.pm | 529 ++++++++ torrus/perllib/Torrus/ConfigTree.pm | 1158 ++++++++++++++++ torrus/perllib/Torrus/ConfigTree/Validator.pm | 969 ++++++++++++++ torrus/perllib/Torrus/ConfigTree/Writer.pm | 755 +++++++++++ torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm | 548 ++++++++ torrus/perllib/Torrus/DB.pm | 703 ++++++++++ torrus/perllib/Torrus/DataAccess.pm | 317 +++++ torrus/perllib/Torrus/DevDiscover.pm | 1106 +++++++++++++++ torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm | 567 ++++++++ torrus/perllib/Torrus/DevDiscover/ATMEL.pm | 167 +++ .../Torrus/DevDiscover/AlliedTelesyn_PBC18.pm | 284 ++++ torrus/perllib/Torrus/DevDiscover/Alteon.pm | 169 +++ torrus/perllib/Torrus/DevDiscover/Apple_AE.pm | 180 +++ torrus/perllib/Torrus/DevDiscover/Arbor_E.pm | 1150 ++++++++++++++++ torrus/perllib/Torrus/DevDiscover/Arista.pm | 144 ++ torrus/perllib/Torrus/DevDiscover/AscendMax.pm | 207 +++ torrus/perllib/Torrus/DevDiscover/AxxessIT.pm | 351 +++++ .../perllib/Torrus/DevDiscover/BetterNetworks.pm | 238 ++++ torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm | 268 ++++ torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm | 193 +++ torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm | 142 ++ torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm | 743 +++++++++++ torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm | 687 ++++++++++ .../perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm | 285 ++++ .../Torrus/DevDiscover/CiscoIOS_MacAccounting.pm | 388 ++++++ torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm | 382 ++++++ torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm | 418 ++++++ torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm | 130 ++ torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm | 212 +++ .../perllib/Torrus/DevDiscover/EmpireSystemedge.pm | 798 +++++++++++ torrus/perllib/Torrus/DevDiscover/F5BigIp.pm | 543 ++++++++ torrus/perllib/Torrus/DevDiscover/FTOS.pm | 378 ++++++ torrus/perllib/Torrus/DevDiscover/Foundry.pm | 566 ++++++++ torrus/perllib/Torrus/DevDiscover/Jacarta.pm | 210 +++ torrus/perllib/Torrus/DevDiscover/JunOS.pm | 657 +++++++++ torrus/perllib/Torrus/DevDiscover/Liebert.pm | 313 +++++ .../perllib/Torrus/DevDiscover/MicrosoftWindows.pm | 181 +++ torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm | 213 +++ torrus/perllib/Torrus/DevDiscover/NetApp.pm | 170 +++ torrus/perllib/Torrus/DevDiscover/NetBotz.pm | 197 +++ torrus/perllib/Torrus/DevDiscover/NetScreen.pm | 152 +++ .../perllib/Torrus/DevDiscover/OracleDatabase.pm | 395 ++++++ torrus/perllib/Torrus/DevDiscover/Paradyne.pm | 200 +++ .../perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm | 180 +++ .../perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm | 85 ++ torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm | 241 ++++ .../perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm | 94 ++ .../Torrus/DevDiscover/RFC2662_ADSL_LINE.pm | 140 ++ .../perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm | 307 +++++ .../Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm | 152 +++ .../Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm | 263 ++++ .../perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm | 1404 ++++++++++++++++++++ torrus/perllib/Torrus/DevDiscover/Symmetricom.pm | 104 ++ torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm | 265 ++++ torrus/perllib/Torrus/DevDiscover/Xylan.pm | 199 +++ torrus/perllib/Torrus/Log.pm | 136 ++ torrus/perllib/Torrus/Monitor.pm | 700 ++++++++++ torrus/perllib/Torrus/RPN.pm | 213 +++ torrus/perllib/Torrus/Renderer.pm | 286 ++++ torrus/perllib/Torrus/Renderer/AdmInfo.pm | 242 ++++ torrus/perllib/Torrus/Renderer/Frontpage.pm | 291 ++++ torrus/perllib/Torrus/Renderer/HTML.pm | 530 ++++++++ torrus/perllib/Torrus/Renderer/RRDtool.pm | 993 ++++++++++++++ torrus/perllib/Torrus/ReportGenerator.pm | 141 ++ .../Torrus/ReportGenerator/MonthlySrvUsage.pm | 221 +++ torrus/perllib/Torrus/ReportOutput.pm | 210 +++ torrus/perllib/Torrus/ReportOutput/HTML.pm | 296 +++++ torrus/perllib/Torrus/SNMP_Failures.pm | 205 +++ torrus/perllib/Torrus/SQL.pm | 234 ++++ torrus/perllib/Torrus/SQL/Reports.pm | 291 ++++ torrus/perllib/Torrus/SQL/SrvExport.pm | 109 ++ torrus/perllib/Torrus/Scheduler.pm | 498 +++++++ torrus/perllib/Torrus/SchedulerInfo.pm | 216 +++ torrus/perllib/Torrus/Search.pm | 148 +++ torrus/perllib/Torrus/ServiceID.pm | 188 +++ torrus/perllib/Torrus/SiteConfig.pm | 335 +++++ torrus/perllib/Torrus/TimeStamp.pm | 71 + 95 files changed, 33827 insertions(+) create mode 100644 torrus/perllib/Makefile.am create mode 100644 torrus/perllib/Makefile.in create mode 100644 torrus/perllib/Torrus/ACL.pm create mode 100644 torrus/perllib/Torrus/ACL/AuthLocalMD5.pm create mode 100644 torrus/perllib/Torrus/ACL/Edit.pm create mode 100644 torrus/perllib/Torrus/ACL/Export.pm create mode 100644 torrus/perllib/Torrus/ACL/Import.pm create mode 100644 torrus/perllib/Torrus/Apache2Handler.pm create mode 100644 torrus/perllib/Torrus/ApacheHandler.pm create mode 100644 torrus/perllib/Torrus/CGI.pm create mode 100644 torrus/perllib/Torrus/Collector.pm create mode 100644 torrus/perllib/Torrus/Collector/CDef.pm create mode 100644 torrus/perllib/Torrus/Collector/CDef_Params.pm create mode 100644 torrus/perllib/Torrus/Collector/ExtDBI.pm create mode 100644 torrus/perllib/Torrus/Collector/ExternalStorage.pm create mode 100644 torrus/perllib/Torrus/Collector/RRDStorage.pm create mode 100644 torrus/perllib/Torrus/Collector/SNMP.pm create mode 100644 torrus/perllib/Torrus/Collector/SNMP_Params.pm create mode 100644 torrus/perllib/Torrus/ConfigBuilder.pm create mode 100644 torrus/perllib/Torrus/ConfigTree.pm create mode 100644 torrus/perllib/Torrus/ConfigTree/Validator.pm create mode 100644 torrus/perllib/Torrus/ConfigTree/Writer.pm create mode 100644 torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm create mode 100644 torrus/perllib/Torrus/DB.pm create mode 100644 torrus/perllib/Torrus/DataAccess.pm create mode 100644 torrus/perllib/Torrus/DevDiscover.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/ATMEL.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Alteon.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Apple_AE.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Arbor_E.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Arista.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/AscendMax.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/AxxessIT.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/F5BigIp.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/FTOS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Foundry.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Jacarta.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/JunOS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Liebert.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/NetApp.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/NetBotz.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/NetScreen.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Paradyne.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Symmetricom.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm create mode 100644 torrus/perllib/Torrus/DevDiscover/Xylan.pm create mode 100644 torrus/perllib/Torrus/Log.pm create mode 100644 torrus/perllib/Torrus/Monitor.pm create mode 100644 torrus/perllib/Torrus/RPN.pm create mode 100644 torrus/perllib/Torrus/Renderer.pm create mode 100644 torrus/perllib/Torrus/Renderer/AdmInfo.pm create mode 100644 torrus/perllib/Torrus/Renderer/Frontpage.pm create mode 100644 torrus/perllib/Torrus/Renderer/HTML.pm create mode 100644 torrus/perllib/Torrus/Renderer/RRDtool.pm create mode 100644 torrus/perllib/Torrus/ReportGenerator.pm create mode 100644 torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm create mode 100644 torrus/perllib/Torrus/ReportOutput.pm create mode 100644 torrus/perllib/Torrus/ReportOutput/HTML.pm create mode 100644 torrus/perllib/Torrus/SNMP_Failures.pm create mode 100644 torrus/perllib/Torrus/SQL.pm create mode 100644 torrus/perllib/Torrus/SQL/Reports.pm create mode 100644 torrus/perllib/Torrus/SQL/SrvExport.pm create mode 100644 torrus/perllib/Torrus/Scheduler.pm create mode 100644 torrus/perllib/Torrus/SchedulerInfo.pm create mode 100644 torrus/perllib/Torrus/Search.pm create mode 100644 torrus/perllib/Torrus/ServiceID.pm create mode 100644 torrus/perllib/Torrus/SiteConfig.pm create mode 100644 torrus/perllib/Torrus/TimeStamp.pm (limited to 'torrus/perllib') diff --git a/torrus/perllib/Makefile.am b/torrus/perllib/Makefile.am new file mode 100644 index 000000000..b1b691a63 --- /dev/null +++ b/torrus/perllib/Makefile.am @@ -0,0 +1,48 @@ + +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Makefile.am,v 1.1 2010-12-27 00:03:37 ivan Exp $ +# Stanislav Sinyagin +# + + +install-data-local: + $(mkinstalldirs) $(DESTDIR)$(perllibdir) + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + $(mkinstalldirs) $(DESTDIR)$(perllibdir)/$$d; done + find * \( -name '*.pm' \) -type f -print >list.tmp + for f in `cat list.tmp`; do \ + $(INSTALL_DATA) $$f $(DESTDIR)$(perllibdir)/$$f; done + rm -f list.tmp + + +uninstall-local: + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + rm -r $(DESTDIR)$(perllibdir)/$$d; done + rm -f list.tmp + + +dist-hook: + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + mkdir $(distdir)/$$d; done + find * \( -name '*.pm' -o -name '*.txt' \) -type f -print >list.tmp + for f in `cat list.tmp`; do \ + cp $$f $(distdir)/$$f; done + rm -f list.tmp diff --git a/torrus/perllib/Makefile.in b/torrus/perllib/Makefile.in new file mode 100644 index 000000000..81714f45b --- /dev/null +++ b/torrus/perllib/Makefile.in @@ -0,0 +1,366 @@ +# Makefile.in generated by automake 1.9.6 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Makefile.in,v 1.1 2010-12-27 00:03:37 ivan Exp $ +# Stanislav Sinyagin +# +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +top_builddir = .. +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +INSTALL = @INSTALL@ +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = perllib +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_CLEAN_FILES = +SOURCES = +DIST_SOURCES = +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +FIND = @FIND@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +KILL = @KILL@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PERL = @PERL@ +PERLINC = @PERLINC@ +POD2MAN = @POD2MAN@ +POD2MAN_PRESENT_FALSE = @POD2MAN_PRESENT_FALSE@ +POD2MAN_PRESENT_TRUE = @POD2MAN_PRESENT_TRUE@ +POD2TEXT = @POD2TEXT@ +POD2TEXT_PRESENT_FALSE = @POD2TEXT_PRESENT_FALSE@ +POD2TEXT_PRESENT_TRUE = @POD2TEXT_PRESENT_TRUE@ +RM = @RM@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SLEEP = @SLEEP@ +STRIP = @STRIP@ +SU = @SU@ +VERSION = @VERSION@ +ac_ct_STRIP = @ac_ct_STRIP@ +am__leading_dot = @am__leading_dot@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +cachedir = @cachedir@ +cfgdefdir = @cfgdefdir@ +datadir = @datadir@ +dbhome = @dbhome@ +defrrddir = @defrrddir@ +distxmldir = @distxmldir@ +enable_pkgonly = @enable_pkgonly@ +enable_varperm = @enable_varperm@ +exec_prefix = @exec_prefix@ +exmpdir = @exmpdir@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localstatedir = @localstatedir@ +logdir = @logdir@ +mandir = @mandir@ +mansec_misc = @mansec_misc@ +mansec_usercmd = @mansec_usercmd@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +perlithreads = @perlithreads@ +perllibdir = @perllibdir@ +perllibdirs = @perllibdirs@ +piddir = @piddir@ +pkgbindir = @pkgbindir@ +pkgdocdir = @pkgdocdir@ +pkghome = @pkghome@ +plugdevdisccfgdir = @plugdevdisccfgdir@ +pluginsdir = @pluginsdir@ +plugtorruscfgdir = @plugtorruscfgdir@ +plugwrapperdir = @plugwrapperdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +reportsdir = @reportsdir@ +sbindir = @sbindir@ +scriptsdir = @scriptsdir@ +seslockdir = @seslockdir@ +sesstordir = @sesstordir@ +sharedstatedir = @sharedstatedir@ +siteconfdir = @siteconfdir@ +sitedir = @sitedir@ +sitexmldir = @sitexmldir@ +supdir = @supdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +tmpldir = @tmpldir@ +tmpluserdir = @tmpluserdir@ +torrus_user = @torrus_user@ +var_group = @var_group@ +var_mode = @var_mode@ +var_user = @var_user@ +varprefix = @varprefix@ +webplaindir = @webplaindir@ +webscriptsdir = @webscriptsdir@ +wrapperdir = @wrapperdir@ +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu perllib/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu perllib/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +uninstall-info-am: +tags: TAGS +TAGS: + +ctags: CTAGS +CTAGS: + + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ + list='$(DISTFILES)'; for file in $$list; do \ + case $$file in \ + $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \ + $(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \ + esac; \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test "$$dir" != "$$file" && test "$$dir" != "."; then \ + dir="/$$dir"; \ + $(mkdir_p) "$(distdir)$$dir"; \ + else \ + dir=''; \ + fi; \ + if test -d $$d/$$file; then \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$(top_distdir)" distdir="$(distdir)" \ + dist-hook +check-am: all-am +check: check-am +all-am: Makefile +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: + +html: html-am + +info: info-am + +info-am: + +install-data-am: install-data-local + +install-exec-am: + +install-info: install-info-am + +install-man: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-info-am uninstall-local + +.PHONY: all all-am check check-am clean clean-generic dist-hook \ + distclean distclean-generic distdir dvi dvi-am html html-am \ + info info-am install install-am install-data install-data-am \ + install-data-local install-exec install-exec-am install-info \ + install-info-am install-man install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ + pdf-am ps ps-am uninstall uninstall-am uninstall-info-am \ + uninstall-local + + +install-data-local: + $(mkinstalldirs) $(DESTDIR)$(perllibdir) + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + $(mkinstalldirs) $(DESTDIR)$(perllibdir)/$$d; done + find * \( -name '*.pm' \) -type f -print >list.tmp + for f in `cat list.tmp`; do \ + $(INSTALL_DATA) $$f $(DESTDIR)$(perllibdir)/$$f; done + rm -f list.tmp + +uninstall-local: + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + rm -r $(DESTDIR)$(perllibdir)/$$d; done + rm -f list.tmp + +dist-hook: + find * -type d ! -name CVS -print >list.tmp + for d in `cat list.tmp`; do \ + mkdir $(distdir)/$$d; done + find * \( -name '*.pm' -o -name '*.txt' \) -type f -print >list.tmp + for f in `cat list.tmp`; do \ + cp $$f $(distdir)/$$f; done + rm -f list.tmp +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/torrus/perllib/Torrus/ACL.pm b/torrus/perllib/Torrus/ACL.pm new file mode 100644 index 000000000..53b9f618c --- /dev/null +++ b/torrus/perllib/Torrus/ACL.pm @@ -0,0 +1,156 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ACL.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ACL; + +use Torrus::DB; +use Torrus::Log; + +use strict; + +BEGIN +{ + eval( 'require ' . $Torrus::ACL::userAuthModule ); + die( $@ ) if $@; +} + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + eval( '$self->{"auth"} = new ' . $Torrus::ACL::userAuthModule ); + die( $@ ) if $@; + + my $writing = $options{'-WriteAccess'}; + + $self->{'db_users'} = new Torrus::DB('users', -WriteAccess => $writing ); + defined( $self->{'db_users'} ) or return( undef ); + + $self->{'db_acl'} = new Torrus::DB('acl', -WriteAccess => $writing ); + defined( $self->{'db_acl'} ) or return( undef ); + + $self->{'is_writing'} = $writing; + + return $self; +} + + +sub DESTROY +{ + my $self = shift; + + Debug('Destroying ACL object'); + + undef $self->{'db_users'}; + undef $self->{'db_acl'}; +} + + +sub hasPrivilege +{ + my $self = shift; + my $uid = shift; + my $object = shift; + my $privilege = shift; + + foreach my $group ( $self->memberOf( $uid ) ) + { + if( $self->{'db_acl'}->get( $group.':'.$object.':'.$privilege ) ) + { + Debug('User ' . $uid . ' has privilege ' . $privilege . + ' for ' . $object); + return 1; + } + } + + if( $object ne '*' ) + { + return $self->hasPrivilege( $uid, '*', $privilege ); + } + + Debug('User ' . $uid . ' has NO privilege ' . $privilege . + ' for ' . $object); + return undef; +} + + +sub memberOf +{ + my $self = shift; + my $uid = shift; + + my $glist = $self->{'db_users'}->get( 'gm:' . $uid ); + return( defined( $glist ) ? split(',', $glist) : () ); +} + + +sub authenticateUser +{ + my $self = shift; + my $uid = shift; + my $password = shift; + + my @attrList = $self->{'auth'}->getUserAttrList(); + my $attrValues = {}; + foreach my $attr ( @attrList ) + { + $attrValues->{$attr} = $self->userAttribute( $uid, $attr ); + } + + my $ret = $self->{'auth'}->authenticateUser( $uid, $password, + $attrValues ); + Debug('User authentication: uid=' . $uid . ', result=' . + ($ret ? 'true':'false')); + return $ret; +} + + +sub userAttribute +{ + my $self = shift; + my $uid = shift; + my $attr = shift; + + return $self->{'db_users'}->get( 'ua:' . $uid . ':' . $attr ); +} + + +sub groupAttribute +{ + my $self = shift; + my $group = shift; + my $attr = shift; + + return $self->{'db_users'}->get( 'ga:' . $group . ':' . $attr ); +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm b/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm new file mode 100644 index 000000000..b1e6a1577 --- /dev/null +++ b/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm @@ -0,0 +1,79 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: AuthLocalMD5.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ACL::AuthLocalMD5; + +use Torrus::Log; + +use Digest::MD5 qw(md5_hex); +use strict; + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + return $self; +} + + +sub getUserAttrList +{ + return qw(userPasswordMD5); +} + +sub authenticateUser +{ + my $self = shift; + my $uid = shift; + my $password = shift; + my $attrValues = shift; + + if( not $password or not $attrValues->{'userPasswordMD5'} ) + { + return undef; + } + my $pw_md5 = md5_hex( $password ); + return( $pw_md5 eq $attrValues->{'userPasswordMD5'} ); +} + + +sub setPassword +{ + my $self = shift; + my $uid = shift; + my $password = shift; + + my $attrValues = {}; + $attrValues->{'userPasswordMD5'} = md5_hex( $password ); + return $attrValues; +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ACL/Edit.pm b/torrus/perllib/Torrus/ACL/Edit.pm new file mode 100644 index 000000000..9966c9edd --- /dev/null +++ b/torrus/perllib/Torrus/ACL/Edit.pm @@ -0,0 +1,627 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Edit.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ACL::Edit; + +use Torrus::ACL; +use Torrus::Log; + +use strict; + +@Torrus::ACL::Edit::ISA = qw(Torrus::ACL); + +sub new +{ + my $proto = shift; + my %options = @_; + my $class = ref($proto) || $proto; + $options{'-WriteAccess'} = 1; + my $self = $class->SUPER::new( %options ); + bless $self, $class; + return $self; +} + + +sub addGroups +{ + my $self = shift; + my @groups = shift; + + my $ok = 1; + foreach my $group ( @groups ) + { + if( length( $group ) == 0 or $group =~ /\W/ ) + { + Error('Invalid group name: ' . $group); + $ok = 0; + } + elsif( $self->groupExists( $group ) ) + { + Error('Cannot add group ' . $group . ': the group already exists'); + $ok = 0; + } + else + { + $self->{'db_users'}->addToList( 'G:', $group ); + $self->setGroupModified( $group ); + Info('Group added: ' . $group); + } + } + return $ok; +} + +sub deleteGroups +{ + my $self = shift; + my @groups = shift; + + my $ok = 1; + foreach my $group ( @groups ) + { + if( $self->groupExists( $group ) ) + { + my $members = $self->listGroupMembers( $group ); + foreach my $uid ( @{$members} ) + { + $self->{'db_users'}->delFromList( 'gm:' . $uid, $group ); + } + $self->{'db_users'}->delFromList( 'G:', $group ); + + my $cursor = $self->{'db_acl'}->cursor( -Write => 1 ); + while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) ) + { + my( $dbgroup, $object, $privilege ) = split( ':', $key ); + if( $dbgroup eq $group ) + { + $self->{'db_acl'}->c_del( $cursor ); + } + } + undef $cursor; + + Info('Group deleted: ' . $group); + } + else + { + Error('Cannot delete group ' . $group . + ': the group does not exist'); + $ok = 0; + } + } + return $ok; +} + +sub groupExists +{ + my $self = shift; + my $group = shift; + + return $self->{'db_users'}->searchList( 'G:', $group ); +} + + +sub listGroups +{ + my $self = shift; + + my $list = $self->{'db_users'}->get( 'G:' ); + + return split( ',', $list ); +} + + +sub listGroupMembers +{ + my $self = shift; + my $group = shift; + + my $members = []; + + my $cursor = $self->{'db_users'}->cursor(); + while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) ) + { + my( $selector, $uid ) = split(':', $key); + if( $selector eq 'gm' ) + { + if( defined($val) and length($val) > 0 and + grep {$group eq $_} split(',', $val) ) + { + push( @{$members}, $uid ); + } + } + } + undef $cursor; + return $members; +} + + +sub addUserToGroups +{ + my $self = shift; + my $uid = shift; + my @groups = @_; + + my $ok = 1; + if( $self->userExists( $uid ) ) + { + foreach my $group ( @groups ) + { + if( $self->groupExists( $group ) ) + { + if( not grep {$group eq $_} $self->memberOf( $uid ) ) + { + $self->{'db_users'}->addToList( 'gm:' . $uid, $group ); + $self->setGroupModified( $group ); + Info('Added ' . $uid . ' to group ' . $group); + } + else + { + Error('Cannot add ' . $uid . ' to group ' . $group . + ': user is already a member of this group'); + $ok = 0; + } + } + else + { + Error('Cannot add ' . $uid . ' to group ' . $group . + ': group does not exist'); + $ok = 0; + } + } + } + else + { + Error('Cannot add user ' . $uid . + 'to groups: user does not exist'); + $ok = 0; + } + return $ok; +} + + +sub delUserFromGroups +{ + my $self = shift; + my $uid = shift; + my @groups = shift; + + my $ok = 1; + if( $self->userExists( $uid ) ) + { + foreach my $group ( @groups ) + { + if( $self->groupExists( $group ) ) + { + if( grep {$group eq $_} $self->memberOf( $uid ) ) + { + $self->{'db_users'}->delFromList( 'gm:' . $uid, $group ); + $self->setGroupModified( $group ); + Info('Deleted ' . $uid . ' from group ' . $group); + } + else + { + Error('Cannot delete ' . $uid . ' from group ' . $group . + ': user is not a member of this group'); + $ok = 0; + } + } + else + { + Error('Cannot detete ' . $uid . ' from group ' . $group . + ': group does not exist'); + $ok = 0; + } + } + } + else + { + Error('Cannot delete user ' . $uid . + 'from groups: user does not exist'); + $ok = 0; + } + return $ok; +} + + +sub addUser +{ + my $self = shift; + my $uid = shift; + my $attrValues = shift; + + my $ok = 1; + if( length( $uid ) == 0 or $uid =~ /\W/ ) + { + Error('Invalid user ID: ' . $uid); + $ok = 0; + } + elsif( $self->userExists( $uid ) ) + { + Error('Cannot add user ' . $uid . ': the user already exists'); + $ok = 0; + } + else + { + $self->setUserAttribute( $uid, 'uid', $uid ); + if( defined( $attrValues ) ) + { + $self->setUserAttributes( $uid, $attrValues ); + } + Info('User added: ' . $uid); + } + return $ok; +} + + +sub userExists +{ + my $self = shift; + my $uid = shift; + + my $dbuid = $self->userAttribute( $uid, 'uid' ); + return( defined( $dbuid ) and ( $dbuid eq $uid ) ); +} + +sub listUsers +{ + my $self = shift; + + my @ret; + + my $cursor = $self->{'db_users'}->cursor(); + while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) ) + { + my( $selector, $uid, $attr ) = split(':', $key); + if( $selector eq 'ua' and $attr eq 'uid' ) + { + push( @ret, $uid ); + } + } + undef $cursor; + return @ret; +} + +sub setUserAttribute +{ + my $self = shift; + my $uid = shift; + my $attr = shift; + my $val = shift; + + my $ok = 1; + if( length( $attr ) == 0 or $attr =~ /\W/ ) + { + Error('Invalid attribute name: ' . $attr); + $ok = 0; + } + else + { + $self->{'db_users'}->put( 'ua:' . $uid . ':' . $attr, $val ); + $self->{'db_users'}->addToList( 'uA:' . $uid, $attr ); + if( $attr ne 'modified' ) + { + $self->setUserModified( $uid ); + } + Debug('Set ' . $attr . ' for ' . $uid . ': ' . $val); + } + return $ok; +} + + +sub delUserAttribute +{ + my $self = shift; + my $uid = shift; + my @attrs = @_; + + foreach my $attr ( @attrs ) + { + $self->{'db_users'}->del( 'ua:' . $uid . ':' . $attr ); + $self->{'db_users'}->delFromList( 'uA:' . $uid, $attr ); + $self->setUserModified( $uid ); + Debug('Deleted ' . $attr . ' from ' . $uid); + } +} + + +sub setUserAttributes +{ + my $self = shift; + my $uid = shift; + my $attrValues = shift; + + my $ok = 1; + + foreach my $attr ( keys %{$attrValues} ) + { + $ok = $self->setUserAttribute( $uid, $attr, $attrValues->{$attr} ) + ? $ok:0; + } + + return $ok; +} + + +sub setUserModified +{ + my $self = shift; + my $uid = shift; + + $self->setUserAttribute( $uid, 'modified', scalar( localtime( time() ) ) ); +} + +sub listUserAttributes +{ + my $self = shift; + my $uid = shift; + + my $list = $self->{'db_users'}->get( 'uA:' . $uid ); + + return split( ',', $list ); +} + + +sub setPassword +{ + my $self = shift; + my $uid = shift; + my $password = shift; + + my $ok = 1; + if( $self->userExists( $uid ) ) + { + if( length( $password ) < $Torrus::ACL::minPasswordLength ) + { + Error('Password too short: must be ' . + $Torrus::ACL::minPasswordLength . ' characters long'); + $ok = 0; + } + else + { + my $attrValues = $self->{'auth'}->setPassword( $uid, $password ); + $self->setUserAttributes( $uid, $attrValues ); + Info('Password set for ' . $uid); + } + } + else + { + Error('Cannot change password for user ' . $uid . + ': user does not exist'); + $ok = 0; + } + return $ok; +} + + +sub deleteUser +{ + my $self = shift; + my $uid = shift; + + my $ok = 1; + if( $self->userExists( $uid ) ) + { + my $cursor = $self->{'db_users'}->cursor( -Write => 1 ); + while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) ) + { + my( $selector, $dbuid ) = split(':', $key); + if( ( $selector eq 'gm' or $selector eq 'ua' ) and + $dbuid eq $uid ) + { + $self->{'db_users'}->c_del( $cursor ); + } + } + undef $cursor; + + Info('User deleted: ' . $uid); + } + else + { + Error('Cannot delete user ' . $uid . ': user does not exist'); + $ok = 0; + } + return $ok; +} + + +sub setGroupAttribute +{ + my $self = shift; + my $group = shift; + my $attr = shift; + my $val = shift; + + my $ok = 1; + if( length( $attr ) == 0 or $attr =~ /\W/ ) + { + Error('Invalid attribute name: ' . $attr); + $ok = 0; + } + else + { + $self->{'db_users'}->put( 'ga:' . $group . ':' . $attr, $val ); + $self->{'db_users'}->addToList( 'gA:' . $group, $attr ); + if( $attr ne 'modified' ) + { + $self->setGroupModified( $group ); + } + Debug('Set ' . $attr . ' for ' . $group . ': ' . $val); + } + return $ok; +} + + +sub listGroupAttributes +{ + my $self = shift; + my $group = shift; + + my $list = $self->{'db_users'}->get( 'gA:' . $group ); + + return split( ',', $list ); +} + + + +sub setGroupModified +{ + my $self = shift; + my $group = shift; + + $self->setGroupAttribute( $group, 'modified', + scalar( localtime( time() ) ) ); +} + + +sub setPrivilege +{ + my $self = shift; + my $group = shift; + my $object = shift; + my $privilege = shift; + + my $ok = 1; + if( $self->groupExists( $group ) ) + { + $self->{'db_acl'}->put( $group.':'.$object.':'.$privilege, 1 ); + $self->setGroupModified( $group ); + Info('Privilege ' . $privilege . ' for object ' . $object . + ' set for group ' . $group); + } + else + { + Error('Cannot set privilege for group ' . $group . + ': group does not exist'); + $ok = 0; + } + return $ok; +} + + +sub clearPrivilege +{ + my $self = shift; + my $group = shift; + my $object = shift; + my $privilege = shift; + + my $ok = 1; + if( $self->groupExists( $group ) ) + { + my $key = $group.':'.$object.':'.$privilege; + if( $self->{'db_acl'}->get( $key ) ) + { + $self->{'db_acl'}->del( $key ); + $self->setGroupModified( $group ); + Info('Privilege ' . $privilege . ' for object ' . $object . + ' revoked from group ' . $group); + } + } + else + { + Error('Cannot revoke privilege from group ' . $group . + ': group does not exist'); + $ok = 0; + } + return $ok; +} + + +sub listPrivileges +{ + my $self = shift; + my $group = shift; + + my $ret = {}; + + my $cursor = $self->{'db_acl'}->cursor(); + while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) ) + { + my( $dbgroup, $object, $privilege ) = split( ':', $key ); + if( $dbgroup eq $group ) + { + $ret->{$object}{$privilege} = 1; + } + } + undef $cursor; + + return $ret; +} + + +sub clearConfig +{ + my $self = shift; + + $self->{'db_acl'}->trunc(); + $self->{'db_users'}->trunc(); + + Info('Cleared the ACL configuration'); + return 1; +} + +sub exportACL +{ + my $self = shift; + my $exportfile = shift; + my $exporttemplate = shift; + + my $ok; + eval 'require Torrus::ACL::Export; + $ok = Torrus::ACL::Export::exportACL( $self, $exportfile, + $exporttemplate );'; + if( $@ ) + { + Error($@); + return 0; + } + else + { + return $ok; + } +} + +sub importACL +{ + my $self = shift; + my $importfile = shift; + + my $ok; + eval 'require Torrus::ACL::Import; + $ok = Torrus::ACL::Import::importACL( $self, $importfile );'; + + if( $@ ) + { + Error($@); + return 0; + } + else + { + return $ok; + } +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ACL/Export.pm b/torrus/perllib/Torrus/ACL/Export.pm new file mode 100644 index 000000000..a4c8c6a5a --- /dev/null +++ b/torrus/perllib/Torrus/ACL/Export.pm @@ -0,0 +1,91 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Export.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ACL::Export; + +use Torrus::ACL; +use Torrus::ACL::Edit; +use Torrus::Log; + +use Template; + +use strict; + + +sub exportACL +{ + my $self = shift; + my $exportfile = shift; + my $exporttemplate = shift; + + my $tt = new Template(INCLUDE_PATH => $Torrus::Global::templateDirs, + TRIM => 1); + + my $vars = { + 'groups' => sub { return $self->listGroups(); }, + 'users' => sub { return $self->listUsers(); }, + 'memberof' => sub { return $self->memberOf($_[0]); }, + 'uattrlist' => sub { return $self->listUserAttributes($_[0]); }, + 'uattr' => sub { return $self->userAttribute($_[0], $_[1]); }, + 'gattrlist' => sub { return $self->listGroupAttributes($_[0]); }, + 'gattr' => sub { return $self->groupAttribute($_[0], $_[1]); }, + 'privileges' => sub { return $self->listPrivileges($_[0]); }, + 'version' => $Torrus::Global::version, + 'xmlnorm' => \&xmlnormalize + }; + + my $ok = $tt->process($exporttemplate, $vars, $exportfile); + + if( not $ok ) + { + print STDERR "Error while processing template: ".$tt->error()."\n"; + } + else + { + Info('Wrote ' . $exportfile); + } + + return $ok; +} + + +sub xmlnormalize +{ + my( $txt )= @_; + + $txt =~ s/\&/\&\;/gm; + $txt =~ s/\/\>\;/gm; + $txt =~ s/\'/\&apos\;/gm; + $txt =~ s/\"/\"\;/gm; + + return $txt; +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ACL/Import.pm b/torrus/perllib/Torrus/ACL/Import.pm new file mode 100644 index 000000000..5c522cf6a --- /dev/null +++ b/torrus/perllib/Torrus/ACL/Import.pm @@ -0,0 +1,157 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Import.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ACL::Import; + +use Torrus::ACL; +use Torrus::ACL::Edit; +use Torrus::Log; + +use XML::LibXML; +use strict; + +my %formatsSupported = ('1.0' => 1, + '1.1' => 1); + +sub importACL +{ + my $self = shift; + my $filename = shift; + + my $ok = 1; + my $parser = new XML::LibXML; + my $doc; + eval { $doc = $parser->parse_file( $filename ); }; + if( $@ ) + { + Error("Failed to parse $filename: $@"); + return 0; + } + + my $root = $doc->documentElement(); + if( $root->nodeName() ne 'aclexport' ) + { + Error('XML root element is not "aclexport" in ' . $filename); + return 0; + } + + my $format_version = + (($root->getElementsByTagName('file-info'))[0]-> + getElementsByTagName('format-version'))[0]->textContent(); + if( not $format_version or not $formatsSupported{$format_version} ) + { + Error('Invalid format or format version not supported: ' . $filename); + return 0; + } + + foreach my $groupnode ( ($root->getElementsByTagName('groups'))[0]-> + getElementsByTagName('group') ) + { + my $group = $groupnode->getAttribute('name'); + Debug('Importing group: ' . $group); + if( not $self->groupExists( $group ) ) + { + $ok = $self->addGroups( $group ) ? $ok:0; + } + else + { + Debug('Group already exists: ' . $group); + } + + foreach my $privnode ( $groupnode->getElementsByTagName('privilege') ) + { + my $object = $privnode->getAttribute('object'); + my $priv = $privnode->getAttribute('name'); + Debug('Setting privilege ' . $priv . ' for ' . $object . + ' to group ' . $group); + $ok = $self->setPrivilege( $group, $object, $priv ) ? $ok:0; + } + + foreach my $attrnode ( $groupnode->getElementsByTagName('attribute') ) + { + my $attr = $attrnode->getAttribute('name'); + if( $attr ne 'modified' ) + { + my $value = $attrnode->getAttribute('value'); + Debug('Setting attribute ' . $attr . ' for group ' . $group . + ' to ' . $value); + $ok = $self->setGroupAttribute( $group, $attr, $value ) + ? $ok:0; + } + } + } + + foreach my $usernode ( ($root->getElementsByTagName('users'))[0]-> + getElementsByTagName('user') ) + { + my $uid = $usernode->getAttribute('uid'); + Debug('Importing user: ' . $uid); + + if( not $self->userExists( $uid ) ) + { + $ok = $self->addUser( $uid ) ? $ok:0; + } + else + { + Debug('User already exists: ' . $uid); + } + + foreach my $membernode ( $usernode->getElementsByTagName('member-of') ) + { + my $group = $membernode->getAttribute('group'); + Debug('Adding ' . $uid . ' to group ' . $group); + + if( not grep {$group eq $_} $self->memberOf( $uid ) ) + { + $ok = $self->addUserToGroups( $uid, $group ) ? $ok:0; + } + else + { + Debug('User ' . $uid . ' is already in group ' . $group); + } + } + + foreach my $attrnode ( $usernode->getElementsByTagName('attribute') ) + { + my $attr = $attrnode->getAttribute('name'); + if( $attr ne 'modified' ) + { + my $value = $attrnode->getAttribute('value'); + Debug('Setting attribute ' . $attr . ' for user ' . $uid . + ' to ' . $value); + $ok = $self->setUserAttribute( $uid, $attr, $value ) ? $ok:0; + } + } + } + Debug('Import finished'); + return $ok; +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Apache2Handler.pm b/torrus/perllib/Torrus/Apache2Handler.pm new file mode 100644 index 000000000..3c7544374 --- /dev/null +++ b/torrus/perllib/Torrus/Apache2Handler.pm @@ -0,0 +1,62 @@ +# Copyright (C) 2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Apache2Handler.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin + +# Apache mod_perl handler. See http://perl.apache.org + +package Torrus::Apache2Handler; + +use strict; +use Apache2::Const -compile => qw(:common); + +use Torrus::CGI; + +sub handler : method +{ + my($class, $r) = @_; + + # Before torrus-1.0.9, Apache2 handler was designed + # for "SetHandler modperl". Now it should be used with perl-script + # handler only + + if( $r->handler() ne 'perl-script') + { + $r->content_type('text/plain'); + $r->print("Apache configuration must be changed.\n"); + $r->print("The current version ot Torrus is incompatible with "); + $r->print("\"SetHandler modperl\" statement.\n"); + $r->print("Change it to:\n"); + $r->print(" SetHandler perl-script\n"); + return Apache2::Const::OK; + } + + my $q = CGI->new($r); + Torrus::CGI->process( $q ); + + return Apache2::Const::OK; +} + + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ApacheHandler.pm b/torrus/perllib/Torrus/ApacheHandler.pm new file mode 100644 index 000000000..a1335793c --- /dev/null +++ b/torrus/perllib/Torrus/ApacheHandler.pm @@ -0,0 +1,46 @@ +# Copyright (C) 2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ApacheHandler.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $ +# Stanislav Sinyagin + +# Apache mod_perl handler. See http://perl.apache.org + +package Torrus::ApacheHandler; + +use strict; +use Apache; + +use Torrus::CGI; + +sub handler +{ + my $r = shift; + + my $q = CGI->new($r); + Torrus::CGI->process( $q ); + + return Apache::Constants::OK; +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/CGI.pm b/torrus/perllib/Torrus/CGI.pm new file mode 100644 index 000000000..574e87252 --- /dev/null +++ b/torrus/perllib/Torrus/CGI.pm @@ -0,0 +1,423 @@ +# Copyright (C) 2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CGI.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin + +# Universal CGI handler for Apache mod_perl and FastCGI + +package Torrus::CGI; + +use strict; +use CGI; +use IO::File; + +# This modue is not a part of mod_perl +use Apache::Session::File; + + +use Torrus::Log; +use Torrus::Renderer; +use Torrus::SiteConfig; +use Torrus::ACL; + +## Torrus::CGI->process($q) +## Expects a CGI object as input + +sub process +{ + my($class, $q) = @_; + + my $path_info = $q->url(-path => 1); + + # quickly give plaintext file contents + { + my $pos = index( $path_info, $Torrus::Renderer::plainURL ); + if( $pos >= 0 ) + { + my $fname = $Torrus::Global::webPlainDir . '/' . + substr( $path_info, + $pos + length($Torrus::Renderer::plainURL) ); + + my $ok = 0; + + my $type; + if( $path_info =~ /\.css$/o ) + { + $type = 'text/css'; + } + else + { + $type = 'text/html'; + } + + if( -r $fname ) + { + my $fh = new IO::File( $fname ); + if( defined( $fh ) ) + { + print $q->header('-type' => $type, + '-expires' => '+1h'); + + $fh->binmode(':raw'); + my $buffer; + while( $fh->read( $buffer, 65536 ) ) + { + print( $buffer ); + } + $fh->close(); + $ok = 1; + } + } + + if( not $ok ) + { + print $q->header(-status=>400), + $q->start_html('Error'), + $q->h2('Error'), + $q->strong('Cannot retrieve file: ' . $fname); + } + + return; + } + } + + my @paramNames = $q->param(); + + if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug ) + { + &Torrus::Log::setLevel('debug'); + } + + my %options = (); + foreach my $name ( @paramNames ) + { + if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' ) + { + $options{'variables'}->{$name} = $q->param($name); + } + } + + my( $fname, $mimetype, $expires ); + my @cookies; + + my $renderer = new Torrus::Renderer(); + if( not defined( $renderer ) ) + { + return report_error($q, 'Error initializing Renderer'); + } + + my $tree = $path_info; + $tree =~ s/^.*\/(.*)$/$1/; + + if( $Torrus::CGI::authorizeUsers ) + { + $options{'acl'} = new Torrus::ACL; + + my $hostauth = $q->param('hostauth'); + if( defined( $hostauth ) ) + { + my $uid = $q->remote_addr(); + $uid =~ s/\W/_/go; + my $password = $uid . '//' . $hostauth; + + Debug('Host-based authentication for ' . $uid); + + if( not $options{'acl'}->authenticateUser( $uid, $password ) ) + { + print $q->header(-status=>'403 Forbidden', + '-type' => 'text/plain'); + print('Host-based authentication failed for ' . $uid); + Info('Host-based authentication failed for ' . $uid); + return; + } + + Info('Host authenticated: ' . $uid); + $options{'uid'} = $uid; + } + else + { + + my $ses_id = $q->cookie('SESSION_ID'); + + my $needs_new_session = 1; + my %session; + + if( $ses_id ) + { + # create a session object based on the cookie we got from the + # browser, or a new session if we got no cookie + eval + { + tie %session, 'Apache::Session::File', $ses_id, { + Directory => $Torrus::Global::sesStoreDir, + LockDirectory => $Torrus::Global::sesLockDir } + }; + if( not $@ ) + { + if( $options{'variables'}->{'LOGOUT'} ) + { + tied( %session )->delete(); + } + else + { + $needs_new_session = 0; + } + } + } + + if( $needs_new_session ) + { + tie %session, 'Apache::Session::File', undef, { + Directory => $Torrus::Global::sesStoreDir, + LockDirectory => $Torrus::Global::sesLockDir }; + } + + # might be a new session, so lets give them their cookie back + + my %cookie = (-name => 'SESSION_ID', + -value => $session{'_session_id'}); + + if( $session{'uid'} ) + { + $options{'uid'} = $session{'uid'}; + if( $session{'remember_login'} ) + { + $cookie{'-expires'} = '+60d'; + } + } + else + { + my $needsLogin = 1; + + # POST form parameters + + my $uid = $q->param('uid'); + my $password = $q->param('password'); + if( defined( $uid ) and defined( $password ) ) + { + if( $options{'acl'}->authenticateUser( $uid, $password ) ) + { + $session{'uid'} = $options{'uid'} = $uid; + $needsLogin = 0; + Info('User logged in: ' . $uid); + + if( $q->param('remember') ) + { + $cookie{'-expires'} = '+60d'; + $session{'remember_login'} = 1; + } + } + else + { + $options{'authFailed'} = 1; + } + } + + if( $needsLogin ) + { + $options{'urlPassTree'} = $tree; + foreach my $param ( 'token', 'path', 'nodeid', + 'view', 'v' ) + { + my $val = $q->param( $param ); + if( defined( $val ) and length( $val ) > 0 ) + { + $options{'urlPassParams'}{$param} = $val; + } + } + + ( $fname, $mimetype, $expires ) = + $renderer->renderUserLogin( %options ); + + die('renderUserLogin returned undef') unless $fname; + } + } + untie %session; + + push(@cookies, $q->cookie(%cookie)); + } + } + + if( not $fname ) + { + if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) ) + { + ( $fname, $mimetype, $expires ) = + $renderer->renderTreeChooser( %options ); + } + else + { + if( $Torrus::CGI::authorizeUsers and + not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree, + 'DisplayTree' ) ) + { + return report_error($q, 'Permission denied'); + } + + if( $Torrus::Renderer::displayReports and + defined( $q->param('htmlreport') ) ) + { + if( $Torrus::CGI::authorizeUsers and + not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree, + 'DisplayReports' ) ) + { + return report_error($q, 'Permission denied'); + } + + my $reportfname = $q->param('htmlreport'); + # strip off leading slashes for security + $reportfname =~ s/^.*\///o; + + $fname = $Torrus::Global::reportsDir . '/' . $tree . + '/html/' . $reportfname; + if( not -f $fname ) + { + return report_error($q, 'No such file: ' . $reportfname); + } + + $mimetype = 'text/html'; + $expires = '3600'; + } + else + { + my $config_tree = new Torrus::ConfigTree( -TreeName => $tree ); + if( not defined($config_tree) ) + { + return report_error($q, 'Configuration is not ready'); + } + + my $token = $q->param('token'); + if( not defined($token) ) + { + my $path = $q->param('path'); + if( not defined($path) ) + { + my $nodeid = $q->param('nodeid'); + if( defined($nodeid) ) + { + $token = $config_tree->getNodeByNodeid( $nodeid ); + if( not defined($token) ) + { + return report_error + ($q, 'Cannot find nodeid:' . $nodeid); + } + } + else + { + $token = $config_tree->token('/'); + } + } + else + { + $token = $config_tree->token($path); + if( not defined($token) ) + { + return report_error($q, 'Invalid path'); + } + } + } + elsif( $token !~ /^S/ and + not defined( $config_tree->path( $token ) ) ) + { + return report_error($q, 'Invalid token'); + } + + my $view = $q->param('view'); + if( not defined($view) ) + { + $view = $q->param('v'); + } + + ( $fname, $mimetype, $expires ) = + $renderer->render( $config_tree, $token, $view, %options ); + + undef $config_tree; + } + } + } + + undef $renderer; + &Torrus::DB::cleanupEnvironment(); + + if( defined( $options{'acl'} ) ) + { + undef $options{'acl'}; + } + + if( defined($fname) ) + { + if( not -e $fname ) + { + return report_error($q, 'No such file or directory: ' . $fname); + } + + Debug("Render returned $fname $mimetype $expires"); + + my $fh = new IO::File( $fname ); + if( defined( $fh ) ) + { + print $q->header('-type' => $mimetype, + '-expires' => '+'.$expires.'s', + '-cookie' => \@cookies); + + $fh->binmode(':raw'); + my $buffer; + while( $fh->read( $buffer, 65536 ) ) + { + print( $buffer ); + } + $fh->close(); + } + else + { + return report_error($q, 'Cannot open file ' . $fname . ': ' . $!); + } + } + else + { + return report_error($q, "Renderer returned error.\n" . + "Probably wrong directory permissions or " . + "directory missing:\n" . + $Torrus::Global::cacheDir); + } + + if( not $Torrus::Renderer::globalDebug ) + { + &Torrus::Log::setLevel('info'); + } +} + + +sub report_error +{ + my $q = shift; + my $msg = shift; + + print $q->header('-type' => 'text/plain', + '-expires' => 'now'); + + print('Error: ' . $msg); +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector.pm b/torrus/perllib/Torrus/Collector.pm new file mode 100644 index 000000000..0789be05f --- /dev/null +++ b/torrus/perllib/Torrus/Collector.pm @@ -0,0 +1,695 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Collector.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::Collector; +@Torrus::Collector::ISA = qw(Torrus::Scheduler::PeriodicTask); + +use strict; +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::RPN; +use Torrus::Scheduler; + +BEGIN +{ + foreach my $mod ( @Torrus::Collector::loadModules ) + { + eval( 'require ' . $mod ); + die( $@ ) if $@; + } +} + +# Executed once after the fork. Here modules can launch processing threads +sub initThreads +{ + foreach my $key ( %Torrus::Collector::initThreadsHandlers ) + { + if( ref( $Torrus::Collector::initThreadsHandlers{$key} ) ) + { + &{$Torrus::Collector::initThreadsHandlers{$key}}(); + } + } +} + + +## One collector module instance holds all leaf tokens which +## must be collected at the same time. + +sub new +{ + my $proto = shift; + my %options = @_; + + if( not $options{'-Name'} ) + { + $options{'-Name'} = "Collector"; + } + + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new( %options ); + bless $self, $class; + + foreach my $collector_type ( keys %Torrus::Collector::collectorTypes ) + { + $self->{'types'}{$collector_type} = {}; + $self->{'types_in_use'}{$collector_type} = 0; + } + + foreach my $storage_type ( keys %Torrus::Collector::storageTypes ) + { + $self->{'storage'}{$storage_type} = {}; + $self->{'storage_in_use'}{$storage_type} = 0; + + my $storage_string = $storage_type . '-storage'; + if( ref( $Torrus::Collector::initStorage{$storage_string} ) ) + { + &{$Torrus::Collector::initStorage{$storage_string}}($self); + } + } + + $self->{'tree_name'} = $options{'-TreeName'}; + + return $self; +} + + +sub addTarget +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + my $ok = 1; + $self->{'targets'}{$token}{'path'} = $config_tree->path($token); + + my $collector_type = $config_tree->getNodeParam($token, 'collector-type'); + if( not $Torrus::Collector::collectorTypes{$collector_type} ) + { + Error('Unknown collector type: ' . $collector_type); + return; + } + + $self->fetchParams($config_tree, $token, $collector_type); + + $self->{'targets'}{$token}{'type'} = $collector_type; + $self->{'types_in_use'}{$collector_type} = 1; + + my $storage_types = $config_tree->getNodeParam($token, 'storage-type'); + foreach my $storage_type ( split( ',', $storage_types ) ) + { + if( not $Torrus::Collector::storageTypes{$storage_type} ) + { + Error('Unknown storage type: ' . $storage_type); + } + else + { + my $storage_string = $storage_type . '-storage'; + if( not exists( $self->{'targets'}{$token}{'storage-types'} ) ) + { + $self->{'targets'}{$token}{'storage-types'} = []; + } + push( @{$self->{'targets'}{$token}{'storage-types'}}, + $storage_type ); + + $self->fetchParams($config_tree, $token, $storage_string); + $self->{'storage_in_use'}{$storage_type} = 1; + } + } + + # If specified, store the value transformation code + my $code = $config_tree->getNodeParam($token, 'transform-value'); + if( defined $code ) + { + $self->{'targets'}{$token}{'transform'} = $code; + } + + # If specified, store the scale RPN + my $scalerpn = $config_tree->getNodeParam($token, 'collector-scale'); + if( defined $scalerpn ) + { + $self->{'targets'}{$token}{'scalerpn'} = $scalerpn; + } + + # If specified, store the value map + my $valueMap = $config_tree->getNodeParam($token, 'value-map'); + if( defined $valueMap and length($valueMap) > 0 ) + { + my $map = {}; + foreach my $item ( split( ',', $valueMap ) ) + { + my ($key, $value) = split( ':', $item ); + $map->{$key} = $value; + } + $self->{'targets'}{$token}{'value-map'} = $map; + } + + # Initialize local token, collectpor, and storage data + if( not defined $self->{'targets'}{$token}{'local'} ) + { + $self->{'targets'}{$token}{'local'} = {}; + } + + if( ref( $Torrus::Collector::initTarget{$collector_type} ) ) + { + $ok = &{$Torrus::Collector::initTarget{$collector_type}}($self, + $token); + } + + if( $ok ) + { + foreach my $storage_type + ( @{$self->{'targets'}{$token}{'storage-types'}} ) + { + my $storage_string = $storage_type . '-storage'; + if( ref( $Torrus::Collector::initTarget{$storage_string} ) ) + { + &{$Torrus::Collector::initTarget{$storage_string}}($self, + $token); + } + } + } + + if( not $ok ) + { + $self->deleteTarget( $token ); + } +} + + +sub fetchParams +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $type = shift; + + if( not defined( $Torrus::Collector::params{$type} ) ) + { + Error("\%Torrus::Collector::params does not have member $type"); + return; + } + + my $ref = \$self->{'targets'}{$token}{'params'}; + + my @maps = ( $Torrus::Collector::params{$type} ); + + while( scalar( @maps ) > 0 ) + { + &Torrus::DB::checkInterrupted(); + + my @next_maps = (); + foreach my $map ( @maps ) + { + foreach my $param ( keys %{$map} ) + { + my $value = $config_tree->getNodeParam( $token, $param ); + + if( ref( $map->{$param} ) ) + { + if( defined $value ) + { + if( exists $map->{$param}->{$value} ) + { + if( defined $map->{$param}->{$value} ) + { + push( @next_maps, + $map->{$param}->{$value} ); + } + } + else + { + Error("Parameter $param has unknown value: " . + $value . " in " . $self->path($token)); + } + } + } + else + { + if( not defined $value ) + { + # We know the default value + $value = $map->{$param}; + } + } + # Finally store the value + if( defined $value ) + { + $$ref->{$param} = $value; + } + } + } + @maps = @next_maps; + } +} + + +sub fetchMoreParams +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my @params = @_; + + &Torrus::DB::checkInterrupted(); + + my $ref = \$self->{'targets'}{$token}{'params'}; + + foreach my $param ( @params ) + { + my $value = $config_tree->getNodeParam( $token, $param ); + if( defined $value ) + { + $$ref->{$param} = $value; + } + } +} + + +sub param +{ + my $self = shift; + my $token = shift; + my $param = shift; + + return $self->{'targets'}{$token}{'params'}{$param}; +} + +sub setParam +{ + my $self = shift; + my $token = shift; + my $param = shift; + my $value = shift; + + $self->{'targets'}{$token}{'params'}{$param} = $value; +} + + +sub path +{ + my $self = shift; + my $token = shift; + + return $self->{'targets'}{$token}{'path'}; +} + +sub listCollectorTargets +{ + my $self = shift; + my $collector_type = shift; + + my @ret; + foreach my $token ( keys %{$self->{'targets'}} ) + { + if( $self->{'targets'}{$token}{'type'} eq $collector_type ) + { + push( @ret, $token ); + } + } + return @ret; +} + +# A callback procedure that will be executed on deleteTarget() + +sub registerDeleteCallback +{ + my $self = shift; + my $token = shift; + my $proc = shift; + + if( not ref( $self->{'targets'}{$token}{'deleteProc'} ) ) + { + $self->{'targets'}{$token}{'deleteProc'} = []; + } + push( @{$self->{'targets'}{$token}{'deleteProc'}}, $proc ); +} + +sub deleteTarget +{ + my $self = shift; + my $token = shift; + + &Torrus::DB::checkInterrupted(); + + Info('Deleting target: ' . $self->path($token)); + + if( ref( $self->{'targets'}{$token}{'deleteProc'} ) ) + { + foreach my $proc ( @{$self->{'targets'}{$token}{'deleteProc'}} ) + { + &{$proc}( $self, $token ); + } + } + delete $self->{'targets'}{$token}; +} + +# Returns a reference to token-specific local data + +sub tokenData +{ + my $self = shift; + my $token = shift; + + return $self->{'targets'}{$token}{'local'}; +} + +# Returns a reference to collector type-specific local data + +sub collectorData +{ + my $self = shift; + my $type = shift; + + return $self->{'types'}{$type}; +} + +# Returns a reference to storage type-specific local data + +sub storageData +{ + my $self = shift; + my $type = shift; + + return $self->{'storage'}{$type}; +} + + +# Runs each collector type, and then stores the values +sub run +{ + my $self = shift; + + undef $self->{'values'}; + + while( my ($collector_type, $ref) = each %{$self->{'types'}} ) + { + next unless $self->{'types_in_use'}{$collector_type}; + + &Torrus::DB::checkInterrupted(); + + if( $Torrus::Collector::needsConfigTree + {$collector_type}{'runCollector'} ) + { + $self->{'config_tree'} = + new Torrus::ConfigTree( -TreeName => $self->{'tree_name'}, + -Wait => 1 ); + } + + &{$Torrus::Collector::runCollector{$collector_type}}( $self, $ref ); + + if( defined( $self->{'config_tree'} ) ) + { + undef $self->{'config_tree'}; + } + } + + while( my ($storage_type, $ref) = each %{$self->{'storage'}} ) + { + next unless $self->{'storage_in_use'}{$storage_type}; + + &Torrus::DB::checkInterrupted(); + + if( $Torrus::Collector::needsConfigTree + {$storage_type}{'storeData'} ) + { + $self->{'config_tree'} = + new Torrus::ConfigTree( -TreeName => $self->{'tree_name'}, + -Wait => 1 ); + } + + &{$Torrus::Collector::storeData{$storage_type}}( $self, $ref ); + + if( defined( $self->{'config_tree'} ) ) + { + undef $self->{'config_tree'}; + } + } + + while( my ($collector_type, $ref) = each %{$self->{'types'}} ) + { + next unless $self->{'types_in_use'}{$collector_type}; + + if( ref( $Torrus::Collector::postProcess{$collector_type} ) ) + { + &Torrus::DB::checkInterrupted(); + + if( $Torrus::Collector::needsConfigTree + {$collector_type}{'postProcess'} ) + { + $self->{'config_tree'} = + new Torrus::ConfigTree( -TreeName => $self->{'tree_name'}, + -Wait => 1 ); + } + + &{$Torrus::Collector::postProcess{$collector_type}}( $self, $ref ); + + if( defined( $self->{'config_tree'} ) ) + { + undef $self->{'config_tree'}; + } + } + } +} + + +# This procedure is called by the collector type-specific functions +# every time there's a new value for a token +sub setValue +{ + my $self = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + my $uptime = shift; + + if( $value ne 'U' ) + { + if( defined( my $code = $self->{'targets'}{$token}{'transform'} ) ) + { + # Screen out the percent sign and $_ + $code =~ s/DOLLAR/\$/gm; + $code =~ s/MOD/\%/gm; + Debug('Value before transformation: ' . $value); + $_ = $value; + $value = do { eval $code }; + if( $@ ) + { + Error('Fatal error in transformation code: ' . $@ ); + $value = 'U'; + } + elsif( $value !~ /^[0-9.+-eE]+$/o and $value ne 'U' ) + { + Error('Non-numeric value after transformation: ' . $value); + $value = 'U'; + } + } + elsif( defined( my $map = $self->{'targets'}{$token}{'value-map'} ) ) + { + my $newValue; + if( defined( $map->{$value} ) ) + { + $newValue = $map->{$value}; + } + elsif( defined( $map->{'_'} ) ) + { + $newValue = $map->{'_'}; + } + else + { + Warn('Could not find value mapping for ' . $value . + 'in ' . $self->path($token)); + } + + if( defined( $newValue ) ) + { + Debug('Value mapping: ' . $value . ' -> ' . $newValue); + $value = $newValue; + } + } + + if( defined( $self->{'targets'}{$token}{'scalerpn'} ) ) + { + Debug('Value before scaling: ' . $value); + my $rpn = new Torrus::RPN; + $value = $rpn->run( $value . ',' . + $self->{'targets'}{$token}{'scalerpn'}, + sub{} ); + } + } + + if( isDebug() ) + { + Debug('Value ' . $value . ' set for ' . + $self->path($token) . ' TS=' . $timestamp); + } + + foreach my $storage_type + ( @{$self->{'targets'}{$token}{'storage-types'}} ) + { + &{$Torrus::Collector::setValue{$storage_type}}( $self, $token, + $value, $timestamp, + $uptime ); + } +} + + +sub configTree +{ + my $self = shift; + + if( defined( $self->{'config_tree'} ) ) + { + return $self->{'config_tree'}; + } + else + { + Error('Cannot provide ConfigTree object'); + return undef; + } +} + + +####### Collector scheduler ######## + +package Torrus::CollectorScheduler; +@Torrus::CollectorScheduler::ISA = qw(Torrus::Scheduler); + +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::Scheduler; +use Torrus::TimeStamp; + + +sub beforeRun +{ + my $self = shift; + + &Torrus::DB::checkInterrupted(); + + my $tree = $self->treeName(); + my $config_tree = new Torrus::ConfigTree(-TreeName => $tree, -Wait => 1); + if( not defined( $config_tree ) ) + { + return undef; + } + + my $data = $self->data(); + + my $instance = $self->{'options'}{'-Instance'}; + + # Prepare the list of tokens, sorted by period and offset, + # from config tree or from cache. + + my $need_new_tasks = 0; + + Torrus::TimeStamp::init(); + my $timestamp_key = $tree . ':' . $instance . ':collector_cache'; + my $known_ts = Torrus::TimeStamp::get( $timestamp_key ); + my $actual_ts = $config_tree->getTimestamp(); + + if( $actual_ts >= $known_ts or not $data->{'targets_initialized'} ) + { + Info('Initializing tasks for collector instance ' . $instance); + Debug("Config TS: $actual_ts, Collector TS: $known_ts"); + my $init_start = time(); + + my $targets = {}; + + my $db_tokens = + new Torrus::DB('collector_tokens' . '_' . $instance . '_' . + $config_tree->{'ds_config_instance'}, + -Subdir => $tree); + + my $cursor = $db_tokens->cursor(); + while( my ($token, $schedule) = $db_tokens->next($cursor) ) + { + my ($period, $offset) = split(/:/o, $schedule); + if( not exists( $targets->{$period}{$offset} ) ) + { + $targets->{$period}{$offset} = []; + } + push( @{$targets->{$period}{$offset}}, $token ); + + &Torrus::DB::checkInterrupted(); + } + undef $cursor; + $db_tokens->closeNow(); + undef $db_tokens; + + &Torrus::DB::checkInterrupted(); + + # Set the timestamp + &Torrus::TimeStamp::setNow( $timestamp_key ); + + $self->flushTasks(); + + foreach my $period ( keys %{$targets} ) + { + foreach my $offset ( keys %{$targets->{$period}} ) + { + my $collector = + new Torrus::Collector( -Period => $period, + -Offset => $offset, + -TreeName => $tree, + -Instance => $instance ); + + foreach my $token ( @{$targets->{$period}{$offset}} ) + { + &Torrus::DB::checkInterrupted(); + $collector->addTarget( $config_tree, $token ); + } + + $self->addTask( $collector ); + } + } + Verbose(sprintf("Tasks initialization finished in %d seconds", + time() - $init_start)); + + $data->{'targets_initialized'} = 1; + Info('Tasks for collector instance ' . $instance . ' initialized'); + + foreach my $collector_type ( keys %Torrus::Collector::collectorTypes ) + { + if( ref($Torrus::Collector::initCollectorGlobals{ + $collector_type}) ) + { + &{$Torrus::Collector::initCollectorGlobals{ + $collector_type}}($tree, $instance); + + Verbose('Initialized collector globals for type: ' . + $collector_type); + } + } + } + + Torrus::TimeStamp::release(); + + return 1; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector/CDef.pm b/torrus/perllib/Torrus/Collector/CDef.pm new file mode 100644 index 000000000..28dff8a9a --- /dev/null +++ b/torrus/perllib/Torrus/Collector/CDef.pm @@ -0,0 +1,120 @@ +# +# Copyright (C) 2004-2005 Christian Schnidrig +# Copyright (C) 2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# $Id: CDef.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $ +# Christian Schnidrig + + +# Torrus collector module for combining multiple datasources into one + +package Torrus::Collector::CDef; + +use strict; + +use Torrus::Collector::CDef_Params; +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::RPN; +use Torrus::DataAccess; +use Torrus::Collector::RRDStorage; + +# Register the collector type +$Torrus::Collector::collectorTypes{'cdef'} = 1; + +# List of needed parameters and default values +$Torrus::Collector::params{'cdef'} = \%Torrus::Collector::CDef_Params::params; +$Torrus::Collector::initTarget{'cdef'} = \&Torrus::Collector::CDef::initTarget; + + +# get access to the configTree; +$Torrus::Collector::needsConfigTree{'cdef'}{'runCollector'} = 1; + +sub initTarget +{ + my $collector = shift; + my $token = shift; + + my $cref = $collector->collectorData( 'cdef' ); + if( not defined( $cref->{'crefTokens'} ) ) + { + $cref->{'crefTokens'} = []; + } + + push( @{$cref->{'crefTokens'}}, $token ); + + return 1; +} + +# This is first executed per target +$Torrus::Collector::runCollector{'cdef'} = + \&Torrus::Collector::CDef::runCollector; + +sub runCollector +{ + my $collector = shift; + my $cref = shift; + my $config_tree = $collector->configTree(); + + my $now = time(); + my $da = new Torrus::DataAccess; + + # By default, try to get the data from one period behind + my $defaultAccessTime = $now - + ( $now % $collector->period() ) + $collector->offset(); + + foreach my $token ( @{$cref->{'crefTokens'}} ) + { + &Torrus::DB::checkInterrupted(); + + my $accessTime = $defaultAccessTime - + ( $collector->period() * + $collector->param( $token, 'cdef-collector-delay' ) ); + + # The RRDtool is non-reentrant, and we need to be careful + # when running multiple threads + Torrus::Collector::RRDStorage::semaphoreDown(); + + my ($value, $timestamp) = + $da->read_RPN( $config_tree, $token, + $collector->param( $token, 'rpn-expr' ), + $accessTime ); + + Torrus::Collector::RRDStorage::semaphoreUp(); + + if( defined( $value ) ) + { + if ( $timestamp < + ( $accessTime - + ( $collector->period() * + $collector->param( $token, 'cdef-collector-tolerance' )))) + { + Error( "CDEF: Data is " . ($accessTime-$timestamp) . + " seconds too old for " . $collector->path($token) ); + } + else + { + $collector->setValue( $token, $value, $timestamp ); + } + } + } +} + + + +1; + diff --git a/torrus/perllib/Torrus/Collector/CDef_Params.pm b/torrus/perllib/Torrus/Collector/CDef_Params.pm new file mode 100644 index 000000000..4bd84ba9d --- /dev/null +++ b/torrus/perllib/Torrus/Collector/CDef_Params.pm @@ -0,0 +1,69 @@ +# +# Copyright (C) 2004 Christian Schnidrig +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# $Id: CDef_Params.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $ +# Christian Schnidrig + + +# Parameter definitions for CDef collector plugin + +package Torrus::Collector::CDef_Params; + +use strict; + +### Initialize the configuration validator with module-specific parameters +our %params = + ( + 'rpn-expr' => undef, + 'cdef-collector-delay' => undef, + 'cdef-collector-tolerance' => undef, + ); + + +sub initValidatorLeafParams +{ + my $hashref = shift; + $hashref->{'ds-type'}{'collector'}{'collector-type'}{'cdef'} = + \%params; +} + + +my %admInfoParamCategories = + ( + 'cdef-collector-delay' => 'CDef_Collector', + 'cdef-collector-tolerance' => 'CDef_Collector', + ); + + +sub initAdmInfo +{ + my $map = shift; + my $categories = shift; + + $map->{'ds-type'}{'collector'}{'collector-type'}{'cdef'} = + \%params; + + while( my ($pname, $category) = each %admInfoParamCategories ) + { + $categories->{$pname} = $category; + } +} + + + +1; + diff --git a/torrus/perllib/Torrus/Collector/ExtDBI.pm b/torrus/perllib/Torrus/Collector/ExtDBI.pm new file mode 100644 index 000000000..7d1394191 --- /dev/null +++ b/torrus/perllib/Torrus/Collector/ExtDBI.pm @@ -0,0 +1,128 @@ +# Copyright (C) 2005 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ExtDBI.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $ +# Stanislav Sinyagin + +## Pluggable backend module for ExternalStorage +## Stores data in a generic SQL database + +# We use some internals of Torrus::SQL::SrvExport, but +# handle the SQL by ourselves, for better efficiency. + +package Torrus::Collector::ExtDBI; + +use strict; +use DBI; +use Date::Format; + +use Torrus::SQL::SrvExport; +use Torrus::Log; + +$Torrus::Collector::ExternalStorage::backendInit = + \&Torrus::Collector::ExtDBI::backendInit; + +$Torrus::Collector::ExternalStorage::backendOpenSession = + \&Torrus::Collector::ExtDBI::backendOpenSession; + +$Torrus::Collector::ExternalStorage::backendStoreData = + \&Torrus::Collector::ExtDBI::backendStoreData; + +$Torrus::Collector::ExternalStorage::backendCloseSession = + \&Torrus::Collector::ExtDBI::backendCloseSession; + + +# Optional SQL connection subtype, configurable from torrus-siteconfig.pl +our $subtype; + +my $dbh; +my $sth; + +sub backendInit +{ + my $collector = shift; + my $token = shift; +} + +sub backendOpenSession +{ + $dbh = Torrus::SQL::SrvExport->dbh( $subtype ); + + if( defined( $dbh ) ) + { + $sth = $dbh->prepare( Torrus::SQL::SrvExport->sqlInsertStatement() ); + if( not defined( $sth ) ) + { + Error('Error preparing the SQL statement: ' . $dbh->errstr); + } + } +} + + +sub backendStoreData +{ + my $timestamp = shift; + my $serviceid = shift; + my $value = shift; + my $interval = shift; + + if( defined( $dbh ) and defined( $sth ) ) + { + my $datestr = time2str('%Y-%m-%d', $timestamp); + my $timestr = time2str('%H:%M:%S', $timestamp); + if( isDebug() ) + { + Debug('Updating SQL database: ' . + join(', ', $datestr, $timestr, + $serviceid, $value, $interval )); + } + + if( $sth->execute( $datestr, $timestr, + $serviceid, $value, $interval ) ) + { + return 1; + } + else + { + Error('Error executing SQL: ' . $dbh->errstr); + } + } + + return undef; +} + + +sub backendCloseSession +{ + undef $sth; + if( defined( $dbh ) ) + { + $dbh->commit(); + $dbh->disconnect(); + undef $dbh; + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector/ExternalStorage.pm b/torrus/perllib/Torrus/Collector/ExternalStorage.pm new file mode 100644 index 000000000..1a876fa1d --- /dev/null +++ b/torrus/perllib/Torrus/Collector/ExternalStorage.pm @@ -0,0 +1,415 @@ +# Copyright (C) 2005 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ExternalStorage.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::Collector::ExternalStorage; + +use Torrus::ConfigTree; +use Torrus::Log; + +use strict; +use Math::BigInt; +use Math::BigFloat; + +# Pluggable backend module implements all storage-specific tasks +BEGIN +{ + eval( 'require ' . $Torrus::Collector::ExternalStorage::backend ); + die( $@ ) if $@; +} + +# These variables must be set by the backend module +our $backendInit; +our $backendOpenSession; +our $backendStoreData; +our $backendCloseSession; + +# Register the storage type +$Torrus::Collector::storageTypes{'ext'} = 1; + + +# List of needed parameters and default values + +$Torrus::Collector::params{'ext-storage'} = { + 'ext-dstype' => { + 'GAUGE' => undef, + 'COUNTER32' => { + 'ext-counter-max' => undef}, + 'COUNTER64' => { + 'ext-counter-max' => undef}}, + 'ext-service-id' => undef + }; + + + + +$Torrus::Collector::initTarget{'ext-storage'} = + \&Torrus::Collector::ExternalStorage::initTarget; + +sub initTarget +{ + my $collector = shift; + my $token = shift; + + my $sref = $collector->storageData( 'ext' ); + + $collector->registerDeleteCallback + ( $token, \&Torrus::Collector::ExternalStorage::deleteTarget ); + + my $serviceid = + $collector->param($token, 'ext-service-id'); + + if( defined( $sref->{'serviceid'}{$serviceid} ) ) + { + Error('ext-service-id is not unique: "' . $serviceid . + '". External storage is not activated for ' . + $collector->path($token)); + return; + } + + $sref->{'serviceid'}{$serviceid} = 1; + + my $processor; + my $dstype = $collector->param($token, 'ext-dstype'); + if( $dstype eq 'GAUGE' ) + { + $processor = \&Torrus::Collector::ExternalStorage::processGauge; + } + else + { + if( $dstype eq 'COUNTER32' ) + { + $processor = + \&Torrus::Collector::ExternalStorage::processCounter32; + } + else + { + $processor = + \&Torrus::Collector::ExternalStorage::processCounter64; + } + + my $max = $collector->param( $token, 'ext-counter-max' ); + if( defined( $max ) ) + { + $sref->{'max'}{$token} = Math::BigFloat->new($max); + } + } + + $sref->{'tokens'}{$token} = $processor; + + &{$backendInit}( $collector, $token ); +} + + + +$Torrus::Collector::setValue{'ext'} = + \&Torrus::Collector::ExternalStorage::setValue; + + +sub setValue +{ + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + + my $sref = $collector->storageData( 'ext' ); + + my $prevTimestamp = $sref->{'prevTimestamp'}{$token}; + if( not defined( $prevTimestamp ) ) + { + $prevTimestamp = $timestamp; + } + + my $procvalue = + &{$sref->{'tokens'}{$token}}( $collector, $token, $value, $timestamp ); + if( defined( $procvalue ) ) + { + if( ref( $procvalue ) ) + { + # Convert a BigFloat into a scientific notation string + $procvalue = $procvalue->bsstr(); + } + $sref->{'values'}{$token} = + [$procvalue, $timestamp, $timestamp - $prevTimestamp]; + } + + $sref->{'prevTimestamp'}{$token} = $timestamp; +} + + +sub processGauge +{ + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + + return $value; +} + + +sub processCounter32 +{ + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + + return processCounter( 32, $collector, $token, $value, $timestamp ); +} + +sub processCounter64 +{ + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + + return processCounter( 64, $collector, $token, $value, $timestamp ); +} + +my $base32 = Math::BigInt->new(2)->bpow(32); +my $base64 = Math::BigInt->new(2)->bpow(64); + +sub processCounter +{ + my $base = shift; + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + + my $sref = $collector->storageData( 'ext' ); + + if( isDebug() ) + { + Debug('ExternalStorage::processCounter: token=' . $token . + ' value=' . $value . ' timestamp=' . $timestamp); + } + + if( $value eq 'U' ) + { + # the agent rebooted, so we flush the counter + delete $sref->{'prevCounter'}{$token}; + return undef; + } + + $value = Math::BigInt->new( $value ); + my $ret; + + if( exists( $sref->{'prevCounter'}{$token} ) ) + { + my $prevValue = $sref->{'prevCounter'}{$token}; + my $prevTimestamp = $sref->{'prevTimestamp'}{$token}; + if( isDebug() ) + { + Debug('ExternalStorage::processCounter: prevValue=' . $prevValue . + ' prevTimestamp=' . $prevTimestamp); + } + + if( $prevValue->bcmp( $value ) > 0 ) # previous is bigger + { + $ret = Math::BigFloat->new($base==32 ? $base32:$base64); + $ret->bsub( $prevValue ); + $ret->badd( $value ); + } + else + { + $ret = Math::BigFloat->new( $value ); + $ret->bsub( $prevValue ); + } + $ret->bdiv( $timestamp - $prevTimestamp ); + if( defined( $sref->{'max'}{$token} ) ) + { + if( $ret->bcmp( $sref->{'max'}{$token} ) > 0 ) + { + Debug('Resulting counter rate is above the maximum'); + $ret = undef; + } + } + } + + $sref->{'prevCounter'}{$token} = $value; + + if( defined( $ret ) and isDebug() ) + { + Debug('ExternalStorage::processCounter: Resulting value=' . $ret); + } + return $ret; +} + + + +$Torrus::Collector::storeData{'ext'} = + \&Torrus::Collector::ExternalStorage::storeData; + +# timestamp of last unavailable storage +my $storageUnavailable = 0; + +# Last time we tried to reach it +my $storageLastTry = 0; + +# how often we retry - configurable in torrus-config.pl +our $unavailableRetry; + +# maximum age for backlog in case of unavailable storage. +# We stop recording new data when maxage is reached. +our $backlogMaxAge; + +sub storeData +{ + my $collector = shift; + my $sref = shift; + + &Torrus::DB::checkInterrupted(); + + my $nTokens = scalar( keys %{$sref->{'values'}} ); + + if( $nTokens == 0 ) + { + return; + } + + Verbose('Exporting data to external storage for ' . + $nTokens . ' tokens'); + &{$backendOpenSession}(); + + while( my($token, $valuetriple) = each( %{$sref->{'values'}} ) ) + { + &Torrus::DB::checkInterrupted(); + + my( $value, $timestamp, $interval ) = @{$valuetriple}; + my $serviceid = + $collector->param($token, 'ext-service-id'); + + my $toBacklog = 0; + + if( $storageUnavailable > 0 and + time() < $storageLastTry + $unavailableRetry ) + { + $toBacklog = 1; + } + else + { + $storageUnavailable = 0; + $storageLastTry = time(); + + if( exists( $sref->{'backlog'} ) ) + { + # Try to flush the backlog first + Verbose('Trying to flush the backlog'); + + my $ok = 1; + while( scalar(@{$sref->{'backlog'}}) > 0 and $ok ) + { + my $quarter = shift @{$sref->{'backlog'}}; + if( not &{$backendStoreData}( @{$quarter} ) ) + { + Warn('Unable to flush the backlog, external ' . + 'storage is unavailable'); + + unshift( @{$sref->{'backlog'}}, $quarter ); + $ok = 0; + $toBacklog = 1; + } + } + if( $ok ) + { + delete( $sref->{'backlog'} ); + Verbose('Backlog is successfully flushed'); + } + } + + if( not $toBacklog ) + { + if( not &{$backendStoreData}( $timestamp, $serviceid, + $value, $interval ) ) + { + Warn('Unable to store data, external storage is ' . + 'unavailable. Saving data to backlog'); + + $toBacklog = 1; + } + } + } + + if( $toBacklog ) + { + if( $storageUnavailable == 0 ) + { + $storageUnavailable = time(); + } + + if( not exists( $sref->{'backlog'} ) ) + { + $sref->{'backlog'} = []; + $sref->{'backlogStart'} = time(); + } + + if( time() < $sref->{'backlogStart'} + $backlogMaxAge ) + { + push( @{$sref->{'backlog'}}, + [ $timestamp, $serviceid, $value, $interval ] ); + } + else + { + Error('Backlog has reached its maximum age, stopped storing ' . + 'any more data'); + } + } + } + + undef $sref->{'values'}; + &{$backendCloseSession}(); +} + + + + + +# Callback executed by Collector + +sub deleteTarget +{ + my $collector = shift; + my $token = shift; + + my $sref = $collector->storageData( 'ext' ); + + my $serviceid = + $collector->param($token, 'ext-service-id'); + delete $sref->{'serviceid'}{$serviceid}; + + if( defined( $sref->{'prevCounter'}{$token} ) ) + { + delete $sref->{'prevCounter'}{$token}; + } + + delete $sref->{'tokens'}{$token}; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector/RRDStorage.pm b/torrus/perllib/Torrus/Collector/RRDStorage.pm new file mode 100644 index 000000000..7f806fac2 --- /dev/null +++ b/torrus/perllib/Torrus/Collector/RRDStorage.pm @@ -0,0 +1,584 @@ +# Copyright (C) 2002-2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: RRDStorage.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::Collector::RRDStorage; + +use Torrus::ConfigTree; +use Torrus::Log; + +use strict; +use RRDs; + +our $useThreads; +our $threadsInUse = 0; +our $thrQueueLimit; +our $thrUpdateQueue; +our $thrErrorsQueue; +# RRDtool is not reentrant. use this semaphore for every call to RRDs::* +our $rrdtoolSemaphore; +our $thrUpdateThread; + +our $moveConflictRRD; +our $conflictRRDPath; + +# Register the storage type +$Torrus::Collector::storageTypes{'rrd'} = 1; + + +# List of needed parameters and default values + +$Torrus::Collector::params{'rrd-storage'} = { + 'data-dir' => undef, + 'data-file' => undef, + 'rrd-create-rra' => undef, + 'rrd-create-heartbeat' => undef, + 'rrd-create-min' => 'U', + 'rrd-create-max' => 'U', + 'rrd-hwpredict' => { + 'enabled' => { + 'rrd-create-hw-alpha' => 0.1, + 'rrd-create-hw-beta' => 0.0035, + 'rrd-create-hw-gamma' => 0.1, + 'rrd-create-hw-winlen' => 9, + 'rrd-create-hw-failth' => 6, + 'rrd-create-hw-season' => 288, + 'rrd-create-hw-rralen' => undef }, + 'disabled' => undef }, + 'rrd-create-dstype' => undef, + 'rrd-ds' => undef + }; + + +$Torrus::Collector::initThreadsHandlers{'rrd-storage'} = + \&Torrus::Collector::RRDStorage::initThreads; + +sub initThreads +{ + if( $useThreads and not defined( $thrUpdateThread ) ) + { + Verbose('RRD storage is configured for multithreading. Initializing ' . + 'the background thread'); + require threads; + require threads::shared; + require Thread::Queue; + require Thread::Semaphore; + + $thrUpdateQueue = new Thread::Queue; + $thrErrorsQueue = new Thread::Queue; + $rrdtoolSemaphore = new Thread::Semaphore; + + $thrUpdateThread = threads->create( \&rrdUpdateThread ); + $thrUpdateThread->detach(); + $threadsInUse = 1; + } +} + + + +$Torrus::Collector::initTarget{'rrd-storage'} = + \&Torrus::Collector::RRDStorage::initTarget; + +sub initTarget +{ + my $collector = shift; + my $token = shift; + + my $sref = $collector->storageData( 'rrd' ); + + $collector->registerDeleteCallback + ( $token, \&Torrus::Collector::RRDStorage::deleteTarget ); + + my $filename = + $collector->param($token, 'data-dir') . '/' . + $collector->param($token, 'data-file'); + + $sref->{'byfile'}{$filename}{$token} = 1; + $sref->{'filename'}{$token} = $filename; +} + + + +$Torrus::Collector::setValue{'rrd'} = + \&Torrus::Collector::RRDStorage::setValue; + + +sub setValue +{ + my $collector = shift; + my $token = shift; + my $value = shift; + my $timestamp = shift; + my $uptime = shift; + + my $sref = $collector->storageData( 'rrd' ); + + $sref->{'values'}{$token} = [$value, $timestamp, $uptime]; +} + + +$Torrus::Collector::storeData{'rrd'} = + \&Torrus::Collector::RRDStorage::storeData; + +sub storeData +{ + my $collector = shift; + my $sref = shift; + + if( $threadsInUse ) + { + $collector->setStatValue( 'RRDQueue', $thrUpdateQueue->pending() ); + } + + if( $threadsInUse and $thrUpdateQueue->pending() > $thrQueueLimit ) + { + Error('Cannot enqueue RRD files for updating: ' . + 'queue size is above limit'); + } + else + { + while( my ($filename, $tokens) = each %{$sref->{'byfile'}} ) + { + &Torrus::DB::checkInterrupted(); + + if( not -e $filename ) + { + createRRD( $collector, $sref, $filename, $tokens ); + } + + if( -e $filename ) + { + updateRRD( $collector, $sref, $filename, $tokens ); + } + } + } + + delete $sref->{'values'}; +} + + +sub semaphoreDown +{ + if( $threadsInUse ) + { + $rrdtoolSemaphore->down(); + } +} + +sub semaphoreUp +{ + if( $threadsInUse ) + { + $rrdtoolSemaphore->up(); + } +} + + +sub createRRD +{ + my $collector = shift; + my $sref = shift; + my $filename = shift; + my $tokens = shift; + + # We use hashes here, in order to make the superset of RRA + # definitions, and unique RRD names + my %DS_hash; + my %RRA_hash; + + # Holt-Winters parameters + my $needs_hw = 0; + my %hwparam; + + my $timestamp = time(); + + foreach my $token ( keys %{$tokens} ) + { + my $ds_string = + sprintf('DS:%s:%s:%d:%s:%s', + $collector->param($token, 'rrd-ds'), + $collector->param($token, 'rrd-create-dstype'), + $collector->param($token, 'rrd-create-heartbeat'), + $collector->param($token, 'rrd-create-min'), + $collector->param($token, 'rrd-create-max')); + $DS_hash{$ds_string} = 1; + + foreach my $rra_string + ( split(/\s+/, $collector->param($token, 'rrd-create-rra')) ) + { + $RRA_hash{$rra_string} = 1; + } + + if( $collector->param($token, 'rrd-hwpredict') eq 'enabled' ) + { + $needs_hw = 1; + + foreach my $param ( 'alpha', 'beta', 'gamma', 'winlen', 'failth', + 'season', 'rralen' ) + { + my $value = $collector->param($token, 'rrd-create-hw-'.$param); + + if( defined( $hwparam{$param} ) and + $hwparam{$param} != $value ) + { + my $paramname = 'rrd-create-hw-'.$param; + Warn("Parameter " . $paramname . " was already defined " . + "with differentr value for " . $filename); + } + + $hwparam{$param} = $value; + } + } + + if( ref $sref->{'values'}{$token} ) + { + my $new_ts = $sref->{'values'}{$token}[1]; + if( $new_ts > 0 and $new_ts < $timestamp ) + { + $timestamp = $new_ts; + } + } + } + + my @DS = sort keys %DS_hash; + my @RRA = sort keys %RRA_hash; + + if( $needs_hw ) + { + ## Define the RRAs for Holt-Winters prediction + + my $hwpredict_rran = scalar(@RRA) + 1; + my $seasonal_rran = $hwpredict_rran + 1; + my $devseasonal_rran = $hwpredict_rran + 2; + my $devpredict_rran = $hwpredict_rran + 3; + my $failures_rran = $hwpredict_rran + 4; + + push( @RRA, sprintf('RRA:HWPREDICT:%d:%e:%e:%d:%d', + $hwparam{'rralen'}, + $hwparam{'alpha'}, + $hwparam{'beta'}, + $hwparam{'season'}, + $seasonal_rran)); + + push( @RRA, sprintf('RRA:SEASONAL:%d:%e:%d', + $hwparam{'season'}, + $hwparam{'gamma'}, + $hwpredict_rran)); + + push( @RRA, sprintf('RRA:DEVSEASONAL:%d:%e:%d', + $hwparam{'season'}, + $hwparam{'gamma'}, + $hwpredict_rran)); + + push( @RRA, sprintf('RRA:DEVPREDICT:%d:%d', + $hwparam{'rralen'}, + $devseasonal_rran)); + + push( @RRA, sprintf('RRA:FAILURES:%d:%d:%d:%d', + $hwparam{'rralen'}, + $hwparam{'failth'}, + $hwparam{'winlen'}, + $devseasonal_rran)); + } + + my $step = $collector->period(); + my $start = $timestamp - $step; + + my @OPT = ( sprintf( '--start=%d', $start ), + sprintf( '--step=%d', $step ) ); + + &Torrus::DB::checkInterrupted(); + + Debug("Creating RRD $filename: " . join(" ", @OPT, @DS, @RRA)); + + semaphoreDown(); + + RRDs::create($filename, + @OPT, + @DS, + @RRA); + + my $err = RRDs::error(); + + semaphoreUp(); + + Error("ERROR creating $filename: $err") if $err; + + delete $sref->{'rrdinfo_ds'}{$filename}; +} + + +sub updateRRD +{ + my $collector = shift; + my $sref = shift; + my $filename = shift; + my $tokens = shift; + + if( not defined( $sref->{'rrdinfo_ds'}{$filename} ) ) + { + my $ref = {}; + $sref->{'rrdinfo_ds'}{$filename} = $ref; + + semaphoreDown(); + + my $rrdinfo = RRDs::info( $filename ); + + semaphoreUp(); + + foreach my $prop ( keys %$rrdinfo ) + { + if( $prop =~ /^ds\[(\S+)\]\./o ) + { + $ref->{$1} = 1; + } + } + + &Torrus::DB::checkInterrupted(); + } + + # First we compare the sets of datasources in our memory and in RRD file + my %ds_updating = (); + my $ds_conflict = 0; + + foreach my $token ( keys %{$tokens} ) + { + $ds_updating{ $collector->param($token, 'rrd-ds') } = $token; + } + + # Check if we update all datasources in RRD file + foreach my $ds ( keys %{$sref->{'rrdinfo_ds'}{$filename}} ) + { + if( not $ds_updating{$ds} ) + { + Warn('Datasource exists in RRD file, but it is not updated: ' . + $ds . ' in ' . $filename); + $ds_conflict = 1; + } + } + + # Check if all DS that we update are defined in RRD + foreach my $ds ( keys %ds_updating ) + { + if( not $sref->{'rrdinfo_ds'}{$filename}{$ds} ) + { + Error("Datasource being updated does not exist: $ds in $filename"); + delete $ds_updating{$ds}; + $ds_conflict = 1; + } + } + + if( $ds_conflict and $moveConflictRRD ) + { + if( not -f $filename ) + { + Error($filename . 'is not a regular file'); + return; + } + + my( $sec, $min, $hour, $mday, $mon, $year) = localtime( time() ); + my $destfile = sprintf('%s_%04d%02d%02d%02d%02d', + $filename, + $year + 1900, $mon+1, $mday, $hour, $min); + + my $destdir = $conflictRRDPath; + if( defined( $destdir ) and -d $destdir ) + { + my @fpath = split('/', $destfile); + my $fname = pop( @fpath ); + $destfile = $destdir . '/' . $fname; + } + + Warn('Moving the conflicted RRD file ' . $filename . + ' to ' . $destfile); + rename( $filename, $destfile ) or + Error("Cannot rename $filename to $destfile: $!"); + + delete $sref->{'rrdinfo_ds'}{$filename}; + + createRRD( $collector, $sref, $filename, $tokens ); + } + + if( scalar( keys %ds_updating ) == 0 ) + { + Error("No datasources to update in $filename"); + return; + } + + &Torrus::DB::checkInterrupted(); + + # Build the arguments for RRDs::update. + my $template; + my $values; + + # We will use the average timestamp + my @timestamps; + my $max_ts = 0; + my $min_ts = time(); + + my $step = $collector->period(); + + foreach my $ds ( keys %ds_updating ) + { + my $token = $ds_updating{$ds}; + if( length($template) > 0 ) + { + $template .= ':'; + } + $template .= $ds; + + my $now = time(); + my ( $value, $timestamp, $uptime ) = ( 'U', $now, $now ); + if( ref $sref->{'values'}{$token} ) + { + ($value, $timestamp, $uptime) = @{$sref->{'values'}{$token}}; + } + + push( @timestamps, $timestamp ); + if( $timestamp > $max_ts ) + { + $max_ts = $timestamp; + } + if( $timestamp < $min_ts ) + { + $min_ts = $timestamp; + } + + # The plus sign generated by BigInt is not a problem for rrdtool + $values .= ':'. $value; + } + + # Get the average timestamp + my $sum = 0; + map {$sum += $_} @timestamps; + my $avg_ts = $sum / scalar( @timestamps ); + + if( ($max_ts - $avg_ts) > $Torrus::Global::RRDTimestampTolerance ) + { + Error("Maximum timestamp value is beyond the tolerance in $filename"); + } + if( ($avg_ts - $min_ts) > $Torrus::Global::RRDTimestampTolerance ) + { + Error("Minimum timestamp value is beyond the tolerance in $filename"); + } + + my @cmd = ( "--template=" . $template, + sprintf("%d%s", $avg_ts, $values) ); + + &Torrus::DB::checkInterrupted(); + + if( $threadsInUse ) + { + # Process errors from RRD update thread + my $errfilename; + while( defined( $errfilename = $thrErrorsQueue->dequeue_nb() ) ) + { + delete $sref->{'rrdinfo_ds'}{$errfilename}; + } + + Debug('Enqueueing update job for ' . $filename); + + my $cmdlist = &threads::shared::share([]); + push( @{$cmdlist}, $filename, @cmd ); + $thrUpdateQueue->enqueue( $cmdlist ); + } + else + { + if( isDebug ) + { + Debug("Updating $filename: " . join(' ', @cmd)); + } + RRDs::update( $filename, @cmd ); + my $err = RRDs::error(); + if( $err ) + { + Error("ERROR updating $filename: $err"); + delete $sref->{'rrdinfo_ds'}{$filename}; + } + } +} + + +# A background thread that updates RRD files +sub rrdUpdateThread +{ + &Torrus::DB::setSafeSignalHandlers(); + $| = 1; + &Torrus::Log::setTID( threads->tid() ); + + my $cmdlist; + &threads::shared::share( \$cmdlist ); + + while(1) + { + &Torrus::DB::checkInterrupted(); + + $cmdlist = $thrUpdateQueue->dequeue(); + + if( isDebug ) + { + Debug("Updating RRD: " . join(' ', @{$cmdlist})); + } + + $rrdtoolSemaphore->down(); + + RRDs::update( @{$cmdlist} ); + my $err = RRDs::error(); + + $rrdtoolSemaphore->up(); + + if( $err ) + { + Error('ERROR updating' . $cmdlist->[0] . ': ' . $err); + $thrErrorsQueue->enqueue( $cmdlist->[0] ); + } + } +} + + + +# Callback executed by Collector + +sub deleteTarget +{ + my $collector = shift; + my $token = shift; + + my $sref = $collector->storageData( 'rrd' ); + my $filename = $sref->{'filename'}{$token}; + + delete $sref->{'filename'}{$token}; + + delete $sref->{'byfile'}{$filename}{$token}; + if( scalar( keys %{$sref->{'byfile'}{$filename}} ) == 0 ) + { + delete $sref->{'byfile'}{$filename}; + } + + delete $sref->{'values'}{$token}; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector/SNMP.pm b/torrus/perllib/Torrus/Collector/SNMP.pm new file mode 100644 index 000000000..5d3d8cdc0 --- /dev/null +++ b/torrus/perllib/Torrus/Collector/SNMP.pm @@ -0,0 +1,1261 @@ +# Copyright (C) 2002-2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: SNMP.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::Collector::SNMP; + +use Torrus::Collector::SNMP_Params; +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::SNMP_Failures; + +use strict; +use Net::hostent; +use Socket; +use Net::SNMP qw(:snmp); +use Math::BigInt; + + +# Register the collector type +$Torrus::Collector::collectorTypes{'snmp'} = 1; + + +# List of needed parameters and default values + +$Torrus::Collector::params{'snmp'} = { + 'snmp-ipversion' => undef, + 'snmp-transport' => undef, + 'snmp-version' => undef, + 'snmp-port' => undef, + 'snmp-community' => undef, + 'snmp-username' => undef, + 'snmp-authkey' => undef, + 'snmp-authpassword' => undef, + 'snmp-authprotocol' => 'md5', + 'snmp-privkey' => undef, + 'snmp-privpassword' => undef, + 'snmp-privprotocol' => 'des', + 'snmp-timeout' => undef, + 'snmp-retries' => undef, + 'domain-name' => undef, + 'snmp-host' => undef, + 'snmp-localaddr' => undef, + 'snmp-localport' => undef, + 'snmp-object' => undef, + 'snmp-oids-per-pdu' => undef, + 'snmp-object-type' => 'OTHER', + 'snmp-check-sysuptime' => 'yes', + 'snmp-max-msg-size' => undef, + 'snmp-ignore-mib-errors' => undef, + }; + +my $sysUpTime = '1.3.6.1.2.1.1.3.0'; + +# Hosts that are running SNMPv1. We do not reresh maps on them, as +# they are too slow +my %snmpV1Hosts; + +# SNMP tables lookup maps +my %maps; + +# Old lookup maps, used temporarily during refresh cycle +my %oldMaps; + +# How frequent we refresh the SNMP mapping +our $mapsRefreshPeriod; + +# Random factor in refresh period +our $mapsRefreshRandom; + +# Time period after configuration re-compile when we refresh existing mappings +our $mapsUpdateInterval; + +# how often we check for expired maps +our $mapsExpireCheckPeriod; + +# expiration time for each map +my %mapsExpire; + +# Lookups scheduled for execution +my %mapLookupScheduled; + +# SNMP session objects for map lookups +my @mappingSessions; + + +# Timestamps of hosts last found unreachable +my %hostUnreachableSeen; + +# Last time we tried to reach an unreachable host +my %hostUnreachableRetry; + +# Hosts that were deleted because of unreachability for too long +my %unreachableHostDeleted; + + +our $db_failures; + +# Flush stats after a restart or recompile +$Torrus::Collector::initCollectorGlobals{'snmp'} = + \&Torrus::Collector::SNMP::initCollectorGlobals; + +sub initCollectorGlobals +{ + my $tree = shift; + my $instance = shift; + + if( not defined( $db_failures ) ) + { + $db_failures = + new Torrus::SNMP_Failures( -Tree => $tree, + -Instance => $instance, + -WriteAccess => 1 ); + } + + if( defined( $db_failures ) ) + { + $db_failures->init(); + } + + # re-init counters and collect garbage + %oldMaps = (); + %hostUnreachableSeen = (); + %hostUnreachableRetry = (); + %unreachableHostDeleted = (); + + # Configuration re-compile was probably caused by new object instances + # appearing on the monitored devices. Here we force the maps to refresh + # soon enough in order to catch up with the changes + + my $now = time(); + foreach my $maphash ( keys %mapsExpire ) + { + $mapsExpire{$maphash} = int( $now + rand( $mapsUpdateInterval ) ); + } +} + + +# This is first executed per target + +$Torrus::Collector::initTarget{'snmp'} = \&Torrus::Collector::SNMP::initTarget; + + + +sub initTarget +{ + my $collector = shift; + my $token = shift; + + my $tref = $collector->tokenData( $token ); + my $cref = $collector->collectorData( 'snmp' ); + + $collector->registerDeleteCallback + ( $token, \&Torrus::Collector::SNMP::deleteTarget ); + + my $hostname = getHostname( $collector, $token ); + if( not defined( $hostname ) ) + { + return 0; + } + + $tref->{'hostname'} = $hostname; + + return Torrus::Collector::SNMP::initTargetAttributes( $collector, $token ); +} + + +sub initTargetAttributes +{ + my $collector = shift; + my $token = shift; + + &Torrus::DB::checkInterrupted(); + + my $tref = $collector->tokenData( $token ); + my $cref = $collector->collectorData( 'snmp' ); + + my $hostname = $tref->{'hostname'}; + my $port = $collector->param($token, 'snmp-port'); + my $version = $collector->param($token, 'snmp-version'); + + my $community; + if( $version eq '1' or $version eq '2c' ) + { + $community = $collector->param($token, 'snmp-community'); + } + else + { + # We use community string to identify the agent. + # For SNMPv3, it's the user name + $community = $collector->param($token, 'snmp-username'); + } + + my $hosthash = join('|', $hostname, $port, $community); + $tref->{'hosthash'} = $hosthash; + + if( $version eq '1' ) + { + $snmpV1Hosts{$hosthash} = 1; + } + + # If the object is defined as a map, retrieve the whole map + # and cache it. + + if( isHostDead( $collector, $hosthash ) ) + { + return 0; + } + + if( not checkUnreachableRetry( $collector, $hosthash ) ) + { + $cref->{'needsRemapping'}{$token} = 1; + return 1; + } + + my $oid = $collector->param($token, 'snmp-object'); + $oid = expandOidMappings( $collector, $token, $hosthash, $oid ); + + if( not $oid ) + { + if( $unreachableHostDeleted{$hosthash} ) + { + # we tried our best, but the target is dead + return 0; + } + else + { + # we return OK status, to let the storage initiate + $cref->{'needsRemapping'}{$token} = 1; + return 1; + } + } + elsif( $oid eq 'notfound' ) + { + return 0; + } + + # Collector should be able to find the target + # by host, port, community, and oid. + # There can be several targets with the same host|port|community+oid set. + + $cref->{'targets'}{$hosthash}{$oid}{$token} = 1; + $cref->{'activehosts'}{$hosthash} = 1; + + $tref->{'oid'} = $oid; + + $cref->{'oids_per_pdu'}{$hosthash} = + $collector->param($token, 'snmp-oids-per-pdu'); + + if( $collector->param($token, 'snmp-object-type') eq 'COUNTER64' ) + { + $cref->{'64bit_oid'}{$oid} = 1; + } + + if( $collector->param($token, 'snmp-check-sysuptime') eq 'no' ) + { + $cref->{'nosysuptime'}{$hosthash} = 1; + } + + if( $collector->param($token, 'snmp-ignore-mib-errors') eq 'yes' ) + { + $cref->{'ignoremiberrors'}{$hosthash}{$oid} = 1; + } + + return 1; +} + + +sub getHostname +{ + my $collector = shift; + my $token = shift; + + my $cref = $collector->collectorData( 'snmp' ); + + my $hostname = $collector->param($token, 'snmp-host'); + my $domain = $collector->param($token, 'domain-name'); + + if( length( $domain ) > 0 and + index($hostname, '.') < 0 and + index($hostname, ':') < 0 ) + { + $hostname .= '.' . $domain; + } + + return $hostname; +} + + +sub snmpSessionArgs +{ + my $collector = shift; + my $token = shift; + my $hosthash = shift; + + my $cref = $collector->collectorData( 'snmp' ); + if( defined( $cref->{'snmpargs'}{$hosthash} ) ) + { + return $cref->{'snmpargs'}{$hosthash}; + } + + my $transport = $collector->param($token, 'snmp-transport') . '/ipv' . + $collector->param($token, 'snmp-ipversion'); + + my ($hostname, $port, $community) = split(/\|/o, $hosthash); + + my $version = $collector->param($token, 'snmp-version'); + my $ret = [ -domain => $transport, + -hostname => $hostname, + -port => $port, + -timeout => $collector->param($token, 'snmp-timeout'), + -retries => $collector->param($token, 'snmp-retries'), + -version => $version ]; + + foreach my $arg ( qw(-localaddr -localport) ) + { + if( defined( $collector->param($token, 'snmp' . $arg) ) ) + { + push( @{$ret}, $arg, $collector->param($token, 'snmp' . $arg) ); + } + } + + if( $version eq '1' or $version eq '2c' ) + { + push( @{$ret}, '-community', $community ); + } + else + { + push( @{$ret}, -username, $community); + + foreach my $arg ( qw(-authkey -authpassword -authprotocol + -privkey -privpassword -privprotocol) ) + { + if( defined( $collector->param($token, 'snmp' . $arg) ) ) + { + push( @{$ret}, + $arg, $collector->param($token, 'snmp' . $arg) ); + } + } + } + + $cref->{'snmpargs'}{$hosthash} = $ret; + return $ret; +} + + + +sub openBlockingSession +{ + my $collector = shift; + my $token = shift; + my $hosthash = shift; + + my $args = snmpSessionArgs( $collector, $token, $hosthash ); + my ($session, $error) = + Net::SNMP->session( @{$args}, + -nonblocking => 0, + -translate => ['-all', 0, '-octetstring', 1] ); + if( not defined($session) ) + { + Error('Cannot create SNMP session for ' . $hosthash . ': ' . $error); + } + else + { + my $maxmsgsize = $collector->param($token, 'snmp-max-msg-size'); + if( defined( $maxmsgsize ) and $maxmsgsize > 0 ) + { + $session->max_msg_size( $maxmsgsize ); + } + } + + return $session; +} + +sub openNonblockingSession +{ + my $collector = shift; + my $token = shift; + my $hosthash = shift; + + my $args = snmpSessionArgs( $collector, $token, $hosthash ); + + my ($session, $error) = + Net::SNMP->session( @{$args}, + -nonblocking => 0x1, + -translate => ['-timeticks' => 0] ); + if( not defined($session) ) + { + Error('Cannot create SNMP session for ' . $hosthash . ': ' . $error); + return undef; + } + + if( $collector->param($token, 'snmp-transport') eq 'udp' ) + { + # We set SO_RCVBUF only once, because Net::SNMP shares + # one UDP socket for all sessions. + + my $sock_name = $session->transport()->sock_name(); + my $refcount = $Net::SNMP::Transport::SOCKETS->{ + $sock_name}->[&Net::SNMP::Transport::_SHARED_REFC()]; + + if( $refcount == 1 ) + { + my $buflen = int($Torrus::Collector::SNMP::RxBuffer); + my $socket = $session->transport()->socket(); + my $ok = $socket->sockopt( SO_RCVBUF, $buflen ); + if( not $ok ) + { + Error('Could not set SO_RCVBUF to ' . + $buflen . ': ' . $!); + } + else + { + Debug('Set SO_RCVBUF to ' . $buflen); + } + } + } + + my $maxmsgsize = $collector->param($token, 'snmp-max-msg-size'); + if( defined( $maxmsgsize ) and $maxmsgsize > 0 ) + { + $session->max_msg_size( $maxmsgsize ); + + } + + return $session; +} + + +sub expandOidMappings +{ + my $collector = shift; + my $token = shift; + my $hosthash = shift; + my $oid_in = shift; + + my $cref = $collector->collectorData( 'snmp' ); + + my $oid = $oid_in; + + # Process Map statements + + while( index( $oid, 'M(' ) >= 0 ) + { + if( not $oid =~ /^(.*)M\(\s*([0-9\.]+)\s*,\s*([^\)]+)\)(.*)$/o ) + { + Error("Error in OID mapping syntax: $oid"); + return undef; + } + + my $head = $1; + my $map = $2; + my $key = $3; + my $tail = $4; + + # Remove trailing space from key + $key =~ s/\s+$//o; + + my $value = + lookupMap( $collector, $token, $hosthash, $map, $key ); + + if( defined( $value ) ) + { + if( $value eq 'notfound' ) + { + return 'notfound'; + } + else + { + $oid = $head . $value . $tail; + } + } + else + { + return undef; + } + } + + # process value lookups + + while( index( $oid, 'V(' ) >= 0 ) + { + if( not $oid =~ /^(.*)V\(\s*([0-9\.]+)\s*\)(.*)$/o ) + { + Error("Error in OID value lookup syntax: $oid"); + return undef; + } + + my $head = $1; + my $key = $2; + my $tail = $4; + + my $value; + + if( not defined( $cref->{'value-lookups'} + {$hosthash}{$key} ) ) + { + # Retrieve the OID value from host + + my $session = openBlockingSession( $collector, $token, $hosthash ); + if( not defined($session) ) + { + return undef; + } + + my $result = $session->get_request( -varbindlist => [$key] ); + $session->close(); + if( defined $result and defined($result->{$key}) ) + { + $value = $result->{$key}; + $cref->{'value-lookups'}{$hosthash}{$key} = $value; + } + else + { + Error("Error retrieving $key from $hosthash: " . + $session->error()); + probablyDead( $collector, $hosthash ); + return undef; + } + } + else + { + $value = + $cref->{'value-lookups'}{$hosthash}{$key}; + } + if( defined( $value ) ) + { + $oid = $head . $value . $tail; + } + else + { + return 'notfound'; + } + } + + # Debug('OID expanded: ' . $oid_in . ' -> ' . $oid'); + return $oid; +} + +# Look up table index in a map by value + +sub lookupMap +{ + my $collector = shift; + my $token = shift; + my $hosthash = shift; + my $map = shift; + my $key = shift; + + my $cref = $collector->collectorData( 'snmp' ); + my $maphash = join('#', $hosthash, $map); + + if( not defined( $maps{$hosthash}{$map} ) ) + { + my $ret; + + if( defined( $oldMaps{$hosthash}{$map} ) and + defined( $key ) ) + { + $ret = $oldMaps{$hosthash}{$map}{$key}; + } + + if( $mapLookupScheduled{$maphash} ) + { + return $ret; + } + + if( scalar(@mappingSessions) >= + $Torrus::Collector::SNMP::maxSessionsPerDispatcher ) + { + snmp_dispatcher(); + @mappingSessions = (); + %mapLookupScheduled = (); + } + + # Retrieve map from host + Debug('Retrieving map ' . $map . ' from ' . $hosthash); + + my $session = openNonblockingSession( $collector, $token, $hosthash ); + if( not defined($session) ) + { + return $ret; + } + else + { + push( @mappingSessions, $session ); + } + + # Retrieve the map table + + $session->get_table( -baseoid => $map, + -callback => [\&mapLookupCallback, + $collector, $hosthash, $map] ); + + $mapLookupScheduled{$maphash} = 1; + + if( not $snmpV1Hosts{$hosthash} ) + { + $mapsExpire{$maphash} = + int( time() + $mapsRefreshPeriod + + rand( $mapsRefreshPeriod * $mapsRefreshRandom ) ); + } + + return $ret; + } + + if( defined( $key ) ) + { + my $value = $maps{$hosthash}{$map}{$key}; + if( not defined $value ) + { + Error("Cannot find value $key in map $map for $hosthash in ". + $collector->path($token)); + if( defined ( $maps{$hosthash}{$map} ) ) + { + Error("Current map follows"); + while( my($key, $val) = each + %{$maps{$hosthash}{$map}} ) + { + Error("'$key' => '$val'"); + } + } + return 'notfound'; + } + else + { + if( not $snmpV1Hosts{$hosthash} ) + { + $cref->{'mapsDependentTokens'}{$maphash}{$token} = 1; + $cref->{'mapsRelatedMaps'}{$token}{$maphash} = 1; + } + + return $value; + } + } + else + { + return undef; + } +} + + +sub mapLookupCallback +{ + my $session = shift; + my $collector = shift; + my $hosthash = shift; + my $map = shift; + + &Torrus::DB::checkInterrupted(); + + Debug('Received mapping PDU from ' . $hosthash); + + my $result = $session->var_bind_list(); + if( defined $result ) + { + my $preflen = length($map) + 1; + + while( my( $oid, $key ) = each %{$result} ) + { + my $val = substr($oid, $preflen); + $maps{$hosthash}{$map}{$key} = $val; + # Debug("Map $map discovered: '$key' -> '$val'"); + } + } + else + { + Error("Error retrieving table $map from $hosthash: " . + $session->error()); + $session->close(); + probablyDead( $collector, $hosthash ); + return undef; + } +} + +sub activeMappingSessions +{ + return scalar( @mappingSessions ); +} + +# The target host is unreachable. We try to reach it few more times and +# give it the final diagnose. + +sub probablyDead +{ + my $collector = shift; + my $hosthash = shift; + + my $cref = $collector->collectorData( 'snmp' ); + + # Stop all collection for this host, until next initTargetAttributes + # is successful + delete $cref->{'activehosts'}{$hosthash}; + + my $probablyAlive = 1; + + if( defined( $hostUnreachableSeen{$hosthash} ) ) + { + if( $Torrus::Collector::SNMP::unreachableTimeout > 0 and + time() - + $hostUnreachableSeen{$hosthash} > + $Torrus::Collector::SNMP::unreachableTimeout ) + { + $probablyAlive = 0; + } + } + else + { + $hostUnreachableSeen{$hosthash} = time(); + + if( defined( $db_failures ) ) + { + $db_failures->host_failure('unreachable', $hosthash); + $db_failures->set_counter('unreachable', + scalar( keys %hostUnreachableSeen)); + } + } + + if( $probablyAlive ) + { + Info('Target host is unreachable. Will try again later: ' . $hosthash); + } + else + { + # It is dead indeed. Delete all tokens associated with this host + Info('Target host is unreachable during last ' . + $Torrus::Collector::SNMP::unreachableTimeout . + ' seconds. Giving it up: ' . $hosthash); + my @deleteTargets = (); + while( my ($oid, $ref1) = + each %{$cref->{'targets'}{$hosthash}} ) + { + while( my ($token, $dummy) = each %{$ref1} ) + { + push( @deleteTargets, $token ); + } + } + + Debug('Deleting ' . scalar( @deleteTargets ) . ' tokens'); + foreach my $token ( @deleteTargets ) + { + $collector->deleteTarget($token); + } + + delete $hostUnreachableSeen{$hosthash}; + delete $hostUnreachableRetry{$hosthash}; + $unreachableHostDeleted{$hosthash} = 1; + + if( defined( $db_failures ) ) + { + $db_failures->host_failure('deleted', $hosthash); + $db_failures->set_counter('unreachable', + scalar( keys %hostUnreachableSeen)); + $db_failures->set_counter('deleted', + scalar( keys %unreachableHostDeleted)); + } + } + + return $probablyAlive; +} + +# Return false if the try is too early + +sub checkUnreachableRetry +{ + my $collector = shift; + my $hosthash = shift; + + my $cref = $collector->collectorData( 'snmp' ); + + my $ret = 1; + if( $hostUnreachableSeen{$hosthash} ) + { + my $lastRetry = $hostUnreachableRetry{$hosthash}; + + if( not defined( $lastRetry ) ) + { + $lastRetry = $hostUnreachableSeen{$hosthash}; + } + + if( time() < $lastRetry + + $Torrus::Collector::SNMP::unreachableRetryDelay ) + { + $ret = 0; + } + else + { + $hostUnreachableRetry{$hosthash} = time(); + } + } + + return $ret; +} + + +sub isHostDead +{ + my $collector = shift; + my $hosthash = shift; + + my $cref = $collector->collectorData( 'snmp' ); + return $unreachableHostDeleted{$hosthash}; +} + + +sub hostReachableAgain +{ + my $collector = shift; + my $hosthash = shift; + + my $cref = $collector->collectorData( 'snmp' ); + if( exists( $hostUnreachableSeen{$hosthash} ) ) + { + delete $hostUnreachableSeen{$hosthash}; + if( defined( $db_failures ) ) + { + $db_failures->remove_host($hosthash); + $db_failures->set_counter('unreachable', + scalar( keys %hostUnreachableSeen)); + } + } +} + + +# Callback executed by Collector + +sub deleteTarget +{ + my $collector = shift; + my $token = shift; + + my $tref = $collector->tokenData( $token ); + my $cref = $collector->collectorData( 'snmp' ); + + my $hosthash = $tref->{'hosthash'}; + my $oid = $tref->{'oid'}; + + delete $cref->{'targets'}{$hosthash}{$oid}{$token}; + if( not %{$cref->{'targets'}{$hosthash}{$oid}} ) + { + delete $cref->{'targets'}{$hosthash}{$oid}; + + if( not %{$cref->{'targets'}{$hosthash}} ) + { + delete $cref->{'targets'}{$hosthash}; + } + } + + delete $cref->{'needsRemapping'}{$token}; + + foreach my $maphash ( keys %{$cref->{'mapsRelatedMaps'}{$token}} ) + { + delete $cref->{'mapsDependentTokens'}{$maphash}{$token}; + } + delete $cref->{'mapsRelatedMaps'}{$token}; +} + +# Main collector cycle + +$Torrus::Collector::runCollector{'snmp'} = + \&Torrus::Collector::SNMP::runCollector; + +sub runCollector +{ + my $collector = shift; + my $cref = shift; + + # Info(sprintf('runCollector() Offset: %d, active hosts: %d, maps: %d', + # $collector->offset(), + # scalar( keys %{$cref->{'activehosts'}} ), + # scalar(keys %maps))); + + # Create one SNMP session per host address. + # We assume that version, timeout and retries are the same + # within one address + + # We limit the number of sessions per snmp_dispatcher run + # because of some strange bugs: with more than 400 sessions per + # dispatcher, some requests are not sent out + + my @hosts = keys %{$cref->{'activehosts'}}; + + while( scalar(@mappingSessions) + scalar(@hosts) > 0 ) + { + my @batch = (); + while( ( scalar(@mappingSessions) + scalar(@batch) < + $Torrus::Collector::SNMP::maxSessionsPerDispatcher ) + and + scalar(@hosts) > 0 ) + { + push( @batch, pop( @hosts ) ); + } + + &Torrus::DB::checkInterrupted(); + + my @sessions; + + foreach my $hosthash ( @batch ) + { + my @oids = sort keys %{$cref->{'targets'}{$hosthash}}; + + # Info(sprintf('Host %s: %d OIDs', + # $hosthash, + # scalar(@oids))); + + # Find one representative token for the host + + if( scalar( @oids ) == 0 ) + { + next; + } + + my @reptokens = keys %{$cref->{'targets'}{$hosthash}{$oids[0]}}; + if( scalar( @reptokens ) == 0 ) + { + next; + } + my $reptoken = $reptokens[0]; + + my $session = + openNonblockingSession( $collector, $reptoken, $hosthash ); + + &Torrus::DB::checkInterrupted(); + + if( not defined($session) ) + { + next; + } + else + { + Debug('Created SNMP session for ' . $hosthash); + push( @sessions, $session ); + } + + my $oids_per_pdu = $cref->{'oids_per_pdu'}{$hosthash}; + + my @pdu_oids = (); + my $delay = 0; + + while( scalar( @oids ) > 0 ) + { + my $oid = shift @oids; + push( @pdu_oids, $oid ); + + if( scalar( @oids ) == 0 or + ( scalar( @pdu_oids ) >= $oids_per_pdu ) ) + { + if( not $cref->{'nosysuptime'}{$hosthash} ) + { + # We insert sysUpTime into every PDU, because + # we need it in further processing + push( @pdu_oids, $sysUpTime ); + } + + if( Torrus::Log::isDebug() ) + { + Debug('Sending SNMP PDU to ' . $hosthash . ':'); + foreach my $oid ( @pdu_oids ) + { + Debug($oid); + } + } + + # Generate the list of tokens that form this PDU + my $pdu_tokens = {}; + foreach my $oid ( @pdu_oids ) + { + if( defined( $cref->{'targets'}{$hosthash}{$oid} ) ) + { + foreach my $token + ( keys %{$cref->{'targets'}{$hosthash}{$oid}} ) + { + $pdu_tokens->{$oid}{$token} = 1; + } + } + } + my $result = + $session-> + get_request( -delay => $delay, + -callback => + [ \&Torrus::Collector::SNMP::callback, + $collector, $pdu_tokens, $hosthash ], + -varbindlist => \@pdu_oids ); + if( not defined $result ) + { + Error("Cannot create SNMP request: " . + $session->error); + } + @pdu_oids = (); + $delay += 0.01; + } + } + } + + &Torrus::DB::checkInterrupted(); + + snmp_dispatcher(); + + # Check if there were pending map lookup sessions + + if( scalar( @mappingSessions ) > 0 ) + { + @mappingSessions = (); + %mapLookupScheduled = (); + } + } +} + + +sub callback +{ + my $session = shift; + my $collector = shift; + my $pdu_tokens = shift; + my $hosthash = shift; + + &Torrus::DB::checkInterrupted(); + + my $cref = $collector->collectorData( 'snmp' ); + + Debug('SNMP Callback executed for ' . $hosthash); + + if( not defined( $session->var_bind_list() ) ) + { + Error('SNMP Error for ' . $hosthash . ': ' . $session->error() . + ' when retrieving ' . join(' ', sort keys %{$pdu_tokens})); + + probablyDead( $collector, $hosthash ); + + # Clear the mapping + delete $maps{$hosthash}; + foreach my $oid ( keys %{$pdu_tokens} ) + { + foreach my $token ( keys %{$pdu_tokens->{$oid}} ) + { + $cref->{'needsRemapping'}{$token} = 1; + } + } + return; + } + else + { + hostReachableAgain( $collector, $hosthash ); + } + + my $timestamp = time(); + + my $checkUptime = not $cref->{'nosysuptime'}{$hosthash}; + my $doSetValue = 1; + + my $uptime = 0; + + if( $checkUptime ) + { + my $uptimeTicks = $session->var_bind_list()->{$sysUpTime}; + if( defined $uptimeTicks ) + { + $uptime = $uptimeTicks / 100; + Debug('Uptime: ' . $uptime); + } + else + { + Error('Did not receive sysUpTime for ' . $hosthash); + } + + if( $uptime < $collector->period() or + ( defined($cref->{'knownUptime'}{$hosthash}) + and + $uptime + $collector->period() < + $cref->{'knownUptime'}{$hosthash} ) ) + { + # The agent has reloaded. Clean all maps and push UNDEF + # values to the storage + + Info('Agent rebooted: ' . $hosthash); + delete $maps{$hosthash}; + + $timestamp -= $uptime; + foreach my $oid ( keys %{$pdu_tokens} ) + { + foreach my $token ( keys %{$pdu_tokens->{$oid}} ) + { + $collector->setValue( $token, 'U', $timestamp, $uptime ); + $cref->{'needsRemapping'}{$token} = 1; + } + } + + $doSetValue = 0; + } + $cref->{'knownUptime'}{$hosthash} = $uptime; + } + + if( $doSetValue ) + { + while( my ($oid, $value) = each %{ $session->var_bind_list() } ) + { + # Debug("OID=$oid, VAL=$value"); + if( $value eq 'noSuchObject' or + $value eq 'noSuchInstance' or + $value eq 'endOfMibView' ) + { + if( not $cref->{'ignoremiberrors'}{$hosthash}{$oid} ) + { + Error("Error retrieving $oid from $hosthash: $value"); + + foreach my $token ( keys %{$pdu_tokens->{$oid}} ) + { + if( defined( $db_failures ) ) + { + $db_failures->mib_error + ($hosthash, $collector->path($token)); + } + + $collector->deleteTarget($token); + } + } + } + else + { + if( $cref->{'64bit_oid'}{$oid} ) + { + $value = Math::BigInt->new($value); + } + + foreach my $token ( keys %{$pdu_tokens->{$oid}} ) + { + $collector->setValue( $token, $value, + $timestamp, $uptime ); + } + } + } + } +} + + +# Execute this after the collector has finished + +$Torrus::Collector::postProcess{'snmp'} = + \&Torrus::Collector::SNMP::postProcess; + +sub postProcess +{ + my $collector = shift; + my $cref = shift; + + # It could happen that postProcess is called for a collector which + # has no targets, and therefore it's the only place where we can + # initialize these variables + + if( not defined( $cref->{'mapsLastExpireChecked'} ) ) + { + $cref->{'mapsLastExpireChecked'} = 0; + } + + if( not defined( $cref->{'mapsRefreshed'} ) ) + { + $cref->{'mapsRefreshed'} = []; + } + + # look if some maps are ready after last expiration check + if( scalar( @{$cref->{'mapsRefreshed'}} ) > 0 ) + { + foreach my $maphash ( @{$cref->{'mapsRefreshed'}} ) + { + foreach my $token + ( keys %{$cref->{'mapsDependentTokens'}{$maphash}} ) + { + $cref->{'needsRemapping'}{$token} = 1; + } + } + $cref->{'mapsRefreshed'} = []; + } + + my $now = time(); + + if( $cref->{'mapsLastExpireChecked'} + $mapsExpireCheckPeriod <= $now ) + { + $cref->{'mapsLastExpireChecked'} = $now; + + # Check the maps expiration and arrange lookup for expired + + while( my ( $maphash, $expire ) = each %mapsExpire ) + { + if( $expire <= $now and not $mapLookupScheduled{$maphash} ) + { + &Torrus::DB::checkInterrupted(); + + my ( $hosthash, $map ) = split( /\#/o, $maphash ); + + if( $unreachableHostDeleted{$hosthash} ) + { + # This host is no longer polled. Remove the leftovers + + delete $mapsExpire{$maphash}; + delete $maps{$hosthash}; + } + else + { + # Find one representative token for the map + my @tokens = + keys %{$cref->{'mapsDependentTokens'}{$maphash}}; + if( scalar( @tokens ) == 0 ) + { + next; + } + my $reptoken = $tokens[0]; + + # save the map for the time of refresh + $oldMaps{$hosthash}{$map} = $maps{$hosthash}{$map}; + delete $maps{$hosthash}{$map}; + + # this will schedule the map retrieval for the next + # collector cycle + Debug('Refreshing map: ' . $maphash); + + lookupMap( $collector, $reptoken, + $hosthash, $map, undef ); + + # After the next collector period, the maps will be + # ready and tokens may be updated without losing the data + push( @{$cref->{'mapsRefreshed'}}, $maphash ); + } + } + } + } + + foreach my $token ( keys %{$cref->{'needsRemapping'}} ) + { + &Torrus::DB::checkInterrupted(); + + delete $cref->{'needsRemapping'}{$token}; + if( not Torrus::Collector::SNMP::initTargetAttributes + ( $collector, $token ) ) + { + $collector->deleteTarget($token); + } + } +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Collector/SNMP_Params.pm b/torrus/perllib/Torrus/Collector/SNMP_Params.pm new file mode 100644 index 000000000..8b05264ea --- /dev/null +++ b/torrus/perllib/Torrus/Collector/SNMP_Params.pm @@ -0,0 +1,149 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: SNMP_Params.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::Collector::SNMP_Params; + +### Initialize the configuration validator with module-specific parameters +### Moved to a separate module to speed up the compiler initialization + +my %validatorLeafParams = + ( + 'snmp-ipversion' => {'4' => undef, '6' => undef}, + 'snmp-transport' => {'udp' => undef, 'tcp' => undef}, + 'snmp-host' => undef, + 'snmp-port' => undef, + '+snmp-localaddr' => undef, + '+snmp-localport' => undef, + '+domain-name' => undef, + 'snmp-object' => undef, + 'snmp-version' => { '1' => { 'snmp-community' => undef }, + '2c' => { 'snmp-community' => undef }, + '3' => { + 'snmp-username' => undef, + '+snmp-authkey' => undef, + '+snmp-authpassword' => undef, + '+snmp-authprotocol' => { + 'md5' => undef, + 'sha' => undef }, + '+snmp-privkey' => undef, + '+snmp-privpassword' => undef, + '+snmp-privprotocol' => { + 'des' => undef, + 'aes128cfb' => undef, + '3desede' => undef } } }, + 'snmp-timeout' => undef, + 'snmp-retries' => undef, + 'snmp-oids-per-pdu' => undef, + '+snmp-object-type' => { 'OTHER' => undef, + 'COUNTER64' => undef }, + '+snmp-check-sysuptime' => { 'yes' => undef, + 'no' => undef }, + '+snmp-max-msg-size' => undef, + '+snmp-ignore-mib-errors' => undef, + ); + +sub initValidatorLeafParams +{ + my $hashref = shift; + $hashref->{'ds-type'}{'collector'}{'collector-type'}{'snmp'} = + \%validatorLeafParams; +} + + +my %admInfoLeafParams = + ( + 'snmp-ipversion' => undef, + 'snmp-transport' => undef, + 'snmp-host' => undef, + 'snmp-port' => undef, + 'snmp-localaddr' => undef, + 'snmp-localport' => undef, + 'domain-name' => undef, + 'snmp-community' => undef, + 'snmp-username' => undef, + 'snmp-authkey' => undef, + 'snmp-authpassword' => undef, + 'snmp-authprotocol' => undef, + 'snmp-privkey' => undef, + 'snmp-privpassword' => undef, + 'snmp-privprotocol' => undef, + 'snmp-object' => undef, + 'snmp-version' => undef, + 'snmp-timeout' => undef, + 'snmp-retries' => undef, + 'snmp-oids-per-pdu' => undef, + 'snmp-object-type' => undef, + 'snmp-check-sysuptime' => undef, + 'snmp-max-msg-size' => undef, + 'snmp-ignore-mib-errors' => undef, + ); + + +my %admInfoParamCategories = + ( + 'snmp-ipversion' => 'SNMP', + 'snmp-transport' => 'SNMP', + 'snmp-host' => 'SNMP', + 'snmp-port' => 'SNMP', + 'snmp-localaddr' => 'SNMP', + 'snmp-localport' => 'SNMP', + 'domain-name' => 'SNMP', + 'snmp-community' => 'SNMP', + 'snmp-username' => 'SNMP', + 'snmp-authkey' => 'SNMP', + 'snmp-authpassword' => 'SNMP', + 'snmp-authprotocol' => 'SNMP', + 'snmp-privkey' => 'SNMP', + 'snmp-privpassword' => 'SNMP', + 'snmp-privprotocol' => 'SNMP', + 'snmp-object' => 'SNMP', + 'snmp-version' => 'SNMP', + 'snmp-timeout' => 'SNMP', + 'snmp-retries' => 'SNMP', + 'snmp-oids-per-pdu' => 'SNMP', + 'snmp-object-type' => 'SNMP', + 'snmp-check-sysuptime' => 'SNMP', + 'snmp-max-msg-size' => 'SNMP', + 'snmp-ignore-mib-errors' => 'SNMP' + ); + + +sub initAdmInfo +{ + my $map = shift; + my $categories = shift; + + $map->{'ds-type'}{'collector'}{'collector-type'}{'snmp'} = + \%admInfoLeafParams; + + while( ($pname, $category) = each %admInfoParamCategories ) + { + $categories->{$pname} = $category; + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ConfigBuilder.pm b/torrus/perllib/Torrus/ConfigBuilder.pm new file mode 100644 index 000000000..7762c00dc --- /dev/null +++ b/torrus/perllib/Torrus/ConfigBuilder.pm @@ -0,0 +1,529 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ConfigBuilder.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $ +# Stanislav Sinyagin + +# XML configuration builder + +package Torrus::ConfigBuilder; + +use strict; +use XML::LibXML; +use IO::File; + +use Torrus::Log; + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + + my $doc = XML::LibXML->createDocument( "1.0", "UTF-8" ); + my $root = $doc->createElement('configuration'); + $doc->setDocumentElement( $root ); + $self->{'doc'} = $doc; + $self->{'docroot'} = $root; + + $root->appendChild($doc->createComment('DO NOT EDIT THIS FILE')); + + my $dsnode = $doc->createElement('datasources'); + $self->{'docroot'}->appendChild( $dsnode ); + $self->{'datasources'} = $dsnode; + + $self->{'required_templates'} = {}; + + $self->{'statistics'} = {}; + + $self->{'registry_overlays'} = []; + + return $self; +} + + +sub setRegistryOverlays +{ + my $self = shift; + + $self->{'registry_overlays'} = []; + push( @{$self->{'registry_overlays'}}, @_ ); +} + + +sub lookupRegistry +{ + my $self = shift; + my $template = shift; + + my $ret = undef; + + foreach my $regOverlay ( @{$self->{'registry_overlays'}} ) + { + if( defined( $regOverlay->{$template} ) ) + { + $ret = $regOverlay->{$template}; + } + } + + if( not defined( $ret ) and + defined( $Torrus::ConfigBuilder::templateRegistry{$template} ) ) + { + $ret = $Torrus::ConfigBuilder::templateRegistry{$template}; + } + + if( not defined( $ret ) ) + { + if( scalar( %Torrus::ConfigBuilder::templateRegistry ) > 0 ) + { + Warn('Template ' . $template . + ' is not listed in ConfigBuilder template registry'); + } + } + + return $ret; +} + + + + +sub addCreatorInfo +{ + my $self = shift; + my $creatorInfo = shift; + + my $creatorNode = $self->{'doc'}->createElement('creator-info'); + $creatorNode->appendText( $creatorInfo ); + $self->{'docroot'}->insertBefore( $creatorNode, $self->{'datasources'} ); +} + + +sub addRequiredFiles +{ + my $self = shift; + + foreach my $file ( $self->requiredFiles() ) + { + $self->addFileInclusion( $file ); + } +} + + +sub addFileInclusion +{ + my $self = shift; + my $file = shift; + + my $node = $self->{'doc'}->createElement('include'); + $node->setAttribute( 'filename', $file ); + $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} ); +} + + +sub startDefinitions +{ + my $self = shift; + + my $node = $self->{'doc'}->createElement('definitions'); + $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} ); + return $node; +} + + +sub addDefinition +{ + my $self = shift; + my $definitionsNode = shift;; + my $name = shift; + my $value = shift; + + my $node = $self->{'doc'}->createElement('def'); + $node->setAttribute( 'name', $name ); + $node->setAttribute( 'value', $value ); + $definitionsNode->appendChild( $node ); +} + + +sub startParamProps +{ + my $self = shift; + + my $node = $self->{'doc'}->createElement('param-properties'); + $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} ); + return $node; +} + + +sub addParamProp +{ + my $self = shift; + my $propsNode = shift;; + my $param = shift; + my $prop = shift; + my $value = shift; + + my $node = $self->{'doc'}->createElement('prop'); + $node->setAttribute( 'param', $param ); + $node->setAttribute( 'prop', $prop ); + $node->setAttribute( 'value', $value ); + $propsNode->appendChild( $node ); +} + + + +sub addSubtree +{ + my $self = shift; + my $parentNode = shift; + my $subtreeName = shift; + my $params = shift; # hash reference with param name-value pairs + my $templates = shift; # array reference with template names + + return $self->addChildElement( 0, $parentNode, $subtreeName, + $params, $templates ); +} + + +sub addLeaf +{ + my $self = shift; + my $parentNode = shift; + my $leafName = shift; + my $params = shift; # hash reference with param name-value pairs + my $templates = shift; # array reference with template names + + return $self->addChildElement( 1, $parentNode, $leafName, + $params, $templates ); +} + + +sub addChildElement +{ + my $self = shift; + my $isLeaf = shift; + my $parentNode = shift; + my $childName = shift; + my $params = shift; + my $templates = shift; + + my $doc = $self->{'doc'}; + + if( not ref( $parentNode ) ) + { + $parentNode = $self->{'datasources'}; + } + + my $childNode = $doc->createElement( $isLeaf ? 'leaf' : 'subtree' ); + $childNode->setAttribute( 'name', $childName ); + $childNode = $parentNode->appendChild( $childNode ); + + if( ref( $templates ) ) + { + foreach my $tmpl ( sort @{$templates} ) + { + $self->addTemplateApplication( $childNode, $tmpl ); + } + } + + $self->addParams( $childNode, $params ); + + return $childNode; +} + + +sub getChildSubtree +{ + my $self = shift; + my $parentNode = shift; + my $childName = shift; + + if( not ref( $parentNode ) ) + { + $parentNode = $self->{'datasources'}; + } + + my @subtrees = + $parentNode->findnodes( 'subtree[@name="' . $childName . '"]' ); + if( not @subtrees ) + { + Error('Cannot find subtree named ' . $childName); + return undef; + } + return $subtrees[0]; +} + + +# Reconstruct the path to the given subtree or leaf +sub getElementPath +{ + my $self = shift; + my $node = shift; + + my $path = ''; + if( $node->nodeName() eq 'subtree' ) + { + $path = '/'; + } + + while( not $node->isSameNode( $self->{'datasources'} ) ) + { + $path = '/' . $node->getAttribute( 'name' ) . $path; + $node = $node->parentNode(); + } + + return $path; +} + + +sub getTopSubtree +{ + my $self = shift; + return $self->{'datasources'}; +} + + +sub addTemplateApplication +{ + my $self = shift; + my $parentNode = shift; + my $template = shift; + + if( not ref( $parentNode ) ) + { + $parentNode = $self->{'datasources'}; + } + + my $found = 0; + + my $reg = $self->lookupRegistry( $template ); + if( defined( $reg ) ) + { + $self->{'required_templates'}{$template} = 1; + my $name = $reg->{'name'}; + if( defined( $name ) ) + { + $template = $name; + } + } + + my $tmplNode = $self->{'doc'}->createElement( 'apply-template' ); + $tmplNode->setAttribute( 'name', $template ); + $parentNode->appendChild( $tmplNode ); +} + + +sub addParams +{ + my $self = shift; + my $parentNode = shift; + my $params = shift; + + if( ref( $params ) ) + { + foreach my $paramName ( sort keys %{$params} ) + { + $self->addParam( $parentNode, $paramName, $params->{$paramName} ); + } + } +} + + +sub addParam +{ + my $self = shift; + my $parentNode = shift; + my $param = shift; + my $value = shift; + + if( not ref( $parentNode ) ) + { + $parentNode = $self->{'datasources'}; + } + + my $paramNode = $self->{'doc'}->createElement( 'param' ); + $paramNode->setAttribute( 'name', $param ); + $paramNode->setAttribute( 'value', $value ); + $parentNode->appendChild( $paramNode ); +} + + +sub addAlias +{ + my $self = shift; + my $parentNode = shift; + my $aliasPath = shift; + + if( not ref( $parentNode ) ) # I hope nobody would need this + { + $parentNode = $self->{'datasources'}; + } + + my $aliasNode = $self->{'doc'}->createElement( 'alias' ); + $aliasNode->appendText( $aliasPath ); + $parentNode->appendChild( $aliasNode ); +} + + +sub setVar +{ + my $self = shift; + my $parentNode = shift; + my $name = shift; + my $value = shift; + + my $setvarNode = $self->{'doc'}->createElement( 'setvar' ); + $setvarNode->setAttribute( 'name', $name ); + $setvarNode->setAttribute( 'value', $value ); + $parentNode->appendChild( $setvarNode ); +} + + + +sub startMonitors +{ + my $self = shift; + + my $node = $self->{'doc'}->createElement('monitors'); + $self->{'docroot'}->appendChild( $node ); + return $node; +} + + +sub addMonitorAction +{ + my $self = shift; + my $monitorsNode = shift;; + my $name = shift; + my $params = shift; + + my $node = $self->{'doc'}->createElement('action'); + $node->setAttribute( 'name', $name ); + $monitorsNode->appendChild( $node ); + + $self->addParams( $node, $params ); +} + + +sub addMonitor +{ + my $self = shift; + my $monitorsNode = shift;; + my $name = shift; + my $params = shift; + + my $node = $self->{'doc'}->createElement('monitor'); + $node->setAttribute( 'name', $name ); + $monitorsNode->appendChild( $node ); + + $self->addParams( $node, $params ); +} + + +sub startTokensets +{ + my $self = shift; + + my $node = $self->{'doc'}->createElement('token-sets'); + $self->{'docroot'}->appendChild( $node ); + return $node; +} + + +sub addTokenset +{ + my $self = shift; + my $tsetsNode = shift;; + my $name = shift; + my $params = shift; + + my $node = $self->{'doc'}->createElement('token-set'); + $node->setAttribute( 'name', $name ); + $tsetsNode->appendChild( $node ); + + $self->addParams( $node, $params ); +} + + +sub addStatistics +{ + my $self = shift; + + foreach my $stats ( sort keys %{$self->{'statistics'}} ) + { + my $node = $self->{'doc'}->createElement('configbuilder-statistics'); + $node->setAttribute( 'category', $stats ); + $node->setAttribute( 'value', $self->{'statistics'}{$stats} ); + $self->{'docroot'}->appendChild( $node ); + } +} + + + +sub requiredFiles +{ + my $self = shift; + + my %files; + foreach my $template ( keys %{$self->{'required_templates'}} ) + { + my $file; + my $reg = $self->lookupRegistry( $template ); + if( defined( $reg ) ) + { + $file = $reg->{'source'}; + } + + if( defined( $file ) ) + { + $files{$file} = 1; + } + else + { + Error('Source file is not defined for template ' . $template . + ' in ConfigBuilder template registry'); + } + } + return( sort keys %files ); +} + + + +sub toFile +{ + my $self = shift; + my $filename = shift; + + my $fh = new IO::File('> ' . $filename); + if( defined( $fh ) ) + { + my $ok = $self->{'doc'}->toFH( $fh, 2 ); + $fh->close(); + return $ok; + } + else + { + return undef; + } +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ConfigTree.pm b/torrus/perllib/Torrus/ConfigTree.pm new file mode 100644 index 000000000..efa4aaff8 --- /dev/null +++ b/torrus/perllib/Torrus/ConfigTree.pm @@ -0,0 +1,1158 @@ +# Copyright (C) 2002-2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ConfigTree.pm,v 1.1 2010-12-27 00:03:41 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ConfigTree; + +use Torrus::DB; +use Torrus::Log; +use Torrus::TimeStamp; + +use strict; + + + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + $self->{'treename'} = $options{'-TreeName'}; + die('ERROR: TreeName is mandatory') if not $self->{'treename'}; + + $self->{'db_config_instances'} = + new Torrus::DB( 'config_instances', -WriteAccess => 1 ); + defined( $self->{'db_config_instances'} ) or return( undef ); + + my $i = $self->{'db_config_instances'}->get('ds:' . $self->{'treename'}); + if( not defined($i) ) + { + $i = 0; + $self->{'first_time_created'} = 1; + } + + my $dsConfInstance = sprintf( '%d', $i ); + + $i = $self->{'db_config_instances'}->get('other:' . $self->{'treename'}); + $i = 0 unless defined( $i ); + + my $otherConfInstance = sprintf( '%d', $i ); + + if( $options{'-WriteAccess'} ) + { + $self->{'is_writing'} = 1; + + # Acquire exlusive lock on the database and set the compiling flag + { + my $ok = 1; + my $key = 'compiling:' . $self->{'treename'}; + my $cursor = $self->{'db_config_instances'}->cursor( -Write => 1 ); + my $compilingFlag = + $self->{'db_config_instances'}->c_get( $cursor, $key ); + if( $compilingFlag ) + { + if( $options{'-ForceWriter'} ) + { + Warn('Another compiler process is probably still ' . + 'running. This may lead to an unusable ' . + 'database state'); + } + else + { + Error('Another compiler is running for the tree ' . + $self->{'treename'}); + $ok = 0; + } + } + else + { + $self->{'db_config_instances'}->c_put( $cursor, $key, 1 ); + } + undef $cursor; + if( not $ok ) + { + return undef; + } + $self->{'iam_writer'} = 1; + } + + if( not $options{'-NoDSRebuild'} ) + { + $dsConfInstance = sprintf( '%d', ( $dsConfInstance + 1 ) % 2 ); + } + $otherConfInstance = sprintf( '%d', ( $otherConfInstance + 1 ) % 2 ); + } + + $self->{'ds_config_instance'} = $dsConfInstance; + $self->{'other_config_instance'} = $otherConfInstance; + + $self->{'db_readers'} = new Torrus::DB('config_readers', + -Subdir => $self->{'treename'}, + -WriteAccess => 1 ); + defined( $self->{'db_readers'} ) or return( undef ); + + $self->{'db_dsconfig'} = + new Torrus::DB('ds_config_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => $options{'-WriteAccess'}); + defined( $self->{'db_dsconfig'} ) or return( undef ); + + $self->{'db_otherconfig'} = + new Torrus::DB('other_config_' . $otherConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => $options{'-WriteAccess'}); + defined( $self->{'db_otherconfig'} ) or return( undef ); + + $self->{'db_aliases'} = + new Torrus::DB('aliases_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => $options{'-WriteAccess'}); + defined( $self->{'db_aliases'} ) or return( undef ); + + if( $options{'-WriteAccess'} ) + { + $self->setReady(0); + $self->waitReaders(); + + if( $options{'-Rebuild'} ) + { + $self->{'db_otherconfig'}->trunc(); + if( not $options{'-NoDSRebuild'} ) + { + $self->{'db_dsconfig'}->trunc(); + $self->{'db_aliases'}->trunc(); + } + } + } + else + { + $self->setReader(); + + if( not $self->isReady() ) + { + if( $options{'-Wait'} ) + { + Warn('Configuration is not ready'); + + my $waitingTimeout = + time() + $Torrus::Global::ConfigReadyTimeout; + my $success = 0; + + while( not $success and time() < $waitingTimeout ) + { + $self->clearReader(); + + Info('Sleeping ' . + $Torrus::Global::ConfigReadyRetryPeriod . + ' seconds'); + sleep $Torrus::Global::ConfigReadyRetryPeriod; + + $self->setReader(); + + if( $self->isReady() ) + { + $success = 1; + Info('Now configuration is ready'); + } + else + { + Info('Configuration is still not ready'); + } + } + if( not $success ) + { + Error('Configuration wait timed out'); + $self->clearReader(); + return undef; + } + } + else + { + Error('Configuration is not ready'); + $self->clearReader(); + return undef; + } + } + } + + # Read the parameter properties into memory + $self->{'db_paramprops'} = + new Torrus::DB('paramprops_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => $options{'-WriteAccess'}); + defined( $self->{'db_paramprops'} ) or return( undef ); + + if( $options{'-Rebuild'} ) + { + $self->{'db_paramprops'}->trunc(); + } + else + { + my $cursor = $self->{'db_paramprops'}->cursor(); + while( my ($key, $val) = + $self->{'db_paramprops'}->next( $cursor ) ) + { + my( $param, $prop ) = split( /:/o, $key ); + $self->{'paramprop'}{$prop}{$param} = $val; + } + undef $cursor; + $self->{'db_paramprops'}->closeNow(); + delete $self->{'db_paramprops'}; + } + + + $self->{'db_sets'} = + new Torrus::DB('tokensets_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 0, + -WriteAccess => 1, -Truncate => $options{'-Rebuild'}); + defined( $self->{'db_sets'} ) or return( undef ); + + + $self->{'db_nodepcache'} = + new Torrus::DB('nodepcache_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => 1, + -Truncate => ($options{'-Rebuild'} and + not $options{'-NoDSRebuild'})); + defined( $self->{'db_nodepcache'} ) or return( undef ); + + + $self->{'db_nodeid'} = + new Torrus::DB('nodeid_' . $dsConfInstance, + -Subdir => $self->{'treename'}, -Btree => 1, + -WriteAccess => 1, + -Truncate => ($options{'-Rebuild'} and + not $options{'-NoDSRebuild'})); + defined( $self->{'db_nodeid'} ) or return( undef ); + + return $self; +} + + +sub DESTROY +{ + my $self = shift; + + Debug('Destroying ConfigTree object'); + + if( $self->{'iam_writer'} ) + { + # Acquire exlusive lock on the database and clear the compiling flag + my $cursor = $self->{'db_config_instances'}->cursor( -Write => 1 ); + $self->{'db_config_instances'}->c_put + ( $cursor, 'compiling:' . $self->{'treename'}, 0 ); + undef $cursor; + } + else + { + $self->clearReader(); + } + + undef $self->{'db_dsconfig'}; + undef $self->{'db_otherconfig'}; + undef $self->{'db_aliases'}; + undef $self->{'db_sets'}; + undef $self->{'db_nodepcache'}; + undef $self->{'db_readers'}; +} + +# Manage the readinness flag + +sub setReady +{ + my $self = shift; + my $ready = shift; + $self->{'db_otherconfig'}->put( 'ConfigurationReady', $ready ? 1:0 ); +} + +sub isReady +{ + my $self = shift; + return $self->{'db_otherconfig'}->get( 'ConfigurationReady' ); +} + +# Manage the readers database + +sub setReader +{ + my $self = shift; + + my $readerId = 'pid=' . $$ . ',rand=' . sprintf('%.10d', rand(1e9)); + Debug('Setting up reader: ' . $readerId); + $self->{'reader_id'} = $readerId; + $self->{'db_readers'}->put( $readerId, + sprintf('%d:%d:%d', + time(), + $self->{'ds_config_instance'}, + $self->{'other_config_instance'}) ); +} + +sub clearReader +{ + my $self = shift; + + if( defined( $self->{'reader_id'} ) ) + { + Debug('Clearing reader: ' . $self->{'reader_id'}); + $self->{'db_readers'}->del( $self->{'reader_id'} ); + delete $self->{'reader_id'}; + } +} + + +sub waitReaders +{ + my $self = shift; + + # Let the active readers finish their job + my $noReaders = 0; + while( not $noReaders ) + { + my @readers = (); + my $cursor = $self->{'db_readers'}->cursor(); + while( my ($key, $val) = $self->{'db_readers'}->next( $cursor ) ) + { + my( $timestamp, $dsInst, $otherInst ) = split( /:/o, $val ); + if( $dsInst == $self->{'ds_config_instance'} or + $otherInst == $self->{'other_config_instance'} ) + { + push( @readers, { + 'reader' => $key, + 'timestamp' => $timestamp } ); + } + } + undef $cursor; + if( @readers > 0 ) + { + Info('Waiting for ' . scalar(@readers) . ' readers:'); + my $recentTS = 0; + foreach my $reader ( @readers ) + { + Info($reader->{'reader'} . ', timestamp: ' . + localtime( $reader->{'timestamp'} )); + if( $reader->{'timestamp'} > $recentTS ) + { + $recentTS = $reader->{'timestamp'}; + } + } + if( $recentTS + $Torrus::Global::ConfigReadersWaitTimeout >= + time() ) + { + Info('Sleeping ' . $Torrus::Global::ConfigReadersWaitPeriod . + ' seconds'); + sleep( $Torrus::Global::ConfigReadersWaitPeriod ); + } + else + { + # the readers are too long active. we ignore them now + Warn('Readers wait timed out. Flushing the readers list for ' . + 'DS config instance ' . $self->{'ds_config_instance'} . + ' and Other config instance ' . + $self->{'other_config_instance'}); + + my $cursor = $self->{'db_readers'}->cursor( -Write => 1 ); + while( my ($key, $val) = + $self->{'db_readers'}->next( $cursor ) ) + { + my( $timestamp, $dsInst, $otherInst ) = + split( /:/o, $val ); + if( $dsInst == $self->{'ds_config_instance'} or + $otherInst == $self->{'other_config_instance'} ) + { + $self->{'db_readers'}->c_del( $cursor ); + } + } + undef $cursor; + $noReaders = 1; + } + } + else + { + $noReaders = 1; + } + } +} + + + +# This should be called after Torrus::TimeStamp::init(); + +sub getTimestamp +{ + my $self = shift; + return Torrus::TimeStamp::get($self->{'treename'} . ':configuration'); +} + +sub treeName +{ + my $self = shift; + return $self->{'treename'}; +} + + +# Returns array with path components + +sub splitPath +{ + my $self = shift; + my $path = shift; + my @ret = (); + while( length($path) > 0 ) + { + my $node; + $path =~ s/^([^\/]*\/?)//o; $node = $1; + push(@ret, $node); + } + return @ret; +} + +sub nodeName +{ + my $self = shift; + my $path = shift; + $path =~ s/.*\/([^\/]+)\/?$/$1/o; + return $path; +} + +sub token +{ + my $self = shift; + my $path = shift; + + my $token = $self->{'db_dsconfig'}->get( 'pt:'.$path ); + if( not defined( $token ) ) + { + my $prefixLen = 1; # the leading slash is anyway there + my $pathLen = length( $path ); + while( not defined( $token ) and $prefixLen < $pathLen ) + { + my $result = $self->{'db_aliases'}->getBestMatch( $path ); + if( not defined( $result ) ) + { + $prefixLen = $pathLen; # exit the loop + } + else + { + # Found a partial match + $prefixLen = length( $result->{'key'} ); + my $aliasTarget = $self->path( $result->{'value'} ); + $path = $aliasTarget . substr( $path, $prefixLen ); + $token = $self->{'db_dsconfig'}->get( 'pt:'.$path ); + } + } + } + return $token; +} + +sub path +{ + my $self = shift; + my $token = shift; + return $self->{'db_dsconfig'}->get( 'tp:'.$token ); +} + +sub nodeExists +{ + my $self = shift; + my $path = shift; + + return defined( $self->{'db_dsconfig'}->get( 'pt:'.$path ) ); +} + + +sub nodeType +{ + my $self = shift; + my $token = shift; + + my $type = $self->{'nodetype_cache'}{$token}; + if( not defined( $type ) ) + { + $type = $self->{'db_dsconfig'}->get( 'n:'.$token ); + $self->{'nodetype_cache'}{$token} = $type; + } + return $type; +} + + +sub isLeaf +{ + my $self = shift; + my $token = shift; + + return ( $self->nodeType($token) == 1 ); +} + + +sub isSubtree +{ + my $self = shift; + my $token = shift; + + return( $self->nodeType($token) == 0 ); +} + +# Returns the real token or undef +sub isAlias +{ + my $self = shift; + my $token = shift; + + return( ( $self->nodeType($token) == 2 ) ? + $self->{'db_dsconfig'}->get( 'a:'.$token ) : undef ); +} + +# Returns the list of tokens pointing to this one as an alias +sub getAliases +{ + my $self = shift; + my $token = shift; + + return $self->{'db_dsconfig'}->getListItems('ar:'.$token); +} + + +sub getParam +{ + my $self = shift; + my $name = shift; + my $param = shift; + my $fromDS = shift; + + if( exists( $self->{'paramcache'}{$name}{$param} ) ) + { + return $self->{'paramcache'}{$name}{$param}; + } + else + { + my $db = $fromDS ? $self->{'db_dsconfig'} : $self->{'db_otherconfig'}; + my $val = $db->get( 'P:'.$name.':'.$param ); + $self->{'paramcache'}{$name}{$param} = $val; + return $val; + } +} + +sub retrieveNodeParam +{ + my $self = shift; + my $token = shift; + my $param = shift; + + # walk up the tree and save the grandparent's value at parent's cache + + my $value; + my $currtoken = $token; + my @ancestors; + my $walked = 0; + + while( not defined($value) and defined($currtoken) ) + { + $value = $self->getParam( $currtoken, $param, 1 ); + if( not defined $value ) + { + if( $walked ) + { + push( @ancestors, $currtoken ); + } + else + { + $walked = 1; + } + # walk up to the parent + $currtoken = $self->getParent($currtoken); + } + } + + foreach my $ancestor ( @ancestors ) + { + $self->{'paramcache'}{$ancestor}{$param} = $value; + } + + return $self->expandNodeParam( $token, $param, $value ); +} + + +sub expandNodeParam +{ + my $self = shift; + my $token = shift; + my $param = shift; + my $value = shift; + + # %parameter_substitutions% in ds-path-* in multigraph leaves + # are expanded by the Writer post-processing + if( defined $value and $self->getParamProperty( $param, 'expand' ) ) + { + $value = $self->expandSubstitutions( $token, $param, $value ); + } + return $value; +} + + +sub expandSubstitutions +{ + my $self = shift; + my $token = shift; + my $param = shift; + my $value = shift; + + my $ok = 1; + my $changed = 1; + + while( $changed and $ok ) + { + $changed = 0; + + # Substitute definitions + if( index($value, '$') >= 0 ) + { + if( not $value =~ /\$(\w+)/o ) + { + my $path = $self->path($token); + Error("Incorrect definition reference: $value in $path"); + $ok = 0; + } + else + { + my $dname = $1; + my $dvalue = $self->getDefinition($dname); + if( not defined( $dvalue ) ) + { + my $path = $self->path($token); + Error("Cannot find definition $dname in $path"); + $ok = 0; + } + else + { + $value =~ s/\$$dname/$dvalue/g; + $changed = 1; + } + } + } + + # Substitute parameter references + if( index($value, '%') >= 0 and $ok ) + { + if( not $value =~ /\%([a-zA-Z0-9\-_]+)\%/o ) + { + Error("Incorrect parameter reference: $value"); + $ok = 0; + } + else + { + my $pname = $1; + my $pval = $self->getNodeParam( $token, $pname ); + + if( not defined( $pval ) ) + { + my $path = $self->path($token); + Error("Cannot expand parameter reference %". + $pname."% in ".$path); + $ok = 0; + } + else + { + $value =~ s/\%$pname\%/$pval/g; + $changed = 1; + } + } + } + } + + if( ref( $Torrus::ConfigTree::nodeParamHook ) ) + { + $value = &{$Torrus::ConfigTree::nodeParamHook}( $self, $token, + $param, $value ); + } + + return $value; +} + + +sub getNodeParam +{ + my $self = shift; + my $token = shift; + my $param = shift; + my $noclimb = shift; + + my $value; + if( $noclimb ) + { + $value = $self->getParam( $token, $param, 1 ); + return $self->expandNodeParam( $token, $param, $value ); + } + + if( $self->{'is_writing'} ) + { + return $self->retrieveNodeParam( $token, $param ); + } + + my $cachekey = $token.':'.$param; + my $cacheval = $self->{'db_nodepcache'}->get( $cachekey ); + if( defined( $cacheval ) ) + { + my $status = substr( $cacheval, 0, 1 ); + if( $status eq 'U' ) + { + return undef; + } + else + { + return substr( $cacheval, 1 ); + } + } + + $value = $self->retrieveNodeParam( $token, $param ); + + if( defined( $value ) ) + { + $self->{'db_nodepcache'}->put( $cachekey, 'D'.$value ); + } + else + { + $self->{'db_nodepcache'}->put( $cachekey, 'U' ); + } + + return $value; +} + + +sub getParamNames +{ + my $self = shift; + my $name = shift; + my $fromDS = shift; + + my $db = $fromDS ? $self->{'db_dsconfig'} : $self->{'db_otherconfig'}; + + return $db->getListItems('Pl:'.$name); +} + + +sub getParams +{ + my $self = shift; + my $name = shift; + my $fromDS = shift; + + my $ret = {}; + foreach my $param ( $self->getParamNames( $name, $fromDS ) ) + { + $ret->{$param} = $self->getParam( $name, $param, $fromDS ); + } + return $ret; +} + +sub getParent +{ + my $self = shift; + my $token = shift; + if( exists( $self->{'parentcache'}{$token} ) ) + { + return $self->{'parentcache'}{$token}; + } + else + { + my $parent = $self->{'db_dsconfig'}->get( 'p:'.$token ); + $self->{'parentcache'}{$token} = $parent; + return $parent; + } +} + + +sub getChildren +{ + my $self = shift; + my $token = shift; + + if( (my $alias = $self->isAlias($token)) ) + { + return $self->getChildren($alias); + } + else + { + return $self->{'db_dsconfig'}->getListItems( 'c:'.$token ); + } +} + +sub getParamProperty +{ + my $self = shift; + my $param = shift; + my $prop = shift; + + return $self->{'paramprop'}{$prop}{$param}; +} + + +sub getParamProperties +{ + my $self = shift; + + return $self->{'paramprop'}; +} + +# Recognize the regexp patterns within a path, +# like /Netflow/Exporters/.*/.*/bps. +# Each pattern is applied against direct child names only. +# +sub getNodesByPattern +{ + my $self = shift; + my $pattern = shift; + + if( $pattern !~ /^\//o ) + { + Error("Incorrect pattern: $pattern"); + return undef; + } + + my @retlist = (); + foreach my $nodepattern ( $self->splitPath($pattern) ) + { + my @next_retlist = (); + + # Cut the trailing slash, if any + my $patternname = $nodepattern; + $patternname =~ s/\/$//o; + + if( $patternname =~ /\W/o ) + { + foreach my $candidate ( @retlist ) + { + # This is a pattern, let's get all matching children + foreach my $child ( $self->getChildren( $candidate ) ) + { + # Cut the trailing slash and leading path + my $childname = $self->path($child); + $childname =~ s/\/$//o; + $childname =~ s/.*\/([^\/]+)$/$1/o; + if( $childname =~ $patternname ) + { + push( @next_retlist, $child ); + } + } + } + + } + elsif( length($patternname) == 0 ) + { + @next_retlist = ( $self->token('/') ); + } + else + { + foreach my $candidate ( @retlist ) + { + my $proposal = $self->path($candidate).$nodepattern; + if( defined( my $proptoken = $self->token($proposal) ) ) + { + push( @next_retlist, $proptoken ); + } + } + } + @retlist = @next_retlist; + } + return @retlist; +} + +# +# Recognizes absolute or relative path, '..' as the parent subtree +# +sub getRelative +{ + my $self = shift; + my $token = shift; + my $relPath = shift; + + if( $relPath =~ /^\//o ) + { + return $self->token( $relPath ); + } + else + { + if( length( $relPath ) > 0 ) + { + $token = $self->getParent( $token ); + } + + while( length( $relPath ) > 0 ) + { + if( $relPath =~ /^\.\.\//o ) + { + $relPath =~ s/^\.\.\///o; + if( $token ne $self->token('/') ) + { + $token = $self->getParent( $token ); + } + } + else + { + my $childName; + $relPath =~ s/^([^\/]*\/?)//o; $childName = $1; + my $path = $self->path( $token ); + $token = $self->token( $path . $childName ); + if( not defined $token ) + { + return undef; + } + } + } + return $token; + } +} + + +sub getNodeByNodeid +{ + my $self = shift; + my $nodeid = shift; + + return $self->{'db_nodeid'}->get( $nodeid ); +} + +# Returns arrayref or undef. +# Each element is an arrayref to [nodeid, token] pair +sub searchNodeidPrefix +{ + my $self = shift; + my $prefix = shift; + + return $self->{'db_nodeid'}->searchPrefix( $prefix ); +} + + +# Returns arrayref or undef. +# Each element is an arrayref to [nodeid, token] pair +sub searchNodeidSubstring +{ + my $self = shift; + my $substring = shift; + + return $self->{'db_nodeid'}->searchSubstring( $substring ); +} + + + +sub getDefaultView +{ + my $self = shift; + my $token = shift; + + my $view; + if( $self->isTset($token) ) + { + if( $token eq 'SS' ) + { + $view = $self->getParam('SS', 'default-tsetlist-view'); + } + else + { + $view = $self->getParam($token, 'default-tset-view'); + if( not defined( $view ) ) + { + $view = $self->getParam('SS', 'default-tset-view'); + } + } + } + elsif( $self->isSubtree($token) ) + { + $view = $self->getNodeParam($token, 'default-subtree-view'); + } + else + { + # This must be leaf + $view = $self->getNodeParam($token, 'default-leaf-view'); + } + + if( not defined( $view ) ) + { + Error("Cannot find default view for $token"); + } + return $view; +} + + +sub getInstanceParam +{ + my $self = shift; + my $type = shift; + my $name = shift; + my $param = shift; + + if( $type eq 'node' ) + { + return $self->getNodeParam($name, $param); + } + else + { + return $self->getParam($name, $param); + } +} + + +sub getViewNames +{ + my $self = shift; + return $self->{'db_otherconfig'}->getListItems( 'V:' ); +} + + +sub viewExists +{ + my $self = shift; + my $vname = shift; + return $self->searchOtherList('V:', $vname); +} + + +sub getMonitorNames +{ + my $self = shift; + return $self->{'db_otherconfig'}->getListItems( 'M:' ); +} + +sub monitorExists +{ + my $self = shift; + my $mname = shift; + return $self->searchOtherList('M:', $mname); +} + + +sub getActionNames +{ + my $self = shift; + return $self->{'db_otherconfig'}->getListItems( 'A:' ); +} + + +sub actionExists +{ + my $self = shift; + my $mname = shift; + return $self->searchOtherList('A:', $mname); +} + + +# Search for a value in comma-separated list +sub searchOtherList +{ + my $self = shift; + my $key = shift; + my $name = shift; + + return $self->{'db_otherconfig'}->searchList($key, $name); +} + +# Token sets manipulation + +sub isTset +{ + my $self = shift; + my $token = shift; + return substr($token, 0, 1) eq 'S'; +} + +sub addTset +{ + my $self = shift; + my $tset = shift; + $self->{'db_sets'}->addToList('S:', $tset); +} + + +sub tsetExists +{ + my $self = shift; + my $tset = shift; + return $self->{'db_sets'}->searchList('S:', $tset); +} + +sub getTsets +{ + my $self = shift; + return $self->{'db_sets'}->getListItems('S:'); +} + +sub tsetMembers +{ + my $self = shift; + my $tset = shift; + + return $self->{'db_sets'}->getListItems('s:'.$tset); +} + +sub tsetMemberOrigin +{ + my $self = shift; + my $tset = shift; + my $token = shift; + + return $self->{'db_sets'}->get('o:'.$tset.':'.$token); +} + +sub tsetAddMember +{ + my $self = shift; + my $tset = shift; + my $token = shift; + my $origin = shift; + + $self->{'db_sets'}->addToList('s:'.$tset, $token); + $self->{'db_sets'}->put('o:'.$tset.':'.$token, $origin); +} + + +sub tsetDelMember +{ + my $self = shift; + my $tset = shift; + my $token = shift; + + $self->{'db_sets'}->delFromList('s:'.$tset, $token); + $self->{'db_sets'}->del('o:'.$tset.':'.$token); +} + +# Definitions manipulation + +sub getDefinition +{ + my $self = shift; + my $name = shift; + return $self->{'db_dsconfig'}->get( 'd:'.$name ); +} + +sub getDefinitionNames +{ + my $self = shift; + return $self->{'db_dsconfig'}->getListItems( 'D:' ); +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ConfigTree/Validator.pm b/torrus/perllib/Torrus/ConfigTree/Validator.pm new file mode 100644 index 000000000..96923d032 --- /dev/null +++ b/torrus/perllib/Torrus/ConfigTree/Validator.pm @@ -0,0 +1,969 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Validator.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ConfigTree::Validator; + +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::RPN; +use Torrus::SiteConfig; +use strict; + +Torrus::SiteConfig::loadStyling(); + +%Torrus::ConfigTree::Validator::reportedErrors = (); + +my %rrd_params = + ( + 'leaf-type' => {'rrd-def' => {'rrd-ds' => undef, + 'rrd-cf' => {'AVERAGE' => undef, + 'MIN' => undef, + 'MAX' => undef, + 'LAST' => undef}, + 'data-file' => undef, + 'data-dir' => undef}, + 'rrd-cdef' => {'rpn-expr' => undef}}, + ); + +my %rrdmulti_params = ( 'ds-names' => undef ); + +# Plugins might need to add a new storage type +our %collector_params = + ( + 'collector-type' => undef, + '@storage-type' => { + 'rrd' => { + 'data-file' => undef, + 'data-dir' => undef, + 'leaf-type' => { + 'rrd-def' => {'rrd-ds' => undef, + 'rrd-cf' => {'AVERAGE' => undef, + 'MIN' => undef, + 'MAX' => undef, + 'LAST' => undef}, + 'rrd-create-dstype' => {'GAUGE' => undef, + 'COUNTER' => undef, + 'DERIVE' => undef, + 'ABSOLUTE' => undef }, + 'rrd-create-rra' => undef, + 'rrd-create-heartbeat' => undef, + '+rrd-hwpredict' => { + 'enabled' => { + 'rrd-create-hw-rralen' => undef}, + 'disabled' => undef, + }}}}, + 'ext' => { + 'ext-dstype' => { + 'GAUGE' => undef, + 'COUNTER32' => undef, + 'COUNTER64' => undef }, + 'ext-service-id' => undef, + '+ext-service-units' => { + 'bytes' => undef }}}, + 'collector-period' => undef, + 'collector-timeoffset' => undef, + '+collector-scale' => undef, + '+collector-dispersed-timeoffset' => { + 'no' => undef, + 'yes' => undef } + # collector-timeoffset-min, max, step, and hashstring are validated + # during post-processing + ); + + +# Plugins might in theory create new datasource types +our %leaf_params = + ('ds-type' => {'rrd-file' => \%rrd_params, + 'rrd-multigraph' => \%rrdmulti_params, + 'collector' => \%collector_params}, + 'rrgraph-views' => undef, + '+rrd-scaling-base' => {'1000' => undef, '1024' => undef}, + '+graph-logarithmic' => {'yes' => undef, 'no' => undef}, + '+graph-rigid-boundaries' => {'yes' => undef, 'no' => undef}, + '+graph-ignore-decorations' => {'yes' => undef, 'no' => undef}); + + +my %monitor_params = + ('monitor-type' => {'expression' => {'rpn-expr' => undef}, + 'failures' => undef}, + 'action' => undef, + 'expires' => undef + ); + +my %action_params = + ('action-type' => {'tset' => {'tset-name' => undef}, + 'exec' => {'command' => undef} } + ); + +my %view_params = + ('expires' => undef, + 'view-type' => {'rrgraph' => {'width' => undef, + 'height' => undef, + 'start' => undef, + 'line-style' => undef, + 'line-color' => undef, + '+ignore-limits' => { + 'yes'=>undef, 'no'=>undef }, + '+ignore-lower-limit' => { + 'yes'=>undef, 'no'=>undef }, + '+ignore-upper-limit' => { + 'yes'=>undef, 'no'=>undef }}, + 'rrprint' => {'start' => undef, + 'print-cf' => undef}, + 'html' => {'html-template' => undef}, + 'adminfo' => undef} + ); + + +# Load additional validation, configurable from +# torrus-config.pl and torrus-siteconfig.pl + +foreach my $mod ( @Torrus::Validator::loadLeafValidators ) +{ + eval( 'require ' . $mod ); + die( $@ ) if $@; + eval( '&' . $mod . '::initValidatorLeafParams( \%leaf_params )' ); + die( $@ ) if $@; +} + + +sub validateNodes +{ + my $config_tree = shift; + my $token = $config_tree->token('/'); + + if( defined($token) ) + { + return validateNode($config_tree, $token); + } + else + { + Error("The datasource tree is empty"); + return 0; + } +} + +sub validateNode +{ + my $config_tree = shift; + my $token = shift; + + &Torrus::DB::checkInterrupted(); + + my $ok = 1; + + if( $config_tree->isLeaf($token) ) + { + # Verify the default view + my $view = $config_tree->getNodeParam( $token, 'default-leaf-view' ); + if( not defined( $view ) ) + { + my $path = $config_tree->path( $token ); + Error("Default view is not defined for leaf $path"); + $ok = 0; + } + elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and + not $config_tree->viewExists( $view ) ) + { + my $path = $config_tree->path( $token ); + Error("Non-existent view is defined as default for leaf $path"); + $ok = 0; + } + else + { + # Cache the view name + $config_tree->{'validator'}{'viewExists'}{$view} = 1; + } + + # Verify parameters + $ok = validateInstanceParams($config_tree, $token, + 'node', \%leaf_params); + + if( $ok ) + { + my $rrviewslist = + $config_tree->getNodeParam( $token, 'rrgraph-views' ); + + # Check the cache first + if( not $config_tree->{'validator'}{'graphviews'}{$rrviewslist} ) + { + my @rrviews = split( ',', $rrviewslist ); + + if( scalar(@rrviews) != 5 ) + { + my $path = $config_tree->path( $token ); + Error('rrgraph-views sould refer 5 views in' . $path); + $ok = 0; + } + else + { + foreach my $view ( @rrviews ) + { + if( not $config_tree->viewExists( $view ) ) + { + my $path = $config_tree->path( $token ); + Error("Non-existent view ($view) is defined in " . + "rrgraph-views for $path"); + $ok = 0; + } + elsif( $config_tree->getParam($view, 'view-type') ne + 'rrgraph' ) + { + my $path = $config_tree->path( $token ); + Error("View $view is not of type rrgraph in " . + "rrgraph-views for $path"); + $ok = 0; + } + } + } + + if( $ok ) + { + # Store the cache + $config_tree->{'validator'}{'graphviews'}{$rrviewslist}=1; + } + } + } + + # Verify monitor references + my $mlist = $config_tree->getNodeParam( $token, 'monitor' ); + if( defined $mlist ) + { + foreach my $param ( 'monitor-period', 'monitor-timeoffset' ) + { + if( not defined( $config_tree->getNodeParam( $token, + $param ) ) ) + { + my $path = $config_tree->path( $token ); + Error('Mandatory parameter ' . $param . + ' is not defined in ' . $path); + $ok = 0; + } + } + + foreach my $monitor ( split(',', $mlist) ) + { + if( not $config_tree->{'validator'}{'monitorExists'}{$monitor} + and + not $config_tree->monitorExists( $monitor ) ) + { + my $path = $config_tree->path( $token ); + Error("Non-existent monitor: $monitor in $path"); + $ok = 0; + } + else + { + $config_tree->{'validator'}{'monitorExists'}{$monitor} = 1; + } + } + + my $varstring = + $config_tree->getNodeParam( $token, 'monitor-vars' ); + if( defined $varstring ) + { + foreach my $pair ( split( '\s*;\s*', $varstring ) ) + { + if( $pair !~ /^\w+\s*\=\s*[0-9\-+.eU]+$/o ) + { + Error("Syntax error in monitor variables: $pair"); + $ok = 0; + } + } + } + + my $action_target = + $config_tree->getNodeParam($token, 'monitor-action-target'); + if( defined( $action_target ) ) + { + my $target = $config_tree->getRelative($token, $action_target); + if( not defined( $target ) ) + { + my $path = $config_tree->path( $token ); + Error('monitor-action-target points to an invalid path: ' . + $action_target . ' in ' . $path); + $ok = 0; + } + elsif( not $config_tree->isLeaf( $target ) ) + { + my $path = $config_tree->path( $token ); + Error('monitor-action-target must point to a leaf: ' . + $action_target . ' in ' . $path); + $ok = 0; + } + } + } + + # Verify if the data-dir exists + my $datadir = $config_tree->getNodeParam( $token, 'data-dir' ); + if( defined $datadir ) + { + if( not $config_tree->{'validator'}{'dirExists'}{$datadir} and + not ( -d $datadir ) and + not $Torrus::ConfigTree::Validator::reportedErrors{$datadir} ) + { + my $path = $config_tree->path( $token ); + Error("Directory does not exist: $datadir in $path"); + $ok = 0; + $Torrus::ConfigTree::Validator::reportedErrors{$datadir} = 1; + } + else + { + # Store the cache + $config_tree->{'validator'}{'dirExists'}{$datadir} = 1; + } + } + + # Verify type-specific parameters + my $dsType = $config_tree->getNodeParam( $token, 'ds-type' ); + if( not defined( $dsType ) ) + { + # Writer has already complained + return 0; + } + + if( $dsType eq 'rrd-multigraph' ) + { + my @dsNames = + split(',', $config_tree->getNodeParam( $token, 'ds-names' ) ); + + if( scalar(@dsNames) == 0 ) + { + my $path = $config_tree->path( $token ); + Error("ds-names list is empty in $path"); + $ok = 0; + } + foreach my $dname ( @dsNames ) + { + my $param = 'ds-expr-' . $dname; + my $expr = $config_tree->getNodeParam( $token, $param ); + if( not defined( $expr ) ) + { + my $path = $config_tree->path( $token ); + Error("Parameter $param is not defined in $path"); + $ok = 0; + } + else + { + $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0; + } + + foreach my $paramprefix ( 'graph-legend-', 'line-style-', + 'line-color-', 'line-order-' ) + { + my $param = $paramprefix.$dname; + my $value = $config_tree->getNodeParam($token, $param); + if( not defined( $value ) ) + { + my $path = $config_tree->path( $token ); + Error('Parameter ' . $param . + ' is not defined in ' . $path); + $ok = 0; + } + elsif( $param eq 'line-style-' and + not validateLine( $value ) ) + { + my $path = $config_tree->path( $token ); + Error('Parameter ' . $param . + ' is defined incorrectly in ' . $path); + $ok = 0; + } + elsif( $param eq 'line-color-' and + not validateColor( $value ) ) + { + my $path = $config_tree->path( $token ); + Error('Parameter ' . $param . + ' is defined incorrectly in ' . $path); + $ok = 0; + } + } + } + } + elsif( $dsType eq 'rrd-file' and + $config_tree->getNodeParam( $token, 'leaf-type' ) eq 'rrd-cdef') + { + my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' ); + if( defined( $expr ) ) + { + $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0; + } + # Otherwise already reported by validateInstanceParams() + } + elsif($dsType eq 'collector' and + $config_tree->getNodeParam( $token, 'collector-type' ) eq 'snmp') + { + # Check the OID syntax + my $oid = $config_tree->getNodeParam( $token, 'snmp-object' ); + if( defined($oid) and $oid =~ /^\./o ) + { + my $path = $config_tree->path( $token ); + Error("Invalid syntax for snmp-object in " . + $path . ": OID must not start with dot"); + $ok = 0; + } + } + } + else + { + # This is subtree + my $view = $config_tree->getNodeParam( $token, + 'default-subtree-view' ); + + if( not defined( $view ) ) + { + my $path = $config_tree->path( $token ); + Error("Default view is not defined for subtree $path"); + $ok = 0; + } + elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and + not $config_tree->viewExists( $view ) ) + { + my $path = $config_tree->path( $token ); + Error("Non-existent view is defined as default for subtree $path"); + $ok = 0; + } + else + { + # Store the cache + $config_tree->{'validator'}{'viewExists'}{$view} = 1; + } + + foreach my $ctoken ( $config_tree->getChildren($token) ) + { + if( not $config_tree->isAlias($ctoken) ) + { + $ok = validateNode($config_tree, $ctoken) + ? $ok:0; + } + } + } + return $ok; +} + +my %validFuntcionNames = + ( 'AVERAGE' => 1, + 'MIN' => 1, + 'MAX' => 1, + 'LAST' => 1, + 'T' => 1 ); + + +sub validateRPN +{ + my $token = shift; + my $expr = shift; + my $config_tree = shift; + my $timeoffset_supported = shift; + + &Torrus::DB::checkInterrupted(); + + my $ok = 1; + + # There must be at least one DS reference + my $ds_couter = 0; + + my $rpn = new Torrus::RPN; + + # The callback for RPN translation + my $callback = sub + { + my ($noderef, $timeoffset) = @_; + + my $function; + if( $noderef =~ s/^(.+)\@//o ) + { + $function = $1; + } + + if( defined( $function ) and not $validFuntcionNames{$function} ) + { + my $path = $config_tree->path($token); + Error('Invalid function name ' . $function . + ' in node reference at ' . $path); + $ok = 0; + return undef; + } + + my $leaf = length($noderef) > 0 ? + $config_tree->getRelative($token, $noderef) : $token; + + if( not defined $leaf ) + { + my $path = $config_tree->path($token); + Error("Cannot find relative reference $noderef at $path"); + $ok = 0; + return undef; + } + if( not $config_tree->isLeaf( $leaf ) ) + { + my $path = $config_tree->path($token); + Error("Relative reference $noderef at $path is not a leaf"); + $ok = 0; + return undef; + } + if( $config_tree->getNodeParam($leaf, 'leaf-type') ne 'rrd-def' ) + { + my $path = $config_tree->path($token); + Error("Relative reference $noderef at $path must point to a ". + "leaf of type rrd-def"); + $ok = 0; + return undef; + } + if( defined( $timeoffset ) and not $timeoffset_supported ) + { + my $path = $config_tree->path($token); + Error("Time offsets are not supported at $path"); + $ok = 0; + return undef; + } + + $ds_couter++; + return 'TESTED'; + }; + + $rpn->translate( $expr, $callback ); + if( $ok and $ds_couter == 0 ) + { + my $path = $config_tree->path($token); + Error("RPN must contain at least one DS reference at $path"); + $ok = 0; + } + return $ok; +} + + + +sub validateViews +{ + my $config_tree = shift; + my $ok = 1; + + foreach my $view ($config_tree->getViewNames()) + { + &Torrus::DB::checkInterrupted(); + + $ok = validateInstanceParams($config_tree, $view, + 'view', \%view_params) ? $ok:0; + if( $ok and $config_tree->getParam($view, 'view-type') eq 'rrgraph' ) + { + my $hrulesList = $config_tree->getParam($view, 'hrules'); + if( defined( $hrulesList ) ) + { + foreach my $hrule ( split(',', $hrulesList ) ) + { + my $valueParam = + $config_tree->getParam($view, 'hrule-value-' . $hrule); + if( not defined( $valueParam ) or $valueParam !~ /^\S+$/o ) + { + Error('Mandatory parameter hrule-value-' . $hrule . + ' is not defined or incorrect for view ' . + $view); + $ok = 0; + } + my $color = + $config_tree->getParam($view, 'hrule-color-'.$hrule); + if( not defined( $color ) ) + { + Error('Mandatory parameter hrule-color-' . $hrule . + ' is not defined for view ' . $view); + $ok = 0; + } + else + { + $ok = validateColor( $color ) ? $ok:0; + } + } + } + + my $decorList = $config_tree->getParam($view, 'decorations'); + if( defined( $decorList ) ) + { + foreach my $decorName ( split(',', $decorList ) ) + { + foreach my $paramName ( qw(order style color expr) ) + { + my $param = 'dec-' . $paramName . '-' . $decorName; + if( not defined( $config_tree-> + getParam($view, $param) ) ) + { + Error('Missing parameter: ' . $param . + ' in view ' . $view); + $ok = 0; + } + } + + $ok = validateLine( $config_tree-> + getParam($view, + 'dec-style-' . $decorName) ) + ? $ok:0; + $ok = validateColor( $config_tree-> + getParam($view, + 'dec-color-' . $decorName) ) + ? $ok:0; + } + } + + $ok = validateColor( $config_tree->getParam($view, 'line-color') ) + ? $ok:0; + $ok = validateLine( $config_tree->getParam($view, 'line-style') ) + ? $ok:0; + + my $gprintValues = $config_tree->getParam($view, 'gprint-values'); + if( defined( $gprintValues ) and length( $gprintValues ) > 0 ) + { + foreach my $gprintVal ( split(',', $gprintValues ) ) + { + my $format = + $config_tree->getParam($view, + 'gprint-format-' . $gprintVal); + if( not defined( $format ) or length( $format ) == 0 ) + { + Error('GPRINT format for ' . $gprintVal . + ' is not defined for view ' . $view); + $ok = 0; + } + } + } + } + } + return $ok; +} + + +sub validateColor +{ + my $color = shift; + my $ok = 1; + + if( $color !~ /^\#[0-9a-fA-F]{6}$/o ) + { + if( $color =~ /^\#\#(\S+)$/o ) + { + if( not $Torrus::Renderer::graphStyles{$1}{'color'} ) + { + Error('Incorrect color reference: ' . $color); + $ok = 0; + } + } + else + { + Error('Incorrect color syntax: ' . $color); + $ok = 0; + } + } + + return $ok; +} + + +sub validateLine +{ + my $line = shift; + my $ok = 1; + + if( $line =~ /^\#\#(\S+)$/o ) + { + if( not $Torrus::Renderer::graphStyles{$1}{'line'} ) + { + Error('Incorrect line style reference: ' . $line); + $ok = 0; + } + } + elsif( not $Torrus::SiteConfig::validLineStyles{$line} ) + { + Error('Incorrect line syntax: ' . $line); + $ok = 0; + } + + return $ok; +} + + +sub validateMonitors +{ + my $config_tree = shift; + my $ok = 1; + + foreach my $action ($config_tree->getActionNames()) + { + $ok = validateInstanceParams($config_tree, $action, + 'action', \%action_params) ? $ok:0; + my $atype = $config_tree->getParam($action, 'action-type'); + if( $atype eq 'tset' ) + { + my $tset = $config_tree->getParam($action, 'tset-name'); + if( defined $tset ) + { + $tset = 'S'.$tset; + if( not $config_tree->tsetExists( $tset ) ) + { + Error("Token-set does not exist: $tset in action $action"); + $ok = 0; + } + } + # Otherwise the error is already reported by validateInstanceParams + } + elsif( $atype eq 'exec' ) + { + my $launch_when = $config_tree->getParam($action, 'launch-when'); + if( defined $launch_when ) + { + foreach my $when ( split(',', $launch_when) ) + { + my $matched = 0; + foreach my $event ('set', 'repeat', 'clear', 'forget') + { + if( $when eq $event ) + { + $matched = 1; + } + } + if( not $matched ) + { + if( $when eq 'throw' ) + { + Error('Event type "throw" is no longer ' . + 'supported. Replace with "set".'); + } + else + { + Error("Invalid value in parameter launch-when " . + "in action $action: $when"); + } + $ok = 0; + } + } + } + + my $setenv_dataexpr = + $config_tree->getParam( $action, 'setenv-dataexpr' ); + + if( defined( $setenv_dataexpr ) ) + { + # + + foreach my $pair ( split( ',', $setenv_dataexpr ) ) + { + my ($env, $param) = split( '=', $pair ); + if( not $param ) + { + Error("Syntax error in setenv-dataexpr in action " . + $action . ": \"" . $pair . "\""); + $ok = 0; + } + elsif( $env =~ /\W/o ) + { + Error("Illegal characters in environment variable ". + "name in setenv-dataexpr in action " . $action . + ": \"" . $env . "\""); + $ok = 0; + } + elsif( not defined ($config_tree->getParam( $action, + $param ) ) ) + { + Error("Parameter referenced in setenv-dataexpr is " . + "not defined in action " . + $action . ": " . $param); + $ok = 0; + } + } + } + } + } + + foreach my $monitor ($config_tree->getMonitorNames()) + { + $ok = validateInstanceParams($config_tree, $monitor, + 'monitor', \%monitor_params) ? $ok:0; + my $alist = $config_tree->getParam( $monitor, 'action' ); + foreach my $action ( split(',', $alist ) ) + { + if( not $config_tree->actionExists( $action ) ) + { + Error("Non-existent action: $action in monitor $monitor"); + $ok = 0; + } + } + } + return $ok; +} + + +sub validateTokensets +{ + my $config_tree = shift; + my $ok = 1; + + my $view = $config_tree->getParam( 'SS', 'default-tsetlist-view' ); + if( not defined( $view ) ) + { + Error("View is not defined for tokensets list"); + $ok = 0; + } + elsif( not $config_tree->viewExists( $view ) ) + { + Error("Non-existent view is defined for tokensets list"); + $ok = 0; + } + + foreach my $tset ($config_tree->getTsets()) + { + &Torrus::DB::checkInterrupted(); + + $view = $config_tree->getParam($tset, 'default-tset-view'); + if( not defined( $view ) ) + { + $view = $config_tree->getParam('SS', 'default-tset-view'); + } + + if( not defined( $view ) ) + { + Error("Default view is not defined for tokenset $tset"); + $ok = 0; + } + elsif( not $config_tree->viewExists( $view ) ) + { + Error("Non-existent view is defined for tokenset $tset"); + $ok = 0; + } + } + return $ok; +} + + + + +sub validateInstanceParams +{ + my $config_tree = shift; + my $inst_name = shift; + my $inst_type = shift; + my $mapref = shift; + + &Torrus::DB::checkInterrupted(); + + # Debug("Validating $inst_type $inst_name"); + + my $ok = 1; + my @namemaps = ($mapref); + + while( $ok and scalar(@namemaps) > 0 ) + { + my @next_namemaps = (); + + foreach my $namemap (@namemaps) + { + foreach my $paramkey (keys %{$namemap}) + { + # Debug("Checking param: $pname"); + + my $pname = $paramkey; + my $mandatory = 1; + if( $pname =~ s/^\+//o ) + { + $mandatory = 0; + } + + my $listval = 0; + if( $pname =~ s/^\@//o ) + { + $listval = 1; + } + + my $pvalue = + $config_tree->getInstanceParam($inst_type, + $inst_name, $pname); + + my @pvalues; + if( $listval ) + { + @pvalues = split(',', $pvalue); + } + else + { + @pvalues = ( $pvalue ); + } + + if( not defined( $pvalue ) ) + { + if( $mandatory ) + { + my $msg; + if( $inst_type eq 'node' ) + { + $msg = $config_tree->path( $inst_name ); + } + else + { + $msg = "$inst_type $inst_name"; + } + Error("Mandatory parameter $pname is not ". + "defined for $msg"); + $ok = 0; + } + } + else + { + if( ref( $namemap->{$paramkey} ) ) + { + foreach my $pval ( @pvalues ) + { + if( exists $namemap->{$paramkey}->{$pval} ) + { + if( defined $namemap->{$paramkey}->{$pval} ) + { + push( @next_namemaps, + $namemap->{$paramkey}->{$pval} ); + } + } + else + { + my $msg; + if( $inst_type eq 'node' ) + { + $msg = $config_tree->path( $inst_name ); + } + else + { + $msg = "$inst_type $inst_name"; + } + Error("Parameter $pname has ". + "unknown value: $pval for $msg"); + $ok = 0; + } + } + } + } + } + } + @namemaps = @next_namemaps; + } + return $ok; +} + + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ConfigTree/Writer.pm b/torrus/perllib/Torrus/ConfigTree/Writer.pm new file mode 100644 index 000000000..9c1af8f86 --- /dev/null +++ b/torrus/perllib/Torrus/ConfigTree/Writer.pm @@ -0,0 +1,755 @@ +# Copyright (C) 2002-2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Writer.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $ +# Stanislav Sinyagin + +# +# Write access for ConfigTree +# + +package Torrus::ConfigTree::Writer; + +use Torrus::ConfigTree; +our @ISA=qw(Torrus::ConfigTree); + +use Torrus::Log; +use Torrus::TimeStamp; +use Torrus::SiteConfig; +use Torrus::ServiceID; + +use strict; +use Digest::MD5 qw(md5); # needed as hash function + + +our %multigraph_remove_space = + ('ds-expr-' => 1, + 'graph-legend-' => 0); + + +# instance of Torrus::ServiceID object, if needed +my $srvIdParams; + +# tree names where we initialized service IDs +my %srvIdInitialized; + + +sub new +{ + my $proto = shift; + my %options = @_; + my $class = ref($proto) || $proto; + $options{'-WriteAccess'} = 1; + my $self = $class->SUPER::new( %options ); + if( not defined( $self ) ) + { + return undef; + } + + bless $self, $class; + + $self->{'viewparent'} = {}; + $self->{'mayRunCollector'} = + Torrus::SiteConfig::mayRunCollector( $self->treeName() ); + + $self->{'collectorInstances'} = + Torrus::SiteConfig::collectorInstances( $self->treeName() ); + + $self->{'db_collectortokens'} = []; + foreach my $instance ( 0 .. ($self->{'collectorInstances'} - 1) ) + { + $self->{'db_collectortokens'}->[$instance] = + new Torrus::DB( 'collector_tokens' . '_' . + $instance . '_' . $self->{'ds_config_instance'}, + -Subdir => $self->treeName(), + -WriteAccess => 1, + -Truncate => 1 ); + } + + # delay writing of frequently changed values + $self->{'db_dsconfig'}->delay(); + $self->{'db_otherconfig'}->delay(); + return $self; +} + + +sub newToken +{ + my $self = shift; + my $token = $self->{'next_free_token'}; + $token = 1 unless defined( $token ); + $self->{'next_free_token'} = $token + 1; + return sprintf('T%.4d', $token); +} + + +sub setParam +{ + my $self = shift; + my $name = shift; + my $param = shift; + my $value = shift; + + if( $self->getParamProperty( $param, 'remspace' ) ) + { + $value =~ s/\s+//go; + } + + $self->{'paramcache'}{$name}{$param} = $value; + $self->{'db_otherconfig'}->put( 'P:'.$name.':'.$param, $value ); + $self->{'db_otherconfig'}->addToList('Pl:'.$name, $param); +} + +sub setNodeParam +{ + my $self = shift; + my $name = shift; + my $param = shift; + my $value = shift; + + if( $self->getParamProperty( $param, 'remspace' ) ) + { + $value =~ s/\s+//go; + } + + $self->{'paramcache'}{$name}{$param} = $value; + $self->{'db_dsconfig'}->put( 'P:'.$name.':'.$param, $value ); + $self->{'db_dsconfig'}->addToList('Pl:'.$name, $param); +} + + +sub setParamProperty +{ + my $self = shift; + my $param = shift; + my $prop = shift; + my $value = shift; + + $self->{'paramprop'}{$prop}{$param} = $value; + $self->{'db_paramprops'}->put( $param . ':' . $prop, $value ); +} + + +sub initRoot +{ + my $self = shift; + if( not defined( $self->token('/') ) ) + { + my $token = $self->newToken(); + $self->{'db_dsconfig'}->put( 'pt:/', $token ); + $self->{'db_dsconfig'}->put( 'tp:'.$token, '/' ); + $self->{'db_dsconfig'}->put( 'n:'.$token, 0 ); + $self->{'nodetype_cache'}{$token} = 0; + } +} + +sub addChild +{ + my $self = shift; + my $token = shift; + my $childname = shift; + my $isAlias = shift; + + if( not $self->isSubtree( $token ) ) + { + Error('Cannot add a child to a non-subtree node: ' . + $self->path($token)); + return undef; + } + + my $path = $self->path($token) . $childname; + + # If the child already exists, do nothing + + my $ctoken = $self->token($path); + if( not defined($ctoken) ) + { + $ctoken = $self->newToken(); + + $self->{'db_dsconfig'}->put( 'pt:'.$path, $ctoken ); + $self->{'db_dsconfig'}->put( 'tp:'.$ctoken, $path ); + + $self->{'db_dsconfig'}->addToList( 'c:'.$token, $ctoken ); + $self->{'db_dsconfig'}->put( 'p:'.$ctoken, $token ); + $self->{'parentcache'}{$ctoken} = $token; + + my $nodeType; + if( $isAlias ) + { + $nodeType = 2; # alias + } + elsif( $childname =~ /\/$/o ) + { + $nodeType = 0; # subtree + } + else + { + $nodeType = 1; # leaf + } + $self->{'db_dsconfig'}->put( 'n:'.$ctoken, $nodeType ); + $self->{'nodetype_cache'}{$ctoken} = $nodeType; + } + return $ctoken; +} + +sub setAlias +{ + my $self = shift; + my $token = shift; + my $apath = shift; + + my $ok = 1; + + my $iamLeaf = $self->isLeaf($token); + + # TODO: Add more verification here + if( not defined($apath) or $apath !~ /^\//o or + ( not $iamLeaf and $apath !~ /\/$/o ) or + ( $iamLeaf and $apath =~ /\/$/o ) ) + { + my $path = $self->path($token); + Error("Incorrect alias at $path: $apath"); $ok = 0; + } + elsif( $self->token( $apath ) ) + { + my $path = $self->path($token); + Error("Alias already exists: $apath at $path"); $ok = 0; + } + else + { + # Go through the alias and create subtrees if neccessary + + my @pathelements = $self->splitPath($apath); + my $aliasChildName = pop @pathelements; + + my $nodepath = ''; + my $parent_token = $self->token('/'); + + foreach my $nodename ( @pathelements ) + { + $nodepath .= $nodename; + my $child_token = $self->token( $nodepath ); + if( not defined( $child_token ) ) + { + $child_token = $self->addChild( $parent_token, $nodename ); + if( not defined( $child_token ) ) + { + return 0; + } + } + $parent_token = $child_token; + } + + my $alias_token = $self->addChild( $parent_token, $aliasChildName, 1 ); + if( not defined( $alias_token ) ) + { + return 0; + } + + $self->{'db_dsconfig'}->put( 'a:'.$alias_token, $token ); + $self->{'db_dsconfig'}->addToList( 'ar:'.$token, $alias_token ); + $self->{'db_aliases'}->put( $apath, $token ); + } + return $ok; +} + +sub addView +{ + my $self = shift; + my $vname = shift; + my $parent = shift; + $self->{'db_otherconfig'}->addToList('V:', $vname); + if( defined( $parent ) ) + { + $self->{'viewparent'}{$vname} = $parent; + } +} + + +sub addMonitor +{ + my $self = shift; + my $mname = shift; + $self->{'db_otherconfig'}->addToList('M:', $mname); +} + + +sub addAction +{ + my $self = shift; + my $aname = shift; + $self->{'db_otherconfig'}->addToList('A:', $aname); +} + + +sub addDefinition +{ + my $self = shift; + my $name = shift; + my $value = shift; + $self->{'db_dsconfig'}->put( 'd:'.$name, $value ); + $self->{'db_dsconfig'}->addToList('D:', $name); +} + + +sub setVar +{ + my $self = shift; + my $token = shift; + my $name = shift; + my $value = shift; + + $self->{'setvar'}{$token}{$name} = $value; +} + + +sub isTrueVar +{ + my $self = shift; + my $token = shift; + my $name = shift; + + my $ret = 0; + + while( defined( $token ) and + not defined( $self->{'setvar'}{$token}{$name} ) ) + { + $token = $self->getParent( $token ); + } + + if( defined( $token ) ) + { + my $value = $self->{'setvar'}{$token}{$name}; + if( defined( $value ) ) + { + if( $value eq 'true' or + $value =~ /^\d+$/o and $value ) + { + $ret = 1; + } + } + } + + return $ret; +} + +sub finalize +{ + my $self = shift; + my $status = shift; + + if( $status ) + { + # write delayed data + $self->{'db_dsconfig'}->commit(); + $self->{'db_otherconfig'}->commit(); + + Verbose('Configuration has compiled successfully. Switching over to ' . + 'DS config instance ' . $self->{'ds_config_instance'} . + ' and Other config instance ' . + $self->{'other_config_instance'} ); + + $self->setReady(1); + if( not $self->{'-NoDSRebuild'} ) + { + $self->{'db_config_instances'}-> + put( 'ds:' . $self->treeName(), + $self->{'ds_config_instance'} ); + } + + $self->{'db_config_instances'}-> + put( 'other:' . $self->treeName(), + $self->{'other_config_instance'} ); + + Torrus::TimeStamp::init(); + Torrus::TimeStamp::setNow($self->treeName() . ':configuration'); + Torrus::TimeStamp::release(); + } +} + + +sub postProcess +{ + my $self = shift; + + my $ok = $self->postProcessNodes(); + + # Propagate view inherited parameters + $self->{'viewParamsProcessed'} = {}; + foreach my $vname ( $self->getViewNames() ) + { + &Torrus::DB::checkInterrupted(); + + $self->propagateViewParams( $vname ); + } + return $ok; +} + + + +sub postProcessNodes +{ + my $self = shift; + my $token = shift; + + &Torrus::DB::checkInterrupted(); + + my $ok = 1; + + if( not defined( $token ) ) + { + $token = $self->token('/'); + } + + my $nodeid = $self->getNodeParam( $token, 'nodeid', 1 ); + if( defined( $nodeid ) ) + { + # verify the uniqueness of nodeid + + my $oldToken = $self->{'db_nodeid'}->get($nodeid); + if( defined($oldToken) ) + { + Error('Non-unique nodeid ' . $nodeid . + ' in ' . $self->path($token) . + ' and ' . $self->path($oldToken)); + $ok = 0; + } + else + { + $self->{'db_nodeid'}->put($nodeid, $token); + } + } + + + if( $self->isLeaf($token) ) + { + # Process static tokenset members + + my $tsets = $self->getNodeParam( $token, 'tokenset-member' ); + if( defined( $tsets ) ) + { + foreach my $tset ( split(/,/o, $tsets) ) + { + my $tsetName = 'S'.$tset; + if( not $self->tsetExists( $tsetName ) ) + { + my $path = $self->path( $token ); + Error("Referenced undefined token set $tset in $path"); + $ok = 0; + } + else + { + $self->tsetAddMember( $tsetName, $token, 'static' ); + } + } + } + + my $dsType = $self->getNodeParam( $token, 'ds-type' ); + if( defined( $dsType ) ) + { + if( $dsType eq 'rrd-multigraph' ) + { + # Expand parameter substitutions in multigraph leaves + + my @dsNames = + split(/,/o, $self->getNodeParam($token, 'ds-names') ); + + foreach my $dname ( @dsNames ) + { + foreach my $param ( 'ds-expr-', 'graph-legend-' ) + { + my $dsParam = $param . $dname; + my $value = $self->getNodeParam( $token, $dsParam ); + if( defined( $value ) ) + { + my $newValue = $value; + if( $multigraph_remove_space{$param} ) + { + $newValue =~ s/\s+//go; + } + $newValue = + $self->expandSubstitutions( $token, $dsParam, + $newValue ); + if( $newValue ne $value ) + { + $self->setNodeParam( $token, $dsParam, + $newValue ); + } + } + } + } + } + elsif( $dsType eq 'collector' and $self->{'mayRunCollector'} ) + { + # Split the collecting job between collector instances + my $instance = 0; + my $nInstances = $self->{'collectorInstances'}; + + my $oldOffset = + $self->getNodeParam($token, 'collector-timeoffset'); + my $newOffset = $oldOffset; + + my $period = + $self->getNodeParam($token, 'collector-period'); + + if( $nInstances > 1 ) + { + my $hashString = + $self->getNodeParam($token, + 'collector-instance-hashstring'); + if( not defined( $hashString ) ) + { + Error('collector-instance-hashstring is not defined ' . + 'in ' . $self->path( $token )); + $hashString = ''; + } + + $instance = + unpack( 'N', md5( $hashString ) ) % $nInstances; + } + + $self->setNodeParam( $token, + 'collector-instance', + $instance ); + + my $dispersed = + $self->getNodeParam($token, + 'collector-dispersed-timeoffset'); + if( defined( $dispersed ) and $dispersed eq 'yes' ) + { + # Process dispersed collector offsets + + my %p; + foreach my $param ( 'collector-timeoffset-min', + 'collector-timeoffset-max', + 'collector-timeoffset-step', + 'collector-timeoffset-hashstring' ) + { + my $val = $self->getNodeParam( $token, $param ); + if( not defined( $val ) ) + { + Error('Mandatory parameter ' . $param . ' is not '. + ' defined in ' . $self->path( $token )); + $ok = 0; + } + else + { + $p{$param} = $val; + } + } + + if( $ok ) + { + my $min = $p{'collector-timeoffset-min'}; + my $max = $p{'collector-timeoffset-max'}; + if( $max < $min ) + { + Error('collector-timeoffset-max is less than ' . + 'collector-timeoffset-min in ' . + $self->path( $token )); + $ok = 0; + } + else + { + my $step = $p{'collector-timeoffset-step'}; + my $hashString = + $p{'collector-timeoffset-hashstring'}; + + my $bucketSize = int( ($max - $min) / $step ); + $newOffset = + $min + + + $step * ( unpack( 'N', md5( $hashString ) ) % + $bucketSize ) + + + $instance * int( $step / $nInstances ); + } + } + } + else + { + $newOffset += $instance * int( $period / $nInstances ); + } + + $newOffset %= $period; + + if( $newOffset != $oldOffset ) + { + $self->setNodeParam( $token, + 'collector-timeoffset', + $newOffset ); + } + + $self->{'db_collectortokens'}->[$instance]->put + ( $token, sprintf('%d:%d', $period, $newOffset) ); + + my $storagetypes = + $self->getNodeParam( $token, 'storage-type' ); + foreach my $stype ( split(/,/o, $storagetypes) ) + { + if( $stype eq 'ext' ) + { + if( not defined( $srvIdParams ) ) + { + $srvIdParams = + new Torrus::ServiceID( -WriteAccess => 1 ); + } + + my $srvTrees = + $self->getNodeParam($token, 'ext-service-trees'); + + if( not defined( $srvTrees ) or + length( $srvTrees ) == 0 ) + { + $srvTrees = $self->treeName(); + } + + my $serviceid = + $self->getNodeParam($token, 'ext-service-id'); + + foreach my $srvTree (split(/\s*,\s*/o, $srvTrees)) + { + if( not Torrus::SiteConfig::treeExists($srvTree) ) + { + Error + ('Error processing ext-service-trees' . + 'for ' . $self->path( $token ) . + ': tree ' . $srvTree . + ' does not exist'); + $ok = 0; + } + else + { + if( not $srvIdInitialized{$srvTree} ) + { + $srvIdParams->cleanAllForTree + ( $srvTree ); + $srvIdInitialized{$srvTree} = 1; + } + else + { + if( $srvIdParams->idExists( $serviceid, + $srvTree ) ) + { + Error('Duplicate ServiceID: ' . + $serviceid . ' in tree ' . + $srvTree); + $ok = 0; + } + } + } + } + + if( $ok ) + { + # sorry for ackward Emacs auto-indent + my $params = { + 'trees' => $srvTrees, + 'token' => $token, + 'dstype' => + $self->getNodeParam($token, + 'ext-dstype'), + 'units' => + $self->getNodeParam + ($token, 'ext-service-units') + }; + + $srvIdParams->add( $serviceid, $params ); + } + } + } + } + } + else + { + my $path = $self->path( $token ); + Error("Mandatory parameter 'ds-type' is not defined for $path"); + $ok = 0; + } + } + else + { + foreach my $ctoken ( $self->getChildren( $token ) ) + { + if( not $self->isAlias( $ctoken ) ) + { + $ok = $self->postProcessNodes( $ctoken ) ? $ok:0; + } + } + } + return $ok; +} + + +sub propagateViewParams +{ + my $self = shift; + my $vname = shift; + + # Avoid processing the same view twice + if( $self->{'viewParamsProcessed'}{$vname} ) + { + return; + } + + # First we do the same for parent + my $parent = $self->{'viewparent'}{$vname}; + if( defined( $parent ) ) + { + $self->propagateViewParams( $parent ); + + my $parentParams = $self->getParams( $parent ); + foreach my $param ( keys %{$parentParams} ) + { + if( not defined( $self->getParam( $vname, $param ) ) ) + { + $self->setParam( $vname, $param, $parentParams->{$param} ); + } + } + } + + # mark this view as processed + $self->{'viewParamsProcessed'}{$vname} = 1; +} + + +sub validate +{ + my $self = shift; + + my $ok = 1; + + $self->{'is_writing'} = undef; + + if( not $self->{'-NoDSRebuild'} ) + { + $ok = Torrus::ConfigTree::Validator::validateNodes($self); + } + $ok = Torrus::ConfigTree::Validator::validateViews($self) ? $ok:0; + $ok = Torrus::ConfigTree::Validator::validateMonitors($self) ? $ok:0; + $ok = Torrus::ConfigTree::Validator::validateTokensets($self) ? $ok:0; + + return $ok; +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm new file mode 100644 index 000000000..0874270da --- /dev/null +++ b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm @@ -0,0 +1,548 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: XMLCompiler.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $ +# Stanislav Sinyagin + + +package Torrus::ConfigTree::XMLCompiler; + +use Torrus::ConfigTree::Writer; +our @ISA=qw(Torrus::ConfigTree::Writer); + +use Torrus::ConfigTree; +use Torrus::ConfigTree::Validator; +use Torrus::SiteConfig; +use Torrus::Log; +use Torrus::TimeStamp; + +use XML::LibXML; +use strict; + +sub new +{ + my $proto = shift; + my %options = @_; + my $class = ref($proto) || $proto; + + $options{'-Rebuild'} = 1; + + my $self = $class->SUPER::new( %options ); + if( not defined( $self ) ) + { + return undef; + } + + bless $self, $class; + + if( $options{'-NoDSRebuild'} ) + { + $self->{'-NoDSRebuild'} = 1; + } + + $self->{'files_processed'} = {}; + + return $self; +} + + +sub compile +{ + my $self = shift; + my $filename = shift; + + &Torrus::DB::checkInterrupted(); + + $filename = Torrus::SiteConfig::findXMLFile($filename); + if( not defined( $filename ) ) + { + return 0; + } + + # Make sure we process each file only once + if( $self->{'files_processed'}{$filename} ) + { + return 1; + } + else + { + $self->{'files_processed'}{$filename} = 1; + } + + Verbose('Compiling ' . $filename); + + my $ok = 1; + my $parser = new XML::LibXML; + my $doc; + eval { $doc = $parser->parse_file( $filename ); }; + if( $@ ) + { + Error("Failed to parse $filename: $@"); + return 0; + } + + my $root = $doc->documentElement(); + + # Initialize the '/' element + $self->initRoot(); + + my $node; + + # First of all process all pre-required files + foreach $node ( $root->getElementsByTagName('include') ) + { + my $incfile = $node->getAttribute('filename'); + if( not $incfile ) + { + Error("No filename given in include statement in $filename"); + $ok = 0; + } + else + { + $ok = $self->compile( $incfile ) ? $ok:0; + } + } + + foreach $node ( $root->getElementsByTagName('param-properties') ) + { + $ok = $self->compile_paramprops( $node ) ? $ok:0; + } + + if( not $self->{'-NoDSRebuild'} ) + { + foreach $node ( $root->getElementsByTagName('definitions') ) + { + $ok = $self->compile_definitions( $node ) ? $ok:0; + } + + foreach $node ( $root->getElementsByTagName('datasources') ) + { + $ok = $self->compile_ds( $node ) ? $ok:0; + } + } + + foreach $node ( $root->getElementsByTagName('monitors') ) + { + $ok = $self->compile_monitors( $node ) ? $ok:0; + } + + foreach $node ( $root->getElementsByTagName('token-sets') ) + { + $ok = $self->compile_tokensets( $node ) ? $ok:0; + } + + foreach $node ( $root->getElementsByTagName('views') ) + { + $ok = $self->compile_views( $node ) ? $ok:0; + } + + return $ok; +} + + +sub compile_definitions +{ + my $self = shift; + my $node = shift; + my $ok = 1; + + foreach my $def ( $node->getChildrenByTagName('def') ) + { + &Torrus::DB::checkInterrupted(); + + my $name = $def->getAttribute('name'); + my $value = $def->getAttribute('value'); + if( not $name ) + { + Error("Definition without a name"); $ok = 0; + } + elsif( not $value ) + { + Error("Definition without value: $name"); $ok = 0; + } + elsif( defined $self->getDefinition($name) ) + { + Error("Duplicate definition: $name"); $ok = 0; + } + else + { + $self->addDefinition($name, $value); + } + } + return $ok; +} + + +sub compile_paramprops +{ + my $self = shift; + my $node = shift; + my $ok = 1; + + foreach my $def ( $node->getChildrenByTagName('prop') ) + { + &Torrus::DB::checkInterrupted(); + + my $param = $def->getAttribute('param'); + my $prop = $def->getAttribute('prop'); + my $value = $def->getAttribute('value'); + if( not $param or not $prop or not defined($value) ) + { + Error("Property definition error"); $ok = 0; + } + else + { + $self->setParamProperty($param, $prop, $value); + } + } + return $ok; +} + + + +# Process and put them into DB. +# Usage: $self->compile_params($node, $name); + +sub compile_params +{ + my $self = shift; + my $node = shift; + my $name = shift; + my $isDS = shift; + + &Torrus::DB::checkInterrupted(); + + my $ok = 1; + foreach my $p_node ( $node->getChildrenByTagName('param') ) + { + my $param = $p_node->getAttribute('name'); + my $value = $p_node->getAttribute('value'); + if( not defined($value) ) + { + $value = $p_node->textContent(); + } + if( not $param ) + { + Error("Parameter without name in $name"); $ok = 0; + } + else + { + # Remove spaces in the head and tail. + $value =~ s/^\s+//om; + $value =~ s/\s+$//om; + + if( $isDS ) + { + $self->setNodeParam($name, $param, $value); + } + else + { + $self->setParam($name, $param, $value); + } + } + } + return $ok; +} + + +sub compile_ds +{ + my $self = shift; + my $ds_node = shift; + my $ok = 1; + + # First, process templates. We expect them to be direct children of + # + + foreach my $template ( $ds_node->getChildrenByTagName('template') ) + { + my $name = $template->getAttribute('name'); + if( not $name ) + { + Error("Template without a name"); $ok = 0; + } + elsif( defined $self->{'Templates'}->{$name} ) + { + Error("Duplicate template names: $name"); $ok = 0; + } + else + { + $self->{'Templates'}->{$name} = $template; + } + } + + # Recursively traverse the tree + $ok = $self->compile_subtrees( $ds_node, $self->token('/') ) ? $ok:0; + + return $ok; +} + + + + +sub validate_nodename +{ + my $self = shift; + my $name = shift; + + return ( $name =~ /^[0-9A-Za-z_\-\.\:]+$/o and + $name !~ /\.\./o ); +} + +sub compile_subtrees +{ + my $self = shift; + my $node = shift; + my $token = shift; + my $iamLeaf = shift; + + my $ok = 1; + + # Apply templates + + foreach my $templateapp ( $node->getChildrenByTagName('apply-template') ) + { + my $name = $templateapp->getAttribute('name'); + if( not $name ) + { + my $path = $self->path($token); + Error("Template application without a name at $path"); $ok = 0; + } + else + { + my $template = $self->{'Templates'}->{$name}; + if( not defined $template ) + { + my $path = $self->path($token); + Error("Cannot find template named $name at $path"); $ok = 0; + } + else + { + $ok = $self->compile_subtrees + ($template, $token, $iamLeaf) ? $ok:0; + } + } + } + + $ok = $self->compile_params($node, $token, 1); + + # Handle aliases -- we are still in compile_subtrees() + + foreach my $alias ( $node->getChildrenByTagName('alias') ) + { + my $apath = $alias->textContent(); + $apath =~ s/\s+//mgo; + $ok = $self->setAlias($token, $apath) ? $ok:0; + } + + foreach my $setvar ( $node->getChildrenByTagName('setvar') ) + { + my $name = $setvar->getAttribute('name'); + my $value = $setvar->getAttribute('value'); + if( not defined( $name ) or not defined( $value ) ) + { + my $path = $self->path($token); + Error("Setvar statement without name or value in $path"); $ok = 0; + } + else + { + $self->setVar( $token, $name, $value ); + } + } + + # Compile-time variables + + foreach my $iftrue ( $node->getChildrenByTagName('iftrue') ) + { + my $var = $iftrue->getAttribute('var'); + if( not defined( $var ) ) + { + my $path = $self->path($token); + Error("Iftrue statement without variable name in $path"); $ok = 0; + } + elsif( $self->isTrueVar( $token, $var ) ) + { + $ok = $self->compile_subtrees( $iftrue, $token, $iamLeaf ) ? $ok:0; + } + } + + foreach my $iffalse ( $node->getChildrenByTagName('iffalse') ) + { + my $var = $iffalse->getAttribute('var'); + if( not defined( $var ) ) + { + my $path = $self->path($token); + Error("Iffalse statement without variable name in $path"); $ok = 0; + } + elsif( not $self->isTrueVar( $token, $var ) ) + { + $ok = $self->compile_subtrees + ( $iffalse, $token, $iamLeaf ) ? $ok:0; + } + } + + + # Compile child nodes -- the last part of compile_subtrees() + + if( not $iamLeaf ) + { + foreach my $subtree ( $node->getChildrenByTagName('subtree') ) + { + my $name = $subtree->getAttribute('name'); + if( not defined( $name ) or length( $name ) == 0 ) + { + my $path = $self->path($token); + Error("Subtree without a name at $path"); $ok = 0; + } + else + { + if( $self->validate_nodename( $name ) ) + { + my $stoken = $self->addChild($token, $name.'/'); + $ok = $self->compile_subtrees( $subtree, $stoken ) ? $ok:0; + } + else + { + my $path = $self->path($token); + Error("Invalid subtree name: $name at $path"); $ok = 0; + } + } + } + + foreach my $leaf ( $node->getChildrenByTagName('leaf') ) + { + my $name = $leaf->getAttribute('name'); + if( not defined( $name ) or length( $name ) == 0 ) + { + my $path = $self->path($token); + Error("Leaf without a name at $path"); $ok = 0; + } + else + { + if( $self->validate_nodename( $name ) ) + { + my $ltoken = $self->addChild($token, $name); + $ok = $self->compile_subtrees( $leaf, $ltoken, 1 ) ? $ok:0; + } + else + { + my $path = $self->path($token); + Error("Invalid leaf name: $name at $path"); $ok = 0; + } + } + } + } + return $ok; +} + + +sub compile_monitors +{ + my $self = shift; + my $mon_node = shift; + my $ok = 1; + + foreach my $monitor ( $mon_node->getChildrenByTagName('monitor') ) + { + my $mname = $monitor->getAttribute('name'); + if( not $mname ) + { + Error("Monitor without a name"); $ok = 0; + } + else + { + $ok = $self->addMonitor( $mname ); + $ok = $self->compile_params($monitor, $mname) ? $ok:0; + } + } + + foreach my $action ( $mon_node->getChildrenByTagName('action') ) + { + my $aname = $action->getAttribute('name'); + if( not $aname ) + { + Error("Action without a name"); $ok = 0; + } + else + { + $self->addAction( $aname ); + $ok = $self->compile_params($action, $aname); + } + } + return $ok; +} + + +sub compile_tokensets +{ + my $self = shift; + my $tsets_node = shift; + my $ok = 1; + + $ok = $self->compile_params($tsets_node, 'SS') ? $ok:0; + + foreach my $tokenset ( $tsets_node->getChildrenByTagName('token-set') ) + { + my $sname = $tokenset->getAttribute('name'); + if( not $sname ) + { + Error("Token-set without a name"); $ok = 0; + } + else + { + $sname = 'S'. $sname; + $ok = $self->addTset( $sname ); + $ok = $self->compile_params($tokenset, $sname) ? $ok:0; + } + } + return $ok; +} + + +sub compile_views +{ + my $self = shift; + my $vw_node = shift; + my $parentname = shift; + my $ok = 1; + + foreach my $view ( $vw_node->getChildrenByTagName('view') ) + { + my $vname = $view->getAttribute('name'); + if( not $vname ) + { + Error("View without a name"); $ok = 0; + } + else + { + $self->addView( $vname, $parentname ); + $ok = $self->compile_params( $view, $vname ) ? $ok:0; + # Process child views + $ok = $self->compile_views( $view, $vname ) ? $ok:0; + } + } + return $ok; +} + + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DB.pm b/torrus/perllib/Torrus/DB.pm new file mode 100644 index 000000000..4d600f966 --- /dev/null +++ b/torrus/perllib/Torrus/DB.pm @@ -0,0 +1,703 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: DB.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::DB; + +use Torrus::Log; +use BerkeleyDB; +use strict; + + +# This is an abstraction layer for BerkeleyDB database operations +# +# Database opening: +# my $db = new Torrus::DB('db_name', +# [ -Btree => 1, ] +# [ -WriteAccess => 1, ] +# [ -Truncate => 1, ] +# [ -Subdir => 'dirname' ]); +# Defaults: Hash, read-only, no truncate. +# +# Database closing: +# undef $db; +# +# Database cleaning: +# $status = $db->trunc(); +# + +END +{ + &Torrus::DB::cleanupEnvironment(); +} + +sub new +{ + my $self = {}; + my $class = shift; + my $dbname = shift; + my %options = @_; + bless $self, $class; + + if( not defined($Torrus::DB::env) ) + { + if( not defined $Torrus::Global::dbHome ) + { + Error('$Torrus::Global::dbHome must be defined ' . + 'in torrus_config.pl'); + return undef; + } + elsif( not -d $Torrus::Global::dbHome ) + { + Error("No such directory: $Torrus::Global::dbHome" ); + return undef; + } + else + { + $Torrus::DB::dbEnvErrFile = + $Torrus::Global::logDir . '/dbenv_errlog_' . $$; + + Debug("Creating BerkeleyDB::Env"); + umask 0002; + $Torrus::DB::env = + new BerkeleyDB::Env(-Home => $Torrus::Global::dbHome, + -Flags => (DB_CREATE | + DB_INIT_CDB | DB_INIT_MPOOL), + -Mode => 0664, + -ErrFile => $Torrus::DB::dbEnvErrFile); + if( not defined($Torrus::DB::env) ) + { + Error("Cannot create BerkeleyDB Environment: ". + $BerkeleyDB::Error); + return undef; + } + } + } + + my $filename = $dbname.'.db'; + + if( $options{'-Subdir'} ) + { + my $dirname = $Torrus::Global::dbHome . '/' . $Torrus::DB::dbSub; + if( not -d $dirname and not mkdir( $dirname ) ) + { + Error("Cannot create directory $dirname: $!"); + return undef; + } + $dirname .= '/' . $options{'-Subdir'}; + if( not -d $dirname and not mkdir( $dirname ) ) + { + Error("Cannot create directory $dirname: $!"); + return undef; + } + $filename = + $Torrus::DB::dbSub . '/' . $options{'-Subdir'} . '/' . $filename; + } + + # we need this in DESTROY debug message + $self->{'dbname'} = $filename; + + my %hash; + + my $accmethod = $options{'-Btree'} ? + 'BerkeleyDB::Btree':'BerkeleyDB::Hash'; + + my $flags = DB_RDONLY; + + if( $options{'-WriteAccess'} ) + { + $flags = DB_CREATE; + } + + my $property = 0; + if( $options{'-Duplicates'} ) + { + $property = DB_DUP | DB_DUPSORT; + } + + if( not exists( $Torrus::DB::dbPool{$filename} ) ) + { + Debug('Opening ' . $self->{'dbname'}); + + my $dbh = new $accmethod ( + -Filename => $filename, + -Flags => $flags, + -Property => $property, + -Mode => 0664, + -Env => $Torrus::DB::env ); + if( not $dbh ) + { + Error("Cannot open database $filename: $! $BerkeleyDB::Error"); + return undef; + } + + $Torrus::DB::dbPool{$filename} = { 'dbh' => $dbh, + 'accmethod' => $accmethod, + 'flags' => $flags }; + + $self->{'dbh'} = $dbh; + } + else + { + my $ref = $Torrus::DB::dbPool{$filename}; + if( $ref->{'accmethod'} eq $accmethod and $ref->{'flags'} eq $flags ) + { + $self->{'dbh'} = $ref->{'dbh'}; + } + else + { + Error('Database in dbPool has different flags: ' . + $self->{'dbname'}); + return undef; + } + } + + if( $options{'-Truncate'} ) + { + $self->trunc(); + } + + if( $options{'-Delayed'} ) + { + $self->{'delay_list_commit'} = 1; + } + + return $self; +} + + +# It is strongly inadvisable to do anything inside a signal handler when DB +# operation is in progress + +our $interrupted = 0; + +my $signalHandlersSet = 0; +my $safeSignals = 0; + + + + + +sub setSignalHandlers +{ + if( $signalHandlersSet ) + { + return; + } + + $SIG{'TERM'} = sub { + if( $safeSignals ) + { + Warn('Received SIGTERM. Scheduling to exit.'); + $interrupted = 1; + } + else + { + Warn('Received SIGTERM. Stopping the process.'); + exit(1); + } + }; + + $SIG{'INT'} = sub { + if( $safeSignals ) + { + Warn('Received SIGINT. Scheduling to exit.'); + $interrupted = 1; + } + else + { + Warn('Received SIGINT. Stopping the process'); + exit(1); + } + }; + + + $SIG{'PIPE'} = sub { + if( $safeSignals ) + { + Warn('Received SIGPIPE. Scheduling to exit.'); + $interrupted = 1; + } + else + { + Warn('Received SIGPIPE. Stopping the process'); + exit(1); + } + }; + + $SIG{'QUIT'} = sub { + if( $safeSignals ) + { + Warn('Received SIGQUIT. Scheduling to exit.'); + $interrupted = 1; + } + else + { + Warn('Received SIGQUIT. Stopping the process'); + exit(1); + } + }; + + $signalHandlersSet = 1; +} + + +sub setSafeSignalHandlers +{ + setSignalHandlers(); + $safeSignals = 1; +} + + +sub setUnsafeSignalHandlers +{ + setSignalHandlers(); + $safeSignals = 0; +} + + +# If we were previously interrupted, gracefully exit now + +sub checkInterrupted +{ + if( $interrupted ) + { + Warn('Stopping the process'); + exit(1); + } +} + + + +sub closeNow +{ + my $self = shift; + + my $filename = $self->{'dbname'}; + Debug('Explicitly closing ' . $filename); + delete $Torrus::DB::dbPool{$filename}; + $self->{'dbh'}->db_close(); + delete $self->{'dbh'}; +} + +sub cleanupEnvironment +{ + if( defined( $Torrus::DB::env ) ) + { + foreach my $filename ( sort keys %Torrus::DB::dbPool ) + { + Debug('Closing ' . $filename); + $Torrus::DB::dbPool{$filename}->{'dbh'}->db_close(); + delete $Torrus::DB::dbPool{$filename}; + } + + Debug("Destroying BerkeleyDB::Env"); + $Torrus::DB::env->close(); + $Torrus::DB::env = undef; + + if( -z $Torrus::DB::dbEnvErrFile ) + { + unlink $Torrus::DB::dbEnvErrFile; + } + } +} + + +sub delay +{ + my $self = shift; + $self->{'delay_list_commit'} = 1; +} + + + +sub trunc +{ + my $self = shift; + + Debug('Truncating ' . $self->{'dbname'}); + my $count = 0; + return $self->{'dbh'}->truncate($count) == 0; +} + + +sub put +{ + my $self = shift; + my $key = shift; + my $val = shift; + + ref( $self->{'dbh'} ) or die( 'Fatal error: ' . $self->{'dbname'} ); + return $self->{'dbh'}->db_put($key, $val) == 0; +} + +sub get +{ + my $self = shift; + my $key = shift; + my $val = undef; + + $self->{'dbh'}->db_get($key, $val); + return $val; +} + + +sub del +{ + my $self = shift; + my $key = shift; + my $val = undef; + + return $self->{'dbh'}->db_del($key) == 0; +} + + +sub cursor +{ + my $self = shift; + my %options = @_; + + return $self->{'dbh'}->db_cursor( $options{'-Write'} ? DB_WRITECURSOR:0 ); +} + + +sub next +{ + my $self = shift; + my $cursor = shift; + my $key = ''; + my $val = ''; + + if( $cursor->c_get($key, $val, DB_NEXT) == 0 ) + { + return ($key, $val); + } + else + { + return (); + } +} + +sub c_del +{ + my $self = shift; + my $cursor = shift; + + my $cnt = 0; + $cursor->c_del( $cnt ); +} + + +sub c_get +{ + my $self = shift; + my $cursor = shift; + my $key = shift; + my $val = undef; + + if( $cursor->c_get( $key, $val, DB_SET ) == 0 ) + { + return $val; + } + else + { + return undef; + } +} + +sub c_put +{ + my $self = shift; + my $cursor = shift; + my $key = shift; + my $val = shift; + + return ( $cursor->c_put( $key, $val, DB_KEYFIRST ) == 0 ); +} + + + +# Btree best match. We assume that the searchKey is longer or equal +# than the matched key in the database. +# +# If none found, returns undef. +# If found, returns a hash with keys +# "exact" => true when exact match found +# "key" => key as is stored in the database +# "value" => value from the matched database entry +# The found key is shorter or equal than searchKey, and is a prefix +# of the searchKey + +sub getBestMatch +{ + my $self = shift; + my $searchKey = shift; + + my $key = $searchKey; + my $searchLen = length( $searchKey ); + my $val = ''; + my $ret = {}; + my $ok = 0; + + my $cursor = $self->{'dbh'}->db_cursor(); + + if( $cursor->c_get( $key, $val, DB_SET_RANGE ) == 0 ) + { + if( $key eq $searchKey ) + { + $ok = 1; + $ret->{'exact'} = 1; + } + else + { + # the returned key/data pair is the smallest data item greater + # than or equal to the specified data item. + # The previous entry should be what we search for. + if( $cursor->c_get( $key, $val, DB_PREV ) == 0 ) + { + if( length( $key ) < $searchLen and + index( $searchKey, $key ) == 0 ) + { + $ok = 1; + $ret->{'key'} = $key; + $ret->{'value'} = $val; + } + } + } + } + else + { + if ( $cursor->c_get( $key, $val, DB_LAST ) == 0 ) + { + if( length( $key ) < $searchLen and + index( $searchKey, $key ) == 0 ) + { + $ok = 1; + $ret->{'key'} = $key; + $ret->{'value'} = $val; + } + } + } + + return( $ok ? $ret : undef ); +} + + +# Search the keys that match the specified prefix. +# Return value is an array of [key,val] pairs or undef +# Returned keys may be duplicated if the DB is created with -Duplicates + +sub searchPrefix +{ + my $self = shift; + my $prefix = shift; + + my $ret = []; + my $ok = 0; + + my $key = $prefix; + my $val = ''; + + my $cursor = $self->{'dbh'}->db_cursor(); + + if( $cursor->c_get( $key, $val, DB_SET_RANGE ) == 0 ) + { + # the returned key/data pair is the smallest data item greater + # than or equal to the specified data item. + my $finished = 0; + while( not $finished ) + { + if( index( $key, $prefix ) == 0 ) + { + $ok = 1; + push( @{$ret}, [ $key, $val ] ); + + if( $cursor->c_get($key, $val, DB_NEXT) != 0 ) + { + $finished = 1; + } + } + else + { + $finished = 1; + } + } + } + + undef $cursor; + + return( $ok ? $ret : undef ); +} + + +# Search the keys that match the specified substring. +# Return value is an array of [key,val] pairs or undef +# Returned keys may be duplicated if the DB is created with -Duplicates + +sub searchSubstring +{ + my $self = shift; + my $substring = shift; + + my $ret = []; + my $ok = 0; + + my $key = ''; + my $val = ''; + + my $cursor = $self->{'dbh'}->db_cursor(); + + while( $cursor->c_get($key, $val, DB_NEXT) == 0 ) + { + if( index( $key, $substring ) >= 0 ) + { + $ok = 1; + push( @{$ret}, [ $key, $val ] ); + } + } + + undef $cursor; + + return( $ok ? $ret : undef ); +} + + + + + +# Comma-separated list manipulation + +sub _populateListCache +{ + my $self = shift; + my $key = shift; + + if( not exists( $self->{'listcache'}{$key} ) ) + { + my $ref = {}; + my $values = $self->get($key); + if( defined( $values ) ) + { + foreach my $val (split(/,/o, $values)) + { + $ref->{$val} = 1; + } + } + $self->{'listcache'}{$key} = $ref; + } +} + + +sub _storeListCache +{ + my $self = shift; + my $key = shift; + + if( not $self->{'delay_list_commit'} ) + { + $self->put($key, join(',', keys %{$self->{'listcache'}{$key}})); + } +} + + +sub addToList +{ + my $self = shift; + my $key = shift; + my $newval = shift; + + $self->_populateListCache($key); + + $self->{'listcache'}{$key}{$newval} = 1; + + $self->_storeListCache($key); +} + + +sub searchList +{ + my $self = shift; + my $key = shift; + my $name = shift; + + $self->_populateListCache($key); + return $self->{'listcache'}{$key}{$name}; +} + + +sub delFromList +{ + my $self = shift; + my $key = shift; + my $name = shift; + + $self->_populateListCache($key); + if( $self->{'listcache'}{$key}{$name} ) + { + delete $self->{'listcache'}{$key}{$name}; + } + + $self->_storeListCache($key); +} + + +sub getListItems +{ + my $self = shift; + my $key = shift; + + $self->_populateListCache($key); + return keys %{$self->{'listcache'}{$key}}; +} + + + +sub deleteList +{ + my $self = shift; + my $key = shift; + + delete $self->{'listcache'}{$key}; + $self->del($key); +} + + +sub commit +{ + my $self = shift; + + if( $self->{'delay_list_commit'} and + defined( $self->{'listcache'} ) ) + { + while( my($key, $list) = each %{$self->{'listcache'}} ) + { + $self->put($key, join(',', keys %{$list})); + } + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DataAccess.pm b/torrus/perllib/Torrus/DataAccess.pm new file mode 100644 index 000000000..e03fda10b --- /dev/null +++ b/torrus/perllib/Torrus/DataAccess.pm @@ -0,0 +1,317 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: DataAccess.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::DataAccess; + +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::RPN; + +use strict; +use RRDs; + +# The Torrus::DataAccess object contains cached values, and it does not +# check the cache validity. We assume that a Torrus::DataAccess object +# lifetime is within a short period of time, such as one monitor cycle. + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + return $self; +} + +# Read the data from datasource file, depending on its type. +# If time is not specified, reads the latest available data. +# In case of rrd-cdef leaf type, the returned timestamp is the +# earliest timestamp of the data sources involved. +# +# ($value, $timestamp) = $da->read( $config_tree, $leaf_token ) +# +# ($value, $timestamp) = $da->read( $config_tree, $leaf_token, $end_time ) +# +# ($value, $timestamp) = $da->read( $config_tree, $leaf_token, +# $end_time, $start_time ) + + +sub read +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $t_end = shift; + my $t_start = shift; + + my $cachekey = $token . + ':' . (defined($t_end)?$t_end:'') . + ':' . (defined($t_start)?$t_start:''); + + if( exists( $self->{'cache_read'}{$cachekey} ) ) + { + return @{$self->{'cache_read'}{$cachekey}}; + } + + if( not $config_tree->isLeaf( $token ) ) + { + my $path = $config_tree->path( $token ); + Error("Torrus::DataAccess::readLast: $path is not a leaf"); + return undef; + } + + my $ret_val; + my $ret_time; + + my $ds_type = $config_tree->getNodeParam( $token, 'ds-type' ); + if( $ds_type eq 'rrd-file' or + $ds_type eq 'collector' ) + { + my $leaf_type = $config_tree->getNodeParam( $token, 'leaf-type' ); + + if( $leaf_type eq 'rrd-def' ) + { + my $file = $config_tree->getNodeParam( $token, 'data-file' ); + my $dir = $config_tree->getNodeParam( $token, 'data-dir' ); + my $ds = $config_tree->getNodeParam( $token, 'rrd-ds' ); + my $cf = $config_tree->getNodeParam( $token, 'rrd-cf' ); + ( $ret_val, $ret_time ) = + $self->read_RRD_DS( $dir.'/'.$file, + $cf, $ds, $t_end, $t_start ); + } + elsif( $leaf_type eq 'rrd-cdef' ) + { + my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' ); + ( $ret_val, $ret_time ) = + $self->read_RPN( $config_tree, $token, $expr, + $t_end, $t_start ); + + } + else + { + my $path = $config_tree->path( $token ); + Error("$path: leaf-type $leaf_type is not supported ". + "for data access"); + } + } + else + { + my $path = $config_tree->path( $token ); + Error("$path: ds-type $ds_type is not supported ". + "for data access"); + } + + $self->{'cache_read'}{$cachekey} = [ $ret_val, $ret_time ]; + return ( $ret_val, $ret_time ); +} + + +sub read_RRD_DS +{ + my $self = shift; + my $filename = shift; + my $cf = shift; + my $ds = shift; + my $t_end = shift; + my $t_start = shift; + + my $cachekey = $filename . ':' . $cf . + ':' . (defined($t_end)?$t_end:'') . + ':' . (defined($t_start)?$t_start:''); + + if( exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) ) + { + return @{$self->{'cache_RRD'}{$cachekey}{$ds}}; + } + + my $rrdinfo = RRDs::info( $filename ); + my $ERR = RRDs::error; + if( $ERR ) + { + Error("Error during RRD info for $filename: $ERR"); + return undef; + + } + my $step = $rrdinfo->{'step'}; + my $last_available = $rrdinfo->{'last_update'}; + $last_available -= $last_available % $step; + + if( not defined $t_end ) + { + $t_end = $last_available; + } + elsif( index( $t_end, 'LAST' ) >= 0 ) + { + $t_end =~ s/LAST/$last_available/g; + } + + if( not defined $t_start ) + { + $t_start = $t_end . '-' . int($step * 3); + } + elsif( index( $t_start, 'LAST' ) >= 0 ) + { + $t_start =~ s/LAST/$last_available/g; + } + + # From here on, f_ prefix means fetch results + my( $f_start, $f_step, $f_names, $f_data ) = + RRDs::fetch( $filename, $cf, '--start', $t_start, '--end', $t_end ); + $ERR = RRDs::error; + if( $ERR ) + { + Error("Error during RRD fetch for $filename: $ERR"); + return undef; + + } + + # Memorize the DS names in cache + + for( my $i = 0; $i < @{$f_names}; $i++ ) + { + $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} = []; + } + + # Get the last available data and store in cache + + foreach my $f_line ( @{$f_data} ) + { + for( my $i = 0; $i < @{$f_names}; $i++ ) + { + if( defined $f_line->[$i] ) + { + $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} = + [ $f_line->[$i], $f_start ]; + } + } + $f_start += $f_step; + } + + if( not exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) ) + { + Error("DS name $ds is not found in $filename"); + return undef; + } + else + { + if( scalar( @{$self->{'cache_RRD'}{$cachekey}{$ds}} ) == 0 ) + { + Warn("Value undefined for ", + "DS=$ds, CF=$cf, start=$t_start, end=$t_end in $filename"); + return undef; + } + else + { + return @{$self->{'cache_RRD'}{$cachekey}{$ds}}; + } + } +} + + + +# Data access for other CF than defined for the leaf doesn't make much +# sense. So we ignore the CF in DataAccess and leave it for the +# sake of Renderer compatibility +my %cfNames = + ( 'AVERAGE' => 1, + 'MIN' => 1, + 'MAX' => 1, + 'LAST' => 1 ); + + +sub read_RPN +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $expr = shift; + my $t_end = shift; + my $t_start = shift; + + my @expr_list = split(',', $expr); + my @eval_expr; + my $timestamp = $t_end > 0 ? $t_end : time(); + + my $rpn = new Torrus::RPN; + + my $callback = sub + { + my ($noderef, $timeoffset) = @_; + + my $function; + if( $noderef =~ s/^(.)\@// ) + { + $function = $1; + } + + my $leaf = length($noderef) > 0 ? + $config_tree->getRelative($token, $noderef) : $token; + + if( not defined $leaf ) + { + my $path = $config_tree->path($token); + Error("Cannot find relative reference $noderef at $path"); + return undef; + } + + my ($rval, $var_tstamp) = $self->read($config_tree, + $leaf, + $timeoffset, + $t_start); + if( defined $rval ) + { + if( $var_tstamp == 0 ) + { + Warn("Torrus::DataAccess::read retirned zero timestamp ". + "for $leaf"); + } + + if( $var_tstamp < $timestamp ) + { + $timestamp = $var_tstamp; + } + } + + if( defined( $function ) ) + { + if( $function eq 'T' ) + { + return $var_tstamp; + } + elsif( not $cfNames{$function} ) + { + Error("Function not supported in RPN: $function"); + return undef; + } + } + return $rval; + }; + + my $result = $rpn->run( $expr, $callback ); + + return ( $result, $timestamp ); +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover.pm b/torrus/perllib/Torrus/DevDiscover.pm new file mode 100644 index 000000000..b6ee8eef8 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover.pm @@ -0,0 +1,1106 @@ +# Copyright (C) 2002-2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: DevDiscover.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin + +# Core SNMP device discovery module + +package Torrus::DevDiscover::DevDetails; + +package Torrus::DevDiscover; + +use strict; +use POSIX qw(strftime); +use Net::SNMP qw(:snmp :asn1); +use Digest::MD5 qw(md5); + +use Torrus::Log; + +BEGIN +{ + foreach my $mod ( @Torrus::DevDiscover::loadModules ) + { + eval( 'require ' . $mod ); + die( $@ ) if $@; + } +} + +# Custom overlays for templates +# overlayName -> +# 'Module::templateName' -> { 'name' => 'templateName', +# 'source' => 'filename.xml' } +our %templateOverlays; + +our @requiredParams = + ( + 'snmp-port', + 'snmp-version', + 'snmp-timeout', + 'snmp-retries', + 'data-dir', + 'snmp-host' + ); + +our %defaultParams; + +$defaultParams{'rrd-hwpredict'} = 'no'; +$defaultParams{'domain-name'} = ''; +$defaultParams{'host-subtree'} = ''; +$defaultParams{'snmp-check-sysuptime'} = 'yes'; +$defaultParams{'show-recursive'} = 'yes'; +$defaultParams{'snmp-ipversion'} = '4'; +$defaultParams{'snmp-transport'} = 'udp'; + +our @copyParams = + ( 'collector-period', + 'collector-timeoffset', + 'collector-dispersed-timeoffset', + 'collector-timeoffset-min', + 'collector-timeoffset-max', + 'collector-timeoffset-step', + 'comment', + 'domain-name', + 'monitor-period', + 'monitor-timeoffset', + 'nodeid-device', + 'show-recursive', + 'snmp-host', + 'snmp-port', + 'snmp-localaddr', + 'snmp-localport', + 'snmp-ipversion', + 'snmp-transport', + 'snmp-community', + 'snmp-version', + 'snmp-username', + 'snmp-authkey', + 'snmp-authpassword', + 'snmp-authprotocol', + 'snmp-privkey', + 'snmp-privpassword', + 'snmp-privprotocol', + 'snmp-timeout', + 'snmp-retries', + 'snmp-oids-per-pdu', + 'snmp-check-sysuptime', + 'snmp-max-msg-size', + 'system-id' ); + + +%Torrus::DevDiscover::oiddef = + ( + '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', + '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' + ); + +my @systemOIDs = ('sysDescr', 'sysObjectID', 'sysUpTime', 'sysContact', + 'sysName', 'sysLocation'); + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + $self->{'oiddef'} = {}; + $self->{'oidrev'} = {}; + + # Combine all %MODULE::oiddef hashes into one + foreach my $module ( 'Torrus::DevDiscover', + @Torrus::DevDiscover::loadModules ) + { + while( my($name, $oid) = each %{eval('\%'.$module.'::oiddef')} ) + { + die( $@ ) if $@; + $self->{'oiddef'}->{$name} = $oid; + $self->{'oidrev'}->{$oid} = $name; + } + } + + $self->{'datadirs'} = {}; + $self->{'globalData'} = {}; + + return $self; +} + + + +sub globalData +{ + my $self = shift; + return $self->{'globalData'}; +} + + +sub discover +{ + my $self = shift; + my @paramhashes = @_; + + my $devdetails = new Torrus::DevDiscover::DevDetails(); + + foreach my $params ( \%defaultParams, @paramhashes ) + { + $devdetails->setParams( $params ); + } + + foreach my $param ( @requiredParams ) + { + if( not defined( $devdetails->param( $param ) ) ) + { + Error('Required parameter not defined: ' . $param); + return 0; + } + } + + my %snmpargs; + my $community; + + my $version = $devdetails->param( 'snmp-version' ); + $snmpargs{'-version'} = $version; + + foreach my $arg ( qw(-port -localaddr -localport -timeout -retries) ) + { + if( defined( $devdetails->param( 'snmp' . $arg ) ) ) + { + $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg ); + } + } + + $snmpargs{'-domain'} = $devdetails->param('snmp-transport') . '/ipv' . + $devdetails->param('snmp-ipversion'); + + if( $version eq '1' or $version eq '2c' ) + { + $community = $devdetails->param( 'snmp-community' ); + if( not defined( $community ) ) + { + Error('Required parameter not defined: snmp-community'); + return 0; + } + $snmpargs{'-community'} = $community; + + # set maxMsgSize to a maximum value for better compatibility + + my $maxmsgsize = $devdetails->param('snmp-max-msg-size'); + if( defined( $maxmsgsize ) ) + { + $devdetails->setParam('snmp-max-msg-size', $maxmsgsize); + $snmpargs{'-maxmsgsize'} = $maxmsgsize; + } + } + elsif( $version eq '3' ) + { + foreach my $arg ( qw(-username -authkey -authpassword -authprotocol + -privkey -privpassword -privprotocol) ) + { + if( defined $devdetails->param( 'snmp' . $arg ) ) + { + $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg ); + } + } + $community = $snmpargs{'-username'}; + if( not defined( $community ) ) + { + Error('Required parameter not defined: snmp-user'); + return 0; + } + } + else + { + Error('Illegal value for snmp-version parameter: ' . $version); + return 0; + } + + my $hostname = $devdetails->param('snmp-host'); + my $domain = $devdetails->param('domain-name'); + + if( $domain and index($hostname, '.') < 0 and index($hostname, ':') < 0 ) + { + $hostname .= '.' . $domain; + } + $snmpargs{'-hostname'} = $hostname; + + my $port = $snmpargs{'-port'}; + Debug('Discovering host: ' . $hostname . ':' . $port . ':' . $community); + + my ($session, $error) = + Net::SNMP->session( %snmpargs, + -nonblocking => 0, + -translate => ['-all', 0, '-octetstring', 1] ); + if( not defined($session) ) + { + Error('Cannot create SNMP session: ' . $error); + return undef; + } + + my @oids = (); + foreach my $var ( @systemOIDs ) + { + push( @oids, $self->oiddef( $var ) ); + } + + # This is the only checking if the remote agent is alive + + my $result = $session->get_request( -varbindlist => \@oids ); + if( defined $result ) + { + $devdetails->storeSnmpVars( $result ); + } + else + { + # When the remote agent is reacheable, but system objecs are + # not implemented, we get a positive error_status + if( $session->error_status() == 0 ) + { + Error("Unable to communicate with SNMP agent on " . $hostname . + ':' . $port . ':' . $community . " - " . $session->error()); + return undef; + } + } + + my $data = $devdetails->data(); + $data->{'param'} = {}; + + $data->{'templates'} = []; + my $customTmpl = $devdetails->param('custom-host-templates'); + if( length( $customTmpl ) > 0 ) + { + push( @{$data->{'templates'}}, split( /\s*,\s*/, $customTmpl ) ); + } + + # Build host-level legend + my %legendValues = + ( + 10 => { + 'name' => 'Location', + 'value' => $devdetails->snmpVar($self->oiddef('sysLocation')) + }, + 20 => { + 'name' => 'Contact', + 'value' => $devdetails->snmpVar($self->oiddef('sysContact')) + }, + 30 => { + 'name' => 'System ID', + 'value' => $devdetails->param('system-id') + }, + 50 => { + 'name' => 'Description', + 'value' => $devdetails->snmpVar($self->oiddef('sysDescr')) + } + ); + + if( defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) ) + { + $legendValues{40}{'name'} = 'Uptime'; + $legendValues{40}{'value'} = + sprintf("%d days since %s", + $devdetails->snmpVar($self->oiddef('sysUpTime')) / + (100*3600*24), + strftime($Torrus::DevDiscover::timeFormat, + localtime(time()))); + } + + my $legend = ''; + foreach my $key ( sort keys %legendValues ) + { + my $text = $legendValues{$key}{'value'}; + if( length( $text ) > 0 ) + { + $text = $devdetails->screenSpecialChars( $text ); + $legend .= $legendValues{$key}{'name'} . ':' . $text . ';'; + } + } + + if( $devdetails->param('suppress-legend') ne 'yes' ) + { + $data->{'param'}{'legend'} = $legend; + } + + # some parameters need just one-to-one copying + + my @hostCopyParams = + split('\s*,\s*', $devdetails->param('host-copy-params')); + + foreach my $param ( @copyParams, @hostCopyParams ) + { + my $val = $devdetails->param( $param ); + if( length( $val ) > 0 ) + { + $data->{'param'}{$param} = $val; + } + } + + # If snmp-host is ipv6 address, system-id needs to be adapted to + # remove colons + + if( not defined( $data->{'param'}{'system-id'} ) and + index($data->{'param'}{'snmp-host'}, ':') >= 0 ) + { + my $systemid = $data->{'param'}{'snmp-host'}; + $systemid =~ s/:/_/g; + $data->{'param'}{'system-id'} = $systemid; + } + + if( not defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) ) + { + Debug('Agent does not support sysUpTime'); + $data->{'param'}{'snmp-check-sysuptime'} = 'no'; + } + + $data->{'param'}{'data-dir'} = + $self->genDataDir( $devdetails->param('data-dir'), $hostname ); + + # Register the directory for listDataDirs() + $self->{'datadirs'}{$devdetails->param('data-dir')} = 1; + + $self->{'session'} = $session; + + # some discovery modules need to be disabled on per-device basis + + my %onlyDevtypes; + my $useOnlyDevtypes = 0; + foreach my $devtype ( split('\s*,\s*', + $devdetails->param('only-devtypes') ) ) + { + $onlyDevtypes{$devtype} = 1; + $useOnlyDevtypes = 1; + } + + my %disabledDevtypes; + foreach my $devtype ( split('\s*,\s*', + $devdetails->param('disable-devtypes') ) ) + { + $disabledDevtypes{$devtype} = 1; + } + + # 'checkdevtype' procedures for each known device type return true + # when it's their device. They also research the device capabilities. + my $reg = \%Torrus::DevDiscover::registry; + foreach my $devtype + ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}} + keys %{$reg} ) + { + if( ( not $useOnlyDevtypes or $onlyDevtypes{$devtype} ) and + not $disabledDevtypes{$devtype} and + &{$reg->{$devtype}{'checkdevtype'}}($self, $devdetails) ) + { + $devdetails->setDevType( $devtype ); + Debug('Found device type: ' . $devtype); + } + } + + my @devtypes = sort { + $reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'} + } $devdetails->getDevTypes(); + $data->{'param'}{'devdiscover-devtypes'} = join(',', @devtypes); + + $data->{'param'}{'devdiscover-nodetype'} = '::device'; + + # Do the detailed discovery and prepare data + my $ok = 1; + foreach my $devtype ( @devtypes ) + { + $ok = &{$reg->{$devtype}{'discover'}}($self, $devdetails) ? $ok:0; + } + + delete $self->{'session'}; + $session->close(); + + $devdetails->applySelectors(); + + my $subtree = $devdetails->param('host-subtree'); + if( not defined( $self->{'devdetails'}{$subtree} ) ) + { + $self->{'devdetails'}{$subtree} = []; + } + push( @{$self->{'devdetails'}{$subtree}}, $devdetails ); + + my $define_tokensets = $devdetails->param('define-tokensets'); + if( defined( $define_tokensets ) and length( $define_tokensets ) > 0 ) + { + foreach my $pair ( split(/\s*;\s*/, $define_tokensets ) ) + { + my( $tset, $description ) = split( /\s*:\s*/, $pair ); + if( $tset !~ /^[a-z][a-z0-9-_]*$/ ) + { + Error('Invalid name for tokenset: ' . $tset); + $ok = 0; + } + elsif( length( $description ) == 0 ) + { + Error('Missing description for tokenset: ' . $tset); + $ok = 0; + } + else + { + $self->{'define-tokensets'}{$tset} = $description; + } + } + } + return $ok; +} + + +sub buildConfig +{ + my $self = shift; + my $cb = shift; + + my $reg = \%Torrus::DevDiscover::registry; + + foreach my $subtree ( sort keys %{$self->{'devdetails'}} ) + { + # Chop the first and last slashes + my $path = $subtree; + $path =~ s/^\///; + $path =~ s/\/$//; + + # generate subtree path XML + my $subtreeNode = undef; + foreach my $subtreeName ( split( '/', $path ) ) + { + $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName ); + } + + foreach my $devdetails + ( sort {$a->param('snmp-host') cmp $b->param('snmp-host')} + @{$self->{'devdetails'}{$subtree}} ) + { + + my $data = $devdetails->data(); + + my @registryOverlays = (); + if( defined( $devdetails->param('template-registry-overlays' ) ) ) + { + my @overlayNames = + split(/\s*,\s*/, + $devdetails->param('template-registry-overlays' )); + foreach my $overlayName ( @overlayNames ) + { + if( defined( $templateOverlays{$overlayName}) ) + { + push( @registryOverlays, + $templateOverlays{$overlayName} ); + } + else + { + Error('Cannot find the template overlay named ' . + $overlayName); + } + } + } + + # we should call this anyway, in order to flush the overlays + # set by previous host + $cb->setRegistryOverlays( @registryOverlays ); + + if( $devdetails->param('disable-snmpcollector' ) eq 'yes' ) + { + push( @{$data->{'templates'}}, '::viewonly-defaults' ); + } + else + { + push( @{$data->{'templates'}}, '::snmp-defaults' ); + } + + if( $devdetails->param('rrd-hwpredict' ) eq 'yes' ) + { + push( @{$data->{'templates'}}, '::holt-winters-defaults' ); + } + + + my $devNodeName = $devdetails->param('symbolic-name'); + if( length( $devNodeName ) == 0 ) + { + $devNodeName = $devdetails->param('system-id'); + if( length( $devNodeName ) == 0 ) + { + $devNodeName = $devdetails->param('snmp-host'); + } + } + + my $devNode = $cb->addSubtree( $subtreeNode, $devNodeName, + $data->{'param'}, + $data->{'templates'} ); + + my $aliases = $devdetails->param('host-aliases'); + if( length( $aliases ) > 0 ) + { + foreach my $alias ( split( '\s*,\s*', $aliases ) ) + { + $cb->addAlias( $devNode, $alias ); + } + } + + my $includeFiles = $devdetails->param('include-files'); + if( length( $includeFiles ) > 0 ) + { + foreach my $file ( split( '\s*,\s*', $includeFiles ) ) + { + $cb->addFileInclusion( $file ); + } + } + + + # Let the device type-specific modules add children + # to the subtree + foreach my $devtype + ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}} + $devdetails->getDevTypes() ) + { + &{$reg->{$devtype}{'buildConfig'}} + ( $devdetails, $cb, $devNode, $self->{'globalData'} ); + } + + $cb->{'statistics'}{'hosts'}++; + } + } + + foreach my $devtype + ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}} + keys %{$reg} ) + { + if( defined( $reg->{$devtype}{'buildGlobalConfig'} ) ) + { + &{$reg->{$devtype}{'buildGlobalConfig'}}($cb, + $self->{'globalData'}); + } + } + + if( defined( $self->{'define-tokensets'} ) ) + { + my $tsetsNode = $cb->startTokensets(); + foreach my $tset ( sort keys %{$self->{'define-tokensets'}} ) + { + $cb->addTokenset( $tsetsNode, $tset, { + 'comment' => $self->{'define-tokensets'}{$tset} } ); + } + } +} + + + +sub session +{ + my $self = shift; + return $self->{'session'}; +} + +sub oiddef +{ + my $self = shift; + my $var = shift; + + my $ret = $self->{'oiddef'}->{$var}; + if( not $ret ) + { + Error('Undefined OID definition: ' . $var); + } + return $ret; +} + + +sub oidref +{ + my $self = shift; + my $oid = shift; + return $self->{'oidref'}->{$oid}; +} + + +sub genDataDir +{ + my $self = shift; + my $basedir = shift; + my $hostname = shift; + + if( $Torrus::DevDiscover::hashDataDirEnabled ) + { + return $basedir . '/' . + sprintf( $Torrus::DevDiscover::hashDataDirFormat, + unpack('N', md5($hostname)) % + $Torrus::DevDiscover::hashDataDirBucketSize ); + } + else + { + return $basedir; + } +} + + +sub listDataDirs +{ + my $self = shift; + + my @basedirs = keys %{$self->{'datadirs'}}; + my @ret = @basedirs; + + if( $Torrus::DevDiscover::hashDataDirEnabled ) + { + foreach my $basedir ( @basedirs ) + { + for( my $i = 0; + $i < $Torrus::DevDiscover::hashDataDirBucketSize; + $i++ ) + { + push( @ret, $basedir . '/' . + sprintf( $Torrus::DevDiscover::hashDataDirFormat, $i ) ); + } + } + } + return @ret; +} + +## +# Check if SNMP table is present, without retrieving the whole table + +sub checkSnmpTable +{ + my $self = shift; + my $oidname = shift; + + my $session = $self->session(); + my $oid = $self->oiddef( $oidname ); + + my $result = $session->get_next_request( -varbindlist => [ $oid ] ); + if( defined( $result ) ) + { + # check if the returned oid shares the base of the query + my $firstOid = (keys %{$result})[0]; + if( Net::SNMP::oid_base_match( $oid, $firstOid ) and + length( $result->{$firstOid} ) > 0 ) + { + return 1; + } + } + return 0; +} + + +## +# Check if given OID is present + +sub checkSnmpOID +{ + my $self = shift; + my $oidname = shift; + + my $session = $self->session(); + my $oid = $self->oiddef( $oidname ); + + my $result = $session->get_request( -varbindlist => [ $oid ] ); + if( $session->error_status() == 0 and + defined($result) and + defined($result->{$oid}) and + length($result->{$oid}) > 0 ) + { + return 1; + } + return 0; +} + + +## +# retrieve the given OIDs by names and return hash with values + +sub retrieveSnmpOIDs +{ + my $self = shift; + my @oidnames = @_; + + my $session = $self->session(); + my $oids = []; + foreach my $oidname ( @oidnames ) + { + push( @{$oids}, $self->oiddef( $oidname ) ); + } + + my $result = $session->get_request( -varbindlist => $oids ); + if( $session->error_status() == 0 and defined( $result ) ) + { + my $ret = {}; + foreach my $oidname ( @oidnames ) + { + $ret->{$oidname} = $result->{$self->oiddef( $oidname )}; + } + return $ret; + } + return undef; +} + +## +# Simple wrapper for Net::SNMP::oid_base_match + +sub oidBaseMatch +{ + my $self = shift; + my $base_oid = shift; + my $oid = shift; + + if( $base_oid =~ /^\D/ ) + { + $base_oid = $self->oiddef( $base_oid ); + } + return Net::SNMP::oid_base_match( $base_oid, $oid ); +} + +## +# some discovery modules need to adjust max-msg-size + +sub setMaxMsgSize +{ + my $self = shift; + my $devdetails = shift; + my $msgsize = shift; + my $opt = shift; + + $opt = {} unless defined($opt); + + if( (not $opt->{'only_v1_and_v2'}) or $self->session()->version() != 3 ) + { + $self->session()->max_msg_size($msgsize); + $devdetails->data()->{'param'}{'snmp-max-msg-size'} = $msgsize; + } +} + + + + +########################################################################### +#### Torrus::DevDiscover::DevDetails: the information container for a device +#### + +package Torrus::DevDiscover::DevDetails; + +use strict; +use Torrus::RPN; +use Torrus::Log; + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + + $self->{'params'} = {}; + $self->{'snmpvars'} = {}; # SNMP results stored here + $self->{'devtype'} = {}; # Device types + $self->{'caps'} = {}; # Device capabilities + $self->{'data'} = {}; # Discovery data + + return $self; +} + + +sub setParams +{ + my $self = shift; + my $params = shift; + + while( my ($param, $value) = each %{$params} ) + { + $self->{'params'}->{$param} = $value; + } +} + + +sub setParam +{ + my $self = shift; + my $param = shift; + my $value = shift; + + $self->{'params'}->{$param} = $value; +} + + +sub param +{ + my $self = shift; + my $name = shift; + return $self->{'params'}->{$name}; +} + + +## +# store the query results for later use + +sub storeSnmpVars +{ + my $self = shift; + my $vars = shift; + + while( my( $oid, $value ) = each %{$vars} ) + { + if( $oid !~ /^\d[0-9.]+\d$/o ) + { + Error("Invalid OID syntax: '$oid'"); + } + else + { + $self->{'snmpvars'}{$oid} = $value; + + while( length( $oid ) > 0 ) + { + $oid =~ s/\d+$//o; + $oid =~ s/\.$//o; + if( not exists( $self->{'snmpvars'}{$oid} ) ) + { + $self->{'snmpvars'}{$oid} = undef; + } + } + } + } + + # Clean the cache of sorted OIDs + $self->{'sortedoids'} = undef; +} + +## +# check if the stored query results have such OID prefix + +sub hasOID +{ + my $self = shift; + my $oid = shift; + + my $found = 0; + if( exists( $self->{'snmpvars'}{$oid} ) ) + { + $found = 1; + } + return $found; +} + +## +# get the value of stored SNMP variable + +sub snmpVar +{ + my $self = shift; + my $oid = shift; + return $self->{'snmpvars'}{$oid}; +} + +## +# get the list of table indices for the specified prefix + +sub getSnmpIndices +{ + my $self = shift; + my $prefix = shift; + + # Remember the sorted OIDs, as sorting is quite expensive for large + # arrays. + + if( not defined( $self->{'sortedoids'} ) ) + { + $self->{'sortedoids'} = []; + push( @{$self->{'sortedoids'}}, + Net::SNMP::oid_lex_sort( keys %{$self->{'snmpvars'}} ) ); + } + + my @ret; + my $prefixLen = length( $prefix ) + 1; + my $matched = 0; + + foreach my $oid ( @{$self->{'sortedoids'}} ) + { + if( defined($self->{'snmpvars'}{$oid} ) ) + { + if( Net::SNMP::oid_base_match( $prefix, $oid ) ) + { + # Extract the index from OID + my $index = substr( $oid, $prefixLen ); + push( @ret, $index ); + $matched = 1; + } + elsif( $matched ) + { + last; + } + } + } + return @ret; +} + + +## +# device type is the registered discovery module name + +sub setDevType +{ + my $self = shift; + my $type = shift; + $self->{'devtype'}{$type} = 1; +} + +sub isDevType +{ + my $self = shift; + my $type = shift; + return $self->{'devtype'}{$type}; +} + +sub getDevTypes +{ + my $self = shift; + return keys %{$self->{'devtype'}}; +} + +## +# device capabilities. Each discovery module may define its own set of +# capabilities and use them for information exchange between checkdevtype(), +# discover(), and buildConfig() of its own and dependant modules + +sub setCap +{ + my $self = shift; + my $cap = shift; + Debug('Device capability: ' . $cap); + $self->{'caps'}{$cap} = 1; +} + +sub hasCap +{ + my $self = shift; + my $cap = shift; + return $self->{'caps'}{$cap}; +} + +sub clearCap +{ + my $self = shift; + my $cap = shift; + Debug('Clearing device capability: ' . $cap); + if( exists( $self->{'caps'}{$cap} ) ) + { + delete $self->{'caps'}{$cap}; + } +} + + + +sub data +{ + my $self = shift; + return $self->{'data'}; +} + + +sub screenSpecialChars +{ + my $self = shift; + my $txt = shift; + + $txt =~ s/:/{COLON}/gm; + $txt =~ s/;/{SEMICOL}/gm; + $txt =~ s/%/{PERCENT}/gm; + + return $txt; +} + + +sub applySelectors +{ + my $self = shift; + + my $selList = $self->param('selectors'); + return if not defined( $selList ); + + my $reg = \%Torrus::DevDiscover::selectorsRegistry; + + foreach my $sel ( split('\s*,\s*', $selList) ) + { + my $type = $self->param( $sel . '-selector-type' ); + if( not defined( $type ) ) + { + Error('Parameter ' . $sel . '-selector-type must be defined ' . + 'for ' . $self->param('snmp-host')); + } + elsif( not exists( $reg->{$type} ) ) + { + Error('Unknown selector type: ' . $type . + ' for ' . $self->param('snmp-host')); + } + else + { + Debug('Initializing selector: ' . $sel); + + my $treg = $reg->{$type}; + my @objects = &{$treg->{'getObjects'}}( $self, $type ); + + foreach my $object ( @objects ) + { + Debug('Checking object: ' . + &{$treg->{'getObjectName'}}( $self, $object, $type )); + + my $expr = $self->param( $sel . '-selector-expr' ); + $expr = '1' if length( $expr ) == 0; + + my $callback = sub + { + my $attr = shift; + my $checkval = $self->param( $sel . '-' . $attr ); + + Debug('Checking attribute: ' . $attr . + ' and value: ' . $checkval); + my $ret = &{$treg->{'checkAttribute'}}( $self, + $object, $type, + $attr, $checkval ); + Debug(sprintf('Returned value: %d', $ret)); + return $ret; + }; + + my $rpn = new Torrus::RPN; + my $result = $rpn->run( $expr, $callback ); + Debug('Selector result: ' . $result); + if( $result ) + { + my $actions = $self->param( $sel . '-selector-actions' ); + foreach my $action ( split('\s*,\s*', $actions) ) + { + my $arg = + $self->param( $sel . '-' . $action . '-arg' ); + $arg = 1 if not defined( $arg ); + + Debug('Applying action: ' . $action . + ' with argument: ' . $arg); + &{$treg->{'applyAction'}}( $self, $object, $type, + $action, $arg ); + } + } + } + } + } +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm b/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm new file mode 100644 index 000000000..d1bba7502 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm @@ -0,0 +1,567 @@ +# +# Discovery module for Alcatel-Lucent ESS and SR routers +# +# Copyright (C) 2009 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: ALU_Timetra.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $ +# Stanislav Sinyagin +# + +# Currently tested with following Alcatel-Lucent devices: +# * ESS 7450 + + +package Torrus::DevDiscover::ALU_Timetra; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'ALU_Timetra'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + + +our %oiddef = + ( + # TIMETRA-CHASSIS-MIB + 'tmnxChassisTotalNumber' => '1.3.6.1.4.1.6527.3.1.2.2.1.1.0', + + # TIMETRA-GLOBAL-MIB + 'timetraReg' => '1.3.6.1.4.1.6527.1', + 'timetraServiceRouters' => '1.3.6.1.4.1.6527.1.3', + 'timetraServiceSwitches' => '1.3.6.1.4.1.6527.1.6', + 'alcatel7710ServiceRouters' => '1.3.6.1.4.1.6527.1.9', + + # TIMETRA-SERV-MIB + 'custDescription' => '1.3.6.1.4.1.6527.3.1.2.4.1.3.1.3', + 'svcCustId' => '1.3.6.1.4.1.6527.3.1.2.4.2.2.1.4', + 'svcDescription' => '1.3.6.1.4.1.6527.3.1.2.4.2.2.1.6', + 'sapDescription' => '1.3.6.1.4.1.6527.3.1.2.4.3.2.1.5', + + # TIMETRA-PORT-MIB (chassis ID hardcoded to 1) + 'tmnxPortDescription' => '1.3.6.1.4.1.6527.3.1.2.2.4.2.1.5.1', + 'tmnxPortEncapType' => '1.3.6.1.4.1.6527.3.1.2.2.4.2.1.12.1', + ); + + +my %essInterfaceFilter = + ( + 'system' => { + 'ifType' => 24, # softwareLoopback + 'ifName' => '^system' + }, + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $objectID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') ); + + if( $dd->oidBaseMatch( 'timetraReg', $objectID ) ) + { + my $session = $dd->session(); + my $oid = $dd->oiddef('tmnxChassisTotalNumber'); + my $result = $session->get_request( $oid ); + if( $result->{$oid} != 1 ) + { + Error('Multi-chassis ALU 7x50 equipment is not yet supported'); + return 0; + } + + if( $dd->oidBaseMatch( 'timetraServiceSwitches', $objectID ) ) + { + $devdetails->setCap('ALU_ESS7450'); + + $devdetails->setCap('interfaceIndexingManaged'); + $devdetails->setCap('interfaceIndexingPersistent'); + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, \%essInterfaceFilter); + + $dd->setMaxMsgSize($devdetails, 65535, {'only_v1_and_v2' => 1}); + + return 1; + } + else + { + # placeholder for future developments + Error('This model of Alcatel-Lucent equipment ' . + 'is not yet supported'); + return 0; + } + } + + return 0; +} + + + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # WARNING: This code is tested only with ESS7450 + + # Get port descriptions + { + my $oid = $dd->oiddef('tmnxPortDescription'); + + my $portDescrTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $descr ) = each %{$portDescrTable} ) + { + my $ifIndex = substr( $oid, $prefixLen ); + if( defined( $data->{'interfaces'}{$ifIndex} ) ) + { + $data->{'interfaces'}{$ifIndex}{'tmnxPortDescription'} = + $descr; + } + } + } + + # Amend RFC2863_IF_MIB references + $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; + $data->{'nameref'}{'ifReferenceName'} = 'ifName'; + $data->{'nameref'}{'ifNick'} = 'ifNameT'; + $data->{'nameref'}{'ifComment'} = 'tmnxPortDescription'; + + # Get customers + { + my $oid = $dd->oiddef('custDescription'); + my $custDescrTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $descr ) = each %{$custDescrTable} ) + { + my $custId = substr( $oid, $prefixLen ); + $data->{'timetraCustDescr'}{$custId} = $descr; + } + } + + + # Get Service Descriptions + { + my $oid = $dd->oiddef('svcDescription'); + my $svcDescrTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $descr ) = each %{$svcDescrTable} ) + { + my $svcId = substr( $oid, $prefixLen ); + $data->{'timetraSvc'}{$svcId} = { + 'description' => $descr, + 'sap' => [], + }; + } + } + + # Get mapping of Services to Customers + { + my $oid = $dd->oiddef('svcCustId'); + my $svcCustIdTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $custId ) = each %{$svcCustIdTable} ) + { + my $svcId = substr( $oid, $prefixLen ); + + $data->{'timetraCustSvc'}{$custId}{$svcId} = 1; + $data->{'timetraSvcCust'}{$svcId} = $custId; + } + } + + + # Get port encapsulations + { + my $oid = $dd->oiddef('tmnxPortEncapType'); + + my $portEncapTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $encap ) = each %{$portEncapTable} ) + { + my $ifIndex = substr( $oid, $prefixLen ); + if( defined( $data->{'interfaces'}{$ifIndex} ) ) + { + $data->{'interfaces'}{$ifIndex}{'tmnxPortEncapType'} = $encap; + } + } + } + + + # Get SAP information + { + my $oid = $dd->oiddef('sapDescription'); + + my $sapDescrTable = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $descr ) = each %{$sapDescrTable} ) + { + my $sapFullID = substr( $oid, $prefixLen ); + + my ($svcId, $ifIndex, $sapEncapValue) = + split(/\./o, $sapFullID); + + my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'}; + if( not defined( $svcSaps ) ) + { + Error('Cannot find Service ID ' . $svcId); + next; + } + + if( not defined( $data->{'interfaces'}{$ifIndex} ) ) + { + Warn('IfIndex ' . $ifIndex . ' is not in interfaces table, ' . + 'skipping SAP'); + next; + } + + my $encap = $data->{'interfaces'}{$ifIndex}{'tmnxPortEncapType'}; + + # Compose the SAP name depending on port encapsulation. + + my $sapName = $data->{'interfaces'}{$ifIndex}{'ifName'}; + + if( $encap == 1 ) # nullEncap + { + # do nothing + } + elsif( $encap == 2 ) # qEncap + { + # sapEncapValue is equal to VLAN ID + $sapName .= ':' . $sapEncapValue; + } + elsif( $encap == 10 ) # qinqEncap + { + # sapEncapValue contains inner and outer VLAN IDs + + my $outer = $sapEncapValue & 0xffff; + my $inner = $sapEncapValue >> 16; + if( $inner == 4095 ) + { + # default SAP + $inner = '*'; + } + + $sapName .= ':' . $outer . '.' . $inner; + } + elsif( $encap == 3 ) # mplsEncap + { + # sapEncapValue contains the 20-bit LSP ID + # we should probably do something more here + $sapName .= ':' . $sapEncapValue; + } + else + { + Warn('Encapsulation type ' . $encap . ' is not supported yet'); + $sapName .= ':' . $sapEncapValue; + } + + $data->{'timetraSap'}{$sapFullID} = { + 'description' => $descr, + 'port' => $ifIndex, + 'name' => $sapName, + 'encval' => $sapEncapValue, + 'svc' => $svcId, + }; + + push( @{$svcSaps}, $sapFullID ); + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + if( defined( $data->{'timetraSvc'} ) ) + { + my $customersNode = $cb->addSubtree( $devNode, 'Customers' ); + + foreach my $custId (sort {$a <=> $b} keys %{$data->{'timetraCustSvc'}}) + { + # count the number of SAPs + my $nSaps = 0; + foreach my $svcId ( keys %{$data->{'timetraCustSvc'}{$custId}} ) + { + my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'}; + if( defined( $svcSaps ) ) + { + foreach my $sapID ( @{$svcSaps} ) + { + if( not $data->{'timetraSap'}{$sapID}{'excluded'} ) + { + $nSaps++; + } + } + } + } + + if( $nSaps == 0 ) + { + next; + } + + my $param = { + 'precedence' => 100000 - $custId, + 'comment' => $data->{'timetraCustDescr'}{$custId}, + 'timetra-customer-id' => $custId, + }; + + my $custNode = + $cb->addSubtree( $customersNode, $custId, $param, + ['ALU_Timetra::alu-timetra-customer']); + + my $precedence = 10000; + + foreach my $svcId + ( keys %{$data->{'timetraCustSvc'}{$custId}} ) + { + my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'}; + + if( defined($svcSaps ) ) + { + foreach my $sapID + ( sort {sapCompare($data->{'timetraSap'}{$a}, + $data->{'timetraSap'}{$b})} + @{$svcSaps} ) + { + my $sap = $data->{'timetraSap'}{$sapID}; + + if( $sap->{'excluded'} ) + { + next; + } + + my $sapDescr = $sap->{'description'}; + if( length( $sapDescr ) == 0 ) + { + $sapDescr = $data->{'timetraSvc'}{$svcId}->{ + 'description'}; + } + + my $subtreeName = $sap->{'name'}; + $subtreeName =~ s/\W/_/go; + + my $comment = ''; + if( length( $sapDescr ) > 0 ) + { + $comment = $sapDescr; + } + + my $legend = ''; + + if( length($data->{'timetraCustDescr'}{$custId}) > 0 ) + { + $legend .= 'Customer:' . + $devdetails->screenSpecialChars + ( $data->{'timetraCustDescr'}{$custId} ) . ';'; + } + + if( length($data->{'timetraSvc'}{$svcId}->{ + 'description'}) > 0 ) + { + $legend .= 'Service:' . + $devdetails->screenSpecialChars + ( $data->{'timetraSvc'}{$svcId}->{ + 'description'} ) . ';'; + } + + $legend .= 'SAP: ' . + $devdetails->screenSpecialChars( $sap->{'name'} ); + + + my $param = { + 'comment' => $comment, + 'timetra-sap-id' => $sapID, + 'timetra-sap-name' => $sap->{'name'}, + 'node-display-name' => $sap->{'name'}, + 'precedence' => $precedence--, + 'legend' => $legend, + }; + + $cb->addSubtree( $custNode, $subtreeName, $param, + ['ALU_Timetra::alu-timetra-sap']); + } + } + } + } + } +} + + +sub sapCompare +{ + my $a = shift; + my $b = shift; + + if( $a->{'port'} == $b->{'port'} ) + { + return ( $a->{'encval'} <=> $b->{'encval'} ); + } + else + { + return ( $a->{'port'} <=> $b->{'port'} ); + } +} + + + +####################################### +# Selectors interface +# + + +$Torrus::DevDiscover::selectorsRegistry{'ALU_SAP'} = { + 'getObjects' => \&getSelectorObjects, + 'getObjectName' => \&getSelectorObjectName, + 'checkAttribute' => \&checkSelectorAttribute, + 'applyAction' => \&applySelectorAction, +}; + +## Objects are full SAP indexes: svcId.sapPortId.sapEncapValue + +sub getSelectorObjects +{ + my $devdetails = shift; + my $objType = shift; + + my $data = $devdetails->data(); + my @ret = keys %{$data->{'timetraSap'}}; + + return( sort {$a<=>$b} @ret ); +} + + +sub checkSelectorAttribute +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $attr = shift; + my $checkval = shift; + + my $data = $devdetails->data(); + + my $value; + my $operator = '=~'; + + my $sap = $data->{'timetraSap'}{$object}; + + if( $attr eq 'sapDescr' ) + { + $value = $sap->{'description'}; + } + elsif( $attr eq 'custDescr' ) + { + my $svcId = $sap->{'svc'}; + my $custId = $data->{'timetraSvcCust'}{$svcId}; + $value = $data->{'timetraCustDescr'}{$custId}; + } + elsif( $attr eq 'sapName' ) + { + $value = $sap->{'name'}; + $operator = 'eq'; + } + elsif( $attr eq 'sapPort' ) + { + my $ifIndex = $sap->{'port'}; + $value = $data->{'interfaces'}{$ifIndex}{'ifName'}; + $operator = 'eq'; + } + else + { + Error('Unknown ALU_SAP selector attribute: ' . $attr); + $value = ''; + } + + + return eval( '$value' . ' ' . $operator . '$checkval' ) ? 1:0; +} + + +sub getSelectorObjectName +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + + my $data = $devdetails->data(); + + return $data->{'timetraSap'}{$object}{'name'}; +} + + +my %knownSelectorActions = + ( + 'RemoveSAP' => 1, + ); + + +sub applySelectorAction +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $action = shift; + my $arg = shift; + + my $data = $devdetails->data(); + my $objref; + + if( not $knownSelectorActions{$action} ) + { + Error('Unknown ALU_SAP selector action: ' . $action); + return; + } + + if( $action eq 'RemoveSAP' ) + { + $data->{'timetraSap'}{$object}{'excluded'} = 1; + } +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/ATMEL.pm b/torrus/perllib/Torrus/DevDiscover/ATMEL.pm new file mode 100644 index 000000000..e45c7eb4e --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/ATMEL.pm @@ -0,0 +1,167 @@ +# Copyright (C) 2004 Scott Brooks +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# Scott Brooks + +# ATMEL based access points/bridges + +package Torrus::DevDiscover::ATMEL; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'ATMEL'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # Check to see if we can get the list of running WSS ports + 'sysDeviceInfo' => '1.3.6.1.4.1.410.1.1.1.5.0', + 'bridgeOperationalMode' => '1.3.6.1.4.1.410.1.1.4.1.0', + 'operAccessPointName' => '1.3.6.1.4.1.410.1.2.1.10.0', + 'bridgeRemoteBridgeBSSID' => '1.3.6.1.4.1.410.1.1.4.2.0' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->checkSnmpOID('sysDeviceInfo') ) + { + return 0; + } + + return 1; +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + my $info = $dd->retrieveSnmpOIDs('sysDeviceInfo', + 'operAccessPointName', + 'bridgeOperationalMode', + 'bridgeRemoteBridgeBSSID', + ); + + my $deviceInfo = substr($info->{'sysDeviceInfo'},2); + my $bridgeName = $info->{'operAccessPointName'}; + + #Get rid of all the nulls returned. + $bridgeName =~ s/\000//g; + + $data->{'param'}{'comment'} = $bridgeName; + + my $bridgeMode = $info->{'bridgeOperationalMode'}; + + my $remoteMac = substr($info->{'bridgeRemoteBridgeBSSID'},2); + + $remoteMac =~ s/(\w\w)/$1-/g; + $remoteMac = substr($remoteMac,0,-1); + + my $bridge=0; + + my ($version,$macaddr,$reserved,$regdomain,$producttype,$oemname,$oemid, + $productname,$hardwarerev) = unpack("LH12SLLA32LA32L", + pack("H*", $deviceInfo)); + + $macaddr =~ s/(\w\w)/$1-/g; + $macaddr = substr($macaddr,0,-1); + + $data->{'param'}{'comment'} = $bridgeName; + + if ($productname =~ m/airPoint/) + { + #we have an access point + if ($bridgeMode == 3) + { + #we have an access point in client bridge mode. + $bridge=1; + } + } + else + { + #we have a bridge + $bridge=1; + } + if (!$bridge) + { + $devdetails->setCap('ATMEL::accessPoint'); + my $legend = + "AP: " . $bridgeName .";" . + "Mac: " . $macaddr.";"; + $data->{'param'}{'legend'} .= $legend; + + } + else + { + my $legend = + "Bridge: " . $bridgeName .";" . + "Mac: " . $macaddr.";"; + $data->{'param'}{'legend'} .= $legend; + + $data->{'param'}{'legend'} .= "AP Mac: " . $remoteMac . ";"; + } + #disable SNMP uptime check + $data->{'param'}{'snmp-check-sysuptime'} = 'no'; + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my @templates = ('ATMEL::atmel-device-subtree'); + + if( $devdetails->hasCap('ATMEL::accessPoint') ) + { + push (@templates, 'ATMEL::atmel-accesspoint-stats'); + } + else + { + push (@templates, 'ATMEL::atmel-client-stats'); + } + + foreach my $tmpl ( @templates ) + { + $cb->addTemplateApplication( $devNode, $tmpl ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm b/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm new file mode 100644 index 000000000..4da186276 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm @@ -0,0 +1,284 @@ +# Copyright (C) 2004 Marc Haber +# Copyright (C) 2005 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# $Id: AlliedTelesyn_PBC18.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $ +# Marc Haber +# Redesigned by Stanislav Sinyagin + +# Allied Telesyn 18-Slot Media Converter Chassis + +package Torrus::DevDiscover::AlliedTelesyn_PBC18; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'AlliedTelesyn_PBC18'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + 'ATMCCommon-MIB::mediaconverter' => '1.3.6.1.4.1.207.1.12', + 'ATMCCommon-MIB::mcModuleName' => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.2', + 'ATMCCommon-MIB::mcModuleType' => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.3', + 'ATMCCommon-MIB::mcModuleState' => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.4', + 'ATMCCommon-MIB::mcModuleAportLinkState' => + '1.3.6.1.4.1.207.8.41.1.1.1.1.1.10', + 'ATMCCommon-MIB::mcModuleBportLinkState' => + '1.3.6.1.4.1.207.8.41.1.1.1.1.1.11', + 'ATMCCommon-MIB::mcModuleCportLinkState' => + '1.3.6.1.4.1.207.8.41.1.1.1.1.1.12', + 'ATMCCommon-MIB::mcModuleDportLinkState' => + '1.3.6.1.4.1.207.8.41.1.1.1.1.1.13', + + ); + + +our %knownModuleTypes = + ( + 8 => 'AT-PB103/1 (1x100Base-TX, 1x100Base-FX Single-Mode Fibre SC, 15km)', + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'ATMCCommon-MIB::mediaconverter', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + # Modules table + + my $oid = $dd->oiddef('ATMCCommon-MIB::mcModuleType'); + + my $table = $session->get_table( -baseoid => $oid ); + if( not defined( $table ) ) + { + return 0; + } + + $devdetails->storeSnmpVars( $table ); + + foreach my $INDEX ( $devdetails->getSnmpIndices($oid) ) + { + my $moduleType = $devdetails->snmpVar( $oid . '.' . $INDEX ); + if( $moduleType == 0 ) + { + next; + } + + $data->{'PBC18'}{$INDEX} = {}; + if( defined( $knownModuleTypes{$moduleType} ) ) + { + $data->{'PBC18'}{$INDEX}{'moduleDesc'} = + $knownModuleTypes{$moduleType}; + } + else + { + Warn('Unknown PBC18 module type: ' . $moduleType); + } + } + + foreach my $INDEX ( keys %{$data->{'PBC18'}} ) + { + my $oids = []; + foreach my $oidname ( 'ATMCCommon-MIB::mcModuleName', + 'ATMCCommon-MIB::mcModuleState', + 'ATMCCommon-MIB::mcModuleAportLinkState', + 'ATMCCommon-MIB::mcModuleBportLinkState', + 'ATMCCommon-MIB::mcModuleCportLinkState', + 'ATMCCommon-MIB::mcModuleDportLinkState' ) + { + push( @{$oids}, $dd->oiddef( $oidname ) . '.' . $INDEX ); + } + + my $result = $session->get_request( -varbindlist => $oids ); + if( $session->error_status() == 0 and defined( $result ) ) + { + $devdetails->storeSnmpVars( $result ); + } + else + { + Error('Error retrieving PBC18 module information'); + return 0; + } + } + + foreach my $INDEX ( keys %{$data->{'PBC18'}} ) + { + if( $devdetails->snmpVar + ( $dd->oiddef('ATMCCommon-MIB::mcModuleState') .'.'.$INDEX ) + != 1 ) + { + delete $data->{'PBC18'}{$INDEX}; + next; + } + + my $name = $devdetails->snmpVar + ( $dd->oiddef('ATMCCommon-MIB::mcModuleName') .'.'.$INDEX ); + + if( length( $name ) > 0 ) + { + $data->{'PBC18'}{$INDEX}{'moduleName'} = $name; + } + + foreach my $portName ('A', 'B', 'C', 'D') + { + my $oid = $dd->oiddef + ('ATMCCommon-MIB::mcModule'.$portName.'portLinkState'). + '.'.$INDEX; + + my $portState = $devdetails->snmpVar ( $oid ); + if( $portState == 1 or $portState == 2 ) + { + $data->{'PBC18'}{$INDEX}{'portAvailable'}{$portName} = $oid; + } + } + } + + return 1; +} + + +our %portLineColors = + ( + 'A' => '##green', + 'B' => '##blue', + 'C' => '##red', + 'D' => '##gold' + ); + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + my $param = { + 'data-file' => '%system-id%_pbc18_%pbc-module-index%.rrd', + 'collector-scale' => '-1,*,2,+', + 'graph-lower-limit' => 0, + 'graph-upper-limit' => 1, + 'rrd-cf' => 'MAX', + 'rrd-create-dstype' => 'GAUGE', + 'rrd-create-rra' => + 'RRA:MAX:0:1:4032 RRA:MAX:0.17:6:2016 RRA:MAX:0.042:288:732', + + 'has-overview-shortcuts' => 'yes', + 'overview-shortcuts' => 'links', + 'overview-subleave-name-links' => 'AllPorts', + 'overview-shortcut-text-links' => 'All modules', + 'overview-shortcut-title-links' => 'All converter modules', + 'overview-page-title-links' => 'All converter modules', + }; + + $cb->addParams( $devNode, $param ); + + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'PBC18'}} ) + { + my $param = { 'pbc-module-index' => $INDEX }; + + if( defined( $data->{'PBC18'}{$INDEX}{'moduleDesc'} ) ) + { + $param->{'legend'} = + 'Module type: ' . $data->{'PBC18'}{$INDEX}{'moduleDesc'}; + } + + if( defined( $data->{'PBC18'}{$INDEX}{'moduleName'} ) ) + { + $param->{'comment'} = + $data->{'PBC18'}{$INDEX}{'moduleName'}; + } + + my $modNode = $cb->addSubtree( $devNode, 'Module_' . $INDEX, $param ); + + my $mgParam = { + 'ds-type' => 'rrd-multigraph', + 'ds-names' => '', + 'graph-lower-limit' => '0', + 'precedence' => '1000', + 'comment' => 'Ports status', + 'vertical-label' => 'Status', + }; + + my $n = 1; + foreach my $portName + ( sort keys %{$data->{'PBC18'}{$INDEX}{'portAvailable'}} ) + { + if( $n > 1 ) + { + $mgParam->{'ds-names'} .= ','; + } + + my $dsname = 'port' . $portName; + $mgParam->{'ds-names'} .= $dsname; + + $mgParam->{'graph-legend-' . $dsname} = 'Port ' . $portName; + $mgParam->{'line-style-' . $dsname} = 'LINE2'; + $mgParam->{'line-color-' . $dsname} = $portLineColors{$portName}; + $mgParam->{'line-order-' . $dsname} = $n; + $mgParam->{'ds-expr-' . $dsname} = '{Port_' . $portName . '}'; + + my $param = { + 'rrd-ds' => 'Port' . $portName, + 'snmp-object' => + $data->{'PBC18'}{$INDEX}{'portAvailable'}{$portName}, + }; + + $cb->addLeaf( $modNode, 'Port_' . $portName, $param ); + $n++; + } + + $cb->addLeaf( $modNode, 'AllPorts', $mgParam ); + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Alteon.pm b/torrus/perllib/Torrus/DevDiscover/Alteon.pm new file mode 100644 index 000000000..d8ea6edc7 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Alteon.pm @@ -0,0 +1,169 @@ +# +# Discovery module for Alteon devices +# +# Copyright (C) 2007 Jon Nistor +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Alteon.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Jon Nistor +# + + +package Torrus::DevDiscover::Alteon; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Alteon'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +# pmodule-dependend OIDs are presented for module #1 only. +# currently devices with more than one module do not exist + +our %oiddef = + ( + # ALTEON-PRIVATE-MIBS + 'alteonOID' => '1.3.6.1.4.1.1872.1', + 'hwPartNumber' => '1.3.6.1.4.1.1872.2.1.1.1.0', + 'hwRevision' => '1.3.6.1.4.1.1872.2.1.1.2.0', + 'agSoftwareVersion' => '1.3.6.1.4.1.1872.2.1.2.1.7.0', + 'agEnabledSwFeatures' => '1.3.6.1.4.1.1872.2.1.2.1.25.0', + 'slbCurCfgRealServerName' => '1.3.6.1.4.1.1872.2.1.5.2.1.12', + 'slbNewCfgRealServerName' => '1.3.6.1.4.1.1872.2.1.5.3.1.13', + 'slbCurCfgGroupName' => '1.3.6.1.4.1.1872.2.1.5.10.1.7', + 'slbNewCfgGroupName' => '1.3.6.1.4.1.1872.2.1.5.11.1.10', + 'slbStatPortMaintPortIndex' => '1.3.6.1.4.1.1872.2.1.8.2.1.1.1', + 'slbStatVServerIndex' => '1.3.6.1.4.1.1872.2.1.8.2.7.1.3', + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'alteonOID', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # Get the system info and display it in the comment + my $alteonInfo = $dd->retrieveSnmpOIDs + ( 'hwPartNumber', 'hwRevision', 'agSoftwareVersion', + 'agEnabledSwFeatures', 'sysDescr' ); + + $data->{'param'}{'comment'} = + $alteonInfo->{'sysDescr'} . ", Hw Serial#: " . + $alteonInfo->{'hwPartNumber'} . ", Hw Revision: " . + $alteonInfo->{'hwRevision'} . ", " . + $alteonInfo->{'agEnabledSwFeatures'} . ", Version: " . + $alteonInfo->{'agSoftwareVersion'}; + + # PROG: Discover slbStatVServerIndex (Virtual Server index) + my $virtTable = $session->get_table ( -baseoid => + $dd->oiddef('slbStatVServerIndex') ); + $devdetails->storeSnmpVars( $virtTable ); + foreach my $virtIndex + ( $devdetails->getSnmpIndices( $dd->oiddef('slbStatVServerIndex') ) ) + { + Debug("Alteon::vserver Found index $virtIndex"); + $data->{'VSERVER'}{$virtIndex} = 1; + } + + # PROG: SLB Port Maintenance Statistics Table + my $maintTable = + $session->get_table ( -baseoid => + $dd->oiddef('slbStatPortMaintPortIndex') ); + $devdetails->storeSnmpVars( $maintTable ); + + foreach my $mIndex + ( $devdetails->getSnmpIndices + ( $dd->oiddef('slbStatPortMaintPortIndex') ) ) + { + Debug("Alteon::maintTable Index: $mIndex"); + $data->{'MAINT'}{$mIndex} = 1; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + $cb->addTemplateApplication($devNode, 'Alteon::alteon-cpu'); + $cb->addTemplateApplication($devNode, 'Alteon::alteon-mem'); + $cb->addTemplateApplication($devNode, 'Alteon::alteon-packets'); + $cb->addTemplateApplication($devNode, 'Alteon::alteon-sensor'); + + # PROG: Virtual Server information + my $virtNode = + $cb->addSubtree( $devNode, 'VirtualServer_Stats', + { 'comment' => 'Stats per Virtual Server' }, + [ 'Alteon::alteon-vserver-subtree'] ); + + foreach my $virtIndex ( sort {$a <=> $b } keys %{$data->{'VSERVER'}} ) + { + $cb->addSubtree( $virtNode, 'VirtualHost_' . $virtIndex, + { 'alteon-vserver-index' => $virtIndex }, + [ 'Alteon::alteon-vserver'] ); + } + + # PROG: SLB Port Maintenance Statistics Table + my $maintNode = + $cb->addSubtree( $devNode, 'Port_Maintenance_Stats', + { 'comment' => 'SLB port maintenance statistics' }, + [ 'Alteon::alteon-maint-subtree'] ); + + foreach my $mIndex ( sort {$a <=> $b } keys %{$data->{'MAINT'}} ) + { + $cb->addSubtree( $maintNode, 'Port_' . $mIndex, + { 'alteon-maint-index' => $mIndex }, + [ 'Alteon::alteon-maint'] ); + } + +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm b/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm new file mode 100644 index 000000000..ab5fe087d --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm @@ -0,0 +1,180 @@ +# +# Copyright (C) 2007 Jon Nistor +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Apple_AE.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Jon Nistor + +# Apple Airport Extreme Discovery Module +# +# NOTE: Options for this module: +# Apple_AE::disable-clients + +package Torrus::DevDiscover::Apple_AE; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Apple_AE'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig +}; + + +our %oiddef = + ( + # Apple Airport Extreme + 'airportObject' => '1.3.6.1.4.1.63.501', + 'baseStation3' => '1.3.6.1.4.1.63.501.3', + + # Airport Information + 'sysConfName' => '1.3.6.1.4.1.63.501.3.1.1.0', + 'sysConfContact' => '1.3.6.1.4.1.63.501.3.1.2.0', + 'sysConfLocation' => '1.3.6.1.4.1.63.501.3.1.3.0', + 'sysConfFirmwareVersion' => '1.3.6.1.4.1.63.501.3.1.5.0', + + 'wirelessNumber' => '1.3.6.1.4.1.63.501.3.2.1.0', + 'wirelessPhysAddress' => '1.3.6.1.4.1.63.501.3.2.2.1.1' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + # PROG: Standard sysObject does not work on Airport devices + # So we will match on the specific OID + if( not $dd->checkSnmpOID('sysConfName') ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # NOTE: Comments and Serial number of device + my $chassisInfo = + $dd->retrieveSnmpOIDs( 'sysConfName', 'sysConfLocation', + 'sysConfFirmwareVersion' ); + + if( defined( $chassisInfo ) ) + { + if( not $chassisInfo->{'sysConfLocation'} ) + { + $chassisInfo->{'sysConfLocation'} = "unknown"; + } + + $data->{'param'}{'comment'} = "Apple Airport Extreme, " . + "Fw#: " . $chassisInfo->{'sysConfFirmwareVersion'} . ", " . + $chassisInfo->{'sysConfName'} . " located at " . + $chassisInfo->{'sysConfLocation'}; + } else { + $data->{'param'}{'comment'} = "Apple Airport Extreme"; + } + + + # PROG: Find wireless clients + if( $devdetails->param('Apple_AE::disable-clients') ne 'yes' ) + { + my $numWireless = $dd->retrieveSnmpOIDs('wirelessNumber'); + + my $tableClients = + $session->get_table( -baseoid => + $dd->oiddef('wirelessPhysAddress') ); + $devdetails->storeSnmpVars( $tableClients ); + + if( $tableClients && ($numWireless->{'wirelessNumber'} > 0) ) + { + # PROG: setCap that we actually have clients ... + $devdetails->setCap('AE_clients'); + + foreach my $wClient ( $devdetails->getSnmpIndices + ($dd->oiddef('wirelessPhysAddress')) ) + { + my $wMAC = $devdetails->snmpVar( + $dd->oiddef('wirelessPhysAddress') . "." . $wClient); + + # Construct data + $data->{'Apple_AE'}{'wClients'}{$wClient} = undef; + $data->{'Apple_AE'}{'wClients'}{$wClient}{'wMAC'} = $wMAC; + + Debug("Apple_AE:: Client $wMAC / $wClient"); + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + # Wireless Client information + if( $devdetails->hasCap('AE_clients') ) + { + my $nodeTop = + $cb->addSubtree( $devNode, 'Wireless_Clients', undef, + [ 'Apple_AE::ae-wireless-clients-subtree'] ); + + foreach my $wClient ( keys %{$data->{'Apple_AE'}{'wClients'}} ) + { + my $airport = $data->{'Apple_AE'}{'wClients'}{$wClient}; + my $wMAC = $airport->{'wMAC'}; + my $wMACfix = $wMAC; + $wMACfix =~ s/:/_/g; + + my $nodeWireless = + $cb->addSubtree( $nodeTop, $wMACfix, + { 'wireless-mac' => $wMAC, + 'wireless-macFix' => $wMACfix, + 'wireless-macOid' => $wClient }, + [ 'Apple_AE::ae-wireless-clients-leaf' ] ); + } + } + + # PROG: Adding global statistics + $cb->addTemplateApplication( $devNode, 'Apple_AE::ae-global-stats'); +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm b/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm new file mode 100644 index 000000000..076d79867 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm @@ -0,0 +1,1150 @@ +# +# Discovery module for Arbor|e Series devices +# Formerly Ellacoya Networks +# +# Copyright (C) 2008 Jon Nistor +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. +# +# $Id: Arbor_E.pm,v 1.1 2010-12-27 00:03:52 ivan Exp $ +# Jon Nistor +# +# NOTE: This module has been tested against v7.5.x, v7.6.x, v9.0.x, v9.1.x +# +# -- Common +# Arbor_E::disable-bundle-offer +# Arbor_E::disable-bundle-offer-deny +# Arbor_E::disable-bundle-offer-pktsize +# Arbor_E::disable-bundle-offer-rate +# Arbor_E::disable-bundle-offer-subcount +# Arbor_E::enable-bundle-name-rrd +# Arbor_E::disable-flowdev +# +# -- e30 specific +# Arbor_E::disable-e30-buffers +# Arbor_E::disable-e30-bundle +# Arbor_E::disable-e30-cpu +# Arbor_E::disable-e30-fwdTable +# Arbor_E::disable-e30-fwdTable-login +# Arbor_E::disable-e30-hdd +# Arbor_E::enable-e30-hdd-errors +# Arbor_E::disable-e30-hdd-logs +# Arbor_E::disable-e30-l2tp +# Arbor_E::disable-e30-mem +# Arbor_E::enable-e30-mempool +# Arbor_E::disable-e30-bundle +# Arbor_E::disable-e30-bundle-deny +# Arbor_E::disable-e30-bundle-rate +# Arbor_E::disable-e30-slowpath +# +# -- e100 specific +# Arbor_E::disable-e100-cpu +# Arbor_E::disable-e100-hdd +# Arbor_E::disable-e100-mem +# Arbor_E::disable-e100-policymgmt +# Arbor_E::disable-e100-submgmt +# + +# Arbor_E devices discovery +package Torrus::DevDiscover::Arbor_E; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Arbor_E'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # ELLACOYA-MIB + 'eProducts' => '1.3.6.1.4.1.3813.2', + 'codeVer' => '1.3.6.1.4.1.3813.1.4.1.1.0', + 'sysIdSerialNum' => '1.3.6.1.4.1.3813.1.4.1.5.2.0', + 'memPoolNameIndex' => '1.3.6.1.4.1.3813.1.4.2.5.1.1', + 'hDriveErrModel' => '1.3.6.1.4.1.3813.1.4.2.10.16.0', + 'hDriveErrSerialNum' => '1.3.6.1.4.1.3813.1.4.2.10.17.0', + 'partitionName' => '1.3.6.1.4.1.3813.1.4.2.11.1.2', # e100 + 'cpuSdramIndex' => '1.3.6.1.4.1.3813.1.4.2.12.1.1', # e100 + 'hDriveDailyLogSize' => '1.3.6.1.4.1.3813.1.4.2.13.0', + 'cpuUtilization' => '1.3.6.1.4.1.3813.1.4.4.1.0', + 'cpuUtilTable' => '1.3.6.1.4.1.3813.1.4.4.2', # e100 + 'cpuIndex' => '1.3.6.1.4.1.3813.1.4.4.2.1.1', # e100 + 'cpuName' => '1.3.6.1.4.1.3813.1.4.4.2.1.2', # e100 + 'loginRespOkStatsIndex' => '1.3.6.1.4.1.3813.1.4.3.15.1.1', + + # ELLACOYA-MIB::cpuCounters, e30 (available in 7.5.x -- slowpath counters) + 'cpuCounters' => '1.3.6.1.4.1.3813.1.4.4.10', + 'slowpathCounters' => '1.3.6.1.4.1.3813.1.4.4.10.1', + 'sigCounters' => '1.3.6.1.4.1.3813.1.4.4.10.2', + + # ELLACOYA-MIB::flow + 'flowPoolNameD1' => '1.3.6.1.4.1.3813.1.4.5.1.1.1.2', + 'flowPoolNameD2' => '1.3.6.1.4.1.3813.1.4.5.2.1.1.2', + + # ELLACOYA-MIB::bundleStatsTable + 'bundleName' => '1.3.6.1.4.1.3813.1.4.12.1.1.2', + 'bundleBytesSentDenyPolicyDrop' => '1.3.6.1.4.1.3813.1.4.12.1.1.6', + 'bundleBytesSentRateLimitDrop' => '1.3.6.1.4.1.3813.1.4.12.1.1.8', + 'boBundleID' => '1.3.6.1.4.1.3813.1.4.12.2.1.1', + 'boBundleName' => '1.3.6.1.4.1.3813.1.4.12.2.1.3', + 'boOfferName' => '1.3.6.1.4.1.3813.1.4.12.2.1.4', + 'boBundleSubCount' => '1.3.6.1.4.1.3813.1.4.12.2.1.7', + 'boPacketsSent64' => '1.3.6.1.4.1.3813.1.4.12.2.1.8', + 'boBundleBytesSentDenyPolicyDrop' => '1.3.6.1.4.1.3813.1.4.12.2.1.22', + 'boBundleBytesSentRateLimitDrop' => '1.3.6.1.4.1.3813.1.4.12.2.1.24', + + # ELLACOYA-MIB::policyMgmt, e100 + 'policyMgmt' => '1.3.6.1.4.1.3813.1.4.16', + + # ELLACOYA-MIB::subscriberMgmt, e100 + 'subscriberMgmt' => '1.3.6.1.4.1.3813.1.4.17', + 'subscriberStateName' => '1.3.6.1.4.1.3813.1.4.17.7.1.2', + + # ELLACOYA-MIB::l2tp, e30 (available in 7.5.x) + 'l2tpConfigEnabled' => '1.3.6.1.4.1.3813.1.4.18.1.1.0', + 'l2tpSecureEndpointIpAddress' => '1.3.6.1.4.1.3813.1.4.18.3.2.1.1.1', + 'l2tpSecureEndpointOverlapping' => '1.3.6.1.4.1.3813.1.4.18.3.2.1.1.3', + + ); + +our %eChassisName = + ( + '1' => 'e16k', + '2' => 'e4k', + '3' => 'e30 Revision: R', + '4' => 'e30 Revision: S', + '5' => 'e30 Revision: T', + '6' => 'e30 Revision: U', + '7' => 'e30 Revision: V', + '8' => 'Ellacoya e100', + '9' => 'e100' + ); + +our %eCpuName = + ( + '1' => 'Control Module', + '3' => 'DPI Module 1 CPU 1', + '4' => 'DPI Module 1 CPU 2', + '5' => 'DPI Module 2 CPU 1', + '6' => 'DPI Module 2 CPU 2', + '7' => 'I/O Module' + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'eProducts', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # PROG: Grab versions, serials and type of chassis. + my $eInfo = $dd->retrieveSnmpOIDs + ( 'codeVer', 'sysIdSerialNum', 'sysObjectID' ); + $eInfo->{'modelNum'} = $eInfo->{'sysObjectID'}; + $eInfo->{'modelNum'} =~ s/.*(\d)$/$1/; # Last digit + + # SNMP: System comment + $data->{'param'}{'comment'} = + "Arbor " . $eChassisName{$eInfo->{'modelNum'}} . + ", Hw Serial#: " . $eInfo->{'sysIdSerialNum'} . + ", Version: " . $eInfo->{'codeVer'}; + + # ------------------------------------------------------------------------ + # Arbor_E e30 related material here + if( $eInfo->{'modelNum'} < 8 ) + { + Debug("Arbor_E: Found " . $eChassisName{$eInfo->{'modelNum'}} ); + + # PROG: Set Capability to be the e30 device + $devdetails->setCap('e30'); + + # PROG: Check status oids + if( $devdetails->param('Arbor_E::disable-e30-buffers') ne 'yes' ) + { + $devdetails->setCap('e30-buffers'); + } + + if( $devdetails->param('Arbor_E::disable-e30-cpu') ne 'yes' ) + { + $devdetails->setCap('e30-cpu'); + } + + if( $devdetails->param('Arbor_E::disable-e30-fwdTable') ne 'yes' ) + { + $devdetails->setCap('e30-fwdTable'); + + if( $devdetails->param('Arbor_E::disable-e30-fwdTable-login') + ne 'yes' ) + { + my $loginTable = $session->get_table( + -baseoid => $dd->oiddef('loginRespOkStatsIndex') ); + $devdetails->storeSnmpVars( $loginTable ); + + if( defined( $loginTable ) ) + { + $devdetails->setCap('e30-fwdTable-login'); + + foreach my $statsIdx ( $devdetails->getSnmpIndices( + $dd->oiddef('loginRespOkStatsIndex') ) ) + { + push(@{$data->{'e30'}{'loginResp'}}, $statsIdx); + } + } + } # END hasCap disable-e30-fwdTable-login + } + + if( $devdetails->param('Arbor_E::disable-e30-hdd') ne 'yes' ) + { + $devdetails->setCap('e30-hdd'); + + # SNMP: Add harddrive comment information + $eInfo = $dd->retrieveSnmpOIDs( 'hDriveErrModel', + 'hDriveErrSerialNum' ); + + $data->{'e30'}{'hddModel'} = $eInfo->{'hDriveErrModel'}; + $data->{'e30'}{'hddSerial'} = $eInfo->{'hDriveErrSerialNum'}; + + # PROG: Do we want errors as well? + if( $devdetails->param('Arbor_E::enable-e30-hdd-errors') eq 'yes' ) + { + $devdetails->setCap('e30-hdd-errors'); + } + + # PROG: Do we want to look at daily log files? (New in 7.6) + if( $devdetails->param('Arbor_E::disable-e30-hdd-logs') ne 'yes' ) + { + $eInfo = $dd->retrieveSnmpOIDs( 'hDriveDailyLogSize' ); + + if( $eInfo->{'hDriveDailyLogSize'} ) + { + $devdetails->setCap('e30-hdd-logs'); + } + } + } # END: if disable-e30-hdd + + if( $devdetails->param('Arbor_E::disable-e30-l2tp') ne 'yes' ) + { + # 1 - disabled, 2 - enabled, 3 - session aware + $eInfo = $dd->retrieveSnmpOIDs('l2tpConfigEnabled'); + + if( $eInfo->{'l2tpConfigEnabled'} > 1 ) + { + $devdetails->setCap('e30-l2tp'); + + my $l2tpSecEndTable = $session->get_table( + -baseoid => $dd->oiddef('l2tpSecureEndpointIpAddress') ); + $devdetails->storeSnmpVars( $l2tpSecEndTable ); + + Debug("e30: L2TP secure endpoints found:"); + foreach my $SEP ( $devdetails->getSnmpIndices( + $dd->oiddef('l2tpSecureEndpointIpAddress') ) ) + { + next if( ! $SEP ); + $data->{'e30'}{'l2tpSEP'}{$SEP} = 0; + Debug("e30: $SEP"); + } + } # END: if l2tpConfigEnabled + } + + # Memory usage on system + if( $devdetails->param('Arbor_E::disable-e30-mem') ne 'yes' ) + { + $devdetails->setCap('e30-mem'); + } + + # Memory usage / individual blocks + if( $devdetails->param('Arbor_E::enable-e30-mempool') eq 'yes' ) + { + my $mempoolTable = $session->get_table( + -baseoid => $dd->oiddef('memPoolNameIndex') ); + $devdetails->storeSnmpVars( $mempoolTable ); + + if( defined( $mempoolTable ) ) + { + $devdetails->setCap('e30-mempool'); + + foreach my $memOID ( + $devdetails->getSnmpIndices( + $dd->oiddef('memPoolNameIndex') ) ) + { + my $memName = $mempoolTable->{ + $dd->oiddef('memPoolNameIndex') . '.' . $memOID}; + + Debug("e30: Mempool: $memName"); + $data->{'e30'}{'mempool'}{$memOID} = $memName; + } + } + } + + # Traffic statistics per Bundle + if( $devdetails->param('Arbor_E::disable-e30-bundle') ne 'yes' ) + { + # Set capability + $devdetails->setCap('e30-bundle'); + + # Pull table information + my $bundleTable = $session->get_table( + -baseoid => $dd->oiddef('bundleName') ); + $devdetails->storeSnmpVars( $bundleTable ); + + Debug("e30: Bundle Information id:name"); + foreach my $bundleID ( + $devdetails->getSnmpIndices( $dd->oiddef('bundleName') )) + { + my $bundleName = $bundleTable->{$dd->oiddef('bundleName') . + '.' . $bundleID}; + $data->{'e30'}{'bundleID'}{$bundleID} = $bundleName; + + Debug("e30: $bundleID $bundleName"); + } # END foreache my $bundleID + + if( $devdetails->param('Arbor_E::disable-e30-bundle-deny') ne 'yes') + { + my $bundleDenyTable = $session->get_table( + -baseoid => $dd->oiddef('bundleBytesSentDenyPolicyDrop') ); + $devdetails->storeSnmpVars( $bundleDenyTable ); + + if( $bundleDenyTable ) + { + $devdetails->setCap('e30-bundle-denyStats'); + } + } + + if( $devdetails->param('Arbor_E::disable-e30-bundle-rate') ne 'yes') + { + my $bundleRateLimitTable = $session->get_table( + -baseoid => $dd->oiddef('bundleBytesSentRateLimitDrop') ); + $devdetails->storeSnmpVars( $bundleRateLimitTable ); + + if( $bundleRateLimitTable ) + { + $devdetails->setCap('e30-bundle-rateLimitStats'); + } + } + + } # END if Arbor_E::disable-e30-bundle + + # PROG: Counters + if( $devdetails->param('Arbor_E::disable-e30-slowpath') ne 'yes' ) + { + # Slowpath counters are available as of 7.5.x + my $counters = $session->get_table( + -baseoid => $dd->oiddef('slowpathCounters') ); + $devdetails->storeSnmpVars( $counters ); + + if( defined( $counters ) ) + { + $devdetails->setCap('e30-slowpath'); + } + } + } + + + # ------------------------------------------------------------------------ + # + # Arbor E100 related material here + + if( $eInfo->{'modelNum'} >= 8 ) + { + Debug("Arbor_E: Found " . $eChassisName{$eInfo->{'modelNum'}} ); + + # PROG: Set Capability to be the e100 device + $devdetails->setCap('e100'); + + # CPU parameters ... + if( $devdetails->param('Arbor_E::disable-e100-cpu') ne 'yes' ) + { + my $cpuNameTable = $session->get_table( + -baseoid => $dd->oiddef('cpuName') ); + $devdetails->storeSnmpVars( $cpuNameTable ); + + if( defined( $cpuNameTable ) ) + { + $devdetails->setCap('e100-cpu'); + + # PROG: Find all the CPU's .. + foreach my $cpuIndex ( $devdetails->getSnmpIndices( + $dd->oiddef('cpuName') ) ) + { + my $cpuName = $cpuNameTable->{$dd->oiddef('cpuName') . + '.' . $cpuIndex}; + + Debug(" CPU found: $cpuIndex, $cpuName"); + $data->{'e100'}{'cpu'}{$cpuIndex} = $cpuName; + } + } + } + + # HDD Parameters + if( $devdetails->param('Arbor_E::disable-e100-hdd') ne 'yes' ) + { + my $hddTable = $session->get_table( + -baseoid => $dd->oiddef('partitionName') ); + $devdetails->storeSnmpVars( $hddTable ); + + if( defined( $hddTable ) ) + { + $devdetails->setCap('e100-hdd'); + + # PROG: Find all the paritions and names .. + foreach my $hddIndex ( $devdetails->getSnmpIndices( + $dd->oiddef('partitionName') ) ) + { + my $partitionName = $hddTable->{$dd->oiddef('partitionName') . + '.' . $hddIndex}; + Debug("HDD Partition: $hddIndex, $partitionName"); + $data->{'e100'}{'hdd'}{$hddIndex} = $partitionName; + } + } + } + + # MEM Parameters + if( $devdetails->param('Arbor_E::disable-e100-mem') ne 'yes' ) + { + my $cpuSdramTable = $session->get_table( + -baseoid => $dd->oiddef('cpuSdramIndex') ); + $devdetails->storeSnmpVars( $cpuSdramTable ); + + if( defined( $cpuSdramTable ) ) + { + $devdetails->setCap('e100-mem'); + + # PROG: Find all memory indexes + foreach my $memIndex ( $devdetails->getSnmpIndices( + $dd->oiddef('cpuSdramIndex') ) ) + { + my $memName = $data->{'e100'}{'cpu'}{$memIndex}; + Debug("MEM found: $memIndex, $memName"); + $data->{'e100'}{'mem'}{$memIndex} = $memName; + } + } + } + + # Policy Mgmt parameters + if( $devdetails->param('Arbor_E::disable-e100-policymgmt') ne 'yes' ) + { + my $policyTable = $session->get_table( + -baseoid => $dd->oiddef('policyMgmt') + ); + $devdetails->storeSnmpVars( $policyTable ); + + if( defined( $policyTable ) ) + { + $devdetails->setCap('e100-policymgmt'); + } + } + + # Subscriber Mgmt parameters + if( $devdetails->param('Arbor_E::disable-e100-submgmt') ne 'yes' ) + { + my $subTable = $session->get_table( + -baseoid => $dd->oiddef('subscriberStateName') + ); + $devdetails->storeSnmpVars( $subTable ); + + if( defined( $subTable ) ) + { + $devdetails->setCap('e100-submgmt'); + + # Sub: Find state name entries + foreach my $stateIDX ( $devdetails->getSnmpIndices( $dd->oiddef( + 'subscriberStateName') ) ) + { + my $state = $subTable->{ + $dd->oiddef('subscriberStateName') . + '.' . $stateIDX + }; + + Debug(" State index: $stateIDX, name: $state"); + $data->{'e100'}{'submgmt'}{$stateIDX} = $state; + } + } + } + } + + + # ------------------------------------------------------------------------ + # + # Common information between e30 and e100 + + if( $devdetails->param('Arbor_E::disable-flowdev') ne 'yes' ) + { + $devdetails->setCap('arbor-flowLookup'); + + # Flow Lookup Device information + # Figure out what pools exist for the 2 flow switching modules + # ------------------------------------------------------------ + my $switchingModules = 2; + + foreach my $flowModule (1 .. $switchingModules) { + Debug("common: Flow Lookup Device " . $flowModule); + + my $flowPoolOid = 'flowPoolNameD' . $flowModule; + my $flowModTable = $session->get_table ( + -baseoid => $dd->oiddef($flowPoolOid) ); + $devdetails->storeSnmpVars ( $flowModTable ); + + # PROG: Look for pool names and indexes and store them. + if( $flowModTable ) { + foreach my $flowPoolIDX ( $devdetails->getSnmpIndices( + $dd->oiddef($flowPoolOid) ) ) + { + my $flowPoolName = $flowModTable->{ + $dd->oiddef($flowPoolOid) . '.' . $flowPoolIDX}; + + $data->{'arbor_e'}{'flowModule'}{$flowModule}{$flowPoolIDX} + = $flowPoolName; + + Debug("common: IDX: $flowPoolIDX Pool: $flowPoolName"); + + } # END: foreach my $flowPoolIDX + } # END: if $flowModTable + } # END: foreach my $flowModule + } + + + if( $devdetails->param('Arbor_E::disable-bundle-offer') ne 'yes' ) + { + my $boOfferNameTable = $session->get_table( + -baseoid => $dd->oiddef('boOfferName') ); + $devdetails->storeSnmpVars( $boOfferNameTable ); + + my $boBundleNameTable = $session->get_table( + -baseoid => $dd->oiddef('boBundleName') ); + $devdetails->storeSnmpVars( $boBundleNameTable ); + + if( defined( $boOfferNameTable ) ) + { + $devdetails->setCap('arbor-bundle'); + + foreach my $boOfferNameID ( $devdetails->getSnmpIndices( + $dd->oiddef('boOfferName') ) ) + { + my ($bundleID,$offerNameID) = split( /\./, $boOfferNameID ); + + my $offerName = $boOfferNameTable->{ + $dd->oiddef('boOfferName') + . '.' . $boOfferNameID }; + my $bundleName = $boBundleNameTable->{ + $dd->oiddef('boBundleName') + . '.' . $boOfferNameID }; + + $data->{'arbor_e'}{'offerName'}{$offerNameID} = $offerName; + $data->{'arbor_e'}{'bundleName'}{$bundleID} = $bundleName; + + push( @{$data->{'arbor_e'}{'boOfferBundle'}{$offerNameID}}, + $bundleID ); + } + } + + # PROG: Subscribers using the bundle + if( $devdetails->param('Arbor_E::disable-bundle-offer-subcount') + ne 'yes' ) + { + my $oidSubcount = $dd->oiddef('boBundleSubCount'); + + if( defined $session->get_table( -baseoid => $oidSubcount ) ) + { + $devdetails->setCap('arbor-bundle-subcount'); + } + } + + # PROG: Packets sent on this bundle with a size + if( $devdetails->param('Arbor_E::disable-bundle-offer-pktsize') + ne 'yes' ) + { + my $oidPktsize = $dd->oiddef('boPacketsSent64'); + + if( defined $session->get_table( -baseoid => $oidPktsize ) ) + { + $devdetails->setCap('arbor-bundle-pktsize'); + } + } + + # PROG: Bytes sent on this bundle for deny policy drop + if( $devdetails->param('Arbor_E::disable-bundle-offer-deny') + ne 'yes' ) + { + my $oidDenypolicy = $dd->oiddef('boBundleBytesSentDenyPolicyDrop'); + + if( defined $session->get_table( -baseoid => $oidDenypolicy ) ) + { + $devdetails->setCap('arbor-bundle-deny'); + } + } + + # PROG: Bytes sent on this bundle for rate limit drop + if( $devdetails->param('Arbor_E::disable-bundle-offer-rate') + ne 'yes' ) + { + my $oidRatelimit = $dd->oiddef('boBundleBytesSentRateLimitDrop'); + + if( defined $session->get_table( -baseoid => $oidRatelimit ) ) + { + $devdetails->setCap('arbor-bundle-ratelimit'); + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + # PROG: Lets do e30 first ... + if( $devdetails->hasCap('e30') ) + { + # e30 buffer information + if( $devdetails->hasCap('e30-buffers') ) + { + $cb->addTemplateApplication($devNode, 'Arbor_E::e30-buffers'); + } + + if( $devdetails->hasCap('e30-bundle') ) + { + # Create topLevel subtree + my $bundleNode = $cb->addSubtree( $devNode, 'Bundle_Stats', + { 'comment' => 'Bundle statistics' }, + [ 'Arbor_E::e30-bundle-subtree' ] ); + + foreach my $bundleID + ( sort {$a <=> $b} keys %{$data->{'e30'}{'bundleID'} } ) + { + my $srvName = $data->{'e30'}{'bundleID'}{$bundleID}; + my $subtreeName = $srvName; + $subtreeName =~ s/\W/_/g; + my $bundleRRD = $bundleID; + my @templates = ( 'Arbor_E::e30-bundle' ); + + if( $devdetails->param('Arbor_E::enable-e30-bundle-name-rrd') + eq 'yes' ) + { + # Filenames written out as the bundle name + $bundleRRD = lc($srvName); + $bundleRRD =~ s/\W/_/g; + } + + if( $devdetails->hasCap('e30-bundle-denyStats') ) + { + push( @templates, 'Arbor_E::e30-bundle-deny' ); + } + + if( $devdetails->hasCap('e30-bundle-rateLimitStats') ) + { + push( @templates, 'Arbor_E::e30-bundle-ratelimit' ); + } + + $cb->addSubtree( $bundleNode, $subtreeName, + { 'comment' => $srvName, + 'e30-bundle-index' => $bundleID, + 'e30-bundle-name' => $srvName, + 'e30-bundle-rrd' => $bundleRRD, + 'precedence' => 1000 - $bundleID }, + \@templates ); + } # END foreach my $bundleID + } + + # e30 cpu + if( $devdetails->hasCap('e30-cpu') ) + { + $cb->addTemplateApplication($devNode, 'Arbor_E::e30-cpu'); + } + + # e30 forwarding table + if( $devdetails->hasCap('e30-fwdTable') ) + { + $cb->addTemplateApplication($devNode, 'Arbor_E::e30-fwdTable'); + + if( $devdetails->hasCap('e30-fwdTable-login') ) + { + my $subtree = "Forwarding_Table_Login_Stats"; + my $comment = "Discovery attempts statistics"; + my $nodeTree = $cb->addSubtree( $devNode, $subtree, + { 'comment' => $comment }, + undef ); + + my @colors = + ('##one', '##two', '##three', '##four', '##five', + '##six', '##seven', '##eight', '##nine', '##ten' + ); + + my $multiParam = { + 'precedence' => 1000, + 'comment' => 'Summary of login attempt responses', + 'graph-lower-limit' => 0, + 'graph-title' => 'Summary of login attempt responses', + 'rrd-hwpredict' => 'disabled', + 'vertical-label' => 'Responses', + 'ds-type' => 'rrd-multigraph' + }; + my $dsList; + + foreach my $sindex ( sort { $a <=> $b } + @{$data->{'e30'}{'loginResp'}} ) + { + + $cb->addLeaf( $nodeTree, 'Login_' . $sindex, + { 'comment' => 'Login attempt #' . $sindex, + 'login-idx' => $sindex, + 'precedence' => 100 - $sindex }, + [ 'Arbor_E::e30-fwdTable-login' ] ); + + # Addition for multi-graph + my $dsName = "Login_$sindex"; + my $color = shift @colors; + $dsList .= $dsName . ','; + + $multiParam->{"ds-expr-$dsName"} = "{$dsName}"; + $multiParam->{"graph-legend-$dsName"} = "Attempt $sindex"; + $multiParam->{"line-style-$dsName"} = "LINE1"; + $multiParam->{"line-color-$dsName"} = $color; + $multiParam->{"line-order-$dsName"} = $sindex; + + Debug(" loginReps: $sindex, color: $color"); + } # END: foreach $sindex + + $dsList =~ s/,$//o; # Remove final comma + $multiParam->{'ds-names'} = $dsList; + + $cb->addLeaf($nodeTree, 'Summary', $multiParam, undef ); + + } # END: hasCap e30-fwdTable-login + } # END: hasCap e30-fwdTable + + # e30 hard drive + if( $devdetails->hasCap('e30-hdd') ) + { + my $comment = "Model: " . $data->{'e30'}{'hddModel'} . ", " . + "Serial: " . $data->{'e30'}{'hddSerial'}; + my $subtree = "Hard_Drive"; + my @templates; + push( @templates, 'Arbor_E::e30-hdd-subtree' ); + push( @templates, 'Arbor_E::e30-hdd' ); + + # PROG: Process hdd errors + if( $devdetails->hasCap('e30-hdd-errors') ) + { + push( @templates, 'Arbor_E::e30-hdd-errors' ); + } + + # PROG: Process hdd daily logs + if( $devdetails->hasCap('e30-hdd-logs') ) + { + push( @templates, 'Arbor_E::e30-hdd-logs' ); + } + + my $hdNode = $cb->addSubtree($devNode, $subtree, + { 'comment' => $comment }, + \@templates); + } + + # e30 L2TP tunnel information + if( $devdetails->hasCap('e30-l2tp') ) + { + # PROG: First add the appropriate template + my $l2tpNode = $cb->addSubtree( $devNode, 'L2TP', undef, + [ 'Arbor_E::e30-l2tp-subtree' ]); + + # PROG: Cycle through the SECURE EndPoint devices + if( $data->{'e30'}{'l2tpSEP'} ) + { + # PROG: Add the assisting template first + my $l2tpEndNode = $cb->addSubtree( $l2tpNode, 'Secure_Endpoint', + { 'comment' => 'Secure endpoint parties' }, + [ 'Arbor_E::e30-l2tp-secure-endpoints-subtree' ] ); + + foreach my $SEP ( keys %{$data->{'e30'}{'l2tpSEP'}} ) + { + my $endPoint = $SEP; + $endPoint =~ s/\W/_/g; + + $cb->addSubtree($l2tpEndNode, $endPoint, + { 'e30-l2tp-ep' => $SEP, + 'e30-l2tp-file' => $endPoint }, + [ 'Arbor_E::e30-l2tp-secure-endpoints-leaf' ]); + } # END: foreach + } + } + + # e30 memory + if( $devdetails->hasCap('e30-mem') ) + { + $cb->addTemplateApplication($devNode, 'Arbor_E::e30-mem'); + } + + # e30 memory pool + if( $devdetails->hasCap('e30-mempool') ) + { + my $subtreeName = "Memory_Pool"; + my $param = { 'comment' => 'Memory Pool Statistics' }; + my $templates = [ 'Arbor_E::e30-mempool-subtree' ]; + my $memIndex = $data->{'e30'}{'mempool'}; + + my $nodeTop = $cb->addSubtree( $devNode, $subtreeName, + $param, $templates ); + + foreach my $memIDX ( keys %{$memIndex} ) + { + my $leafName = $memIndex->{$memIDX}; + my $dataFile = "%snmp-host%_mempool_" . $leafName . '.rrd'; + + my $nodeMem = $cb->addSubtree( $nodeTop, $leafName, + { 'data-file' => $dataFile, + 'e30-mempool-index' => $memIDX, + 'e30-mempool-name' => $leafName + }, + [ 'Arbor_E::e30-mempool' ] ); + } + } + + # e30 slowpath counters + if( $devdetails->hasCap('e30-slowpath') ) + { + my $slowNode = $cb->addSubtree( $devNode, 'SlowPath', undef, + [ 'Arbor_E::e30-slowpath' ] ); + } + } # END: if e30 device + + + # ----------------------------------------------------- + # + # E100 series... + + if( $devdetails->hasCap('e100') ) + { + # CPU: per-cpu information + if( $devdetails->hasCap('e100-cpu') ) + { + my @colors = ( '##one', '##two', '##three', '##four', '##five', + '##six', '##seven', '##eight', '##nine', '##ten' + ); + my $subtree = "CPU_Usage"; + my $cpuTree = $cb->addSubtree( $devNode, $subtree, undef, + [ 'Arbor_E::e100-cpu-subtree' ] ); + my $multiParam = { + 'precedence' => 1000, + 'comment' => 'Summary of all CPU utilization', + 'graph-lower-limit' => 0, + 'graph-title' => 'Summary of all CPU utilization', + 'rrd-hwpredict' => 'disabled', + 'vertical-label' => 'Percent', + 'ds-type' => 'rrd-multigraph' + }; + my $dsList; + + foreach my $cpuIndex ( sort keys %{$data->{'e100'}{'cpu'}} ) + { + my $cpuName = $data->{'e100'}{'cpu'}{$cpuIndex}; + + # Is there proper desc for the CPU index? + my $comment; + if( $eCpuName{$cpuIndex} ) + { + $comment = $eCpuName{$cpuIndex}; + } else { + $comment = "CPU: $cpuName"; + } + + $cb->addLeaf( $cpuTree, $cpuName, + { 'comment' => $comment, + 'cpu-index' => $cpuIndex, + 'cpu-name' => $cpuName, + 'precedence' => 1000 - $cpuIndex }, + [ 'Arbor_E::e100-cpu' ] ); + + # Multi-graph additions + my $color = shift @colors; + $dsList .= $cpuName . ','; + $multiParam->{"ds-expr-$cpuName"} = "{$cpuName}"; + $multiParam->{"graph-legend-$cpuName"} = "$cpuName"; + $multiParam->{"line-style-$cpuName"} = "LINE1"; + $multiParam->{"line-color-$cpuName"} = $color; + $multiParam->{"line-order-$cpuName"} = $cpuIndex; + } # END: foreach $cpuIndex + + $dsList =~ s/,$//o; # Remove final comma + $multiParam->{'ds-names'} = $dsList; + $cb->addLeaf($cpuTree, 'Summary', $multiParam, undef ); + + } # END: hasCap e100-cpu + + # HDD: Partition sizes / usage + if( $devdetails->hasCap('e100-hdd') ) + { + my $subtree = "HDD_Usage"; + my $hddTree = $cb->addSubtree( $devNode, $subtree, undef, + [ 'Arbor_E::e100-hdd-subtree' ] ); + + foreach my $hddIndex ( sort keys %{$data->{'e100'}{'hdd'}} ) + { + my $hddName = $data->{'e100'}{'hdd'}{$hddIndex}; + $cb->addSubtree( $hddTree, $hddName, + { 'comment' => 'HDD: ' . $hddName, + 'hdd-index' => $hddIndex, + 'hdd-name' => $hddName, + 'precedence' => 1000 - $hddIndex }, + [ 'Arbor_E::e100-hdd' ] ); + } + } + + # MEM: per-cpu memory usage + if( $devdetails->hasCap('e100-mem') ) + { + my $subtree = "Memory_Usage"; + my $memTree = $cb->addSubtree( $devNode, $subtree, undef, + [ 'Arbor_E::e100-mem-subtree' ] ); + foreach my $memIndex ( sort keys %{$data->{'e100'}{'mem'}} ) + { + my $memName = $data->{'e100'}{'cpu'}{$memIndex}; + + my $comment = "Memory for $memName CPU"; + $cb->addSubtree( $memTree, $memName, + { 'comment' => $comment, + 'mem-index' => $memIndex, + 'mem-name' => $memName, + 'precedence' => 1000 - $memIndex }, + [ 'Arbor_E::e100-mem' ] ); + } + } + + # PolicyMmgt: Information regarding delta, service bundles, subnets + if( $devdetails->hasCap('e100-policymgmt') ) + { + $cb->addTemplateApplication($devNode, 'Arbor_E::e100-policymgmt'); + } + + # SubscriberMgmt: Information regarding subscriber counts, states, etc. + if( $devdetails->hasCap('e100-submgmt') ) + { + my $subMgmtTree = $cb->addSubtree( $devNode, 'Subscribers', undef, + [ 'Arbor_E::e100-submgmt-subtree' ] + ); + + my $stateTree = $cb->addSubtree( $subMgmtTree, 'Subscriber_State', + undef, + [ 'Arbor_E::e100-submgmt-state-subtree' ] + ); + + # State: Multigraph display + my @colors = + ('##one', '##two', '##three', '##four', '##five', + '##six', '##seven', '##eight', '##nine', '##ten' + ); + my $multiParam = { + 'precedence' => 1000, + 'graph-lower-limit' => 0, + 'graph-title' => 'Summary of subscriber states', + 'rrd-hwpredict' => 'disabled', + 'vertical-label' => 'Subscribers', + 'comment' => 'Summary of all states', + 'ds-type' => 'rrd-multigraph' + }; + my $dsList; + + foreach my $stateIDX ( sort keys %{$data->{'e100'}{'submgmt'}} ) + { + my $color = shift @colors; + my $stateName = $data->{'e100'}{'submgmt'}{$stateIDX}; + my $stateNameRRD = $stateName; + $stateNameRRD =~ s/[^a-zA-Z_]/_/o; + + my $stateNode = $cb->addLeaf( $stateTree, $stateName, + { 'comment' => "State: $stateName", + 'state-idx' => $stateIDX, + 'state-name' => $stateName, + 'state-rrd' => $stateNameRRD, + 'precedence' => 100 - $stateIDX }, + [ 'Arbor_E::e100-submgmt-state' ] ); + $dsList .= $stateName . ','; + + $multiParam->{"ds-expr-$stateName"} = "{$stateName}"; + $multiParam->{"graph-legend-$stateName"} = "$stateName"; + $multiParam->{"line-style-$stateName"} = "LINE1"; + $multiParam->{"line-color-$stateName"} = $color, + $multiParam->{"line-order-$stateName"} = $stateIDX; + } + $dsList =~ s/,$//o; + $multiParam->{'ds-names'} = $dsList; + + $cb->addLeaf($stateTree, 'Summary', $multiParam, undef ); + + } + } + + # ------------------------------------------------------------------------- + # + # Common information between e30 and e100 + + if( $devdetails->hasCap('arbor-bundle') ) + { + my $subtreeName = "Bundle_Offer_Stats"; + my $param = { 'comment' => 'Byte counts for each bundle ' . + 'per Offer' }; + my $templates = [ ]; + my $nodeTop = $cb->addSubtree( $devNode, $subtreeName, + $param, $templates ); + + foreach my $offerNameID ( keys %{$data->{'arbor_e'}{'offerName'}} ) + { + my $offerName = $data->{'arbor_e'}{'offerName'}{$offerNameID}; + $offerName =~ s/\W/_/g; + my $offerBundle = $data->{'arbor_e'}{'boOfferBundle'}; + my $offerRRD = $offerNameID; + + if( $devdetails->param('Arbor_E::enable-bundle-name-rrd') + eq 'yes' ) + { + # Filename will now be written as offer name + $offerRRD = lc($offerName); + } + + # Build tree + my $oparam = { 'comment' => 'Offer: ' . $offerName, + 'offer-id' => $offerNameID, + 'offer-rrd' => $offerRRD }; + my $otemplates = [ 'Arbor_E::arbor-bundle-subtree' ]; + my $offerTop = $cb->addSubtree( $nodeTop, $offerName, $oparam, + $otemplates ); + + Debug(" Offer: $offerName"); + + foreach my $bundleID ( @{%{$offerBundle}->{$offerNameID}} ) + { + my @btemplates; + my $bundleName = $data->{'arbor_e'}{'bundleName'}{$bundleID}; + $bundleName =~ s/\W/_/g; + my $bundleRRD = $bundleID; + + Debug(" $bundleID: $bundleName"); + + if( $devdetails->param('Arbor_E::enable-bundle-name-rrd') + eq 'yes' ) + { + # Filename will now be written as bundle name + $bundleRRD = lc($bundleName); + } + + my $bparam = { 'comment' => 'Bundle ID: ' . $bundleID, + 'data-file' => '%system-id%_bo_' . + '%offer-rrd%_' . + '%bundle-rrd%.rrd', + 'bundle-id' => $bundleID, + 'bundle-name' => $bundleName, + 'bundle-rrd' => $bundleRRD }; + push( @btemplates, 'Arbor_E::arbor-bundle' ); + + # PROG: Subscribers using the bundle + if( $devdetails->hasCap('arbor-bundle-subcount') ) + { + push( @btemplates, 'Arbor_E::arbor-bundle-subcount' ); + } + + # PROG: Packets sent on this bundle per size + if( $devdetails->hasCap('arbor-bundle-pktsize') ) + { + push( @btemplates, 'Arbor_E::arbor-bundle-pktsize' ); + } + + # PROG: Bytes sent on this bundle for deny policy drop + if( $devdetails->hasCap('arbor-bundle-deny') ) + { + push( @btemplates, 'Arbor_E::arbor-bundle-deny' ); + } + + # PROG: Bytes sent on this bundle for rate limit drop + if( $devdetails->hasCap('arbor-bundle-ratelimit') ) + { + push( @btemplates, 'Arbor_E::arbor-bundle-ratelimit' ); + } + + # Build tree + $cb->addSubtree( $offerTop, $bundleName, + $bparam, \@btemplates ); + } # END: foreach $bundleID + } # END: foreach $offerNameID + } # END: hasCap arbor-bundle + + # Flow device lookups + if( $devdetails->hasCap('arbor-flowLookup') ) + { + # PROG: Flow Lookup Device (pool names) + my $flowNode = $cb->addSubtree( $devNode, 'Flow_Lookup', + { 'comment' => 'Switching modules' }, + undef ); + + my $flowLookup = $data->{'arbor_e'}{'flowModule'}; + + foreach my $flowDevIdx ( keys %{$flowLookup} ) + { + my $flowNodeDev = $cb->addSubtree( $flowNode, + 'Flow_Lookup_' . $flowDevIdx, + { 'comment' => 'Switching module ' + . $flowDevIdx }, + [ 'Arbor_E::arbor-flowlkup-subtree' ] ); + + # PROG: Find all the pool names and add Subtree + foreach my $flowPoolIdx ( keys %{$flowLookup->{$flowDevIdx}} ) + { + my $poolName = $flowLookup->{$flowDevIdx}{$flowPoolIdx}; + + my $poolNode = $cb->addSubtree( $flowNodeDev, $poolName, + { 'comment' => 'Flow Pool: ' . $poolName, + 'flowdev-index' => $flowDevIdx, + 'flowpool-index' => $flowPoolIdx, + 'flowpool-name' => $poolName, + 'precedence' => 1000 - $flowPoolIdx}, + [ 'Arbor_E::arbor-flowlkup-leaf' ] ); + } # END: foreach my $flowPoolIdx + } # END: foreach my $flowDevIdx + } # END: hasCap arbor-flowLookup + +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Arista.pm b/torrus/perllib/Torrus/DevDiscover/Arista.pm new file mode 100644 index 000000000..bd18029e4 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Arista.pm @@ -0,0 +1,144 @@ +# +# Copyright (C) 2009 Jon Nistor +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Arista.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $ +# Jon Nistor + +# Force10 Networks Real Time Operating System Software +# +# NOTE: Arista::x + +package Torrus::DevDiscover::Arista; + +use strict; +use Torrus::Log; + +$Torrus::DevDiscover::registry{'Arista'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + 'sysDescr' => '1.3.6.1.2.1.1.1.0', + # Arista + 'aristaProducts' => '1.3.6.1.4.1.30065.1' + + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::Arista::interfaceFilter +# or define $Torrus::DevDiscover::Arista::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %aristaInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%aristaInterfaceFilter; +} + + +# Key is some unique symbolic name, does not mean anything +# ifType is the number to match the interface type +# ifDescr is the regexp to match the interface description +%aristaInterfaceFilter = + ( + 'other' => { + 'ifType' => 1, # other + }, + 'lag' => { + 'ifType' => 161, # ieee 802.3ad LAG groups + # added due to index too high + }, + 'loopback' => { + 'ifType' => 24, # softwareLoopback + }, + 'vlan' => { + 'ifType' => 136, # vlan + # added due to index too high + }, + + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'aristaProducts', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + + if( defined( $interfaceFilterOverlay ) ) + { + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilterOverlay); + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # PROG: Add comment for sysDescr + my $desc = $dd->retrieveSnmpOIDs('sysDescr'); + $data->{'param'}{'comment'} = $desc->{'sysDescr'}; + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/AscendMax.pm b/torrus/perllib/Torrus/DevDiscover/AscendMax.pm new file mode 100644 index 000000000..4bf2bd83b --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/AscendMax.pm @@ -0,0 +1,207 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: AscendMax.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $ +# Stanislav Sinyagin + +# Ascend (Lucent) MAX device discovery. + +# Tested with: +# +# MAX 4000, TAOS version 7.0.26 + +# NOTE: SNMP version 1 is only supported. Because of version 1 and numerous +# WAN DS0 interfaces, the discovery process may take few minutes. + +package Torrus::DevDiscover::AscendMax; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'AscendMax'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # ASCEND-MIB + 'ASCEND-MIB::max' => '1.3.6.1.4.1.529.1.2', + # ASCEND-ADVANCED-AGENT-MIB + 'ASCEND-ADVANCED-AGENT-MIB::wanLineTable' => + '1.3.6.1.4.1.529.4.21', + 'ASCEND-ADVANCED-AGENT-MIB::wanLineState' => + '1.3.6.1.4.1.529.4.21.1.5', + 'ASCEND-ADVANCED-AGENT-MIB::wanLineActiveChannels' => + '1.3.6.1.4.1.529.4.21.1.7', + 'ASCEND-ADVANCED-AGENT-MIB::wanLineSwitchedChannels' => + '1.3.6.1.4.1.529.4.21.1.13' + ); + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::AscendMax::interfaceFilter +# or define $Torrus::DevDiscover::AscendMax::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %ascMaxInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%ascMaxInterfaceFilter; +} + + +# Key is some unique symbolic name, does not mean anything +# ifType is the number to match the interface type +# ifDescr is the regexp to match the interface description +%ascMaxInterfaceFilter = + ( + 'Console' => { + 'ifType' => 33 # rs232 + }, + 'E1' => { + 'ifType' => 19 # e1 + }, + 'wan_activeN' => { + 'ifType' => 23, # ppp + 'ifDescr' => '^wan\d+' + }, + 'wan_inactiveN' => { + 'ifType' => 1, # other + 'ifDescr' => '^wan\d+' + }, + 'wanidleN' => { + 'ifType' => 1, # other + 'ifDescr' => '^wanidle\d+' + }, + 'loopbacks' => { + 'ifType' => 24 # softwareLoopback + } + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'ASCEND-MIB::max', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + + if( defined( $interfaceFilterOverlay ) ) + { + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilterOverlay); + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + my $wanTableOid = $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineTable' ); + my $stateOid = + $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineState' ); + my $totalOid = + $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineSwitchedChannels' ); + + my $wanTable = $session->get_table( -baseoid => $wanTableOid ); + if( defined( $wanTable ) ) + { + $devdetails->storeSnmpVars( $wanTable ); + $devdetails->setCap('wanLineTable'); + + $data->{'ascend_wanLines'} = {}; + + foreach my $ifIndex ( $devdetails->getSnmpIndices( $stateOid ) ) + { + # Check if the line State is 13(active) + if( $devdetails->snmpVar( $stateOid . '.' . $ifIndex) == 13 ) + { + my $descr = $devdetails->snmpVar($dd->oiddef('ifDescr') . + '.' . $ifIndex); + + $data->{'ascend_wanLines'}{$ifIndex}{'description'} = $descr; + $data->{'ascend_wanLines'}{$ifIndex}{'channels'} = + $devdetails->snmpVar( $totalOid . '.' . $ifIndex ); + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + my $callStatsNode = $cb->addSubtree( $devNode, 'Call_Statistics', undef, + ['AscendMax::ascend-totalcalls']); + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'ascend_wanLines'}} ) + { + my $param = {}; + $param->{'precedence'} = sprintf('%d', -10000 - $ifIndex); + $param->{'ascend-ifidx'} = $ifIndex; + + my $nChannels = $data->{'ascend_wanLines'}{$ifIndex}{'channels'}; + $param->{'upper-limit'} = $nChannels; + $param->{'graph-upper-limit'} = $nChannels; + + my $subtreeName = $data->{'ascend_wanLines'}{$ifIndex}{'description'}; + $subtreeName =~ s/\W/_/g; + + $cb->addLeaf( $callStatsNode, $subtreeName, $param, + ['AscendMax::ascend-line-stats']); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm b/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm new file mode 100644 index 000000000..12dc05957 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm @@ -0,0 +1,351 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: AxxessIT.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Stanislav Sinyagin + +# AxxessIT Ethernet over SDH switches, also known as +# Cisco ONS 15305 and 15302 (by January 2005) +# Probably later Cisco will update the software and it will need +# another Torrus discovery module. +# Company website: http://www.axxessit.no/ + +# Tested with: +# +# Cisco ONS 15305 software release 1.1.1 +# Cisco ONS 15302 + + + + +package Torrus::DevDiscover::AxxessIT; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'AxxessIT'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # AXXEDGE-MIB + 'axxEdgeTypes' => '1.3.6.1.4.1.7546.1.4.1.1', + + 'axxEdgeWanPortMapTable' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2', + 'axxEdgeWanPortMapSlotNumber' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2.1.1', + 'axxEdgeWanPortMapPortNumber' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2.1.2', + + 'axxEdgeWanXPortMapTable' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11', + 'axxEdgeWanXPortMapSlotNumber' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11.1.1', + 'axxEdgeWanXPortMapPortNumber' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11.1.2', + + 'axxEdgeWanPortDescription' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.3.1.4', + 'axxEdgeWanXPortDescription' => '1.3.6.1.4.1.7546.1.4.1.2.5.1.12.1.4', + + 'axxEdgeEthPortMapTable' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2', + 'axxEdgeEthPortMapSlotNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2.1.1', + 'axxEdgeEthPortMapPortNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2.1.2', + + 'axxEdgeEthLanXPortMapTable' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4', + 'axxEdgeEthLanXPortMapSlotNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4.1.1', + 'axxEdgeEthLanXPortMapPortNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4.1.2', + + 'axxEdgeEthPortDescription' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.3.1.4', + 'axxEdgeEthLanXPortDescription' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.5.1.4', + + 'axxEdgeDcnManagementPortMode' => '1.3.6.1.4.1.7546.1.4.1.2.3.2.1.0', + 'axxEdgeDcnManagementPortIfIndex' => '1.3.6.1.4.1.7546.1.4.1.2.3.2.2.0', + + # AXX155E-MIB (ONS 15302) + 'axx155EDevices' => '1.3.6.1.4.1.7546.1.5.1.1', + + 'axx155EEthPortTable' => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2', + 'axx155EEthPortIfIndex' => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.2', + 'axx155EEthPortName' => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.3', + 'axx155EEthPortType' => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.4', + + 'axx155EDcnManagementPortMode' => '1.3.6.1.4.1.7546.1.5.1.2.2.2.2.0', + 'axx155EDcnManagementPortIfIndex' => '1.3.6.1.4.1.7546.1.5.1.2.2.2.3.0' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $sysObjID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') ); + if( index( $sysObjID, $dd->oiddef('axxEdgeTypes') ) == 0 ) + { + $devdetails->setCap('axxEdge'); + } + elsif( index( $sysObjID, $dd->oiddef('axx155EDevices') ) == 0 ) + { + $devdetails->setCap('axx155E'); + } + else + { + return 0; + } + + $devdetails->setCap('interfaceIndexingManaged'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX'; + + $data->{'nameref'}{'ifNick'} = 'axxInterfaceNick'; + $data->{'nameref'}{'ifSubtreeName'} = 'axxInterfaceNick'; + $data->{'nameref'}{'ifComment'} = 'axxInterfaceComment'; + $data->{'nameref'}{'ifReferenceName'} = 'axxInterfaceHumanName'; + + if( $devdetails->hasCap('axxEdge') ) + { + my %map = + ( 'Wan' => { + 'MapTable' => 'axxEdgeWanPortMapTable', + 'MapSlotNumber' => 'axxEdgeWanPortMapSlotNumber', + 'MapPortNumber' => 'axxEdgeWanPortMapPortNumber', + 'Description' => 'axxEdgeWanPortDescription', + 'ifNick' => 'Wan_%d_%d', + 'ifHuman' => 'WAN %d/%d', + 'ifComment' => 'WAN slot %d, port %d' }, + + 'WanX' => { + 'MapTable' => 'axxEdgeWanXPortMapTable', + 'MapSlotNumber' => 'axxEdgeWanXPortMapSlotNumber', + 'MapPortNumber' => 'axxEdgeWanXPortMapPortNumber', + 'Description' => 'axxEdgeWanXPortDescription', + 'ifNick' => 'WanX_%d_%d', + 'ifHuman' => 'WANX %d/%d', + 'ifComment' => 'WANX slot %d, port %d' }, + + 'Eth' => { + 'MapTable' => 'axxEdgeEthPortMapTable', + 'MapSlotNumber' => 'axxEdgeEthPortMapSlotNumber', + 'MapPortNumber' => 'axxEdgeEthPortMapPortNumber', + 'Description' => 'axxEdgeEthPortDescription', + 'ifNick' => 'Eth_%d_%d', + 'ifHuman' => 'Ethernet %d/%d', + 'ifComment' => 'Ethernet interface: slot %d, port %d' }, + + 'EthLanX' => { + 'MapTable' => 'axxEdgeEthLanXPortMapTable', + 'MapSlotNumber' => 'axxEdgeEthLanXPortMapSlotNumber', + 'MapPortNumber' => 'axxEdgeEthLanXPortMapPortNumber', + 'Description' => 'axxEdgeEthLanXPortDescription', + 'ifNick' => 'EthLanX_%d_%d', + 'ifHuman' => 'Ethernet LANX %d/%d', + 'ifComment' => 'Ethernet LANX interface: slot %d, port %d' } + ); + + foreach my $type ( keys %map ) + { + my $mapTable = + $session->get_table( -baseoid => + $dd->oiddef($map{$type}{'MapTable'}) ); + $devdetails->storeSnmpVars( $mapTable ); + + my $descTable = + $session->get_table( -baseoid => + $dd->oiddef($map{$type}{'Description'}) ); + $devdetails->storeSnmpVars( $descTable ); + + foreach my $ifIndex + ( $devdetails-> + getSnmpIndices($dd->oiddef($map{$type}{'MapSlotNumber'})) ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + next if not defined( $interface ); + + my $slot = + $devdetails->snmpVar + ($dd->oiddef($map{$type}{'MapSlotNumber'}) .'.'. $ifIndex); + my $port = + $devdetails->snmpVar + ($dd->oiddef($map{$type}{'MapPortNumber'}) .'.'. $ifIndex); + + my $desc = + $devdetails->snmpVar + ($dd->oiddef($map{$type}{'Description'}) .'.'. + $slot .'.'. $port); + + $interface->{'param'}{'interface-index'} = $ifIndex; + + $interface->{'axxInterfaceNick'} = + sprintf( $map{$type}{'ifNick'}, $slot, $port ); + + $interface->{'axxInterfaceHumanName'} = + sprintf( $map{$type}{'ifHuman'}, $slot, $port ); + + $interface->{'axxInterfaceComment'} = + sprintf( $map{$type}{'ifComment'}, $slot, $port ); + if( length( $desc ) > 0 ) + { + $interface->{'axxInterfaceComment'} .= ' (' . $desc . ')'; + } + } + } + + # Management interface + { + my $result = $dd->retrieveSnmpOIDs + ( 'axxEdgeDcnManagementPortMode', + 'axxEdgeDcnManagementPortIfIndex'); + + if( defined( $result ) ) + { + if( $result->{'axxEdgeDcnManagementPortMode'} != 2 ) + { + Warning('Non-IP mode of Management port is not supported'); + } + else + { + my $ifIndex = $result->{'axxEdgeDcnManagementPortIfIndex'}; + + my $interface = $data->{'interfaces'}{$ifIndex}; + + $interface->{'param'}{'interface-index'} = $ifIndex; + + $interface->{'axxInterfaceNick'} = 'Management'; + + $interface->{'axxInterfaceHumanName'} = 'Management'; + + $interface->{'axxInterfaceComment'} = 'Management port'; + } + } + } + } + + if( $devdetails->hasCap('axx155E') ) + { + my $ethTable = + $session->get_table( -baseoid => + $dd->oiddef('axx155EEthPortTable') ); + $devdetails->storeSnmpVars( $ethTable ); + + foreach my $port + ( $devdetails-> + getSnmpIndices($dd->oiddef('axx155EEthPortIfIndex')) ) + { + my $ifIndex = + $devdetails->snmpVar + ($dd->oiddef('axx155EEthPortIfIndex') .'.'. $port); + + my $interface = $data->{'interfaces'}{$ifIndex}; + next if not defined( $interface ); + + my $portName = + $devdetails->snmpVar + ($dd->oiddef('axx155EEthPortName') .'.'. $port); + + my $portType = + $devdetails->snmpVar + ($dd->oiddef('axx155EEthPortType') .'.'. $port); + + $interface->{'param'}{'interface-index'} = $ifIndex; + + my $type = $portType == 1 ? 'Eth':'Wan'; + + $interface->{'axxInterfaceNick'} = + sprintf( '%s_%d', $type, $port ); + + $interface->{'axxInterfaceHumanName'} = + sprintf( '%s %d', $type, $port ); + + $interface->{'axxInterfaceComment'} = ''; + if( length( $portName ) > 0 ) + { + $interface->{'axxInterfaceComment'} = $portName; + } + } + + # Management interface + { + my $result = $dd->retrieveSnmpOIDs + ( 'axx155EDcnManagementPortMode', + 'axx155EDcnManagementPortIfIndex'); + + if( defined( $result ) ) + { + if( $result->{'axx155EDcnManagementPortMode'} != 2 ) + { + Warning('Non-IP mode of Management port is not supported'); + } + else + { + my $ifIndex = $result->{'axx155EDcnManagementPortIfIndex'}; + + my $interface = $data->{'interfaces'}{$ifIndex}; + + $interface->{'param'}{'interface-index'} = $ifIndex; + + $interface->{'axxInterfaceNick'} = 'Management'; + + $interface->{'axxInterfaceHumanName'} = 'Management'; + + $interface->{'axxInterfaceComment'} = 'Management port'; + } + } + } + } + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + if( not defined( $data->{'interfaces'}{$ifIndex}-> + {'param'}{'interface-index'} ) ) + { + delete $data->{'interfaces'}{$ifIndex}; + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm b/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm new file mode 100644 index 000000000..c7187992c --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm @@ -0,0 +1,238 @@ +# Copyright (C) 2004 Marc Haber +# Copyright (C) 2005 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# $Id: BetterNetworks.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Marc Haber +# Redesigned by Stanislav Sinyagin + +# Better Networks Ethernet Box + +package Torrus::DevDiscover::BetterNetworks; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'BetterNetworks'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + 'BNEversion' => '1.3.6.1.4.1.14848.2.1.1.1.0', + 'BNElocation' => '1.3.6.1.4.1.14848.2.1.1.2.0', + 'BNEtempunit' => '1.3.6.1.4.1.14848.2.1.1.3.0', + 'BNEuptime' => '1.3.6.1.4.1.14848.2.1.1.7.0', + 'BNEsensorTable' => '1.3.6.1.4.1.14848.2.1.2', + 'BNEsensorName' => '1.3.6.1.4.1.14848.2.1.2.1.2', + 'BNEsensorType' => '1.3.6.1.4.1.14848.2.1.2.1.3', + 'BNEsensorValid' => '1.3.6.1.4.1.14848.2.1.2.1.7', + ); + + +our %sensorTypes = + ( + 1 => { + 'comment' => 'Temperature sensor', + }, + 2 => { + 'comment' => 'Brightness sensor', + 'label' => 'Lux', + }, + 3 => { + 'comment' => 'Humidity sensor', + 'label' => 'Percent RH', + }, + 4 => { + 'comment' => 'Switch contact', + }, + 5 => { + 'comment' => 'Voltage meter', + }, + 6 => { + 'comment' => 'Smoke sensor', + }, + ); + +our %tempUnits = + ( + 0 => 'Celsius', + 1 => 'Fahrenheit', + 2 => 'Kelvin' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->checkSnmpOID( 'BNEuptime' ) ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + my $unitInfo = $dd->retrieveSnmpOIDs('BNEversion', + 'BNElocation', + 'BNEtempunit'); + if( not defined( $unitInfo ) ) + { + Error('Error retrieving Better Networks Ethernet Box device details'); + return 0; + } + + # sensor support + my $sensorTable = $session->get_table( -baseoid => + $dd->oiddef('BNEsensorTable') ); + if( defined( $sensorTable ) ) + { + $devdetails->storeSnmpVars( $sensorTable ); + + # store the sensor names to guarantee uniqueness + my %sensorNames; + + foreach my $INDEX + ( $devdetails->getSnmpIndices($dd->oiddef('BNEsensorName') ) ) + { + if( $devdetails->snmpVar( $dd->oiddef('BNEsensorValid') . + '.' . $INDEX ) == 0 ) + { + next; + } + + my $type = $devdetails->snmpVar( $dd->oiddef('BNEsensorType') . + '.' . $INDEX ); + my $name = $devdetails->snmpVar( $dd->oiddef('BNEsensorName') + . '.' . $INDEX ); + + if( $sensorNames{$name} ) + { + Warn('Duplicate sensor names: ' . $name); + $sensorNames{$name}++; + } + else + { + $sensorNames{$name} = 1; + } + + if( $sensorNames{$name} > 1 ) + { + $name .= sprintf(' %d', $sensorNames{$name}); + } + + my $leafName = $name; + $leafName =~ s/\W/_/g; + + my $param = { + 'bne-sensor-index' => $INDEX, + 'node-display-name' => $name, + 'precedence' => sprintf('%d', 1000 - $INDEX) + }; + + if( defined( $sensorTypes{$type} ) ) + { + $param->{'comment'} = + sprintf('%s: %s', $sensorTypes{$type}{'comment'}, $name); + if( $type != 1 ) + { + if( defined( $sensorTypes{$type}{'label'} ) ) + { + $param->{'vertical-label'} = + $sensorTypes{$type}{'label'}; + } + } + else + { + $param->{'vertical-label'} = + $tempUnits{$unitInfo->{'BNEtempunit'}}; + } + } + else + { + $param->{'comment'} = 'Unknown sensor type'; + } + + $data->{'BNEsensor'}{$INDEX}{'param'} = $param; + $data->{'BNEsensor'}{$INDEX}{'leafName'} = $leafName; + } + + if( scalar( %{$data->{'BNEsensor'}} ) > 0 ) + { + $devdetails->setCap('BNEsensor'); + + my $devComment = + 'BetterNetworks EthernetBox, ' . $unitInfo->{'BNEversion'}; + if( $unitInfo->{'BNElocation'} =~ /\w/ ) + { + $devComment .= ', Location: ' . + $unitInfo->{'BNElocation'}; + } + $data->{'param'}{'comment'} = $devComment; + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + if( $devdetails->hasCap('BNEsensor') ) + { + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'BNEsensor'}} ) + { + my $param = $data->{'BNEsensor'}{$INDEX}{'param'}; + my $leafName = $data->{'BNEsensor'}{$INDEX}{'leafName'}; + + $cb->addLeaf( $devNode, $leafName, $param, + ['BetterNetworks::betternetworks-sensor'] ); + } + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm b/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm new file mode 100644 index 000000000..90b41633f --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm @@ -0,0 +1,268 @@ +# Copyright (C) 2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CasaCMTS.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ +# Stanislav Sinyagin + +# DOCSIS interface, CASA specific + +package Torrus::DevDiscover::CasaCMTS; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CasaCMTS'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisMacModemsMonitor'} = 'CasaCMTS'; + + +our %oiddef = + ( + 'casaProducts' => '1.3.6.1.4.1.20858.2', + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'casaProducts', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) or + not $devdetails->isDevType('RFC2670_DOCS_IF') ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + push( @{$data->{'docsConfig'}{'docsCableMaclayer'}{'templates'}}, + 'CasaCMTS::casa-docsis-mac-subtree' ); + + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'CasaCMTS::casa-docsis-mac-util' ); + } + + foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'CasaCMTS::casa-docsis-upstream-util' ); + } + + foreach my $ifIndex ( @{$data->{'docsCableDownstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'CasaCMTS::casa-docsis-downstream-util' ); + } + + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + + if( scalar( @{$data->{'docsCableMaclayer'}} ) > 0 ) + { + # Build All_Modems summary graph + my $param = { + 'ds-type' => 'rrd-multigraph', + 'ds-names' => 'total,active,registered', + 'graph-lower-limit' => '0', + 'precedence' => '1000', + 'vertical-label' => 'Modems', + + 'graph-legend-total' => 'Total', + 'line-style-total' => '##totalresource', + 'line-color-total' => '##totalresource', + 'line-order-total' => '1', + + 'graph-legend-active' => 'Active', + 'line-style-active' => '##resourcepartusage', + 'line-color-active' => '##resourcepartusage', + 'line-order-active' => '2', + + 'graph-legend-registered' => 'Registered', + 'line-style-registered' => '##resourceusage', + 'line-color-registered' => '##resourceusage', + 'line-order-registered' => '3', + 'descriptive-nickname' => '%system-id%: All modems' + }; + + # for the sake of better Emacs formatting + $param->{'comment'} = + 'Registered, Active and Total modems on CMTS'; + + $param->{'nodeid'} = + $data->{'docsConfig'}{'docsCableMaclayer'}{'nodeidCategory'} . + '//%nodeid-device%//modems'; + + my $first = 1; + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + if( $first ) + { + $param->{'ds-expr-total'} = + '{' . $intf . '/Modems_Total}'; + $param->{'ds-expr-active'} = + '{' . $intf . '/Modems_Active}'; + $param->{'ds-expr-registered'} = + '{' . $intf . '/Modems_Registered}'; + $first = 0; + } + else + { + $param->{'ds-expr-total'} .= + ',{' . $intf . '/Modems_Total},+'; + $param->{'ds-expr-active'} .= + ',{' . $intf . '/Modems_Active},+'; + $param->{'ds-expr-registered'} .= + ',{' . $intf . '/Modems_Registered},+'; + } + } + + my $macNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{ + 'docsCableMaclayer'}{ + 'subtreeName'} ); + if( defined( $macNode ) ) + { + $cb->addLeaf( $macNode, 'All_Modems', $param, [] ); + } + else + { + Error('Could not find the MAC layer subtree'); + exit 1; + } + + # Apply selector actions + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $monitor = + $interface->{'selectorActions'}{'DocsisMacModemsMonitor'}; + if( defined( $monitor ) ) + { + my $intfNode = $cb->getChildSubtree( $macNode, $intf ); + $cb->addLeaf( $intfNode, 'Modems_Registered', + {'monitor' => $monitor } ); + } + } + } + + if( scalar( @{$data->{'docsCableUpstream'}} ) > 0 ) + { + my $upstrNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{'docsCableUpstream'}{ + 'subtreeName'} ); + + # Override the overview shortcus defined in rfc2670.docsis-if.xml + + my $shortcuts = 'snr,fec,freq,modems'; + + my $param = { + 'overview-shortcuts' => + $shortcuts, + + 'overview-subleave-name-modems' => 'Modems', + 'overview-direct-link-modems' => 'yes', + 'overview-direct-link-view-modems' => 'expanded-dir-html', + 'overview-shortcut-text-modems' => 'All modems', + 'overview-shortcut-title-modems'=> + 'Show modem quantities in one page', + 'overview-page-title-modems' => 'Modem quantities', + }; + + $cb->addParams( $upstrNode, $param ); + } + + if( scalar( @{$data->{'docsCableDownstream'}} ) > 0 ) + { + my $downstrNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{'docsCableDownstream'}{ + 'subtreeName'} ); + + # Override the overview shortcus defined in rfc2670.docsis-if.xml + + my $shortcuts = 'util,modems'; + + my $param = { + 'overview-shortcuts' => $shortcuts, + 'overview-subleave-name-modems' => 'Modems', + 'overview-direct-link-modems' => 'yes', + 'overview-direct-link-view-modems' => 'expanded-dir-html', + 'overview-shortcut-text-modems' => 'All modems', + 'overview-shortcut-title-modems' => + 'Show modem quantities in one page', + 'overview-page-title-modems' => 'Modem quantities', + }; + + $cb->addParams( $downstrNode, $param ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm b/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm new file mode 100644 index 000000000..411d72f7a --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm @@ -0,0 +1,193 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoCatOS.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Stanislav Sinyagin + +# Cisco CatOS devices discovery +# To do: +# Power supply and temperature monitoring +# RAM monitoring + +package Torrus::DevDiscover::CiscoCatOS; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoCatOS'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-SMI + 'ciscoWorkgroup' => '1.3.6.1.4.1.9.5', + # CISCO-STACK-MIB + 'CISCO-STACK-MIB::portName' => '1.3.6.1.4.1.9.5.1.4.1.1.4', + 'CISCO-STACK-MIB::portIfIndex' => '1.3.6.1.4.1.9.5.1.4.1.1.11', + 'CISCO-STACK-MIB::chassisSerialNumberString' => + '1.3.6.1.4.1.9.5.1.2.19.0' + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::CiscoCatOS::interfaceFilter +# or define $Torrus::DevDiscover::CiscoCatOS::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %catOsInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%catOsInterfaceFilter; +} + + +# Key is some unique symbolic name, does not mean anything +# ifType is the number to match the interface type +# ifDescr is the regexp to match the interface description +%catOsInterfaceFilter = + ( + 'VLAN N' => { + 'ifType' => 53, # propVirtual + 'ifDescr' => '^VLAN\s+\d+' + }, + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'ciscoWorkgroup', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + + if( defined( $interfaceFilterOverlay ) ) + { + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilterOverlay); + } + + $devdetails->setCap('interfaceIndexingManaged'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + $data->{'nameref'}{'ifReferenceName'} = 'ifName'; + $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; + $data->{'param'}{'ifindex-table'} = '$ifName'; + + $data->{'nameref'}{'ifComment'} = 'portName'; + + # Retrieve port descriptions from CISCO-STACK-MIB + + my $portIfIndexOID = $dd->oiddef('CISCO-STACK-MIB::portIfIndex'); + my $portNameOID = $dd->oiddef('CISCO-STACK-MIB::portName'); + + my $portIfIndex = $session->get_table( -baseoid => $portIfIndexOID ); + if( defined $portIfIndex ) + { + $devdetails->storeSnmpVars( $portIfIndex ); + + my $portName = $session->get_table( -baseoid => $portNameOID ); + if( defined $portName ) + { + foreach my $portIndex + ( $devdetails->getSnmpIndices( $portIfIndexOID ) ) + { + my $ifIndex = + $devdetails->snmpVar( $portIfIndexOID .'.'. $portIndex ); + my $interface = $data->{'interfaces'}{$ifIndex}; + + $interface->{'portName'} = + $portName->{$portNameOID .'.'. $portIndex}; + } + } + } + + # In large installations, only named ports may be of interest + if( $devdetails->param('CiscoCatOS::suppress-noname-ports') eq 'yes' ) + { + my $nExcluded = 0; + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + if( not defined( $interface->{'portName'} ) or + length( $interface->{'portName'} ) == 0 ) + { + $interface->{'excluded'} = 1; + $nExcluded++; + } + } + Debug('Excluded ' . $nExcluded . ' catalyst ports with empty names'); + } + + my $chassisSerial = + $dd->retrieveSnmpOIDs( 'CISCO-STACK-MIB::chassisSerialNumberString' ); + if( defined( $chassisSerial ) ) + { + if( defined( $data->{'param'}{'comment'} ) ) + { + $data->{'param'}{'comment'} .= ', '; + } + $data->{'param'}{'comment'} .= 'Hw Serial#: ' . + $chassisSerial->{'CISCO-STACK-MIB::chassisSerialNumberString'}; + } + + return 1; +} + + +# Nothing really to do yet +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm b/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm new file mode 100644 index 000000000..b27cfb466 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm @@ -0,0 +1,142 @@ +# Copyright (C) 2003 Shawn Ferry +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoFirewall.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $ +# Shawn Ferry + +# Cisco Firewall devices discovery + +package Torrus::DevDiscover::CiscoFirewall; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoFirewall'} = { + 'sequence' => 510, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-FIREWALL + 'ciscoFirewallMIB' => '1.3.6.1.4.1.9.9.147', + 'cfwBasicEventsTableLastRow' => '1.3.6.1.4.1.9.9.147.1.1.4', + 'cfwConnectionStatTable' => '1.3.6.1.4.1.9.9.147.1.2.2.2.1', + 'cfwConnectionStatMax' => '1.3.6.1.4.1.9.9.147.1.2.2.2.1.5.40.7', + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + if( $devdetails->isDevType('CiscoGeneric') and + $dd->checkSnmpTable('ciscoFirewallMIB') ) + { + $devdetails->setCap('interfaceIndexingManaged'); + return 1; + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + $data->{'nameref'}{'ifReferenceName'} = 'ifName'; + $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; + $data->{'param'}{'ifindex-table'} = '$ifName'; + + if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) ) + { + my $oidsPerPDU = + $devdetails->param('CiscoFirewall::snmp-oids-per-pdu'); + if( $oidsPerPDU == 0 ) + { + $oidsPerPDU = 10; + } + $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU; + } + + if( $dd->checkSnmpOID('cfwConnectionStatMax') ) + { + $devdetails->setCap('CiscoFirewall::connections'); + } + + # I have not seen a system that supports this. + if( $dd->checkSnmpOID('cfwBasicEventsTableLastRow') ) + { + $devdetails->setCap('CiscoFirewall::events'); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + my $fwStatsTree = "Firewall_Stats"; + my $fwStatsParam = { + 'precedence' => '-1000', + 'comment' => 'Firewall Stats', + }; + + my @templates = ('CiscoFirewall::cisco-firewall-subtree'); + + if( $devdetails->hasCap('CiscoFirewall::connections') ) + { + push( @templates, 'CiscoFirewall::connections'); + } + + if( $devdetails->hasCap('CiscoFirewall::events') ) + { + push( @templates, 'CiscoFirewall::events'); + } + + $cb->addSubtree( $devNode, $fwStatsTree, $fwStatsParam, \@templates ); +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm b/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm new file mode 100644 index 000000000..4262bdd71 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm @@ -0,0 +1,743 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoGeneric.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $ +# Stanislav Sinyagin + +# Common Cisco MIBs, supported by many IOS and CatOS devices + +package Torrus::DevDiscover::CiscoGeneric; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoGeneric'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-SMI + 'cisco' => '1.3.6.1.4.1.9', + + # CISCO-ENVMON-MIB + 'ciscoEnvMonTemperatureStatusDescr' => '1.3.6.1.4.1.9.9.13.1.3.1.2', + 'ciscoEnvMonTemperatureStatusValue' => '1.3.6.1.4.1.9.9.13.1.3.1.3', + 'ciscoEnvMonTemperatureThreshold' => '1.3.6.1.4.1.9.9.13.1.3.1.4', + 'ciscoEnvMonTemperatureStatusState' => '1.3.6.1.4.1.9.9.13.1.3.1.6', + 'ciscoEnvMonSupplyState' => '1.3.6.1.4.1.9.9.13.1.5.1.3', + + # CISCO-ENHANCED-MEMPOOL-MIB + 'cempMemPoolName' => '1.3.6.1.4.1.9.9.221.1.1.1.1.3', + + # CISCO-MEMORY-POOL-MIB + 'ciscoMemoryPoolName' => '1.3.6.1.4.1.9.9.48.1.1.1.2', + + # CISCO-PROCESS-MIB + 'cpmCPUTotalTable' => '1.3.6.1.4.1.9.9.109.1.1.1.1', + 'cpmCPUTotalPhysicalIndex' => '1.3.6.1.4.1.9.9.109.1.1.1.1.2', + 'cpmCPUTotal1minRev' => '1.3.6.1.4.1.9.9.109.1.1.1.1.7', + 'cpmCPUTotal1min' => '1.3.6.1.4.1.9.9.109.1.1.1.1.4', + + # OLD-CISCO-CPU-MIB + 'avgBusy1' => '1.3.6.1.4.1.9.2.1.57.0' + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'cisco', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + if( $devdetails->param('CiscoGeneric::disable-sensors') ne 'yes' ) + { + # Check if temperature sensors are supported + + my $oidTempDescr = $dd->oiddef('ciscoEnvMonTemperatureStatusDescr'); + my $oidTempValue = $dd->oiddef('ciscoEnvMonTemperatureStatusValue'); + my $oidTempThrsh = $dd->oiddef('ciscoEnvMonTemperatureThreshold'); + my $oidTempState = $dd->oiddef('ciscoEnvMonTemperatureStatusState'); + + if( defined $session->get_table( -baseoid => $oidTempValue ) ) + { + $devdetails->setCap('ciscoTemperatureSensors'); + $data->{'ciscoTemperatureSensors'} = {}; + + my $tempDescr = $session->get_table( -baseoid => $oidTempDescr ); + my $tempThrsh = $session->get_table( -baseoid => $oidTempThrsh ); + + # Get the sensor states and ignore those notPresent(5) + + my $tempState = $session->get_table( -baseoid => $oidTempState ); + + my $prefixLen = length( $oidTempDescr ) + 1; + while( my( $oid, $descr ) = each %{$tempDescr} ) + { + # Extract the sensor index from OID + my $sIndex = substr( $oid, $prefixLen ); + + if( $tempState->{$oidTempState.'.'.$sIndex} != 5 ) + { + $data->{'ciscoTemperatureSensors'}{$sIndex}{ + 'description'} = $descr; + $data->{'ciscoTemperatureSensors'}{$sIndex}{ + 'threshold'} = $tempThrsh->{$oidTempThrsh.'.'.$sIndex}; + } + } + } + } + + if( $devdetails->param('CiscoGeneric::disable-psupplies') ne 'yes' ) + { + # Check if power supply status is supported + + my $oidSupply = $dd->oiddef('ciscoEnvMonSupplyState'); + + my $supplyTable = $session->get_table( -baseoid => $oidSupply ); + if( defined( $supplyTable ) ) + { + $devdetails->setCap('ciscoPowerSupplies'); + $data->{'ciscoPowerSupplies'} = []; + + my $prefixLen = length( $oidSupply ) + 1; + while( my( $oid, $val ) = each %{$supplyTable} ) + { + # Extract the supply index from OID + my $sIndex = substr( $oid, $prefixLen ); + + #check if the value is not notPresent(5) + if( $val != 5 ) + { + push( @{$data->{'ciscoPowerSupplies'}}, $sIndex ); + } + } + } + } + + if( $devdetails->param('CiscoGeneric::disable-memory-pools') ne 'yes' ) + { + my $eMemPool = + $session->get_table( -baseoid => + $dd->oiddef('cempMemPoolName') ); + if( defined $eMemPool and scalar( %{$eMemPool} ) > 0 and + $devdetails->isDevType('RFC2737_ENTITY_MIB') ) + { + $devdetails->storeSnmpVars( $eMemPool ); + $devdetails->setCap('cempMemPool'); + $data->{'cempMemPool'} = {}; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices($dd->oiddef('cempMemPoolName') ) ) + { + # $INDEX is a pair entPhysicalIndex . cempMemPoolIndex + my ( $phyIndex, $poolIndex ) = split('\.', $INDEX); + + my $poolName = $devdetails-> + snmpVar($dd->oiddef('cempMemPoolName') . '.' . $INDEX ); + + $poolName = 'Processor' unless $poolName; + + my $phyDescr = $data->{'entityPhysical'}{$phyIndex}{'descr'}; + my $phyName = $data->{'entityPhysical'}{$phyIndex}{'name'}; + + $phyDescr = 'Processor' unless $phyDescr; + $phyName = ('Chassis #' . + $phyIndex) unless $phyName; + + $data->{'cempMemPool'}{$INDEX} = { + 'phyIndex' => $phyIndex, + 'poolIndex' => $poolIndex, + 'poolName' => $poolName, + 'phyDescr' => $phyDescr, + 'phyName' => $phyName + }; + } + } + else + { + my $MemoryPool = + $session->get_table( -baseoid => + $dd->oiddef('ciscoMemoryPoolName') ); + + if( defined $MemoryPool and scalar( %{$MemoryPool} ) > 0 ) + { + $devdetails->storeSnmpVars( $MemoryPool ); + $devdetails->setCap('ciscoMemoryPool'); + + $data->{'ciscoMemoryPool'} = {}; + + foreach my $memType + ( $devdetails-> + getSnmpIndices($dd->oiddef('ciscoMemoryPoolName')) ) + { + # According to CISCO-MEMORY-POOL-MIB, only types 1 to 5 + # are static, and the rest are dynamic + # (of which none ever seen) + if( $memType <= 5 ) + { + my $name = + $devdetails-> + snmpVar($dd->oiddef('ciscoMemoryPoolName') . + '.' . $memType ); + + $data->{'ciscoMemoryPool'}{$memType} = $name; + } + } + } + } + } + + if( $devdetails->param('CiscoGeneric::disable-cpu-stats') ne 'yes' ) + { + my $ciscoCpuStats = + $session->get_table( -baseoid => $dd->oiddef('cpmCPUTotalTable') ); + + if( defined $ciscoCpuStats ) + { + $devdetails->setCap('ciscoCpuStats'); + $devdetails->storeSnmpVars( $ciscoCpuStats ); + + $data->{'ciscoCpuStats'} = {}; + + # Find multiple CPU entries pointing to the same Phy index + my %phyReferers = (); + foreach my $INDEX + ( $devdetails-> + getSnmpIndices($dd->oiddef('cpmCPUTotalPhysicalIndex') ) ) + { + my $phyIndex = $devdetails-> + snmpVar($dd->oiddef('cpmCPUTotalPhysicalIndex') . + '.' . $INDEX ); + $phyReferers{$phyIndex}++; + } + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices($dd->oiddef('cpmCPUTotalPhysicalIndex') ) ) + { + $data->{'ciscoCpuStats'}{$INDEX} = {}; + + my $phyIndex = $devdetails-> + snmpVar($dd->oiddef('cpmCPUTotalPhysicalIndex') . + '.' . $INDEX ); + + my $phyDescr; + my $phyName; + + if( $phyIndex > 0 and + $devdetails->isDevType('RFC2737_ENTITY_MIB') ) + { + $phyDescr = $data->{'entityPhysical'}{$phyIndex}{'descr'}; + $phyName = $data->{'entityPhysical'}{$phyIndex}{'name'}; + } + + $phyDescr = 'Central Processor' unless $phyDescr; + $phyName = ('Chassis #' . $phyIndex) unless $phyName; + ; + my $cpuNick = $phyName; + $cpuNick =~ s/^\///; + $cpuNick =~ s/\W/_/g; + $cpuNick =~ s/_+/_/g; + + if( $phyReferers{$phyIndex} > 1 ) + { + $phyDescr .= ' (' . $INDEX . ')'; + $cpuNick .= '_' . $INDEX; + } + + $data->{'ciscoCpuStats'}{$INDEX} = { + 'phy-index' => $phyIndex, + 'phy-name' => $phyName, + 'phy-descr' => $phyDescr, + 'phy-referers' => $phyReferers{$phyIndex}, + 'cpu-nick' => $cpuNick }; + + if( $devdetails->hasOID( $dd->oiddef('cpmCPUTotal1minRev') . + '.' . $INDEX ) ) + { + $data->{'ciscoCpuStats'}{$INDEX}{'stats-type'} = 'revised'; + } + } + } + else + { + # Although OLD-CISCO-CPU-MIB is implemented in IOS only, + # it is easier to leave it here in Generic + + if( $dd->checkSnmpOID('avgBusy1') ) + { + $devdetails->setCap('old-ciscoCpuStats'); + push( @{$data->{'templates'}}, 'CiscoGeneric::old-cisco-cpu' ); + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + # Temperature Sensors + + if( $devdetails->hasCap('ciscoTemperatureSensors') ) + { + # Create a subtree for the sensors + my $subtreeName = 'Temperature_Sensors'; + + my $fahrenheit = + $devdetails->param('CiscoGeneric::use-fahrenheit') eq 'yes'; + + my $param = { + 'node-display-name' => 'Temperature Sensors', + }; + my $templates = [ 'CiscoGeneric::cisco-temperature-subtree' ]; + + my $filePerSensor = + $devdetails->param('CiscoGeneric::file-per-sensor') eq 'yes'; + + $param->{'data-file'} = '%snmp-host%_sensors' . + ($filePerSensor ? '_%sensor-index%':'') . + ($fahrenheit ? '_fahrenheit':'') . '.rrd'; + + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, + $param, $templates ); + + foreach my $sIndex ( sort {$a<=>$b} keys + %{$data->{'ciscoTemperatureSensors'}} ) + { + my $leafName = sprintf( 'sensor_%.2d', $sIndex ); + + my $desc = + $data->{'ciscoTemperatureSensors'}{$sIndex}{'description'}; + my $threshold = + $data->{'ciscoTemperatureSensors'}{$sIndex}{'threshold'}; + + if( $fahrenheit ) + { + $threshold = $threshold * 1.8 + 32; + } + + my $param = { + 'sensor-index' => $sIndex, + 'sensor-description' => $desc, + 'upper-limit' => $threshold + }; + + my $templates = ['CiscoGeneric::cisco-temperature-sensor' . + ($fahrenheit ? '-fahrenheit':'')]; + + my $monitor = $data->{'ciscoTemperatureSensors'}{$sIndex}->{ + 'selectorActions'}{'Monitor'}; + if( defined( $monitor ) ) + { + $param->{'monitor'} = $monitor; + } + + my $tset = $data->{'ciscoTemperatureSensors'}{$sIndex}->{ + 'selectorActions'}{'TokensetMember'}; + if( defined( $tset ) ) + { + $param->{'tokenset-member'} = $tset; + } + + $cb->addLeaf( $subtreeNode, $leafName, $param, $templates ); + } + } + + # Power supplies + + if( $devdetails->hasCap('ciscoPowerSupplies') ) + { + # Create a subtree for the power supplies + my $subtreeName = 'Power_Supplies'; + + my $param = { + 'node-display-name' => 'Power Supplies', + 'comment' => 'Power supplies status', + 'precedence' => -600, + }; + my $templates = []; + + $param->{'data-file'} = '%system-id%_power.rrd'; + + my $monitor = $devdetails->param('CiscoGeneric::power-monitor'); + if( length( $monitor ) > 0 ) + { + $param->{'monitor'} = $monitor; + } + + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, + $param, $templates ); + + foreach my $sIndex ( sort {$a<=>$b} @{$data->{'ciscoPowerSupplies'}} ) + { + my $leafName = sprintf( 'power_%.2d', $sIndex ); + + my $param = { + 'power-index' => $sIndex + }; + + my $templates = ['CiscoGeneric::cisco-power-supply']; + + $cb->addLeaf( $subtreeNode, $leafName, $param, $templates ); + } + } + + + # Memory Pools + + if( $devdetails->hasCap('cempMemPool') or + $devdetails->hasCap('ciscoMemoryPool') ) + { + my $subtreeName = 'Memory_Usage'; + + my $param = { + 'node-display-name' => 'Memory Usage', + 'precedence' => '-100', + 'comment' => 'Router memory utilization' + }; + + my $subtreeNode = + $cb->addSubtree( $devNode, $subtreeName, $param, + ['CiscoGeneric::cisco-memusage-subtree']); + + if( $devdetails->hasCap('cempMemPool') ) + { + foreach my $INDEX ( sort { + $data->{'cempMemPool'}{$a}{'phyIndex'} <=> + $data->{'cempMemPool'}{$b}{'phyIndex'} or + $data->{'cempMemPool'}{$a}{'poolIndex'} <=> + $data->{'cempMemPool'}{$b}{'poolIndex'} } + keys %{$data->{'cempMemPool'}} ) + { + my $pool = $data->{'cempMemPool'}{$INDEX}; + + # Chop off the long chassis description, like + # uBR7246VXR chassis, Hw Serial#: XXXXX, Hw Revision: A + my $phyName = $pool->{'phyName'}; + if( $phyName =~ /chassis/ ) + { + $phyName =~ s/,.+//; + } + + my $poolSubtreeName = + $phyName . '_' . $pool->{'poolName'}; + $poolSubtreeName =~ s/^\///; + $poolSubtreeName =~ s/\W/_/g; + $poolSubtreeName =~ s/_+/_/g; + + my $param = {}; + + $param->{'comment'} = + $pool->{'poolName'} . ' memory of '; + if( $pool->{'phyDescr'} eq $pool->{'phyName'} ) + { + $param->{'comment'} .= $phyName; + } + else + { + $param->{'comment'} .= + $pool->{'phyDescr'} . ' in ' . $phyName; + } + + $param->{'mempool-index'} = $INDEX; + $param->{'mempool-phyindex'} = $pool->{'phyIndex'}; + $param->{'mempool-poolindex'} = $pool->{'poolIndex'}; + + $param->{'mempool-name'} = $pool->{'poolName'}; + $param->{'precedence'} = + sprintf("%d", 1000 - + $pool->{'phyIndex'} * 100 - $pool->{'poolIndex'}); + + $cb->addSubtree( $subtreeNode, $poolSubtreeName, $param, + [ 'CiscoGeneric::cisco-enh-mempool' ]); + } + } + else + { + foreach my $memType + ( sort {$a<=>$b} keys %{$data->{'ciscoMemoryPool'}} ) + { + my $poolName = $data->{'ciscoMemoryPool'}{$memType}; + + my $poolSubtreeName = $poolName; + $poolSubtreeName =~ s/^\///; + $poolSubtreeName =~ s/\W/_/g; + $poolSubtreeName =~ s/_+/_/g; + + my $param = { + 'comment' => 'Memory Pool: ' . $poolName, + 'mempool-type' => $memType, + 'mempool-name' => $poolName, + 'precedence' => sprintf("%d", 1000 - $memType) + }; + + $cb->addSubtree( $subtreeNode, $poolSubtreeName, + $param, [ 'CiscoGeneric::cisco-mempool' ]); + } + } + } + + if( $devdetails->hasCap('ciscoCpuStats') ) + { + my $subtreeName = 'CPU_Usage'; + my $param = { + 'node-display-name' => 'CPU Usage', + 'precedence' => '-500', + 'comment' => 'Overall CPU busy percentage' + }; + + my $subtreeNode = + $cb->addSubtree( $devNode, $subtreeName, $param, + ['CiscoGeneric::cisco-cpu-usage-subtree']); + + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'ciscoCpuStats'}} ) + { + my $cpu = $data->{'ciscoCpuStats'}{$INDEX}; + + my $param = { + 'comment' => $cpu->{'phy-descr'} . ' in ' . $cpu->{'phy-name'} + }; + + # On newer dual-CPU routers, several (two seen) CPU entries + # refer to the same physical entity. For such entries, + # we map them directly to cpmCPUTotalTable index. + if( $cpu->{'phy-referers'} > 1 ) + { + $param->{'cisco-cpu-indexmap'} = $INDEX; + $param->{'cisco-cpu-ref'} = $INDEX; + } + else + { + $param->{'entity-phy-index'} = $cpu->{'phy-index'}; + $param->{'cisco-cpu-ref'} = '%entity-phy-index%'; + } + + my @templates; + + if( $cpu->{'stats-type'} eq 'revised' ) + { + push( @templates, 'CiscoGeneric::cisco-cpu-revised' ); + } + else + { + push( @templates, 'CiscoGeneric::cisco-cpu' ); + } + + my $cpuNode = $cb->addSubtree( $subtreeNode, $cpu->{'cpu-nick'}, + $param, \@templates ); + + my $tset = $cpu->{'selectorActions'}{'TokensetMember'}; + if( defined( $tset ) ) + { + $cb->addLeaf( $cpuNode, 'CPU_Total_1min', + { 'tokenset-member' => $tset } ); + } + } + } +} + + + +####################################### +# Selectors interface +# + +$Torrus::DevDiscover::selectorsRegistry{'CiscoSensor'} = { + 'getObjects' => \&getSelectorObjects, + 'getObjectName' => \&getSelectorObjectName, + 'checkAttribute' => \&checkSelectorAttribute, + 'applyAction' => \&applySelectorAction, +}; + +$Torrus::DevDiscover::selectorsRegistry{'CiscoCPU'} = { + 'getObjects' => \&getSelectorObjects, + 'getObjectName' => \&getSelectorObjectName, + 'checkAttribute' => \&checkSelectorAttribute, + 'applyAction' => \&applySelectorAction, +}; + +## Objects are interface indexes + +sub getSelectorObjects +{ + my $devdetails = shift; + my $objType = shift; + + my $data = $devdetails->data(); + my @ret; + + if( $objType eq 'CiscoSensor' ) + { + @ret = keys( %{$data->{'ciscoTemperatureSensors'}} ); + } + elsif( $objType eq 'CiscoCPU' ) + { + @ret = keys( %{$data->{'ciscoCpuStats'}} ); + } + + return( sort {$a<=>$b} @ret ); +} + + +sub checkSelectorAttribute +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $attr = shift; + my $checkval = shift; + + my $data = $devdetails->data(); + + my $value; + my $operator = '=~'; + + if( $objType eq 'CiscoSensor' ) + { + my $sensor = $data->{'ciscoTemperatureSensors'}{$object}; + if( $attr eq 'SensorDescr' ) + { + $value = $sensor->{'description'}; + } + else + { + Error('Unknown CiscoSensor selector attribute: ' . $attr); + $value = ''; + } + } + elsif( $objType eq 'CiscoCPU' ) + { + my $cpu = $data->{'ciscoCpuStats'}{$object}; + if( $attr eq 'CPUName' ) + { + $value = $cpu->{'cpu-nick'}; + } + elsif( $attr eq 'CPUDescr' ) + { + $value = $cpu->{'cpu-descr'}; + } + else + { + Error('Unknown CiscoCPU selector attribute: ' . $attr); + $value = ''; + } + } + + return eval( '$value' . ' ' . $operator . '$checkval' ) ? 1:0; +} + + +sub getSelectorObjectName +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + + my $data = $devdetails->data(); + my $name; + + if( $objType eq 'CiscoSensor' ) + { + $name = $data->{'ciscoTemperatureSensors'}{$object}{'description'}; + } + elsif( $objType eq 'CiscoCPU' ) + { + $name = $data->{'ciscoCpuStats'}{$object}{'cpu-nick'}; + } + return $name; +} + + +my %knownSelectorActions = + ( + 'CiscoSensor' => { + 'Monitor' => 1, + 'TokensetMember' => 1 }, + 'CiscoCPU' => { + 'TokensetMember' => 1 } + ); + + +sub applySelectorAction +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $action = shift; + my $arg = shift; + + my $data = $devdetails->data(); + my $objref; + if( $objType eq 'CiscoSensor' ) + { + $objref = $data->{'ciscoTemperatureSensors'}{$object}; + } + elsif( $objType eq 'CiscoCPU' ) + { + $objref = $data->{'ciscoCpuStats'}{$object}; + } + + if( $knownSelectorActions{$objType}{$action} ) + { + $objref->{'selectorActions'}{$action} = $arg; + } + else + { + Error('Unknown Cisco selector action: ' . $action); + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm new file mode 100644 index 000000000..6bd6d91c2 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm @@ -0,0 +1,687 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoIOS.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ +# Stanislav Sinyagin + +# Cisco IOS devices discovery +# To do: +# SA Agent MIB +# DiffServ MIB + +package Torrus::DevDiscover::CiscoIOS; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoIOS'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-SMI + 'ciscoProducts' => '1.3.6.1.4.1.9.1', + # CISCO-PRODUCTS-MIB + 'ciscoLS1010' => '1.3.6.1.4.1.9.1.107', + # CISCO-IMAGE-MIB + 'ciscoImageTable' => '1.3.6.1.4.1.9.9.25.1.1', + # CISCO-ENHANCED-IMAGE-MIB + 'ceImageTable' => '1.3.6.1.4.1.9.9.249.1.1.1', + # OLD-CISCO-MEMORY-MIB + 'bufferElFree' => '1.3.6.1.4.1.9.2.1.9.0', + # CISCO-IPSEC-FLOW-MONITOR-MIB + 'cipSecGlobalHcInOctets' => '1.3.6.1.4.1.9.9.171.1.3.1.4.0', + # CISCO-BGP4-MIB + 'cbgpPeerAddrFamilyName' => '1.3.6.1.4.1.9.9.187.1.2.3.1.3', + 'cbgpPeerAcceptedPrefixes' => '1.3.6.1.4.1.9.9.187.1.2.4.1.1', + 'cbgpPeerPrefixAdminLimit' => '1.3.6.1.4.1.9.9.187.1.2.4.1.3', + # CISCO-CAR-MIB + 'ccarConfigTable' => '1.3.6.1.4.1.9.9.113.1.1.1', + 'ccarConfigType' => '1.3.6.1.4.1.9.9.113.1.1.1.1.3', + 'ccarConfigAccIdx' => '1.3.6.1.4.1.9.9.113.1.1.1.1.4', + 'ccarConfigRate' => '1.3.6.1.4.1.9.9.113.1.1.1.1.5', + 'ccarConfigLimit' => '1.3.6.1.4.1.9.9.113.1.1.1.1.6', + 'ccarConfigExtLimit' => '1.3.6.1.4.1.9.9.113.1.1.1.1.7', + 'ccarConfigConformAction' => '1.3.6.1.4.1.9.9.113.1.1.1.1.8', + 'ccarConfigExceedAction' => '1.3.6.1.4.1.9.9.113.1.1.1.1.9', + # CISCO-VPDN-MGMT-MIB + 'cvpdnSystemTunnelTotal' => '1.3.6.1.4.1.9.10.24.1.1.4.1.2' + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::CiscoIOS::interfaceFilter +# or define $Torrus::DevDiscover::CiscoIOS::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %ciscoInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%ciscoInterfaceFilter; +} + + +# Key is some unique symbolic name, does not mean anything +# ifType is the number to match the interface type +# ifDescr is the regexp to match the interface description +%ciscoInterfaceFilter = + ( + 'Null0' => { + 'ifType' => 1, # other + 'ifDescr' => '^Null' + }, + + 'E1 N/N/N' => { + 'ifType' => 18, # ds1 + 'ifDescr' => '^E1' + }, + + 'Virtual-AccessN' => { + 'ifType' => 23, # ppp + 'ifDescr' => '^Virtual-Access' + }, + + 'DialerN' => { + 'ifType' => 23, # ppp + 'ifDescr' => '^Dialer' + }, + + 'LoopbackN' => { + 'ifType' => 24, # softwareLoopback + 'ifDescr' => '^Loopback' + }, + + 'SerialN:N-Bearer Channel' => { + 'ifType' => 81, # ds0, Digital Signal Level 0 + 'ifDescr' => '^Serial.*Bearer\s+Channel' + }, + + 'Voice Encapsulation (POTS) Peer: N' => { + 'ifType' => 103 # voiceEncap + }, + + 'Voice Over IP Peer: N' => { + 'ifType' => 104 # voiceOverIp + }, + + 'ATMN/N/N.N-atm subif' => { + 'ifType' => 134, # atmSubInterface + 'ifDescr' => '^ATM[0-9\/]+\.[0-9]+\s+subif' + }, + + 'BundleN' => { + 'ifType' => 127, # docsCableMaclayer + 'ifDescr' => '^Bundle' + }, + + 'EOBCN/N' => { + 'ifType' => 53, # propVirtual + 'ifDescr' => '^EOBC' + }, + + 'FIFON/N' => { + 'ifType' => 53, # propVirtual + 'ifDescr' => '^FIFO' + }, + ); + +our %tunnelType = + ( + # CISCO-VPDN-MGMT-MIB Tunnel Types + '1' => 'L2F', + '2' => 'L2TP', + '3' => 'PPTP' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'ciscoProducts', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + my $session = $dd->session(); + if( not $dd->checkSnmpTable('ciscoImageTable') ) + { + if( $dd->checkSnmpTable('ceImageTable') ) + { + # IOS XR has a new MIB for software image management + $devdetails->setCap('CiscoIOSXR'); + } + else + { + return 0; + } + } + + # On some Layer3 switching devices, VlanXXX interfaces give some + # useful stats, while on others the stats are not relevant at all + + if( $devdetails->param('CiscoIOS::enable-vlan-interfaces') ne 'yes' ) + { + $interfaceFilter->{'VlanN'} = { + 'ifType' => 53, # propVirtual + 'ifDescr' => '^Vlan\d+' + }; + } + + # same thing with unrouted VLAN interfaces + if( $devdetails->param('CiscoIOS::enable-unrouted-vlan-interfaces') + ne 'yes' ) + { + $interfaceFilter->{'unrouted VLAN N'} => { + 'ifType' => 53, # propVirtual + 'ifDescr' => '^unrouted\s+VLAN\s+\d+' + }; + } + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + + if( defined( $interfaceFilterOverlay ) ) + { + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilterOverlay); + } + + $devdetails->setCap('interfaceIndexingManaged'); + + return 1; +} + + +my %ccarConfigType = + ( 1 => 'all', + 2 => 'quickAcc', + 3 => 'standardAcc' ); + +my %ccarAction = + ( 1 => 'drop', + 2 => 'xmit', + 3 => 'continue', + 4 => 'precedXmit', + 5 => 'precedCont' ); + + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # Old mkroutercfg used cisco-interface-counters + if( $Torrus::DevDiscover::CiscoIOS::useCiscoInterfaceCounters ) + { + foreach my $interface ( values %{$data->{'interfaces'}} ) + { + $interface->{'hasHCOctets'} = 0; + $interface->{'hasOctets'} = 0; + push( @{$interface->{'templates'}}, + 'CiscoIOS::cisco-interface-counters' ); + } + } + else + { + # This is a well-known bug in IOS: HC counters are implemented, + # but always zero. We can catch this only for active interfaces. + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + if( $interface->{'hasHCOctets'} and + ( ( + $devdetails->snmpVar( $dd->oiddef('ifHCInOctets') + . '.' . $ifIndex ) == 0 and + $devdetails->snmpVar( $dd->oiddef('ifInOctets') + . '.' . $ifIndex ) > 0 + ) + or + ( + $devdetails->snmpVar( $dd->oiddef('ifHCOutOctets') + . '.' . $ifIndex ) == 0 and + $devdetails->snmpVar( $dd->oiddef('ifOutOctets') + . '.' . $ifIndex ) > 0 + ) ) ) + { + Debug('Disabling HC octets for ' . $ifIndex . ': ' . + $interface->{'ifDescr'}); + + $interface->{'hasHCOctets'} = 0; + $interface->{'hasHCUcastPkts'} = 0; + } + } + } + + if( $devdetails->param('CiscoIOS::enable-membuf-stats') eq 'yes' ) + { + # Old Memory Buffers, if we have bufferElFree we assume + # the rest as they are "required" + + if( $dd->checkSnmpOID('bufferElFree') ) + { + $devdetails->setCap('old-ciscoMemoryBuffers'); + push( @{$data->{'templates'}}, + 'CiscoIOS::old-cisco-memory-buffers' ); + } + } + + if( $devdetails->param('CiscoIOS::disable-ipsec-stats') ne 'yes' ) + { + if( $dd->checkSnmpOID('cipSecGlobalHcInOctets') ) + { + $devdetails->setCap('ciscoIPSecGlobalStats'); + push( @{$data->{'templates'}}, + 'CiscoIOS::cisco-ipsec-flow-globals' ); + } + + if( $dd->oidBaseMatch + ( 'ciscoLS1010', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + $data->{'param'}{'snmp-oids-per-pdu'} = 10; + } + } + + if( $devdetails->param('CiscoIOS::disable-bgp-stats') ne 'yes' ) + { + my $peerTable = + $session->get_table( -baseoid => + $dd->oiddef('cbgpPeerAcceptedPrefixes') ); + if( defined( $peerTable ) and scalar( %{$peerTable} ) > 0 ) + { + $devdetails->storeSnmpVars( $peerTable ); + $devdetails->setCap('CiscoBGP'); + + my $limitsTable = + $session->get_table( -baseoid => + $dd->oiddef('cbgpPeerPrefixAdminLimit') ); + $limitsTable = {} if not defined( $limitsTable ); + + $data->{'cbgpPeers'} = {}; + + # retrieve AS numbers for neighbor peers + Torrus::DevDiscover::RFC1657_BGP4_MIB::discover($dd, $devdetails); + + # list of indices for peers that are not IPv4 Unicast + my @nonV4Unicast; + + # Number of peers for each AS + my %asNumbers; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('cbgpPeerAcceptedPrefixes') ) ) + { + my ($a1, $a2, $a3, $a4, $afi, $safi) = split(/\./, $INDEX); + my $peerIP = join('.', $a1, $a2, $a3, $a4); + + my $peer = { + 'peerIP' => $peerIP, + 'addrFamily' => 'IPv4 Unicast' + }; + + if( $afi != 1 and $safi != 1 ) + { + push( @nonV4Unicast, $INDEX ); + } + + my $desc = + $devdetails->param('peer-ipaddr-description-' . + join('_', split('\.', $peerIP))); + if( length( $desc ) > 0 ) + { + $peer->{'description'} = $desc; + } + + my $peerAS = $data->{'bgpPeerAS'}{$peerIP}; + if( defined( $peerAS ) ) + { + $peer->{'peerAS'} = $data->{'bgpPeerAS'}{$peerIP}; + $asNumbers{$peer->{'peerAS'}}++; + + my $desc = + $devdetails->param('bgp-as-description-' . $peerAS); + if( length( $desc ) > 0 ) + { + if( defined( $peer->{'description'} ) ) + { + Warn('Conflicting descriptions for peer ' . + $peerIP); + } + $peer->{'description'} = $desc; + } + } + else + { + Error('Cannot find AS number for BGP peer ' . $peerIP); + next; + } + + if( defined( $peer->{'description'} ) ) + { + $peer->{'description'} .= ' '; + } + $peer->{'description'} .= '[' . $peerIP . ']'; + + $peer->{'prefixLimit'} = + $limitsTable->{$dd->oiddef('cbgpPeerPrefixAdminLimit') . + '.' . $INDEX}; + + $data->{'cbgpPeers'}{$INDEX} = $peer; + } + + if( scalar( @nonV4Unicast ) > 0 ) + { + my $addrFamTable = + $session->get_table + ( -baseoid => $dd->oiddef('cbgpPeerAddrFamilyName') ); + + foreach my $INDEX ( @nonV4Unicast ) + { + my $peer = $data->{'cbgpPeers'}{$INDEX}; + + my $fam = $addrFamTable->{ + $dd->oiddef('cbgpPeerAddrFamilyName') . + '.' . $INDEX}; + + $peer->{'addrFamily'} = $fam; + $peer->{'otherAddrFamily'} = 1; + $peer->{'description'} .= ' ' . $fam; + } + } + + # Construct the subtree names from AS, peer IP, and address + # family + foreach my $INDEX ( keys %{$data->{'cbgpPeers'}} ) + { + my $peer = $data->{'cbgpPeers'}{$INDEX}; + + my $subtreeName = 'AS' . $peer->{'peerAS'}; + if( $asNumbers{$peer->{'peerAS'}} > 1 ) + { + $subtreeName .= '_' . $peer->{'peerIP'}; + } + + if( $peer->{'otherAddrFamily'} ) + { + my $fam = $data->{'cbgpPeers'}{$INDEX}{'addrFamily'}; + $fam =~ s/\W/_/g; + $subtreeName .= '_' . $fam; + } + + $peer->{'subtreeName'} = $subtreeName; + } + } + } + + + if( $devdetails->param('CiscoIOS::disable-car-stats') ne 'yes' ) + { + my $carTable = + $session->get_table( -baseoid => + $dd->oiddef('ccarConfigTable') ); + if( defined( $carTable ) and scalar( %{$carTable} ) > 0 ) + { + $devdetails->storeSnmpVars( $carTable ); + $devdetails->setCap('CiscoCAR'); + + $data->{'ccar'} = {}; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('ccarConfigType') ) ) + { + my ($ifIndex, $dir, $carIndex) = split(/\./, $INDEX); + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $car = { + 'ifIndex' => $ifIndex, + 'direction' => $dir, + 'carIndex' => $carIndex }; + + $car->{'configType'} = + $ccarConfigType{ $carTable->{$dd->oiddef + ('ccarConfigType') . + '.' . $INDEX} }; + + $car->{'accIdx'} = $carTable->{$dd->oiddef + ('ccarConfigAccIdx') . + '.' . $INDEX}; + + $car->{'rate'} = $carTable->{$dd->oiddef + ('ccarConfigRate') . + '.' . $INDEX}; + + + $car->{'limit'} = $carTable->{$dd->oiddef + ('ccarConfigLimit') . + '.' . $INDEX}; + + $car->{'extLimit'} = $carTable->{$dd->oiddef + ('ccarConfigExtLimit') . + '.' . $INDEX}; + $car->{'conformAction'} = + $ccarAction{ $carTable->{$dd->oiddef + ('ccarConfigConformAction') . + '.' . $INDEX} }; + + $car->{'exceedAction'} = + $ccarAction{ $carTable->{$dd->oiddef + ('ccarConfigExceedAction') . + '.' . $INDEX} }; + + $data->{'ccar'}{$INDEX} = $car; + } + } + } + + + if( $devdetails->param('CiscoIOS::disable-vpdn-stats') ne 'yes' ) + { + if( $dd->checkSnmpTable( 'cvpdnSystemTunnelTotal' ) ) + { + # Find the Tunnel type + my $tableTun = $session->get_table( + -baseoid => $dd->oiddef('cvpdnSystemTunnelTotal') ); + + if( $tableTun ) + { + $devdetails->setCap('ciscoVPDN'); + + $devdetails->storeSnmpVars( $tableTun ); + + # VPDN indexing: 1: l2f, 2: l2tp, 3: pptp + foreach my $typeIndex ( + $devdetails->getSnmpIndices( + $dd->oiddef('cvpdnSystemTunnelTotal') ) ) + { + Debug("CISCO-VPDN-MGMT-MIB: found Tunnel type " . + $tunnelType{$typeIndex} ); + + $data->{'ciscoVPDN'}{$typeIndex} = $tunnelType{$typeIndex}; + } + } + } + } + + if( $devdetails->param('CiscoIOS::short-device-comment') eq 'yes' ) + { + # Remove serials from device comment + # 1841 chassis, Hw Serial#: 3625140487, Hw Revision: 6.0 + + $data->{'param'}{'comment'} =~ s/, Hw.*//o; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + if( $devdetails->hasCap('CiscoBGP') ) + { + my $countersNode = + $cb->addSubtree( $devNode, 'BGP_Prefixes', + { + 'node-display-name' => 'BGP Prefixes', + 'comment' => 'Accepted prefixes', + } ); + + foreach my $INDEX ( sort + { $data->{'cbgpPeers'}{$a}{'subtreeName'} <=> + $data->{'cbgpPeers'}{$b}{'subtreeName'} } + keys %{$data->{'cbgpPeers'}} ) + { + my $peer = $data->{'cbgpPeers'}{$INDEX}; + + my $param = { + 'peer-index' => $INDEX, + 'peer-ipaddr' => $peer->{'peerIP'}, + 'comment' => $peer->{'description'}, + 'descriptive-nickname' => $peer->{'subtreeName'}, + 'precedence' => 65000 - $peer->{'peerAS'} + }; + + if( defined( $peer->{'prefixLimit'} ) and + $peer->{'prefixLimit'} > 0 ) + { + $param->{'upper-limit'} = $peer->{'prefixLimit'}; + $param->{'graph-upper-limit'} = $peer->{'prefixLimit'} * 1.03; + } + + $cb->addLeaf + ( $countersNode, $peer->{'subtreeName'}, $param, + ['CiscoIOS::cisco-bgp'] ); + } + } + + + if( $devdetails->hasCap('CiscoCAR') ) + { + my $countersNode = + $cb->addSubtree( $devNode, 'CAR_Stats', { + 'comment' => 'Committed Access Rate statistics', + 'node-display-name' => 'CAR', }, + ['CiscoIOS::cisco-car-subtree']); + + foreach my $INDEX ( sort keys %{$data->{'ccar'}} ) + { + my $car = $data->{'ccar'}{$INDEX}; + my $interface = $data->{'interfaces'}{$car->{'ifIndex'}}; + + my $subtreeName = + $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + $subtreeName .= ($car->{'direction'} == 1) ? '_IN':'_OUT'; + if( $car->{'carIndex'} > 1 ) + { + $subtreeName .= '_' . $car->{'carIndex'}; + } + + my $param = { + 'searchable' => 'yes', + 'car-direction' => $car->{'direction'}, + 'car-index' => $car->{'carIndex'} }; + + $param->{'interface-name'} = + $interface->{'param'}{'interface-name'}; + $param->{'interface-nick'} = + $interface->{'param'}{'interface-nick'}; + $param->{'comment'} = + $interface->{'param'}{'comment'}; + + my $legend = sprintf("Type: %s;", $car->{'configType'}); + if( $car->{'accIdx'} > 0 ) + { + $legend .= sprintf("Access list: %d;", $car->{'accIdx'}); + } + + $legend .= + sprintf("Rate: %d bps; Limit: %d bytes; Ext limit: %d bytes;" . + "Conform action: %s; Exceed action: %s", + $car->{'rate'}, + $car->{'limit'}, + $car->{'extLimit'}, + $car->{'conformAction'}, + $car->{'exceedAction'}); + + $param->{'legend'} = $legend; + + $cb->addSubtree + ( $countersNode, + $subtreeName, + $param, + ['CiscoIOS::cisco-car']); + } + } + + + if( $devdetails->hasCap('ciscoVPDN') ) + { + my $tunnelNode = $cb->addSubtree + ( $devNode, 'VPDN_Statistics', + {'node-display-name' => 'VPDN Statistics'}, + [ 'CiscoIOS::cisco-vpdn-subtree' ] ); + + foreach my $INDEX ( sort keys %{$data->{'ciscoVPDN'}} ) + { + my $tunnelProtocol = $data->{'ciscoVPDN'}{$INDEX}; + + $cb->addSubtree( $tunnelNode, $tunnelProtocol, + { 'comment' => $tunnelProtocol . ' information', + 'tunIndex' => $INDEX, + 'tunFile' => lc($tunnelProtocol) }, + [ 'CiscoIOS::cisco-vpdn-leaf' ] ); + } + } +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm new file mode 100644 index 000000000..8118a6542 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm @@ -0,0 +1,285 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoIOS_Docsis.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $ +# Stanislav Sinyagin + +# DOCSIS interface, Cisco specific + +package Torrus::DevDiscover::CiscoIOS_Docsis; + +use strict; +use Torrus::Log; + +# Sequence number is 600 - we depend on RFC2670_DOCS_IF and CiscoIOS + +$Torrus::DevDiscover::registry{'CiscoIOS_Docsis'} = { + 'sequence' => 600, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisMacModemsMonitor'} = 'CiscoIOS_Docsis'; + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpUtilMonitor'} = 'CiscoIOS_Docsis'; +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpSlotsMonitor'} = 'CiscoIOS_Docsis'; + + +our %oiddef = + ( + # CISCO-DOCS-EXT-MIB:cdxIfUpstreamChannelExtTable + 'cdxIfUpChannelMaxUGSLastFiveMins' => '1.3.6.1.4.1.9.9.116.1.4.1.1.14' + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( $devdetails->isDevType('CiscoIOS') and + $devdetails->isDevType('RFC2670_DOCS_IF') ) + { + return 1; + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + if( $dd->checkSnmpTable( 'cdxIfUpChannelMaxUGSLastFiveMins' ) ) + { + $devdetails->setCap('cdxIfUpChannelMaxUGSLastFiveMins'); + } + + push( @{$data->{'docsConfig'}{'docsCableMaclayer'}{'templates'}}, + 'CiscoIOS_Docsis::cisco-docsis-mac-subtree' ); + + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'CiscoIOS_Docsis::cisco-docsis-mac-util' ); + } + + foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'CiscoIOS_Docsis::cisco-docsis-upstream-util' ); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + if( $devdetails->hasCap('cdxIfUpChannelMaxUGSLastFiveMins') ) + { + $cb->setVar( $devNode, 'CiscoIOS_Docsis::ugs-supported', 'true' ); + } + + if( scalar( @{$data->{'docsCableMaclayer'}} ) > 0 ) + { + # Build All_Modems summary graph + my $param = { + 'ds-type' => 'rrd-multigraph', + 'ds-names' => 'total,active,registered', + 'graph-lower-limit' => '0', + 'precedence' => '1000', + 'comment' => + 'Registered, Active and Total modems on CMTS', + + 'vertical-label' => 'Modems', + + 'graph-legend-total' => 'Total', + 'line-style-total' => '##totalresource', + 'line-color-total' => '##totalresource', + 'line-order-total' => '1', + + 'graph-legend-active' => 'Active', + 'line-style-active' => '##resourcepartusage', + 'line-color-active' => '##resourcepartusage', + 'line-order-active' => '2', + + 'graph-legend-registered' => 'Registered', + 'line-style-registered' => '##resourceusage', + 'line-color-registered' => '##resourceusage', + 'line-order-registered' => '3', + 'descriptive-nickname' => '%system-id%: All modems' + }; + + my $first = 1; + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + if( $first ) + { + $param->{'ds-expr-total'} = + '{' . $intf . '/Modems_Total}'; + $param->{'ds-expr-active'} = + '{' . $intf . '/Modems_Active}'; + $param->{'ds-expr-registered'} = + '{' . $intf . '/Modems_Registered}'; + $first = 0; + } + else + { + $param->{'ds-expr-total'} .= + ',{' . $intf . '/Modems_Total},+'; + $param->{'ds-expr-active'} .= + ',{' . $intf . '/Modems_Active},+'; + $param->{'ds-expr-registered'} .= + ',{' . $intf . '/Modems_Registered},+'; + } + } + + my $macNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{ + 'docsCableMaclayer'}{ + 'subtreeName'} ); + if( defined( $macNode ) ) + { + $cb->addLeaf( $macNode, 'All_Modems', $param, [] ); + } + else + { + Error('Could not find the MAC layer subtree'); + exit 1; + } + + # Apply selector actions + foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $monitor = + $interface->{'selectorActions'}{'DocsisMacModemsMonitor'}; + if( defined( $monitor ) ) + { + my $intfNode = $cb->getChildSubtree( $macNode, $intf ); + $cb->addLeaf( $intfNode, 'Modems_Registered', + {'monitor' => $monitor } ); + } + } + } + + if( scalar( @{$data->{'docsCableUpstream'}} ) > 0 ) + { + my $upstrNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{'docsCableUpstream'}{ + 'subtreeName'} ); + + foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $monitor = + $interface->{'selectorActions'}{'DocsisUpUtilMonitor'}; + if( defined( $monitor ) ) + { + my $intfNode = $cb->getChildSubtree( $upstrNode, $intf ); + $cb->addLeaf( $intfNode, 'Util', + {'monitor' => $monitor } ); + } + + $monitor = + $interface->{'selectorActions'}{'DocsisUpSlotsMonitor'}; + if( defined( $monitor ) ) + { + my $intfNode = $cb->getChildSubtree( $upstrNode, $intf ); + $cb->addLeaf( $intfNode, 'ContSlots', + {'monitor' => $monitor } ); + } + } + + # Override the overview shortcus defined in rfc2670.docsis-if.xml + + my $shortcuts = 'snr,fec,freq,modems,util'; + if( $devdetails->hasCap('cdxIfUpChannelMaxUGSLastFiveMins') ) + { + $shortcuts .= ',ugs'; + } + + my $param = { + 'overview-shortcuts' => + $shortcuts, + + 'overview-subleave-name-modems' => 'Modems', + 'overview-direct-link-modems' => 'yes', + 'overview-direct-link-view-modems' => 'expanded-dir-html', + 'overview-shortcut-text-modems' => 'All modems', + 'overview-shortcut-title-modems'=> + 'Show modem quantities in one page', + 'overview-page-title-modems' => 'Modem quantities', + + 'overview-subleave-name-util' => 'Util_Summary', + 'overview-direct-link-util' => 'yes', + 'overview-direct-link-view-util' => 'expanded-dir-html', + 'overview-shortcut-text-util' => 'All utilization', + 'overview-shortcut-title-util' => 'All upstream utilization', + 'overview-page-title-util' => 'Upstream utilization', + + 'overview-subleave-name-ugs' => 'Active_UGS', + 'overview-direct-link-ugs' => 'yes', + 'overview-direct-link-view-ugs' => 'expanded-dir-html', + 'overview-shortcut-text-ugs' => 'All UGS', + 'overview-shortcut-title-ugs' => 'Show all UGS in one page', + 'overview-page-title-ugs' => 'UGS Statistics' + }; + + $cb->addParams( $upstrNode, $param ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm new file mode 100644 index 000000000..841a5755c --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm @@ -0,0 +1,388 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoIOS_MacAccounting.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $ +# Stanislav Sinyagin + +# Cisco IOS MAC accounting + +package Torrus::DevDiscover::CiscoIOS_MacAccounting; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoIOS_MacAccounting'} = { + 'sequence' => 510, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-IP-STAT-MIB + 'cipMacHCSwitchedBytes' => '1.3.6.1.4.1.9.9.84.1.2.3.1.2', + + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + + if( $devdetails->isDevType('CiscoIOS') and + $dd->checkSnmpTable('cipMacHCSwitchedBytes') ) + { + return 1; + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $table = $session->get_table( -baseoid => + $dd->oiddef('cipMacHCSwitchedBytes')); + + if( not defined( $table ) or scalar( %{$table} ) == 0 ) + { + return 0; + } + $devdetails->storeSnmpVars( $table ); + + # External storage serviceid assignment + my $extSrv = + $devdetails->param('CiscoIOS_MacAccounting::external-serviceid'); + if( defined( $extSrv ) and length( $extSrv ) > 0 ) + { + my $extStorage = {}; + my $extStorageTrees = {}; + + foreach my $srvDef ( split( /\s*,\s*/, $extSrv ) ) + { + my ( $serviceid, $peerName, $direction, $trees ) = + split( /\s*:\s*/, $srvDef ); + + if( defined( $trees ) ) + { + # Trees are listed with '|' as separator, + # whereas compiler expects commas + + $trees =~ s/\s*\|\s*/,/g; + } + + if( $direction eq 'Both' ) + { + $extStorage->{$peerName}{'In'} = $serviceid . '_IN'; + $extStorageTrees->{$serviceid . '_IN'} = $trees; + + $extStorage->{$peerName}{'Out'} = $serviceid . '_OUT'; + $extStorageTrees->{$serviceid . '_OUT'} = $trees; + } + else + { + $extStorage->{$peerName}{$direction} = $serviceid; + $extStorageTrees->{$serviceid} = $trees; + } + } + $data->{'cipMacExtStorage'} = $extStorage; + $data->{'cipMacExtStoragetrees'} = $extStorageTrees; + } + + + # tokenset members + # Format: tokenset:ASXXXX,ASXXXX; tokenset:ASXXXX,ASXXXX; + # Peer MAC or IP addresses could be used too + my $tsetMembership = + $devdetails->param('CiscoIOS_MacAccounting::tokenset-members'); + if( defined( $tsetMembership ) and length( $tsetMembership ) > 0 ) + { + my $tsetMember = {}; + foreach my $memList ( split( /\s*;\s*/, $tsetMembership ) ) + { + my ($tset, $list) = split( /\s*:\s*/, $memList ); + foreach my $peerName ( split( /\s*,\s*/, $list ) ) + { + $tsetMember->{$peerName}{$tset} = 1; + } + } + $data->{'cipTokensetMember'} = $tsetMember; + } + + Torrus::DevDiscover::RFC2011_IP_MIB::discover($dd, $devdetails); + Torrus::DevDiscover::RFC1657_BGP4_MIB::discover($dd, $devdetails); + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('cipMacHCSwitchedBytes') ) ) + { + my( $ifIndex, $direction, @phyAddrOctets ) = split( '\.', $INDEX ); + + my $interface = $data->{'interfaces'}{$ifIndex}; + next if not defined( $interface ); + + my $phyAddr = '0x'; + my $macAddrString = ''; + foreach my $byte ( @phyAddrOctets ) + { + $phyAddr .= sprintf('%.2x', $byte); + if( length( $macAddrString ) > 0 ) + { + $macAddrString .= ':'; + } + $macAddrString .= sprintf('%.2x', $byte); + } + + next if ( $phyAddr eq '0xffffffffffff' ); + + my $peerIP = $interface->{'mediaToIpNet'}{$phyAddr}; + if( not defined( $peerIP ) ) + { + # Try in the global table, as the ARP is stored per subinterface, + # and MAC accounting is on main interface + $peerIP = $data->{'mediaToIpNet'}{$phyAddr}; + } + + if( not defined( $peerIP ) ) + { + # high logging level, because who cares about staled entries? + Debug('Cannot determine IP address for MAC accounting ' . + 'entry: ' . $macAddrString); + next; + } + + # There should be two entries per IP: in and out. + if( defined( $data->{'cipMac'}{$ifIndex . ':' . $phyAddr} ) ) + { + $data->{'cipMac'}{$ifIndex . ':' . $phyAddr}{'nEntries'}++; + next; + } + + my $peer = { + 'peerIP' => $peerIP, + 'phyAddr' => $phyAddr, + 'macAddrString' => $macAddrString, + 'ifIndex' => $ifIndex, + 'nEntries' => 1 + }; + + $peer->{'macAddrOID'} = join('.', @phyAddrOctets); + + $peer->{'ifReferenceName'} = + $interface->{$data->{'nameref'}{'ifReferenceName'}}; + $peer->{'ifNick'} = + $interface->{$data->{'nameref'}{'ifNick'}}; + + my $desc = + $devdetails->param('peer-ipaddr-description-' . + join('_', split('\.', $peerIP))); + if( length( $desc ) > 0 ) + { + $peer->{'description'} = $desc; + } + + if( $devdetails->hasCap('bgpPeerTable') ) + { + my $peerAS = $data->{'bgpPeerAS'}{$peerIP}; + if( defined( $peerAS ) ) + { + $peer->{'peerAS'} = $data->{'bgpPeerAS'}{$peerIP}; + + my $desc = + $devdetails->param('bgp-as-description-' . $peerAS); + if( length( $desc ) > 0 ) + { + if( defined( $peer->{'description'} ) ) + { + Warn('Conflicting descriptions for peer ' . + $peerIP); + } + $peer->{'description'} = $desc; + } + } + elsif( $devdetails-> + param('CiscoIOS_MacAccounting::bgponly') eq 'yes' ) + { + next; + } + } + + if( defined( $peer->{'description'} ) ) + { + $peer->{'description'} .= ' '; + } + $peer->{'description'} .= '[' . $peerIP . ']'; + + $data->{'cipMac'}{$ifIndex . ':' . $phyAddr} = $peer; + } + + my %asNumbers; + foreach my $INDEX ( keys %{$data->{'cipMac'}} ) + { + my $peer = $data->{'cipMac'}{$INDEX}; + + if( $peer->{'nEntries'} != 2 ) + { + delete $data->{'cipMac'}{$INDEX}; + } + else + { + if( defined( $peer->{'peerAS'} ) ) + { + $asNumbers{$peer->{'peerAS'}}++; + } + } + } + + foreach my $INDEX ( keys %{$data->{'cipMac'}} ) + { + my $peer = $data->{'cipMac'}{$INDEX}; + + my $subtreeName = $peer->{'peerIP'}; + my $asNum = $peer->{'peerAS'}; + if( defined( $asNum ) ) + { + $subtreeName = 'AS' . $asNum; + if( $asNumbers{$asNum} > 1 ) + { + $subtreeName .= '_' . $peer->{'peerIP'}; + } + } + $peer->{'subtreeName'} = $subtreeName; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + my $countersNode = + $cb->addSubtree( $devNode, 'MAC_Accounting', + {'node-display-name' => 'MAC Accounting'}, + ['CiscoIOS_MacAccounting::cisco-macacc-subtree']); + + foreach my $INDEX ( sort { $data->{'cipMac'}{$a}{'subtreeName'} <=> + $data->{'cipMac'}{$b}{'subtreeName'} } + keys %{$data->{'cipMac'}} ) + { + my $peer = $data->{'cipMac'}{$INDEX}; + + my $param = { + 'peer-macaddr' => $peer->{'phyAddr'}, + 'peer-macoid' => $peer->{'macAddrOID'}, + 'peer-ipaddr' => $peer->{'peerIP'}, + 'interface-name' => $peer->{'ifReferenceName'}, + 'interface-nick' => $peer->{'ifNick'}, + 'comment' => $peer->{'description'}, + 'descriptive-nickname' => $peer->{'subtreeName'}, + 'precedence' => 65000 - $peer->{'peerAS'}, + 'searchable' => 'yes' + }; + + my $peerNode = $cb->addSubtree + ( $countersNode, $peer->{'subtreeName'}, $param, + ['CiscoIOS_MacAccounting::cisco-macacc'] ); + + if( defined( $data->{'cipMacExtStorage'} ) or + defined( $data->{'cipTokensetMember'} ) ) + { + my $extStorageApplied = 0; + my $tsetMemberApplied = 0; + + foreach my $peerName ( 'AS'.$peer->{'peerAS'}, $peer->{'peerIP'}, + $peer->{'phyAddr'} ) + { + if( defined( $peerName ) ) + { + if( not $extStorageApplied and + defined( $data->{'cipMacExtStorage'}{$peerName} ) ) + { + my $extStorage = + $data->{'cipMacExtStorage'}{$peerName}; + foreach my $dir ( 'In', 'Out' ) + { + if( defined( $extStorage->{$dir} ) ) + { + my $serviceid = $extStorage->{$dir}; + + my $params = { + 'storage-type' => 'rrd,ext', + 'ext-service-units' => 'bytes', + 'ext-service-id' => $serviceid }; + + if( defined( $data->{'cipMacExtStoragetrees'}{ + $serviceid}) and + length( $data->{'cipMacExtStoragetrees'}{ + $serviceid}) > 0 ) + { + $params->{'ext-service-trees'} = + $data->{'cipMacExtStoragetrees'}{ + $serviceid}; + } + + $cb->addLeaf + ( $peerNode, 'Bytes_' . $dir, + $params ); + } + } + $extStorageApplied = 1; + } + + if( not $tsetMemberApplied and + defined( $data->{'cipTokensetMember'}{$peerName} ) ) + { + my $tsetList = + join( ',', sort keys + %{$data->{'cipTokensetMember'}{$peerName}} ); + + $cb->addLeaf + ( $peerNode, 'InOut_bps', + { 'tokenset-member' => $tsetList } ); + } + } + } + } + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm new file mode 100644 index 000000000..6d136a93e --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm @@ -0,0 +1,382 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoIOS_SAA.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $ +# Stanislav Sinyagin + +# Cisco IOS Service Assurance Agent +# TODO: +# should really consider rtt-type and rtt-echo-protocol when applying +# per-rtt templates +# +# translate TOS bits into DSCP values + +package Torrus::DevDiscover::CiscoIOS_SAA; + +use strict; +use Socket qw(inet_ntoa); + +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoIOS_SAA'} = { + 'sequence' => 510, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-RTTMON-MIB + 'rttMonCtrlAdminTable' => '1.3.6.1.4.1.9.9.42.1.2.1', + 'rttMonCtrlAdminOwner' => '1.3.6.1.4.1.9.9.42.1.2.1.1.2', + 'rttMonCtrlAdminTag' => '1.3.6.1.4.1.9.9.42.1.2.1.1.3', + 'rttMonCtrlAdminRttType' => '1.3.6.1.4.1.9.9.42.1.2.1.1.4', + 'rttMonCtrlAdminFrequency' => '1.3.6.1.4.1.9.9.42.1.2.1.1.6', + 'rttMonCtrlAdminStatus' => '1.3.6.1.4.1.9.9.42.1.2.1.1.9', + 'rttMonEchoAdminTable' => '1.3.6.1.4.1.9.9.42.1.2.2', + 'rttMonEchoAdminProtocol' => '1.3.6.1.4.1.9.9.42.1.2.2.1.1', + 'rttMonEchoAdminTargetAddress' => '1.3.6.1.4.1.9.9.42.1.2.2.1.2', + 'rttMonEchoAdminPktDataRequestSize' => '1.3.6.1.4.1.9.9.42.1.2.2.1.3', + 'rttMonEchoAdminTargetPort' => '1.3.6.1.4.1.9.9.42.1.2.2.1.5', + 'rttMonEchoAdminTOS' => '1.3.6.1.4.1.9.9.42.1.2.2.1.9', + 'rttMonEchoAdminTargetAddressString' => '1.3.6.1.4.1.9.9.42.1.2.2.1.11', + 'rttMonEchoAdminNameServer' => '1.3.6.1.4.1.9.9.42.1.2.2.1.12', + 'rttMonEchoAdminURL' => '1.3.6.1.4.1.9.9.42.1.2.2.1.15', + 'rttMonEchoAdminInterval' => '1.3.6.1.4.1.9.9.42.1.2.2.1.17', + 'rttMonEchoAdminNumPackets' => '1.3.6.1.4.1.9.9.42.1.2.2.1.18' + ); + + + +our %adminInterpret = + ( + 'rttMonCtrlAdminOwner' => { + 'order' => 10, + 'legend' => 'Owner: %s;', + 'param' => 'rtt-owner' + }, + + 'rttMonCtrlAdminTag' => { + 'order' => 20, + 'legend' => 'Tag: %s;', + 'comment' => '%s: ', + 'param' => 'rtt-tag' + }, + + 'rttMonCtrlAdminRttType' => { + 'order' => 30, + 'legend' => 'Type: %s;', + 'translate' => \&translateRttType, + 'param' => 'rtt-type' + }, + + 'rttMonCtrlAdminFrequency' => { + 'order' => 40, + 'legend' => 'Frequency: %d seconds;', + 'param' => 'rtt-frequency' + }, + + 'rttMonEchoAdminProtocol' => { + 'order' => 50, + 'legend' => 'Protocol: %s;', + 'translate' => \&translateRttEchoProtocol, + 'param' => 'rtt-echo-protocol' + }, + + 'rttMonEchoAdminTargetAddress' => { + 'order' => 60, + 'legend' => 'Target: %s;', + 'comment' => 'Target=%s ', + 'translate' => \&translateRttTargetAddr, + 'param' => 'rtt-echo-target-addr', + 'ignore-text' => '0.0.0.0' + }, + + 'rttMonEchoAdminPktDataRequestSize' => { + 'order' => 70, + 'legend' => 'Packet size: %d octets;', + 'param' => 'rtt-echo-request-size' + }, + + 'rttMonEchoAdminTargetPort' => { + 'order' => 80, + 'legend' => 'Port: %d;', + 'param' => 'rtt-echo-port', + 'ignore-numeric' => 0 + }, + + 'rttMonEchoAdminTOS' => { + 'order' => 90, + 'legend' => 'TOS: %d;', + 'comment' => 'TOS=%d ', + 'param' => 'rtt-echo-tos', + 'ignore-numeric' => 0 + }, + + 'rttMonEchoAdminTargetAddressString' => { + 'order' => 100, + 'legend' => 'Address string: %s;', + 'param' => 'rtt-echo-addr-string' + }, + + 'rttMonEchoAdminNameServer' => { + 'order' => 110, + 'legend' => 'NameServer: %s;', + 'translate' => \&translateRttTargetAddr, + 'param' => 'rtt-echo-name-server', + 'ignore-text' => '0.0.0.0' + }, + + 'rttMonEchoAdminURL' => { + 'order' => 120, + 'legend' => 'URL: %s;', + 'param' => 'rtt-echo-url' + }, + + 'rttMonEchoAdminInterval' => { + 'order' => 130, + 'legend' => 'Interval: %d milliseconds;', + 'param' => 'rtt-echo-interval', + 'ignore-numeric' => 0 + }, + + 'rttMonEchoAdminNumPackets' => { + 'order' => 140, + 'legend' => 'Packets: %d;', + 'param' => 'rtt-echo-num-packets', + 'ignore-numeric' => 0 + } + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + + if( $devdetails->isDevType('CiscoIOS') ) + { + my $rttAdminTable = + $session->get_table( -baseoid => + $dd->oiddef('rttMonCtrlAdminTable') ); + if( defined $rttAdminTable and scalar( %{$rttAdminTable} ) > 0 ) + { + $devdetails->storeSnmpVars( $rttAdminTable ); + return 1; + } + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $rttEchoAdminTable = + $session->get_table( -baseoid => + $dd->oiddef('rttMonEchoAdminTable') ); + if( defined $rttEchoAdminTable ) + { + $devdetails->storeSnmpVars( $rttEchoAdminTable ); + undef $rttEchoAdminTable; + } + + $data->{'rtt_entries'} = {}; + + foreach my $rttIndex + ( $devdetails->getSnmpIndices( $dd->oiddef('rttMonCtrlAdminOwner') ) ) + { + # we're interested in Active agents only + if( $devdetails->snmpVar($dd->oiddef('rttMonCtrlAdminStatus') . + '.' . $rttIndex) != 1 ) + { + next; + } + + my $ref = {}; + $data->{'rtt_entries'}{$rttIndex} = $ref; + $ref->{'param'} = {}; + + my $comment = ''; + my $legend = ''; + + foreach my $adminField + ( sort {$adminInterpret{$a}{'order'} <=> + $adminInterpret{$b}{'order'}} + keys %adminInterpret ) + { + my $value = $devdetails->snmpVar( $dd->oiddef( $adminField ) . + '.' . $rttIndex ); + if( defined( $value ) and length( $value ) > 0 ) + { + my $intrp = $adminInterpret{$adminField}; + if( ref( $intrp->{'translate'} ) ) + { + $value = &{$intrp->{'translate'}}( $value ); + } + + if( ( defined( $intrp->{'ignore-numeric'} ) and + $value == $intrp->{'ignore-numeric'} ) + or + ( defined( $intrp->{'ignore-text'} ) and + $value eq $intrp->{'ignore-text'} ) ) + { + next; + } + + if( defined( $intrp->{'param'} ) ) + { + $ref->{'param'}{$intrp->{'param'}} = $value; + } + + if( defined( $intrp->{'comment'} ) ) + { + $comment .= sprintf( $intrp->{'comment'}, $value ); + } + + if( defined( $intrp->{'legend'} ) ) + { + $legend .= sprintf( $intrp->{'legend'}, $value ); + } + } + } + + $ref->{'param'}{'rtt-index'} = $rttIndex; + $ref->{'param'}{'comment'} = $comment; + $ref->{'param'}{'legend'} = $legend; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + my $subtreeNode = + $cb->addSubtree( $devNode, 'SAA', undef, + ['CiscoIOS_SAA::cisco-saa-subtree']); + + foreach my $rttIndex ( sort {$a<=>$b} keys %{$data->{'rtt_entries'}} ) + { + my $subtreeName = 'rtt_' . $rttIndex; + my $param = $data->{'rtt_entries'}{$rttIndex}{'param'}; + $param->{'precedence'} = sprintf('%d', 10000 - $rttIndex); + + # TODO: should really consider rtt-type and rtt-echo-protocol + + $cb->addSubtree( $subtreeNode, $subtreeName, $param, + ['CiscoIOS_SAA::cisco-rtt-echo-subtree']); + } +} + + +our %rttType = + ( + '1' => 'echo', + '2' => 'pathEcho', + '3' => 'fileIO', + '4' => 'script', + '5' => 'udpEcho', + '6' => 'tcpConnect', + '7' => 'http', + '8' => 'dns', + '9' => 'jitter', + '10' => 'dlsw', + '11' => 'dhcp', + '12' => 'ftp' + ); + +sub translateRttType +{ + my $value = shift; + return $rttType{$value}; +} + + +our %rttEchoProtocol = + ( + '1' => 'notApplicable', + '2' => 'ipIcmpEcho', + '3' => 'ipUdpEchoAppl', + '4' => 'snaRUEcho', + '5' => 'snaLU0EchoAppl', + '6' => 'snaLU2EchoAppl', + '7' => 'snaLU62Echo', + '8' => 'snaLU62EchoAppl', + '9' => 'appleTalkEcho', + '10' => 'appleTalkEchoAppl', + '11' => 'decNetEcho', + '12' => 'decNetEchoAppl', + '13' => 'ipxEcho', + '14' => 'ipxEchoAppl', + '15' => 'isoClnsEcho', + '16' => 'isoClnsEchoAppl', + '17' => 'vinesEcho', + '18' => 'vinesEchoAppl', + '19' => 'xnsEcho', + '20' => 'xnsEchoAppl', + '21' => 'apolloEcho', + '22' => 'apolloEchoAppl', + '23' => 'netbiosEchoAppl', + '24' => 'ipTcpConn', + '25' => 'httpAppl', + '26' => 'dnsAppl', + '27' => 'jitterAppl', + '28' => 'dlswAppl', + '29' => 'dhcpAppl', + '30' => 'ftpAppl' + ); + +sub translateRttEchoProtocol +{ + my $value = shift; + return $rttEchoProtocol{$value}; +} + +sub translateRttTargetAddr +{ + my $value = shift; + $value =~ s/^0x//; + return inet_ntoa( pack( 'H8', $value ) ); +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm b/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm new file mode 100644 index 000000000..e9d200347 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm @@ -0,0 +1,418 @@ +# +# Discovery module for Cisco Service Control Engine (formely PCube) +# +# Copyright (C) 2007 Jon Nistor +# Copyright (C) 2007 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoSCE.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $ +# Jon Nistor +# +# NOTE: Options for this module +# CiscoSCE::disable-disk +# CiscoSCE::disable-gc +# CiscoSCE::disable-qos +# CiscoSCE::disable-rdr +# CiscoSCE::disable-subs +# CiscoSCE::disable-tp +# + +# Cisco SCE devices discovery +package Torrus::DevDiscover::CiscoSCE; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoSCE'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig +}; + +# pmodule-dependend OIDs are presented for module #1 only. +# currently devices with more than one module do not exist + +our %oiddef = + ( + # PCUBE-SE-MIB + 'pcubeProducts' => '1.3.6.1.4.1.5655.1', + 'pchassisSysType' => '1.3.6.1.4.1.5655.4.1.2.1.0', + 'pchassisNumSlots' => '1.3.6.1.4.1.5655.4.1.2.6.0', + 'pmoduleType' => '1.3.6.1.4.1.5655.4.1.3.1.1.2.1', + 'pmoduleNumLinks' => '1.3.6.1.4.1.5655.4.1.3.1.1.7.1', + 'pmoduleSerialNumber' => '1.3.6.1.4.1.5655.4.1.3.1.1.9.1', + 'pmoduleNumTrafficProcessors' => '1.3.6.1.4.1.5655.4.1.3.1.1.3.1', + 'rdrFormatterEnable' => '1.3.6.1.4.1.5655.4.1.6.1.0', + 'rdrFormatterCategoryName' => '1.3.6.1.4.1.5655.4.1.6.11.1.2', + 'subscribersNumIpAddrMappings' => '1.3.6.1.4.1.5655.4.1.8.1.1.3.1', + 'subscribersNumIpRangeMappings' => '1.3.6.1.4.1.5655.4.1.8.1.1.5.1', + 'subscribersNumVlanMappings' => '1.3.6.1.4.1.5655.4.1.8.1.1.7.1', + 'subscribersNumAnonymous' => '1.3.6.1.4.1.5655.4.1.8.1.1.16.1', + 'pportNumTxQueues' => '1.3.6.1.4.1.5655.4.1.10.1.1.4.1', + 'pportIfIndex' => '1.3.6.1.4.1.5655.4.1.10.1.1.5.1', + 'txQueuesDescription' => '1.3.6.1.4.1.5655.4.1.11.1.1.4.1', + + # CISCO-SCAS-BB-MIB (PCUBE-ENGAGE-MIB) + 'globalScopeServiceCounterName' => '1.3.6.1.4.1.5655.4.2.5.1.1.3.1', + + ); + +our %sceChassisNames = + ( + '1' => 'unknown', + '2' => 'SE 1000', + '3' => 'SE 100', + '4' => 'SE 2000', + ); + +our %sceModuleDesc = + ( + '1' => 'unknown', + '2' => '2xGBE + 1xFE Mgmt', + '3' => '2xFE + 1xFE Mgmt', + '4' => '4xGBE + 1 or 2 FastE Mgmt', + '5' => '4xFE + 1xFE Mgmt', + '6' => '4xOC-12 + 1 or 2 FastE Mgmt', + '7' => '16xFE + 2xGBE, 2 FastE Mgmt', + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'pcubeProducts', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + my $result = $dd->retrieveSnmpOIDs('pchassisNumSlots'); + if( $result->{'pchassisNumSlots'} > 1 ) + { + Error('This SCE device has more than one module on the chassis.' . + 'The current version of DevDiscover does not support such ' . + 'devices'); + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # Get the system info and display it in the comment + my $sceInfo = $dd->retrieveSnmpOIDs + ( 'pchassisSysType', 'pmoduleType', 'pmoduleNumLinks', + 'pmoduleSerialNumber', 'pmoduleNumTrafficProcessors', + 'rdrFormatterEnable', + 'subscribersNumIpAddrMappings', 'subscribersNumIpRangeMappings', + 'subscribersNumVlanMappings', 'subscribersNumAnonymous' ); + + $data->{'sceInfo'} = $sceInfo; + + $data->{'param'}{'comment'} = + $sceChassisNames{$sceInfo->{'pchassisSysType'}} . + " chassis, " . $sceModuleDesc{$sceInfo->{'pmoduleType'}} . + ", Hw Serial#: " . $sceInfo->{'pmoduleSerialNumber'}; + + # TP: Traffic Processor + if( $devdetails->param('CiscoSCE::disable-tp') ne 'yes' ) + { + $devdetails->setCap('sceTP'); + + $data->{'sceTrafficProcessors'} = + $sceInfo->{'pmoduleNumTrafficProcessors'}; + } + + # HDD: Disk Usage + if( $devdetails->param('CiscoSCE::disable-disk') ne 'yes' ) + { + $devdetails->setCap('sceDisk'); + } + + # SUBS: subscriber aware configuration + if( $devdetails->param('CiscoSCE::disable-subs') ne 'yes' ) + { + if( $sceInfo->{'subscribersNumIpAddrMappings'} > 0 or + $sceInfo->{'subscribersNumIpRangeMappings'} > 0 or + $sceInfo->{'subscribersNumVlanMappings'} > 0 or + $sceInfo->{'subscribersNumAnonymous'} > 0 ) + { + $devdetails->setCap('sceSubscribers'); + } + } + + + # QOS: TX Queues Names + if( $devdetails->param('CiscoSCE::disable-qos') ne 'yes' ) + { + $devdetails->setCap('sceQos'); + + # Get the names of TX queues + my $txQueueNum = $session->get_table + ( -baseoid => $dd->oiddef('pportNumTxQueues') ); + $devdetails->storeSnmpVars( $txQueueNum ); + + my $ifIndexTable = $session->get_table + ( -baseoid => $dd->oiddef('pportIfIndex') ); + + my $txQueueDesc = $session->get_table + ( -baseoid => $dd->oiddef('txQueuesDescription') ); + + $devdetails->storeSnmpVars( $txQueueDesc ); + + foreach my $pIndex + ( $devdetails->getSnmpIndices( $dd->oiddef('pportNumTxQueues') ) ) + { + # We take ports with more than one queue and add queueing + # statistics to interface counters + if( $txQueueNum->{$dd->oiddef('pportNumTxQueues') . + '.' . $pIndex} > 1 ) + { + # We need the ifIndex to retrieve the interface name + + my $ifIndex = + $ifIndexTable->{$dd->oiddef('pportIfIndex') . '.' + . $pIndex}; + + $data->{'scePortIfIndex'}{$pIndex} = $ifIndex; + + foreach my $qIndex + ( $devdetails->getSnmpIndices + ( $dd->oiddef('txQueuesDescription') . '.' . $pIndex ) ) + { + my $oid = $dd->oiddef('txQueuesDescription') . '.' . + $pIndex . '.' . $qIndex; + + $data->{'sceQueues'}{$pIndex}{$qIndex} = + $txQueueDesc->{$oid}; + } + } + } + } + + + # GC: Global Service Counters + if( $devdetails->param('CiscoSCE::disable-gc') ne 'yes' ) + { + # Set the Capability for the Global Counters + $devdetails->setCap('sceGlobalCounters'); + + my $counterNames = $session->get_table + ( -baseoid => $dd->oiddef('globalScopeServiceCounterName') ); + + $devdetails->storeSnmpVars( $counterNames ); + + foreach my $gcIndex + ( $devdetails->getSnmpIndices + ( $dd->oiddef('globalScopeServiceCounterName') ) ) + { + my $oid = + $dd->oiddef('globalScopeServiceCounterName') . '.' . $gcIndex; + if( length( $counterNames->{$oid} ) > 0 ) + { + $data->{'sceGlobalCounters'}{$gcIndex} = $counterNames->{$oid}; + } + } + } + + + # RDR: Raw Data Record + if( $devdetails->param('CiscoSCE::disable-rdr') ne 'yes' ) + { + if( $sceInfo->{'rdrFormatterEnable'} > 0 ) + { + # Set Capability for the RDR section of XML + $devdetails->setCap('sceRDR'); + + # Get the names of the RDR Category + my $categoryNames = $session->get_table + ( -baseoid => $dd->oiddef('rdrFormatterCategoryName') ); + + $devdetails->storeSnmpVars( $categoryNames ); + + foreach my $categoryIndex + ( $devdetails->getSnmpIndices + ( $dd->oiddef('rdrFormatterCategoryName') ) ) + { + my $oid = $dd->oiddef('rdrFormatterCategoryName') . '.' + . $categoryIndex; + $data->{'sceRDR'}{$categoryIndex} = $categoryNames->{$oid}; + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + # Disk Usage information + if( $devdetails->hasCap('sceDisk') ) + { + $cb->addTemplateApplication($devNode, 'CiscoSCE::cisco-sce-disk'); + } + + if( $devdetails->hasCap('sceSubscribers') ) + { + $cb->addTemplateApplication($devNode, + 'CiscoSCE::cisco-sce-subscribers'); + } + + # Traffic processors subtree + if( $devdetails->hasCap('sceTP') ) + { + my $tpNode = $cb->addSubtree( $devNode, 'SCE_TrafficProcessors', + { 'comment' => 'TP usage statistics' }, + [ 'CiscoSCE::cisco-sce-tp-subtree']); + + foreach my $tp ( 1 .. $data->{'sceTrafficProcessors'} ) + { + $cb->addSubtree( $tpNode, sprintf('TP_%d', $tp), + { 'sce-tp-index' => $tp }, + ['CiscoSCE::cisco-sce-tp'] ); + } + } + + + # QoS queues + if( $devdetails->hasCap('sceQos') ) + { + # Queues subtree + my $qNode = + $cb->addSubtree( $devNode, 'SCE_Queues', + { 'comment' => 'TX queues usage statistics' }, + [ 'CiscoSCE::cisco-sce-queues-subtree']); + + foreach my $pIndex ( sort {$a <=> $b} + keys %{$data->{'scePortIfIndex'}} ) + { + my $ifIndex = $data->{'scePortIfIndex'}{$pIndex}; + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $portNode = + $cb->addSubtree + ( $qNode, + $interface->{$data->{'nameref'}{'ifSubtreeName'}}, + { 'sce-port-index' => $pIndex, + 'precedence' => 1000 - $pIndex }); + + foreach my $qIndex ( sort {$a <=> $b} keys + %{$data->{'sceQueues'}{$pIndex}} ) + { + my $qName = $data->{'sceQueues'}{$pIndex}{$qIndex}; + my $subtreeName = 'Q' . $qIndex; + + $cb->addLeaf( $portNode, $subtreeName, + { 'sce-queue-index' => $qIndex, + 'comment' => $qName, + 'precedence' => 1000 - $qIndex }); + } + } + } # hasCap sceQos + + + # Global counters + if( $devdetails->hasCap('sceGlobalCounters') ) + { + foreach my $linkIndex ( 1 .. $data->{'sceInfo'}{'pmoduleNumLinks'} ) + { + my $gcNode = + $cb->addSubtree( $devNode, + 'SCE_Global_Counters_L' . $linkIndex, + { 'comment' => + 'Global service counters for link #' + . $linkIndex + }, + [ 'CiscoSCE::cisco-sce-gc-subtree']); + + foreach my $gcIndex + ( sort {$a <=> $b} keys %{$data->{'sceGlobalCounters'}} ) + { + my $srvName = $data->{'sceGlobalCounters'}{$gcIndex}; + my $subtreeName = $srvName; + $subtreeName =~ s/\W/_/g; + + $cb->addSubtree( $gcNode, $subtreeName, + { 'sce-link-index' => $linkIndex, + 'sce-gc-index' => $gcIndex, + 'comment' => $srvName, + 'sce-service-name' => $srvName, + 'precedence' => 1000 - $gcIndex, + 'searchable' => 'yes'}, + [ 'CiscoSCE::cisco-sce-gcounter' ]); + } + } + } # END hasCap sceGlobalCounters + + + # RDR Formatter reports + if( $devdetails->hasCap('sceRDR') ) + { + $cb->addTemplateApplication($devNode, 'CiscoSCE::cisco-sce-rdr'); + + # Add a Subtree for "SCE_RDR_Categories" + my $rdrNode = + $cb->addSubtree( $devNode, 'SCE_RDR_Categories', + { 'comment' => 'Raw Data Records per Category' }, + [ 'CiscoSCE::cisco-sce-rdr-category-subtree' ]); + + foreach my $cIndex ( sort {$a <=> $b} keys %{$data->{'sceRDR'}} ) + { + my $categoryName; + if ( $data->{'sceRDR'}{$cIndex} ) + { + $categoryName = $data->{'sceRDR'}{$cIndex}; + } + else + { + $categoryName = 'Category_' . $cIndex; + } + + $cb->addSubtree( $rdrNode, 'Category_' . $cIndex, + { 'precedence' => 1000 - $cIndex, + 'sce-rdr-index' => $cIndex, + 'sce-rdr-comment' => $categoryName }, + ['CiscoSCE::cisco-sce-rdr-category'] ); + } + } # END hasCap sceRDR +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm b/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm new file mode 100644 index 000000000..01d497594 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm @@ -0,0 +1,130 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CiscoVDSL.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $ +# Stanislav Sinyagin + +# Cisco VDSL Line statistics. +# Tested with Catalyst 2950 LRE + +package Torrus::DevDiscover::CiscoVDSL; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CiscoVDSL'} = { + 'sequence' => 600, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # CISCO-IETF-VDSL-LINE-MIB + 'cvdslCurrSnrMgn' => '1.3.6.1.4.1.9.10.87.1.1.2.1.5', + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + if( $devdetails->isDevType('CiscoGeneric') ) + { + my $snrTable = + $session->get_table( -baseoid => $dd->oiddef('cvdslCurrSnrMgn') ); + if( defined $snrTable ) + { + $devdetails->storeSnmpVars( $snrTable ); + return 1; + } + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + $data->{'cvdsl'} = []; + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $oid = $dd->oiddef('cvdslCurrSnrMgn') . '.' . $ifIndex; + if( $devdetails->hasOID( $oid . '.1' ) and + $devdetails->hasOID( $oid . '.2' ) ) + { + push( @{$data->{'cvdsl'}}, $ifIndex ); + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $subtreeName = 'VDSL_Line_Stats'; + + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, {}, + ['CiscoVDSL::cvdsl-subtree']); + + my $data = $devdetails->data(); + + foreach my $ifIndex ( sort {$a<=>$b} @{$data->{'cvdsl'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $templates = ['CiscoVDSL::cvdsl-interface']; + + my $param = { + 'interface-name' => $interface->{'param'}{'interface-name'}, + 'interface-nick' => $interface->{'param'}{'interface-nick'}, + 'comment' => $interface->{'param'}{'comment'} + }; + + $cb->addSubtree( $subtreeNode, $ifSubtreeName, $param, $templates ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm b/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm new file mode 100644 index 000000000..f055a187a --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm @@ -0,0 +1,212 @@ +# Copyright (C) 2003 Shawn Ferry +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CompaqCIM.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ +# Shawn Ferry + +# Compaq Insight Manager +# MIB files available at +# http://h18023.www1.hp.com/support/files/server/us/download/19885.html + +package Torrus::DevDiscover::CompaqCIM; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'CompaqCIM'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # Compaq Insite Manager + 'cpqcim' => '1.3.6.1.4.1.232', + + # CPQHLTH-MIB + 'cpqHeTemperatureTable' => '1.3.6.1.4.1.232.6.2.6.8', + 'cpqHeTemperatureChassis' => '1.3.6.1.4.1.232.6.2.6.8.1.1', + 'cpqHeTemperatureIndex' => '1.3.6.1.4.1.232.6.2.6.8.1.2', + 'cpqHeTemperatureLocale' => '1.3.6.1.4.1.232.6.2.6.8.1.3', + 'cpqHeTemperatureCelsius' => '1.3.6.1.4.1.232.6.2.6.8.1.4', + 'cpqHeTemperatureHwLocation' => '1.3.6.1.4.1.232.6.2.6.8.1.8', + + 'cpqHeCorrMemTotalErrs' => '1.3.6.1.4.1.232.6.2.3.3.0', + + # This is not a complete implementation of the HLTH MIB + + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + return $dd->checkSnmpTable( 'cpqcim' ); +} + +my $enumLocale = { + 1 => 'other', + 2 => 'unknown', + 3 => 'system', + 4 => 'systemBoard', + 5 => 'ioBoard', + 6 => 'cpu', + 7 => 'memory', + 8 => 'storage', + 9 => 'removableMedia', + 10 => 'powerSupply', + 11 => 'ambient', + 12 => 'chassis', + 13 => 'bridgeCard', +}; + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my @checkOids = ( 'cpqHeCorrMemTotalErrs' ); + + foreach my $oid ( @checkOids ) + { + if( $dd->checkSnmpOID($oid) ) + { + $devdetails->setCap( $oid ); + } + } + + my $TemperatureTable = + $session->get_table( -baseoid => + $dd->oiddef('cpqHeTemperatureTable') ); + + if( defined( $TemperatureTable ) ) + { + $devdetails->storeSnmpVars( $TemperatureTable ); + $devdetails->setCap( 'cpqHeTemperatureTable' ); + + my $ref = {}; + $ref->{'indices'} = []; + $data->{'TemperatureTable'} = $ref; + + # Index is Chassis . Index + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('cpqHeTemperatureIndex') ) ) + { + next if ( $devdetails->snmpVar + ( $dd->oiddef('cpqHeTemperatureCelsius') . + '.' . $INDEX ) < 0 ); + + push( @{$ref->{'indices'}}, $INDEX ); + + my $chassis = $devdetails->snmpVar + ( $dd->oiddef('cpqHeTemperatureChassis') . '.' . $INDEX ); + + my $sensorIdx = $devdetails->snmpVar + ( $dd->oiddef('cpqHeTemperatureIndex') . '.' . $INDEX ); + + my $locale = $devdetails->snmpVar + ( $dd->oiddef('cpqHeTemperatureLocale') . '.' . $INDEX ); + $locale = $enumLocale->{$locale} if $enumLocale->{$locale}; + + my $location = $devdetails->snmpVar + ( $dd->oiddef('cpqHeTemperatureHwLocation') . '.' . $INDEX ); + + my $nick = sprintf('Chassis%d_%s_%d', + $chassis, $locale, $sensorIdx); + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + $param->{'cpq-cim-sensor-index'} = $INDEX; + $param->{'cpq-cim-sensor-nick'} = $nick; + $param->{'comment'} = + sprintf('Chassis: %s Location: %s Index: %s', + $chassis, $locale, $sensorIdx); + $param->{'precedence'} = 1000 - $sensorIdx; + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + my $cimParam = { + 'comment' => 'Compaq Insight Manager', + 'precedence' => '-500', + }; + + my $cimNode = $cb->addSubtree( $devNode, 'CompaqCIM', $cimParam ); + + my $healthParam = { + 'comment' => 'Compaq CIM Health', + 'precedence' => '-500' + }; + + my @healthTemplates; + if( $devdetails->hasCap('cpqHeCorrMemTotalErrs') ) + { + push( @healthTemplates, 'CompaqCIM::cpq-cim-corr-mem-errs' ); + } + + my $Health = $cb->addSubtree( $cimNode, 'Health', $healthParam, + \@healthTemplates); + + if( $devdetails->hasCap('cpqHeTemperatureTable') ) + { + my $tempParam = { + 'precedence' => '-100', + 'comment' => 'Compaq Temperature Sensors', + 'rrd-create-dstype' => 'GAUGE', + }; + + my $tempNode = + $cb->addSubtree( $Health, 'Temperature_Sensors', $tempParam ); + + my $ref = $data->{'TemperatureTable'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $param = $ref->{$INDEX}->{'param'}; + $cb->addLeaf( $tempNode, $param->{'cpq-cim-sensor-nick'}, $param, + [ 'CompaqCIM::cpq-cim-temperature-sensor' ] ); + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm b/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm new file mode 100644 index 000000000..f796920be --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm @@ -0,0 +1,798 @@ +# Copyright (C) 2003 Shawn Ferry +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: EmpireSystemedge.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Shawn Ferry + +package Torrus::DevDiscover::EmpireSystemedge; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'EmpireSystemedge'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +# define the oids that are needed to determine support, +# capabilities and information about the device +our %oiddef = + ( + 'empire' => '1.3.6.1.4.1.546', + + 'sysedge_opmode' => '1.3.6.1.4.1.546.1.1.1.17.0', + 'empireSystemType' => '1.3.6.1.4.1.546.1.1.1.12.0', + + # Empire Cpu Table + 'empireCpuStatsTable' => '1.3.6.1.4.1.546.13.1.1', + 'empireCpuStatsIndex' => '1.3.6.1.4.1.546.13.1.1.1', + 'empireCpuStatsDescr' => '1.3.6.1.4.1.546.13.1.1.2', + + # Empire Cpu Totals + 'empireCpuTotalWait' => '1.3.6.1.4.1.546.13.5.0', + + # Empire Swap Counters + 'empireNumPageSwapIns' => '1.3.6.1.4.1.546.1.1.7.8.18.0', + + # Empire Load Average + 'empireLoadAverage' => '1.3.6.1.4.1.546.1.1.7.8.26.0', + + # Empire Device Table and Oids + 'empireDevTable' => '1.3.6.1.4.1.546.1.1.1.7.1', + 'empireDevIndex' => '1.3.6.1.4.1.546.1.1.1.7.1.1', + 'empireDevMntPt' => '1.3.6.1.4.1.546.1.1.1.7.1.3', + 'empireDevBsize' => '1.3.6.1.4.1.546.1.1.1.7.1.4', + 'empireDevTblks' => '1.3.6.1.4.1.546.1.1.1.7.1.5', + 'empireDevType' => '1.3.6.1.4.1.546.1.1.1.7.1.10', + 'empireDevDevice' => '1.3.6.1.4.1.546.1.1.1.7.1.2', + + # Empire Device Stats Table and Oids + 'empireDiskStatsTable' => '1.3.6.1.4.1.546.12.1.1', + 'empireDiskStatsIndex' => '1.3.6.1.4.1.546.12.1.1.1', + 'empireDiskStatsHostIndex' => '1.3.6.1.4.1.546.12.1.1.9', + 'hrDeviceDescr' => '1.3.6.1.2.1.25.3.2.1.3', + + # Empire Performance and related oids + 'empirePerformance' => '1.3.6.1.4.1.546.1.1.7', + 'empireNumTraps' => '1.3.6.1.4.1.546.1.1.7.8.15.0', + + # Empire Process Stats + 'empireRunq' => '1.3.6.1.4.1.546.1.1.7.8.4.0', + 'empireDiskWait' => '1.3.6.1.4.1.546.1.1.7.8.5.0', + 'empirePageWait' => '1.3.6.1.4.1.546.1.1.7.8.6.0', + 'empireSwapActive' => '1.3.6.1.4.1.546.1.1.7.8.7.0', + 'empireSleepActive' => '1.3.6.1.4.1.546.1.1.7.8.8.0', + + # Empire Extensions NTREGPERF + 'empireNTREGPERF' => '1.3.6.1.4.1.546.5.7', + + 'empireDnlc' => '1.3.6.1.4.1.546.1.1.11', + 'empireRpc' => '1.3.6.1.4.1.546.8.1', + 'empireNfs' => '1.3.6.1.4.1.546.8.2', + 'empireMon' => '1.3.6.1.4.1.546.6.1.1', + 'empirePmon' => '1.3.6.1.4.1.546.15.1.1', + 'empireLog' => '1.3.6.1.4.1.546.11.1.1', + ); + +our %storageDescTranslate = ( '/' => {'subtree' => 'root' } ); + +# template => 1 if specific templates for the name explicitly exist, +# othewise the template used is based on ident +# +# Generally only hosts that have been directly observed should have +# templates, the "unix" and "nt" templates are generally aiming for the +# lowest common denominator. +# +# templates also need to be added to devdiscover-config.pl +# +# Templated "names" require a specific template for each of the +# following base template types: +#