diff options
Diffstat (limited to 'torrus/perllib')
95 files changed, 33827 insertions, 0 deletions
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 <ssinyagin@yahoo.com> +# + + +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 <ssinyagin@yahoo.com> +# +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 <ssinyagin@yahoo.com> + + +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 <ssinyagin@yahoo.com> + + +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 <ssinyagin@yahoo.com> + + +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 <ssinyagin@yahoo.com> + + +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/\>/\>\;/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 <ssinyagin@yahoo.com> + + +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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + + +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 <christian.schnidrig@bluewin.ch> + + +# 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 <christian.schnidrig@bluewin.ch> + + +# 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 <ssinyagin@yahoo.com> + +## 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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + + +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 <ssinyagin@yahoo.com> + + +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 ) ) + { + # <param name="setenv_dataexpr" + # value="ENV1=expr1, ENV2=expr2"/> + + 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 <ssinyagin@yahoo.com> + +# +# 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 <ssinyagin@yahoo.com> + + +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 <param name="name" value="value"/> 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 + # <datasources> + + 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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> +# + +# 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 <sbrooks@binary-solutions.net> + +# 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 <mh+torrus-devel@zugschlus.de> +# 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 <nistor at snickers dot org> +# + + +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 <nistor at snickers.org> + +# 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 <nistor at snickers.org> +# +# 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 <nistor at snickers.org> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <mh+torrus-devel@zugschlus.de> +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <lalartu at obscure dot org> <sferry at sevenspace dot com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <ssinyagin@yahoo.com> + +# 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 <nistor at snickers dot org> +# +# 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 <ssinyagin@yahoo.com> + +# 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 <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# 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 <sferry at sevenspace dot com> <lalartu at obscure dot org> + +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: +# <template name="empire-swap-counters-NAME"> +# <template name="empire-counters-NAME"> +# <template name="empire-total-cpu-NAME"> +# <template name="empire-total-cpu-raw-NAME"> +# <template name="empire-cpu-NAME"> +# <template name="empire-cpu-raw-NAME"> +# <template name="empire-disk-stats-NAME"> +# +# i.e. +# <template name="empire-swap-counters-solarisSparc"> +# <template name="empire-counters-solarisSparc"> +# <template name="empire-total-cpu-solarisSparc"> +# <template name="empire-total-cpu-raw-solarisSparc"> +# <template name="empire-cpu-solarisSparc"> +# <template name="empire-cpu-raw-solarisSparc"> +# <template name="empire-disk-stats-solarisSparc"> +# + + +our %osTranslate = + ( + 1 => { 'name' => 'unknown', 'ident' => 'unknown', 'template' => 0, }, + 2 => { 'name' => 'solarisSparc', 'ident' => 'unix', 'template' => 1, }, + 3 => { 'name' => 'solarisIntel', 'ident' => 'unix', 'template' => 0, }, + 4 => { 'name' => 'solarisPPC', 'ident' => 'unix', 'template' => 0, }, + 5 => { 'name' => 'sunosSparc', 'ident' => 'unix', 'template' => 0, }, + 6 => { 'name' => 'hpux9Parisc', 'ident' => 'unix', 'template' => 0, }, + 7 => { 'name' => 'hpux10Parisc', 'ident' => 'unix', 'template' => 0, }, + 8 => { 'name' => 'nt351Intel', 'ident' => 'nt', 'template' => 0, }, + 9 => { 'name' => 'nt351Alpha', 'ident' => 'nt', 'template' => 0, }, + 10 => { 'name' => 'nt40Intel', 'ident' => 'nt', 'template' => 1, }, + 11 => { 'name' => 'nt40Alpha', 'ident' => 'nt', 'template' => 0, }, + 12 => { 'name' => 'irix62Mips', 'ident' => 'unix', 'template' => 0, }, + 13 => { 'name' => 'irix63Mips', 'ident' => 'unix', 'template' => 0, }, + 14 => { 'name' => 'irix64Mips', 'ident' => 'unix', 'template' => 0, }, + 15 => { 'name' => 'aix41RS6000', 'ident' => 'unix', 'template' => 0, }, + 16 => { 'name' => 'aix42RS6000', 'ident' => 'unix', 'template' => 0, }, + 17 => { 'name' => 'aix43RS6000', 'ident' => 'unix', 'template' => 0, }, + 18 => { 'name' => 'irix65Mips', 'ident' => 'unix', 'template' => 0, }, + 19 => { 'name' => 'digitalUNIX', 'ident' => 'unix', 'template' => 0, }, + 20 => { 'name' => 'linuxIntel', 'ident' => 'unix', 'template' => 1, }, + 21 => { 'name' => 'hpux11Parisc', 'ident' => 'unix', 'template' => 0, }, + 22 => { 'name' => 'nt50Intel', 'ident' => 'nt', 'template' => 1, }, + 23 => { 'name' => 'nt50Alpha', 'ident' => 'nt', 'template' => 0, }, + 25 => { 'name' => 'aix5RS6000', 'ident' => 'unix', 'template' => 1, }, + 26 => { 'name' => 'nt52Intel', 'ident' => 'nt', 'template' => 0, }, + ); + +# Solaris Virtual Interface Filtering +our $interfaceFilter; +my %solarisVirtualInterfaceFilter; + +%solarisVirtualInterfaceFilter = ( + 'Virtual Interface (iana 62)' => { + 'ifType' => 62, # Obsoleted + 'ifDescr' => '^\w+:\d+$', # Virtual Interface in the form xxx:1 + # e.g. eri:1 eri1:2 + }, + + 'Virtual Interface' => { + 'ifType' => 6, + 'ifDescr' => '^\w+:\d+$', # Virtual Interface in the form xxx:1 + # e.g. eri:1 eri1:2 + }, + ); + +our $storageGraphTop; +our $storageHiMark; +our $shortTemplate; +our $longTemplate; + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $session = $dd->session(); + + if( not $dd->checkSnmpTable( 'empire' ) ) + { + return 0; + } + + my $result = $dd->retrieveSnmpOIDs( 'sysedge_opmode', + 'empireSystemType' ); + if( $result->{'sysedge_opmode'} == 2 ) + { + Error("Sysedge Agent NOT Licensed"); + $devdetails->setCap('SysedgeNotLicensed'); + } + + # Empire OS Type (Needed here for interface filtering) + + my $empireOsType = $result->{'empireSystemType'}; + if( defined($empireOsType) and $empireOsType > 0 ) + { + $devdetails->setCap('EmpireSystemedge::' . + $osTranslate{$empireOsType}{ident} ); + + $devdetails->{'os_ident'} = $osTranslate{$empireOsType}{ident}; + + + $devdetails->setCap('EmpireSystemedge::' . + $osTranslate{$empireOsType}{name} ); + + $devdetails->{'os_name'} = $osTranslate{$empireOsType}{name}; + + $devdetails->{'os_name_template'} = + $osTranslate{$empireOsType}{template}; + } + + # Exclude Virtual Interfaces on Solaris + if( $devdetails->{'os_name'} =~ /solaris/i ) { + + $interfaceFilter = \%solarisVirtualInterfaceFilter; + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + + if( $dd->checkSnmpOID('empireCpuTotalWait') ) + { + $devdetails->setCap('EmpireSystemedge::CpuTotal::Wait'); + } + + # Empire Dev Stats Table + + my $empireDiskStatsTable = + $session->get_table( -baseoid => + $dd->oiddef('empireDiskStatsTable') ); + + my $hrDeviceDescr = $session->get_table( -baseoid => + $dd->oiddef('hrDeviceDescr') ); + + if( defined($empireDiskStatsTable) and defined($hrDeviceDescr) ) + { + $devdetails->setCap('EmpireSystemedge::DiskStats'); + $devdetails->storeSnmpVars( $empireDiskStatsTable ); + $devdetails->storeSnmpVars( $hrDeviceDescr ); + + my $ref= {'indices' => []}; + $data->{'empireDiskStats'} = $ref; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('empireDiskStatsIndex') ) ) + { + next if( $INDEX < 1 ); + + my $hrindex = + $devdetails->snmpVar( $dd->oiddef('empireDiskStatsHostIndex') . + '.' . $INDEX ); + + next if( $hrindex < 1 ); + + push( @{ $ref->{'indices'} }, $INDEX ); + + my $descr = $devdetails->snmpVar($dd->oiddef('hrDeviceDescr') . + '.' . $hrindex ); + + my $ref = { 'param' => {}, 'templates' => [] }; + $data->{'empireDiskStats'}{$INDEX} = $ref; + my $param = $ref->{'param'}; + + + $param->{'comment'} = $descr; + + $param->{'HRINDEX'} = $hrindex; + + if ( not defined $descr ) + { + $descr = "Index $hrindex"; + } + $param->{'disk-stats-description'} = $descr; + + $descr =~ s/^\///; + $descr =~ s/\W/_/g; + $param->{'disk-stats-nick'} = $descr; + + } + } # end empireDiskStatsTable + + # Empire Dev Table + + my $empireDevTable = $session->get_table( -baseoid => + $dd->oiddef('empireDevTable') ); + + if( defined( $empireDevTable ) ) + { + + $devdetails->setCap('EmpireSystemedge::Devices'); + $devdetails->storeSnmpVars( $empireDevTable ); + + my $ref= {}; + $data->{'empireDev'} = $ref; + + foreach my $INDEX + ( $devdetails->getSnmpIndices($dd->oiddef('empireDevIndex') ) ) + { + next if( $INDEX < 1 ); + + + my $type = $devdetails->snmpVar( $dd->oiddef('empireDevType') . + '.' . $INDEX ); + + my $descr = $devdetails->snmpVar($dd->oiddef('empireDevMntPt') . + '.' . $INDEX ); + + my $bsize = $devdetails->snmpVar($dd->oiddef('empireDevBsize') . + '.' . $INDEX ); + + # NFS has a block size of 0, it will be skipped + if( $bsize and defined( $descr ) ) + { + push( @{ $data->{'empireDev'}->{'indices'} }, $INDEX); + + my $ref = { 'param' => {}, 'templates' => [] }; + $data->{'empireDev'}{$INDEX} = $ref; + my $param = $ref->{'param'}; + + $param->{'storage-description'} = $descr; + $param->{'storage-device'} = + $devdetails->snmpVar($dd->oiddef('empireDevDevice') + . '.' . $INDEX ); + + my $comment = $type; + if( $descr =~ /^\// ) + { + $comment .= ' (' . $descr . ')'; + } + $param->{'comment'} = $comment; + + if( $storageDescTranslate{$descr}{'subtree'} ) + { + $descr = $storageDescTranslate{$descr}{'subtree'}; + } + $descr =~ s/^\///; + $descr =~ s/\W/_/g; + $param->{'storage-nick'} = $descr; + + my $units = $bsize; + + $param->{'collector-scale'} = sprintf('%d,*', $units); + + my $size = + $devdetails->snmpVar + ($dd->oiddef('empireDevTblks') . '.' . $INDEX); + + if( $size ) + { + if( $storageGraphTop > 0 ) + { + $param->{'graph-upper-limit'} = + sprintf('%e', + $units * $size * $storageGraphTop / 100 ); + } + + if( $storageHiMark > 0 ) + { + $param->{'upper-limit'} = + sprintf('%e', + $units * $size * $storageHiMark / 100 ); + } + } + + } + } + + $devdetails->clearCap( 'hrStorage' ); + + } # end empireDevTable + + + # Empire Per - Cpu Table + + my $empireCpuStatsTable = + $session->get_table( -baseoid => + $dd->oiddef('empireCpuStatsTable') ); + + if( defined( $empireCpuStatsTable ) ) + { + $devdetails->setCap('EmpireSystemedge::CpuStats'); + $devdetails->storeSnmpVars( $empireCpuStatsTable ); + + my $ref= {}; + $data->{'empireCpuStats'} = $ref; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('empireCpuStatsIndex') ) ) + { + next if( $INDEX < 1 ); + + push( @{ $ref->{'indices'} }, $INDEX); + + my $descr = + $devdetails->snmpVar( $dd->oiddef('empireCpuStatsDescr') . + '.' . $INDEX ); + + my $ref = { 'param' => {}, 'templates' => [] }; + $data->{'empireCpuStats'}{$INDEX} = $ref; + my $param = $ref->{'param'}; + + $param->{'cpu'} = 'CPU' . $INDEX; + $param->{'descr'} = $descr; + $param->{'INDEX'} = $INDEX; + $param->{'comment'} = $descr . ' (' . 'CPU ' . $INDEX . ')'; + } + } + + # Empire Load Average + + if( $dd->checkSnmpOID('empireLoadAverage') ) + { + $devdetails->setCap('EmpireSystemedge::LoadAverage'); + } + + # Empire Swap Counters + + if( $dd->checkSnmpOID('empireNumPageSwapIns') ) + { + $devdetails->setCap('EmpireSystemedge::SwapCounters'); + } + + # Empire Counter Traps + + if( $dd->checkSnmpOID('empireNumTraps') ) + { + $devdetails->setCap('EmpireSystemedge::CounterTraps'); + } + + # Empire Performance + + my $empirePerformance = + $session->get_table( -baseoid => $dd->oiddef('empirePerformance') ); + + if( defined( $empirePerformance ) ) + { + $devdetails->setCap('EmpireSystemedge::Performance'); + $devdetails->storeSnmpVars( $empirePerformance ); + + if( defined $devdetails->snmpVar($dd->oiddef('empireRunq') ) ) + { + $devdetails->setCap('EmpireSystemedge::RunQ'); + } + + if( defined $devdetails->snmpVar($dd->oiddef('empireDiskWait') ) ) + { + $devdetails->setCap('EmpireSystemedge::DiskWait'); + } + + if( defined $devdetails->snmpVar($dd->oiddef('empirePageWait') ) ) + { + $devdetails->setCap('EmpireSystemedge::PageWait'); + } + + if( defined $devdetails->snmpVar($dd->oiddef('empireSwapActive') ) ) + { + $devdetails->setCap('EmpireSystemedge::SwapActive'); + } + + if( defined $devdetails->snmpVar($dd->oiddef('empireSleepActive') ) ) + { + $devdetails->setCap('EmpireSystemedge::SleepActive'); + } + } + + my $empireNTREGPERF = + $session->get_table( -baseoid => $dd->oiddef('empireNTREGPERF') ); + if( defined $empireNTREGPERF ) + { + $devdetails->setCap('empireNTREGPERF'); + $devdetails->storeSnmpVars( $empireNTREGPERF ); + + my $ref = {}; + $data->{'empireNTREGPERF'} = $ref; + foreach my $INDEX + ( $devdetails->getSnmpIndices($dd->oiddef('empireNTREGPERF') ) ) + { + # This is all configured on a per site basis. + # The xml will be site specific + push( @{ $ref->{'indices'} }, $INDEX); + my $template = {}; + $Torrus::ConfigBuilder::templateRegistry-> + {'EmpireSystemedge::NTREGPERF_' . $INDEX} = $template; + $template->{'name'}='EmpireSystemedge::NTREGPERF_' . $INDEX; + $template->{'source'}='vendor/empire.systemedge.ntregperf.xml'; + + } + } + +#NOT CONFIGURED## Empire DNLC +#NOT CONFIGURED# my $empireDnlc = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empireDnlc') ); +#NOT CONFIGURED# if( defined $empirePerformance ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empirednlc'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empireDnlc ); +#NOT CONFIGURED# } +#NOT CONFIGURED# +#NOT CONFIGURED## Empire RPC +#NOT CONFIGURED# my $empireRpc = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empireRpc') ); +#NOT CONFIGURED# if( defined $empireRpc ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empirerpc'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empireRpc ); +#NOT CONFIGURED# } +#NOT CONFIGURED# +#NOT CONFIGURED## Empire NFS +#NOT CONFIGURED# my $empireNfs = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empireNfs') ); +#NOT CONFIGURED# if( defined $empireRpc ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empirenfs'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empireNfs ); +#NOT CONFIGURED# } +#NOT CONFIGURED# +#NOT CONFIGURED## Empire Mon Entries +#NOT CONFIGURED# my $empireMon = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empireMon') ); +#NOT CONFIGURED# if( ref( $empireMon ) ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empiremon'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empireMon ); +#NOT CONFIGURED# } +#NOT CONFIGURED# +#NOT CONFIGURED## Empire Process Monitor Entries +#NOT CONFIGURED# my $empirePmon = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empirePmon') ); +#NOT CONFIGURED# if( ref( $empirePmon ) ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empirePmon'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empirePmon ); +#NOT CONFIGURED# } +#NOT CONFIGURED# +#NOT CONFIGURED## Empire Log Monitor Entries +#NOT CONFIGURED# my $empireLog = $session->get_table( -baseoid => +#NOT CONFIGURED# $dd->oiddef('empireLog') ); +#NOT CONFIGURED# if( ref( $empireLog ) ) +#NOT CONFIGURED# { +#NOT CONFIGURED# # don't do this until we use the data +#NOT CONFIGURED# #$devdetails->setCap('empireLog'); +#NOT CONFIGURED# #$devdetails->storeSnmpVars( $empireLog ); +#NOT CONFIGURED# } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + my $mononlyTree = "Mon_Only"; + my $monParam = { + 'precedence' => '-100000', + 'comment' => 'Place to Stash Monitoring Data ', + 'hidden' => 'yes', + }; + + my $monNode = $cb->addSubtree( $devNode, $mononlyTree, $monParam ); + $cb->addTemplateApplication + ( $monNode, 'EmpireSystemedge::sysedge_opmode' ); + + if( $devdetails->hasCap('SysedgeNotLicensed') ) + { + return 1; + } + + my $os_target; + if( $devdetails->{'os_name_template'} ) + { + $os_target = $devdetails->{'os_name'}; + } + else + { + $os_target = $devdetails->{'os_ident'}; + Warn("Using Generic OS Templates '$os_target' for os: " + . $devdetails->{'os_name'} ); + } + + my $subtreeName = "Storage"; + + my $param = { + 'precedence' => '-1000', + 'comment' => 'Storage Information', + }; + + my $StorageNode = $cb->addSubtree( $devNode, $subtreeName, $param ); + + # Empire Devices(Storage) + if( $devdetails->hasCap('EmpireSystemedge::Devices') ) + { + my $subtreeName = "VolumeInfo"; + + my $param = { + 'precedence' => '-1000', + 'comment' => 'Physical/Logical Volume Information', + }; + + my $subtreeNode = + $cb->addSubtree( $StorageNode, $subtreeName, $param, + [ 'EmpireSystemedge::empire-device-subtree' ] ); + + foreach my $INDEX ( sort {$a<=>$b} @{$data->{'empireDev'}{'indices'}} ) + { + my $ref = $data->{'empireDev'}{$INDEX}; + + # Display in index order + $ref->{'param'}->{'precedence'} = sprintf("%d", 2000 - $INDEX); + + $cb->addSubtree( $subtreeNode, $ref->{'param'}{'storage-nick'}, + $ref->{'param'}, + [ 'EmpireSystemedge::empire-device' ] ); + } + } + + # Empire Device Stats + if( $devdetails->hasCap('EmpireSystemedge::DiskStats') ) + { + my $subtreeName = "DiskInfo"; + + my $param = { + 'precedence' => '-1000', + 'comment' => 'Physical/Logical Disk Information', + }; + + my $subtreeNode = + $cb->addSubtree( $StorageNode, $subtreeName, $param, + ['EmpireSystemedge::empire-disk-stats-subtree']); + + foreach my $INDEX + ( sort {$a<=>$b} @{$data->{'empireDiskStats'}{'indices'}} ) + { + my $ref = $data->{'empireDiskStats'}{$INDEX}; + # Display in index order + $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX); + + $cb->addSubtree( $subtreeNode, $ref->{'param'}{'disk-stats-nick'}, + $ref->{'param'}, + [ 'EmpireSystemedge::empire-disk-stats-' . + $os_target, ] ); + } + } + + + # Performance Subtree + my $subtreeName= "System_Performance"; + + my $param = { + 'precedence' => '-900', + 'comment' => 'System, CPU and memory statistics' + }; + + my @perfTemplates = (); + + # Empire Load Average + if( $devdetails->hasCap('EmpireSystemedge::LoadAverage') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-load' ); + } + + # Empire Performance + if( $devdetails->hasCap('EmpireSystemedge::Performance') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-memory' ); + } + + push( @perfTemplates, + 'EmpireSystemedge::empire-counters-' . $os_target, + 'EmpireSystemedge::empire-swap-counters-' . $os_target, + 'EmpireSystemedge::empire-total-cpu-' . $os_target, + 'EmpireSystemedge::empire-total-cpu-raw-' . $os_target, + ); + + if( $devdetails->hasCap('EmpireSystemedge::RunQ') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-runq' ); + } + + if( $devdetails->hasCap('EmpireSystemedge::DiskWait') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-diskwait' ); + } + + if( $devdetails->hasCap('EmpireSystemedge::PageWait') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-pagewait' ); + } + + if( $devdetails->hasCap('EmpireSystemedge::SwapActive') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-swapactive' ); + } + + if( $devdetails->hasCap('EmpireSystemedge::SleepActive') ) + { + push( @perfTemplates, 'EmpireSystemedge::empire-sleepactive' ); + } + + my $PerformanceNode = $cb->addSubtree( $devNode, $subtreeName, + $param, \@perfTemplates ); + + # Empire CPU Stats + if( $devdetails->hasCap('EmpireSystemedge::CpuStats') ) + { + my $ref = $data->{'empireCpuStats'}; + + my $subtreeName = "CpuStats"; + + my $param = { + 'precedence' => '-1100', + 'comment' => 'Per-CPU Statistics', + }; + + my $subtreeNode = + $cb->addSubtree( $PerformanceNode, $subtreeName, $param, + [ 'EmpireSystemedge::empire-cpu-subtree' ] ); + + foreach my $INDEX + ( sort {$a<=>$b} @{$data->{'empireCpuStats'}{'indices'} } ) + { + my $ref = $data->{'empireCpuStats'}{$INDEX}; + + # Display in index order + $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX); + + $cb->addSubtree + ( $subtreeNode, $ref->{'param'}{'cpu'}, + $ref->{'param'}, + ['EmpireSystemedge::empire-cpu-' . $os_target, + 'EmpireSystemedge::empire-cpu-raw-' . $os_target], + ); + } + } + + if( $devdetails->hasCap('empireNTREGPERF') ) + { + Debug("NTREGPERF"); + my $ntregTree = "NT_REG_PERF"; + my $ntregParam = { + 'precedence' => '-10000', + 'comment' => 'NT Reg Perf', + }; + my $ntregnode = + $cb->addSubtree( $devNode, $ntregTree, $ntregParam ); + + foreach my $INDEX + ( sort {$a<=>$b} @{$data->{'empireNTREGPERF'}{'indices'} } ) + { + my $ref = $data->{'empireNTREGPERF'}{$INDEX}; + $cb->addTemplateApplication + ( $ntregnode, 'EmpireSystemedge::NTREGPERF_' . $INDEX ); + + } + + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm b/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm new file mode 100644 index 000000000..e0d0770bb --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm @@ -0,0 +1,543 @@ +# 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: F5BigIp.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# F5 BigIp Load Balancer + +package Torrus::DevDiscover::F5BigIp; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'F5BigIp'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # F5 + 'f5' => '1.3.6.1.4.1.3375', + + '4.x_globalStatUptime' => '1.3.6.1.4.1.3375.1.1.1.2.1.0', + '3.x_uptime' => '1.3.6.1.4.1.3375.1.1.50.0', + + '4.x_globalAttrProductCode' => '1.3.6.1.4.1.3375.1.1.1.1.5.0', + + '4.x_virtualServer' => '1.3.6.1.4.1.3375.1.1.3', + '4.x_virtualServerNumber' => '1.3.6.1.4.1.3375.1.1.3.1.0', + '4.x_virtualServerTable' => '1.3.6.1.4.1.3375.1.1.3.2', + '4.x_virtualServerIp' => '1.3.6.1.4.1.3375.1.1.3.2.1.1', + '4.x_virtualServerPort' => '1.3.6.1.4.1.3375.1.1.3.2.1.2', + '4.x_virtualServerPool' => '1.3.6.1.4.1.3375.1.1.3.2.1.30', + + '4.x_poolTable' => '1.3.6.1.4.1.3375.1.1.7.2', + '4.x_poolName' => '1.3.6.1.4.1.3375.1.1.7.2.1.1', + + '4.x_poolMemberTable' => '1.3.6.1.4.1.3375.1.1.8.2', + '4.x_poolMemberPoolName' => '1.3.6.1.4.1.3375.1.1.8.2.1.1', + '4.x_poolMemberIpAddress' => '1.3.6.1.4.1.3375.1.1.8.2.1.2', + '4.x_poolMemberPort' => '1.3.6.1.4.1.3375.1.1.8.2.1.3', + + '4.x_sslProxyTable' => '1.3.6.1.4.1.3375.1.1.9.2.1', + '4.x_sslProxyOrigIpAddress' => '1.3.6.1.4.1.3375.1.1.9.2.1.1', + '4.x_sslProxyOrigPort' => '1.3.6.1.4.1.3375.1.1.9.2.1.2', + '4.x_sslProxyDestIpAddress' => '1.3.6.1.4.1.3375.1.1.9.2.1.3', + '4.x_sslProxyDestPort' => '1.3.6.1.4.1.3375.1.1.9.2.1.4', + '4.x_sslProxyConnLimit' => '1.3.6.1.4.1.3375.1.1.9.2.1.23', + + ); + +# from https://secure.f5.com/validate/help.jsp +#HA (BIG-IP high availability software) +#3DNS (3-DNS software) +#LC (BIG-IP Link Controller software) +#LB (BIG-IP Load Balancer 520) +#FLB (BIG-IP FireGuard 520) +#CLB (BIG-IP Cache Load Balancer 520) +#SSL (BIG-IP eCommerce Load Balancer 520) +#XLB (BIG-IP user-defined special purpose product for 520 platforms) +#ISMAN (iControl Services Manager) + +our %f5_product = ( + '1' => { 'product' => 'indeterminate', 'supported' => 0, }, + '2' => { 'product' => 'ha', 'supported' => 1, }, + '3' => { 'product' => 'lb', 'supported' => 1, }, + '4' => { 'product' => 'threedns', 'supported' => 0, }, + '5' => { 'product' => 'flb', 'supported' => 0, }, + '6' => { 'product' => 'clb', 'supported' => 0, }, + '7' => { 'product' => 'xlb', 'supported' => 0, }, + '8' => { 'product' => 'ssl', 'supported' => 1, }, + '10' => { 'product' => 'test', 'supported' => 0, }, + '99' => { 'product' => 'unsupported', 'supported' => 0, }, + ); + +our %f5_sslGatewayLevel = ( + '1' => 'none', + '3' => 'tps200', + '4' => 'tps400', + '5' => 'tps600', + '6' => 'tps800', + '7' => 'tps1000', + '9' => 'tps500', + '10' => 'tps1500', + '11' => 'tps2000', + '99' => 'unsupported', + ); + + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + my $data = $devdetails->data(); + + # You would think globalAttrProductCode would work well + # I need more examples to see if ha(2) is specific to + # BipIP HA or any ha f5 product + + if( not $dd->checkSnmpTable( 'f5' ) ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # SNMP on F5 boxes will become unresponsive over time with large + # enough oids-per-pdu values. 10 appears to work for everything however + # no exhaustive testing has been done to determine if a higer number + # could be used. + if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) ) + { + my $oidsPerPDU = $devdetails->param('F5BigIp::snmp-oids-per-pdu'); + if( $oidsPerPDU == 0 ) + { + $oidsPerPDU = 10; + } + $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU; + } + + # this is rather basic, per-capability checking + # may be required in the future + + if( $dd->checkSnmpOID('4.x_globalStatUptime') ) + { + $devdetails->setCap('BigIp_4.x'); + } + elsif( $dd->checkSnmpOID('3.x_uptime') ) + { + # for v3.x we are not supporting detailed stats, so don't check + # anything else + $devdetails->setCap('BigIp_3.x'); + return 1; + } + + my $product_name; + my $product_name; + my $result = $dd->retrieveSnmpOIDs( '4.x_globalAttrProductCode' ); + my $product_code = $result->{'4.x_globalAttrProductCode'}; + + $product_name = %f5_product->{$product_code}->{'product'}; + if( %f5_product->{$product_code}->{'supported'} ) + { + $devdetails->setCap( 'BigIp_' . $product_name ); + } + else + { + if( defined($product_name) ) + { + Debug("Found an unsupported F5 product '$product_name'"); + } + else + { + Debug("Found an unknown F5 product"); + } + return 0; + } + + my $poolTable = $session->get_table( -baseoid => + $dd->oiddef('4.x_poolTable') ); + + if( defined( $poolTable ) ) + { + $devdetails->storeSnmpVars( $poolTable ); + $devdetails->setCap('BigIp_4.x_PoolTable'); + + my $ref = {}; + $ref->{'indices'} = []; + $data->{'poolTable'} = $ref; + + foreach my $INDEX ( $devdetails-> + getSnmpIndices( $dd->oiddef('4.x_poolName') ) ) + { + push( @{$ref->{'indices'}}, $INDEX ); + my $pool = $devdetails->snmpVar($dd->oiddef('4.x_poolName') . + '.' . $INDEX ); + + my $nick = $pool; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + $param->{'nick'} = $nick; + $param->{'pool'} = $pool; + $param->{'descr'} = "Stats for Pool $pool"; + $param->{'INDEX'} = $INDEX; + } + + } + + my $poolMemberTable = + $session->get_table( -baseoid => + $dd->oiddef('4.x_poolMemberTable') ); + + if( defined( $poolMemberTable ) ) + { + $devdetails->storeSnmpVars( $poolMemberTable ); + $devdetails->setCap('BigIp_4.x_PoolMemberTable'); + + my $ref = {}; + $data->{'poolMemberTable'} = $ref; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('4.x_poolMemberPoolName') ) ) + { + push( @{ $ref->{'indices'} }, $INDEX ); + my $pool = + $devdetails->snmpVar($dd->oiddef('4.x_poolMemberPoolName') . + '.' . $INDEX ); + my $ip = + $devdetails->snmpVar($dd->oiddef('4.x_poolMemberIpAddress') . + '.' . $INDEX ); + my $port = + $devdetails->snmpVar($dd->oiddef('4.x_poolMemberPort') . + '.' . $INDEX ); + + my $nick = "MEMBER_${pool}_${ip}_${port}"; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + $param->{'nick'} = $nick; + $param->{'pool'} = $pool; + $param->{'descr'} = "Member of Pool $pool IP: $ip Port: $port"; + $param->{'INDEX'} = $INDEX; + } + + } + + my $virtServerNumber = $dd->retrieveSnmpOIDs( '4.x_virtualServerNumber' ); + if( $virtServerNumber->{'4.x_virtualServerNumber'} > 0 ) + { + my $virtServer = $session->get_table( -baseoid => + $dd->oiddef('4.x_virtualServer') ); + if( defined( $virtServer ) ) + { + $devdetails->storeSnmpVars( $virtServer ); + $devdetails->setCap('BigIp_4.x_VirtualServer'); + + my $ref = {}; + $data->{'virtualServer'} = $ref; + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('4.x_virtualServerIp') ) ) + { + push( @{ $ref->{'indices'} }, $INDEX); + my $pool = $devdetails->snmpVar( + $dd->oiddef('4.x_virtualServerPool') . + '.' . $INDEX ); + my $ip = $devdetails->snmpVar( + $dd->oiddef('4.x_virtualServerIp') . + '.' . $INDEX ); + my $port = $devdetails->snmpVar( + $dd->oiddef('4.x_virtualServerPort') . + '.' . $INDEX ); + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + + my $descr = "Virtual Server Pool: $pool IP: $ip Port: $port"; + my $nick = "VIP_${pool}_${ip}_${port}"; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + $param->{'INDEX'} = $INDEX; + $param->{'descr'} = $descr; + $param->{'nick'} = $nick; + $param->{'pool'} = $pool; + } + } + else + { + Debug("Virtual Servers Defined but not able to be configured"); + } + } + + my $sslProxyTable = $session->get_table( -baseoid => + $dd->oiddef('4.x_sslProxyTable') ); + + if( defined( $sslProxyTable ) ) + { + $devdetails->storeSnmpVars( $sslProxyTable ); + $devdetails->setCap('BigIp_4.x_sslProxyTable'); + + my $ref = {}; + $ref->{'indices'} = []; + $data->{'sslProxyTable'} = $ref; + + foreach my $INDEX ( $devdetails-> + getSnmpIndices( $dd->oiddef('4.x_sslProxyOrigIpAddress') ) ) + { + push( @{$ref->{'indices'}}, $INDEX ); + + my $origIp = $devdetails->snmpVar( + $dd->oiddef('4.x_sslProxyOrigIpAddress') + . '.' . $INDEX ); + + my $origPort = $devdetails->snmpVar( + $dd->oiddef('4.x_sslProxyOrigPort') + . '.' . $INDEX ); + + my $destIp = $devdetails->snmpVar( + $dd->oiddef('4.x_sslProxyDestIpAddress') + . '.' . $INDEX ); + + my $destPort = $devdetails->snmpVar( + $dd->oiddef('4.x_sslProxyDestPort') + . '.' . $INDEX ); + + my $connLimit = $devdetails->snmpVar( + $dd->oiddef('4.x_sslProxyConnLimit') + . '.' . $INDEX ); + + + + my $nick = $origIp . '_' . $origPort . '_' . $destIp . + '_' . $destPort; + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + $param->{'nick'} = $nick; + $param->{'descr'} = "Stats for SSL Proxy Address: " . + "${origIp}:${origPort} -> ${destIp}:${destPort}"; + $param->{'INDEX'} = $INDEX; + $param->{'connLimit'} = $connLimit; + + } + + + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + my $bigIpName = 'BigIp_Global_Stats'; + + my $bigIpParam = { + 'precedence' => '-100', + 'comment' => 'BigIp Global Stats', + 'rrd-create-dstype' => 'GAUGE', }; + + if( $devdetails->hasCap('BigIp_4.x') ) + { + my $bigIpStatsNode = $cb->addSubtree( $devNode, $bigIpName, + $bigIpParam, [ 'F5BigIp::BigIp_4.x' ]); + + if( $devdetails->hasCap('BigIp_ssl') ) + { + $cb->addTemplateApplication + ( $bigIpStatsNode , 'F5BigIp::BigIp_4.x_sslProxy_Global' ); + } + } + elsif( $devdetails->hasCap('BigIp_3.x') ) + { + $cb->addSubtree( $devNode, $bigIpName, $bigIpParam, + [ 'F5BigIp::BigIp_3.x' ]); + } + + my $virtName = 'BigIp_VirtualServers'; + + my $virtParam = { + 'precedence' => '-200', + 'comment' => 'Virtual Server(VIP) Stats', + }; + + my $virtTree; + + if( $devdetails->hasCap('BigIp_4.x_VirtualServer') ) + { + my @templates = + ( 'F5BigIp::BigIp_4.x_virtualServer-actvconn-overview' ); + # 'F5BigIp::BigIp_4.x_virtualServer-connrate-overview'); + + $virtTree = + $cb->addSubtree( $devNode, $virtName, $virtParam, \@templates ); + + my $ref = $data->{'virtualServer'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $server = $ref->{$INDEX}->{'param'}; + + $server->{'precedence'} = '-100'; + + $cb->addSubtree( $virtTree, $server->{'nick'}, $server, + [ 'F5BigIp::BigIp_4.x_virtualServer' ] ); + } + } + + my $poolName = 'BigIp_Pools'; + my $poolParam = { + 'precedence' => '-300', + 'comment' => 'Pool Stats', + }; + + my $poolTree; + + if( $devdetails->hasCap('BigIp_4.x_PoolTable') ) + { + $poolTree = + $cb->addSubtree( $devNode, $poolName, $poolParam, + ['F5BigIp::BigIp_4.x_pool-actvconn-overview']); + my $ref = $data->{'poolTable'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $pool = $ref->{$INDEX}->{'param'}; + + $pool->{'precedence'} = '-100'; + + $cb->addSubtree( $poolTree, $pool->{'pool'}, $pool, + [ 'F5BigIp::BigIp_4.x_pool' ] ); + } + + } + + my $poolMemberName = 'BigIp_Pool_Members'; + + my $poolMemberParam = { + 'precedence' => '-400', + 'comment' => 'Pool Member Stats', + }; + + my $poolMemberTree; + + if( $devdetails->hasCap('BigIp_4.x_PoolMemberTable') ) + { + $poolMemberTree = + $cb->addSubtree( $devNode, $poolMemberName, $poolMemberParam ); + my $ref = $data->{'poolMemberTable'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $poolMemberPoolTree; + my $lastPoolTree; + my $server = $ref->{$INDEX}->{'param'}; + + my $poolMemberPoolName = $server->{'pool'}; + my $poolMemberPoolParam = { + 'precidence' => '-100', + 'comment' => "Members of the $server->{'pool'} Pool", + }; + + + if( not defined( $lastPoolTree ) or + $poolMemberPoolName !~ /\b$lastPoolTree\b/ ) + { + my @templates = + ( 'F5BigIp::BigIp_4.x_poolMember-actvconn-overview' ); + $poolMemberPoolTree = + $cb->addSubtree( $poolMemberTree, $poolMemberPoolName, + $poolMemberPoolParam, \@templates ); + + $lastPoolTree = $poolMemberPoolName; + + $server->{'precedence'} = '-100'; + + $cb->addSubtree( $poolMemberPoolTree, $server->{'nick'}, $server, + [ 'F5BigIp::BigIp_4.x_poolMember' ] ); + } + } + } + + + # BigIP SSL Product Support + if( $devdetails->hasCap('BigIp_4.x_sslProxyTable') ) + { + + my $bigIpSSLProxies = 'BigIp_SSL_Proxies'; + + my $bigIpSSLParam = { + 'comment' => 'BigIp SSL Proxies', + 'rrd-create-dstype' => 'COUNTER', }; + + my $sslProxyTree = $cb->addSubtree( + $devNode, $bigIpSSLProxies, $bigIpSSLParam, + [ 'F5BigIp::BigIp_4.x_sslProxy-currconn-overview' ]); + + my $ref = $data->{'sslProxyTable'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $proxy = $ref->{$INDEX}->{'param'}; + + $cb->addSubtree( $sslProxyTree, $proxy->{'nick'}, $proxy, + [ 'F5BigIp::BigIp_4.x_sslProxy' ] ); + } + + } + +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/FTOS.pm b/torrus/perllib/Torrus/DevDiscover/FTOS.pm new file mode 100644 index 000000000..82629e2df --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/FTOS.pm @@ -0,0 +1,378 @@ +# +# 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: FTOS.pm,v 1.1 2010-12-27 00:03:54 ivan Exp $ +# Jon Nistor <nistor at snickers.org> + +# Force10 Networks Real Time Operating System Software +# +# NOTE: FTOS::disable-cpu +# FTOS::disable-power +# FTOS::disable-temperature +# FTOS::use-fahrenheit +# FTOS::file-per-sensor (affects both power and temperature) + +package Torrus::DevDiscover::FTOS; + +use strict; +use Torrus::Log; + +$Torrus::DevDiscover::registry{'FTOS'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # FORCE10-SMI + 'f10Products' => '1.3.6.1.4.1.6027.1', + + # F10-CHASSIS-MIB + 'chType' => '1.3.6.1.4.1.6027.3.1.1.1.1.0', + 'chSerialNumber' => '1.3.6.1.4.1.6027.3.1.1.1.2.0', + 'chSysPowerSupplyIndex' => '1.3.6.1.4.1.6027.3.1.1.2.1.1.1', + 'chSysCardSlotIndex' => '1.3.6.1.4.1.6027.3.1.1.2.3.1.1', + 'chSysCardNumber' => '1.3.6.1.4.1.6027.3.1.1.2.3.1.3', + 'chRpmCpuIndex' => '1.3.6.1.4.1.6027.3.1.1.3.7.1.1', + + # FORCE10-SYSTEM-COMPONENT-MIB + 'camUsagePartDesc' => '1.3.6.1.4.1.6027.3.7.1.1.1.1.4' + ); + + +our %f10ChassisType = + ( + '1' => 'Force10 E1200 16-slot switch/router', + '2' => 'Force10 E600 9-slot switch/router', + '3' => 'Force10 E300 8-slot switch/router', + '4' => 'Force10 E150 8-slot switch/router', + '5' => 'Force10 E610 9-slot switch/router', + '6' => 'Force10 C150 6-slot switch/router', + '7' => 'Force10 C300 10-slot switch/router', + '8' => 'Force10 E1200i 16-slot switch/router', + '9' => 'Force10 S2410 10GbE switch', + '10' => 'Force10 S2410 10GbE switch', + '11' => 'Force10 S50 access switch', + '12' => 'Force10 S50e access switch', + '13' => 'Force10 S50v access switch', + '14' => 'Force10 S50nac access switch', + '15' => 'Force10 S50ndc access switch', + '16' => 'Force10 S25pdc access switch', + '17' => 'Force10 S25pac access switch', + '18' => 'Force10 S25v access switch', + '19' => 'Force10 S25n access switch' + ); + +our %f10CPU = + ( + '1' => 'Control Processor', + '2' => 'Routing Processor #1', + '3' => 'Routing Processor #2' + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::FTOS::interfaceFilter +# or define $Torrus::DevDiscover::FTOS::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %ftosInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%ftosInterfaceFilter; +} + + +# 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 +%ftosInterfaceFilter = + ( + 'other' => { + 'ifType' => 1, # other + }, + 'loopback' => { + 'ifType' => 24, # softwareLoopback + }, + + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'f10Products', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + # Systems running FTOS will have chassisType, SFTOS will not. + if( not $dd->checkSnmpOID('chType') ) + { + 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(); + + # NOTE: Comments and Serial number of device + my $chassisSerial = $dd->retrieveSnmpOIDs( 'chType', 'chSerialNumber' ); + + if( defined( $chassisSerial ) ) + { + $data->{'param'}{'comment'} = + %f10ChassisType->{$chassisSerial->{'chType'}} . + ', Hw Serial#: ' . $chassisSerial->{'chSerialNumber'}; + } + else + { + $data->{'param'}{'comment'} = "Force10 Networks switch/router"; + } + + # PROG: CPU statistics + if( $devdetails->param('FTOS::disable-cpu') ne 'yes' ) + { + # Poll table to translate the CPU Index to a Name + my $ftosCpuTable = + $session->get_table( -baseoid => $dd->oiddef('chRpmCpuIndex') ); + + $devdetails->storeSnmpVars( $ftosCpuTable ); + + if( defined( $ftosCpuTable ) ) + { + $devdetails->setCap('ftosCPU'); + + # Find the index of the CPU + foreach my $ftosCPUidx ( $devdetails->getSnmpIndices + ( $dd->oiddef('chRpmCpuIndex') ) ) + { + my $cpuType = $dd->oiddef('chRpmCpuIndex') . "." . $ftosCPUidx; + my $cpuName = %f10CPU->{$ftosCpuTable->{$cpuType}}; + + Debug("FTOS::CPU index $ftosCPUidx, $cpuName"); + + # Construct the data ... + $data->{'ftosCPU'}{$ftosCPUidx} = $cpuName; + } + } + else + { + Debug("FTOS::CPU No CPU information found, old sw?"); + } + } # END: CPU + + + # PROG: Power Supplies + if( $devdetails->param('FTOS::disable-power') ne 'yes' ) + { + # Poll table of power supplies + my $ftosPSUTable = + $session->get_table( -baseoid => + $dd->oiddef('chSysPowerSupplyIndex') ); + + $devdetails->storeSnmpVars( $ftosPSUTable ); + + if( defined( $ftosPSUTable ) ) + { + $devdetails->setCap('ftosPSU'); + + # Find the Index of the Power Supplies + foreach my $ftosPSUidx ( $devdetails->getSnmpIndices + ($dd->oiddef('chSysPowerSupplyIndex')) ) + { + Debug("FTOS::PSU index $ftosPSUidx"); + + push( @{$data->{'ftosPSU'}}, $ftosPSUidx ); + } + } + } # END: PSU + + + # PROG: Temperature + if( $devdetails->param('FTOS::disable-sensors') ne 'yes' ) + { + # Check if temperature sensors are supported + my $sensorTable = + $session->get_table( -baseoid => + $dd->oiddef('chSysCardSlotIndex') ); + $devdetails->storeSnmpVars( $sensorTable ); + + my $sensorCard = + $session->get_table( -baseoid => $dd->oiddef('chSysCardNumber') ); + $devdetails->storeSnmpVars( $sensorCard ); + + + if( defined( $sensorTable ) ) + { + $devdetails->setCap('ftosSensor'); + + foreach my $sensorIdx ( $devdetails->getSnmpIndices + ( $dd->oiddef('chSysCardSlotIndex') ) ) + { + my $sensorCard = + $devdetails->snmpVar( $dd->oiddef('chSysCardNumber') . + '.' . $sensorIdx ); + + $data->{'ftosSensor'}{$sensorIdx} = $sensorCard; + + Debug("FTOS::Sensor index $sensorIdx, card $sensorCard"); + } + } # END if: $sensorTable + } # END: disable-sensors + + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + # PROG: CPU processing + if( $devdetails->hasCap('ftosCPU') ) + { + my $nodeTop = $cb->addSubtree( $devNode, 'CPU_Usage', undef, + [ 'FTOS::ftos-cpu-subtree'] ); + + foreach my $CPUidx ( sort {$a <=> $b} keys %{$data->{'ftosCPU'}} ) + { + my $CPUName = $data->{'ftosCPU'}{$CPUidx}; + my $subName = sprintf( 'CPU_%.2d', $CPUidx ); + + my $nodeCPU = $cb->addSubtree( $nodeTop, $subName, + { 'comment' => $CPUName, + 'cpu-index' => $CPUidx, + 'cpu-name' => $CPUName }, + [ 'FTOS::ftos-cpu' ] ); + } + } # END if ftosCPU + + + # PROG: Power supplies + if( $devdetails->hasCap('ftosPSU') ) + { + my $subtreeName = "Power_Supplies"; + my $param = { 'comment' => 'Power supplies status', + 'precedence' => -600 }; + my $filePerSensor + = $devdetails->param('FTOS::file-per-sensor') eq 'yes'; + my $templates = []; + + $param->{'data-file'} = '%snmp-host%_power' . + ($filePerSensor ? '_%power-index%':'') . + '.rrd'; + + my $nodeTop = $cb->addSubtree( $devNode, $subtreeName, + $param, $templates ); + + + foreach my $PSUidx ( sort {$a <=> $b} @{$data->{'ftosPSU'}} ) + { + my $leafName = sprintf( 'power_%.2d', $PSUidx ); + + my $nodePSU = $cb->addLeaf( $nodeTop, $leafName, + { 'power-index' => $PSUidx }, + [ 'FTOS::ftos-power-supply-leaf' ]); + } + } + + + # PROG: Temperature sensors + if( $devdetails->hasCap('ftosSensor') ) + { + my $subtreeName = "Temperature_Sensors"; + my $param = {}; + my $fahrenheit = $devdetails->param('FTOS::use-fahrenheit') eq 'yes'; + my $filePerSensor + = $devdetails->param('FTOS::file-per-sensor') eq 'yes'; + my $templates = [ 'FTOS::ftos-temperature-subtree' ]; + + $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->{'ftosSensor'}} ) + { + my $leafName = sprintf( 'sensor_%.2d', $sIndex ); + my $threshold = 60; # Forced value for the time being, 60 degC + my $sensorCard = $data->{'ftosSensor'}{$sIndex}; + + if( $fahrenheit ) + { + $threshold = $threshold * 1.8 + 32; + } + + my $param = { + 'sensor-index' => $sIndex, + 'sensor-description' => 'Module ' . $sensorCard, + 'upper-limit' => $threshold + }; + + my $templates = ['FTOS::ftos-temperature-sensor' . + ($fahrenheit ? '-fahrenheit':'')]; + + $cb->addLeaf( $subtreeNode, $leafName, $param, $templates ); + } + } +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Foundry.pm b/torrus/perllib/Torrus/DevDiscover/Foundry.pm new file mode 100644 index 000000000..8c9ef2c96 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Foundry.pm @@ -0,0 +1,566 @@ +# Copyright (C) 2008 Roman Hochuli +# 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: Foundry.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $ +# Roman Hochuli <roman@hochu.li> + +# Common Foundry MIBs, supported by IronWare-Devices + +package Torrus::DevDiscover::Foundry; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Foundry'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # FOUNDRY-SN-ROOT-MIB + 'fdry' => '1.3.6.1.4.1.1991', + + # FOUNDRY-SN-AGENT-MIB + 'fdrySnChasSerNum' => '1.3.6.1.4.1.1991.1.1.1.1.2.0', + 'fdrySnChasGen' => '1.3.6.1.4.1.1991.1.1.1.1.13', + 'fdrySnChasIdNumber' => '1.3.6.1.4.1.1991.1.1.1.1.17.0', + 'fdrySnChasArchitectureType' => '1.3.6.1.4.1.1991.1.1.1.1.25.0', + 'fdrySnChasProductType' => '1.3.6.1.4.1.1991.1.1.1.1.26.0', + + # FOUNDRY-SN-AGENT-MIB + 'fdrySnChasActualTemperature' => '1.3.6.1.4.1.1991.1.1.1.1.18.0', + 'fdrySnChasWarningTemperature' => '1.3.6.1.4.1.1991.1.1.1.1.19.0', + 'fdrySnChasShutdownTemperature' => '1.3.6.1.4.1.1991.1.1.1.1.20.0', + 'fdrySnAgImgVer' => '1.3.6.1.4.1.1991.1.1.2.1.11', + 'fdrySnAgentTempTable' => '1.3.6.1.4.1.1991.1.1.2.13.1', + 'fdrySnAgentTempSensorDescr' => '1.3.6.1.4.1.1991.1.1.2.13.1.1.3', + 'fdrySnAgentTempValue' => '1.3.6.1.4.1.1991.1.1.2.13.1.1.4', + + # FOUNDRY-SN-AGENT-MIB + 'fdrySnAgGblCpuUtilData' => '1.3.6.1.4.1.1991.1.1.2.1.35', + 'fdrySnAgGblCpuUtil1SecAvg' => '1.3.6.1.4.1.1991.1.1.2.1.50', + 'fdrySnAgGblCpuUtil5SecAvg' => '1.3.6.1.4.1.1991.1.1.2.1.51', + 'fdrySnAgGblCpuUtil1MinAvg' => '1.3.6.1.4.1.1991.1.1.2.1.52', + 'fdrySnAgentCpuUtilValue' => '1.3.6.1.4.1.1991.1.1.2.11.1.1.4', + 'fdrySnAgentCpuUtil100thPercent' => '1.3.6.1.4.1.1991.1.1.2.11.1.1.6', + + # FOUNDRY-SN-AGENT-MIB + 'fdrySnAgentBrdTbl' => '1.3.6.1.4.1.1991.1.1.2.2.1.1', + 'fdrySnAgentBrdMainBrdDescription' => '1.3.6.1.4.1.1991.1.1.2.2.1.1.2', + 'fdrySnAgentBrdMainPortTotal' => '1.3.6.1.4.1.1991.1.1.2.2.1.1.4', + 'fdrySnAgentBrdModuleStatus' => '1.3.6.1.4.1.1991.1.1.2.2.1.1.12', + # Not listed in FOUNDRY-SN-AGENT-MIB, but in release notes + 'fdrySnAgentBrdMemoryTotal' => '1.3.6.1.4.1.1991.1.1.2.2.1.1.24', + 'fdrySnAgentBrdMemoryAvailable' => '1.3.6.1.4.1.1991.1.1.2.2.1.1.25', + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::Foundry::interfaceFilter +# or define $Torrus::DevDiscover::Foundry::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %fdryInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%fdryInterfaceFilter; +} + +# 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 +%fdryInterfaceFilter = + ( + 'lb' => { + 'ifType' => 24, # softwareLoopback + }, + + 'v' => { + 'ifType' => 135, # l2vlan + }, + + 'tnl' => { + 'ifType' => 150, # mplsTunnel + }, + ); + + + +my %productTypeAttr = + ( + 1 => { + 'desc' => 'BigIron MG8', + }, + + 2 => { + 'desc' => 'NetIron 40G', + }, + + 3 => { + 'desc' => 'NetIron IMR 640', + }, + + 4 => { + 'desc' => 'NetIron RX 800', + }, + + 5 => { + 'desc' => 'NetIron XMR 16000', + }, + + 6 => { + 'desc' => 'NetIron RX 400', + }, + + 7 => { + 'desc' => 'NetIron XMR 8000', + }, + + 8 => { + 'desc' => 'NetIron RX 200', + }, + + 9 => { + 'desc' => 'NetIron XMR 4000', + }, + + 13 => { + 'desc' => 'NetIron MLX-32', + }, + + 14 => { + 'desc' => 'NetIron XMR 32000', + }, + + 15 => { + 'desc' => 'NetIron RX-32', + }, + + 78 => { + 'desc' => 'FastIron', + }, + + 0 => { + 'desc' => 'device', + }, + ); + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + my $retval = 0; + + if( $dd->oidBaseMatch + ( 'fdry', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + $retval = 1; + + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilter); + + if( defined( $interfaceFilterOverlay ) ) + { + &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter + ($devdetails, $interfaceFilterOverlay); + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + } + + return $retval; +} + + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # NOTE: Comments and Serial number of device + + my $chassis = $dd->retrieveSnmpOIDs( 'fdrySnChasSerNum', + 'fdrySnChasIdNumber', + 'fdrySnChasArchitectureType', + 'fdrySnChasProductType' ); + + Debug('fdrySnChasSerNum=' . $chassis->{'fdrySnChasSerNum'}); + Debug('fdrySnChasIdNumber=' . $chassis->{'fdrySnChasIdNumber'}); + Debug('fdrySnChasArchitectureType=' . + $chassis->{'fdrySnChasArchitectureType'}); + Debug('fdrySnChasProductType=' . $chassis->{'fdrySnChasProductType'}); + + my $productType = 0; + + if( defined( $chassis ) and + defined( $productTypeAttr{$chassis->{'fdrySnChasProductType'}} ) ) + { + $productType = $chassis->{'fdrySnChasProductType'}; + } + + my $deviceComment = 'Brocade ' . $productTypeAttr{$productType}{'desc'}; + + if( defined( $chassis ) ) + { + if( defined( $chassis->{'fdrySnChasSerNum'} ) ) + { + $deviceComment .= ', Chassis S/N: ' . + $chassis->{'fdrySnChasSerNum'}; + } + + if( defined( $chassis->{'fdrySnChasIdNumber'} ) and + $chassis->{'fdrySnChasIdNumber'} ne '' ) + { + $deviceComment .= ', Chassis ID: ' . + $chassis->{'fdrySnChasIdNumber'}; + } + } + + $data->{'param'}{'comment'} = $deviceComment; + + + my $chasTemp = $dd->retrieveSnmpOIDs( 'fdrySnChasActualTemperature', + 'fdrySnChasWarningTemperature', + 'fdrySnChasShutdownTemperature'); + + if( defined($chasTemp) and + defined($chasTemp->{'fdrySnChasActualTemperature'}) ) + { + $devdetails->setCap('snChasActualTemperature'); + + $data->{'fdryChasTemp'}{'warning'} = + $chasTemp->{'fdrySnChasWarningTemperature'}; + $data->{'fdryChasTemp'}{'shutdown'} = + $chasTemp->{'fdrySnChasShutdownTemperature'}; + } + + if( $dd->checkSnmpTable('fdrySnAgentBrdTbl') ) + { + $devdetails->setCap('fdryBoardStats'); + $data->{'fdryBoard'} = {}; + + # get only the modules with + # snAgentBrdModuleStatus = moduleRunning(10) + { + my $base = $dd->oiddef('fdrySnAgentBrdModuleStatus'); + my $table = $session->get_table( -baseoid => $base ); + my $prefixLen = length( $base ) + 1; + + while( my( $oid, $status ) = each %{$table} ) + { + if( $status == 10 ) + { + my $brdIndex = substr( $oid, $prefixLen ); + $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} = 1; + } + } + } + + # get module descriptions + { + my $oid = $dd->oiddef('fdrySnAgentBrdMainBrdDescription'); + my $table = $session->get_table( -baseoid => $oid ); + my $prefixLen = length( $oid ) + 1; + + while( my( $oid, $descr ) = each %{$table} ) + { + if( length($descr) > 0 ) + { + my $brdIndex = substr( $oid, $prefixLen ); + + if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} ) + { + $data->{'fdryBoard'}{$brdIndex}{'description'} = + $descr; + } + } + } + } + + # Non-chassis Foundry products set the description to "Invalid Module" + if( scalar(keys %{$data->{'fdryBoard'}}) == 1 and + $data->{'fdryBoard'}{1}{'moduleRunning'} ) + { + $data->{'fdryBoard'}{1}{'description'} = 'Management'; + } + + # check if memory statistics are available + { + my $base = $dd->oiddef('fdrySnAgentBrdMemoryTotal'); + my $table = $session->get_table( -baseoid => $base ); + my $prefixLen = length( $base ) + 1; + + while( my( $oid, $memory ) = each %{$table} ) + { + if( $memory > 0 ) + { + my $brdIndex = substr( $oid, $prefixLen ); + + if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} ) + { + $data->{'fdryBoard'}{$brdIndex}{'memory'} = 1; + } + } + } + } + + # check if CPU stats are available + # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.1 = Gauge32: 1 + # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.5 = Gauge32: 1 + # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.60 = Gauge32: 1 + # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.300 = Gauge32: 1 + { + my $base = $dd->oiddef('fdrySnAgentCpuUtilValue'); + my $table = $session->get_table( -baseoid => $base ); + my $prefixLen = length( $base ) + 1; + + while( my( $oid, $val ) = each %{$table} ) + { + my $brdIndex = substr( $oid, $prefixLen ); + $brdIndex =~ s/\.(.+)$//o; + if( $1 eq '1.1' and + $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} ) + { + $data->{'fdryBoard'}{$brdIndex}{'cpu'} = 1; + } + } + } + + # snAgentCpuUtil100thPercent: supported on NetIron XMR and NetIron + # MLX devices running software release 03.9.00 and later, FGS release + # 04.3.01 and later, and FSX 04.3.00 and later. + # snAgentCpuUtilValue is deprecated in these releases + { + my $base = $dd->oiddef('fdrySnAgentCpuUtil100thPercent'); + my $table = $session->get_table( -baseoid => $base ); + my $prefixLen = length( $base ) + 1; + + while( my( $oid, $val ) = each %{$table} ) + { + my $brdIndex = substr( $oid, $prefixLen ); + $brdIndex =~ s/\.(.+)$//o; + if( $1 eq '1.1' and + $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} ) + { + $data->{'fdryBoard'}{$brdIndex}{'cpu-new'} = 1; + } + } + } + + # check if temperature stats are available + # exclude the sensors which show zero + { + my $base = $dd->oiddef('fdrySnAgentTempSensorDescr'); + my $table = $session->get_table( -baseoid => $base ); + my $prefixLen = length( $base ) + 1; + + my $baseVal = $dd->oiddef('fdrySnAgentTempValue'); + my $values = $session->get_table( -baseoid => $baseVal ); + + while( my( $oid, $descr ) = each %{$table} ) + { + my $index = substr( $oid, $prefixLen ); + my ($brdIndex, $sensor) = split(/\./, $index); + + if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} and + $values->{$baseVal . '.' . $index} > 0 ) + { + $data->{'fdryBoard'}{$brdIndex}{'temperature'}{$sensor} = + $descr; + $devdetails->setCap('fdryBoardTemperature'); + } + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + # Chassis Temperature Sensors + if( $devdetails->hasCap('snChasActualTemperature') and not + $devdetails->hasCap('fdryBoardTemperature') ) + { + my $param = { + 'fdry-chastemp-warning' => $data->{'fdryChasTemp'}{'warning'}/2, + 'fdry-chastemp-shutdown' => $data->{'fdryChasTemp'}{'shutdown'}/2, + }; + + my $templates = [ 'Foundry::fdry-chass-temperature' ]; + + $cb->addLeaf( $devNode, 'Chassis_Temperature', + $param, $templates ); + } + + # Board Stats + if( $devdetails->hasCap('fdryBoardStats') ) + { + my $brdNode = $devNode; + if( scalar(keys %{$data->{'fdryBoard'}}) > 1 ) + { + my $param = { + 'node-display-name' => 'Linecard Statistics', + 'comment' => 'CPU, Memory, and Temperature information', + }; + + $brdNode = + $cb->addSubtree( $devNode, 'Linecard_Statistics', $param ); + } + + $cb->addTemplateApplication( $brdNode, + 'Foundry::fdry-board-overview' ); + + + foreach my $brdIndex ( sort {$a <=> $b} keys %{$data->{'fdryBoard'}} ) + { + my $descr = $data->{'fdryBoard'}{$brdIndex}{'description'}; + my $param = { + 'comment' => $descr, + 'fdry-board-index' => $brdIndex, + 'fdry-board-descr' => $descr, + 'nodeid' => 'module//%nodeid-device%//' . $brdIndex, + }; + + my $linecardNode = + $cb->addSubtree( $brdNode, 'Linecard_' . $brdIndex, + $param, + [ 'Foundry::fdry-board-subtree' ]); + + if( $data->{'fdryBoard'}{$brdIndex}{'memory'} ) + { + $cb->addSubtree( $linecardNode, 'Memory_Statistics', {}, + [ 'Foundry::fdry-board-memstats' ]); + } + + + my $cpuOid; + if( $data->{'fdryBoard'}{$brdIndex}{'cpu-new'} ) + { + $cpuOid = '$fdrySnAgentCpuUtil100thPercent'; + } + elsif( $data->{'fdryBoard'}{$brdIndex}{'cpu'} ) + { + $cpuOid = '$fdrySnAgentCpuUtilValue'; + } + + if( defined( $cpuOid ) ) + { + + $cb->addSubtree + ( $linecardNode, 'CPU_Statistics', + { + 'fdry-cpu-base' => $cpuOid, + 'nodeid' => 'cpu//%nodeid-device%//' . $brdIndex, + }, + [ 'Foundry::fdry-board-cpustats' ]); + } + + if( defined( $data->{'fdryBoard'}{$brdIndex}{'temperature'} ) ) + { + my $tempNode = + $cb->addSubtree( $linecardNode, 'Temperature_Statistics', + {}, ['Foundry::fdry-board-tempstats']); + + # Build a multi-graph for all sensors + + my @colors = + ('##one', '##two', '##three', '##four', '##five', + '##six', '##seven', '##eight', '##nine', '##ten'); + + my $mgParam = { + 'comment' => 'Board temperature sensors combined', + 'ds-type' => 'rrd-multigraph', + 'vertical-label' => 'Degrees Celcius', + 'nodeid' => 'temp//%nodeid-device%//' . $brdIndex, + }; + + my @sensors; + + foreach my $sensor + ( sort {$a <=> $b} + keys %{$data->{'fdryBoard'}{$brdIndex}{'temperature'}} ) + { + my $leafName = 'sensor_' . $sensor; + + my $descr = $data->{'fdryBoard'}{$brdIndex}{ + 'temperature'}{$sensor}; + + my $short = 'Temperature sensor ' . $sensor; + + my $param = { + 'comment' => $descr, + 'precedence' => 1000 - $sensor, + 'sensor-index' => $sensor, + 'sensor-short' => $short, + 'sensor-description' => $descr, + }; + + $cb->addLeaf + ( $tempNode, $leafName, $param, + ['Foundry::fdry-board-temp-sensor-halfcelsius'] ); + + push(@sensors, $leafName); + + $mgParam->{'ds-expr-' . $leafName} = + '{' . $leafName . '}'; + $mgParam->{'graph-legend-' . $leafName} = $short; + $mgParam->{'line-style-' . $leafName} = 'LINE2'; + + my $color = shift @colors; + if( not defined( $color ) ) + { + Error('Too many sensors on one Foundry board'); + $color = '##black'; + } + $mgParam->{'line-color-' . $leafName} = $color; + + $mgParam->{'line-order-' . $leafName} = $sensor; + } + + $mgParam->{'ds-names'} = join(',', @sensors); + + $cb->addLeaf( $tempNode, 'Temperature_Overview', $mgParam ); + } + } + } +} + + + +1; diff --git a/torrus/perllib/Torrus/DevDiscover/Jacarta.pm b/torrus/perllib/Torrus/DevDiscover/Jacarta.pm new file mode 100644 index 000000000..fdd6ee959 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Jacarta.pm @@ -0,0 +1,210 @@ +# Copyright (C) 2010 Roman Hochuli +# +# 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: Jacarta.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ + +# Sensor-MIBs of Jacarta iMeter-Products + + +package Torrus::DevDiscover::Jacarta; + +use strict; +use Torrus::Log; +use Switch; +use Data::Dumper; + + +$Torrus::DevDiscover::registry{'Jacarta'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + 'jacarta' => '1.3.6.1.4.1.19011', + 'sensorEntry' => '1.3.6.1.4.1.19011.2.3.1.1', + 'sensorIndex' => '1.3.6.1.4.1.19011.2.3.1.1.1', + 'sensorDescription' => '1.3.6.1.4.1.19011.2.3.1.1.2', + 'sensorType' => '1.3.6.1.4.1.19011.2.3.1.1.3', + 'sensorValue' => '1.3.6.1.4.1.19011.2.3.1.1.4', + 'sensorUnit' => '1.3.6.1.4.1.19011.2.3.1.1.5', + ); + + +our %sensor_types = + ( + 2 => { + 'template' => 'Jacarta::imeter-humi-sensor', + 'max' => 'NetBotz::humi-max', + }, + 3 => { + 'template' => 'Jacarta::imeter-temp-sensor', + 'max' => 'NetBotz::dew-max', + }, + 5 => { + 'template' => 'Jacarta::imeter-amps-sensor', + 'max' => 'NetBotz::dew-max', + }, + + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'jacarta', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + $data->{'Jacarta'} = {}; + + my $sensorTable = + $session->get_table( -baseoid => $oiddef{'sensorEntry'} ); + + if( not defined( $sensorTable ) ) + { + return 1; + } + + $devdetails->storeSnmpVars( $sensorTable ); + + # store the sensor names to guarantee uniqueness + my %sensorNames; + + foreach my $INDEX + ($devdetails->getSnmpIndices( $oiddef{'sensorIndex'} )) + { + my $sensorType = + $devdetails->snmpVar( $oiddef{'sensorType'} . '.' . + $INDEX); + my $sensorName = + $devdetails->snmpVar( $oiddef{'sensorDescription'} . '.' . + $INDEX); + + if( not defined( $sensor_types{$sensorType} ) ) + { + Error('Sensor ' . $INDEX . ' of unknown type: ' . $sensorType); + next; + } + + if( $sensorNames{$sensorName} ) + { + Warn('Duplicate sensor names: ' . $sensorName); + $sensorNames{$sensorName}++; + } + else + { + $sensorNames{$sensorName} = 1; + } + + if( $sensorNames{$sensorName} > 1 ) + { + $sensorName .= sprintf(' %d', $INDEX); + } + + my $leafName = $sensorName; + $leafName =~ s/\W/_/g; + + my $param = { + 'imeter-sensor-index' => $INDEX, + 'node-display-name' => $sensorName, + 'graph-title' => $sensorName, + 'precedence' => sprintf('%d', 1000 - $INDEX) + }; + + + if( defined( $sensor_types{$sensorType}{'max'} ) ) + { + my $max = + $devdetails->param($sensor_types{$sensorType}{'max'}); + + if( defined($max) and $max > 0 ) + { + $param->{'upper-limit'} = $max; + } + } + + $data->{'Jacarta'}{$INDEX} = { + 'param' => $param, + 'leafName' => $leafName, + 'template' => $sensor_types{$sensorType}{'template'}}; + + Debug('Found Sensor ' . $INDEX . ' of type ' . $sensorType . + ', named ' . $sensorName ); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + my $param = { + 'node-display-name' => 'Sensors', + 'comment' => 'All sensors connected via this iMeter Master', + }; + + my $sensorTree = + $cb->addSubtree( $devNode, 'Sensors', $param ); + + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'Jacarta'}} ) + { + my $ref = $data->{'Jacarta'}{$INDEX}; + + $cb->addLeaf( $sensorTree, $ref->{'leafName'}, $ref->{'param'}, + [$ref->{'template'}] ); + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/JunOS.pm b/torrus/perllib/Torrus/DevDiscover/JunOS.pm new file mode 100644 index 000000000..ff5c3f8a0 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/JunOS.pm @@ -0,0 +1,657 @@ +# +# 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: JunOS.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $ +# Jon Nistor <nistor at snickers.org> + +# Juniper JunOS Discovery Module +# +# NOTE: For Class of service, if you are noticing that you are not seeing +# all of your queue names show up, this is by design of Juniper. +# Solution: Put place-holder names for those queues such as: +# "UNUSED-queue-#" +# This is in reference to JunOS 7.6 +# +# NOTE: Options for this module: +# JunOS::disable-cos +# JunOS::disable-cos-red +# JunOS::disable-cos-tail +# JunOS::disable-firewall +# JunOS::disable-operating +# JunOS::disable-rpf + +package Torrus::DevDiscover::JunOS; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'JunOS'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig +}; + + +our %oiddef = + ( + # JUNIPER-SMI + 'jnxProducts' => '1.3.6.1.4.1.2636.1', + 'jnxBoxDescr' => '1.3.6.1.4.1.2636.3.1.2.0', + 'jnxBoxSerialNo' => '1.3.6.1.4.1.2636.3.1.3.0', + + # Operating status + 'jnxOperatingDescr' => '1.3.6.1.4.1.2636.3.1.13.1.5', + 'jnxOperatingTemp' => '1.3.6.1.4.1.2636.3.1.13.1.7', + 'jnxOperatingCPU' => '1.3.6.1.4.1.2636.3.1.13.1.8', + 'jnxOperatingISR' => '1.3.6.1.4.1.2636.3.1.13.1.9', + 'jnxOperatingDRAMSize' => '1.3.6.1.4.1.2636.3.1.13.1.10', # deprecated + 'jnxOperatingBuffer' => '1.3.6.1.4.1.2636.3.1.13.1.11', + 'jnxOperatingMemory' => '1.3.6.1.4.1.2636.3.1.13.1.15', + + # Firewall filter + 'jnxFWCounterDisplayFilterName' => '1.3.6.1.4.1.2636.3.5.2.1.6', + 'jnxFWCounterDisplayName' => '1.3.6.1.4.1.2636.3.5.2.1.7', + 'jnxFWCounterDisplayType' => '1.3.6.1.4.1.2636.3.5.2.1.8', + + # Class of Service (jnxCosIfqStatsTable deprecated, use jnxCosQstatTable) + # COS - Class Of Service + # RED - Random Early Detection + # PLP - Packet Loss Priority + # DSCP - Differential Service Code Point + + 'jnxCosFcIdToFcName' => '1.3.6.1.4.1.2636.3.15.3.1.2', + 'jnxCosQstatQedPkts' => '1.3.6.1.4.1.2636.3.15.4.1.3', + + # Reverse path forwarding + 'jnxRpfStatsPackets' => '1.3.6.1.4.1.2636.3.17.1.1.1.3' + + ); + + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::JunOS::interfaceFilter +# or define $Torrus::DevDiscover::JunOS::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %junosInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%junosInterfaceFilter; +} + + +# 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 +%junosInterfaceFilter = + ( + 'lsi' => { + 'ifType' => 150, # mplsTunnel + 'ifDescr' => '^lsi$' + }, + + 'other' => { + 'ifType' => 1, # other + }, + + 'loopback' => { + 'ifType' => 24, # softwareLoopback + }, + + 'propVirtual' => { + 'ifType' => 53, # propVirtual + }, + + 'gre_ipip_pime_pimd_mtun' => { + 'ifType' => 131, # tunnel + 'ifDescr' => '^(gre)|(ipip)|(pime)|(pimd)|(mtun)$' + }, + + 'pd_pe_gr_ip_mt_lt' => { + 'ifType' => 131, # tunnel + 'ifDescr' => '^(pd)|(pe)|(gr)|(ip)|(mt)|(lt)-\d+\/\d+\/\d+$' + }, + + 'ls' => { + 'ifType' => 108, # pppMultilinkBundle + 'ifDescr' => '^ls-\d+\/\d+\/\d+$' + }, + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'jnxProducts', + $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(); + + # NOTE: Comments and Serial number of device + my $chassisSerial = + $dd->retrieveSnmpOIDs( 'jnxBoxDescr', 'jnxBoxSerialNo' ); + + if( defined( $chassisSerial ) ) + { + $data->{'param'}{'comment'} = $chassisSerial->{'jnxBoxDescr'} . + ', Hw Serial#: ' . $chassisSerial->{'jnxBoxSerialNo'}; + } else + { + $data->{'param'}{'comment'} = "Juniper router"; + } + + + # PROG: Class of Service + # + if( $devdetails->param('JunOS::disable-cos') ne 'yes' ) + { + # Poll table to translate the CoS Index to a Name + my $cosQueueNumTable = + $session->get_table( -baseoid => + $dd->oiddef('jnxCosFcIdToFcName') ); + $devdetails->storeSnmpVars( $cosQueueNumTable ); + + if( $cosQueueNumTable ) + { + $devdetails->setCap('jnxCoS'); + + # Find the index of the CoS queue name + foreach my $cosFcIndex ( $devdetails->getSnmpIndices + ($dd->oiddef('jnxCosFcIdToFcName')) ) + { + my $cosFcNameOid = $dd->oiddef('jnxCosFcIdToFcName') . "." . + $cosFcIndex; + my $cosFcName = $cosQueueNumTable->{$cosFcNameOid}; + + Debug("JunOS::CoS FC index: $cosFcIndex name: $cosFcName"); + + # Construct the data ... + $data->{'jnxCos'}{'queue'}{$cosFcIndex} = $cosFcName; + } + + # We need to find out all the interfaces that have CoS enabled + # on them. We will use jnxCosQstatQedPkts as our reference point. + my $cosIfIndex = + $session->get_table( -baseoid => + $dd->oiddef('jnxCosQstatQedPkts') ); + $devdetails->storeSnmpVars( $cosIfIndex ); + + if( $cosIfIndex ) + { + foreach my $INDEX ( $devdetails->getSnmpIndices + ($dd->oiddef('jnxCosQstatQedPkts')) ) + { + my( $ifIndex, $cosQueueIndex ) = split( '\.', $INDEX ); + $data->{'jnxCos'}{'ifIndex'}{$ifIndex} = 1; + } + } + } + } # END JunOS::disable-cos + + + # PROG: Grab and store description of parts + # + if( $devdetails->param('JunOS::disable-operating') ne 'yes' ) + { + my $tableDesc = $session->get_table( -baseoid => + $dd->oiddef('jnxOperatingDescr')); + $devdetails->storeSnmpVars( $tableDesc ); + + if ( $tableDesc ) + { + # PROG: Set Capability flag + $devdetails->setCap('jnxOperating'); + + # PROG: Poll tables for more info to match and index on + my $tableCPU = + $session->get_table( -baseoid => + $dd->oiddef('jnxOperatingCPU')); + $devdetails->storeSnmpVars( $tableCPU ); + + my $tableISR = + $session->get_table( -baseoid => + $dd->oiddef('jnxOperatingISR')); + $devdetails->storeSnmpVars( $tableISR ); + + my $tableMEM = + $session->get_table( -baseoid => + $dd->oiddef('jnxOperatingMemory')); + $devdetails->storeSnmpVars( $tableMEM ); + + my $tableTemp = + $session->get_table( -baseoid => + $dd->oiddef('jnxOperatingTemp')); + $devdetails->storeSnmpVars( $tableTemp ); + + # PROG: Build tables for all the oids + # We are using the Descr oid base for matching. (cheap hack) + foreach my $opIndex ( $devdetails->getSnmpIndices + ($dd->oiddef('jnxOperatingDescr')) ) + { + my $opCPU = $devdetails->snmpVar + ($dd->oiddef('jnxOperatingCPU') . '.' . $opIndex); + my $opDesc = $devdetails->snmpVar + ($dd->oiddef('jnxOperatingDescr') . '.' . $opIndex); + my $opMem = $devdetails->snmpVar + ($dd->oiddef('jnxOperatingMemory') . '.' . $opIndex); + my $opISR = $devdetails->snmpVar + ($dd->oiddef('jnxOperatingISR') . '.' . $opIndex); + my $opTemp = $devdetails->snmpVar + ($dd->oiddef('jnxOperatingTemp') . '.' . $opIndex); + + Debug("JunOS:: opIdx: $opIndex Desc: $opDesc"); + Debug("JunOS:: CPU: $opCPU, CPU: $opISR, MEM: $opMem"); + Debug("JunOS:: Temp: $opTemp"); + + # Construct the data + $data->{'jnxOperating'}{$opIndex}{'index'} = $opIndex; + $data->{'jnxOperating'}{$opIndex}{'cpu'} = $opCPU; + $data->{'jnxOperating'}{$opIndex}{'desc'} = $opDesc; + $data->{'jnxOperating'}{$opIndex}{'isr'} = $opISR; + $data->{'jnxOperating'}{$opIndex}{'mem'} = $opMem; + $data->{'jnxOperating'}{$opIndex}{'temp'} = $opTemp; + } + } # END: if $tableDesc + } # END: JunOS::disable-operating + + + # PROG: Firewall statistics + if( $devdetails->param('JunOS::disable-firewall') ne 'yes' ) + { + my $tableFWFilter = + $session->get_table( -baseoid => + $dd->oiddef('jnxFWCounterDisplayFilterName')); + $devdetails->storeSnmpVars( $tableFWFilter ); + + if( $tableFWFilter ) + { + # PROG: Set Capability flag + $devdetails->setCap('jnxFirewall'); + + # PROG: Poll tables for more info to match and index on + my $tableFWCounter = + $session->get_table( -baseoid => + $dd->oiddef('jnxFWCounterDisplayName') ); + $devdetails->storeSnmpVars( $tableFWCounter ); + + # Firewall Type (counter = 2, policer = 3) + my $tableFWType = + $session->get_table( -baseoid => + $dd->oiddef('jnxFWCounterDisplayType') ); + $devdetails->storeSnmpVars( $tableFWType ); + + # PROG: Build tables for all the oids + # We are using the FW Filter name as the Indexing + foreach my $fwIndex ( $devdetails->getSnmpIndices + ($dd->oiddef('jnxFWCounterDisplayName')) ) + { + my $fwFilter = $devdetails->snmpVar + ($dd->oiddef('jnxFWCounterDisplayFilterName') . + '.' . $fwIndex); + my $fwCounter = $devdetails->snmpVar + ($dd->oiddef('jnxFWCounterDisplayName') . + '.' . $fwIndex); + my $fwType = $devdetails->snmpVar + ($dd->oiddef('jnxFWCounterDisplayType') . + '.' . $fwIndex); + Debug("JunOS::fw Filter: $fwFilter"); + Debug("JunOS::fw Counter: $fwCounter"); + Debug("JunOS::fw Type: $fwType"); + + # Construct the data + $data->{'jnxFirewall'}{$fwFilter}{$fwCounter}{'oid'} = + $fwIndex; + $data->{'jnxFirewall'}{$fwFilter}{$fwCounter}{'type'} = + $fwType; + } + } # END: if $tableFWfilter + } # END: JunOS::diable-firewall + + + # PROG: Check for RPF availability + if( $devdetails->param('JunOS::disable-rpf') ne 'yes' ) + { + my $tableRPF = + $session->get_table( -baseoid => + $dd->oiddef('jnxRpfStatsPackets') ); + $devdetails->storeSnmpVars( $tableRPF ); + + if( $tableRPF ) + { + # PROG: Set capability flag + $devdetails->setCap('jnxRPF'); + + # PROG: Find all the relevent interfaces + foreach my $rpfIndex ( $devdetails->getSnmpIndices + ($dd->oiddef('jnxRpfStatsPackets')) ) + { + my ($ifIndex,$addrFamily) = split('\.',$rpfIndex); + if( defined( $data->{'interfaces'}{$ifIndex} ) ) + { + my $ifAddrFam = $addrFamily == 1 ? 'ipv4' : 'ipv6'; + my $intName = $data->{'interfaces'}{$ifIndex}{'ifName'}; + my $intNameT = $data->{'interfaces'}{$ifIndex}{'ifNameT'}; + + # Construct data + $data->{'jnxRPF'}{$ifIndex}{'ifName'} = $intName; + $data->{'jnxRPF'}{$ifIndex}{'ifNameT'} = $intNameT; + + if( $addrFamily == 1 ) + { + $data->{'jnxRPF'}{$ifIndex}{'ipv4'} = 1; + } + if( $addrFamily == 2 ) + { + $data->{'jnxRPF'}{$ifIndex}{'ipv6'} = 2; + } + } + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + # PROG: Class of Service information + if( $devdetails->hasCap('jnxCoS') && + ( keys %{$data->{'jnxCos'}{'ifIndex'}} > 0 ) + ) + { + # PROG: Add CoS information if it exists. + my $nodeTop = $cb->addSubtree( $devNode, 'CoS', undef, + [ 'JunOS::junos-cos-subtree']); + + foreach my $ifIndex ( sort {$a <=> $b} keys + %{$data->{'jnxCos'}{'ifIndex'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + my $ifAlias = $interface->{'ifAlias'}; + my $ifDescr = $interface->{'ifDescr'}; + my $ifName = $interface->{'ifNameT'}; + + next if( not $ifName ); # Skip since port is likely 'disabled' + # This might be better to match against ifType + # as well since not all of them support Q's. + + # Add Subtree per port + my $nodePort = + $cb->addSubtree( $nodeTop, $ifName, + { 'comment' => $ifAlias, + 'precedence' => 1000 - $ifIndex }, + [ 'JunOS::junos-cos-subtree-interface' ]); + + # Loop to create subtree's for each QueueName/ID pair + foreach my $cosIndex ( sort keys %{$data->{'jnxCos'}{'queue'}} ) + { + my $cosName = $data->{'jnxCos'}{'queue'}{$cosIndex}; + + # Add Leaf for each one + Debug("JunOS::CoS ifIndex: $ifIndex ($ifName -> $cosName)"); + my $nodeIFCOS = + $cb->addSubtree( $nodePort, $cosName, + { 'comment' => "Class: " . $cosName, + 'cos-index' => $cosIndex, + 'cos-name' => $cosName, + 'ifDescr' => $ifDescr, + 'ifIndex' => $ifIndex, + 'ifName' => $ifName, + 'precedence' => 1000 - $cosIndex }, + [ 'JunOS::junos-cos-leaf' ]); + + if( $devdetails->param('JunOS::disable-cos-tail') ne 'yes' ) + { + $cb->addSubtree( $nodeIFCOS, "Tail_drop_stats", + { 'comment' => 'Tail drop statistics' }, + [ 'JunOS::junos-cos-tail' ]); + } + + if( $devdetails->param('JunOS::disable-cos-red') ne 'yes' ) + { + $cb->addSubtree + ( $nodeIFCOS, "RED_stats", + { 'comment' => 'Random Early Detection' }, + [ 'JunOS::junos-cos-red' ]); + } + + } # end foreach (INDEX of queue's [Q-ID]) + } # end foreach (INDEX of port) + } # end if HasCap->{CoS} + + + # PROG: Firewall Table (filters and counters) + if( $devdetails->hasCap('jnxFirewall') ) + { + # Add subtree first + my $nodeFW = $cb->addSubtree( $devNode, 'Firewall', undef, + [ 'JunOS::junos-firewall-subtree' ]); + + # Loop through and find all the filter names + foreach my $fwFilter + ( sort {$a <=> $b} keys %{$data->{'jnxFirewall'}} ) + { + my $firewall = $data->{'jnxFirewall'}{$fwFilter}; + + # Add subtree for FilterName + my $nodeFWFilter = + $cb->addSubtree( $nodeFW, $fwFilter, + { 'comment' => 'Filter: ' . $fwFilter }, + [ 'JunOS::junos-firewall-filter-subtree' ]); + + # Loop through and find all the counter names within the filter + foreach my $fwCounter ( sort {$a <=> $b} keys %{$firewall} ) + { + my $fwOid = $firewall->{$fwCounter}{'oid'}; + my $fwType = $firewall->{$fwCounter}{'type'}; + my @templates = ( 'JunOS::junos-firewall-filter' ); + + # Figure out which templates to apply ... + if ($fwType == 2) + { + # fwType is a counter ... + push( @templates, + 'JunOS::junos-firewall-filter-counter', + 'JunOS::junos-firewall-filter-policer' ); + } + elsif ($fwType == 3) + { + # fwType is a policer ... + push( @templates, + 'JunOS::junos-firewall-filter-policer' ); + } # END: if $fwType + + # Finally, add the subtree... + my $fwTypeName = $fwType == 2 ? 'Counter: ' : 'Policer: '; + my $nodeFWCounter = + $cb->addSubtree($nodeFWFilter, $fwCounter, + { 'comment' => $fwTypeName . $fwCounter, + 'fw-counter' => $fwCounter, + 'fw-filter' => $fwFilter, + 'fw-index' => $fwOid }, \@templates ); + } # END foreach $fwCounter + } # END foreach $fwFilter + } # END: if hasCap jnxFirewall + + + # PROG: Operating Status Table + # NOTE: According to the Juniper MIB, the following is a statement: + # jnxOperatingTemp: The temperature in Celsius (degrees C) of this + # subject. Zero if unavailable or inapplicable. + # The same applies for all values under Operating status table, if + # Zero is shown it might be considered unavail or N/A. We will + # also take that into consideration. + # NOTE: Also so poorly written, its great. + if( $devdetails->hasCap('jnxOperating') ) + { + my $nodeCPU = $cb->addSubtree( $devNode, 'CPU_Usage', undef, + [ 'JunOS::junos-cpu-subtree' ]); + + my $nodeMem = $cb->addSubtree( $devNode, 'Memory_Usage', undef, + [ 'JunOS::junos-memory-subtree' ]); + + my $nodeTemp = + $cb->addSubtree( $devNode, 'Temperature_Sensors', undef, + [ 'JunOS::junos-temperature-subtree' ]); + + + foreach my $opIndex + ( sort {$a <=> $b} keys %{$data->{'jnxOperating'}} ) + { + my $operating = $data->{'jnxOperating'}{$opIndex}; + my $jnxCPU = $operating->{'cpu'}; + my $jnxDesc = $operating->{'desc'}; + my $jnxMem = $operating->{'mem'}; + my $jnxTemp = $operating->{'temp'}; + my $jnxTag = $jnxDesc; + $jnxTag =~ s/\W+/_/go; + $jnxTag =~ s/_$//go; + # Fix the .'s into _'s for the RRD-DS and name of leaf + my $opIndexFix = $opIndex; + $opIndexFix =~ s/\./_/g; + + # PROG: Find CPU that does not equal 0 + if ($jnxCPU > 0) + { + $cb->addSubtree( $nodeCPU, $jnxTag, + { 'comment' => $jnxDesc, + 'cpu-index' => $opIndex }, + [ 'JunOS::junos-cpu' ]); + } + + # PROG: Find memory that does not equal 0 + if ($jnxMem > 0) + { + $cb->addSubtree( $nodeMem, $jnxTag, + { 'comment' => $jnxDesc, + 'mem-index' => $opIndex, + 'mem-indexFix' => $opIndexFix }, + [ 'JunOS::junos-memory' ]); + } + + # PROG: Find Temperature that does not equal 0 + if ($jnxTemp > 0) + { + if ($jnxDesc =~ /(temp.* sensor|Engine)/) { + # Small little hack to cleanup the sensor tags + $jnxTag =~ s/_temp(erature|)_sensor//g; + $cb->addLeaf( $nodeTemp, $jnxTag, + { 'comment' => $jnxDesc, + 'sensor-desc' => $jnxDesc, + 'sensor-index' => $opIndex, + 'sensor-indexFix' => $opIndexFix }, + [ 'JunOS::junos-temperature-sensor' ]); + } + } + } # END foreach $opIndex + } # END if jnxOperating + + + # PROG: Reverse Forwarding Path (RPF) + if( $devdetails->hasCap('jnxRPF') ) + { + # Add subtree first + my $nodeRPF = $cb->addSubtree( $devNode, 'RPF', undef, + [ 'JunOS::junos-rpf-subtree' ]); + + # Loop through and find all interfaces with RPF enabled + foreach my $ifIndex ( sort {$a <=> $b} keys %{$data->{'jnxRPF'}} ) + { + # Set some names + my $ifAlias = $data->{'interfaces'}{$ifIndex}{'ifAlias'}; + my $ifName = $data->{'interfaces'}{$ifIndex}{'ifName'}; + my $ifNameT = $data->{'interfaces'}{$ifIndex}{'ifNameT'}; + my $hasIPv4 = $data->{'jnxRPF'}{$ifIndex}{'ipv4'}; + my $hasIPv6 = $data->{'jnxRPF'}{$ifIndex}{'ipv6'}; + + Debug("JunOS:: RPF int: $ifName IPv4: $hasIPv4 IPv6: $hasIPv6"); + + # PROG: Process IPv4 first ... + if( $hasIPv4 ) + { + $cb->addSubtree( $nodeRPF, 'IPv4_' . $ifNameT, + { 'comment' => $ifAlias, + 'ifAddrType' => "ipv4", + 'ifName' => $ifName, + 'ifNameT' => $ifNameT, + 'rpfIndex' => $ifIndex . "." . $hasIPv4 }, + [ 'JunOS::junos-rpf' ]); + } + + if( $hasIPv6 ) + { + $cb->addSubtree( $nodeRPF, 'IPv6_' . $ifNameT, + { 'comment' => $ifAlias, + 'ifAddrType' => "ipv6", + 'ifName' => $ifName, + 'ifNameT' => $ifNameT, + 'rpfIndex' => $ifIndex . "." . $hasIPv6 }, + [ 'JunOS::junos-rpf' ]); + } + } + } # END: if jnxRPF +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Liebert.pm b/torrus/perllib/Torrus/DevDiscover/Liebert.pm new file mode 100644 index 000000000..c8aa3d21b --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Liebert.pm @@ -0,0 +1,313 @@ +# +# Discovery module for Liebert HVAC systems +# +# 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: Liebert.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $ +# Jon Nistor <nistor at snickers.org> +# +# NOTE: Options for this module +# Liebert::use-fahrenheit +# Liebert::disable-temperature +# Liebert::disable-humidity +# Liebert::disable-state +# Liebert::disable-stats +# +# NOTE: This module supports both Fahrenheit and Celcius, but for ease of +# module and cleanliness we will convert Celcius into Fahrenheit +# instead of polling for Fahrenheit directly. +# + +# Liebert discovery module +package Torrus::DevDiscover::Liebert; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Liebert'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # LIEBERT-GP-REGISTRATION-MIB + 'GlobalProducts' => '1.3.6.1.4.1.476.1.42', + + # LIEBERT-GP-AGENT-MIB + 'Manufacturer' => '1.3.6.1.4.1.476.1.42.2.1.1.0', + 'Model' => '1.3.6.1.4.1.476.1.42.2.1.2.0', + 'FirmwareVer' => '1.3.6.1.4.1.476.1.42.2.1.3.0', + 'SerialNum' => '1.3.6.1.4.1.476.1.42.2.1.4.0', + 'PartNum' => '1.3.6.1.4.1.476.1.42.2.1.5.0', + + 'TemperatureIdDegF' => '1.3.6.1.4.1.476.1.42.3.4.1.2.3.1.1', + 'TemperatureIdDegC' => '1.3.6.1.4.1.476.1.42.3.4.1.3.3.1.1', + 'HumidityIdRel' => '1.3.6.1.4.1.476.1.42.3.4.2.2.3.1.1', + + 'lgpEnvState' => '1.3.6.1.4.1.476.1.42.3.4.3', + 'lgpEnvStateCoolingCapacity' => '1.3.6.1.4.1.476.1.42.3.4.3.9.0', + 'lgpEnvStatistics' => '1.3.6.1.4.1.476.1.42.3.4.6', + + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch ( 'GlobalProducts', + $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 $Info = $dd->retrieveSnmpOIDs ( 'Manufacturer', 'Model', + 'FirmwareVer', 'SerialNum', 'PartNum' ); + + # SNMP: System comment + $data->{'param'}{'comment'} = + $Info->{'Manufacturer'} . " " . $Info->{'Model'} . ", Version: " . + $Info->{'FirmwareVer'} . ", Serial: " . $Info->{'SerialNum'}; + + # The Liebert HVAC snmp implementation requires a lower number + # of pdu's to be sent to it. + $data->{'param'}{'snmp-oids-per-pdu'} = 10; + + # Temperature + if( $devdetails->param('Liebert::disable-temperature') ne 'yes' ) + { + $devdetails->setCap('env-temperature'); + + if( $devdetails->param('Liebert::use-fahrenheit') ne 'yes' ) + { + # ENV: Temperature in Celcius + my $idTable = $session->get_table( + -baseoid => $dd->oiddef('TemperatureIdDegC') ); + $devdetails->storeSnmpVars( $idTable ); + + if( defined( $idTable ) ) + { + $devdetails->setCap('env-temperature-celcius'); + + foreach my $index ( $devdetails->getSnmpIndices( + $dd->oiddef('TemperatureIdDegC') ) ) + { + Debug("Liebert: Temp (degC) index: $index"); + $data->{'liebert'}{'tempidx'}{$index} = "celcius"; + } + } + } else { + # ENV: Temperature in Fahrenheit + my $idTable = $session->get_table( + -baseoid => $dd->oiddef('TemperatureIdDegF') ); + $devdetails->storeSnmpVars( $idTable ); + + if( defined( $idTable ) ) + { + $devdetails->setCap('env-temperature-fahrenheit'); + + foreach my $index ( $devdetails->getSnmpIndices( + $dd->oiddef('TemperatureIdDegF') ) ) + { + Debug("Liebert: Temp (degF) index: $index"); + $data->{'liebert'}{'tempidx'}{$index} = "fahrenheit"; + } + } + } + } + + # ENV: Humidity + if( $devdetails->param('Liebert::disable-humidity') ne 'yes' ) + { + my $idTable = $session->get_table( + -baseoid => $dd->oiddef('HumidityIdRel') ); + $devdetails->storeSnmpVars( $idTable ); + + if( defined( $idTable ) ) + { + $devdetails->setCap('env-humidity'); + foreach my $index ( $devdetails->getSnmpIndices( + $dd->oiddef('HumidityIdRel') ) ) + { + Debug("Liebert: humidity index: $index"); + $data->{'liebert'}{'humididx'}{$index} = "humidity"; + } + } + } + + # ENV: State + if( $devdetails->param('Liebert::disable-state') ne 'yes' ) + { + my $stateTable = $session->get_table( + -baseoid => $dd->oiddef('lgpEnvState') ); + $devdetails->storeSnmpVars( $stateTable ); + + if( defined( $stateTable ) ) + { + $devdetails->setCap('env-state'); + + # PROG: Check to see if Firmware is new enough for Capacity + if( $dd->checkSnmpOID('lgpEnvStateCoolingCapacity') ) + { + $devdetails->setCap('env-state-capacity'); + } + } + } + + # Statistics + if( $devdetails->param('Liebert::disable-stats') ne 'yes' ) + { + my $statsTable = $session->get_table( + -baseoid => $dd->oiddef('lgpEnvStatistics') ); + $devdetails->storeSnmpVars( $statsTable ); + + if( defined( $statsTable ) ) + { + $devdetails->setCap('env-stats'); + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + if( $devdetails->hasCap('env-temperature') ) + { + # All place-setting variables default to Celcius + my @template; + my $dataFile = "%system-id%_temperature.rrd"; + my $fahrenheit = 0; + my $snmpVar = 3; + my $tempUnit = "C"; + my $tempScale = "Celcius"; + my $tempLowLim = 15; + my $tempUppLim = 70; + + if( $devdetails->hasCap('env-temperature-fahrenheit') ) + { + $dataFile = "%system-id%_temperature_f.rrd"; + $fahrenheit = 1; + $snmpVar = 2; + $tempUnit = "F"; + $tempScale = "Fahrenheit"; + $tempLowLim = $tempLowLim * 1.8 + 32; + $tempUppLim = $tempUppLim * 1.8 + 32; + push(@template, "Liebert::temperature-sensor-fahrenheit"); + } else { + push(@template, "Liebert::temperature-sensor"); + } + + my $paramSubTree = { + 'data-file' => $dataFile, + 'temp-idx' => $snmpVar, + 'temp-lower' => $tempLowLim, + 'temp-scale' => $tempUnit, + 'temp-upper' => $tempUppLim, + 'vertical-label' => "degrees $tempScale" + }; + my $nodeTemp = $cb->addSubtree( $devNode, 'Temperature', $paramSubTree, + [ 'Liebert::temperature-subtree' ] ); + + # ---------------------------------------------------------------- + # PROG: Figure out how many indexes we have + foreach my $index ( keys %{$data->{'liebert'}{'tempidx'}} ) + { + my $dataFile = "%system-id%_sensor_$index" . + ($fahrenheit ? '_fahrenheit':'') . ".rrd"; + Debug("Liebert: Temperature idx: $index : $tempScale"); + my $param = { + 'comment' => "Sensor: $index", + 'data-file' => $dataFile, + 'sensor-idx' => $index + }; + + $cb->addSubtree( $nodeTemp, 'sensor_' . $index, $param, + [ @template ] ); + } # END: foreach my $index + } # END: env-temperature + + + # Humidity + if( $devdetails->hasCap('env-humidity') ) + { + my $nodeHumidity = $cb->addSubtree( $devNode, "Humidity", undef, + [ 'Liebert::humidity-subtree' ] ); + + # PROG: Figure out how many sensors we have + foreach my $index ( keys %{$data->{'liebert'}{'humididx'}} ) + { + Debug("Liebert: Humidity idx: $index"); + + my $param = { + 'comment' => "Sensor: " . $index, + 'humid-idx' => $index + }; + + $cb->addSubtree( $nodeHumidity, 'sensor_' . $index, $param, + [ 'Liebert::humidity-sensor' ] ); + } + + } # END of hasCap + + + # State of the system + if( $devdetails->hasCap('env-state') ) + { + my $nodeState = $cb->addSubtree( $devNode, 'State', undef, + [ 'Liebert::state-subtree' ] ); + + if( $devdetails->hasCap('env-state-capacity') ) + { + $cb->addSubtree( $devNode, 'State', undef, + [ 'Liebert::state-capacity' ] ); + } + } +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm b/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm new file mode 100644 index 000000000..d924dc469 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm @@ -0,0 +1,181 @@ +# Copyright (C) 2003-2004 Stanislav Sinyagin, 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: MicrosoftWindows.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# MS Windows 2000/XP SNMP agent discovery. +# ifDescr does not give unique interace mapping, so MAC address mapping +# is used. + +package Torrus::DevDiscover::MicrosoftWindows; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'MicrosoftWindows'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # MSFT-MIB + 'windowsNT' => '1.3.6.1.4.1.311.1.1.3.1', + + # FtpServer-MIB + 'ms_ftpStatistics' => '1.3.6.1.4.1.311.1.7.2.1', + + # HttpServer-MIB + 'ms_httpStatistics' => '1.3.6.1.4.1.311.1.7.3.1', + ); + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::MicrosoftWindows::interfaceFilter +# or define $Torrus::DevDiscover::MicrosoftWindows::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %winNTInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%winNTInterfaceFilter; +} + + +# 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 +%winNTInterfaceFilter = + ( + 'MS TCP Loopback interface' => { + 'ifType' => 24 # softwareLoopback + }, + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'windowsNT', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + my $data = $devdetails->data(); + + &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(); + + # In Windows SNMP agent, ifDescr is not unique per interface. + # We use MAC address as a unique interface identifier. + + $data->{'nameref'}{'ifComment'} = ''; # suggest? + + $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC'; + Torrus::DevDiscover::RFC2863_IF_MIB::retrieveMacAddresses( $dd, + $devdetails ); + + $data->{'nameref'}{'ifNick'} = 'MAC'; + + # FTP and HTTP servers, if present + if( $dd->checkSnmpTable( 'ms_ftpStatistics' ) ) + { + $devdetails->setCap( 'msIIS' ); + $devdetails->setCap( 'msFtpStats' ); + } + + if( $dd->checkSnmpTable( 'ms_httpStatistics' ) ) + { + $devdetails->setCap( 'msIIS' ); + $devdetails->setCap( 'msHttpStats' ); + } + + return 1; +} + + +# Nothing really to do yet +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + if( $devdetails->hasCap( 'msIIS' ) ) + { + my $iisParam = { + 'precedence' => -100000, + 'comment' => 'Microsoft Internet Information Server' + }; + + my @iisTemplates; + if( $devdetails->hasCap( 'msFtpStats' ) ) + { + push( @iisTemplates, + 'MicrosoftWindows::microsoft-iis-ftp-stats' ); + } + if( $devdetails->hasCap( 'msHttpStats' ) ) + { + push( @iisTemplates, + 'MicrosoftWindows::microsoft-iis-http-stats' ); + } + + + my $iisNode = $cb->addSubtree( $devNode, 'MS_IIS', $iisParam, + \@iisTemplates ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm b/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm new file mode 100644 index 000000000..dd061d5a5 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm @@ -0,0 +1,213 @@ +# +# Discovery module for Motorola Broadband Services Router (formely Riverdelta) +# +# Copyright (C) 2006 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: MotorolaBSR.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $ +# + + +# Cisco SCE devices discovery +package Torrus::DevDiscover::MotorolaBSR; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'MotorolaBSR'} = { + '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 = + ( + 'rdnProducts' => '1.3.6.1.4.1.4981.4.1', + # RDN-CMTS-MIB + 'rdnCmtsUpstreamChannelTable' => '1.3.6.1.4.1.4981.2.1.2' + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'rdnProducts', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) or + not $devdetails->isDevType('RFC2670_DOCS_IF') ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX'; + Torrus::DevDiscover::RFC2863_IF_MIB::storeIfIndexParams( $devdetails ); + + if( $dd->checkSnmpTable( 'rdnCmtsUpstreamChannelTable' ) ) + { + $devdetails->setCap('rdnCmtsUpstreamChannelTable'); + + foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + push( @{$interface->{'docsTemplates'}}, + 'MotorolaBSR::motorola-bsr-docsis-upstream-util' ); + } + } + + return 1; +} + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + if( $devdetails->hasCap('rdnCmtsUpstreamChannelTable') and + scalar( @{$data->{'docsCableUpstream'}} ) > 0 ) + { + my $upstrNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{'docsCableUpstream'}{ + 'subtreeName'} ); + + 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 ); + + # Build All_Modems summary graph + + my $param = { + 'ds-type' => 'rrd-multigraph', + 'ds-names' => 'registered,unregistered,offline', + 'graph-lower-limit' => '0', + 'precedence' => '1000', + + 'vertical-label' => 'Modems', + 'descriptive-nickname' => '%system-id%: All modems', + + 'ds-expr-registered' => '{Modems_Registered}', + 'graph-legend-registered' => 'Registered', + 'line-style-registered' => 'AREA', + 'line-color-registered' => '##blue', + 'line-order-registered' => '1', + + 'ds-expr-unregistered' => '{Modems_Unregistered}', + 'graph-legend-unregistered' => 'Unregistered', + 'line-style-unregistered' => 'STACK', + 'line-color-unregistered' => '##crimson', + 'line-order-unregistered' => '2', + + 'ds-expr-offline' => '{Modems_Offline}', + 'graph-legend-offline' => 'Offline', + 'line-style-offline' => 'STACK', + 'line-color-offline' => '##silver', + 'line-order-offline' => '3', + }; + + $param->{'comment'} = + 'Registered, Unregistered and Offline modems on CMTS'; + + $param->{'nodeid'} = + $data->{'docsConfig'}{'docsCableUpstream'}{'nodeidCategory'} . + '//%nodeid-device%//modems'; + + my $first = 1; + foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + if( $first ) + { + $param->{'ds-expr-registered'} = + '{' . $intf . '/Modems_Registered}'; + $param->{'ds-expr-unregistered'} = + '{' . $intf . '/Modems_Unregistered}'; + $param->{'ds-expr-offline'} = + '{' . $intf . '/Modems_Offline}'; + $first = 0; + } + else + { + $param->{'ds-expr-registered'} .= + ',{' . $intf . '/Modems_Registered},+'; + $param->{'ds-expr-unregistered'} .= + ',{' . $intf . '/Modems_Unregistered},+'; + $param->{'ds-expr-offline'} .= + ',{' . $intf . '/Modems_Offline},+'; + } + } + + my $usNode = + $cb->getChildSubtree( $devNode, + $data->{'docsConfig'}{ + 'docsCableUpstream'}{ + 'subtreeName'} ); + if( defined( $usNode ) ) + { + $cb->addLeaf( $usNode, 'All_Modems', $param, [] ); + } + else + { + Error('Could not find the Upstream subtree'); + exit 1; + } + } +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/NetApp.pm b/torrus/perllib/Torrus/DevDiscover/NetApp.pm new file mode 100644 index 000000000..331680358 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/NetApp.pm @@ -0,0 +1,170 @@ +# Copyright (C) 2004 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: NetApp.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# NetApp.com storage products + +package Torrus::DevDiscover::NetApp; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'NetApp'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + 'netapp' => '1.3.6.1.4.1.789', + 'netapp1' => '1.3.6.1.4.1.789.1', + 'netappProducts' => '1.3.6.1.4.1.789.2', + + # netapp product + 'netapp_product' => '1.3.6.1.4.1.789.1.1', + 'netapp_productVersion' => '1.3.6.1.4.1.789.1.1.2.0', + 'netapp_productId' => '1.3.6.1.4.1.789.1.1.3.0', + 'netapp_productModel' => '1.3.6.1.4.1.789.1.1.5.0', + 'netapp_productFirmwareVersion' => '1.3.6.1.4.1.789.1.1.6.0', + + # netapp sysstat + 'netapp_sysStat' => '1.3.6.1.4.1.789.1.2', + 'netapp_sysStat_cpuCount' => '1.3.6.1.4.1.789.1.2.1.6.0', + + # netapp nfs + 'netapp_nfs' => '1.3.6.1.4.1.789.1.3', + 'netapp_nfsIsLicensed' => '1.3.6.1.4.1.789.1.3.3.1.0', + + # At a glance Lookup values seem to be the most common as opposed to + # collecting NFS stats for v2 and v3 (and eventually v4 ) if No lookups + # have been performed at discovery time we assume that vX is not in use. + 'netapp_tv2cLookups' => '1.3.6.1.4.1.789.1.3.2.2.3.1.5.0', + 'netapp_tv3cLookups' => '1.3.6.1.4.1.789.1.3.2.2.4.1.4.0', + + # netapp CIFS + 'netapp_cifs' => '1.3.6.1.4.1.789.1.7', + 'netapp_cifsIsLicensed' => '1.3.6.1.4.1.789.1.7.21.0', + + # 4 - 19 should also be interesting + # particularly cluster netcache stats + ); + +# netappFiler OBJECT IDENTIFIER ::= { netappProducts 1 } +# netappNetCache OBJECT IDENTIFIER ::= { netappProducts 2 } +# netappClusteredFiler OBJECT IDENTIFIER ::= { netappProducts 3 } + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + return $dd->checkSnmpTable( 'netapp' ); +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $result = $dd->retrieveSnmpOIDs + ( 'netapp_productModel', 'netapp_productId', + 'netapp_productVersion', 'netapp_productFirmwareVersion', + 'netapp_nfsIsLicensed', 'netapp_cifsIsLicensed', + 'netapp_tv2cLookups', 'netapp_tv3cLookups' ); + + $data->{'param'}->{'comment'} = + sprintf('%s %s: %s %s', + $result->{'netapp_productModel'}, + $result->{'netapp_productId'}, + $result->{'netapp_productVersion'}, + $result->{'netapp_productFirmwareVersion'}); + + # At a glance Lookup values seem to be the most common as opposed to + # collecting NFS stats for v2 and v3 (and eventually v4 ) if No lookups + # have been performed at discovery time we assume that nfsvX is not in use. + + if( $result->{'netapp_nfsIsLicensed'} == 2 ) + { + if( $result->{'netapp_tv2cLookups'} > 0 ) + { + $devdetails->setCap('NetApp::nfsv2'); + } + + if( $result->{'netapp_tv3cLookups'} > 0 ) + { + $devdetails->setCap('NetApp::nfsv3'); + } + } + + if( $result->{'netapp_cifsIsLicensed'} == 2 ) + { + $devdetails->setCap('NetApp::cifs'); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + $cb->addParams( $devNode, $data->{'params'} ); + + # Add CPU Template + $cb->addTemplateApplication( $devNode, 'NetApp::CPU'); + + # Add Misc Stats + $cb->addTemplateApplication( $devNode, 'NetApp::misc'); + + if( $devdetails->hasCap('NetApp::nfsv2') ) + { + $cb->addTemplateApplication( $devNode, 'NetApp::nfsv2'); + } + + if( $devdetails->hasCap('NetApp::nfsv3') ) + { + $cb->addTemplateApplication( $devNode, 'NetApp::nfsv3'); + } + + if( $devdetails->hasCap('NetApp::cifs') ) + { + Debug("Would add cifs here\n"); + #$cb->addTemplateApplication( $devNode, 'NetApp::cifs'); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/NetBotz.pm b/torrus/perllib/Torrus/DevDiscover/NetBotz.pm new file mode 100644 index 000000000..f91af5e25 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/NetBotz.pm @@ -0,0 +1,197 @@ +# 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., 675 Mass Ave, Cambridge, MA 02139, USA. + +# $Id: NetBotz.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ + +# NetBotz modular sensors + +package Torrus::DevDiscover::NetBotz; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'NetBotz'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + 'netBotzV2Products' => '1.3.6.1.4.1.5528.100.20', + ); + + +our %sensor_types = + ('temp' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.1.1.1', + 'template' => 'NetBotz::netbotz-temp-sensor', + 'max' => 'NetBotz::temp-max', + }, + 'humi' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.1.2.1', + 'template' => 'NetBotz::netbotz-humi-sensor', + 'max' => 'NetBotz::humi-max', + }, + 'dew' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.1.3.1', + 'template' => 'NetBotz::netbotz-dew-sensor', + 'max' => 'NetBotz::dew-max', + }, + 'audio' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.1.4.1', + 'template' => 'NetBotz::netbotz-audio-sensor' + }, + 'air' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.1.5.1', + 'template' => 'NetBotz::netbotz-air-sensor' + }, + 'door' => { + 'oid' => '1.3.6.1.4.1.5528.100.4.2.2.1', + 'template' => 'NetBotz::netbotz-door-sensor' + }, + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'netBotzV2Products', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + foreach my $stype (sort keys %sensor_types) + { + my $oid = $sensor_types{$stype}{'oid'}; + + my $sensorTable = $session->get_table( -baseoid => $oid ); + + if( defined( $sensorTable ) ) + { + $devdetails->storeSnmpVars( $sensorTable ); + + # store the sensor names to guarantee uniqueness + my %sensorNames; + + foreach my $INDEX ($devdetails->getSnmpIndices($oid . '.1')) + { + my $label = $devdetails->snmpVar( $oid . '.4.' . $INDEX ); + + if( $sensorNames{$label} ) + { + Warn('Duplicate sensor names: ' . $label); + $sensorNames{$label}++; + } + else + { + $sensorNames{$label} = 1; + } + + if( $sensorNames{$label} > 1 ) + { + $label .= sprintf(' %d', $sensorNames{$label}); + } + + my $leafName = $label; + $leafName =~ s/\W/_/g; + + my $param = { + 'netbotz-sensor-index' => $INDEX, + 'node-display-name' => $label, + 'graph-title' => $label, + 'precedence' => sprintf('%d', 1000 - $INDEX) + }; + + if( defined( $sensor_types{$stype}{'max'} ) ) + { + my $max = + $devdetails->param($sensor_types{$stype}{'max'}); + + if( defined($max) and $max > 0 ) + { + $param->{'upper-limit'} = $max; + } + } + + + $data->{'NetBotz'}{$INDEX} = { + 'param' => $param, + 'leafName' => $leafName, + 'template' => $sensor_types{$stype}{'template'}}; + } + } + } + + if( not defined($data->{'param'}{'comment'}) or + length($data->{'param'}{'comment'}) == 0 ) + { + $data->{'param'}{'comment'} = 'NetBotz environment sensors'; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'NetBotz'}} ) + { + my $ref = $data->{'NetBotz'}{$INDEX}; + + $cb->addLeaf( $devNode, $ref->{'leafName'}, $ref->{'param'}, + [$ref->{'template'}] ); + } +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/NetScreen.pm b/torrus/perllib/Torrus/DevDiscover/NetScreen.pm new file mode 100644 index 000000000..9541daa6c --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/NetScreen.pm @@ -0,0 +1,152 @@ +# 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: NetScreen.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# NetScreen + +package Torrus::DevDiscover::NetScreen; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'NetScreen'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + 'netscreen' => '1.3.6.1.4.1.3224', + 'nsResSessMaxium' => '1.3.6.1.4.1.3224.16.3.3.0', + 'nsIfFlowTable' => '1.3.6.1.4.1.3224.9.3', + + 'nsIfMonTable' => '1.3.6.1.4.1.3224.9.4', + 'nsIfMonIfIdx' => '1.3.6.1.4.1.3224.9.4.1.1', + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->checkSnmpTable( 'netscreen' ) ) + { + return 0; + } + + my $data = $devdetails->data(); + + $devdetails->setCap('interfaceIndexingManaged'); + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + $data->{'nameref'}{'ifDescr'} = ''; + $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC'; + Torrus::DevDiscover::RFC2863_IF_MIB::retrieveMacAddresses( $dd, + $devdetails ); + + # TODO: do something about these tables in buildConfig + + if( $dd->checkSnmpTable( 'nsIfFlowTable' ) ) + { + $devdetails->setCap('nsIfFlowTable'); + } + + if( $dd->checkSnmpTable( 'nsIfMonTable' ) ) + { + $devdetails->setCap('nsIfMonTable'); + } + + if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) ) + { + my $oidsPerPDU = $devdetails->param('NetScreen::snmp-oids-per-pdu'); + if( $oidsPerPDU == 0 ) + { + $oidsPerPDU = 10; + } + Debug("Setting snmp-oids-per-pdu to $oidsPerPDU"); + $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU; + } + + my $result = $dd->retrieveSnmpOIDs('nsResSessMaxium'); + if( defined($result) and $result->{'nsResSessMaxium'} > 0 ) + { + $devdetails->setCap('NetScreen::SessMax'); + + my $param = {}; + my $max = $result->{'nsResSessMaxium'}; + + $param->{'hrule-value-max'} = $max; + $param->{'hrule-legend-max'} = 'Maximum Sessions'; + # upper limit of graph is 5% higher than max sessions + $param->{'graph-upper-limit'} = + sprintf('%e', + ( $max * 5 / 100 ) + $max ); + + $data->{'netScreenSessions'} = { + 'param' => $param, + }; + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + + { #Allocated Sessions + + my $ref = $data->{'netScreenSessions'}; + + $cb->addSubtree( $devNode, "NetScreen_Sessions", $ref->{'param'}, + [ 'NetScreen::netscreen-sessions-stats' ] ); + + } + + $cb->addTemplateApplication($devNode, 'NetScreen::netscreen-cpu-stats'); + $cb->addTemplateApplication($devNode, 'NetScreen::netscreen-memory-stats'); +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm b/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm new file mode 100644 index 000000000..313c73e5c --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm @@ -0,0 +1,395 @@ +# 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: OracleDatabase.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# Oracle Database MIB + +package Torrus::DevDiscover::OracleDatabase; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'OracleDatabase'} = { + 'sequence' => 600, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # Oracle Database + 'oraDb' => '1.3.6.1.4.1.111.4.1', + + 'oraDbConfigDbBlockSize' => '1.3.6.1.4.1.111.4.1.7.1.3', + + 'oraDbSysTable' => '1.3.6.1.4.1.111.4.1.1.1', + + 'oraDbTablespace' => '1.3.6.1.4.1.111.4.1.2.1', + 'oraDbTablespaceIndex' => '1.3.6.1.4.1.111.4.1.2.1.1', + 'oraDbTablespaceName' => '1.3.6.1.4.1.111.4.1.2.1.2', + + 'oraDbDataFile' => '1.3.6.1.4.1.111.4.1.3.1', + 'oraDbDataFileIndex' => '1.3.6.1.4.1.111.4.1.3.1.1', + 'oraDbDataFileName' => '1.3.6.1.4.1.111.4.1.3.1.2', + + 'oraDbLibraryCache' => '1.3.6.1.4.1.111.4.1.4.1', + 'oraDbLibraryCacheIndex' => '1.3.6.1.4.1.111.4.1.4.1.1', + 'oraDbLibraryCacheNameSpace' => '1.3.6.1.4.1.111.4.1.4.1.2', + + 'oraDbLibraryCacheSumTable' => '1.3.6.1.4.1.111.4.1.5.1', + + 'oraDbSGATable' => '1.3.6.1.4.1.111.4.1.6.1', + + ); + +my $DbInfoSizeUnits = +{ + 1 => '1', # bytes + 2 => '1024', # kbytes + 3 => '1048576', # mbytes + 4 => '1073741824', # gbytes + 5 => '1099511627776', # tbytes +}; + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + return $dd->checkSnmpTable('oraDb'); +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) ) + { + $data->{'param'}{'snmp-oids-per-pdu'} = '10'; + } + + my $dbType = $data->{'ora'}; + + # my $oraTableSpaceCols = ( + # $dd->oiddef('oraDbTablespaceIndex'), + # $dd->oiddef('oraDbTablespaceName'), + # ); + + # my $oraTableSpace = $session->get_entries( -columns => [ + # $dd->oiddef('oraDbTablespaceIndex'), + # $dd->oiddef('oraDbTablespaceName'), + # ], ); + + my $oraTableSpace = $session->get_table( -baseoid => + $dd->oiddef('oraDbTablespace'), + ); + + + if( defined($oraTableSpace) ) + { + $devdetails->setCap('oraTableSpace'); + $devdetails->storeSnmpVars($oraTableSpace); + + } + + ## + + # my @oraDbDataFileCols = ( + # $dd->oiddef('oraDbDataFileIndex'), + # $dd->oiddef('oraDbDataFileName'), + # ); + + # my $oraDbDataFile = $session->get_entries( -columns => [ + # @oraDbDataFileCols ], ); + + my $oraDbDataFile = + $session->get_table( -baseoid => $dd->oiddef('oraDbDataFile') ); + + if( defined($oraDbDataFile) ) + { + $devdetails->setCap('oraDbDataFile'); + $devdetails->storeSnmpVars($oraDbDataFile); + } + + ## + + # my @oraDbLibraryCacheCols = ( + # $dd->oiddef('oraDbLibraryCacheIndex'), + # $dd->oiddef('oraDbLibraryCacheNameSpace'), + # ); + + # my $oraDbLibraryCache = $session->get_entries( -columns => [ + # @oraDbLibraryCacheCols ], ); + + my $oraDbLibraryCache = + $session->get_table( -baseoid => $dd->oiddef('oraDbLibraryCache') ); + + if( defined($oraDbLibraryCache) ) + { + $devdetails->setCap('oraDbLibraryCache'); + $devdetails->storeSnmpVars($oraDbLibraryCache); + } + + Debug("Looking For dbNames"); + + foreach my $dbName ( keys %{ $dbType } ) + { + Debug("DBName: $dbName"); + + my $dbIndex = $dbType->{$dbName}->{'index'}; + Debug("DBIndex: $dbIndex"); + + my $db = {}; + $dbType->{$dbName} = $db; + + my $oid = $dd->oiddef('oraDbConfigDbBlockSize') . '.' . $dbIndex; + my $result = $session->get_request( -varbindlist => [ $oid ] ); + + + if( $session->error_status() == 0 and $result->{$oid} > 0 ) + { + my $blocksize = $result->{$oid}; + $dbType->{$dbName}->{'dbBlockSize'} = $blocksize; + Debug("DB Block Size: $blocksize"); + } + Debug($session->error()); + + if( $devdetails->hasCap('oraTableSpace') ) + { + my $ref = {}; + $db->{'oraTableSpace'} = $ref; + + # Table Space + foreach my $tsIndex + ( $devdetails-> + getSnmpIndices( $dd->oiddef('oraDbTablespaceIndex') . + '.' . $dbIndex ) ) + { + my $tsName = + $devdetails->snmpVar( $dd->oiddef('oraDbTablespaceName') . + '.' . $dbIndex . '.' . $tsIndex ); + + $ref->{$tsName} = $tsIndex; + } + } + + if( $devdetails->hasCap('oraDbDataFile') ) + { + my $ref = {}; + $db->{'oraDbDataFile'} = $ref; + + # Data File + foreach my $dfIndex + ( $devdetails-> + getSnmpIndices( $dd->oiddef('oraDbDataFileIndex') . + '.' . $dbIndex ) ) + { + my $dfName = + $devdetails->snmpVar( $dd->oiddef('oraDbDataFileName') . + '.' . $dbIndex . '.' . $dfIndex ); + + $ref->{$dfName} = $dfIndex; + } + } + + if( $devdetails->hasCap('oraDbLibraryCache') ) + { + my $ref = {}; + $db->{'oraDbLibraryCache'} = $ref; + + # Library Cache + foreach my $lcIndex + ( $devdetails-> + getSnmpIndices( $dd->oiddef('oraDbLibraryCacheIndex') . + '.' . $dbIndex ) ) + { + my $lcName = + $devdetails-> + snmpVar( $dd->oiddef('oraDbLibraryCacheNameSpace') . + '.' . $dbIndex . '.' . $lcIndex ); + + $ref->{$lcName} = $lcIndex; + } + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + my $dbType = $data->{'ora'}; + + my $appNode = $cb->addSubtree($devNode, 'Applications' ); + my $vendorNode = $cb->addSubtree($appNode, 'Oracle' ); + + foreach my $dbName ( keys %{ $dbType } ) + { + my $db = $dbType->{$dbName}; + my $dbIndex = $dbType->{$dbName}->{'index'}; + my $dbBlockSize = $dbType->{$dbName}->{'dbBlockSize'}; + + my $dbNick = $dbName; + $dbNick =~ s/^\///; + $dbNick =~ s/\W/_/g; + $dbNick =~ s/_+/_/g; + + my $dbParam = { + 'dbName' => $dbName, + 'precedence' => sprintf("%d", 10000 - $dbIndex), + 'vendor' => 'Oracle', + 'dbNick' => $dbNick, + }; + + my @dbTemplates = ( + 'OracleDatabase::Sys', + 'OracleDatabase::CacheSum', + 'OracleDatabase::SGA', + ); + + my $dbNode = $cb->addSubtree($vendorNode, "Vendor_Oracle_DB_$dbNick", + $dbParam, [ @dbTemplates ] ); + + if( $devdetails->hasCap('oraTableSpace') ) + { + my $tsParam = { + 'comment' => "Table space for $dbName", + 'precedence' => "600", + }; + + my $tsNode = $cb->addSubtree($dbNode, 'Table_Space', $tsParam ); + + foreach my $tsName ( keys %{ $db->{'oraTableSpace'} } ) + { + my $INDEX = $db->{'oraTableSpace'}->{$tsName}; + + my $nick = $tsName; + $nick =~ s/^\///; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $title = '%system-id%' . " $dbName $tsName"; + + my $tsParam = { + 'comment' => "Table Space: $tsName", + 'precedence' => sprintf("%d", 10000 - $INDEX), + 'table-space-nick' => $nick, + 'table-space-name' => $tsName, + 'graph-title' => $title, + 'descriptive-nickname' => $title, + }; + + $cb->addSubtree( $tsNode, $nick, $tsParam, + [ 'OracleDatabase::table-space' ] ); + Debug("Will add TableSpace: $tsName"); + } + } + + if( $devdetails->hasCap('oraDbDataFile') ) + { + my $dfParam = { + 'comment' => "Data Files for $dbName", + 'precedence' => "500", + }; + + my $dfNode = $cb->addSubtree($dbNode, 'Data_Files', $dfParam ); + + foreach my $dfName ( keys %{ $db->{'oraDbDataFile'} } ) + { + my $INDEX = $db->{'oraDbDataFile'}->{$dfName}; + + my $nick = $dfName; + $nick =~ s/^\///; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $title = '%system-id%' . " $dbName $dfName"; + + + my $dfParam = { + 'comment' => "Data File: $dfName", + 'precedence' => sprintf("%d", 10000 - $INDEX), + 'data-file-nick' => $nick, + 'data-file-name' => $dfName, + 'graph-title' => $title, + 'dbBlockSize' => $dbBlockSize, + }; + + $cb->addSubtree( $dfNode, $nick, $dfParam, + ['OracleDatabase::data-file' ] ); + Debug("Will add DataFile: $dfName"); + } + } + + if( $devdetails->hasCap('oraDbLibraryCache') ) + { + my $lcParam = { + 'comment' => "Library Cache for $dbName", + 'precedence' => "400", + }; + + my $lcNode = $cb->addSubtree($dbNode, 'Library_Cache', $lcParam ); + + foreach my $lcName ( keys %{ $db->{'oraDbLibraryCache'} } ) + { + my $INDEX = $db->{'oraDbLibraryCache'}->{$lcName}; + + my $nick = $lcName; + $nick =~ s/^\///; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $title = '%system-id%' . " $dbName $lcName"; + + my $lcParam = { + 'comment' => "Library Cache: $lcName", + 'precedence' => sprintf("%d", 10000 - $INDEX), + 'library-cache-nick' => $nick, + 'library-cache-name' => $lcName, + 'graph-title' => $title, + }; + + $cb->addSubtree( $lcNode, $nick, $lcParam, + ['OracleDatabase::library-cache'] ); + Debug("Will add LibraryCache: $lcName"); + } + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Paradyne.pm b/torrus/perllib/Torrus/DevDiscover/Paradyne.pm new file mode 100644 index 000000000..5e45f1782 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Paradyne.pm @@ -0,0 +1,200 @@ +# 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: Paradyne.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Paradyne devices discovery +# A typical Paradyne device has several slots, and all slots are managed +# through the same IP address, with different community strings. +# That's why you have to configure "Paradyne::slot-name" parameter +# in your discovery file, uniquely for each slot. A slot name should +# not contain special characters. + + +# Tested with: +# +# - Paradyne GranDSLAM 2.0 DSLAM - Hotwire DSL; +# Model: 8000-B2-211; S/W Release : M04.02.27 +# +# - Paradyne Hotwire ATM ADSL Line Card; +# Model: 8365-B1-000; S/W Release: 02.03.54 +# +# - Paradyne Hotwire ATM G.SHDSL Line Card; +# Model: 8385-B1-000; S/W Release: 02.03.45 +# +# - Hotwire IP ReachDSL Line Card; +# Model: 8314-B3-000; S/W Release: 04.03.10 + + +package Torrus::DevDiscover::Paradyne; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Paradyne'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # PDN-HEADER-MIB + 'paradyne-products' => '1.3.6.1.4.1.1795.1.14', + 'xdslDevIfStatsElapsedTimeLinkUp' => + '1.3.6.1.4.1.1795.2.24.2.6.8.1.1.1.1.4' + ); + +our $statsInterval; +if( not defined $statsInterval ) +{ + $statsInterval = 6; # current15Minutes (GORD) +} + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'paradyne-products', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + if( length( $devdetails->param('Paradyne::slot-name') ) == 0 ) + { + Error('Mandatory discovery parameter "Paradyne::slot-number" ' . + 'is not defined for a Paradyne device: ' . + $devdetails->param('snmp-host') . ':' . + $devdetails->param('snmp-port') . ':' . + $devdetails->param('snmp-community')); + return 0; + } + + $devdetails->setCap('interfaceIndexingManaged'); + + return 1; +} + + +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'; + $data->{'nameref'}{'ifNick'} = 'ParadyneIfNick'; + + $data->{'nameref'}{'ifComment'} = 'ifDescr'; + + if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) ) + { + $data->{'param'}{'snmp-oids-per-pdu'} = '10'; + } + + my $slot = $devdetails->param('Paradyne::slot-name'); + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + $interface->{'ParadyneIfNick'} = + $slot . '_' . $interface->{'ifNameT'}; + } + + my $xdslOID = $dd->oiddef('xdslDevIfStatsElapsedTimeLinkUp'); + + my $xdslTable = $session->get_table( -baseoid => $xdslOID ); + if( defined $xdslTable ) + { + $devdetails->storeSnmpVars( $xdslTable ); + $devdetails->setCap('paradyneXDSL'); + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + if( $devdetails->hasOID( $xdslOID .'.'. $ifIndex .'.'. + $statsInterval ) ) + { + push( @{$data->{'paradyneXDSLInterfaces'}}, $ifIndex ); + } + } + } + + return 1; +} + + +# Nothing really to do yet +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + if( $devdetails->hasCap('paradyneXDSL') ) + { + my $subtreeName = 'XDSL_Line_Stats'; + + my $param = { + 'precedence' => '-600', + 'comment' => 'Paradyne XDSL line statistics', + 'xdsl-stats-interval' => $statsInterval + }; + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $param ); + + my $data = $devdetails->data(); + + foreach my $ifIndex + ( sort {$a<=>$b} @{$data->{'paradyneXDSLInterfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $ifSubtreeName = + $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $templates = ['Paradyne::paradyne-xdsl-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/RFC1628_UPS_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm new file mode 100644 index 000000000..890843f47 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm @@ -0,0 +1,180 @@ +# 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: RFC1628_UPS_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $ +# Jon Nistor <nistor at snickers dot org> + +# Discovery module for UPS-MIB (RFC 1628) +# +# Tested with: +# ConnectUPS Web/SNMP Card V4.20 [powerware 9390] +# +# Issues with: +# ConnectUPS Web/SNMP Card V3.16 [powerware 9155] +# - InputFrequency and InputTruePower are missing from RFC UPS-MIB +# + +package Torrus::DevDiscover::RFC1628_UPS_MIB; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC1628_UPS_MIB'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # UPS-MIB + 'upsIdent' => '1.3.6.1.2.1.33.1.1', + 'upsIdentManufacturer' => '1.3.6.1.2.1.33.1.1.1.0', + 'upsIdentModel' => '1.3.6.1.2.1.33.1.1.2.0', + 'upsIdentUPSSoftwareVersion' => '1.3.6.1.2.1.33.1.1.3.0', + 'upsIdentAgentSoftwareVersion' => '1.3.6.1.2.1.33.1.1.4.0', + 'upsIdentName' => '1.3.6.1.2.1.33.1.1.5.0', + + 'upsInputNumLines' => '1.3.6.1.2.1.33.1.3.2.0', + 'upsOutputNumLines' => '1.3.6.1.2.1.33.1.4.3.0', + 'upsBypassNumLines' => '1.3.6.1.2.1.33.1.5.2.0' + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + return $dd->checkSnmpTable( 'upsIdent' ); +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + my $upsInfo = $dd->retrieveSnmpOIDs('upsIdentManufacturer', + 'upsIdentModel', 'upsIdentUPSSoftwareVersion', + 'upsIdentAgentSoftwareVersion', 'upsIdentName', + 'upsInputNumLines', 'upsOutputNumLines', 'upsBypassNumLines'); + + $data->{'param'}{'comment'} = $upsInfo->{'upsIdentManufacturer'} . " " . + $upsInfo->{'upsIdentModel'} . " " . + $upsInfo->{'upsIdentUPSSoftwareVersion'}; + + # PROG: Discover number of lines (in,out,bypass)... + $data->{'numInput'} = $upsInfo->{'upsInputNumLines'}; + $data->{'numOutput'} = $upsInfo->{'upsOutputNumLines'}; + $data->{'numBypass'} = $upsInfo->{'upsBypassNumLines'}; + + Debug("UPS Lines Input: " . $data->{'numInput'} . + ", Output: " . $data->{'numOutput'} . + ", Bypass: " . $data->{'numBypass'} ); + + if( $devdetails->param('RFC1628_UPS::disable-input') ne 'yes' ) + { + $devdetails->setCap('UPS-input'); + } + + if( $devdetails->param('RFC1628_UPS::disable-output') ne 'yes' ) + { + $devdetails->setCap('UPS-output'); + } + + if( $devdetails->param('RFC1628_UPS::disable-bypass') ne 'yes' ) + { + $devdetails->setCap('UPS-bypass'); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + # PROG: Add static battery information + $cb->addSubtree( $devNode, 'Battery', + { 'precedence' => 999 }, + [ 'RFC1628_UPS_MIB::battery-subtree' ] ); + + if( $devdetails->hasCap('UPS-input') ) + { + my $nodeInput = $cb->addSubtree( $devNode, 'Input', + { 'comment' => 'Input feeds' }, + [ 'RFC1628_UPS_MIB::ups-input-subtree' ] ); + + foreach my $INDEX ( 1 .. $data->{'numInput'} ) + { + $cb->addSubtree( $nodeInput, sprintf('Phase_%d', $INDEX), + { 'ups-input-idx' => $INDEX }, + [ 'RFC1628_UPS::ups-input-leaf' ] ); + } + } + + if( $devdetails->hasCap('UPS-output') ) + { + my $nodeOutput = $cb->addSubtree( $devNode, 'Output', + { 'comment' => 'Output feeds' }, + [ 'RFC1628_UPS_MIB::ups-output-subtree' ] ); + + foreach my $INDEX ( 1 .. $data->{'numOutput'} ) + { + $cb->addSubtree( $nodeOutput, sprintf('Phase_%d', $INDEX), + { 'ups-output-idx' => $INDEX }, + [ 'RFC1628_UPS::ups-output-leaf' ] ); + } + } + + if( $devdetails->hasCap('UPS-bypass') ) + { + my $nodeBypass = $cb->addSubtree( $devNode, 'Bypass', + { 'comment' => 'Bypass feeds' }, + [ 'RFC1628_UPS_MIB::ups-bypass-subtree' ] ); + + foreach my $INDEX ( 1 .. $data->{'numBypass'} ) + { + $cb->addSubtree( $nodeBypass, sprintf('Phase_%d', $INDEX), + { 'ups-bypass-idx' => $INDEX }, + [ 'RFC1628_UPS::ups-bypass-leaf' ] ); + } + } + +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm new file mode 100644 index 000000000..c0a80399e --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm @@ -0,0 +1,85 @@ +# 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: RFC1657_BGP4_MIB.pm,v 1.1 2010-12-27 00:03:54 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Discovery module for BGP4-MIB (RFC 1657) +# This module does not generate any XML, but provides information +# for other discovery modules. For the sake of discovery time and traffic, +# it is not implicitly executed during the normal discovery process. + +package Torrus::DevDiscover::RFC1657_BGP4_MIB; + +use strict; +use Torrus::Log; + + +our %oiddef = + ( + # BGP4-MIB + 'bgpPeerRemoteAs' => '1.3.6.1.2.1.15.3.1.9', + ); + + + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + my $table = $session->get_table( -baseoid => + $dd->oiddef('bgpPeerRemoteAs')); + + if( not defined( $table ) or scalar( %{$table} ) == 0 ) + { + return 0; + } + + $devdetails->storeSnmpVars( $table ); + $devdetails->setCap('bgpPeerTable'); + + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('bgpPeerRemoteAs') ) ) + { + my $ipAddr = $INDEX; + + my $asNum = + $devdetails->snmpVar($dd->oiddef('bgpPeerRemoteAs') . + '.' . $INDEX); + + $data->{'bgpPeerAS'}{$ipAddr} = $asNum; + } + + return 1; +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm b/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm new file mode 100644 index 000000000..56d348f6e --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm @@ -0,0 +1,241 @@ +# 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: RFC1697_RDBMS.pm,v 1.1 2010-12-27 00:03:52 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# RDBMS MIB + +package Torrus::DevDiscover::RFC1697_RDBMS; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC1697_RDBMS'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # RDBMS-MIB + 'rdbms' => '1.3.6.1.2.1.39', + + 'rdbmsDbTable' => '1.3.6.1.2.1.39.1.1.1', + 'rdbmsDbIndex' => '1.3.6.1.2.1.39.1.1.1.1', + 'rdbmsDbVendorName' => '1.3.6.1.2.1.39.1.1.1.3', + 'rdbmsDbName' => '1.3.6.1.2.1.39.1.1.1.4', + 'rdbmsDbContact' => '1.3.6.1.2.1.39.1.1.1.5', + 'rdbmsDbPrivateMIBOID' => '1.3.6.1.2.1.39.1.1.1.2', + + 'rdbmsDbInfoTable' => '1.3.6.1.2.1.39.1.2.1', + 'rdbmsDbInfoProductName' => '1.3.6.1.2.1.39.1.2.1.1', + 'rdbmsDbInfoVersion' => '1.3.6.1.2.1.39.1.2.1.2', + 'rdbmsDbInfoSizeUnits' => '1.3.6.1.2.1.39.1.2.1.3', + + # currently ignored, generally identical to rdbmsDb for oracle + 'rdbmsSrvTable' => '1.3.6.1.2.1.39.1.5.1', + 'rdbmsSrvVendorName' => '1.3.6.1.2.1.39.1.5.1.2', + 'rdbmsSrvProductName' => '1.3.6.1.2.1.39.1.5.1.3', + 'rdbmsSrvContact' => '1.3.6.1.2.1.39.1.5.1.4', + 'rdbmsSrvPrivateMIBOID' => '1.3.6.1.2.1.39.1.5.1.1', + + # Oracle MIB base + 'ora' => '1.3.6.1.4.1.111', + + ); + + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + return $dd->checkSnmpTable('rdbms'); +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $DbInfoSizeUnits = { + 1 => '1', # bytes + 2 => '1024', # kbytes + 3 => '1048576', # mbytes + 4 => '1073741824', # gbytes + 5 => '1099511627776', # tbytes + }; + + my $dbTypes = { + ora => $dd->oiddef('ora'), + }; + + + my $rdbmsDbTable = $session->get_table( -baseoid => + $dd->oiddef('rdbmsDbTable') ); + + my $rdbmsDbInfoTable = + $session->get_table( -baseoid => + $dd->oiddef('rdbmsDbInfoTable') ); + + if( defined( $rdbmsDbTable ) ) + { + $devdetails->storeSnmpVars($rdbmsDbTable); + $devdetails->setCap('RDBMS::DbTable'); + + if( defined( $rdbmsDbInfoTable ) ) + { + $devdetails->storeSnmpVars($rdbmsDbInfoTable); + $devdetails->setCap('RDBMS::DbInfoTable'); + } + else + { + Debug("No Actively Opened Instances"); + } + + my $ref = {}; + $ref->{'indices'} = []; + $data->{'DbTable'} = $ref; + + foreach my $INDEX + ( $devdetails->getSnmpIndices( $dd->oiddef('rdbmsDbIndex') ) ) + { + + push( @{$ref->{'indices'}}, $INDEX ); + + my $vendor = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbVendorName') . + '.' . $INDEX ); + + my $product = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoProductName') . + '.' . $INDEX ); + + my $version = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoVersion') . + '.' . $INDEX ); + + my $sizeUnits = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoSizeUnits') . + '.' . $INDEX ); + $sizeUnits = $DbInfoSizeUnits->{$sizeUnits}; + + my $dbName = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbName') . + '.' . $INDEX ); + + my $dbContact = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbContact') . + '.' . $INDEX ); + + my $dbMIBOID = + $devdetails->snmpVar( $dd->oiddef('rdbmsDbPrivateMIBOID') + . '.' . $INDEX ); + + my $nick = "Vendor_" . $vendor . "_DB_" . $dbName; + $nick =~ s/^\///; + $nick =~ s/\W/_/g; + $nick =~ s/_+/_/g; + + my $descr = "Vendor: $vendor DB: $dbName"; + $descr .= " Contact: $dbContact" if $dbContact; + $descr .= " Version: $version" if $version; + + my $param = {}; + $ref->{$INDEX}->{'param'} = $param; + $param->{'vendor'} = $vendor; + $param->{'product'} = $product; + $param->{'dbVersion'} = $version; + $param->{'dbSizeUnits'} = $sizeUnits; + $param->{'dbName'} = $dbName; + $param->{'dbMIBOID'} = $dbMIBOID; + $param->{'nick'} = $nick; + $param->{'comment'} = $descr; + $param->{'precedence'} = 1000 - $INDEX; + + foreach my $dbType ( keys %{ $dbTypes } ) + { + if( Net::SNMP::oid_base_match + ( $dbTypes->{$dbType}, $dbMIBOID ) ) + { + if( not exists $data->{$dbType} ) + { + $data->{$dbType} = {}; + } + $data->{$dbType}->{$dbName}->{'index'} = $INDEX; + Debug(" Added $dbName -> $INDEX to $dbType "); + last; + } + } + + } + + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + return unless $devdetails->isDevType("RDBMS"); + + my $appParam = { + 'precedence' => -100000, + }; + + my $appNode = $cb->addSubtree( $devNode, 'Applications', $appParam ); + + my $param = { }; + my $oraNode = $cb->addSubtree( $appNode, 'Oracle', $param ); + + if( $devdetails->hasCap('RDBMS::DbTable') ) + { + my $ref = $data->{'DbTable'}; + + foreach my $INDEX ( @{ $ref->{'indices'} } ) + { + my $param = $ref->{$INDEX}->{'param'}; + $cb->addSubtree( $oraNode, $param->{'nick'}, $param, + [ 'RFC1697_RDBMS::rdbms-dbtable' ], ); + } + + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm new file mode 100644 index 000000000..c7745b5e6 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm @@ -0,0 +1,94 @@ +# 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: RFC2011_IP_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Discovery module for IP-MIB (RFC 2011) +# This module does not generate any XML, but provides information +# for other discovery modules. For the sake of discovery time and traffic, +# it is not implicitly executed during the normal discovery process. + +package Torrus::DevDiscover::RFC2011_IP_MIB; + +use strict; +use Torrus::Log; + + +our %oiddef = + ( + # IP-MIB + 'ipNetToMediaTable' => '1.3.6.1.2.1.4.22', + 'ipNetToMediaPhysAddress' => '1.3.6.1.2.1.4.22.1.2', + ); + + + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + my $table = $session->get_table( -baseoid => + $dd->oiddef('ipNetToMediaPhysAddress')); + + if( not defined( $table ) or scalar( %{$table} ) == 0 ) + { + return 0; + } + + $devdetails->storeSnmpVars( $table ); + + foreach my $INDEX + ( $devdetails-> + getSnmpIndices( $dd->oiddef('ipNetToMediaPhysAddress') ) ) + { + my( $ifIndex, @ipAddrOctets ) = split( '\.', $INDEX ); + my $ipAddr = join('.', @ipAddrOctets); + + my $interface = $data->{'interfaces'}{$ifIndex}; + next if not defined( $interface ); + + my $phyAddr = + $devdetails->snmpVar($dd->oiddef('ipNetToMediaPhysAddress') . + '.' . $INDEX); + + $interface->{'ipNetToMedia'}{$ipAddr} = $phyAddr; + $interface->{'mediaToIpNet'}{$phyAddr} = $ipAddr; + + # Cisco routers assign ARP to subinterfaces, but MAC accounting + # to main interfaces. Let them search in a global table + $data->{'ipNetToMedia'}{$ipAddr} = $phyAddr; + $data->{'mediaToIpNet'}{$phyAddr} = $ipAddr; + } + + return 1; +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm b/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm new file mode 100644 index 000000000..1c69714ea --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm @@ -0,0 +1,140 @@ +# 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: RFC2662_ADSL_LINE.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# ADSL Line statistics. + +# We assume that adslAturPhysTable is always present when adslAtucPhysTable +# is there. Probably that's wrong, and needs to be redesigned. + +package Torrus::DevDiscover::RFC2662_ADSL_LINE; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC2662_ADSL_LINE'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # ADSL-LINE-MIB + 'adslAtucPhysTable' => '1.3.6.1.2.1.10.94.1.1.2', + 'adslAtucCurrSnrMgn' => '1.3.6.1.2.1.10.94.1.1.2.1.4', + 'adslAturPhysTable' => '1.3.6.1.2.1.10.94.1.1.3' + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $atucTable = + $session->get_table( -baseoid => $dd->oiddef('adslAtucPhysTable') ); + if( not defined $atucTable ) + { + return 0; + } + $devdetails->storeSnmpVars( $atucTable ); + + ## Do we need to check adslAtucPhysTable ? ## + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + $data->{'adslAtucPhysTable'} = []; + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + if( $devdetails->hasOID( $dd->oiddef('adslAtucCurrSnrMgn') . + '.' . $ifIndex ) ) + { + push( @{$data->{'adslAtucPhysTable'}}, $ifIndex ); + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + # Build SNR subtree + my $subtreeName = 'ADSL_Line_Stats'; + + my $param = { + 'precedence' => '-600', + 'comment' => 'ADSL line statistics' + }; + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $param ); + + my $data = $devdetails->data(); + + foreach my $ifIndex ( sort {$a<=>$b} @{$data->{'adslAtucPhysTable'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + my $templates = ['RFC2662_ADSL_LINE::adsl-line-interface']; + + my $param = { + 'interface-name' => $interface->{'param'}{'interface-name'}, + 'interface-nick' => $interface->{'param'}{'interface-nick'}, + 'collector-timeoffset-hashstring' =>'%system-id%:%interface-nick%', + 'comment' => $interface->{'param'}{'comment'} + }; + + $param->{'node-display-name'} = + $interface->{$data->{'nameref'}{'ifReferenceName'}}; + + $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/RFC2670_DOCS_IF.pm b/torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm new file mode 100644 index 000000000..91e30a555 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm @@ -0,0 +1,307 @@ +# 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: RFC2670_DOCS_IF.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# DOCSIS interface statistics + +package Torrus::DevDiscover::RFC2670_DOCS_IF; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC2670_DOCS_IF'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpSNRMonitor'} = 'RFC2670_DOCS_IF'; +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpSNRTokenset'} = 'RFC2670_DOCS_IF'; + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpFECCorMonitor'} = 'RFC2670_DOCS_IF'; +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisUpFECUncorMonitor'} = 'RFC2670_DOCS_IF'; + +$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{ + 'DocsisDownUtilMonitor'} = 'RFC2670_DOCS_IF'; + + +our %oiddef = + ( + # DOCS-IF-MIB + 'docsIfDownstreamChannelTable' => '1.3.6.1.2.1.10.127.1.1.1', + 'docsIfCmtsDownChannelCounterTable' => '1.3.6.1.2.1.10.127.1.3.10', + 'docsIfSigQSignalNoise' => '1.3.6.1.2.1.10.127.1.1.4.1.5', + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + if( $dd->checkSnmpTable( 'docsIfDownstreamChannelTable' ) ) + { + return 1; + } + + return 0; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + if( $dd->checkSnmpTable( 'docsIfCmtsDownChannelCounterTable' ) ) + { + $devdetails->setCap('docsDownstreamUtil'); + } + + my $snrTable = + $session->get_table( -baseoid => + $dd->oiddef('docsIfSigQSignalNoise') ); + if( defined( $snrTable ) ) + { + $devdetails->storeSnmpVars( $snrTable ); + } + + $data->{'docsCableMaclayer'} = []; + $data->{'docsCableDownstream'} = []; + $data->{'docsCableUpstream'} = []; + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + my $ifType = $interface->{'ifType'}; + + $interface->{'docsTemplates'} = []; + $interface->{'docsParams'} = {}; + + if( $devdetails->hasCap('interfaceIndexingPersistent') ) + { + $interface->{'docsParams'}{'interface-index'} = $ifIndex; + } + + if( $ifType == 127 ) + { + push( @{$data->{'docsCableMaclayer'}}, $ifIndex ); + } + elsif( $ifType == 128 ) + { + push( @{$data->{'docsCableDownstream'}}, $ifIndex ); + if( $devdetails->hasCap('docsDownstreamUtil') ) + { + push( @{$interface->{'docsTemplates'}}, + 'RFC2670_DOCS_IF::docsis-downstream-util' ); + } + } + elsif( $ifType == 129 or $ifType == 205 ) + { + if( $devdetails->hasOID( $dd->oiddef('docsIfSigQSignalNoise') . + '.' . $ifIndex ) ) + { + push( @{$data->{'docsCableUpstream'}}, $ifIndex ); + push( @{$interface->{'docsTemplates'}}, + 'RFC2670_DOCS_IF::docsis-upstream-stats' ); + + } + } + } + + if( $devdetails->param('RFC2670_DOCS_IF::upstreams-only') eq 'yes' ) + { + $data->{'docsCableMaclayer'} = []; + $data->{'docsCableDownstream'} = []; + } + + $data->{'docsConfig'} = { + 'docsCableMaclayer' => { + 'subtreeName' => 'Docsis_MAC_Layer', + 'nodeidCategory' => 'docsmac', + 'templates' => [], + 'param' => { + 'node-display-name' => 'DOCSIS MAC Layer', + }, + }, + 'docsCableDownstream' => { + 'subtreeName' => 'Docsis_Downstream', + 'nodeidCategory' => 'docsds', + 'templates' => [], + 'param' => { + 'node-display-name' => 'DOCSIS Downstream', + }, + }, + 'docsCableUpstream' => { + 'subtreeName' => 'Docsis_Upstream', + 'nodeidCategory' => 'docsus', + 'templates' => ['RFC2670_DOCS_IF::docsis-upstream-subtree'], + 'param' => { + 'node-display-name' => 'DOCSIS Upstream', + }, + }, + }; + + if( $devdetails->hasCap('docsDownstreamUtil') ) + { + push( @{$data->{'docsConfig'}{'docsCableDownstream'}{'templates'}}, + 'RFC2670_DOCS_IF::docsis-downstream-subtree' ); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + foreach my $category ( sort keys %{$data->{'docsConfig'}} ) + { + if( scalar( @{$data->{$category}} ) > 0 and + scalar( @{$data->{'docsConfig'}{$category}{'templates'}} ) > 0 ) + { + # Count non-excluded interfaces + my $updatedInterfaceList = []; + foreach my $ifIndex ( @{$data->{$category}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + next if $interface->{'excluded'}; + push( @{$updatedInterfaceList}, $ifIndex ); + } + $data->{$category} = $updatedInterfaceList; + + next if scalar( @{$data->{$category}} ) == 0; + + my $subtreeNode = + $cb->addSubtree( $devNode, + $data->{'docsConfig'}{$category}{ + 'subtreeName'}, + $data->{'docsConfig'}{$category}{ + 'param'}, + $data->{'docsConfig'}{$category}{ + 'templates'}); + + foreach my $ifIndex ( @{$data->{$category}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $param = $interface->{'docsParams'}; + + $param->{'searchable'} = 'yes'; + + # Copy some parameters from IF-MIB discovery results + + foreach my $p ('interface-name', 'interface-nick', + 'node-display-name', 'comment') + { + $param->{$p} = $interface->{'param'}{$p}; + } + + $param->{'nodeid-docsif'} = + $data->{'docsConfig'}{$category}{'nodeidCategory'} . + '//%nodeid-device%//' . + $interface->{$data->{'nameref'}{'ifNodeid'}}; + + $param->{'nodeid'} = '%nodeid-docsif%'; + + my $intfNode = $cb->addSubtree + ( $subtreeNode, + $interface->{$data->{'nameref'}{'ifSubtreeName'}}, + $param, + $interface->{'docsTemplates'} ); + + # Apply selector actions + if( $category eq 'docsCableUpstream' ) + { + my $monitor = + $interface->{'selectorActions'}{'DocsisUpSNRMonitor'}; + my $tset = + $interface->{'selectorActions'}{'DocsisUpSNRTokenset'}; + if( defined( $monitor ) or defined( $tset ) ) + { + my $param = {}; + if( defined( $monitor ) ) + { + $param->{'monitor'} = $monitor; + } + if( defined( $tset ) ) + { + $param->{'tokenset-member'} = $tset; + } + $cb->addLeaf( $intfNode, 'SNR', $param ); + } + + $monitor = $interface->{'selectorActions'}{ + 'DocsisUpFECCorMonitor'}; + if( defined( $monitor ) ) + { + $cb->addLeaf( $intfNode, 'Correctable', + {'monitor' => $monitor } ); + } + + $monitor = $interface->{'selectorActions'}{ + 'DocsisUpFECUncorMonitor'}; + if( defined( $monitor ) ) + { + $cb->addLeaf( $intfNode, 'Uncorrectable', + {'monitor' => $monitor } ); + } + } + elsif( $category eq 'docsCableDownstream') + { + my $monitor = $interface->{'selectorActions'}{ + 'DocsisDownUtilMonitor'}; + if( defined( $monitor ) ) + { + $cb->addLeaf( $intfNode, 'UsedBytes', + {'monitor' => $monitor } ); + } + } + } + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm new file mode 100644 index 000000000..596152f01 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm @@ -0,0 +1,152 @@ +# 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: RFC2737_ENTITY_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Discovery module for ENTITY-MIB (RFC 2737) +# This module does not generate any XML, but provides information +# for other discovery modules + +package Torrus::DevDiscover::RFC2737_ENTITY_MIB; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC2737_ENTITY_MIB'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # ENTITY-MIB + 'entPhysicalDescr' => '1.3.6.1.2.1.47.1.1.1.1.2', + 'entPhysicalContainedIn' => '1.3.6.1.2.1.47.1.1.1.1.4', + 'entPhysicalName' => '1.3.6.1.2.1.47.1.1.1.1.7' + ); + + + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my $descrTable = + $session->get_table( -baseoid => + $dd->oiddef('entPhysicalDescr') ); + if( defined $descrTable ) + { + $devdetails->storeSnmpVars( $descrTable ); + } + + my $nameTable = + $session->get_table( -baseoid => + $dd->oiddef('entPhysicalName') ); + if( defined $nameTable ) + { + $devdetails->storeSnmpVars( $nameTable ); + } + + return( defined($descrTable) or defined($nameTable) ); +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + $data->{'entityPhysical'} = {}; + + my $chassisIndex = 0; + my $oidContainedIn = $dd->oiddef('entPhysicalContainedIn'); + + foreach my $phyIndex + ( $devdetails->getSnmpIndices($dd->oiddef('entPhysicalDescr')) ) + { + my $ref = {}; + $data->{'entityPhysical'}{$phyIndex} = $ref; + + # Find the chassis. It is not contained in anything. + if( not $chassisIndex ) + { + my $oid = $oidContainedIn . '.' . $phyIndex; + my $result = $session->get_request( -varbindlist => [ $oid ] ); + if( $session->error_status() == 0 and $result->{$oid} == 0 ) + { + $chassisIndex = $phyIndex; + } + } + + my $descr = $devdetails->snmpVar( $dd->oiddef('entPhysicalDescr') . + '.' . $phyIndex ); + if( $descr ) + { + $ref->{'descr'} = $descr; + } + + my $name = $devdetails->snmpVar( $dd->oiddef('entPhysicalName') . + '.' . $phyIndex ); + if( $name ) + { + $ref->{'name'} = $name; + } + } + + if( $chassisIndex ) + { + $data->{'entityChassisPhyIndex'} = $chassisIndex; + my $chassisDescr = $data->{'entityPhysical'}{$chassisIndex}{'descr'}; + if( length( $chassisDescr ) > 0 and + not defined( $data->{'param'}{'comment'} ) ) + { + Debug('ENTITY-MIB: found chassis description: ' . $chassisDescr); + $data->{'param'}{'comment'} = $chassisDescr; + } + } + + 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/RFC2790_HOST_RESOURCES.pm b/torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm new file mode 100644 index 000000000..8e79d9d78 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm @@ -0,0 +1,263 @@ +# Copyright (C) 2003 Shawn Ferry, 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: RFC2790_HOST_RESOURCES.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Standard HOST_RESOURCES_MIB discovery, which should apply to most hosts + +package Torrus::DevDiscover::RFC2790_HOST_RESOURCES; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC2790_HOST_RESOURCES'} = { + 'sequence' => 100, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +# define the oids that are needed to determine support, +# capabilities and information about the device +our %oiddef = + ( + 'hrSystemUptime' => '1.3.6.1.2.1.25.1.1.0', + 'hrSystemNumUsers' => '1.3.6.1.2.1.25.1.5.0', + 'hrSystemProcesses' => '1.3.6.1.2.1.25.1.6.0', + 'hrSystemMaxProcesses' => '1.3.6.1.2.1.25.1.7.0', + 'hrMemorySize' => '1.3.6.1.2.1.25.2.2.0', + 'hrStorageTable' => '1.3.6.1.2.1.25.2.3.1', + 'hrStorageIndex' => '1.3.6.1.2.1.25.2.3.1.1', + 'hrStorageType' => '1.3.6.1.2.1.25.2.3.1.2', + 'hrStorageDescr' => '1.3.6.1.2.1.25.2.3.1.3', + 'hrStorageAllocationUnits' => '1.3.6.1.2.1.25.2.3.1.4', + 'hrStorageSize' => '1.3.6.1.2.1.25.2.3.1.5', + 'hrStorageUsed' => '1.3.6.1.2.1.25.2.3.1.6', + 'hrStorageAllocationFailures' => '1.3.6.1.2.1.25.2.3.1.7' + ); + + +our %storageDescTranslate = ( '/' => {'subtree' => 'root' } ); + +# storage type names from MIB +my %storageTypes = + ( + 1 => 'Other Storage', + 2 => 'Physical Memory (RAM)', + 3 => 'Virtual Memory', + 4 => 'Fixed Disk', + 5 => 'Removable Disk', + 6 => 'Floppy Disk', + 7 => 'Compact Disk', + 8 => 'RAM Disk', + 9 => 'Flash Memory', + 10 => 'Network File System' + ); + +our $storageGraphTop; +our $storageHiMark; + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + return $dd->checkSnmpOID('hrSystemUptime'); +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + my $session = $dd->session(); + + if( $dd->checkSnmpOID('hrSystemNumUsers') ) + { + $devdetails->setCap('hrSystemNumUsers'); + } + + if( $dd->checkSnmpOID('hrSystemProcesses') ) + { + $devdetails->setCap('hrSystemProcesses'); + } + + # hrStorage support + my $hrStorageTable = $session->get_table( -baseoid => + $dd->oiddef('hrStorageTable') ); + if( defined( $hrStorageTable ) ) + { + $devdetails->storeSnmpVars( $hrStorageTable ); + + my $ref = {}; + $data->{'hrStorage'} = $ref; + + foreach my $INDEX + ( $devdetails->getSnmpIndices($dd->oiddef('hrStorageIndex') ) ) + { + my $typeNum = $devdetails->snmpVar( $dd->oiddef('hrStorageType') . + '.' . $INDEX ); + $typeNum =~ s/^[0-9.]+\.(\d+)$/$1/; + + my $descr = $devdetails->snmpVar($dd->oiddef('hrStorageDescr') + . '.' . $INDEX); + + my $used = $devdetails->snmpVar($dd->oiddef('hrStorageUsed') + . '.' . $INDEX); + + if( defined( $used ) and $storageTypes{$typeNum} ) + { + my $ref = { 'param' => {}, 'templates' => [] }; + $data->{'hrStorage'}{$INDEX} = $ref; + my $param = $ref->{'param'}; + + $param->{'storage-description'} = $descr; + + my $comment = $storageTypes{$typeNum}; + if( $descr =~ /^\// ) + { + $comment .= ' (' . $descr . ')'; + } + $param->{'comment'} = $comment; + + if( $storageDescTranslate{$descr}{'subtree'} ) + { + $descr = $storageDescTranslate{$descr}{'subtree'}; + } + $descr =~ s/^\///; + $descr =~ s/\W/_/g; + $param->{'storage-nick'} = $descr; + + my $units = + $devdetails->snmpVar + ($dd->oiddef('hrStorageAllocationUnits') . '.' . $INDEX); + + $param->{'collector-scale'} = sprintf('%d,*', $units); + + my $size = + $devdetails->snmpVar + ($dd->oiddef('hrStorageSize') . '.' . $INDEX); + + if( $size ) + { + if( $storageGraphTop > 0 ) + { + $param->{'graph-upper-limit'} = + sprintf('%e', + $units * $size * $storageGraphTop / 100 ); + } + + if( $storageHiMark > 0 ) + { + $param->{'upper-limit'} = + sprintf('%e', + $units * $size * $storageHiMark / 100 ); + } + } + + push( @{ $ref->{'templates'} }, + 'RFC2790_HOST_RESOURCES::hr-storage-usage' ); + } + } + + if( scalar( keys %{$data->{'hrStorage'}} ) > 0 ) + { + $devdetails->setCap('hrStorage'); + } + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + { # Anon sub for System Info + my $subtreeName = + $devdetails->param('RFC2790_HOST_RESOURCES::sysperf-subtree-name'); + if( not defined( $subtreeName ) ) + { + $subtreeName = 'System_Performance'; + $devdetails->setParam + ('RFC2790_HOST_RESOURCES::sysperf-subtree-name', $subtreeName); + } + + my $param = {}; + + my @templates = + ('RFC2790_HOST_RESOURCES::hr-system-performance-subtree', + 'RFC2790_HOST_RESOURCES::hr-system-uptime'); + if( $devdetails->hasCap('hrSystemNumUsers') ) + { + push( @templates, 'RFC2790_HOST_RESOURCES::hr-system-num-users' ); + } + + if( $devdetails->hasCap('hrSystemProcesses') ) + { + push( @templates, 'RFC2790_HOST_RESOURCES::hr-system-processes' ); + } + + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, + $param, \@templates ); + } + + if( $devdetails->hasCap('hrStorage') ) + { + # Build hrstorage subtree + my $subtreeName = 'Storage_Used'; + + my $param = {}; + my @templates = ('RFC2790_HOST_RESOURCES::hr-storage-subtree'); + my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, + $param, \@templates ); + + foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'hrStorage'}} ) + { + my $ref = $data->{'hrStorage'}{$INDEX}; + + #Display in index order, This is generally good(tm) + $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX); + + $cb->addLeaf( $subtreeNode, $ref->{'param'}{'storage-nick'}, + $ref->{'param'}, $ref->{'templates'} ); + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm new file mode 100644 index 000000000..a3ae8013f --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm @@ -0,0 +1,1404 @@ +# 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: RFC2863_IF_MIB.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Standard IF_MIB discovery, which should apply to most devices + +package Torrus::DevDiscover::RFC2863_IF_MIB; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'RFC2863_IF_MIB'} = { + 'sequence' => 50, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig, + 'buildGlobalConfig' => \&buildGlobalConfig + }; + + +our %oiddef = + ( + 'ifTable' => '1.3.6.1.2.1.2.2', + 'ifDescr' => '1.3.6.1.2.1.2.2.1.2', + 'ifType' => '1.3.6.1.2.1.2.2.1.3', + 'ifSpeed' => '1.3.6.1.2.1.2.2.1.5', + 'ifPhysAddress' => '1.3.6.1.2.1.2.2.1.6', + 'ifAdminStatus' => '1.3.6.1.2.1.2.2.1.7', + 'ifOperStatus' => '1.3.6.1.2.1.2.2.1.8', + 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', + 'ifInUcastPkts' => '1.3.6.1.2.1.2.2.1.11', + 'ifInDiscards' => '1.3.6.1.2.1.2.2.1.13', + 'ifInErrors' => '1.3.6.1.2.1.2.2.1.14', + 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16', + 'ifOutUcastPkts' => '1.3.6.1.2.1.2.2.1.17', + 'ifOutDiscards' => '1.3.6.1.2.1.2.2.1.19', + 'ifOutErrors' => '1.3.6.1.2.1.2.2.1.20', + 'ifXTable' => '1.3.6.1.2.1.31.1.1', + 'ifName' => '1.3.6.1.2.1.31.1.1.1.1', + 'ifHCInOctets' => '1.3.6.1.2.1.31.1.1.1.6', + 'ifHCInUcastPkts' => '1.3.6.1.2.1.31.1.1.1.7', + 'ifHCOutOctets' => '1.3.6.1.2.1.31.1.1.1.10', + 'ifHCOutUcastPkts' => '1.3.6.1.2.1.31.1.1.1.11', + 'ifHighSpeed' => '1.3.6.1.2.1.31.1.1.1.15', + 'ifAlias' => '1.3.6.1.2.1.31.1.1.1.18' + ); + + + +# Just curious, are there any devices without ifTable? +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + return $dd->checkSnmpTable('ifTable'); +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + + my $ifTable = + $session->get_table( -baseoid => $dd->oiddef('ifTable') ); + if( not defined $ifTable ) + { + Error('Cannot retrieve ifTable'); + return 0; + } + $devdetails->storeSnmpVars( $ifTable ); + + my $ifXTable = + $session->get_table( -baseoid => $dd->oiddef('ifXTable') ); + if( defined $ifXTable ) + { + $devdetails->storeSnmpVars( $ifXTable ); + $devdetails->setCap('ifXTable'); + + if( $devdetails->hasOID( $dd->oiddef('ifName') ) ) + { + $devdetails->setCap('ifName'); + } + + if( $devdetails->hasOID( $dd->oiddef('ifAlias') ) ) + { + $devdetails->setCap('ifAlias'); + } + + if( $devdetails->hasOID( $dd->oiddef('ifHighSpeed') ) ) + { + $devdetails->setCap('ifHighSpeed'); + } + } + + ## Fill in per-interface data. This is normally done within discover(), + ## but in our case we want to give other modules more control as early + ## as possible. + + # Define the tables used for subtree naming, interface indexing, + # and RRD file naming + my $data = $devdetails->data(); + + $data->{'param'}{'has-inout-leaves'} = 'yes'; + + ## Set default interface index mapping + + $data->{'nameref'}{'ifSubtreeName'} = 'ifDescrT'; + $data->{'nameref'}{'ifReferenceName'} = 'ifDescr'; + + if( $devdetails->hasCap('ifName') ) + { + $data->{'nameref'}{'ifNick'} = 'ifNameT'; + } + else + { + $data->{'nameref'}{'ifNick'} = 'ifDescrT'; + } + + if( $devdetails->hasCap('ifAlias') ) + { + $data->{'nameref'}{'ifComment'} = 'ifAlias'; + } + + # Pre-populate the interfaces table, so that other modules may + # delete unneeded interfaces + my $includeAdmDown = + $devdetails->param('RFC2863_IF_MIB::list-admindown-interfaces') + eq 'yes'; + my $includeNotpresent = + $devdetails->param('RFC2863_IF_MIB::list-notpresent-interfaces') + eq 'yes'; + my $excludeOperDown = + $devdetails->param('RFC2863_IF_MIB::exclude-down-interfaces') + eq 'yes'; + foreach my $ifIndex + ( $devdetails->getSnmpIndices( $dd->oiddef('ifDescr') ) ) + { + my $admStatus = + $devdetails->snmpVar($dd->oiddef('ifAdminStatus') .'.'. $ifIndex); + my $operStatus = + $devdetails->snmpVar($dd->oiddef('ifOperStatus') .'.'. $ifIndex); + + if( ( $admStatus == 1 or $includeAdmDown ) and + ( $operStatus != 6 or $includeNotpresent ) and + ( $operStatus != 2 or not $excludeOperDown ) ) + { + my $interface = {}; + $data->{'interfaces'}{$ifIndex} = $interface; + + $interface->{'param'} = {}; + $interface->{'vendor_templates'} = []; + + $interface->{'ifType'} = + $devdetails->snmpVar($dd->oiddef('ifType') . '.' . $ifIndex); + + my $descr = $devdetails->snmpVar($dd->oiddef('ifDescr') . + '.' . $ifIndex); + $interface->{'ifDescr'} = $descr; + $descr =~ s/\W/_/g; + # Some SNMP agents send extra zero byte at the end + $descr =~ s/_+$//; + $interface->{'ifDescrT'} = $descr; + + if( $devdetails->hasCap('ifName') ) + { + my $iname = $devdetails->snmpVar($dd->oiddef('ifName') . + '.' . $ifIndex); + if( $iname !~ /\w/ ) + { + $iname = $interface->{'ifDescr'}; + Warn('Empty or invalid ifName for interface ' . $iname); + } + $interface->{'ifName'} = $iname; + $iname =~ s/\W/_/g; + $interface->{'ifNameT'} = $iname; + } + + if( $devdetails->hasCap('ifAlias') ) + { + $interface->{'ifAlias'} = + $devdetails->snmpVar($dd->oiddef('ifAlias') . + '.' . $ifIndex); + } + + my $bw = 0; + if( $devdetails->hasCap('ifHighSpeed') ) + { + my $hiBW = + $devdetails->snmpVar($dd->oiddef('ifHighSpeed') . '.' . + $ifIndex); + if( $hiBW >= 10 ) + { + $bw = 1e6 * $hiBW; + } + } + + if( $bw == 0 ) + { + $bw = + $devdetails->snmpVar($dd->oiddef('ifSpeed') . '.' . + $ifIndex); + } + + if( $bw > 0 ) + { + $interface->{'ifSpeed'} = $bw; + } + } + } + + ## Process hints on interface indexing + ## The capability 'interfaceIndexingManaged' disables the hints + ## and lets the vendor discovery module to operate the indexing + + if( not $devdetails->hasCap('interfaceIndexingManaged') and + not $devdetails->hasCap('interfaceIndexingPersistent') ) + { + my $hint = + $devdetails->param('RFC2863_IF_MIB::ifindex-map-hint'); + if( defined( $hint ) ) + { + if( $hint eq 'ifName' ) + { + if( not $devdetails->hasCap('ifName') ) + { + Error('Cannot use ifName interface mapping: ifName is '. + 'not supported by device'); + return 0; + } + else + { + $data->{'nameref'}{'ifReferenceName'} = 'ifName'; + $data->{'param'}{'ifindex-table'} = '$ifName'; + } + } + elsif( $hint eq 'ifPhysAddress' ) + { + $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC'; + retrieveMacAddresses( $dd, $devdetails ); + } + elsif( $hint eq 'ifIndex' ) + { + $devdetails->setCap('interfaceIndexingPersistent'); + } + else + { + Error('Unknown value of RFC2863_IF_MIB::ifindex-map-hint: ' . + $hint); + } + } + + $hint = + $devdetails->param('RFC2863_IF_MIB::subtree-name-hint'); + if( defined( $hint ) ) + { + if( $hint eq 'ifName' ) + { + $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; + } + else + { + Error('Unknown value of RFC2863_IF_MIB::subtree-name-hint: ' . + $hint); + } + } + + $hint = + $devdetails->param('RFC2863_IF_MIB::nodeid-hint'); + if( defined( $hint ) ) + { + $data->{'nameref'}{'ifNodeid'} = $hint; + } + } + + if( $devdetails->hasCap('interfaceIndexingPersistent') ) + { + $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX'; + storeIfIndexParams( $devdetails ); + } + + if( not defined( $data->{'nameref'}{'ifNodeid'} ) ) + { + $data->{'nameref'}{'ifNodeid'} = 'ifNodeid'; + } + + if( not defined( $data->{'nameref'}{'ifNodeidPrefix'} ) ) + { + $data->{'nameref'}{'ifNodeidPrefix'} = 'ifNodeidPrefix'; + } + + # Filter out the interfaces if needed + + if( ref( $data->{'interfaceFilter'} ) ) + { + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + my $match = 0; + + foreach my $filterHash ( @{$data->{'interfaceFilter'}} ) + { + last if $match; + foreach my $filter ( values %{$filterHash} ) + { + last if $match; + + if( defined( $filter->{'ifType'} ) and + $interface->{'ifType'} == $filter->{'ifType'} ) + { + if( not defined( $filter->{'ifDescr'} ) or + $interface->{'ifDescr'} =~ $filter->{'ifDescr'} ) + { + $match = 1; + } + } + } + } + + if( $match ) + { + Debug('Excluding interface: ' . + $interface->{$data->{'nameref'}{'ifReferenceName'}}); + delete $data->{'interfaces'}{$ifIndex}; + } + } + } + + my $suppressHCCounters = + $devdetails->param('RFC2863_IF_MIB::suppress-hc-counters') eq 'yes'; + + # Explore each interface capability + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + if( $devdetails->hasOID( $dd->oiddef('ifInOctets') . + '.' . $ifIndex ) + and + $devdetails->hasOID( $dd->oiddef('ifOutOctets') . + '.' . $ifIndex ) ) + { + $interface->{'hasOctets'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifInUcastPkts') . + '.' . $ifIndex ) + and + $devdetails->hasOID( $dd->oiddef('ifOutUcastPkts') . + '.' . $ifIndex ) ) + { + $interface->{'hasUcastPkts'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifInDiscards') . + '.' . $ifIndex ) ) + { + $interface->{'hasInDiscards'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifOutDiscards') . + '.' . $ifIndex ) ) + { + $interface->{'hasOutDiscards'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifInErrors') . + '.' . $ifIndex ) ) + { + $interface->{'hasInErrors'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifOutErrors') . + '.' . $ifIndex ) ) + { + $interface->{'hasOutErrors'} = 1; + } + + if( $devdetails->hasCap('ifXTable') and not $suppressHCCounters ) + { + if( $devdetails->hasOID( $dd->oiddef('ifHCInOctets') . + '.' . $ifIndex ) + and + $devdetails->hasOID( $dd->oiddef('ifHCOutOctets') . + '.' . $ifIndex ) ) + { + $interface->{'hasHCOctets'} = 1; + } + + if( $devdetails->hasOID( $dd->oiddef('ifHCInUcastPkts') . + '.' . $ifIndex ) + and + $devdetails->hasOID( $dd->oiddef('ifHCOutUcastPkts') . + '.' . $ifIndex ) ) + { + $interface->{'hasHCUcastPkts'} = 1; + } + } + } + + push( @{$data->{'templates'}}, 'RFC2863_IF_MIB::rfc2863-ifmib-hostlevel' ); + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $globalData = shift; + + my $data = $devdetails->data(); + + if( scalar( keys %{$data->{'interfaces'}} ) == 0 ) + { + return; + } + + # Make sure that ifNick and ifSubtreeName are unique across interfaces + + uniqueEntries( $devdetails, $data->{'nameref'}{'ifNick'} ); + uniqueEntries( $devdetails, $data->{'nameref'}{'ifSubtreeName'} ); + + # If other discovery modules don't set nodeid reference, fall back to + # default interface reference + + + # Build interface parameters + + my $nInterfaces = 0; + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + next if $interface->{'excluded'}; + $nInterfaces++; + + $interface->{'param'}{'searchable'} = 'yes'; + + $interface->{'param'}{'interface-iana-type'} = $interface->{'ifType'}; + + $interface->{'param'}{'interface-name'} = + $interface->{$data->{'nameref'}{'ifReferenceName'}}; + + $interface->{'param'}{'node-display-name'} = + $interface->{$data->{'nameref'}{'ifReferenceName'}}; + + $interface->{'param'}{'interface-nick'} = + $interface->{$data->{'nameref'}{'ifNick'}}; + + if( not defined( $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} ) ) + { + $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} = + 'if//%nodeid-device%//'; + } + + if( not defined( $interface->{$data->{'nameref'}{'ifNodeid'}} ) ) + { + $interface->{$data->{'nameref'}{'ifNodeid'}} = + $interface->{$data->{'nameref'}{'ifReferenceName'}}; + } + + # A per-interface value which is used by leafs in IF-MIB templates + $interface->{'param'}{'nodeid-interface'} = + $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} . + $interface->{$data->{'nameref'}{'ifNodeid'}}; + + $interface->{'param'}{'nodeid'} = '%nodeid-interface%'; + + if( defined $data->{'nameref'}{'ifComment'} and + not defined( $interface->{'param'}{'comment'} ) and + length( $interface->{$data->{'nameref'}{'ifComment'}} ) > 0 ) + { + my $comment = $interface->{$data->{'nameref'}{'ifComment'}}; + $interface->{'param'}{'comment'} = $comment; + $interface->{'param'}{'interface-comment'} = $comment; + } + + # Order the interfaces by ifIndex, not by interface name + $interface->{'param'}{'precedence'} = sprintf('%d', 100000-$ifIndex); + + $interface->{'param'}{'devdiscover-nodetype'} = + 'RFC2863_IF_MIB::interface'; + } + + if( $nInterfaces == 0 ) + { + return; + } + + if( $devdetails->param('RFC2863_IF_MIB::noout') eq 'yes' ) + { + return; + } + + # explicitly excluded interfaces + my %excludeName; + my $excludeNameList = + $devdetails->param('RFC2863_IF_MIB::exclude-interfaces'); + my $nExplExcluded = 0; + + if( defined( $excludeNameList ) and length( $excludeNameList ) > 0 ) + { + foreach my $name ( split( /\s*,\s*/, $excludeNameList ) ) + { + $excludeName{$name} = 1; + } + } + + # explicitly listed interfaces + my %onlyName; + my $onlyNamesList = + $devdetails->param('RFC2863_IF_MIB::only-interfaces'); + my $onlyNamesDefined = 0; + if( defined( $onlyNamesList ) and length( $onlyNamesList ) > 0 ) + { + $onlyNamesDefined = 1; + foreach my $name ( split( /\s*,\s*/, $onlyNamesList ) ) + { + $onlyName{$name} = 1; + } + } + + # Bandwidth usage + my %bandwidthLimits; + if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' ) + { + my $limits = $devdetails->param('RFC2863_IF_MIB::bandwidth-limits'); + foreach my $intfLimit ( split( /\s*;\s*/, $limits ) ) + { + my( $intf, $limitIn, $limitOut ) = split( /\s*:\s*/, $intfLimit ); + $bandwidthLimits{$intf}{'In'} = $limitIn; + $bandwidthLimits{$intf}{'Out'} = $limitOut; + } + } + + # tokenset member interfaces of the form + # Format: tset:intf,intf; tokenset:intf,intf; + # Format for global parameter: + # tset:host/intf,host/intf; tokenset:host/intf,host/intf; + my %tsetMember; + my %tsetMemberApplied; + my $tsetMembership = + $devdetails->param('RFC2863_IF_MIB::tokenset-members'); + if( defined( $tsetMembership ) and length( $tsetMembership ) > 0 ) + { + foreach my $memList ( split( /\s*;\s*/, $tsetMembership ) ) + { + my ($tset, $list) = split( /\s*:\s*/, $memList ); + foreach my $intfName ( split( /\s*,\s*/, $list ) ) + { + if( $intfName =~ /\// ) + { + my( $host, $intf ) = split( '/', $intfName ); + if( $host eq $devdetails->param('snmp-host') ) + { + $tsetMember{$intf}{$tset} = 1; + } + } + else + { + $tsetMember{$intfName}{$tset} = 1; + } + } + } + } + + + # External storage serviceid assignment + my $extSrv = + $devdetails->param('RFC2863_IF_MIB::external-serviceid'); + my %extStorage; + my %extStorageTrees; + + if( defined( $extSrv ) and length( $extSrv ) > 0 ) + { + foreach my $srvDef ( split( /\s*,\s*/, $extSrv ) ) + { + my ( $serviceid, $intfName, $direction, $trees ) = + split( /\s*:\s*/, $srvDef ); + + if( $intfName =~ /\// ) + { + my( $host, $intf ) = split( '/', $intfName ); + if( $host eq $devdetails->param('snmp-host') ) + { + $intfName = $intf; + } + else + { + $intfName = undef; + } + } + + if( defined( $intfName ) and length( $intfName ) > 0 ) + { + if( defined( $trees ) ) + { + # Trees are listed with '|' as separator, + # whereas compiler expects commas + + $trees =~ s/\s*\|\s*/,/g; + } + + if( $direction eq 'Both' ) + { + $extStorage{$intfName}{'In'} = $serviceid . '_IN'; + $extStorageTrees{$serviceid . '_IN'} = $trees; + + $extStorage{$intfName}{'Out'} = $serviceid . '_OUT'; + $extStorageTrees{$serviceid . '_OUT'} = $trees; + } + else + { + $extStorage{$intfName}{$direction} = $serviceid; + $extStorageTrees{$serviceid} = $trees; + } + } + } + } + + # Sums of several interfaces into single graphs (via CDef collector) + # RFC2863_IF_MIB::traffic-summaries: the list of sums to create; + # RFC2863_IF_MIB::traffic-XXX-path: the full path of the summary leaf + # RFC2863_IF_MIB::traffic-XXX-comment: description + # RFC2863_IF_MIB::traffic-XXX-interfaces: list of interfaces to add + # format: "intf,intf" or "host/intf, host/intf" + my $trafficSums = $devdetails->param('RFC2863_IF_MIB::traffic-summaries'); + my %trafficSummary; + if( defined( $trafficSums ) ) + { + foreach my $summary ( split( /\s*,\s*/, $trafficSums ) ) + { + $globalData->{'RFC2863_IF_MIB::summaryAttr'}{ + $summary}{'path'} = + $devdetails->param + ('RFC2863_IF_MIB::traffic-' . $summary . '-path'); + $globalData->{'RFC2863_IF_MIB::summaryAttr'}{ + $summary}{'comment'} = + $devdetails->param + ('RFC2863_IF_MIB::traffic-' . $summary . '-comment'); + + $globalData->{'RFC2863_IF_MIB::summaryAttr'}{ + $summary}{'data-dir'} = $devdetails->param('data-dir'); + + my $intfList = $devdetails->param + ('RFC2863_IF_MIB::traffic-' . $summary . '-interfaces'); + + # get the intreface names for this host + foreach my $intfName ( split( /\s*,\s*/, $intfList ) ) + { + if( $intfName =~ /\// ) + { + my( $host, $intf ) = split( '/', $intfName ); + if( $host eq $devdetails->param('snmp-host') ) + { + $trafficSummary{$intf}{$summary} = 1; + } + } + else + { + $trafficSummary{$intfName}{$summary} = 1; + } + } + } + } + + # interface-level parameters to copy + my @intfCopyParams = (); + my $copyParams = $devdetails->param('RFC2863_IF_MIB::copy-params'); + if( defined( $copyParams ) and length( $copyParams ) > 0 ) + { + @intfCopyParams = split( /\s*,\s*/m, $copyParams ); + } + + # Build configuration tree + + my $subtreeName = $devdetails->param('RFC2863_IF_MIB::subtree-name'); + if( length( $subtreeName ) == 0 ) + { + $subtreeName = 'Interface_Counters'; + } + my $subtreeParams = {}; + my $subtreeComment = $devdetails->param('RFC2863_IF_MIB::subtree-comment'); + + if( length( $subtreeComment ) > 0 ) + { + $subtreeParams->{'comment'} = $subtreeComment; + } + + if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' ) + { + $subtreeParams->{'overview-shortcuts'} = 'traffic,errors,bandwidth'; + } + + my $countersNode = + $cb->addSubtree( $devNode, $subtreeName, $subtreeParams, + ['RFC2863_IF_MIB::rfc2863-ifmib-subtree'] ); + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + if( $interface->{'selectorActions'}{'RemoveInterface'} ) + { + $interface->{'excluded'} = 1; + Debug('Removing interface by selector action: ' . + $interface->{$data->{'nameref'}{'ifReferenceName'}}); + } + + # Some vendor-specific modules may exclude some interfaces + next if $interface->{'excluded'}; + + # Create a subtree for the interface + my $subtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + + if( $onlyNamesDefined ) + { + if( not $onlyName{$subtreeName} ) + { + $interface->{'excluded'} = 1; + $nExplExcluded++; + next; + } + } + + if( $excludeName{$subtreeName} ) + { + $interface->{'excluded'} = 1; + $nExplExcluded++; + next; + } + elsif( length( $subtreeName ) == 0 ) + { + Warn('Excluding an interface with empty name: ifIndex=' . + $ifIndex); + next; + } + + my @templates = (); + + if( $interface->{'hasHCOctets'} ) + { + push( @templates, 'RFC2863_IF_MIB::ifxtable-hcoctets' ); + } + elsif( $interface->{'hasOctets'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-octets' ); + } + + if( $interface->{'hasOctets'} or $interface->{'hasHCOctets'} ) + { + $interface->{'hasChild'}{'Bytes_In'} = 1; + $interface->{'hasChild'}{'Bytes_Out'} = 1; + $interface->{'hasChild'}{'InOut_bps'} = 1; + + foreach my $dir ( 'In', 'Out' ) + { + if( defined( $interface->{'selectorActions'}-> + {$dir . 'BytesMonitor'} ) ) + { + $interface->{'childCustomizations'}->{ + 'Bytes_' . $dir}->{'monitor'} = + $interface->{'selectorActions'}->{ + $dir . 'BytesMonitor'}; + } + + if( defined( $interface->{'selectorActions'}-> + {$dir . 'BytesParameters'} ) ) + { + my @pairs = + split('\s*;\s*', + $interface->{'selectorActions'}{ + $dir . 'BytesParameters'}); + + foreach my $pair( @pairs ) + { + my ($param, $val) = split('\s*=\s*', $pair); + $interface->{'childCustomizations'}->{ + 'Bytes_' . $dir}->{$param} = $val; + } + } + } + + if( defined( $interface->{'selectorActions'}{'HoltWinters'} ) ) + { + push( @templates, '::holt-winters-defaults' ); + } + + if( defined( $interface->{'selectorActions'}{'NotifyPolicy'} ) ) + { + $interface->{'param'}{'notify-policy'} = + $interface->{'selectorActions'}{'NotifyPolicy'}; + } + } + + if( not $interface->{'selectorActions'}{'NoPacketCounters'} ) + { + my $has_someting = 0; + if( $interface->{'hasHCUcastPkts'} ) + { + push( @templates, 'RFC2863_IF_MIB::ifxtable-hcucast-packets' ); + $has_someting = 1; + } + elsif( $interface->{'hasUcastPkts'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-ucast-packets' ); + $has_someting = 1; + } + + if( $has_someting ) + { + $interface->{'hasChild'}{'Packets_In'} = 1; + $interface->{'hasChild'}{'Packets_Out'} = 1; + } + } + + if( not $interface->{'selectorActions'}{'NoDiscardCounters'} ) + { + if( $interface->{'hasInDiscards'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-discards-in' ); + $interface->{'hasChild'}{'Discards_In'} = 1; + + if( defined + ($interface->{'selectorActions'}->{'InDiscardsMonitor'}) ) + { + $interface->{'childCustomizations'}->{ + 'Discards_In'}->{'monitor'} = + $interface->{'selectorActions'}{ + 'InDiscardsMonitor'}; + } + } + + if( $interface->{'hasOutDiscards'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-discards-out' ); + $interface->{'hasChild'}{'Discards_Out'} = 1; + + if( defined( $interface->{'selectorActions'}->{ + 'OutDiscardsMonitor'} ) ) + { + $interface->{'childCustomizations'}->{ + 'Discards_Out'}->{'monitor'} = + $interface->{'selectorActions'}{ + 'OutDiscardsMonitor'}; + } + } + } + + + if( not $interface->{'selectorActions'}{'NoErrorCounters'} ) + { + if( $interface->{'hasInErrors'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-errors-in' ); + $interface->{'hasChild'}{'Errors_In'} = 1; + + if( defined( $interface->{'selectorActions'}->{ + 'InErrorsMonitor'} ) ) + { + $interface->{'childCustomizations'}->{ + 'Errors_In'}->{'monitor'} = + $interface->{'selectorActions'}{'InErrorsMonitor'}; + } + } + + if( $interface->{'hasOutErrors'} ) + { + push( @templates, 'RFC2863_IF_MIB::iftable-errors-out' ); + $interface->{'hasChild'}{'Errors_Out'} = 1; + + if( defined( $interface->{'selectorActions'}->{ + 'OutErrorsMonitor'} ) ) + { + $interface->{'childCustomizations'}->{ + 'Errors_Out'}->{'monitor'} = + $interface->{'selectorActions'}{ + 'OutErrorsMonitor'}; + } + } + } + + if( defined( $interface->{'selectorActions'}{'TokensetMember'} ) ) + { + foreach my $tset + ( split('\s*,\s*', + $interface->{'selectorActions'}{'TokensetMember'}) ) + { + $tsetMember{$subtreeName}{$tset} = 1; + } + } + + if( defined( $interface->{'selectorActions'}{'Parameters'} ) ) + { + my @pairs = split('\s*;\s*', + $interface->{'selectorActions'}{'Parameters'}); + foreach my $pair( @pairs ) + { + my ($param, $val) = split('\s*=\s*', $pair); + $interface->{'param'}{$param} = $val; + } + } + + if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' ) + { + if( defined( $bandwidthLimits{$subtreeName} ) ) + { + $interface->{'param'}{'bandwidth-limit-in'} = + $bandwidthLimits{$subtreeName}{'In'}; + $interface->{'param'}{'bandwidth-limit-out'} = + $bandwidthLimits{$subtreeName}{'Out'}; + } + + # We accept that parameters may be added by some other ways + + if( defined( $interface->{'param'}{'bandwidth-limit-in'} ) and + defined( $interface->{'param'}{'bandwidth-limit-out'} ) ) + { + push( @templates, + 'RFC2863_IF_MIB::interface-bandwidth-usage' ); + } + } + + if( ref( $interface->{'templates'} ) ) + { + push( @templates, @{$interface->{'templates'}} ); + } + + # Add vendor templates + push( @templates, @{$interface->{'vendor_templates'}} ); + + # Add subtree only if there are template references + + if( scalar( @templates ) > 0 ) + { + # process interface-level parameters to copy + + foreach my $param ( @intfCopyParams ) + { + my $val = $devdetails->param('RFC2863_IF_MIB::' . + $param . '::' . $subtreeName ); + if( defined( $val ) and length( $val ) > 0 ) + { + $interface->{'param'}{$param} = $val; + } + } + + if( defined( $tsetMember{$subtreeName} ) ) + { + my $tsetList = + join( ',', sort keys %{$tsetMember{$subtreeName}} ); + + $interface->{'childCustomizations'}->{'InOut_bps'}->{ + 'tokenset-member'} = $tsetList; + $tsetMemberApplied{$subtreeName} = 1; + } + + if( defined( $extStorage{$subtreeName} ) ) + { + foreach my $dir ( 'In', 'Out' ) + { + if( defined( $extStorage{$subtreeName}{$dir} ) ) + { + my $serviceid = $extStorage{$subtreeName}{$dir}; + + my $params = { + 'storage-type' => 'rrd,ext', + 'ext-service-id' => $serviceid, + 'ext-service-units' => 'bytes' }; + + if( defined( $extStorageTrees{$serviceid} ) + and length( $extStorageTrees{$serviceid} ) > 0 ) + { + $params->{'ext-service-trees'} = + $extStorageTrees{$serviceid}; + } + + foreach my $param ( keys %{$params} ) + { + $interface->{'childCustomizations'}->{ + 'Bytes_' . $dir}{$param} = $params->{$param}; + } + } + } + } + + my $intfNode = + $cb->addSubtree( $countersNode, $subtreeName, + $interface->{'param'}, \@templates ); + + if( defined( $interface->{'childCustomizations'} ) ) + { + foreach my $childName + ( sort keys %{$interface->{'childCustomizations'}} ) + { + if( $interface->{'hasChild'}{$childName} ) + { + $cb->addLeaf + ( $intfNode, $childName, + $interface->{'childCustomizations'}->{ + $childName} ); + } + } + } + + # If the interafce is a member of traffic summary + if( defined( $trafficSummary{$subtreeName} ) ) + { + foreach my $summary ( keys %{$trafficSummary{$subtreeName}} ) + { + addTrafficSummaryElement( $globalData, + $summary, $intfNode ); + } + } + } + } + + if( $nExplExcluded > 0 ) + { + Debug('Explicitly excluded ' . $nExplExcluded . + ' RFC2863_IF_MIB interfaces'); + } + + if( scalar( %tsetMember ) > 0 ) + { + my @failedIntf; + foreach my $intfName ( keys %tsetMember ) + { + if( not $tsetMemberApplied{$intfName} ) + { + push( @failedIntf, $intfName ); + } + } + + if( scalar( @failedIntf ) > 0 ) + { + Warn('The following interfaces were not added to tokensets, ' . + 'probably because they do not exist or are explicitly ' . + 'excluded: ' . + join(' ', sort @failedIntf)); + } + } + + $cb->{'statistics'}{'interfaces'} += $nInterfaces; + if( $cb->{'statistics'}{'max-interfaces-per-host'} < $nInterfaces ) + { + $cb->{'statistics'}{'max-interfaces-per-host'} = $nInterfaces; + } +} + + +sub addTrafficSummaryElement +{ + my $globalData = shift; + my $summary = shift; + my $node = shift; + + if( not defined( $globalData->{ + 'RFC2863_IF_MIB::summaryMembers'}{$summary} ) ) + { + $globalData->{'RFC2863_IF_MIB::summaryMembers'}{$summary} = []; + } + + push( @{$globalData->{'RFC2863_IF_MIB::summaryMembers'}{$summary}}, + $node ); +} + + +sub buildGlobalConfig +{ + my $cb = shift; + my $globalData = shift; + + if( not defined( $globalData->{'RFC2863_IF_MIB::summaryMembers'} ) ) + { + return; + } + + foreach my $summary ( keys %{$globalData->{ + 'RFC2863_IF_MIB::summaryMembers'}} ) + { + next if scalar( @{$globalData->{ + 'RFC2863_IF_MIB::summaryMembers'}{$summary}} ) == 0; + + my $attr = $globalData->{'RFC2863_IF_MIB::summaryAttr'}{$summary}; + my $path = $attr->{'path'}; + + if( not defined( $path ) ) + { + Error('Missing the path for traffic summary ' . $summary); + next; + } + + Debug('Building summary: ' . $summary); + + # Chop the first and last slashes + $path =~ s/^\///; + $path =~ s/\/$//; + + # generate subtree path XML + my $subtreeNode = undef; + foreach my $subtreeName ( split( '/', $path ) ) + { + $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName, { + 'comment' => $attr->{'comment'}, + 'data-dir' => $attr->{'data-dir'} } ); + } + + foreach my $dir ('In', 'Out') + { + my $rpn = ''; + foreach my $member ( @{$globalData->{ + 'RFC2863_IF_MIB::summaryMembers'}{$summary}} ) + { + my $memRef = '{' . $cb->getElementPath($member) . + 'Bytes_' . $dir . '}'; + if( length( $rpn ) == 0 ) + { + $rpn = $memRef; + } + else + { + $rpn .= ',' . $memRef . ',+'; + } + } + + my $param = { + 'rpn-expr' => $rpn, + 'data-file' => 'summary_' . $summary . '.rrd', + 'rrd-ds' => 'Bytes' . $dir }; + + $cb->addLeaf( $subtreeNode, 'Bytes_' . $dir, $param, + ['::cdef-collector-defaults'] ); + } + } +} + + + + + +# $filterHash is a hash reference +# Key is some unique symbolic name, does not mean anything +# $filterHash->{$key}{'ifType'} is the number to match the interface type +# $filterHash->{$key}{'ifDescr'} is the regexp to match the interface +# description + +sub addInterfaceFilter +{ + my $devdetails = shift; + my $filterHash = shift; + + my $data = $devdetails->data(); + + if( not ref( $data->{'interfaceFilter'} ) ) + { + $data->{'interfaceFilter'} = []; + } + + push( @{$data->{'interfaceFilter'}}, $filterHash ); +} + + +sub uniqueEntries +{ + my $devdetails = shift; + my $nameref = shift; + + my $data = $devdetails->data(); + my %count = (); + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $entry = $interface->{$nameref}; + if( length($entry) == 0 ) + { + $entry = $interface->{$nameref} = '_'; + } + if( int( $count{$entry} ) > 0 ) + { + my $new_entry = sprintf('%s%d', $entry, int( $count{$entry} ) ); + $interface->{$nameref} = $new_entry; + $count{$new_entry}++; + } + $count{$entry}++; + } +} + +# For devices which require MAC address-to-interface mapping, +# this function fills in the appropriate interface-macaddr parameters. +# To get use of MAC mapping, set +# $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC'; + + +sub retrieveMacAddresses +{ + my $dd = shift; + my $devdetails = shift; + + my $data = $devdetails->data(); + + foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + my $macaddr = $devdetails->snmpVar($dd->oiddef('ifPhysAddress') . + '.' . $ifIndex); + + if( defined( $macaddr ) and length( $macaddr ) > 0 ) + { + $interface->{'MAC'} = $macaddr; + $interface->{'param'}{'interface-macaddr'} = $macaddr; + } + else + { + Warn('Excluding interface without MAC address: ' . + $interface->{$data->{'nameref'}{'ifReferenceName'}}); + delete $data->{'interfaces'}{$ifIndex}; + } + } +} + + +# For devices with fixed ifIndex mapping it populates interface-index parameter + + +sub storeIfIndexParams +{ + my $devdetails = shift; + + my $data = $devdetails->data(); + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + $interface->{'param'}{'interface-index'} = $ifIndex; + } +} + +####################################### +# Selectors interface +# + +$Torrus::DevDiscover::selectorsRegistry{'RFC2863_IF_MIB'} = { + 'getObjects' => \&getSelectorObjects, + 'getObjectName' => \&getSelectorObjectName, + 'checkAttribute' => \&checkSelectorAttribute, + 'applyAction' => \&applySelectorAction, +}; + + +## Objects are interface indexes + +sub getSelectorObjects +{ + my $devdetails = shift; + my $objType = shift; + return sort {$a<=>$b} keys ( %{$devdetails->data()->{'interfaces'}} ); +} + + +sub checkSelectorAttribute +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $attr = shift; + my $checkval = shift; + + my $data = $devdetails->data(); + my $interface = $data->{'interfaces'}{$object}; + + if( $attr =~ /^ifSubtreeName\d*$/ ) + { + my $value = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; + my $match = 0; + foreach my $chkexpr ( split( /\s+/, $checkval ) ) + { + if( $value =~ $chkexpr ) + { + $match = 1; + last; + } + } + return $match; + } + else + { + my $value; + my $operator = '=~'; + if( $attr eq 'ifComment' ) + { + $value = $interface->{$data->{'nameref'}{'ifComment'}}; + } + elsif( $attr eq 'ifType' ) + { + $value = $interface->{'ifType'}; + $operator = '=='; + } + else + { + Error('Unknown RFC2863_IF_MIB 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 $interface = $data->{'interfaces'}{$object}; + return $interface->{$data->{'nameref'}{'ifSubtreeName'}}; +} + + +# Other discovery modules can add their interface actions here +our %knownSelectorActions = + ( 'InBytesMonitor' => 'RFC2863_IF_MIB', + 'OutBytesMonitor' => 'RFC2863_IF_MIB', + 'InDiscardsMonitor' => 'RFC2863_IF_MIB', + 'OutDiscardsMonitor' => 'RFC2863_IF_MIB', + 'InErrorsMonitor' => 'RFC2863_IF_MIB', + 'OutErrorsMonitor' => 'RFC2863_IF_MIB', + 'NotifyPolicy' => 'RFC2863_IF_MIB', + 'HoltWinters' => 'RFC2863_IF_MIB', + 'NoPacketCounters' => 'RFC2863_IF_MIB', + 'NoDiscardCounters' => 'RFC2863_IF_MIB', + 'NoErrorCounters' => 'RFC2863_IF_MIB', + 'RemoveInterface' => 'RFC2863_IF_MIB', + 'TokensetMember' => 'RFC2863_IF_MIB', + 'Parameters' => 'RFC2863_IF_MIB', + 'InBytesParameters' => 'RFC2863_IF_MIB', + 'OutBytesParameters' => 'RFC2863_IF_MIB',); + + +sub applySelectorAction +{ + my $devdetails = shift; + my $object = shift; + my $objType = shift; + my $action = shift; + my $arg = shift; + + my $data = $devdetails->data(); + my $interface = $data->{'interfaces'}{$object}; + + if( defined( $knownSelectorActions{$action} ) ) + { + if( not $devdetails->isDevType( $knownSelectorActions{$action} ) ) + { + Error('Action ' . $action . ' is applied to a device that is ' . + 'not of type ' . $knownSelectorActions{$action} . + ': ' . $devdetails->param('system-id')); + } + $interface->{'selectorActions'}{$action} = $arg; + } + else + { + Error('Unknown RFC2863_IF_MIB selector action: ' . $action); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm b/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm new file mode 100644 index 000000000..cc7ff3a12 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm @@ -0,0 +1,104 @@ +# +# Discovery module for Symmetricom +# +# 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: Symmetricom.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $ +# Jon Nistor <nistor at snickers dot org> +# + + +# Symmetricom +package Torrus::DevDiscover::Symmetricom; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Symmetricom'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = ( + # SYMM-SMI + 'syncServer' => '1.3.6.1.4.1.9070.1.2.3.1.5', + 'sysDescr' => '1.3.6.1.2.1.1.1.0', + 'ntpSysSystem' => '1.3.6.1.4.1.9070.1.2.3.1.5.1.1.14.0', + 'etcSerialNbr' => '1.3.6.1.4.1.9070.1.2.3.1.5.1.6.2.0', + 'etcModel' => '1.3.6.1.4.1.9070.1.2.3.1.5.1.6.3.0', + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'syncServer', + $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) + { + return 0; + } + + $devdetails->setCap('interfaceIndexingPersistent'); + $devdetails->setDevType('UcdSnmp'); # Force load Ucd + + return 1; +} + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + # SNMP: Get the system info and display it in the comment + my $ntpComment = $dd->retrieveSnmpOIDs + ( 'sysDescr', 'ntpSysSystem', 'etcSerialNbr', 'etcModel' ); + + $data->{'ntp'} = $ntpComment; + + $data->{'param'}{'comment'} = + $ntpComment->{'ntpSysSystem'} . " " . $ntpComment->{'etcModel'} . + ", Hw Serial#: " . $ntpComment->{'etcSerialNbr'}; + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + my $data = $devdetails->data(); + + $cb->addTemplateApplication($devNode, 'Symmetricom::ntp-stats'); +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm b/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm new file mode 100644 index 000000000..9c9ce733d --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm @@ -0,0 +1,265 @@ +# 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: UcdSnmp.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $ +# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org> + +# Ucd Snmp Discovery + +package Torrus::DevDiscover::UcdSnmp; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'UcdSnmp'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + +our %oiddef = + ( + # ucd + 'ucd' => '1.3.6.1.4.1.2021', + 'net_snmp' => '1.3.6.1.4.1.8072', + + # We assume that if we have Avail we also have Total + 'ucd_memAvailSwap' => '1.3.6.1.4.1.2021.4.4.0', + 'ucd_memAvailReal' => '1.3.6.1.4.1.2021.4.6.0', + + # If we have in we assume out + 'ucd_ssSwapIn' => '1.3.6.1.4.1.2021.11.3.0', + + # If we have User we assume System and Idle + 'ucd_ssCpuRawUser' => '1.3.6.1.4.1.2021.11.50.0', + 'ucd_ssCpuRawNice' => '1.3.6.1.4.1.2021.11.51.0', + 'ucd_ssCpuRawWait' => '1.3.6.1.4.1.2021.11.54.0', + 'ucd_ssCpuRawKernel' => '1.3.6.1.4.1.2021.11.55.0', + 'ucd_ssCpuRawInterrupts' => '1.3.6.1.4.1.2021.11.56.0', + 'ucd_ssCpuRawSoftIRQ' => '1.3.6.1.4.1.2021.11.61.0', + + # if we have Sent we assume Received + 'ucd_ssIORawSent' => '1.3.6.1.4.1.2021.11.57.0', + + 'ucd_ssRawInterrupts' => '1.3.6.1.4.1.2021.11.59.0', + 'ucd_ssRawContexts' => '1.3.6.1.4.1.2021.11.60.0', + + 'ucd_laTable' => '1.3.6.1.4.1.2021.10' + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + my $sysObjectID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') ); + + if( not $dd->oidBaseMatch( 'ucd', $sysObjectID ) + and + not $dd->oidBaseMatch( 'net_snmp', $sysObjectID ) ) + { + return 0; + } + + return 1; +} + + +sub discover +{ + my $dd = shift; + my $devdetails = shift; + + my $session = $dd->session(); + my $data = $devdetails->data(); + + my @checkOids = ( + 'ucd_memAvailSwap', + 'ucd_memAvailReal', + 'ucd_ssSwapIn', + 'ucd_ssCpuRawUser', + 'ucd_ssCpuRawWait', + 'ucd_ssCpuRawKernel', + 'ucd_ssCpuRawInterrupts', + 'ucd_ssCpuRawNice', + 'ucd_ssCpuRawSoftIRQ', + 'ucd_ssIORawSent', + 'ucd_ssRawInterrupts', + ); + + + my $result = $dd->retrieveSnmpOIDs( @checkOids ); + if( defined( $result ) ) + { + foreach my $oid ( @checkOids ) + { + if( defined($result->{$oid}) and length($result->{$oid}) > 0 ) + { + $devdetails->setCap($oid); + } + } + } + + if( $dd->checkSnmpTable('ucd_laTable') ) + { + $devdetails->setCap('ucd_laTable'); + } + + return 1; +} + + +sub buildConfig +{ + my $devdetails = shift; + my $cb = shift; + my $devNode = shift; + + my $data = $devdetails->data(); + + # Hostresources MIB is optional in net-snmp. We try and use the same + # subtree name for UCD and Hostresources statistics. + + my $subtreeName = + $devdetails->param('RFC2790_HOST_RESOURCES::sysperf-subtree-name'); + if( not defined( $subtreeName ) ) + { + $subtreeName = 'System_Performance'; + $devdetails->setParam + ('RFC2790_HOST_RESOURCES::sysperf-subtree-name', $subtreeName); + } + + my @templates; + if( $devdetails->hasCap('ucd_ssIORawSent') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-blockio' ); + } + + if( $devdetails->hasCap('ucd_ssRawInterrupts') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-raw-interrupts' ); + } + + if( $devdetails->hasCap('ucd_laTable') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-load-average' ); + } + + if( $devdetails->hasCap('ucd_memAvailSwap') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-memory-swap' ); + } + + if( $devdetails->hasCap('ucd_memAvailReal') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-memory-real' ); + } + + my $cpuMultiParam; + my @cpuMultiTemplates; + + if( $devdetails->hasCap('ucd_ssCpuRawUser') ) + { + $cpuMultiParam = { + 'graph-lower-limit' => '0', + 'rrd-hwpredict' => 'disabled', + 'vertical-label' => 'Cpu Usage', + 'comment' => 'Cpu Idle, Sys, User', + 'ds-names' => 'idle,sys,user', + 'ds-type' => 'rrd-multigraph' + }; + + push( @templates, + 'UcdSnmp::ucdsnmp-cpu-user', + 'UcdSnmp::ucdsnmp-cpu-system', + 'UcdSnmp::ucdsnmp-cpu-idle' ); + + push( @cpuMultiTemplates, + 'UcdSnmp::ucdsnmp-cpu-user-multi', + 'UcdSnmp::ucdsnmp-cpu-system-multi', + 'UcdSnmp::ucdsnmp-cpu-idle-multi' ); + + if( $devdetails->hasCap('ucd_ssCpuRawWait') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-cpu-wait' ); + push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-wait-multi' ); + + $cpuMultiParam->{'comment'} .= ', Wait'; + $cpuMultiParam->{'ds-names'} .= ',wait'; + } + + if( $devdetails->hasCap('ucd_ssCpuRawKernel') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-cpu-kernel' ); + push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-kernel-multi' ); + + $cpuMultiParam->{'comment'} .= ', Kernel'; + $cpuMultiParam->{'ds-names'} .= ',kernel'; + } + + if( $devdetails->hasCap('ucd_ssCpuRawNice') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-cpu-nice' ); + push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-nice-multi' ); + + $cpuMultiParam->{'comment'} .= ', Nice'; + $cpuMultiParam->{'ds-names'} .= ',nice'; + } + + if( $devdetails->hasCap('ucd_ssCpuRawInterrupts') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-cpu-interrupts' ); + push( @cpuMultiTemplates, + 'UcdSnmp::ucdsnmp-cpu-interrupts-multi' ); + + $cpuMultiParam->{'comment'} .= ', Interrupts'; + $cpuMultiParam->{'ds-names'} .= ',int'; + } + + if( $devdetails->hasCap('ucd_ssCpuRawSoftIRQ') ) + { + push( @templates, 'UcdSnmp::ucdsnmp-cpu-softirq' ); + push( @cpuMultiTemplates, + 'UcdSnmp::ucdsnmp-cpu-softirq-multi' ); + + $cpuMultiParam->{'comment'} .= ', SoftIRQs'; + $cpuMultiParam->{'ds-names'} .= ',softirq'; + } + + $cpuMultiParam->{'comment'} =~ s/\,\s+(\w+)$/ and $1/; + } + + my $perfNode = $cb->addSubtree( $devNode, $subtreeName, + undef, \@templates); + + if( $cpuMultiParam ) + { + $cb->addLeaf( $perfNode, 'Cpu_Stats', + $cpuMultiParam, \@cpuMultiTemplates ); + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/DevDiscover/Xylan.pm b/torrus/perllib/Torrus/DevDiscover/Xylan.pm new file mode 100644 index 000000000..6d1c89406 --- /dev/null +++ b/torrus/perllib/Torrus/DevDiscover/Xylan.pm @@ -0,0 +1,199 @@ +# 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: Xylan.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Xylan (Alcatel) switch discovery. + +# Tested with: +# +# Xylan OmniSwitch 9x +# Xylan OmniStack 5024 +# Switch software: X/OS 4.3.3 +# +# Virtual ports are not processed yet + + +package Torrus::DevDiscover::Xylan; + +use strict; +use Torrus::Log; + + +$Torrus::DevDiscover::registry{'Xylan'} = { + 'sequence' => 500, + 'checkdevtype' => \&checkdevtype, + 'discover' => \&discover, + 'buildConfig' => \&buildConfig + }; + + +our %oiddef = + ( + # XYLAN-BASE-MIB + 'xylanSwitchDevice' => '1.3.6.1.4.1.800.3.1.1', + # PORT-MIB::phyPortTable + 'xylanPhyPortTable' => '1.3.6.1.4.1.800.2.3.3.1', + # PORT-MIB::phyPortDescription + 'xylanPhyPortDescription' => '1.3.6.1.4.1.800.2.3.3.1.1.4', + # PORT-MIB::phyPortToInterface + 'xylanPhyPortToInterface' => '1.3.6.1.4.1.800.2.3.3.1.1.19' + ); + +# Not all interfaces are normally needed to monitor. +# You may override the interface filtering in devdiscover-siteconfig.pl: +# redefine $Torrus::DevDiscover::Xylan::interfaceFilter +# or define $Torrus::DevDiscover::Xylan::interfaceFilterOverlay + +our $interfaceFilter; +our $interfaceFilterOverlay; +my %xylInterfaceFilter; + +if( not defined( $interfaceFilter ) ) +{ + $interfaceFilter = \%xylInterfaceFilter; +} + + +# 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 +%xylInterfaceFilter = + ( + 'vnN' => { + 'ifType' => 53 # propVirtual + }, + 'loN' => { + 'ifType' => 24 # softwareLoopback + } + ); + +sub checkdevtype +{ + my $dd = shift; + my $devdetails = shift; + + if( not $dd->oidBaseMatch + ( 'xylanSwitchDevice', + $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(); + + $data->{'nameref'}{'ifNick'} = 'xylanInterfaceNick'; + $data->{'nameref'}{'ifSubtreeName'} = 'xylanInterfaceNick'; + $data->{'nameref'}{'ifComment'} = 'xylanInterfaceComment'; + $data->{'nameref'}{'ifReferenceName'} = 'xylanInterfaceHumanName'; + + my $phyPortTable = + $session->get_table( -baseoid => $dd->oiddef('xylanPhyPortTable') ); + + if( not defined $phyPortTable ) + { + Error('Error retrieving PORT-MIB::phyPortTable from Xylan device'); + return 0; + } + + $devdetails->storeSnmpVars( $phyPortTable ); + + foreach my $slotDotPort + ( $devdetails-> + getSnmpIndices( $dd->oiddef('xylanPhyPortDescription') ) ) + { + my ( $slot, $port ) = split( '\.', $slotDotPort ); + + my $ifIndex = + $devdetails->snmpVar($dd->oiddef('xylanPhyPortToInterface') . + '.' . $slotDotPort); + my $interface = $data->{'interfaces'}{$ifIndex}; + + if( defined $interface ) + { + $interface->{'xylanInterfaceNick'} = + sprintf( '%d_%d', $slot, $port ); + + $interface->{'xylanInterfaceHumanName'} = + sprintf( '%d/%d', $slot, $port ); + + $interface->{'xylanInterfaceComment'} = + $devdetails->snmpVar($dd->oiddef('xylanPhyPortDescription') . + '.' . $slotDotPort); + } + } + + # verify if all interfaces are processed + + foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) + { + my $interface = $data->{'interfaces'}{$ifIndex}; + + if( not defined( $interface->{'xylanInterfaceNick'} ) ) + { + Warn('Interface ' . $ifIndex . ' is not in phyPortTable'); + + my $nick = sprintf( 'PORT%d', $ifIndex ); + $interface->{'xylanInterfaceNick'} = $nick; + $interface->{'xylanInterfaceHumanName'} = $nick; + + $interface->{'xylanInterfaceComment'} = $interface->{'ifDescr'}; + } + } + + 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/Log.pm b/torrus/perllib/Torrus/Log.pm new file mode 100644 index 000000000..3c2c824ee --- /dev/null +++ b/torrus/perllib/Torrus/Log.pm @@ -0,0 +1,136 @@ +# This file was initially taken from Cricket, and reworked later +# +# Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc. +# 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: Log.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# 2002/06/25 11:35:00 ssinyagin +# Taken from Cricket lib/Common/Log.pm +# +# 2004/06/25 ssinyagin +# Finally reworked in 2 years! +# + +package Torrus::Log; + +use strict; + +require Exporter; +our @ISA = qw(Exporter); + +our @EXPORT = qw(Debug Warn Info Error Verbose isDebug); + +my @monthNames = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', + 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ); + +my %logLevel = ( + 'debug' => 9, + 'verbose' => 8, + 'info' => 7, + 'warn' => 5, + 'error' => 1 ); + +my $currentLogLevel = $logLevel{'info'}; + +sub Log +{ + my( $level, @msg ) = @_; + + $level = $logLevel{$level}; + + if( $level <= $currentLogLevel ) + { + my $severity = ( $level <= $logLevel{'warn'} ) ? '*' : ' '; + printf STDERR ( "[%s%s] %s\n", + timeStr( time() ), $severity, join( '', @msg ) ); + } + return undef; +} + + +sub Error +{ + Log( 'error', @_ ); +} + +sub Warn +{ + Log( 'warn', @_); +} + +sub Info +{ + Log( 'info', @_ ); +} + +sub Verbose +{ + Log( 'verbose', @_ ); +} + +our $TID = 0; +sub setTID +{ + $TID = shift; +} + +sub Debug +{ + Log( 'debug', $$ . '.' . $TID . ' ', join('|', @_) ); +} + + +sub isDebug +{ + return $currentLogLevel >= $logLevel{'debug'}; +} + +sub timeStr +{ + my $t = shift; + + my( $sec, $min, $hour, $mday, $mon, $year) = localtime( $t ); + + return sprintf('%02d-%s-%04d %02d:%02d:%02d', + $mday, $monthNames[$mon], $year + 1900, $hour, $min, $sec); +} + +sub setLevel +{ + my $level = lc( shift ); + + if( defined( $logLevel{$level} ) ) + { + $currentLogLevel = $logLevel{$level}; + } + else + { + Error("Log level name '$level' unknown. Defaulting to 'info'"); + $currentLogLevel = $logLevel{'info'}; + } +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# tab-width: 4 +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Monitor.pm b/torrus/perllib/Torrus/Monitor.pm new file mode 100644 index 000000000..72e5c2433 --- /dev/null +++ b/torrus/perllib/Torrus/Monitor.pm @@ -0,0 +1,700 @@ +# 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: Monitor.pm,v 1.1 2010-12-27 00:03:37 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Monitor; +@Torrus::Monitor::ISA = qw(Torrus::Scheduler::PeriodicTask); + +use strict; + +use Torrus::DB; +use Torrus::ConfigTree; +use Torrus::Scheduler; +use Torrus::DataAccess; +use Torrus::TimeStamp; +use Torrus::Log; + + +sub new +{ + my $proto = shift; + my %options = @_; + + if( not $options{'-Name'} ) + { + $options{'-Name'} = "Monitor"; + } + + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new( %options ); + bless $self, $class; + + + $self->{'tree_name'} = $options{'-TreeName'}; + $self->{'sched_data'} = $options{'-SchedData'}; + $self->{'delay'} = $options{'-Delay'} * 60; + + return $self; +} + + +sub addTarget +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + if( not defined( $self->{'targets'} ) ) + { + $self->{'targets'} = []; + } + push( @{$self->{'targets'}}, $token ); +} + + + + +sub run +{ + my $self = shift; + + my $config_tree = + new Torrus::ConfigTree( -TreeName => $self->{'tree_name'}, + -Wait => 1 ); + if( not defined( $config_tree ) ) + { + return; + } + + my $da = new Torrus::DataAccess; + + $self->{'db_alarms'} = new Torrus::DB('monitor_alarms', + -Subdir => $self->{'tree_name'}, + -WriteAccess => 1); + + foreach my $token ( @{$self->{'targets'}} ) + { + &Torrus::DB::checkInterrupted(); + + my $mlist = $self->{'sched_data'}{'mlist'}{$token}; + + foreach my $mname ( @{$mlist} ) + { + my $obj = { 'token' => $token, 'mname' => $mname }; + + $obj->{'da'} = $da; + + my $mtype = $config_tree->getParam($mname, 'monitor-type'); + $obj->{'mtype'} = $mtype; + + my $method = 'check_' . $mtype; + my( $alarm, $timestamp ) = $self->$method( $config_tree, $obj ); + $obj->{'alarm'} = $alarm; + $obj->{'timestamp'} = $timestamp; + + Debug("Monitor $mname returned ($alarm, $timestamp) ". + "for token $token"); + + $self->setAlarm( $config_tree, $obj ); + undef $obj; + } + } + + $self->cleanupExpired(); + + undef $self->{'db_alarms'}; +} + + +sub check_failures +{ + my $self = shift; + my $config_tree = shift; + my $obj = shift; + + my $token = $obj->{'token'}; + 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 ($value, $timestamp) = $obj->{'da'}->read_RRD_DS( $dir.'/'.$file, + 'FAILURES', $ds ); + return( $value > 0 ? 1:0, $timestamp ); + +} + + +sub check_expression +{ + my $self = shift; + my $config_tree = shift; + my $obj = shift; + + my $token = $obj->{'token'}; + my $mname = $obj->{'mname'}; + + my ($value, $timestamp) = $obj->{'da'}->read( $config_tree, $token ); + $value = 'UNKN' unless defined($value); + + my $expr = $value . ',' . $config_tree->getParam($mname,'rpn-expr'); + $expr = $self->substitute_vars( $config_tree, $obj, $expr ); + + my $display_expr = $config_tree->getParam($mname,'display-rpn-expr'); + if( defined( $display_expr ) ) + { + $display_expr = + $self->substitute_vars( $config_tree, $obj, + $value . ',' . $display_expr ); + my ($dv, $dt) = $obj->{'da'}->read_RPN( $config_tree, $token, + $display_expr, $timestamp ); + $obj->{'display_value'} = $dv; + } + else + { + $obj->{'display_value'} = $value; + } + + return $obj->{'da'}->read_RPN( $config_tree, $token, $expr, $timestamp ); +} + + +sub substitute_vars +{ + my $self = shift; + my $config_tree = shift; + my $obj = shift; + my $expr = shift; + + my $token = $obj->{'token'}; + my $mname = $obj->{'mname'}; + + if( index( $expr, '#' ) >= 0 ) + { + my $vars; + if( exists( $self->{'varscache'}{$token} ) ) + { + $vars = $self->{'varscache'}{$token}; + } + else + { + my $varstring = + $config_tree->getNodeParam( $token, 'monitor-vars' ); + foreach my $pair ( split( '\s*;\s*', $varstring ) ) + { + my( $var, $value ) = split( '\s*\=\s*', $pair ); + $vars->{$var} = $value; + } + $self->{'varscache'}{$token} = $vars; + } + + my $ok = 1; + while( index( $expr, '#' ) >= 0 and $ok ) + { + if( not $expr =~ /\#(\w+)/ ) + { + Error("Error in monitor expression: $expr for monitor $mname"); + $ok = 0; + } + else + { + my $var = $1; + my $val = $vars->{$var}; + if( not defined $val ) + { + Error("Unknown variable $var in monitor $mname"); + $ok = 0; + } + else + { + $expr =~ s/\#$var/$val$1/g; + } + } + } + + } + + return $expr; +} + + + +sub setAlarm +{ + my $self = shift; + my $config_tree = shift; + my $obj = shift; + + my $token = $obj->{'token'}; + my $mname = $obj->{'mname'}; + my $alarm = $obj->{'alarm'}; + my $timestamp = $obj->{'timestamp'}; + + my $key = $mname . ':' . $config_tree->path($token); + + my $prev_values = $self->{'db_alarms'}->get( $key ); + my ($t_set, $t_expires, $prev_status, $t_last_change); + if( defined($prev_values) ) + { + Debug("Previous state found, Alarm: $alarm, ". + "Token: $token, Monitor: $mname"); + ($t_set, $t_expires, $prev_status, $t_last_change) = + split(':', $prev_values); + } + + my $event; + + $t_last_change = time(); + + if( $alarm ) + { + if( not $prev_status ) + { + $t_set = $timestamp; + $event = 'set'; + } + else + { + $event = 'repeat'; + } + } + else + { + if( $prev_status ) + { + $t_expires = $t_last_change + + $config_tree->getParam($mname, 'expires'); + $event = 'clear'; + } + else + { + if( defined($t_expires) and time() > $t_expires ) + { + $self->{'db_alarms'}->del( $key ); + $event = 'forget'; + } + } + } + + if( $event ) + { + Debug("Event: $event, Monitor: $mname, Token: $token"); + $obj->{'event'} = $event; + + my $action_token = $token; + + my $action_target = + $config_tree->getNodeParam($token, 'monitor-action-target'); + if( defined( $action_target ) ) + { + Debug('Action target redirected to ' . $action_target); + $action_token = $config_tree->getRelative($token, $action_target); + Debug('Redirected to token ' . $action_token); + } + $obj->{'action_token'} = $action_token; + + foreach my $aname (split(',', + $config_tree->getParam($mname, 'action'))) + { + &Torrus::DB::checkInterrupted(); + + Debug("Running action: $aname"); + my $method = 'run_event_' . + $config_tree->getParam($aname, 'action-type'); + $self->$method( $config_tree, $aname, $obj ); + } + + if( $event ne 'forget' ) + { + $self->{'db_alarms'}->put( $key, + join(':', ($t_set, + $t_expires, + ($alarm ? 1:0), + $t_last_change)) ); + } + } +} + + +# If an alarm is no longer in ConfigTree, it is not cleaned by setAlarm. +# We clean them up explicitly after they expire + +sub cleanupExpired +{ + my $self = shift; + + &Torrus::DB::checkInterrupted(); + + my $cursor = $self->{'db_alarms'}->cursor(-Write => 1); + while( my ($key, $timers) = $self->{'db_alarms'}->next($cursor) ) + { + my ($t_set, $t_expires, $prev_status, $t_last_change) = + split(':', $timers); + + if( $t_last_change and + time() > ( $t_last_change + $Torrus::Monitor::alarmTimeout ) and + ( (not $t_expires) or (time() > $t_expires) ) ) + { + my ($mname, $path) = split(':', $key); + + Info('Cleaned up an orphaned alarm: monitor=' . $mname . + ', path=' . $path); + $self->{'db_alarms'}->c_del( $cursor ); + } + } + undef $cursor; + + &Torrus::DB::checkInterrupted(); +} + + + + + +sub run_event_tset +{ + my $self = shift; + my $config_tree = shift; + my $aname = shift; + my $obj = shift; + + my $token = $obj->{'action_token'}; + my $event = $obj->{'event'}; + + if( $event eq 'set' or $event eq 'forget' ) + { + my $tset = 'S'.$config_tree->getParam($aname, 'tset-name'); + + if( $event eq 'set' ) + { + $config_tree->tsetAddMember($tset, $token, 'monitor'); + } + else + { + $config_tree->tsetDelMember($tset, $token); + } + } +} + + +sub run_event_exec +{ + my $self = shift; + my $config_tree = shift; + my $aname = shift; + my $obj = shift; + + my $token = $obj->{'action_token'}; + my $event = $obj->{'event'}; + my $mname = $obj->{'mname'}; + my $timestamp = $obj->{'timestamp'}; + + my $launch_when = $config_tree->getParam($aname, 'launch-when'); + if( not defined $launch_when ) + { + $launch_when = 'set'; + } + + if( grep {$event eq $_} split(',', $launch_when) ) + { + my $cmd = $config_tree->getParam($aname, 'command'); + $cmd =~ s/\>\;/\>/; + $cmd =~ s/\<\;/\</; + + $ENV{'TORRUS_BIN'} = $Torrus::Global::pkgbindir; + $ENV{'TORRUS_UPTIME'} = time() - $self->whenStarted(); + + $ENV{'TORRUS_TREE'} = $config_tree->treeName(); + $ENV{'TORRUS_TOKEN'} = $token; + $ENV{'TORRUS_NODEPATH'} = $config_tree->path( $token ); + + my $nick = + $config_tree->getNodeParam( $token, 'descriptive-nickname' ); + if( not defined( $nick ) ) + { + $nick = $ENV{'TORRUS_NODEPATH'}; + } + $ENV{'TORRUS_NICKNAME'} = $nick; + + $ENV{'TORRUS_NCOMMENT'} = + $config_tree->getNodeParam( $token, 'comment', 1 ); + $ENV{'TORRUS_NPCOMMENT'} = + $config_tree->getNodeParam( $config_tree->getParent( $token ), + 'comment', 1 ); + $ENV{'TORRUS_EVENT'} = $event; + $ENV{'TORRUS_MONITOR'} = $mname; + $ENV{'TORRUS_MCOMMENT'} = $config_tree->getParam($mname, 'comment'); + $ENV{'TORRUS_TSTAMP'} = $timestamp; + + if( defined( $obj->{'display_value'} ) ) + { + $ENV{'TORRUS_VALUE'} = $obj->{'display_value'}; + + my $format = $config_tree->getParam($mname, 'display-format'); + if( not defined( $format ) ) + { + $format = '%.2f'; + } + + $ENV{'TORRUS_DISPLAY_VALUE'} = + sprintf( $format, $obj->{'display_value'} ); + } + + my $severity = $config_tree->getParam($mname, 'severity'); + if( defined( $severity ) ) + { + $ENV{'TORRUS_SEVERITY'} = $severity; + } + + my $setenv_params = + $config_tree->getParam($aname, 'setenv-params'); + + if( defined( $setenv_params ) ) + { + foreach my $param ( split( ',', $setenv_params ) ) + { + # We retrieve the param from the monitored token, not + # from action-token + my $value = $config_tree->getNodeParam( $obj->{'token'}, + $param ); + if( not defined $value ) + { + Warn('Parameter ' . $param . ' referenced in action '. + $aname . ', but not defined for ' . + $config_tree->path($obj->{'token'})); + $value = ''; + } + $param =~ s/\W/_/g; + my $envName = 'TORRUS_P_'.$param; + Debug("Setting environment $envName to $value"); + $ENV{$envName} = $value; + } + } + + my $setenv_dataexpr = + $config_tree->getParam($aname, 'setenv-dataexpr'); + + if( defined( $setenv_dataexpr ) ) + { + # <param name="setenv_dataexpr" value="ENV1=expr1, ENV2=expr2"/> + # Integrity checks are done at compilation time. + foreach my $pair ( split( ',', $setenv_dataexpr ) ) + { + my ($env, $param) = split( '=', $pair ); + my $expr = $config_tree->getParam($aname, $param); + my ($value, $timestamp) = + $obj->{'da'}->read_RPN( $config_tree, $token, $expr ); + my $envName = 'TORRUS_'.$env; + Debug("Setting environment $envName to $value"); + $ENV{$envName} = $value; + } + } + + Debug("Going to run command: $cmd"); + my $status = system($cmd); + if( $status != 0 ) + { + Error("$cmd executed with error: $!"); + } + + # Clean up the environment + foreach my $envName ( keys %ENV ) + { + if( $envName =~ /^TORRUS_/ ) + { + delete $ENV{$envName}; + } + } + } +} + + + +####### Monitor scheduler ######## + +package Torrus::MonitorScheduler; +@Torrus::MonitorScheduler::ISA = qw(Torrus::Scheduler); + +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::Scheduler; +use Torrus::TimeStamp; + +sub beforeRun +{ + my $self = shift; + + 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(); + + # 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 $known_ts = Torrus::TimeStamp::get($tree . ':monitor_cache'); + my $actual_ts = $config_tree->getTimestamp(); + if( $actual_ts >= $known_ts ) + { + if( $self->{'delay'} > 0 ) + { + Info(sprintf('Delaying for %d seconds', $self->{'delay'})); + sleep( $self->{'delay'} ); + } + + Info("Rebuilding monitor cache"); + Debug("Config TS: $actual_ts, Monitor TS: $known_ts"); + + undef $data->{'targets'}; + $need_new_tasks = 1; + + $data->{'db_tokens'} = new Torrus::DB( 'monitor_tokens', + -Subdir => $tree, + -WriteAccess => 1, + -Truncate => 1 ); + $self->cacheMonitors( $config_tree, $config_tree->token('/') ); + # explicitly close, since we don't need it often, and sometimes + # open it in read-only mode + $data->{'db_tokens'}->closeNow(); + undef $data->{'db_tokens'}; + + # Set the timestamp + &Torrus::TimeStamp::setNow($tree . ':monitor_cache'); + } + Torrus::TimeStamp::release(); + + &Torrus::DB::checkInterrupted(); + + if( not $need_new_tasks and not defined $data->{'targets'} ) + { + $need_new_tasks = 1; + + $data->{'db_tokens'} = new Torrus::DB('monitor_tokens', + -Subdir => $tree); + my $cursor = $data->{'db_tokens'}->cursor(); + while( my ($token, $schedule) = $data->{'db_tokens'}->next($cursor) ) + { + my ($period, $offset, $mlist) = split(':', $schedule); + if( not exists( $data->{'targets'}{$period}{$offset} ) ) + { + $data->{'targets'}{$period}{$offset} = []; + } + push( @{$data->{'targets'}{$period}{$offset}}, $token ); + $data->{'mlist'}{$token} = []; + push( @{$data->{'mlist'}{$token}}, split(',', $mlist) ); + } + undef $cursor; + $data->{'db_tokens'}->closeNow(); + undef $data->{'db_tokens'}; + } + + &Torrus::DB::checkInterrupted(); + + # Now fill in Scheduler's task list, if needed + + if( $need_new_tasks ) + { + Verbose("Initializing tasks"); + my $init_start = time(); + $self->flushTasks(); + + foreach my $period ( keys %{$data->{'targets'}} ) + { + foreach my $offset ( keys %{$data->{'targets'}{$period}} ) + { + my $monitor = new Torrus::Monitor( -Period => $period, + -Offset => $offset, + -TreeName => $tree, + -SchedData => $data ); + + foreach my $token ( @{$data->{'targets'}{$period}{$offset}} ) + { + &Torrus::DB::checkInterrupted(); + + $monitor->addTarget( $config_tree, $token ); + } + + $self->addTask( $monitor ); + } + } + Verbose(sprintf("Tasks initialization finished in %d seconds", + time() - $init_start)); + } + + Verbose("Monitor initialized"); + + return 1; +} + + +sub cacheMonitors +{ + my $self = shift; + my $config_tree = shift; + my $ptoken = shift; + + my $data = $self->data(); + + foreach my $ctoken ( $config_tree->getChildren( $ptoken ) ) + { + &Torrus::DB::checkInterrupted(); + + if( $config_tree->isSubtree( $ctoken ) ) + { + $self->cacheMonitors( $config_tree, $ctoken ); + } + elsif( $config_tree->isLeaf( $ctoken ) and + ( $config_tree->getNodeParam($ctoken, 'ds-type') ne + 'rrd-multigraph') ) + { + my $mlist = $config_tree->getNodeParam( $ctoken, 'monitor' ); + if( defined $mlist ) + { + my $period = sprintf('%d', + $config_tree->getNodeParam + ( $ctoken, 'monitor-period' ) ); + my $offset = sprintf('%d', + $config_tree->getNodeParam + ( $ctoken, 'monitor-timeoffset' ) ); + + $data->{'db_tokens'}->put( $ctoken, + $period.':'.$offset.':'.$mlist ); + + push( @{$data->{'targets'}{$period}{$offset}}, $ctoken ); + $data->{'mlist'}{$ctoken} = []; + push( @{$data->{'mlist'}{$ctoken}}, split(',', $mlist) ); + } + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/RPN.pm b/torrus/perllib/Torrus/RPN.pm new file mode 100644 index 000000000..20fe15a16 --- /dev/null +++ b/torrus/perllib/Torrus/RPN.pm @@ -0,0 +1,213 @@ +# +# Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc. +# 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: RPN.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# a simple little RPN calculator -- implements the same operations +# that RRDTool does. + +# This file is based on Cricket's RPM.pm + +package Torrus::RPN; + +use strict; + +use Torrus::Log; +use Math::BigFloat; + +# Each RPN operator is defined by an array reference with the +# following elements: <number of args>, <subroutine>, <accepts undef> + +my $operators = { + '+' => [ 2, sub{ $_[0] + $_[1]; } ], + '-' => [ 2, sub{ $_[0] - $_[1]; } ], + '*' => [ 2, sub{ $_[0] * $_[1]; } ], + '/' => [ 2, sub{ $_[0] / $_[1]; } ], + '%' => [ 2, sub{ $_[0] % $_[1]; } ], + 'MOD' => [ 2, sub{ $_[0] % $_[1]; } ], + 'SIN' => [ 1, sub{ sin($_[0]->bsstr()); } ], + 'COS' => [ 1, sub{ cos($_[0]->bsstr()); } ], + 'LOG' => [ 1, sub{ log($_[0]); } ], + 'EXP' => [ 1, sub{ $_[0]->exponent() } ], + 'FLOOR' => [ 1, sub{ $_[0]->bfloor(); } ], + 'CEIL' => [ 1, sub{ $_[0]->bceil(); } ], + 'LT' => [ 2, sub{ ($_[0] < $_[1]) ? 1:0; } ], + 'LE' => [ 2, sub{ ($_[0] <= $_[1]) ? 1:0; } ], + 'GT' => [ 2, sub{ ($_[0] > $_[1]) ? 1:0; } ], + 'GE' => [ 2, sub{ ($_[0] >= $_[1]) ? 1:0; } ], + 'EQ' => [ 2, sub{ ($_[0] == $_[1]) ? 1:0; } ], + 'IF' => [ 3, sub{ defined($_[0]) ? ($_[0] ? $_[1] : $_[2]) : undef; }, 1], + 'MIN' => [ 2, sub{ ($_[0] < $_[1]) ? $_[0] : $_[1]; } ], + 'MAX' => [ 2, sub{ ($_[0] > $_[1]) ? $_[0] : $_[1]; } ], + 'UN' => [ 1, sub{ defined($_[0]) ? $_[0]->is_nan() : 1; }, 1 ], + 'UNKN' => [ 0, sub{ undef; } ], + # Operators not defined in RRDtool graph + 'NE' => [ 2, sub{ ($_[0] != $_[1]) ? 1:0; } ], + 'AND' => [ 2, sub{ ($_[0] and $_[1]) ? 1:0; } ], + 'OR' => [ 2, sub{ ($_[0] or $_[1]) ? 1:0; } ], + 'NOT' => [ 1, sub{ (not $_[0]) ? 1:0; } ], + 'ABS' => [ 1, sub{ abs($_[0]); } ], + 'NOW' => [ 0, sub{ time(); } ], + 'DUP' => [ 1, sub{ ($_[0], $_[0]);}, 1 ], + 'EXC' => [ 2, sub{ ($_[1], $_[0]); }, 1 ], + 'NUM' => [ 1, sub{ defined($_[0]) ? $_[0] : 0; }, 1 ], + 'INF' => [ 0, sub{ Math::BigFloat->binf(); } ], + 'NEGINF' => [ 0, sub{ Math::BigFloat->binf('-'); } ] + }; + + +sub new +{ + my $type = shift; + my $self = {}; + bless( $self, $type ); + $self->{'stack'} = []; + return $self; +} + + +sub operator +{ + my $self = shift; + my $op = shift; + + my $n_args = $operators->{$op}->[0]; + my $action = $operators->{$op}->[1]; + my $acceptsUndefined = $operators->{$op}->[2]; + my @args = (); + my $allDefined = 1; + for( my $i = 0; $i < $n_args; $i++ ) + { + my $arg = $self->popStack(); + if( defined( $arg ) or $acceptsUndefined ) + { + push( @args, $arg ); + } + else + { + $allDefined = 0; + } + } + $self->pushStack( $allDefined ? &{$action}(reverse @args) : undef ); +} + + +sub popStack +{ + my $self = shift; + + my $ret; + if( scalar( @{$self->{'stack'}} ) == 0 ) + { + Warn("Stack underflow"); + } + else + { + $ret = pop( @{$self->{'stack'}} ); + } + return $ret; +} + + +sub pushStack +{ + my $self = shift; + my @items = @_; + + push( @{$self->{'stack'}}, @items ); +} + + +sub translate +{ + my $self = shift; + my $string = shift; + my $callback = shift; + + # Debug("Translating RPN: $string"); + my $item; + my @new_items; + foreach $item ( split( /,/, $string ) ) + { + if( $item =~ /^\{([^\}]*)\}$/ ) + { + my $noderef = $1; + my $timeoffset; + if( $noderef =~ s/\(([^\)]+)\)// ) + { + $timeoffset = $1; + } + my $value = &{$callback}( $noderef, $timeoffset ); + $value = 'UNKN' unless defined( $value ); + # Debug("$item translated into $value"); + $item = $value; + } + elsif( $item eq 'MOD' ) + { + # In Torrus parameter value, percent sign is reserved for + # parameter expansion. Rrdtool understands % only. + $item = '%'; + } + push( @new_items, $item ); + } + + $string = join( ',', @new_items ); + # Debug("RPN translated: $string"); + return $string; +} + + +sub run +{ + my $self = shift; + my $string = shift; + my $callback = shift; + + # Debug("Input RPN: $string"); + + if( index( $string, '{' ) >= 0 ) + { + $string = $self->translate( $string, $callback ); + } + + my $item; + foreach $item ( split( /,/, $string ) ) + { + if( ref( $operators->{$item} ) ) + { + $self->operator($item); + } + else + { + $self->pushStack( Math::BigFloat->new($item) ); + } + } + + my $retval = $self->popStack(); + # Debug("RPN result: $retval"); + return $retval; +} + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Renderer.pm b/torrus/perllib/Torrus/Renderer.pm new file mode 100644 index 000000000..803dd1858 --- /dev/null +++ b/torrus/perllib/Torrus/Renderer.pm @@ -0,0 +1,286 @@ +# 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: Renderer.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Renderer; + +use strict; +use Digest::MD5 qw(md5_hex); + +use Torrus::DB; +use Torrus::ConfigTree; +use Torrus::TimeStamp; +use Torrus::RPN; +use Torrus::Log; +use Torrus::SiteConfig; + +use Torrus::Renderer::HTML; +use Torrus::Renderer::RRDtool; + +# Inherit methods from these modules +use base qw(Torrus::Renderer::HTML + Torrus::Renderer::RRDtool + Torrus::Renderer::Frontpage + Torrus::Renderer::AdmInfo); + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + + if( not defined $Torrus::Global::cacheDir ) + { + Error('$Torrus::Global::cacheDir must be defined'); + return undef; + } + elsif( not -d $Torrus::Global::cacheDir ) + { + Error("No such directory: $Torrus::Global::cacheDir"); + return undef; + } + + $self->{'db'} = new Torrus::DB('render_cache', -WriteAccess => 1); + if( not defined( $self->{'db'} ) ) + { + return undef; + } + + srand( time() * $$ ); + + return $self; +} + + +# Returns the absolute filename and MIME type: +# +# my($fname, $mimetype) = $renderer->render($config_tree, $token, $view); +# + +sub render +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my %new_options = @_; + + # If no options given, preserve the existing ones + if( %new_options ) + { + $self->{'options'} = \%new_options; + } + + $self->checkAndClearCache( $config_tree ); + + my($t_render, $t_expires, $filename, $mime_type); + + my $tree = $config_tree->treeName(); + + if( not $config_tree->isTset($token) ) + { + if( my $alias = $config_tree->isAlias($token) ) + { + $token = $alias; + } + if( not defined( $config_tree->path($token) ) ) + { + Error("No such token: $token"); + return undef; + } + } + + $view = $config_tree->getDefaultView($token) unless defined $view; + + my $uid = ''; + if( $self->{'options'}->{'uid'} ) + { + $uid = $self->{'options'}->{'uid'}; + } + + my $cachekey = $self->cacheKey( $uid . ':' . $tree . ':' . + $token . ':' . $view ); + + ($t_render, $t_expires, $filename, $mime_type) = + $self->getCache( $cachekey ); + + my $not_in_cache = 0; + + if( not defined( $filename ) ) + { + $filename = Torrus::Renderer::newCacheFileName( $cachekey ); + $not_in_cache = 1; + } + + my $cachefile = $Torrus::Global::cacheDir.'/'.$filename; + + if( ( not $not_in_cache ) and + -f $cachefile and + $t_expires >= time() ) + { + return ($cachefile, $mime_type, $t_expires - time()); + } + + my $method = 'render_' . $config_tree->getParam($view, 'view-type'); + + ($t_expires, $mime_type) = + $self->$method( $config_tree, $token, $view, $cachefile ); + + if( %new_options ) + { + $self->{'options'} = undef; + } + + my @ret; + if( defined($t_expires) and defined($mime_type) ) + { + $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type); + @ret = ($cachefile, $mime_type, $t_expires - time()); + } + + return @ret; +} + + +sub cacheKey +{ + my $self = shift; + my $keystring = shift; + + if( ref( $self->{'options'}->{'variables'} ) ) + { + foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} ) + { + my $val = $self->{'options'}->{'variables'}->{$name}; + $keystring .= ':' . $name . '=' . $val; + } + } + return $keystring; +} + + +sub getCache +{ + my $self = shift; + my $keystring = shift; + + my $cacheval = $self->{'db'}->get( $keystring ); + + if( defined($cacheval) ) + { + return split(':', $cacheval); + } + else + { + return undef; + } +} + + +sub setCache +{ + my $self = shift; + my $keystring = shift; + my $t_render = shift; + my $t_expires = shift; + my $filename = shift; + my $mime_type = shift; + + $self->{'db'}->put( $keystring, + join(':', + ($t_render, $t_expires, $filename, $mime_type))); +} + + + +sub checkAndClearCache +{ + my $self = shift; + my $config_tree = shift; + + my $tree = $config_tree->treeName(); + + Torrus::TimeStamp::init(); + my $known_ts = Torrus::TimeStamp::get($tree . ':renderer_cache'); + my $actual_ts = $config_tree->getTimestamp(); + if( $actual_ts >= $known_ts or + time() >= $known_ts + $Torrus::Renderer::cacheMaxAge ) + { + $self->clearcache(); + Torrus::TimeStamp::setNow($tree . ':renderer_cache'); + } + Torrus::TimeStamp::release(); +} + + +sub clearcache +{ + my $self = shift; + + Debug('Clearing renderer cache'); + my $cursor = $self->{'db'}->cursor( -Write => 1 ); + while( my ($key, $val) = $self->{'db'}->next( $cursor ) ) + { + my($t_render, $t_expires, $filename, $mime_type) = split(':', $val); + + unlink $Torrus::Global::cacheDir.'/'.$filename; + $self->{'db'}->c_del( $cursor ); + } + undef $cursor; + Debug('Renderer cache cleared'); +} + + +sub newCacheFileName +{ + my $cachekey = shift; + return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5)); +} + +sub xmlnormalize +{ + my( $txt )= @_; + + # Remove spaces in the head and tail. + $txt =~ s/^\s+//om; + $txt =~ s/\s+$//om; + + # Unscreen special characters + $txt =~ s/{COLON}/:/ogm; + $txt =~ s/{SEMICOL}/;/ogm; + $txt =~ s/{PERCENT}/%/ogm; + + $txt =~ s/\&/\&\;/ogm; + $txt =~ s/\</\<\;/ogm; + $txt =~ s/\>/\>\;/ogm; + $txt =~ s/\'/\&apos\;/ogm; + $txt =~ s/\"/\"\;/ogm; + + return $txt; +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Renderer/AdmInfo.pm b/torrus/perllib/Torrus/Renderer/AdmInfo.pm new file mode 100644 index 000000000..1cbd5106a --- /dev/null +++ b/torrus/perllib/Torrus/Renderer/AdmInfo.pm @@ -0,0 +1,242 @@ +# 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: AdmInfo.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Renderer::AdmInfo; + +use strict; + +use Torrus::ConfigTree; +use Torrus::Log; +use Torrus::ACL; + +use Template; + +my %rrd_params = + ( + 'leaf-type' => {'rrd-def' => {'rrd-ds' => undef, + 'rrd-cf' => undef, + 'data-file' => undef, + 'data-dir' => undef}, + 'rrd-cdef' => {'rpn-expr' => undef}}, + ); + +my %rrdmulti_params = ( 'ds-names' => undef ); + +my %collector_params = + ( + 'storage-type' => {'rrd' => { + 'data-file' => undef, + 'data-dir' => undef, + 'leaf-type' => { + 'rrd-def' => {'rrd-ds' => undef, + 'rrd-cf' => undef, + 'rrd-create-dstype' => undef, + 'rrd-create-rra' => undef, + 'rrd-create-heartbeat' => undef, + 'rrd-hwpredict' => { + 'enabled' => {'rrd-create-hw-rralen' => undef}, + 'disabled' => undef + }}}}}, + 'collector-type' => undef, + 'collector-period' => undef, + 'collector-timeoffset' => undef, + 'collector-instance' => undef, + 'collector-instance-hashstring' => undef, + 'collector-scale' => undef, + 'collector-dispersed-timeoffset' => { + 'no' => undef, + 'yes' => {'collector-timeoffset-min' => undef, + 'collector-timeoffset-max' => undef, + 'collector-timeoffset-step' => undef, + 'collector-timeoffset-hashstring' => undef}} + ); + + +my %leaf_params = + ('ds-type' => {'rrd-file' => \%rrd_params, + 'rrd-multigraph' => \%rrdmulti_params, + 'collector' => \%collector_params}, + 'rrgraph-views' => undef, + 'rrd-scaling-base' => undef, + 'graph-logarithmic' => undef, + 'graph-rigid-boundaries' => undef, + 'graph-ignore-decorations' => undef, + 'nodeid' => undef); + + +my %param_categories = + ( + 'collector-dispersed-timeoffset' => 'Collector', + 'collector-period' => 'Collector', + 'collector-scale' => 'Collector', + 'collector-timeoffset' => 'Collector', + 'collector-timeoffset-hashstring' => 'Collector', + 'collector-timeoffset-max' => 'Collector', + 'collector-timeoffset-min' => 'Collector', + 'collector-timeoffset-step' => 'Collector', + 'collector-type' => 'Collector', + 'collector-instance' => 'Collector', + 'collector-instance-hashstring' => 'Collector', + 'data-dir' => 'Storage', + 'data-file' => 'Storage', + 'ds-names' => 'Multigraph', + 'ds-type' => 'Common Parameters', + 'graph-ignore-decorations' => 'Display', + 'graph-logarithmic' => 'Display', + 'graph-rigid-boundaries' => 'Display', + 'leaf-type' => 'Common Parameters', + 'nodeid' => 'Common Parameters', + 'rpn-expr' => 'RRD CDEF Paramters', + 'rrd-cf' => 'RRD', + 'rrd-create-dstype' => 'RRD', + 'rrd-create-heartbeat' => 'RRD', + 'rrd-create-hw-rralen' => 'RRD', + 'rrd-create-rra' => 'RRD', + 'rrd-ds' => 'RRD', + 'rrd-hwpredict' => 'RRD', + 'rrd-scaling-base' => 'RRD', + 'rrgraph-views' => 'Display', + 'storage-type' => 'Storage' + ); + + +# Load additional validation, configurable from +# torrus-config.pl and torrus-siteconfig.pl + +foreach my $mod ( @Torrus::Renderer::loadAdmInfo ) +{ + eval( 'require ' . $mod ); + die( $@ ) if $@; + eval( '&' . $mod . '::initAdmInfo( \%leaf_params, \%param_categories )' ); + die( $@ ) if $@; +} + + +# All our methods are imported by Torrus::Renderer; + +sub render_adminfo +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $outfile = shift; + + if( $self->may_display_adminfo( $config_tree, $token ) ) + { + $self->{'adminfo'} = $self->retrieve_adminfo( $config_tree, $token ); + my @ret = $self->render_html( $config_tree, $token, $view, $outfile ); + delete $self->{'adminfo'}; + return @ret; + } + else + { + if( not open(OUT, ">$outfile") ) + { + Error("Cannot open $outfile for writing: $!"); + return undef; + } + else + { + print OUT "Cannot display admin information\n"; + close OUT; + } + + return (300+time(), 'text/plain'); + } +} + + +sub may_display_adminfo +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + if( $config_tree->isLeaf( $token ) ) + { + # hasPrivilege is imported from Torrus::Renderer::HTML + if( $self->hasPrivilege( $config_tree->treeName(), + 'DisplayAdmInfo' ) ) + { + return 1; + } + } + + return 0; +} + + +sub retrieve_adminfo +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + my $ret = {}; + my @namemaps = ( \%leaf_params ); + + while( scalar( @namemaps ) > 0 ) + { + my @next_namemaps = (); + + foreach my $namemap ( @namemaps ) + { + foreach my $paramkey ( keys %{$namemap} ) + { + my $pname = $paramkey; + + my $pval = $config_tree->getNodeParam( $token, $pname ); + if( defined( $pval ) ) + { + if( ref( $namemap->{$paramkey} ) ) + { + if( exists $namemap->{$paramkey}->{$pval} ) + { + if( defined $namemap->{$paramkey}->{$pval} ) + { + push( @next_namemaps, + $namemap->{$paramkey}->{$pval} ); + } + } + } + + my $category = $param_categories{$pname}; + if( not defined( $category ) ) + { + $category = 'Other'; + } + $ret->{$category}{$pname} = $pval; + } + } + } + @namemaps = @next_namemaps; + } + + return $ret; +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Renderer/Frontpage.pm b/torrus/perllib/Torrus/Renderer/Frontpage.pm new file mode 100644 index 000000000..5a9d0a39d --- /dev/null +++ b/torrus/perllib/Torrus/Renderer/Frontpage.pm @@ -0,0 +1,291 @@ +# 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: Frontpage.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Renderer::Frontpage; + +use strict; + +use Torrus::ConfigTree; +use Torrus::Search; +use Torrus::Log; + +use Template; +use URI::Escape; + +# All our methods are imported by Torrus::Renderer; + +sub renderUserLogin +{ + my $self = shift; + my %new_options = @_; + + if( %new_options ) + { + $self->{'options'} = \%new_options; + } + + my($t_render, $t_expires, $filename, $mime_type); + + my $cachekey = $self->cacheKey( 'LOGINSCREEN' ); + + ($t_render, $t_expires, $filename, $mime_type) = + $self->getCache( $cachekey ); + + # We don't check the expiration time for login screen + if( not defined( $filename ) ) + { + $filename = Torrus::Renderer::newCacheFileName( $cachekey ); + } + + my $outfile = $Torrus::Global::cacheDir.'/'.$filename; + + $t_expires = time(); + $mime_type = $Torrus::Renderer::LoginScreen::mimeType; + my $tmplfile = $Torrus::Renderer::LoginScreen::template; + + # Create the Template Toolkit processor once, and reuse + # it in subsequent render() calls + + if( not defined( $self->{'tt'} ) ) + { + $self->{'tt'} = + new Template(INCLUDE_PATH => $Torrus::Global::templateDirs, + TRIM => 1); + } + + my $url = $Torrus::Renderer::rendererURL; + if( length( $self->{'options'}->{'urlPassTree'} ) > 0 ) + { + $url .= '/' . $self->{'options'}->{'urlPassTree'}; + } + + my $ttvars = + { + 'url' => $url, + 'plainURL' => $Torrus::Renderer::plainURL, + 'style' => sub { return $self->style($_[0]); }, + 'companyName'=> $Torrus::Renderer::companyName, + 'companyLogo'=> $Torrus::Renderer::companyLogo, + 'companyURL' => $Torrus::Renderer::companyURL, + 'lostPasswordURL' => $Torrus::Renderer::lostPasswordURL, + 'siteInfo' => $Torrus::Renderer::siteInfo, + 'version' => $Torrus::Global::version, + 'xmlnorm' => \&Torrus::Renderer::xmlnormalize + }; + + + # Pass the options from Torrus::Renderer::render() to Template + while( my( $opt, $val ) = each( %{$self->{'options'}} ) ) + { + $ttvars->{$opt} = $val; + } + + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); + + undef $ttvars; + + my @ret; + if( not $result ) + { + Error("Error while rendering login screen: " . + $self->{'tt'}->error()); + } + else + { + $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type); + @ret = ($outfile, $mime_type, $t_expires - time()); + } + + $self->{'options'} = undef; + + return @ret; +} + + +sub renderTreeChooser +{ + my $self = shift; + my %new_options = @_; + + if( %new_options ) + { + $self->{'options'} = \%new_options; + } + + my($t_render, $t_expires, $filename, $mime_type); + + my $uid = ''; + if( $self->{'options'}->{'uid'} ) + { + $uid = $self->{'options'}->{'uid'}; + } + + my $cachekey = $self->cacheKey( $uid . ':' . 'TREECHOOSER' ); + + ($t_render, $t_expires, $filename, $mime_type) = + $self->getCache( $cachekey ); + + if( defined( $filename ) ) + { + if( $t_expires >= time() ) + { + return ($Torrus::Global::cacheDir.'/'.$filename, + $mime_type, $t_expires - time()); + } + # Else reuse the old filename + } + else + { + $filename = Torrus::Renderer::newCacheFileName( $cachekey ); + } + + my $outfile = $Torrus::Global::cacheDir.'/'.$filename; + + $t_expires = time() + $Torrus::Renderer::Chooser::expires; + $mime_type = $Torrus::Renderer::Chooser::mimeType; + + my $tmplfile; + if( defined( $self->{'options'}{'variables'}{'SEARCH'} ) and + $self->mayGlobalSearch() ) + { + $tmplfile = $Torrus::Renderer::Chooser::searchTemplate; + } + else + { + $tmplfile = $Torrus::Renderer::Chooser::template; + } + + # Create the Template Toolkit processor once, and reuse + # it in subsequent render() calls + + if( not defined( $self->{'tt'} ) ) + { + $self->{'tt'} = + new Template(INCLUDE_PATH => $Torrus::Global::templateDirs, + TRIM => 1); + } + + my $ttvars = + { + 'treeNames' => sub{ return Torrus::SiteConfig::listTreeNames() }, + 'treeDescr' => sub{ return + Torrus::SiteConfig::treeDescription($_[0]) } + , + 'url' => sub { return $Torrus::Renderer::rendererURL . '/' . $_[0] }, + 'plainURL' => $Torrus::Renderer::plainURL, + 'persistentUrl' => sub { return $Torrus::Renderer::rendererURL . '/' . + $_[0] . '?path=' . uri_escape($_[1])} + , + 'clearVar' => sub { delete $self->{'options'}{'variables'}{$_[0]}; + return undef;}, + 'style' => sub { return $self->style($_[0]); }, + 'companyName'=> $Torrus::Renderer::companyName, + 'companyLogo'=> $Torrus::Renderer::companyLogo, + 'companyURL' => $Torrus::Renderer::companyURL, + 'siteInfo' => $Torrus::Renderer::siteInfo, + 'version' => $Torrus::Global::version, + 'xmlnorm' => \&Torrus::Renderer::xmlnormalize, + 'userAuth' => $Torrus::CGI::authorizeUsers, + 'uid' => $self->{'options'}->{'uid'}, + 'userAttr' => sub { return $self->userAttribute( $_[0] ) }, + 'mayDisplayTree' => sub { return $self-> + hasPrivilege( $_[0], 'DisplayTree' ) } + , + 'mayGlobalSearch' => sub { return $self->mayGlobalSearch(); }, + 'searchResults' => sub { return $self->doGlobalSearch($_[0]); } + }; + + + # Pass the options from Torrus::Renderer::render() to Template + while( my( $opt, $val ) = each( %{$self->{'options'}} ) ) + { + $ttvars->{$opt} = $val; + } + + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); + + undef $ttvars; + + my @ret; + if( not $result ) + { + Error("Error while rendering tree chooser: " . + $self->{'tt'}->error()); + } + else + { + $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type); + @ret = ($outfile, $mime_type, $t_expires - time()); + } + + $self->{'options'} = undef; + + return @ret; +} + + +sub mayGlobalSearch +{ + my $self = shift; + + return ( $Torrus::Renderer::globalSearchEnabled and + ( not $Torrus::CGI::authorizeUsers or + ( $self->hasPrivilege( '*', 'GlobalSearch' ) ) ) ); +} + +sub doGlobalSearch +{ + my $self = shift; + my $string = shift; + + my $sr = new Torrus::Search; + $sr->openGlobal(); + my $result = $sr->searchPrefix( $string ); + + my $sorted = []; + push( @{$sorted}, sort {$a->[0] cmp $b->[0]} @{$result} ); + + # remove duplicating entries + my %seen; + my $ret = []; + + foreach my $element ( @{$sorted} ) + { + my $string = join( ':', $element->[0], $element->[1] ); + if( not $seen{$string} ) + { + $seen{$string} = 1; + push( @{$ret}, $element ); + } + } + + return $ret; +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Renderer/HTML.pm b/torrus/perllib/Torrus/Renderer/HTML.pm new file mode 100644 index 000000000..e9f72acf0 --- /dev/null +++ b/torrus/perllib/Torrus/Renderer/HTML.pm @@ -0,0 +1,530 @@ +# 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: HTML.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Renderer::HTML; + +use strict; + +use Torrus::ConfigTree; +use Torrus::Search; +use Torrus::Log; + +use URI::Escape; +use Template; +use POSIX qw(abs log floor pow); +use Date::Parse; +use Date::Format; + +Torrus::SiteConfig::loadStyling(); + +# All our methods are imported by Torrus::Renderer; + +sub render_html +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $outfile = shift; + + my $tmplfile = $config_tree->getParam($view, 'html-template'); + + my $expires = $config_tree->getParam($view, 'expires'); + + # Create the Template Toolkit processor once, and reuse + # it in subsequent render() calls + + if( not defined( $self->{'tt'} ) ) + { + $self->{'tt'} = + new Template(INCLUDE_PATH => $Torrus::Global::templateDirs, + TRIM => 1); + } + my $ttvars = + { + 'treeName' => $config_tree->treeName(), + 'token' => $token, + 'view' => $view, + 'expires' => $expires, + 'path' => sub { return $config_tree->path($_[0]); }, + 'pathToken' => sub { return $config_tree->token($_[0]); }, + 'nodeExists' => sub { return $config_tree->nodeExists($_[0]); }, + 'children' => sub { return $config_tree->getChildren($_[0]); }, + 'isLeaf' => sub { return $config_tree->isLeaf($_[0]); }, + 'isAlias' => sub { return $config_tree->isAlias($_[0]); }, + 'sortTokens' => sub { return $self->sortTokens($config_tree, + $_[0]); }, + 'nodeName' => sub { return $self->nodeName($config_tree, $_[0]); }, + 'parent' => sub { return $config_tree->getParent($_[0]); }, + 'nodeParam' => sub { return $config_tree->getNodeParam(@_); }, + 'param' => sub { return $config_tree->getParam(@_); }, + 'url' => sub { return $self->makeURL($config_tree, 0, @_); }, + 'persistentUrl' => sub { return $self->makeURL($config_tree, 1, @_); }, + 'clearVar' => sub { delete $self->{'options'}{'variables'}{$_[0]}; + return undef;}, + 'plainURL' => $Torrus::Renderer::plainURL, + 'splitUrls' => sub { return $self->makeSplitURLs($config_tree, + $_[0], $_[1]); }, + 'topURL' => ($Torrus::Renderer::rendererURL ne '' ? + $Torrus::Renderer::rendererURL : '/'), + 'rrprint' => sub { return $self->rrPrint($config_tree, + $_[0], $_[1]); }, + 'scale' => sub { return $self->scale($_[0], $_[1]); }, + 'tsetMembers' => sub { $config_tree->tsetMembers($_[0]); }, + 'tsetList' => sub { $config_tree->getTsets(); }, + 'style' => sub { return $self->style($_[0]); }, + 'companyName'=> $Torrus::Renderer::companyName, + 'companyLogo'=> $Torrus::Renderer::companyLogo, + 'companyURL' => $Torrus::Renderer::companyURL, + 'siteInfo' => $Torrus::Renderer::siteInfo, + 'treeInfo' => sub { return $Torrus::Global::treeConfig{ + $config_tree->treeName()}{'info'}; }, + 'version' => $Torrus::Global::version, + 'xmlnorm' => \&Torrus::Renderer::xmlnormalize, + 'userAuth' => $Torrus::CGI::authorizeUsers, + 'uid' => $self->{'options'}->{'uid'}, + 'userAttr' => sub { return $self->userAttribute( $_[0] ) }, + 'mayDisplayAdmInfo' => sub { + return $self->may_display_adminfo( $config_tree, $_[0] ) }, + 'adminfo' => $self->{'adminfo'}, + 'mayDisplayReports' => sub { + return $self->may_display_reports($config_tree) }, + 'reportsUrl' => sub { + return $self->reportsUrl($config_tree); }, + 'timestamp' => sub { return time2str($Torrus::Renderer::timeFormat, + time()); }, + 'verifyDate' => sub { return verifyDate($_[0]); }, + 'markup' => sub{ return $self->translateMarkup( @_ ); }, + 'searchEnabled' => $Torrus::Renderer::searchEnabled, + 'searchResults' => sub { return $self->doSearch($config_tree, $_[0]); } + }; + + + # Pass the options from Torrus::Renderer::render() to Template + while( my( $opt, $val ) = each( %{$self->{'options'}} ) ) + { + $ttvars->{$opt} = $val; + } + + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); + + undef $ttvars; + + if( not $result ) + { + if( $config_tree->isTset( $token ) ) + { + Error("Error while rendering tokenset $token: " . + $self->{'tt'}->error()); + } + else + { + my $path = $config_tree->path($token); + Error("Error while rendering $path: " . + $self->{'tt'}->error()); + } + return undef; + } + + return ($expires+time(), 'text/html; charset=UTF-8'); +} + + +sub nodeName +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + my $n = $config_tree->getNodeParam($token, 'node-display-name', 1); + if( defined( $n ) and length( $n ) > 0 ) + { + return $n; + } + + return $config_tree->nodeName($config_tree->path($token)); +} + + +sub sortTokens +{ + my $self = shift; + my $config_tree = shift; + my $tokenlist = shift; + + my @sorted = (); + if( ref($tokenlist) and scalar(@{$tokenlist}) > 0 ) + { + @sorted = sort + { + my $p_a = $config_tree->getNodeParam($a, 'precedence', 1); + $p_a = 0 unless defined $p_a; + my $p_b = $config_tree->getNodeParam($b, 'precedence', 1); + $p_b = 0 unless defined $p_b; + if( $p_a == $p_b ) + { + my $n_a = $config_tree->path($a); + my $n_b = $config_tree->path($b); + return $n_a cmp $n_b; + } + else + { + return $p_b <=> $p_a; + } + } @{$tokenlist}; + } + else + { + push(@sorted, $tokenlist); + } + return @sorted; +} + + +# compose an URL for a node. +# $persistent defines if the link should be persistent +# Persistent link is done with nodeid if available, or with path + +sub makeURL +{ + my $self = shift; + my $config_tree = shift; + my $persistent = shift; + my $token = shift; + my $view = shift; + my @add_vars = @_; + + my $ret = $Torrus::Renderer::rendererURL . '/' . $config_tree->treeName(); + + if( $persistent ) + { + my $nodeid = $config_tree->getNodeParam($token, 'nodeid', 1); + if( defined( $nodeid ) ) + { + $ret .= '?nodeid=' . + uri_escape($nodeid, $Torrus::Renderer::uriEscapeExceptions); + } + else + { + $ret .= '?path=' . + uri_escape($config_tree->path($token), + $Torrus::Renderer::uriEscapeExceptions); + } + } + else + { + $ret .= '?token=' . uri_escape($token); + } + + if( $view ) + { + $ret .= '&view=' . uri_escape($view); + } + + my %vars = (); + # This could be array or a reference to array + my $add_vars_size = scalar( @add_vars ); + if( $add_vars_size == 1 and ref( $add_vars[0] ) ) + { + %vars = @{$add_vars[0]}; + } + elsif( $add_vars_size > 0 and ($add_vars_size % 2 == 0) ) + { + %vars = @add_vars; + } + + if( ref( $self->{'options'}->{'variables'} ) ) + { + foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} ) + { + my $val = $self->{'options'}->{'variables'}->{$name}; + if( not defined( $vars{$name} ) ) + { + $vars{$name} = $val; + } + } + } + + foreach my $name ( sort keys %vars ) + { + if( $vars{$name} ne '' ) + { + $ret .= '&' . $name . '=' . + uri_escape( $vars{$name}, + $Torrus::Renderer::uriEscapeExceptions ); + } + } + + return $ret; +} + +sub makeSplitURLs +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + + my $ret = ''; + while( defined( $token ) ) + { + my $path = $config_tree->path($token); + + my $str = '<SPAN CLASS="PathElement">'; + $str .= + sprintf('<A HREF="%s">%s%s</A>', + $self->makeURL($config_tree, 0, $token, $view), + $config_tree->nodeName($path), + ( $config_tree->isSubtree($token) and + $path ne '/') ? '/':'' ); + $str .= "</SPAN>\n"; + + $ret = $str . $ret; + + $token = $config_tree->getParent( $token ); + } + + return $ret; +} + + +sub rrPrint +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + + my @ret = (); + my($fname, $mimetype) = $self->render( $config_tree, $token, $view ); + + if( $mimetype ne 'text/plain' ) + { + Error("View $view does not produce text/plain for token $token"); + } + else + { + if( not open(IN, $fname) ) + { + Error("Cannot open $fname for reading: $!"); + } + else + { + chomp(my $values = <IN>); + @ret = split(':', $values); + close IN; + } + } + return @ret; +} + +# This subroutine is taken from Dave Plonka's Flowscan + +sub scale +{ + my $self = shift; + # This is based somewhat on Tobi Oetiker's code in rrd_graph.c: + my $fmt = shift; + my $value = shift; + my @symbols = ("a", # 10e-18 Ato + "f", # 10e-15 Femto + "p", # 10e-12 Pico + "n", # 10e-9 Nano + "u", # 10e-6 Micro + "m", # 10e-3 Milli + " ", # Base + "k", # 10e3 Kilo + "M", # 10e6 Mega + "G", # 10e9 Giga + "T", # 10e12 Terra + "P", # 10e15 Peta + "E"); # 10e18 Exa + + my $symbcenter = 6; + my $digits = (0 == $value)? 0 : floor(log(abs($value))/log(1000)); + return sprintf( $fmt . " %s", $value/pow(1000, $digits), + $symbols[ $symbcenter+$digits ] ); +} + +sub style +{ + my $self = shift; + my $object = shift; + + my $media; + if( not defined( $media = $self->{'options'}->{'variables'}->{'MEDIA'} ) ) + { + $media = 'default'; + } + return $Torrus::Renderer::styling{$media}{$object}; +} + + + +sub userAttribute +{ + my $self = shift; + my $attr = shift; + + if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} ) + { + $self->{'options'}->{'acl'}-> + userAttribute( $self->{'options'}->{'uid'}, $attr ); + } + else + { + return ''; + } +} + +sub hasPrivilege +{ + my $self = shift; + my $object = shift; + my $privilege = shift; + + if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} ) + { + $self->{'options'}->{'acl'}-> + hasPrivilege( $self->{'options'}->{'uid'}, $object, $privilege ); + } + else + { + return undef; + } +} + + +sub translateMarkup +{ + my $self = shift; + my @strings = @_; + + my $tt = new Template( TRIM => 1 ); + + my $ttvars = + { + 'em' => sub { return '<em>' . $_[0] . '</em>'; }, + 'strong' => sub { return '<strong>' . $_[0] . '</strong>'; } + }; + + my $ret = ''; + + foreach my $str ( @strings ) + { + my $output = ''; + my $result = $tt->process( \$str, $ttvars, \$output ); + + if( not $result ) + { + Error('Error translating markup: ' . $tt->error()); + } + else + { + $ret .= $output; + } + } + + undef $tt; + + return $ret; +} + + +sub verifyDate +{ + my $input = shift; + + my $time = str2time( $input ); + # rrdtool does not understand dates prior to 1980 (315529200) + if( defined( $time ) and $time > 315529200 ) + { + # Present the time in format understood by rrdtool + return time2str('%H:%M %Y%m%d', $time); + } + else + { + return ''; + } +} + + +sub may_display_reports +{ + my $self = shift; + my $config_tree = shift; + + if( $Torrus::Renderer::displayReports ) + { + if( not $Torrus::CGI::authorizeUsers ) + { + return 1; + } + + my $tree = $config_tree->treeName(); + if( $self->hasPrivilege( $tree, 'DisplayReports' ) and + -r $Torrus::Global::reportsDir . '/' . $tree . + '/html/index.html' ) + { + return 1; + } + } + return 0; +} + + +sub reportsUrl +{ + my $self = shift; + my $config_tree = shift; + + return $Torrus::Renderer::rendererURL . '/' . + $config_tree->treeName() . '?htmlreport=index.html'; +} + + +sub doSearch +{ + my $self = shift; + my $config_tree = shift; + my $string = shift; + + + my $tree = $config_tree->treeName(); + + my $sr = new Torrus::Search; + $sr->openTree( $tree ); + my $result = $sr->searchPrefix( $string, $tree ); + $sr->closeTree( $tree ); + + my $ret = []; + push( @{$ret}, sort {$a->[0] cmp $b->[0]} @{$result} ); + + return $ret; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Renderer/RRDtool.pm b/torrus/perllib/Torrus/Renderer/RRDtool.pm new file mode 100644 index 000000000..db0cc54a9 --- /dev/null +++ b/torrus/perllib/Torrus/Renderer/RRDtool.pm @@ -0,0 +1,993 @@ +# 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: RRDtool.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::Renderer::RRDtool; + +use strict; + +use Torrus::ConfigTree; +use Torrus::RPN; +use Torrus::Log; + +use RRDs; + +# All our methods are imported by Torrus::Renderer; + +my %rrd_graph_opts = + ( + 'start' => '--start', + 'end' => '--end', + 'width' => '--width', + 'height' => '--height' + ); + +my @arg_arrays = qw(opts defs bg hwtick hrule hwline line fg); + + +sub render_rrgraph +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $outfile = shift; + + if( not $config_tree->isLeaf($token) ) + { + Error("Token $token is not a leaf"); + return undef; + } + + my $obj = {'args' => {}, 'dname' => 'A'}; + + foreach my $arrayName ( @arg_arrays ) + { + $obj->{'args'}{$arrayName} = []; + } + + push( @{$obj->{'args'}{'opts'}}, + $self->rrd_make_opts( $config_tree, $token, $view, + \%rrd_graph_opts, ) ); + + push( @{$obj->{'args'}{'opts'}}, + $self->rrd_make_graph_opts( $config_tree, $token, $view ) ); + + my $dstype = $config_tree->getNodeParam($token, 'ds-type'); + + if( $dstype eq 'rrd-multigraph' ) + { + $self->rrd_make_multigraph( $config_tree, $token, $view, $obj ); + } + else + { + my $leaftype = $config_tree->getNodeParam($token, 'leaf-type'); + + # Handle DEFs and CDEFs + # At the moment, we call the DEF as 'A'. Could change in the future + if( $leaftype eq 'rrd-def' ) + { + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_def( $config_tree, $token, + $obj->{'dname'} ) ); + + if( $self->rrd_check_hw( $config_tree, $token, $view ) ) + { + $self->rrd_make_holtwinters( $config_tree, $token, + $view, $obj ); + } + } + elsif( $leaftype eq 'rrd-cdef' ) + { + my $expr = $config_tree->getNodeParam($token, 'rpn-expr'); + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_cdef($config_tree, $token, + $obj->{'dname'}, $expr) ); + } + else + { + Error("Unsupported leaf-type: $leaftype"); + return undef; + } + + $self->rrd_make_graphline( $config_tree, $token, $view, $obj ); + } + + $self->rrd_make_hrules( $config_tree, $token, $view, $obj ); + if( not $Torrus::Renderer::ignoreDecorations ) + { + $self->rrd_make_decorations( $config_tree, $token, $view, $obj ); + } + + # We're all set + + + my @args; + foreach my $arrayName ( @arg_arrays ) + { + push( @args, @{$obj->{'args'}{$arrayName}} ); + } + Debug("RRDs::graph arguments: " . join(' ', @args)); + + $self->tz_set(); + &RRDs::graph( $outfile, @args ); + $self->tz_restore(); + my $ERR=RRDs::error; + if( $ERR ) + { + my $path = $config_tree->path($token); + Error("$path $view: Error during RRD graph: $ERR"); + return undef; + } + + return( $config_tree->getParam($view, 'expires')+time(), 'image/png' ); +} + + +my %rrd_print_opts = + ( + 'start' => '--start', + 'end' => '--end', + ); + + + +sub render_rrprint +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $outfile = shift; + + if( not $config_tree->isLeaf($token) ) + { + Error("Token $token is not a leaf"); + return undef; + } + + my @arg_opts; + my @arg_defs; + my @arg_print; + + push( @arg_opts, $self->rrd_make_opts( $config_tree, $token, $view, + \%rrd_print_opts, ) ); + + my $dstype = $config_tree->getNodeParam($token, 'ds-type'); + + if( $dstype eq 'rrd-multigraph' ) + { + Error("View type rrprint is not supported ". + "for DS type rrd-multigraph"); + return undef; + } + + my $leaftype = $config_tree->getNodeParam($token, 'leaf-type'); + + # Handle DEFs and CDEFs + # At the moment, we call the DEF as 'A'. Could change in the future + my $dname = 'A'; + if( $leaftype eq 'rrd-def' ) + { + push( @arg_defs, + $self->rrd_make_def( $config_tree, $token, $dname ) ); + } + elsif( $leaftype eq 'rrd-cdef' ) + { + my $expr = $config_tree->getNodeParam($token, 'rpn-expr'); + push( @arg_defs, + $self->rrd_make_cdef($config_tree, $token, $dname, $expr) ); + } + else + { + Error("Unsupported leaf-type: $leaftype"); + return undef; + } + + foreach my $cf ( split(',', $config_tree->getParam($view, 'print-cf')) ) + { + push( @arg_print, sprintf( 'PRINT:%s:%s:%%le', $dname, $cf ) ); + } + + # We're all set + + my @args = ( @arg_opts, @arg_defs, @arg_print ); + Debug("RRDs::graph arguments: " . join(' ', @args)); + + my $printout; + $self->tz_set(); + ($printout, undef, undef) = RRDs::graph('/dev/null', @args); + $self->tz_restore(); + my $ERR=RRDs::error; + if( $ERR ) + { + my $path = $config_tree->path($token); + Error("$path $view: Error during RRD graph: $ERR"); + return undef; + } + + if( not open(OUT, ">$outfile") ) + { + Error("Cannot open $outfile for writing: $!"); + return undef; + } + else + { + printf OUT ("%s\n", join(':', @{$printout})); + close OUT; + } + + return( $config_tree->getParam($view, 'expires')+time(), 'text/plain' ); +} + + + +sub rrd_make_multigraph +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my @dsNames = + split(',', $config_tree->getNodeParam($token, 'ds-names') ); + + # We need this to refer to some existing variable name + $obj->{'dname'} = $dsNames[0]; + + # Analyze the drawing order + my %dsOrder; + foreach my $dname ( @dsNames ) + { + my $order = $config_tree->getNodeParam($token, 'line-order-'.$dname); + $dsOrder{$dname} = defined( $order ) ? $order : 100; + } + + my $disable_legend = $config_tree->getParam($view, 'disable-legend'); + $disable_legend = + (defined($disable_legend) and $disable_legend eq 'yes') ? 1:0; + + # make DEFs and Line instructions + + my $do_gprint = 0; + + if( not $disable_legend ) + { + $do_gprint = $self->rrd_if_gprint( $config_tree, $token ); + if( $do_gprint ) + { + $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj ); + } + } + + foreach my $dname ( sort {$dsOrder{$a} <=> $dsOrder{$b}} @dsNames ) + { + my $dograph = 1; + my $ignoreViews = + $config_tree->getNodeParam($token, 'ignore-views-'.$dname); + if( defined( $ignoreViews ) and + grep {$_ eq $view} split(',', $ignoreViews) ) + { + $dograph = 0; + } + + my $gprint_this = $do_gprint; + if( $do_gprint ) + { + my $ds_nogprint = + $config_tree->getNodeParam($token, 'disable-gprint-'.$dname); + if( defined( $ds_nogprint ) and $ds_nogprint eq 'yes' ) + { + $gprint_this = 0; + } + } + + my $legend; + + if( $dograph or $gprint_this ) + { + my $expr = $config_tree->getNodeParam($token, 'ds-expr-'.$dname); + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_cdef($config_tree, $token, $dname, $expr) ); + + $legend = + $config_tree->getNodeParam($token, 'graph-legend-'.$dname); + if( defined( $legend ) ) + { + $legend =~ s/:/\\:/g; + } + else + { + $legend = ''; + } + } + + if( $gprint_this ) + { + $self->rrd_make_gprint( $dname, $legend, + $config_tree, $token, $view, $obj ); + if( not $dograph ) + { + push( @{$obj->{'args'}{'line'}}, + 'COMMENT:' . $legend . '\l'); + } + } + else + { + # For datasource that disables gprint, there's no reason + # to print the label + $legend = ''; + } + + if( $dograph ) + { + my $linestyle = + $self->mkline( $config_tree->getNodeParam + ($token, 'line-style-'.$dname) ); + + my $linecolor = + $self->mkcolor( $config_tree->getNodeParam + ($token, 'line-color-'.$dname) ); + + my $alpha = + $config_tree->getNodeParam($token, 'line-alpha-'.$dname); + if( defined( $alpha ) ) + { + $linecolor .= $alpha; + } + + my $stack = + $config_tree->getNodeParam($token, 'line-stack-'.$dname); + if( defined( $stack ) and $stack eq 'yes' ) + { + $stack = ':STACK'; + } + else + { + $stack = ''; + } + + push( @{$obj->{'args'}{'line'}}, + sprintf( '%s:%s%s%s%s', $linestyle, $dname, + $linecolor, + length($legend) > 0 ? ':'.$legend.'\l' : '', + $stack ) ); + + } + } +} + + +# Check if Holt-Winters stuff is needed +sub rrd_check_hw +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + + my $use_hw = 0; + my $nodeHW = $config_tree->getNodeParam($token, 'rrd-hwpredict'); + if( defined($nodeHW) and $nodeHW eq 'enabled' ) + { + my $viewHW = $config_tree->getParam($view, 'rrd-hwpredict'); + my $varNoHW = $self->{'options'}->{'variables'}->{'NOHW'}; + + if( (not defined($viewHW) or $viewHW ne 'disabled') and + (not $varNoHW) ) + { + $use_hw = 1; + } + } + return $use_hw; +} + + +sub rrd_make_holtwinters +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my $dname = $obj->{'dname'}; + + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_def( $config_tree, $token, + $dname . 'pred', 'HWPREDICT' ) ); + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_def( $config_tree, $token, + $dname . 'dev', 'DEVPREDICT' ) ); + # Upper boundary definition + push( @{$obj->{'args'}{'defs'}}, + sprintf( 'CDEF:%supper=%spred,%sdev,2,*,+', + $dname, $dname, $dname ) ); + + # Lower boundary definition + push( @{$obj->{'args'}{'defs'}}, + sprintf( 'CDEF:%slower=%spred,%sdev,2,*,-', + $dname, $dname, $dname ) ); + + # Failures definition + push( @{$obj->{'args'}{'defs'}}, + $self->rrd_make_def( $config_tree, $token, + $dname . 'fail', 'FAILURES' ) ); + + # Generate H-W Boundary Lines + + # Boundary style + my $hw_bndr_style = $config_tree->getParam($view, 'hw-bndr-style'); + $hw_bndr_style = 'LINE1' unless defined $hw_bndr_style; + $hw_bndr_style = $self->mkline( $hw_bndr_style ); + + my $hw_bndr_color = $config_tree->getParam($view, 'hw-bndr-color'); + $hw_bndr_color = '#FF0000' unless defined $hw_bndr_color; + $hw_bndr_color = $self->mkcolor( $hw_bndr_color ); + + push( @{$obj->{'args'}{'hwline'}}, + sprintf( '%s:%supper%s:%s', + $hw_bndr_style, $dname, $hw_bndr_color, + $Torrus::Renderer::hwGraphLegend ? 'Boundaries\n':'' ) ); + push( @{$obj->{'args'}{'hwline'}}, + sprintf( '%s:%slower%s', + $hw_bndr_style, $dname, $hw_bndr_color ) ); + + # Failures Tick + + my $hw_fail_color = $config_tree->getParam($view, 'hw-fail-color'); + $hw_fail_color = '#FFFFA0' unless defined $hw_fail_color; + $hw_fail_color = $self->mkcolor( $hw_fail_color ); + + push( @{$obj->{'args'}{'hwtick'}}, + sprintf( 'TICK:%sfail%s:1.0:%s', + $dname, $hw_fail_color, + $Torrus::Renderer::hwGraphLegend ? 'Failures':'') ); +} + +sub rrd_make_graphline +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my $legend; + + my $disable_legend = $config_tree->getParam($view, 'disable-legend'); + if( not defined($disable_legend) or $disable_legend ne 'yes' ) + { + $legend = $config_tree->getNodeParam($token, 'graph-legend'); + if( defined( $legend ) ) + { + $legend =~ s/:/\\:/g; + } + } + + if( not defined( $legend ) ) + { + $legend = ''; + } + + my $styleval = $config_tree->getNodeParam($token, 'line-style'); + if( not defined( $styleval ) or length( $styleval ) == 0 ) + { + $styleval = $config_tree->getParam($view, 'line-style'); + } + + my $linestyle = $self->mkline( $styleval ); + + my $colorval = $config_tree->getNodeParam($token, 'line-color'); + if( not defined( $colorval ) or length( $colorval ) == 0 ) + { + $colorval = $config_tree->getParam($view, 'line-color'); + } + + my $linecolor = $self->mkcolor( $colorval ); + + if( $self->rrd_if_gprint( $config_tree, $token ) ) + { + $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj ); + + $self->rrd_make_gprint( $obj->{'dname'}, $legend, + $config_tree, $token, $view, $obj ); + } + + push( @{$obj->{'args'}{'line'}}, + sprintf( '%s:%s%s%s', $linestyle, $obj->{'dname'}, $linecolor, + length($legend) > 0 ? ':'.$legend.'\l' : '' ) ); +} + + +# Generate RRDtool arguments for HRULE's + +sub rrd_make_hrules +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my $hrulesList = $config_tree->getParam($view, 'hrules'); + if( defined( $hrulesList ) ) + { + foreach my $hruleName ( split(',', $hrulesList ) ) + { + # The presence of this parameter is checked by Validator + my $valueParam = + $config_tree->getParam( $view, 'hrule-value-'.$hruleName ); + my $value = $config_tree->getNodeParam( $token, $valueParam ); + + if( defined( $value ) ) + { + my $color = + $config_tree->getParam($view, 'hrule-color-'.$hruleName); + $color = $self->mkcolor( $color ); + + my $legend = + $config_tree->getNodeParam($token, + 'hrule-legend-'.$hruleName); + + my $arg = sprintf( 'HRULE:%e%s', $value, $color ); + if( defined( $legend ) and $legend =~ /\S/ ) + { + $arg .= ':' . $legend . '\l'; + } + push( @{$obj->{'args'}{'hrule'}}, $arg ); + } + } + } +} + + +sub rrd_make_decorations +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my $decorList = $config_tree->getParam($view, 'decorations'); + my $ignore_decor = + $config_tree->getNodeParam($token, 'graph-ignore-decorations'); + if( defined( $decorList ) and + (not defined($ignore_decor) or $ignore_decor ne 'yes') ) + { + my $decor = {}; + foreach my $decorName ( split(',', $decorList ) ) + { + my $order = + $config_tree->getParam($view, 'dec-order-' . $decorName); + $decor->{$order} = {'def' => [], 'line' => ''}; + + my $style = + $self->mkline( $config_tree-> + getParam($view, 'dec-style-' . $decorName) ); + my $color = + $self->mkcolor( $config_tree-> + getParam($view, 'dec-color-' . $decorName) ); + my $expr = $config_tree-> + getParam($view, 'dec-expr-' . $decorName); + + push( @{$decor->{$order}{'def'}}, + $self->rrd_make_cdef( $config_tree, $token, $decorName, + $obj->{'dname'} . ',POP,' . $expr ) ); + + $decor->{$order}{'line'} = + sprintf( '%s:%s%s', $style, $decorName, $color ); + } + + foreach my $order ( sort {$a<=>$b} keys %{$decor} ) + { + my $array = $order < 0 ? 'bg':'fg'; + + push( @{$obj->{'args'}{'defs'}}, @{$decor->{$order}{'def'}} ); + push( @{$obj->{'args'}{$array}}, $decor->{$order}{'line'} ); + } + } +} + +# Takes the parameters from the view, and composes the list of +# RRDtool arguments + +sub rrd_make_opts +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $opthash = shift; + + my @args = (); + foreach my $param ( keys %{$opthash} ) + { + my $value = + $self->{'options'}->{'variables'}->{'G' . $param}; + + if( not defined( $value ) ) + { + $value = $config_tree->getParam( $view, $param ); + } + + if( defined( $value ) ) + { + if( ( $param eq 'start' or $param eq 'end' ) and + defined( $self->{'options'}->{'variables'}->{'NOW'} ) ) + { + my $now = $self->{'options'}->{'variables'}->{'NOW'}; + if( index( $value , 'now' ) >= 0 ) + { + $value =~ s/now/$now/; + } + elsif( $value =~ /^(\-|\+)/ ) + { + $value = $now . $value; + } + } + push( @args, $opthash->{$param}, $value ); + } + } + + my $params = $config_tree->getParam($view, 'rrd-params'); + if( defined( $params ) ) + { + push( @args, split('\s+', $params) ); + } + + my $scalingbase = $config_tree->getNodeParam($token, 'rrd-scaling-base'); + if( defined($scalingbase) and $scalingbase == 1024 ) + { + push( @args, '--base', '1024' ); + } + + return @args; +} + + +sub rrd_make_graph_opts +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + + my @args = ( '--imgformat', 'PNG' ); + + my $graph_log = $config_tree->getNodeParam($token, 'graph-logarithmic'); + if( defined($graph_log) and $graph_log eq 'yes' ) + { + push( @args, '--logarithmic' ); + } + + my $disable_title = + $config_tree->getParam($view, 'disable-title'); + if( not defined( $disable_title ) or $disable_title ne 'yes' ) + { + my $title = $config_tree->getNodeParam($token, 'graph-title'); + if( not defined( $title ) or length( $title ) == 0 ) + { + $title = ' '; + } + push( @args, '--title', $title ); + } + + my $disable_vlabel = + $config_tree->getParam($view, 'disable-vertical-label'); + if( not defined( $disable_vlabel ) or $disable_vlabel ne 'yes' ) + { + my $vertical_label = + $config_tree->getNodeParam($token, 'vertical-label'); + if( defined( $vertical_label ) and length( $vertical_label ) > 0 ) + { + push( @args, '--vertical-label', $vertical_label ); + } + } + + my $ignore_limits = $config_tree->getParam($view, 'ignore-limits'); + if( not defined($ignore_limits) or $ignore_limits ne 'yes' ) + { + my $ignore_lower = $config_tree->getParam($view, 'ignore-lower-limit'); + if( not defined($ignore_lower) or $ignore_lower ne 'yes' ) + { + my $limit = + $config_tree->getNodeParam($token, 'graph-lower-limit'); + if( defined($limit) and length( $limit ) > 0 ) + { + push( @args, '--lower-limit', $limit ); + } + } + + my $ignore_upper = $config_tree->getParam($view, 'ignore-upper-limit'); + if( not defined($ignore_upper) or $ignore_upper ne 'yes' ) + { + my $limit = + $config_tree->getNodeParam($token, 'graph-upper-limit'); + if( defined($limit) and length( $limit ) > 0 ) + { + push( @args, '--upper-limit', $limit ); + } + } + + my $rigid_boundaries = + $config_tree->getNodeParam($token, 'graph-rigid-boundaries'); + if( defined($rigid_boundaries) and $rigid_boundaries eq 'yes' ) + { + push( @args, '--rigid' ); + } + } + + if( scalar( @Torrus::Renderer::graphExtraArgs ) > 0 ) + { + push( @args, @Torrus::Renderer::graphExtraArgs ); + } + + return @args; +} + + +sub rrd_make_def +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $dname = shift; + my $cf = shift; + + my $datafile = $config_tree->getNodeParam($token, 'data-file'); + my $dataddir = $config_tree->getNodeParam($token, 'data-dir'); + my $rrdfile = $dataddir.'/'.$datafile; + if( not -r $rrdfile ) + { + my $path = $config_tree->path($token); + Error("$path: No such file or directory: $rrdfile"); + return undef; + } + + my $ds = $config_tree->getNodeParam($token, 'rrd-ds'); + if( not defined $cf ) + { + $cf = $config_tree->getNodeParam($token, 'rrd-cf'); + } + return sprintf( 'DEF:%s=%s:%s:%s', + $dname, $rrdfile, $ds, $cf ); +} + + + +my %cfNames = + ( 'AVERAGE' => 1, + 'MIN' => 1, + 'MAX' => 1, + 'LAST' => 1 ); + +# Moved the validation part to Torrus::ConfigTree::Validator +sub rrd_make_cdef +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $dname = shift; + my $expr = shift; + + my @args = (); + + # We will name the DEFs as $dname.sprintf('%.2d', $ds_couter++); + my $ds_couter = 1; + + my $rpn = new Torrus::RPN; + + # The callback for RPN translation + my $callback = sub + { + my ($noderef, $timeoffset) = @_; + + my $function; + if( $noderef =~ s/^(.+)\@// ) + { + $function = $1; + } + + my $cf; + if( defined( $function ) and $cfNames{$function} ) + { + $cf = $function; + } + + my $leaf = length($noderef) > 0 ? + $config_tree->getRelative($token, $noderef) : $token; + + my $varname = $dname . sprintf('%.2d', $ds_couter++); + push( @args, + $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ) ); + return $varname; + }; + + $expr = $rpn->translate( $expr, $callback ); + push( @args, sprintf( 'CDEF:%s=%s', $dname, $expr ) ); + return @args; +} + + +sub rrd_if_gprint +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + + my $disable = $config_tree->getNodeParam($token, 'graph-disable-gprint'); + if( defined( $disable ) and $disable eq 'yes' ) + { + return 0; + } + return 1; +} + +sub rrd_make_gprint +{ + my $self = shift; + my $vname = shift; + my $legend = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my @args = (); + + 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); + push( @args, 'GPRINT:' . $vname . ':' . $format ); + } + } + + push( @{$obj->{'args'}{'line'}}, @args ); +} + + +sub rrd_make_gprint_header +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my $obj = shift; + + my $gprintValues = $config_tree->getParam($view, 'gprint-values'); + if( defined( $gprintValues ) and length( $gprintValues ) > 0 ) + { + my $gprintHeader = $config_tree->getParam($view, 'gprint-header'); + if( defined( $gprintHeader ) and length( $gprintHeader ) > 0 ) + { + push( @{$obj->{'args'}{'line'}}, + 'COMMENT:' . $gprintHeader . '\l' ); + } + } +} + + +sub mkcolor +{ + my $self = shift; + my $color = shift; + + my $recursionLimit = 100; + + while( $color =~ /^\#\#(\S+)$/ ) + { + if( $recursionLimit-- <= 0 ) + { + Error('Color recursion is too deep'); + $color = '#000000'; + } + else + { + my $colorName = $1; + $color = $Torrus::Renderer::graphStyles{$colorName}{'color'}; + if( not defined( $color ) ) + { + Error('No color is defined for ' . $colorName); + $color = '#000000'; + } + } + } + return $color; +} + +sub mkline +{ + my $self = shift; + my $line = shift; + + if( $line =~ /^\#\#(\S+)$/ ) + { + my $lineName = $1; + $line = $Torrus::Renderer::graphStyles{$lineName}{'line'}; + if( not defined( $line ) ) + { + Error('No line style is defined for ' . $lineName); + $line = 'LINE1'; + } + } + return $line; +} + + +sub tz_set +{ + my $self = shift; + + if( defined $ENV{'TZ'} ) + { + Debug("Previous TZ value: " . $ENV{'TZ'}); + $self->{'tz_defined'} = 1; + } + else + { + $self->{'tz_defined'} = 0; + } + + if( defined( my $newTZ = $self->{'options'}->{'variables'}->{'TZ'} ) ) + { + Debug("Setting TZ to " . $newTZ); + $self->{'tz_old'} = $ENV{'TZ'}; + $ENV{'TZ'} = $newTZ; + $self->{'tz_changed'} = 1; + } + else + { + $self->{'tz_changed'} = 0; + } +} + +sub tz_restore +{ + my $self = shift; + + if( $self->{'tz_changed'} ) + { + if( $self->{'tz_defined'} ) + { + Debug("Restoring TZ back to " . $self->{'tz_old'}); + $ENV{'TZ'} = $self->{'tz_old'}; + } + else + { + Debug("Restoring TZ back to undefined"); + delete $ENV{'TZ'}; + } + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ReportGenerator.pm b/torrus/perllib/Torrus/ReportGenerator.pm new file mode 100644 index 000000000..1a4dec3be --- /dev/null +++ b/torrus/perllib/Torrus/ReportGenerator.pm @@ -0,0 +1,141 @@ +# 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: ReportGenerator.pm,v 1.1 2010-12-27 00:03:37 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Package for reports generation +# Classes should inherit Torrus::ReportGenerator + +package Torrus::ReportGenerator; + +use strict; +use Date::Parse; + +use Torrus::Log; +use Torrus::SQL::Reports; +use Torrus::SQL::SrvExport; + +sub new +{ + my $class = shift; + my $options = shift; + + if( not ref( $options ) or + not defined( $options->{'Date'} ) or + not defined( $options->{'Time'} ) or + not defined( $options->{'Name'} ) ) + { + Error('Missing options in Torrus::Report constructor'); + return undef; + } + + my $self = {}; + bless ($self, $class); + + # For monthly reports, adjust date and time for the first day of the month + if( $self->isMonthly() ) + { + $options->{'Time'} = '00:00'; + my ($ss,$mm,$hh,$day,$month,$year,$zone) = + strptime( $options->{'Date'} ); + $year += 1900; + $month++; + $self->{'StartDate'} = sprintf('%.4d-%.2d-01', $year, $month); + $options->{'Date'} = $self->{'StartDate'}; + $self->{'StartUnixTime'} = str2time( $self->{'StartDate'} ); + $self->{'Year'} = $year; + $self->{'Month'} = $month; + + # Count the number of seconds in the month and define the end date + my $endyear = $year; + my $endmonth = $month + 1; + + if( $endmonth > 12 ) + { + $endmonth = 1; + $endyear++; + } + + my $enddate = sprintf('%.4d-%.2d-01', $endyear, $endmonth); + $self->{'EndDate'} = $enddate; + $self->{'EndUnixTime'} = str2time( $self->{'EndDate'} ); + + $self->{'RangeSeconds'} = + $self->{'EndUnixTime'} - $self->{'StartUnixTime'}; + } + + if( $self->usesSrvExport() ) + { + my $srvExp = + Torrus::SQL::SrvExport->new( $options->{'SrvExportSqlSubtype'} ); + if( not defined( $srvExp ) ) + { + Error('Cannot connect to the database'); + return undef; + } + $self->{'srvexport'} = $srvExp; + } + + $self->{'options'} = $options; + + my $sqlRep = Torrus::SQL::Reports->new( $options->{'ReportsSqlSubtype'} ); + if( not defined( $sqlRep ) ) + { + Error('Cannot connect to the database'); + return undef; + } + $self->{'backend'} = $sqlRep; + + my $reportId = $sqlRep->reportId( $options->{'Date'}, + $options->{'Time'}, + $options->{'Name'} ); + $self->{'reportId'} = $reportId; + + if( $sqlRep->isComplete( $reportId ) ) + { + Error('Report already exists'); + return undef; + } + + return $self; +} + + +sub generate +{ + die('Virtual method called'); +} + + +sub isMonthly +{ + return 0; +} + +sub usesSrvExport +{ + return 0; +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm b/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm new file mode 100644 index 000000000..481f8ad9a --- /dev/null +++ b/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm @@ -0,0 +1,221 @@ +# 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: MonthlySrvUsage.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# For all service IDs available, build monthly usage figures: +# Average, Maximum, and Percentile (default 95th percentile) +# + +package Torrus::ReportGenerator::MonthlySrvUsage; + +use strict; +use POSIX qw(floor); +use Date::Parse; +use Math::BigFloat; + +use Torrus::Log; +use Torrus::ReportGenerator; +use Torrus::ServiceID; + +use base 'Torrus::ReportGenerator'; + +sub isMonthly +{ + return 1; +} + +sub usesSrvExport +{ + return 1; +} + + +sub generate +{ + my $self = shift; + + my $percentile = $self->{'options'}->{'Percentile'}; + if( not defined( $percentile ) ) + { + $percentile = 95; + } + + my $step = $self->{'options'}->{'Step'}; + if( not defined( $step ) ) + { + $step = 300; + } + + my $srvIDParams = new Torrus::ServiceID(); + + my $srvIDs = $self->{'srvexport'}->getServiceIDs(); + foreach my $serviceid ( @{$srvIDs} ) + { + &Torrus::DB::checkInterrupted(); + + my $data = $self->{'srvexport'}->getIntervalData + ( $self->{'StartDate'}, $self->{'EndDate'}, $serviceid ); + + &Torrus::DB::checkInterrupted(); + + next if scalar( @{$data} ) == 0; + Debug('MonthlySrvUsage: Generating report for ' . $serviceid); + + my $params = $srvIDParams->getParams( $serviceid ); + + my @aligned = (); + $#aligned = floor( $self->{'RangeSeconds'} / $step ); + my $nDatapoints = scalar( @aligned ); + + # Fill in the aligned array. For each interval by modulo(step), + # we take the maximum value from the available data + + my $maxVal = 0; + + foreach my $row ( @{$data} ) + { + my $rowtime = str2time( $row->{'srv_date'} . 'T' . + $row->{'srv_time'} ); + my $pos = floor( ($rowtime - $self->{'StartUnixTime'}) / $step ); + my $value = Math::BigFloat->new( $row->{'value'} ); + if( $value->is_nan() ) + { + $value->bzero(); + $row->{'value'} = 0; + } + + if( ( not defined( $aligned[$pos] ) ) or + $aligned[$pos] < $value ) + { + $aligned[$pos] = $value; + if( $value > $maxVal ) + { + $maxVal = $value; + } + } + } + + &Torrus::DB::checkInterrupted(); + + # Set undefined values to zero and calculate the average + + my $sum = Math::BigFloat->new(0); + my $unavailCount = 0; + foreach my $pos ( 0 .. $#aligned ) + { + if( not defined( $aligned[$pos] ) ) + { + $aligned[$pos] = 0; + $unavailCount++; + } + else + { + $sum += $aligned[$pos]; + } + } + + &Torrus::DB::checkInterrupted(); + + my $avgVal = $sum / $nDatapoints; + + # Calculate the percentile + + my @sorted = sort {$a <=> $b} @aligned; + my $pcPos = floor( $nDatapoints * $percentile / 100 ); + my $pcVal = $sorted[$pcPos]; + + # Calculate the total volume if it's a counter + my $volume = Math::BigFloat->new(0); + my $volumeDefined = 0; + if( not defined( $params->{'dstype'} ) or + $params->{'dstype'} =~ /^COUNTER/o ) + { + $volumeDefined = 1; + foreach my $row ( @{$data} ) + { + $volume += $row->{'value'} * $row->{'intvl'}; + } + } + + # Adjust units and scale + + my $usageUnits = ''; + my $volumeUnits = ''; + if( not defined( $params->{'units'} ) or + $params->{'units'} eq 'bytes' ) + { + # Adjust bytes into megabit per second + $usageUnits = 'Mbps'; + $maxVal *= 8e-6; + $avgVal *= 8e-6; + $pcVal *= 8e-6; + + # Adjust volume bytes into megabytes + $volumeUnits = 'GB'; + $volume /= 1073741824; + } + + $self->{'backend'}->addField( $self->{'reportId'}, { + 'name' => 'MAX', + 'serviceid' => $serviceid, + 'value' => $maxVal, + 'units' => $usageUnits }); + + $self->{'backend'}->addField( $self->{'reportId'}, { + 'name' => 'AVG', + 'serviceid' => $serviceid, + 'value' => $avgVal, + 'units' => $usageUnits }); + + $self->{'backend'}->addField( $self->{'reportId'}, { + 'name' => sprintf('%s%s', $percentile, 'TH_PERCENTILE'), + 'serviceid' => $serviceid, + 'value' => $pcVal, + 'units' => $usageUnits }); + + $self->{'backend'}->addField( $self->{'reportId'}, { + 'name' => 'UNAVAIL', + 'serviceid' => $serviceid, + 'value' => ($unavailCount*100)/$nDatapoints, + 'units' => '%' }); + + if( $volumeDefined ) + { + $self->{'backend'}->addField( $self->{'reportId'}, { + 'name' => 'VOLUME', + 'serviceid' => $serviceid, + 'value' => $volume, + 'units' => $volumeUnits }); + } + } + + &Torrus::DB::checkInterrupted(); + + $self->{'backend'}->finalize( $self->{'reportId'} ); +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ReportOutput.pm b/torrus/perllib/Torrus/ReportOutput.pm new file mode 100644 index 000000000..b4a4c57ab --- /dev/null +++ b/torrus/perllib/Torrus/ReportOutput.pm @@ -0,0 +1,210 @@ +# 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: ReportOutput.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Package for generating report output to HTML, PDF, whatever +# Media-specific classes should inherit from this package +# and + +package Torrus::ReportOutput; + +use strict; + +use Torrus::Log; +use Torrus::SQL::Reports; +use Torrus::ServiceID; + + +sub new +{ + my $class = shift; + my $options = shift; + + my $self = {}; + bless ($self, $class); + + $self->{'options'} = $options; + defined( $self->{'options'}->{'Tree'} ) or die; + + my $sqlRep = Torrus::SQL::Reports->new( $options->{'ReportsSqlSubtype'} ); + if( not defined( $sqlRep ) ) + { + Error('Cannot connect to the database'); + return undef; + } + $self->{'backend'} = $sqlRep; + + my $outdir = $Torrus::Global::reportsDir . '/' . + $self->{'options'}->{'Tree'}; + $self->{'outdir'} = $outdir; + + if( not -d $outdir ) + { + if( not mkdir( $outdir ) ) + { + Error('Cannot create directory ' . $outdir . ': ' . $!); + return undef; + } + } + + return $self; +} + +# initialize the subclasses' internals +sub init +{ + my $self = shift; + + return 1; +} + + +sub generate +{ + my $self = shift; + + my $ok = 1; + + my %monthlyReportNames; + + my $srvIdList; + if( not $self->{'options'}->{'All_Service_IDs'} ) + { + my $srvId = new Torrus::ServiceID; + $srvIdList = $srvId->getAllForTree( $self->{'options'}->{'Tree'} ); + } + + my $allReports = $self->{'backend'}->getAllReports( $srvIdList ); + + # frontpage, title, list of years, etc. + $self->genIntroduction( $allReports ); + + while( my( $year, $yearRef ) = each %{$allReports} ) + { + my $monthlyReportFields = {}; + my $srvidMonthlyFields = {}; + + while( my( $month, $monthRef ) = each %{$yearRef} ) + { + my $dailyReportFields = {}; + + while( my( $day, $dayRef ) = each %{$monthRef} ) + { + while( my( $reportName, $fieldsRef ) = each %{$dayRef} ) + { + # Check if the report is monthly + if( not defined( $monthlyReportNames{$reportName} ) ) + { + my $class = + $Torrus::ReportGenerator::modules{$reportName}; + eval( 'require ' . $class ); + die( $@ ) if $@; + + $monthlyReportNames{$reportName} = + $class->isMonthly() ? 1:0; + } + + # This report is monthly -- do not include it in daily + # list. + if( $monthlyReportNames{$reportName} ) + { + $monthlyReportFields->{$month}{$reportName} = + $fieldsRef; + while( my( $serviceid, $fref ) = each %{$fieldsRef} ) + { + $srvidMonthlyFields->{$serviceid}{$reportName}->{ + $month} = $fref; + } + } + else + { + $dailyReportFields->{$day} = $dayRef; + } + } + } + + $ok = $self->genDailyOutput( $year, $month, $dailyReportFields )? + $ok:0; + } + + $ok = $self->genSrvIdOutput( $year, $srvidMonthlyFields ) ? $ok:0; + $ok = $self->genMonthlyOutput( $year, $monthlyReportFields ) ? $ok:0;; + } + + return $ok; +} + + +# Print the head page and years reference +sub genIntroduction +{ + my $self = shift; + my $allReports = shift; + + return 1; +} + + +# Print monthly report for a given service ID +# The fields argument is a hash of hashes: +# serviceid => reportname => month => fieldname => {value, units} +sub genSrvIdOutput +{ + my $self = shift; + my $year = shift; + my $fields = shift; + + return 1; +} + +# Print daily report +# Fields structure: +# day => reportname => serviceid => fieldname => {value, units} +sub genDailyOutput +{ + my $self = shift; + my $year = shift; + my $month = shift; + my $fields = shift; + + return 1; +} + +# Print monthly report +# fields: +# month => reportname => serviceid => fieldname => {value, units} +sub genMonthlyOutput +{ + my $self = shift; + my $year = shift; + my $fields = shift; + + return 1; +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ReportOutput/HTML.pm b/torrus/perllib/Torrus/ReportOutput/HTML.pm new file mode 100644 index 000000000..40348a664 --- /dev/null +++ b/torrus/perllib/Torrus/ReportOutput/HTML.pm @@ -0,0 +1,296 @@ +# 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: HTML.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::ReportOutput::HTML; + +use strict; +use Template; +use Date::Format; + +use Torrus::Log; +use Torrus::ReportOutput; +use Torrus::SiteConfig; + +use base 'Torrus::ReportOutput'; + +our @monthNames = qw + (January February March April May June + July August September October November December); + +sub init +{ + my $self = shift; + + Torrus::SiteConfig::loadStyling(); + + my $htmldir = $self->{'outdir'} . '/html'; + if( not -d $htmldir ) + { + Verbose('Creating directory: ' . $htmldir); + if( not mkdir( $htmldir ) ) + { + Error('Cannot create directory ' . $htmldir . ': ' . $!); + return 0; + } + } + $self->{'htmldir'} = $htmldir; + + $self->{'tt'} = + new Template(INCLUDE_PATH => $Torrus::Global::templateDirs, + TRIM => 1); + return 1; +} + + +# Print the head page and years reference +sub genIntroduction +{ + my $self = shift; + my $allReports = shift; + + return $self->render({ + 'filename' => $self->indexFilename(), + 'template' => 'index', + 'data' => $allReports }); +} + + +# Print monthly report for a given service ID +# The fields argument is a hash of hashes: +# serviceid => reportname => month => fieldname => {value, units} +sub genSrvIdOutput +{ + my $self = shift; + my $year = shift; + my $fields = shift; + + my $ok = 1; + while( my( $serviceid, $ref ) = each %{$fields} ) + { + $ok = $self->render({ + 'filename' => $self->srvIdFilename($year, $serviceid), + 'template' => 'serviceid', + 'data' => $ref, + 'serviceid' => $serviceid, + 'year' => $year }) ? $ok:0; + } + return $ok; +} + + +# Print daily report -- NOT IMPLEMENTED YET +# Fields structure: +# day => reportname => serviceid => fieldname => {value, units} +sub genDailyOutput +{ + my $self = shift; + my $year = shift; + my $month = shift; + my $fields = shift; + + return 1; +} + + +# Print monthly report +# fields: +# month => reportname => serviceid => fieldname => {value, units} +sub genMonthlyOutput +{ + my $self = shift; + my $year = shift; + my $fields = shift; + + my $ok = 1; + my @months; + while( my( $month, $ref ) = each %{$fields} ) + { + if( $self->render({ + 'filename' => $self->monthlyFilename($year, $month), + 'template' => 'monthly', + 'data' => $ref, + 'year' => $year, + 'month' => $month }) ) + { + push( @months, $month ); + } + else + { + $ok = 0; + } + } + + my @sorted = sort {$a <=>$b} @months; + $ok = $self->render({ + 'filename' => $self->yearlyFilename($year), + 'template' => 'yearly', + 'data' => {'months' => \@sorted}, + 'year' => $year }) ? $ok:0; + return $ok; +} + + +sub indexFilename +{ + return 'index.html'; +} + + +sub srvIdFilename +{ + my $self = shift; + my $year = shift; + my $serviceid = shift; + + return sprintf('%.4d_serviceid_%s.html', $year, $serviceid); +} + +sub monthlyFilename +{ + my $self = shift; + my $year = shift; + my $month = shift; + + return sprintf('%.4d_monthly_%.2d.html', $year, $month); +} + +sub yearlyFilename +{ + my $self = shift; + my $year = shift; + + return sprintf('%.4d_yearly.html', $year); +} + + + +sub render +{ + my $self = shift; + my $opt = shift; + + my $outfile = $self->{'htmldir'} . '/' . $opt->{'filename'}; + my $tmplfile = $Torrus::ReportOutput::HTML::templates{$opt->{'template'}}; + Debug('Rendering ' . $outfile . ' from ' . $tmplfile); + + my $ttvars = + { + 'plainURL' => $Torrus::Renderer::plainURL, + 'style' => sub { return $self->style($_[0]); }, + 'treeName' => $self->{'options'}->{'Tree'}, + 'companyName'=> $Torrus::Renderer::companyName, + 'companyURL' => $Torrus::Renderer::companyURL, + 'siteInfo' => $Torrus::Renderer::siteInfo, + 'version' => $Torrus::Global::version, + 'xmlnorm' => \&xmlnormalize, + 'data' => $opt->{'data'}, + 'year' => $opt->{'year'}, + 'month' => $opt->{'month'}, + 'serviceid' => $opt->{'serviceid'}, + 'indexUrl' => sub { + return $self->reportUrl($self->indexFilename());}, + 'srvIdUrl' => sub { + return $self->reportUrl($self->srvIdFilename($opt->{'year'}, + $_[0]));}, + 'monthlyUrl' => sub { + return $self->reportUrl($self->monthlyFilename($opt->{'year'}, + $_[0]));}, + 'yearlyUrl' => sub { + return $self->reportUrl($self->yearlyFilename($_[0]));}, + 'monthName' => sub {$self->monthName($_[0]);}, + 'formatValue' => sub { + if( ref($_[0])) + { + return sprintf('%.2f %s', $_[0]->{'value'}, $_[0]->{'units'}); + } + else + { + return 'N/A'; + }}, + 'timestamp' => sub { return time2str($Torrus::Renderer::timeFormat, + time()); }, + }; + + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); + + if( not $result ) + { + Error("Error while rendering " . $outfile . ": " . + $self->{'tt'}->error()); + return 0; + } + return 1; +} + + +sub style +{ + my $self = shift; + my $object = shift; + + my $ret = $Torrus::Renderer::styling{'report'}{$object}; + if( not defined( $ret ) ) + { + $ret = $Torrus::Renderer::styling{'default'}{$object}; + } + + return $ret; +} + +sub monthName +{ + my $self = shift; + my $month = shift; + + return $monthNames[ $month - 1 ]; +} + + +sub reportUrl +{ + my $self = shift; + my $filename = shift; + + return $Torrus::Renderer::rendererURL . '/' . + $self->{'options'}->{'Tree'} . '?htmlreport=' . $filename; +} + +sub xmlnormalize +{ + my( $txt )= @_; + + $txt =~ s/\&/\&\;/gm; + $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/SNMP_Failures.pm b/torrus/perllib/Torrus/SNMP_Failures.pm new file mode 100644 index 000000000..4203dc166 --- /dev/null +++ b/torrus/perllib/Torrus/SNMP_Failures.pm @@ -0,0 +1,205 @@ +# 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: SNMP_Failures.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + + +# SNMP failures statistics interface + +package Torrus::SNMP_Failures; + +use Torrus::DB; +use Torrus::Log; +use strict; + + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + %{$self->{'options'}} = %options; + + die() if ( not defined($options{'-Tree'}) or + not defined($options{'-Instance'}) ); + + $self->{'db_failures'} = + new Torrus::DB( 'snmp_failures_' . $options{'-Instance'}, + -Subdir => $self->{'options'}{'-Tree'}, + -Btree => 1, + -WriteAccess => $options{'-WriteAccess'} ); + + $self->{'counters'} = ['unreachable', 'deleted', 'mib_errors']; + + return( defined( $self->{'db_failures'} ) ? $self:undef ); +} + + +sub DESTROY +{ + my $self = shift; + $self->{'db_failures'}->closeNow(); +} + + + +sub init +{ + my $self = shift; + + $self->{'db_failures'}->trunc(); + + foreach my $c ( @{$self->{'counters'}} ) + { + $self->{'db_failures'}->put('c:' . $c, 0); + } +} + + + +sub host_failure +{ + my $self = shift; + my $type = shift; + my $hosthash = shift; + + $self->{'db_failures'}->put('h:' . $hosthash, + $type . ':' . time()); +} + + +sub set_counter +{ + my $self = shift; + my $type = shift; + my $count = shift; + + $self->{'db_failures'}->put('c:' . $type, $count); +} + + +sub remove_host +{ + my $self = shift; + my $hosthash = shift; + + $self->{'db_failures'}->del('h:' . $hosthash); +} + + +sub mib_error +{ + my $self = shift; + my $hosthash = shift; + my $path = shift; + + my $count = $self->{'db_failures'}->get('M:' . $hosthash); + $count = 0 unless defined($count); + + $self->{'db_failures'}->put('m:' . $hosthash, $path . ':' . time()); + $self->{'db_failures'}->put('M:' . $hosthash, $count + 1); + + my $global_count = $self->{'db_failures'}->get('c:mib_errors'); + $self->{'db_failures'}->put('c:mib_errors', $global_count + 1); +} + + + +sub read +{ + my $self = shift; + my $out = shift; + my %options = @_; + + foreach my $c ( @{$self->{'counters'}} ) + { + if( not defined( $out->{'total_' . $c} ) ) + { + $out->{'total_' . $c} = 0; + } + + $out->{'total_' . $c} += + $self->{'db_failures'}->get('c:' . $c); + + if( $options{'-details'} and + not defined( $out->{'detail_' . $c} ) ) + { + $out->{'detail_' . $c} = {}; + } + } + + &Torrus::DB::checkInterrupted(); + + if( $options{'-details'} ) + { + my $cursor = $self->{'db_failures'}->cursor(); + while( my ($key, $val) = $self->{'db_failures'}->next($cursor) ) + { + if( $key =~ /^h:(.+)$/o ) + { + my $hosthash = $1; + my ($counter, $timestamp) = split(/:/o, $val); + + $out->{'detail_' . $counter}{$hosthash} = { + 'timestamp' => 0 + $timestamp, + 'time' => scalar(localtime( $timestamp )), + }; + } + elsif( $key =~ /^m:(.+)$/o ) + { + my $hosthash = $1; + my ($path, $timestamp) = split(/:/o, $val); + + $out->{'detail_mib_errors'}{$hosthash}{'nodes'}{$path} = { + 'timestamp' => 0 + $timestamp, + 'time' => scalar(localtime( $timestamp )), + } + } + elsif( $key =~ /^M:(.+)$/o ) + { + my $hosthash = $1; + my $count = 0 + $val; + + if( not defined + ( $out->{'detail_mib_errors'}{$hosthash}{'count'}) ) + { + $out->{'detail_mib_errors'}{$hosthash}{'count'} = 0; + } + + $out->{'detail_mib_errors'}{$hosthash}{'count'} += $count; + } + + &Torrus::DB::checkInterrupted(); + } + + undef $cursor; + } +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/SQL.pm b/torrus/perllib/Torrus/SQL.pm new file mode 100644 index 000000000..de54cacee --- /dev/null +++ b/torrus/perllib/Torrus/SQL.pm @@ -0,0 +1,234 @@ +# 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: SQL.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Package for RDBMS communication management in Torrus +# Classes should inherit Torrus::SQL and execute Torrus::SQL->new(), +# and then use methods of DBIx::Abstract. + +package Torrus::SQL; + +use strict; +use DBI; +use DBIx::Abstract; +use DBIx::Sequence; + +use Torrus::Log; + +my %connectionArgsCache; + +# Obtain connection attributes for particular class and object subtype. +# The attributes are defined in torrus-siteconfig.pl, in a hash +# %Torrus::SQL::connections. +# For a given Perl class and an optional subtype, +# the connection attributes are derived in the following order: +# 'Default', 'Default/[subtype]', '[Class]', '[Class]/[subtype]', +# 'All/[subtype]'. +# For a simple setup, the default attributes are usually defined for +# 'Default' key. +# The key attributes are: 'dsn', 'username', and 'password'. +# Returns a hash reference with the same keys. + +sub getConnectionArgs +{ + my $class = shift; + my $objClass = shift; + my $subtype = shift; + + my $cachekey = $objClass . ( defined( $subtype )? '/'.$subtype : ''); + if( defined( $connectionArgsCache{$cachekey} ) ) + { + return $connectionArgsCache{$cachekey}; + } + + my @lookup = ('Default'); + if( defined( $subtype ) ) + { + push( @lookup, 'Default/' . $subtype ); + } + push( @lookup, $objClass ); + if( defined( $subtype ) ) + { + push( @lookup, $objClass . '/' . $subtype, 'All/' . $subtype ); + } + + my $ret = {}; + foreach my $attr ( 'dsn', 'username', 'password' ) + { + my $val; + foreach my $key ( @lookup ) + { + if( defined( $Torrus::SQL::connections{$key} ) ) + { + if( defined( $Torrus::SQL::connections{$key}{$attr} ) ) + { + $val = $Torrus::SQL::connections{$key}{$attr}; + } + } + } + if( not defined( $val ) ) + { + die('Undefined attribute in %Torrus::SQL::connections: ' . $attr); + } + $ret->{$attr} = $val; + } + + $connectionArgsCache{$cachekey} = $ret; + + return $ret; +} + + +my %dbhPool; + +# For those who want direct DBI manipulation, simply call +# Class->dbh($subtype) with optional subtype. Then you don't use +# any other methods of Torrus::SQL. + +sub dbh +{ + my $class = shift; + my $subtype = shift; + + my $attrs = Torrus::SQL->getConnectionArgs( $class, $subtype ); + + my $poolkey = $attrs->{'dsn'} . '//' . $attrs->{'username'} . '//' . + $attrs->{'password'}; + + my $dbh; + + if( exists( $dbhPool{$poolkey} ) ) + { + $dbh = $dbhPool{$poolkey}; + if( not $dbh->ping() ) + { + $dbh = undef; + delete $dbhPool{$poolkey}; + } + } + + if( not defined( $dbh ) ) + { + $dbh = DBI->connect( $attrs->{'dsn'}, + $attrs->{'username'}, + $attrs->{'password'}, + { 'PrintError' => 0, + 'AutoCommit' => 0 } ); + + if( not defined( $dbh ) ) + { + Error('Error connecting to DBI source ' . $attrs->{'dsn'} . ': ' . + $DBI::errstr); + } + else + { + $dbhPool{$poolkey} = $dbh; + } + } + + return $dbh; +} + + +END +{ + foreach my $dbh ( values %dbhPool ) + { + $dbh->disconnect(); + } +} + + +sub new +{ + my $class = shift; + my $subtype = shift; + + my $self = {}; + + $self->{'dbh'} = $class->dbh( $subtype ); + if( not defined( $self->{'dbh'} ) ) + { + return undef; + } + + $self->{'sql'} = DBIx::Abstract->connect( $self->{'dbh'} ); + + $self->{'subtype'} = $subtype; + $self->{'classname'} = $class; + + bless ($self, $class); + return $self; +} + + + +sub sequence +{ + my $self = shift; + + if( not defined( $self->{'sequence'} ) ) + { + my $attrs = Torrus::SQL->getConnectionArgs( $self->{'classname'}, + $self->{'subtype'} ); + + $self->{'sequence'} = DBIx::Sequence->new({ + dbh => $self->{'dbh'}, + allow_id_reuse => 1 }); + } + return $self->{'sequence'}; +} + + +sub sequenceNext +{ + my $self = shift; + + return $self->sequence()->Next($self->{'classname'}); +} + + +sub fetchall +{ + my $self = shift; + my $columns = shift; + + my $ret = []; + while( defined( my $row = $self->{'sql'}->fetchrow_arrayref() ) ) + { + my $retrecord = {}; + my $i = 0; + foreach my $col ( @{$columns} ) + { + $retrecord->{$col} = $row->[$i++]; + } + push( @{$ret}, $retrecord ); + } + + return $ret; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/SQL/Reports.pm b/torrus/perllib/Torrus/SQL/Reports.pm new file mode 100644 index 000000000..5a90b7e42 --- /dev/null +++ b/torrus/perllib/Torrus/SQL/Reports.pm @@ -0,0 +1,291 @@ +# 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: Reports.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Class for Reporter data manipulation +package Torrus::SQL::ReportFields; + +package Torrus::SQL::Reports; + +use strict; + +use Torrus::SQL; +use base 'Torrus::SQL'; + +use Torrus::Log; +# use Torrus::SQL::ReportFields; + +# The name of the table and columns +# defaults configured in torrus-config.pl +our $tableName; +our %columns; + + +sub new +{ + my $class = shift; + my $subtype = shift; + + my $self = $class->SUPER::new( $subtype ); + + $self->{'fields'} = Torrus::SQL::ReportFields->new( $subtype ); + + bless ($self, $class); + return $self; +} + + +# Find or create a new row in reports table +# +sub reportId +{ + my $self = shift; + my $repdate = shift; + my $reptime = shift; + my $repname = shift; + + my $result = $self->{'sql'}->select_one_to_arrayref({ + 'fields' => [ $columns{'id'}, $columns{'iscomplete'} ], + 'table' => $tableName, + 'where' => { $columns{'rep_date'} => $repdate, + $columns{'rep_time'} => $reptime, + $columns{'reportname'} => $repname } }); + + if( defined( $result ) ) + { + if( not $result->[1] ) + { + # iscomplete is zero - the report is unfinished + Warn('Found unfinished report ' . $repname . ' for ' . + $repdate . ' ' . $reptime . + '. Deleting the previous report data'); + $self->{'fields'}->removeAll( $result->[0] ); + } + + return $result->[0]; + } + else + { + my $id = $self->sequenceNext(); + + $self->{'sql'}->insert({ + 'table' => $tableName, + 'fields' => { $columns{'id'} => $id, + $columns{'rep_date'} => $repdate, + $columns{'rep_time'} => $reptime, + $columns{'reportname'} => $repname, + $columns{'iscomplete'} => 0 } }); + + return $id; + } +} + + + +# Add a new field to a report. The field is a hash array reference +# with keys: 'name', 'serviceid', 'value', 'units' + +sub addField +{ + my $self = shift; + my $reportId = shift; + my $field = shift; + + if( isDebug() ) + { + Debug('Adding report field: ' . $field->{'name'} . + ':' . $field->{'serviceid'} . ' = ' . $field->{'value'} . + ' ' . $field->{'units'}); + } + $self->{'fields'}->add( $reportId, $field ); +} + + +sub getFields +{ + my $self = shift; + my $reportId = shift; + + return $self->{'fields'}->getAll( $reportId ); +} + + +sub isComplete +{ + my $self = shift; + my $reportId = shift; + + my $result = $self->{'sql'}->select_one_to_arrayref({ + 'fields' => [ $columns{'iscomplete'} ], + 'table' => $tableName, + 'where' => { $columns{'id'} => $reportId } }); + + if( defined( $result ) ) + { + return $result->[0]; + } + else + { + Error('Cannot find the report record for ID=' . $reportId); + } + + return 0; +} + + +sub finalize +{ + my $self = shift; + my $reportId = shift; + + $self->{'sql'}->update({ + 'table' => $tableName, + 'where' => { $columns{'id'} => $reportId }, + 'fields' => { $columns{'iscomplete'} => 1 } }); + + $self->{'sql'}->commit(); +} + + +sub getAllReports +{ + my $self = shift; + my $srvIdList = shift; + my $limitDate = shift; + + my $where = { $columns{'iscomplete'} => 1 }; + + if( defined( $limitDate ) ) + { + $where->{$columns{'rep_date'}} = ['>=', $limitDate]; + } + + $self->{'sql'}->select({ + 'table' => $tableName, + 'where' => $where, + 'fields' => [ $columns{'id'}, + $columns{'rep_date'}, + $columns{'rep_time'}, + $columns{'reportname'} ] }); + + my $reports = + $self->fetchall([ 'id', 'rep_date', 'rep_time', 'reportname' ]); + + my $ret = {}; + foreach my $report ( @{$reports} ) + { + my($year, $month, $day) = split('-', $report->{'rep_date'}); + + my $fields = $self->getFields( $report->{'id'} ); + my $fieldsref = {}; + + foreach my $field ( @{$fields} ) + { + if( not ref( $srvIdList ) or + grep {$field->{'serviceid'} eq $_} @{$srvIdList} ) + { + $fieldsref->{$field->{'serviceid'}}->{$field->{'name'}} = { + 'value' => $field->{'value'}, + 'units' => $field->{'units'} }; + } + } + + $ret->{$year}{$month}{$day}{$report->{'reportname'}} = $fieldsref; + } + return $ret; +} + + + + + + + +################################################ +## Class for report fields table + +package Torrus::SQL::ReportFields; +use strict; + +use Torrus::SQL; +use base 'Torrus::SQL'; + +use Torrus::Log; + +# The name of the table and columns +# defaults configured in torrus-config.pl +our $tableName; +our %columns; + +sub add +{ + my $self = shift; + my $reportId = shift; + my $attrs = shift; + + my $id = $self->sequenceNext(); + + $self->{'sql'}->insert({ + 'table' => $tableName, + 'fields' => { $columns{'id'} => $id, + $columns{'rep_id'} => $reportId, + $columns{'name'} => $attrs->{'name'}, + $columns{'serviceid'} => $attrs->{'serviceid'}, + $columns{'value'} => $attrs->{'value'}, + $columns{'units'} => $attrs->{'units'} } }); +} + + +sub getAll +{ + my $self = shift; + my $reportId = shift; + + $self->{'sql'}->select({ + 'table' => $tableName, + 'where' => { $columns{'rep_id'} => $reportId }, + 'fields' => [ $columns{'name'}, + $columns{'serviceid'}, + $columns{'value'}, + $columns{'units'}] }); + + return $self->fetchall([ 'name', 'serviceid', 'value', 'units' ]); +} + + +sub removeAll +{ + my $self = shift; + my $reportId = shift; + + $self->{'sql'}->delete({ + 'table' => $tableName, + 'where' => { $columns{'rep_id'} => $reportId }}); +} + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/SQL/SrvExport.pm b/torrus/perllib/Torrus/SQL/SrvExport.pm new file mode 100644 index 000000000..ef94547d6 --- /dev/null +++ b/torrus/perllib/Torrus/SQL/SrvExport.pm @@ -0,0 +1,109 @@ +# 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: SrvExport.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Class for Collector's external storage export data manipulation. + +package Torrus::SQL::SrvExport; + +use strict; + +use Torrus::SQL; +use base 'Torrus::SQL'; + +use Torrus::Log; + +# The name of the table and columns where the collector export is stored +# defaults configured in torrus-config.pl +our $tableName; +our %columns; + +sub sqlInsertStatement +{ + return sprintf('INSERT INTO %s (%s,%s,%s,%s,%s) VALUES (?,?,?,?,?)', + $tableName, + $columns{'srv_date'}, + $columns{'srv_time'}, + $columns{'serviceid'}, + $columns{'value'}, + $columns{'intvl'}); +} + + +sub getServiceIDs +{ + my $self = shift; + + $self->{'sql'}->select({ + 'fields' => [ $columns{'serviceid'} ], + 'table' => $tableName, + 'group' => [ $columns{'serviceid'} ], + 'order' => [ $columns{'serviceid'} ] }); + + my $ret = []; + while( defined( my $row = $self->{'sql'}->fetchrow_arrayref() ) ) + { + push( @{$ret}, $row->[0] ); + } + + return $ret; +} + + +# YYYY-MM-DD for start and end date +# returns the reference to the array of hashes for selected entries. + +sub getIntervalData +{ + my $self = shift; + my $startdate = shift; + my $enddate = shift; + my $serviceid = shift; + + $self->{'sql'}->select({ + 'fields' => + [ $columns{'srv_date'}, + $columns{'srv_time'}, + $columns{'value'}, + $columns{'intvl'} ], + 'table' => $tableName, + 'where' => [ {$columns{'serviceid'} => $serviceid}, + 'AND', + {$columns{'srv_date'} => ['>=', $startdate]}, + 'AND', + {$columns{'srv_date'} => ['<', $enddate]} + ]}); + + return $self->fetchall([ 'srv_date', 'srv_time', 'value', 'intvl' ]); +} + + + + + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Scheduler.pm b/torrus/perllib/Torrus/Scheduler.pm new file mode 100644 index 000000000..9777d7519 --- /dev/null +++ b/torrus/perllib/Torrus/Scheduler.pm @@ -0,0 +1,498 @@ +# 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: Scheduler.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + + +# Task scheduler. +# Task object MUST implement two methods: +# run() -- the running cycle +# whenNext() -- returns the next time it must be run. +# See below the Torrus::Scheduler::PeriodicTask class definition +# +# Options: +# -Tree => tree name +# -ProcessName => process name and commandline options +# -RunOnce => 1 -- this prevents from infinite loop. + + +package Torrus::Scheduler; + +use strict; +use Torrus::SchedulerInfo; +use Torrus::Log; + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + %{$self->{'options'}} = %options; + %{$self->{'data'}} = (); + + if( not defined( $options{'-Tree'} ) or + not defined( $options{'-ProcessName'} ) ) + { + die(); + } + + $self->{'stats'} = new Torrus::SchedulerInfo( -Tree => $options{'-Tree'}, + -WriteAccess => 1 ); + return $self; +} + + +sub DESTROY +{ + my $self = shift; + delete $self->{'stats'}; +} + +sub treeName +{ + my $self = shift; + return $self->{'options'}{'-Tree'}; +} + +sub setProcessStatus +{ + my $self = shift; + my $text = shift; + $0 = $self->{'options'}{'-ProcessName'} . ' [' . $text . ']'; +} + +sub addTask +{ + my $self = shift; + my $task = shift; + my $when = shift; + + if( not defined $when ) + { + # If not specified, run immediately + $when = time() - 1; + } + $self->storeTask( $task, $when ); + $self->{'stats'}->clearStats( $task->id() ); +} + + +sub storeTask +{ + my $self = shift; + my $task = shift; + my $when = shift; + + if( not defined( $self->{'tasks'}{$when} ) ) + { + $self->{'tasks'}{$when} = []; + } + push( @{$self->{'tasks'}{$when}}, $task ); +} + + +sub flushTasks +{ + my $self = shift; + + if( defined( $self->{'tasks'} ) ) + { + foreach my $when ( keys %{$self->{'tasks'}} ) + { + foreach my $task ( @{$self->{'tasks'}{$when}} ) + { + $self->{'stats'}->clearStats( $task->id() ); + } + } + undef $self->{'tasks'}; + } +} + + +sub run +{ + my $self = shift; + + my $stop = 0; + + while( not $stop ) + { + $self->setProcessStatus('initializing scheduler'); + while( not $self->beforeRun() ) + { + &Torrus::DB::checkInterrupted(); + + Error('Scheduler initialization error. Sleeping ' . + $Torrus::Scheduler::failedInitSleep . ' seconds'); + + &Torrus::DB::setUnsafeSignalHandlers(); + sleep($Torrus::Scheduler::failedInitSleep); + &Torrus::DB::setSafeSignalHandlers(); + } + $self->setProcessStatus(''); + my $nextRun = time() + 3600; + foreach my $when ( keys %{$self->{'tasks'}} ) + { + # We have 1-second rounding error + if( $when <= time() + 1 ) + { + foreach my $task ( @{$self->{'tasks'}{$when}} ) + { + &Torrus::DB::checkInterrupted(); + + my $startTime = time(); + + $self->beforeTaskRun( $task, $startTime, $when ); + $task->beforeRun( $self->{'stats'} ); + + $self->setProcessStatus('running'); + $task->run(); + my $whenNext = $task->whenNext(); + + $task->afterRun( $self->{'stats'}, $startTime ); + $self->afterTaskRun( $task, $startTime ); + + if( $whenNext > 0 ) + { + if( $whenNext == $when ) + { + Error("Incorrect time returned by task"); + } + $self->storeTask( $task, $whenNext ); + if( $nextRun > $whenNext ) + { + $nextRun = $whenNext; + } + } + } + delete $self->{'tasks'}{$when}; + } + elsif( $nextRun > $when ) + { + $nextRun = $when; + } + } + + if( $self->{'options'}{'-RunOnce'} or + ( scalar( keys %{$self->{'tasks'}} ) == 0 and + not $self->{'options'}{'-RunAlways'} ) ) + { + $self->setProcessStatus(''); + $stop = 1; + } + else + { + if( scalar( keys %{$self->{'tasks'}} ) == 0 ) + { + Info('Tasks list is empty. Will sleep until ' . + scalar(localtime($nextRun))); + } + + $self->setProcessStatus('sleeping'); + &Torrus::DB::setUnsafeSignalHandlers(); + Debug('We will sleep until ' . scalar(localtime($nextRun))); + + if( $Torrus::Scheduler::maxSleepTime > 0 ) + { + Debug('This is a VmWare-like clock. We devide the sleep ' . + 'interval into small pieces'); + while( time() < $nextRun ) + { + my $sleep = $nextRun - time(); + if( $sleep > $Torrus::Scheduler::maxSleepTime ) + { + $sleep = $Torrus::Scheduler::maxSleepTime; + } + Debug('Sleeping ' . $sleep . ' seconds'); + sleep( $sleep ); + } + } + else + { + my $sleep = $nextRun - time(); + if( $sleep > 0 ) + { + sleep( $sleep ); + } + } + + &Torrus::DB::setSafeSignalHandlers(); + } + } +} + + +# A method to override by ancestors. Executed every time before the +# running cycle. Must return true value when finishes. +sub beforeRun +{ + my $self = shift; + Debug('Torrus::Scheduler::beforeRun() - doing nothing'); + return 1; +} + + +sub beforeTaskRun +{ + my $self = shift; + my $task = shift; + my $startTime = shift; + my $plannedStartTime = shift; + + if( not $task->didNotRun() and $startTime > $plannedStartTime + 1 ) + { + my $late = $startTime - $plannedStartTime; + Verbose(sprintf('Task delayed %d seconds', $late)); + $self->{'stats'}->setStatsValues( $task->id(), 'LateStart', $late ); + } +} + + +sub afterTaskRun +{ + my $self = shift; + my $task = shift; + my $startTime = shift; + + my $len = time() - $startTime; + Verbose(sprintf('%s task finished in %d seconds', $task->name(), $len)); + + $self->{'stats'}->setStatsValues( $task->id(), 'RunningTime', $len ); +} + + +# User data can be stored here +sub data +{ + my $self = shift; + return $self->{'data'}; +} + + +# Periodic task base class +# Options: +# -Period => seconds -- cycle period +# -Offset => seconds -- time offset from even period moments +# -Name => "string" -- Symbolic name for log messages +# -Instance => N -- instance number + +package Torrus::Scheduler::PeriodicTask; + +use Torrus::Log; +use strict; + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + if( not defined( $options{'-Instance'} ) ) + { + $options{'-Instance'} = 0; + } + + %{$self->{'options'}} = %options; + + $self->{'options'}{'-Period'} = 0 unless + defined( $self->{'options'}{'-Period'} ); + + $self->{'options'}{'-Offset'} = 0 unless + defined( $self->{'options'}{'-Offset'} ); + + $self->{'options'}{'-Name'} = "PeriodicTask" unless + defined( $self->{'options'}{'-Name'} ); + + $self->{'missedPeriods'} = 0; + + $self->{'options'}{'-Started'} = time(); + + # Array of (Name, Value) pairs for any kind of stats + $self->{'statValues'} = []; + + Debug("New Periodic Task created: period=" . + $self->{'options'}{'-Period'} . + " offset=" . $self->{'options'}{'-Offset'}); + + return $self; +} + + +sub whenNext +{ + my $self = shift; + + if( $self->period() > 0 ) + { + my $now = time(); + my $period = $self->period(); + my $offset = $self->offset(); + my $previous; + + if( defined $self->{'previousSchedule'} ) + { + if( $now - $self->{'previousSchedule'} <= $period ) + { + $previous = $self->{'previousSchedule'}; + } + elsif( not $Torrus::Scheduler::ignoreClockSkew ) + { + Error('Last run of ' . $self->{'options'}{'-Name'} . + ' was more than ' . $period . ' seconds ago'); + $self->{'missedPeriods'} = + int( ($now - $self->{'previousSchedule'}) / $period ); + } + } + if( not defined( $previous ) ) + { + $previous = $now - ($now % $period) + $offset; + } + + my $whenNext = $previous + $period; + $self->{'previousSchedule'} = $whenNext; + + Debug("Task ". $self->{'options'}{'-Name'}. + " wants to run next time at " . scalar(localtime($whenNext))); + return $whenNext; + } + else + { + return undef; + } +} + + +sub beforeRun +{ + my $self = shift; + my $stats = shift; + + Verbose(sprintf('%s periodic task started. Period: %d:%.2d; ' . + 'Offset: %d:%.2d', + $self->name(), + int( $self->period() / 60 ), $self->period() % 60, + int( $self->offset() / 60 ), $self->offset() % 60)); +} + + +sub afterRun +{ + my $self = shift; + my $stats = shift; + my $startTime = shift; + + my $len = time() - $startTime; + if( $len > $self->period() ) + { + Warn(sprintf('%s task execution (%d) longer than period (%d)', + $self->name(), $len, $self->period())); + + $stats->setStatsValues( $self->id(), 'TooLong', $len ); + $stats->incStatsCounter( $self->id(), 'OverrunPeriods', + int( $len > $self->period() ) ); + } + + if( $self->{'missedPeriods'} > 0 ) + { + $stats->incStatsCounter( $self->id(), 'MissedPeriods', + $self->{'missedPeriods'} ); + $self->{'missedPeriods'} = 0; + } + + foreach my $pair( @{$self->{'statValues'}} ) + { + $stats->setStatsValues( $self->id(), @{$pair} ); + } + @{$self->{'statValues'}} = []; +} + + +sub run +{ + my $self = shift; + Error("Dummy class Torrus::Scheduler::PeriodicTask was run"); +} + + +sub period +{ + my $self = shift; + return $self->{'options'}->{'-Period'}; +} + + +sub offset +{ + my $self = shift; + return $self->{'options'}->{'-Offset'}; +} + + +sub didNotRun +{ + my $self = shift; + return( not defined( $self->{'previousSchedule'} ) ); +} + + +sub name +{ + my $self = shift; + return $self->{'options'}->{'-Name'}; +} + +sub instance +{ + my $self = shift; + return $self->{'options'}->{'-Instance'}; +} + + +sub whenStarted +{ + my $self = shift; + return $self->{'options'}->{'-Started'}; +} + + +sub id +{ + my $self = shift; + return join(':', 'P', $self->name(), $self->instance(), + $self->period(), $self->offset()); +} + +sub setStatValue +{ + my $self = shift; + my $name = shift; + my $value = shift; + + push( @{$self->{'statValues'}}, [$name, $value] ); +} + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/SchedulerInfo.pm b/torrus/perllib/Torrus/SchedulerInfo.pm new file mode 100644 index 000000000..452b16129 --- /dev/null +++ b/torrus/perllib/Torrus/SchedulerInfo.pm @@ -0,0 +1,216 @@ +# 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: SchedulerInfo.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + + +# Task scheduler runtime information. Quite basic statistics access. + +package Torrus::SchedulerInfo; + +use Torrus::DB; +use Torrus::Log; +use strict; + + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + %{$self->{'options'}} = %options; + + die() if not defined( $options{'-Tree'} ); + + $self->{'db_stats'} = + new Torrus::DB( 'scheduler_stats', + -Subdir => $self->{'options'}{'-Tree'}, + -Btree => 1, + -WriteAccess => $options{'-WriteAccess'} ); + + return( defined( $self->{'db_stats'} ) ? $self:undef ); +} + + +sub DESTROY +{ + my $self = shift; + delete $self->{'db_stats'}; +} + + +sub readStats +{ + my $self = shift; + + my $stats = {}; + + my $cursor = $self->{'db_stats'}->cursor(); + while( my ($key, $value) = $self->{'db_stats'}->next($cursor) ) + { + my( $id, $variable ) = split( '#', $key ); + if( defined( $id ) and defined( $variable ) ) + { + $stats->{$id}{$variable} = $value; + } + } + undef $cursor; + + return $stats; +} + + +sub setValue +{ + my $self = shift; + my $id = shift; + my $variable = shift; + my $value = shift; + + $self->{'db_stats'}->put( join('#', $id, $variable), $value ); +} + +sub getValue +{ + my $self = shift; + my $id = shift; + my $variable = shift; + + return $self->{'db_stats'}->get( join('#', $id, $variable) ); +} + + +sub clearStats +{ + my $self = shift; + my $id = shift; + + my $cursor = $self->{'db_stats'}->cursor( -Write => 1 ); + while( my ($key, $value) = $self->{'db_stats'}->next($cursor) ) + { + my( $db_id, $variable ) = split( '#', $key ); + if( defined( $db_id ) and defined( $variable ) and + $id eq $db_id ) + { + $self->{'db_stats'}->c_del( $cursor ); + } + } + undef $cursor; +} + + +sub clearAll +{ + my $self = shift; + $self->{'db_stats'}->trunc(); +} + + +sub setStatsValues +{ + my $self = shift; + my $id = shift; + my $variable = shift; + my $value = shift; + + $self->setValue( $id, 'Last' . $variable, $value ); + + my $maxName = 'Max' . $variable; + my $maxVal = $self->getValue( $id, $maxName ); + if( not defined( $maxVal ) or $value > $maxVal ) + { + $maxVal = $value; + } + $self->setValue( $id, $maxName, $maxVal ); + + my $minName = 'Min' . $variable; + my $minVal = $self->getValue( $id, $minName ); + if( not defined( $minVal ) or $value < $minVal ) + { + $minVal = $value; + } + $self->setValue( $id, $minName, $minVal ); + + my $timesName = 'NTimes' . $variable; + my $nTimes = $self->getValue( $id, $timesName ); + + my $avgName = 'Avg' . $variable; + my $average = $self->getValue( $id, $avgName ); + + if( not defined( $nTimes ) ) + { + $nTimes = 1; + $average = $value; + } + else + { + $average = ( $average * $nTimes + $value ) / ( $nTimes + 1 ); + $nTimes++; + } + $self->setValue( $id, $timesName, $nTimes ); + $self->setValue( $id, $avgName, $average ); + + my $expAvgName = 'ExpAvg' . $variable; + my $expAverage = $self->getValue( $id, $expAvgName ); + if( not defined( $expAverage ) ) + { + $expAverage = $value; + } + else + { + my $alpha = $Torrus::Scheduler::statsExpDecayAlpha; + $expAverage = $alpha * $value + ( 1 - $alpha ) * $expAverage; + } + $self->setValue( $id, $expAvgName, $expAverage ); +} + + +sub incStatsCounter +{ + my $self = shift; + my $id = shift; + my $variable = shift; + my $increment = shift; + + if( not defined( $increment ) ) + { + $increment = 1; + } + + my $name = 'Count' . $variable; + my $previous = $self->getValue( $id, $name ); + + if( not defined( $previous ) ) + { + $previous = 0; + } + + $self->setValue( $id, $name, $previous + $increment ); +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/Search.pm b/torrus/perllib/Torrus/Search.pm new file mode 100644 index 000000000..9923757db --- /dev/null +++ b/torrus/perllib/Torrus/Search.pm @@ -0,0 +1,148 @@ +# 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: Search.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + + +# Task scheduler runtime information. Quite basic statistics access. + +package Torrus::Search; + +use Torrus::DB; +use Torrus::Log; +use strict; + + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + %{$self->{'options'}} = %options; + + return $self; +} + + +sub openTree +{ + my $self = shift; + my $tree = shift; + + my $db = new Torrus::DB + ( 'searchwords', + -Subdir => $tree, + -Btree => 1, + -Duplicates => 1, + -WriteAccess => $self->{'options'}{'-WriteAccess'}, + -Truncate => $self->{'options'}{'-WriteAccess'} ); + + $self->{'db_treewords'}{$tree} = $db; +} + + +sub closeTree +{ + my $self = shift; + my $tree = shift; + + $self->{'db_treewords'}{$tree}->closeNow(); +} + + +sub openGlobal +{ + my $self = shift; + + my $db = new Torrus::DB + ( 'globsearchwords', + -Btree => 1, + -Duplicates => 1, + -WriteAccess => $self->{'options'}{'-WriteAccess'}, + -Truncate => $self->{'options'}{'-WriteAccess'} ); + + $self->{'db_globwords'} = $db; +} + + +sub storeKeyword +{ + my $self = shift; + my $tree = shift; + my $keyword = lc( shift ); + my $path = shift; + my $param = shift; + + my $val = $path; + if( defined( $param ) ) + { + $val .= ':' . $param; + } + + my $lookupkey = join( ':', $tree, $keyword, $val ); + if( not $self->{'stored'}{$lookupkey} ) + { + $self->{'db_treewords'}{$tree}->put( $keyword, $val ); + if( defined( $self->{'db_globwords'} ) ) + { + $self->{'db_globwords'}->put( $keyword, join(':', $tree, $val) ); + } + + $self->{'stored'}{$lookupkey} = 1; + } +} + +sub searchPrefix +{ + my $self = shift; + my $prefix = lc( shift ); + my $tree = shift; + + my $db = defined( $tree ) ? + $self->{'db_treewords'}{$tree} : $self->{'db_globwords'}; + + my $result = $db->searchPrefix( $prefix ); + + my $ret = []; + + if( defined( $result ) ) + { + foreach my $pair ( @{$result} ) + { + my $retstrings = []; + push( @{$retstrings}, split(':', $pair->[1]) ); + push( @{$ret}, $retstrings ); + } + } + + return $ret; +} + + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/ServiceID.pm b/torrus/perllib/Torrus/ServiceID.pm new file mode 100644 index 000000000..90cbb98e0 --- /dev/null +++ b/torrus/perllib/Torrus/ServiceID.pm @@ -0,0 +1,188 @@ +# 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: ServiceID.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Manage the properties assigned to Service IDs + +package Torrus::ServiceID; + +use Torrus::DB; +use Torrus::Log; + +use strict; + + +sub new +{ + my $self = {}; + my $class = shift; + my %options = @_; + bless $self, $class; + + my $writing = $options{'-WriteAccess'}; + + $self->{'db_params'} = + new Torrus::DB( 'serviceid_params', + -Btree => 1, + -WriteAccess => $writing ); + defined( $self->{'db_params'} ) or return( undef ); + + $self->{'is_writing'} = $writing; + + return $self; +} + + +sub DESTROY +{ + my $self = shift; + Debug('Destroyed ServiceID object'); + undef $self->{'db_params'}; +} + + + +sub idExists +{ + my $self = shift; + my $serviceid = shift; + my $tree = shift; + + if( defined($tree) ) + { + return $self->{'db_params'}->searchList( 't:'.$tree, $serviceid ); + } + + return $self->{'db_params'}->searchList( 'a:', $serviceid ); +} + + +sub add +{ + my $self = shift; + my $serviceid = shift; + my $parameters = shift; + + $self->{'db_params'}->addToList( 'a:', $serviceid ); + + my $trees = $parameters->{'trees'}; + + foreach my $tree ( split(/\s*,\s*/o, $trees) ) + { + $self->{'db_params'}->addToList( 't:'.$tree, $serviceid ); + } + + foreach my $param ( keys %{$parameters} ) + { + my $val = $parameters->{$param}; + + if( defined( $val ) and length( $val ) > 0 ) + { + $self->{'db_params'}->put( 'p:'.$serviceid.':'.$param, $val ); + $self->{'db_params'}->addToList( 'P:'.$serviceid, $param ); + } + } +} + + +sub getParams +{ + my $self = shift; + my $serviceid = shift; + + my $ret = {}; + my $plist = $self->{'db_params'}->get( 'P:'.$serviceid ); + foreach my $param ( split(',', $plist ) ) + { + $ret->{$param} = + $self->{'db_params'}->get( 'p:'.$serviceid.':'.$param ); + } + + return $ret; +} + + +sub getAllForTree +{ + my $self = shift; + my $tree = shift; + + my $ret = []; + my $idlist = $self->{'db_params'}->get('t:'.$tree); + if( defined( $idlist ) ) + { + push( @{$ret}, split( ',', $idlist ) ); + } + return $ret; +} + + +sub cleanAllForTree +{ + my $self = shift; + my $tree = shift; + + my $idlist = $self->{'db_params'}->get('t:'.$tree); + if( defined( $idlist ) ) + { + foreach my $serviceid ( split( ',', $idlist ) ) + { + # A ServiceID may belong to several trees. + # delete it from all other trees. + + my $srvTrees = + $self->{'db_params'}->get( 'p:'.$serviceid.':trees' ); + + foreach my $srvTree ( split(/\s*,\s*/o, $srvTrees) ) + { + if( $srvTree ne $tree ) + { + $self->{'db_params'}->delFromList( 't:'.$srvTree, + $serviceid ); + } + } + + $self->{'db_params'}->delFromList( 'a:', $serviceid ); + + my $plist = $self->{'db_params'}->get( 'P:'.$serviceid ); + + foreach my $param ( split(',', $plist ) ) + { + $self->{'db_params'}->del( 'p:'.$serviceid.':'.$param ); + } + + $self->{'db_params'}->del( 'P:'.$serviceid ); + + } + $self->{'db_params'}->deleteList('t:'.$tree); + } +} + + + + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/SiteConfig.pm b/torrus/perllib/Torrus/SiteConfig.pm new file mode 100644 index 000000000..947d0856c --- /dev/null +++ b/torrus/perllib/Torrus/SiteConfig.pm @@ -0,0 +1,335 @@ +# 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: SiteConfig.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +## %Torrus::Global::treeConfig manipulation + +package Torrus::SiteConfig; + +use Torrus::Log; +use strict; + +our %validDaemonNames = ('collector' => 1, + 'monitor' => 1); + +our %mandatoryGraphStyles = + ( + 'SingleGraph' => {'color' => 1, 'line' => 1}, + 'HWBoundary' => {'color' => 1, 'line' => 1}, + 'HWFailure' => {'color' => 1}, + 'HruleMin' => {'color' => 1}, + 'HruleNormal' => {'color' => 1}, + 'HruleMax' => {'color' => 1}, + 'BpsIn' => {'color' => 1, 'line' => 1}, + 'BpsOut' => {'color' => 1, 'line' => 1} + ); + +%Torrus::SiteConfig::validLineStyles = + ( + 'LINE1' => 1, + 'LINE2' => 1, + 'LINE3' => 1, + 'AREA' => 1, + 'STACK' => 1 + ); + +## Verify the correctness of %Torrus::Global::treeConfig contents + +sub verify +{ + my $ok = 1; + if( not (scalar( keys %Torrus::Global::treeConfig )) ) + { + Error('%Torrus::Global::treeConfig is not defined or empty'); + $ok = 0; + } + + foreach my $tree ( keys %Torrus::Global::treeConfig ) + { + if( $tree !~ /^[a-zA-Z][a-zA-Z0-9_\-]*$/o ) + { + Error("Invalid tree name: " . $tree); + $ok = 0; + next; + } + + if( not $Torrus::Global::treeConfig{$tree}{'description'} ) + { + Error("Missing description for the tree named \"" . $tree . "\""); + $ok = 0; + } + + my $xmlfiles = $Torrus::Global::treeConfig{$tree}{'xmlfiles'}; + if( not ref( $xmlfiles ) or not scalar( @{$xmlfiles} ) ) + { + Error("'xmlfiles' array is not defined for the tree named \"" . + $tree . "\""); + $ok = 0; + } + else + { + foreach my $file ( @{$xmlfiles} ) + { + $ok = findXMLFile( $file, + "in the tree named \"" . $tree . "\"" ) ? + $ok:0; + } + + if( ref( $Torrus::Global::treeConfig{$tree}{'run'} ) ) + { + foreach my $daemon + ( keys %{$Torrus::Global::treeConfig{$tree}{'run'}} ) + { + if( not $validDaemonNames{$daemon} ) + { + Error("\"" . $daemon . "\" is not a correct daemon " . + "name in the tree named \"" . $tree . "\""); + $ok = 0; + } + } + } + } + } + + foreach my $file ( @Torrus::Global::xmlAlwaysIncludeFirst ) + { + $ok = findXMLFile( $file, + 'in @Torrus::Global::xmlAlwaysIncludeFirst' ) ? + $ok:0; + } + foreach my $file ( @Torrus::Global::xmlAlwaysIncludeLast ) + { + $ok = findXMLFile( $file, + 'in @Torrus::Global::xmlAlwaysIncludeLast' ) ? + $ok:0; + } + + # Validate the styling profile + + my $file = $Torrus::Global::stylingDir . '/' . + $Torrus::Renderer::stylingProfile . '.pl'; + if( -r $file ) + { + require $file; + + #Color names are always there + require $Torrus::Global::stylingDir . '/colornames.pl'; + + if( defined($Torrus::Renderer::stylingProfileOverlay) ) + { + my $overlay = $Torrus::Renderer::stylingProfileOverlay; + if( -r $overlay ) + { + require $overlay; + } + else + { + Error('Error reading styling profile overlay from ' . + $overlay . ': File is not readable'); + $ok = 0; + } + } + + my $profile = \%Torrus::Renderer::graphStyles; + # Check if mandatory parameters present + foreach my $element ( keys %mandatoryGraphStyles ) + { + if( ref( $profile->{$element} ) ) + { + if( $mandatoryGraphStyles{$element}{'color'} + and not defined( $profile->{$element}{'color'} ) ) + { + Error('Mandatory color for ' . $element . + ' is not defined in ' . $file); + $ok = 0; + } + if( $mandatoryGraphStyles{$element}{'line'} + and not defined( $profile->{$element}{'line'} ) ) + { + Error('Mandatory line style for ' . $element . + ' is not defined in ' . $file); + $ok = 0; + } + } + else + { + Error('Mandatory styling for ' . $element . + ' is not defined in ' . $file); + $ok = 0; + } + } + # Check validity of all parameters + foreach my $element ( keys %{$profile} ) + { + if( defined( $profile->{$element}{'color'} ) ) + { + my $color = $profile->{$element}{'color'}; + my $recursionLimit = 100; + + while( $color =~ /^\#\#(\S+)$/ ) + { + if( $recursionLimit-- <= 0 ) + { + Error('Color recursion is too deep'); + $ok = 0; + } + else + { + my $colorName = $1; + $color = $profile->{$colorName}{'color'}; + if( not defined( $color ) ) + { + Error('No color is defined for ' . $colorName); + $ok = 0; + } + } + } + + if( $color !~ /^\#[0-9a-fA-F]{6}$/ ) + { + Error('Invalid color specification for ' . $element . + ' in ' . $file); + $ok = 0; + } + } + if( defined( $profile->{$element}{'line'} ) ) + { + if( not $Torrus::SiteConfig::validLineStyles{ + $profile->{$element}{'line'}} ) + { + Error('Invalid line specification for ' . $element . + ' in ' . $file); + $ok = 0; + } + } + } + } + else + { + Error('Error reading styling profile from ' . $file . + ': File is not readable'); + $ok = 0; + } + + return $ok; +} + + +sub findXMLFile +{ + my $file = shift; + my $msg = shift; + + my $filename; + if( defined( $file ) ) + { + my $found = 0; + foreach my $dir ( @Torrus::Global::xmlDirs ) + { + $filename = $dir . '/' . $file; + if( -r $filename ) + { + $found = 1; + last; + } + } + + if( not $found ) + { + Error("Cannot find file: " . $file); + $filename = undef; + } + } + else + { + Error("File name undefined " . $msg); + } + return $filename; +} + + +sub treeExists +{ + my $tree = shift; + return defined( $Torrus::Global::treeConfig{$tree} ); +} + + +sub listTreeNames +{ + return( sort keys %Torrus::Global::treeConfig ); +} + + +sub mayRunCollector +{ + my $tree = shift; + my $run = $Torrus::Global::treeConfig{$tree}{'run'}{'collector'}; + return( defined($run) and $run > 0 ); +} + +sub collectorInstances +{ + my $tree = shift; + my $run = $Torrus::Global::treeConfig{$tree}{'run'}{'collector'}; + return( (defined($run) and $run > 1) ? int($run) : 1 ); +} + +sub mayRunMonitor +{ + my $tree = shift; + return $Torrus::Global::treeConfig{$tree}{'run'}{'monitor'}; +} + + +sub listXmlFiles +{ + my $tree = shift; + return @{$Torrus::Global::treeConfig{$tree}{'xmlfiles'}}; +} + + +sub treeDescription +{ + my $tree = shift; + return $Torrus::Global::treeConfig{$tree}{'description'}; +} + + +sub loadStyling +{ + require $Torrus::Global::stylingDir . '/' . + $Torrus::Renderer::stylingProfile . '.pl'; + + require $Torrus::Global::stylingDir . '/colornames.pl'; + + if( defined($Torrus::Renderer::stylingProfileOverlay) ) + { + require $Torrus::Renderer::stylingProfileOverlay; + } +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: diff --git a/torrus/perllib/Torrus/TimeStamp.pm b/torrus/perllib/Torrus/TimeStamp.pm new file mode 100644 index 000000000..07959141c --- /dev/null +++ b/torrus/perllib/Torrus/TimeStamp.pm @@ -0,0 +1,71 @@ +# 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: TimeStamp.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +package Torrus::TimeStamp; + +use Torrus::DB; +use Torrus::Log; + +use strict; + +$Torrus::TimeStamp::db = undef; + +END +{ + Torrus::TimeStamp::release(); +} + +sub init +{ + not defined( $Torrus::TimeStamp::db ) or + die('$Torrus::TimeStamp::db is defined at init'); + $Torrus::TimeStamp::db = new Torrus::DB('timestamps', -WriteAccess => 1); +} + +sub release +{ + undef $Torrus::TimeStamp::db; +} + +sub setNow +{ + my $tname = shift; + ref( $Torrus::TimeStamp::db ) or + die('$Torrus::TimeStamp::db is not defined at setNow'); + $Torrus::TimeStamp::db->put( $tname, time() ); +} + +sub get +{ + my $tname = shift; + ref( $Torrus::TimeStamp::db ) or + die('$Torrus::TimeStamp::db is not defined at get'); + my $stamp = $Torrus::TimeStamp::db->get( $tname ); + return defined($stamp) ? $stamp : 0; +} + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: |