torrus-2.09/0000755000175000017500000000000012661116101007776 500000000000000torrus-2.09/COPYING0000644000175000017500000004311011545711243010760 00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. torrus-2.09/perllib/0000755000175000017500000000000012661116101011427 500000000000000torrus-2.09/perllib/Torrus/0000755000175000017500000000000012661116101012725 500000000000000torrus-2.09/perllib/Torrus/DB.pm0000644000175000017500000003576012661116101013503 00000000000000# 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. # Stanislav Sinyagin # this policy is paranoic about our next() method ## no critic (Subroutines::ProhibitBuiltinHomonyms) package Torrus::DB; use strict; use warnings; use Torrus::Log; use BerkeleyDB; # 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 $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{'HUP'} = sub { if( $safeSignals ) { Warn('Received SIGHUP. Scheduling to exit.'); $interrupted = 1; } else { Warn('Received SIGHUP. Stopping the process.'); exit(1); } }; $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; return; } sub setSafeSignalHandlers { setSignalHandlers(); $safeSignals = 1; return; } sub setUnsafeSignalHandlers { setSignalHandlers(); $safeSignals = 0; return; } # If we were previously interrupted, gracefully exit now sub checkInterrupted { if( $interrupted ) { Warn('Stopping the process'); exit(1); } return; } 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'}; return; } 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; } } return; } sub delay { my $self = shift; $self->{'delay_list_commit'} = 1; return; } 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; $self->{'dbh'}->db_put($key, $val); return; } 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 ); return; } 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 ); } sub c_close { my $self = shift; my $cursor = shift; $cursor->c_close(); return; } # 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; } return; } sub _storeListCache { my $self = shift; my $key = shift; if( not $self->{'delay_list_commit'} ) { $self->put($key, join(',', keys %{$self->{'listcache'}{$key}})); } return; } sub addToList { my $self = shift; my $key = shift; my $newval = shift; $self->_populateListCache($key); $self->{'listcache'}{$key}{$newval} = 1; $self->_storeListCache($key); return; } 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); return; } 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); return; } 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})); } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/Monitor.pm0000644000175000017500000004327412661116101014644 00000000000000# Copyright (C) 2002-2011 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. # Stanislav Sinyagin package Torrus::Monitor; use strict; use warnings; use base 'Torrus::Scheduler::PeriodicTask'; use Torrus::DB; use Torrus::ConfigTree; 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'}; 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 ); return; } 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; if( defined($alarm) ) { Debug("Monitor $mname returned ($alarm, $timestamp) ". "for token $token"); $self->setAlarm( $config_tree, $obj ); } else { Debug("Monitor $mname returned undefined alarm value"); } } } $self->cleanupExpired(); delete $self->{'db_alarms'}; return; } 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'}; # Timezone manipulation that would affect TOD function in RPN my $tz = $config_tree->getParam($mname,'time-zone'); if( not defined($tz) ) { $tz = $ENV{'TZ'}; } local $ENV{'TZ'}; if( defined($tz) ) { $ENV{'TZ'} = $tz; } my $t_end = undef; my $t_start = undef; my $timespan = $config_tree->getParam($mname,'time-span'); if( defined($timespan) and $timespan > 0 ) { $t_end = 'LAST'; $t_start = 'LAST-' . $timespan; } my ($value, $timestamp) = $obj->{'da'}->read($config_tree, $token, $t_end, $t_start); $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/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); $t_expires = 0; my %escalation_state; # true value if escalation was fired if( defined($prev_values) ) { my @fired_escalations; Debug("Previous state found, Alarm: $alarm, ". "Token: $token, Monitor: $mname"); ($t_set, $t_expires, $prev_status, $t_last_change, @fired_escalations) = split(':', $prev_values); foreach my $esc_time (@fired_escalations) { $escalation_state{$esc_time} = 1; } } my @escalation_times; my $esc = $config_tree->getParam($mname, 'escalations'); if( defined($esc) ) { @escalation_times = split(',', $esc); } my @fire_escalations; my $event; $t_last_change = time(); if( $alarm ) { if( not $prev_status ) { $t_set = $timestamp; $event = 'set'; } else { $event = 'repeat'; } foreach my $esc_time (@escalation_times) { if( ($t_last_change >= $t_set + $esc_time) and not $escalation_state{$esc_time} ) { push(@fire_escalations, $esc_time); $escalation_state{$esc_time} = 1; } } } else { if( $prev_status ) { $t_expires = $t_last_change + $config_tree->getParam($mname, 'expires'); $event = 'clear'; } else { if( $t_expires > 0 and time() > $t_expires ) { $self->{'db_alarms'}->del( $key ); $event = 'forget'; } } } if( $event ) { Debug("Event: $event, Monitor: $mname, Token: $token"); 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; $obj->{'event'} = $event; $obj->{'escalation'} = 0; $self->run_actions($config_tree, $obj ); if( $event eq 'repeat' ) { $obj->{'event'} = 'escalate'; foreach my $esc_time (@fire_escalations) { Debug("Escalation: $esc_time"); $obj->{'escalation'} = $esc_time; $self->run_actions($config_tree, $obj ); } } elsif( $event eq 'clear' ) { $obj->{'event'} = 'clear_escalation'; foreach my $esc_time (keys %escalation_state) { Debug("Clear escalation: $esc_time"); $obj->{'escalation'} = $esc_time; $self->run_actions($config_tree, $obj ); } } if( $event ne 'forget' ) { $self->{'db_alarms'}->put( $key, join(':', ($t_set, $t_expires, ($alarm ? 1:0), $t_last_change, keys %escalation_state)) ); } } return; } sub run_actions { my $self = shift; my $config_tree = shift; my $obj = shift; my $mname = $obj->{'mname'}; foreach my $aname (split(',', $config_tree->getParam($mname, 'action'))) { &Torrus::DB::checkInterrupted(); Info(sprintf('Running action %s for event %s in monitor %s', $aname, $obj->{'event'}, $obj->{'mname'})); my $method = 'run_event_' . $config_tree->getParam($aname, 'action-type'); $self->$method( $config_tree, $aname, $obj ); } } # 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 ); } } $self->{'db_alarms'}->c_close($cursor); &Torrus::DB::checkInterrupted(); return; } 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'}; my $add; my $remove; if( $event eq 'forget' ) { $remove = 1; } else { my $esc = $config_tree->getParam($aname, 'on-escalations'); if( defined($esc) ) { if( $event eq 'escalate' ) { foreach my $esc_time (split(',', $esc)) { if( $obj->{'escalation'} == $esc_time ) { $add = 1; last; } } } } elsif( $event eq 'set' ) { $add = 1; } } if( $add or $remove ) { my $tset = 'S'.$config_tree->getParam($aname, 'tset-name'); my $path = $config_tree->path($token); if( $add ) { Info("Adding $path to tokenset $tset"); $config_tree->tsetAddMember($tset, $token, 'monitor'); } if( $remove ) { Info("Removing $path from tokenset $tset"); $config_tree->tsetDelMember($tset, $token); } } return; } 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 $launch_when = $config_tree->getParam($aname, 'launch-when'); if( not defined $launch_when ) { $launch_when = 'set,escalate'; } if( grep {$event eq $_} split(',', $launch_when) ) { my $cmd = $config_tree->getParam($aname, 'command'); $cmd =~ s/\>\;/\>/; $cmd =~ s/\<\;/\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_ESCALATION'} = $obj->{'escalation'}; $ENV{'TORRUS_MONITOR'} = $mname; $ENV{'TORRUS_MCOMMENT'} = $config_tree->getParam($mname, 'comment'); $ENV{'TORRUS_TSTAMP'} = $obj->{'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 ) ) { # # 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; } } Info("Executing command: $cmd"); my $status = system($cmd); if( $status != 0 ) { Error("$cmd executed with error: $!"); } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/Renderer/0000755000175000017500000000000012661116101014473 500000000000000torrus-2.09/perllib/Torrus/Renderer/Frontpage.pm0000644000175000017500000001745612661116101016713 00000000000000# 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. # Stanislav Sinyagin package Torrus::Renderer::Frontpage; use strict; use warnings; 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] }, 'pathUrl' => sub { return $Torrus::Renderer::rendererURL . '/' . $_[0] . '?path=' . $_[1] }, 'plainURL' => $Torrus::Renderer::plainURL, '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 $str = join( ':', $element->[0], $element->[1] ); if( not $seen{$str} ) { $seen{$str} = 1; push( @{$ret}, $element ); } } return $ret; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/Renderer/HTML.pm0000644000175000017500000003364112661116101015524 00000000000000# 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. # Stanislav Sinyagin # our sort block is a bit complicated here ## no critic (BuiltinFunctions::RequireSimpleSortBlock) package Torrus::Renderer::HTML; use strict; use warnings; 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; use IO::File; 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, @_); }, '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 $n ne '' ) { 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. # Link is done with nodeid if available, or with path sub makeURL { my $self = shift; my $config_tree = shift; my $token = shift; my $view = shift; my @add_vars = @_; my $ret = $Torrus::Renderer::rendererURL . '/' . $config_tree->treeName(); # Try using nodeid whenever it's available if( $config_tree->isTset($token) ) { $ret .= '?token=' . $token; } else { 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); } } 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 = ''; $str .= sprintf('%s%s', $self->makeURL($config_tree, $token, $view), $config_tree->nodeName($path), ( $config_tree->isSubtree($token) and $path ne '/') ? '/':'' ); $str .= "\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 { my $fh = IO::File->new($fname, 'r'); if( not defined($fh) ) { Error("Cannot open $fname for reading: $!"); } else { chomp(my $values = <$fh>); @ret = split(':', $values); $fh->close(); } } 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'} ) { return ($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'} ) { return ($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 '' . $_[0] . ''; }, 'strong' => sub { return '' . $_[0] . ''; } }; 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: torrus-2.09/perllib/Torrus/Renderer/RPC.pm0000644000175000017500000003276012661116101015405 00000000000000# Copyright (C) 2011 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. # Stanislav Sinyagin package Torrus::Renderer::RPC; use strict; use warnings; use Torrus::ConfigTree; use Torrus::Log; use RRDs; use JSON (); use IO::File; use Math::BigFloat; # Set to true if you want JSON to be pretty and canonical our $pretty_json; # List of parameters that are always queried our @default_leaf_params; # never return these parameters our %params_blacklist; # make sure we don't pull too much data our $result_limit = 100; my %rpc_methods = ( 'WALK_LEAVES' => { 'call' => \&rpc_walk_leaves, 'needs_params' => 1, }, 'AGGREGATE_DS' => { 'call' => \&rpc_aggregate_ds, }, 'TIMESERIES' => { 'call' => \&rpc_timeseries, }, 'SEARCH_NODEID' => { 'call' => \&rpc_search_nodeid, 'needs_params' => 1, }, ); # All our methods are imported by Torrus::Renderer; sub render_rpc { my $self = shift; my $config_tree = shift; my $token = shift; my $view = shift; my $outfile = shift; my $result = {'success' => 1, 'data' => {}}; my $callproc = $self->{'options'}{'variables'}{'RPCCALL'}; if( not defined $callproc ) { $result->{'success'} = 0; $result->{'error'} = 'Missing RPC call name in RPCCALL'; } elsif( not defined($rpc_methods{$callproc}) ) { $result->{'success'} = 0; $result->{'error'} = 'Unsupported RPC call: ' . $callproc; } # Prepare the list of parameters to retrieve via an RPC call my @params; if( $result->{'success'} and $rpc_methods{$callproc}{'needs_params'} ) { push(@params, @default_leaf_params); my $additional_params = $self->{'options'}{'variables'}{'GET_PARAMS'}; if( defined($additional_params) ) { foreach my $p (split(/\s*,\s*/o, $additional_params)) { if( $params_blacklist{$p} ) { $result->{'success'} = 0; $result->{'error'} = 'Parameter ' . $p . ' is blacklisted'; last; } else { push(@params, $p); } } } } # Process the call if( $result->{'success'} ) { &{$rpc_methods{$callproc}{'call'}} ($self, $config_tree, { 'token' => $token, 'view' => $view, 'params' => \@params, 'result' => $result }); } my $json = new JSON; if( $pretty_json or $self->{'options'}{'variables'}{'PRETTY'}) { $json->pretty; $json->canonical; } my $fh = new IO::File($outfile, 'w'); if( not $fh ) { Error("Error opening $outfile for writing: $!"); return undef; } $fh->binmode(':utf8'); print $fh $json->encode($result); $fh->close; my $expires = $config_tree->getParam($view, 'expires'); return ($expires+time(), 'application/json'); } sub rpc_walk_leaves { my $self = shift; my $config_tree = shift; my $opts = shift; my $token = $opts->{'token'}; my $params = $opts->{'params'}; my $result = $opts->{'result'}; if( scalar(keys %{$result->{'data'}}) > $result_limit ) { $result->{'success'} = 0; $result->{'error'} = 'Result is too big. Aborting the tree walk'; return; } if( $config_tree->isLeaf($token) ) { my $data = {'path' => $config_tree->path($token)}; foreach my $p (@{$params}) { my $val = $config_tree->getNodeParam($token, $p); if( defined($val) ) { $data->{$p} = $val; } } $result->{'data'}{$token} = $data; } elsif( $config_tree->isSubtree($token) ) { foreach my $ctoken ($config_tree->getChildren($token)) { rpc_walk_leaves($self, $config_tree, {'token' => $ctoken, 'params' => $params, 'result' => $result}); } } return; } my @rpc_print_statements = ( { 'name' => 'START', 'args' => ['CDEF:B1=Aavg,POP,TIME', 'VDEF:B2=B1,MINIMUM', 'PRINT:B2:%.0lf'], }, { 'name' => 'END', 'args' => ['CDEF:C1=Aavg,POP,TIME', 'VDEF:C2=C1,MAXIMUM', 'PRINT:C2:%.0lf'], }, { 'name' => 'AVG', 'args' => ['VDEF:D1=Aavg,AVERAGE', 'PRINT:D1:%le'], }, { 'name' => 'AVAIL', 'args' => ['CDEF:F1=Aavg,UN,0,100,IF', 'VDEF:F2=F1,AVERAGE', 'PRINT:F2:%.2lf'], }, ); my @rpc_print_max_statements = ( { 'name' => 'MAX', 'args' => ['VDEF:E1=Amax,MAXIMUM', 'PRINT:E1:%le'], }, ); my %rrd_print_opts = ( 'start' => '--start', 'end' => '--end', ); sub rpc_aggregate_ds { my $self = shift; my $config_tree = shift; my $opts = shift; my $token = $opts->{'token'}; my $view = $opts->{'view'}; my $params = $opts->{'params'}; my $result = $opts->{'result'}; if( not $config_tree->isLeaf($token) ) { $result->{'success'} = 0; $result->{'error'} = 'AGGREGATE_DS method supports only leaf nodes'; return; } if( $config_tree->getNodeParam($token, 'ds-type') eq 'rrd-multigraph' ) { $result->{'success'} = 0; $result->{'error'} = 'AGGREGATE_DS method does not support rrd-multigraph leaves'; return undef; } my $leaftype = $config_tree->getNodeParam($token, 'leaf-type'); if( $leaftype ne 'rrd-def' ) { $result->{'success'} = 0; $result->{'error'} = 'Unsupported leaf-type: ' . $leaftype; return; } my $rra = $config_tree->getNodeParam($token, 'rrd-create-rra'); my $has_max = ($rra =~ /RRA:MAX:/s); my @args; push( @args, $self->rrd_make_opts( $config_tree, $token, $view, \%rrd_print_opts, ) ); push( @args, $self->rrd_make_def($config_tree, $token, 'Aavg', 'AVERAGE') ); if( $has_max ) { push( @args, $self->rrd_make_def($config_tree, $token, 'Amax', 'MAX') ); } my @prints; push( @prints, @rpc_print_statements ); if( $has_max ) { push( @prints, @rpc_print_max_statements ); } foreach my $entry ( @prints ) { push( @args, @{$entry->{'args'}} ); } Debug('RRDs::graphv arguments: ' . join(' ', @args)); my $r = RRDs::graphv('-', @args); my $ERR=RRDs::error; if( $ERR ) { $result->{'success'} = 0; $result->{'error'} = 'RRD::graphv returned error: ' . $ERR; return undef; } my $data = {}; my $i = 0; foreach my $entry ( @prints ) { my $key = 'print[' . $i . ']'; my $val = $r->{$key}; if( not defined($val) ) { $val = 'NaN'; } $data->{$entry->{'name'}} = $val; $i++; } $result->{'data'}{$token} = $data; return; } sub rpc_timeseries { my $self = shift; my $config_tree = shift; my $opts = shift; my $token = $opts->{'token'}; my $view = $opts->{'view'}; my $params = $opts->{'params'}; my $result = $opts->{'result'}; if( not $config_tree->isLeaf($token) ) { $result->{'success'} = 0; $result->{'error'} = 'TIMESERIES supports only leaf nodes'; return; } my @args; foreach my $opt ('step', 'maxrows') { my $value = $self->{'options'}->{'variables'}->{'G' . $opt}; if( defined($value) ) { push(@args, '--' . $opt, $value); } } my $dataonly = $self->{'options'}{'variables'}{'DATAONLY'} ? 1:0; my ($rrgraph_args, $obj) = $self->prepare_rrgraph_args($config_tree, $token, 'embedded', {'data_only' => $dataonly}); Debug('rrgraph_args: ' . join(' ', @{$rrgraph_args})); my @xport_names; my $labels = []; my $title = ''; my $vertical_label = ''; for(my $i=0; $i < scalar(@{$rrgraph_args}); $i++) { my $val = $rrgraph_args->[$i]; if( ($val eq '--start') or ($val eq '--end') ) { $i++; push(@args, $val, $rrgraph_args->[$i]); } elsif( $val =~ /^C?DEF/o ) { push(@args, $val); } elsif( $val =~ /^LINE\d*:([a-zA-Z_][a-zA-Z0-9_]*)/o or $val =~ /^AREA:([a-zA-Z_][a-zA-Z0-9_]*)/o ) { push(@xport_names, $1); if( $val =~ /:([^:\\]+)\\l/o ) { push(@{$labels}, $1); } else { push(@{$labels}, ''); } } elsif( $val eq '--title' ) { $i++; $title = $rrgraph_args->[$i]; } elsif( $val eq '--vertical-label' ) { $i++; $vertical_label = $rrgraph_args->[$i]; } } foreach my $name ( @xport_names ) { push(@args, 'XPORT:' . $name . ':' . $name); } Debug('RRDs::xport arguments: ' . join(' ', @args)); my @xport_ret = RRDs::xport(@args); my $ERR=RRDs::error; if( $ERR ) { $result->{'success'} = 0; $result->{'error'} = 'RRD::xport returned error: ' . $ERR; return undef; } my $r = $result->{'data'}; foreach my $ret_name ('start', 'end', 'step', 'cols', 'names', 'data') { $r->{$ret_name} = shift @xport_ret; } if( not $dataonly ) { # remove --start and --end from rrgraph_args my $i = 0; while( $i < scalar(@{$rrgraph_args}) ) { my $val = $rrgraph_args->[$i]; if( ($val eq '--start') or ($val eq '--end') ) { splice(@{$rrgraph_args}, $i, 2); } else { $i++; } } $r->{'rrgraph_args'} = $rrgraph_args; } $r->{'title'} = $title; $r->{'vertical_label'} = $vertical_label; $r->{'labels'} = $labels; # convert numbers to strings, undefs to NaN, andinfinities to # Infinity and -Infinity for( my $i=0; $i < scalar(@{$r->{'data'}}); $i++ ) { for( my $j=0; $j < scalar(@{$r->{'data'}[$i]}); $j++ ) { my $val = $r->{'data'}[$i][$j]; if( not defined($val) ) { $val = 'NaN'; } else { $val = Math::BigFloat->new($val); if( $val->is_nan() ) { $val = 'NaN'; } elsif( $val->is_inf('+') ) { $val = 'Infinity'; } elsif( $val->is_inf('-') ) { $val = '-Infinity'; } else { $val = $val->bstr(); } } $r->{'data'}[$i][$j] = $val; } } return; } sub rpc_search_nodeid { my $self = shift; my $config_tree = shift; my $opts = shift; my $params = $opts->{'params'}; my $result = $opts->{'result'}; my $search_prefix = $self->{'options'}{'variables'}{'PREFIX'}; if( not defined $search_prefix ) { $result->{'success'} = 0; $result->{'error'} = 'Missing the search prefix in PREFIX'; return; } my $search_results = $config_tree->searchNodeidPrefix($search_prefix); if( not defined($search_results) or scalar(@{$search_results}) == 0 ) { $result->{'data'} = {}; return; } if( scalar(@{$search_results}) > $result_limit ) { $result->{'success'} = 0; $result->{'error'} = 'Result is too big. Aborting the RPC call'; return; } # results are pairs [nodeid,token] foreach my $res ( @{$search_results} ) { my $token = $res->[1]; if( $config_tree->isLeaf($token) ) { my $data = {'path' => $config_tree->path($token)}; foreach my $p (@{$params}) { my $val = $config_tree->getNodeParam($token, $p); if( defined($val) ) { $data->{$p} = $val; } } $result->{'data'}{$token} = $data; } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/Renderer/RRDtool.pm0000644000175000017500000011021312661116101016274 00000000000000# Copyright (C) 2002-2011 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. # Stanislav Sinyagin package Torrus::Renderer::RRDtool; use strict; use warnings; use Torrus::ConfigTree; use Torrus::RPN; use Torrus::Log; use RRDs; use IO::File; # All our methods are imported by Torrus::Renderer; my %rrd_graph_opts = ( 'start' => '--start', 'end' => '--end', 'width' => '--width', 'height' => '--height', 'imgformat' => '--imgformat', 'border' => '--border', ); my %mime_type = ('PNG' => 'image/png', 'SVG' => 'image/svg+xml', 'EPS' => 'application/postscript', 'PDF' => 'application/pdf'); my @arg_arrays = qw(opts defs bg hwtick hwline line hrule fg); sub prepare_rrgraph_args { my $self = shift; my $config_tree = shift; my $token = shift; my $view = shift; my $opt = shift; $opt = {} unless defined($opt); 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, $obj ) ); 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 $showmax = 0; my $max_dname = $obj->{'dname'} . '_Max'; 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' ) { my $defstring = $self->rrd_make_def( $config_tree, $token, $obj->{'dname'} ); return(undef) unless defined($defstring); push( @{$obj->{'args'}{'defs'}}, $defstring ); if( $self->rrd_check_hw( $config_tree, $token, $view ) ) { $self->rrd_make_holtwinters( $config_tree, $token, $view, $obj ); } else { if( $self->rrd_if_showmax($config_tree, $token, $view) ) { my $step = $self->rrd_maxline_step( $config_tree, $view ); my $maxdef = $self->rrd_make_def( $config_tree, $token, $max_dname, 'MAX', {'step' => $step}); push( @{$obj->{'args'}{'defs'}}, $maxdef ); $showmax = 1; } } } 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) ); if( $self->rrd_if_showmax($config_tree, $token, $view) ) { my $step = $self->rrd_maxline_step( $config_tree, $view ); push( @{$obj->{'args'}{'defs'}}, $self->rrd_make_cdef( $config_tree, $token, $max_dname, $expr, {'force_function' => 'MAX', 'step' => $step} ) ); $showmax = 1; } } else { Error("Unsupported leaf-type: $leaftype"); return undef; } $self->rrd_make_graphline( $config_tree, $token, $view, $obj ); if( $showmax ) { $self->rrd_make_maxline( $max_dname, $config_tree, $token, $view, $obj ); } } return(undef) if $obj->{'error'}; if( not $opt->{'data_only'} ) { $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}} ); } return ($args, $obj); } 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 ($args, $obj) = $self->prepare_rrgraph_args($config_tree, $token, $view); Debug("RRDs::graph arguments: " . join(' ', @{$args})); # localize the TZ enviromennt for the child process { my $tz = $self->{'options'}->{'variables'}->{'TZ'}; if( not defined($tz) ) { $tz = $ENV{'TZ'}; } local $ENV{'TZ'}; if( defined($tz) ) { $ENV{'TZ'} = $tz; } &RRDs::graph( $outfile, @{$args} ); } my $ERR=RRDs::error; if( $ERR ) { my $path = $config_tree->path($token); Error("$path $view: Error during RRD graph: $ERR"); return undef; } my $mimetype = $obj->{'mimetype'}; if( not defined($mimetype) ) { $mimetype = 'image/png'; } return( $config_tree->getParam($view, 'expires')+time(), $mimetype ); } 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' ) { my $defstring = $self->rrd_make_def( $config_tree, $token, $dname ); return(undef) unless defined($defstring); push( @arg_defs, $defstring ); } 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; # localize the TZ enviromennt for the child process { my $tz = $self->{'options'}->{'variables'}->{'TZ'}; if( not defined($tz) ) { $tz = $ENV{'TZ'}; } local $ENV{'TZ'}; if( defined($tz) ) { $ENV{'TZ'} = $tz; } ($printout, undef, undef) = RRDs::graph('/dev/null', @args); } my $ERR=RRDs::error; if( $ERR ) { my $path = $config_tree->path($token); Error("$path $view: Error during RRD graph: $ERR"); return undef; } my $fh = IO::File->new($outfile, 'w'); if( not defined($fh) ) { Error("Cannot open $outfile for writing: $!"); return undef; } else { $fh->printf("%s\n", join(':', @{$printout})); $fh->close(); } 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]; my $showmax = $self->rrd_if_showmax($config_tree, $token, $view); # 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 = ''; my $ds_expr; if( $dograph or $gprint_this ) { $ds_expr = $config_tree->getNodeParam($token, 'ds-expr-'.$dname); my @cdefs = $self->rrd_make_cdef($config_tree, $token, $dname, $ds_expr); if( not scalar(@cdefs) ) { $obj->{'error'} = 1; next; } push( @{$obj->{'args'}{'defs'}}, @cdefs ); $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 = ''; } if( $showmax and ($stack eq '') ) { my $max_dname = $dname . '_Max'; my $p_maxlinestyle = $config_tree->getNodeParam($token, 'maxline-style-'.$dname); my $p_maxlinecolor = $config_tree->getNodeParam($token, 'maxline-color-'.$dname); my $step = $self->rrd_maxline_step( $config_tree, $view ); if( defined($p_maxlinestyle) and defined($p_maxlinecolor) ) { my @cdefs = $self->rrd_make_cdef($config_tree, $token, $max_dname, $ds_expr, {'force_function' => 'MAX', 'step' => $step}); if( not scalar(@cdefs) ) { $obj->{'error'} = 1; next; } push( @{$obj->{'args'}{'defs'}}, @cdefs ); my $max_linestyle = $self->mkline( $p_maxlinestyle ); my $max_linecolor = $self->mkcolor( $p_maxlinecolor ); if( defined( $alpha ) ) { $max_linecolor .= $alpha; } push( @{$obj->{'args'}{'line'}}, sprintf( '%s:%s%s', $max_linestyle, $max_dname, $max_linecolor ) ); } } push( @{$obj->{'args'}{'line'}}, sprintf( '%s:%s%s%s%s', $linestyle, $dname, $linecolor, ($legend ne '') ? ':'.$legend.'\l' : ':\l', $stack ) ); } } return; } # 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'}; my $defstring = $self->rrd_make_def( $config_tree, $token, $dname . 'pred', 'HWPREDICT' ); return() unless defined($defstring); push( @{$obj->{'args'}{'defs'}}, $defstring ); $defstring = $self->rrd_make_def( $config_tree, $token, $dname . 'dev', 'DEVPREDICT' ); return() unless defined($defstring); push( @{$obj->{'args'}{'defs'}}, $defstring ); # 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 $defstring = $self->rrd_make_def( $config_tree, $token, $dname . 'fail', 'FAILURES' ); return() unless defined($defstring); push( @{$obj->{'args'}{'defs'}}, $defstring ); # 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':'') ); return; } 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) ) { $styleval = $config_tree->getParam($view, 'line-style'); } my $linestyle = $self->mkline( $styleval ); my $colorval = $config_tree->getNodeParam($token, 'line-color'); if( not defined($colorval) ) { $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, ($legend ne '') ? ':'.$legend.'\l' : '' ) ); if( $legend eq '' ) { push( @{$obj->{'args'}{'line'}}, 'COMMENT:\l' ); } return; } sub rrd_make_maxline { my $self = shift; my $max_dname = 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 = 'Max'; } else { $legend = 'Max ' . $legend; } my $styleval = $config_tree->getNodeParam($token, 'maxline-style'); if( not defined($styleval) ) { $styleval = $config_tree->getParam($view, 'maxline-style'); } my $linestyle = $self->mkline( $styleval ); my $colorval = $config_tree->getNodeParam($token, 'maxline-color'); if( not defined($colorval) ) { $colorval = $config_tree->getParam($view, 'maxline-color'); } my $linecolor = $self->mkcolor( $colorval ); if( $self->rrd_if_gprint( $config_tree, $token ) ) { $self->rrd_make_gprint( $max_dname, $legend, $config_tree, $token, $view, $obj ); } push( @{$obj->{'args'}{'line'}}, sprintf( '%s:%s%s%s', $linestyle, $max_dname, $linecolor, ($legend ne '') ? ':'.$legend.'\l' : ':\l' ) ); return; } # 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 $style = $config_tree->getParam($view, 'hrule-color-'.$hruleName); my $color = $self->mkcolor( $style ); my $line = $self->mkline( $style ); my $legend = $config_tree->getNodeParam($token, 'hrule-legend-'.$hruleName); my $arg = sprintf( '%s:%e%s::skipscale', $line, $value, $color ); if( defined( $legend ) and $legend =~ /\S/ ) { $arg .= ':' . $legend . '\l'; } push( @{$obj->{'args'}{'hrule'}}, $arg ); } } } return; } 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); my @cdefs = $self->rrd_make_cdef( $config_tree, $token, $decorName, $obj->{'dname'} . ',POP,' . $expr ); if( scalar(@cdefs) ) { push( @{$decor->{$order}{'def'}}, @cdefs ); $decor->{$order}{'line'} = sprintf( '%s:%s%s', $style, $decorName, $color ); } else { $obj->{'error'} = 1; } } 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'} ); } } return; } # 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 $obj = 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; } } elsif( $param eq 'imgformat' ) { if( not defined($mime_type{$value}) ) { Error('Unsupported value for imgformat: ' . $value); $value = 'PNG'; } if( defined($obj) ) { $obj->{'mimetype'} = $mime_type{$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; 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) ) { $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 ) ) { 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) ) { 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) ) { 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' ); } } # take colors from view and URL params my $colorval = $self->{'options'}->{'variables'}->{'Gcolors'}; if( not defined( $colorval ) ) { $colorval = $config_tree->getParam( $view, 'graph-colors' ); } if( defined( $colorval ) ) { my @values = split( /:/, $colorval ); if( (scalar(@values) % 2) != 0 ) { Error("Graph colors should be an even number of " . "elements separated by colon: " . $colorval); } else { while( scalar(@values) ) { my $tag = shift @values; my $color = shift @values; if( $tag !~ /^[A-Z]+$/o ) { Error("Invalid format for color tag in graph colors: " . $colorval); } elsif( $color !~ /^[0-9A-F]{6}([0-9A-F]{2})?$/io ) { Error("Invalid format for color value in graph colors: " . $colorval); } else { push( @args, '--color', $tag . '#' . $color ); } } } } 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 $opts = 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'); } my $def_options = ''; my $step = $config_tree->getNodeParam($token, 'graph-step'); if( defined($opts) and defined($opts->{'step'}) ) { $step = $opts->{'step'}; } if( defined($step) ) { $def_options .= ':step=' . $step; } return sprintf( 'DEF:%s=%s:%s:%s%s', $dname, $rrdfile, $ds, $cf, $def_options ); } 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 $opts = shift; my @args = (); my $ok = 1; my $step = $config_tree->getNodeParam($token, 'graph-step'); if( defined($opts) and defined($opts->{'step'}) ) { $step = $opts->{'step'}; } # 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( defined($opts) and defined($opts->{'force_function'}) ) { $function = $opts->{'force_function'}; } elsif( $noderef =~ s/^(.+)\@// ) { $function = $1; } my $cf; if( defined( $function ) and $cfNames{$function} ) { $cf = $function; } my $leaf = ($noderef ne '') ? $config_tree->getRelative($token, $noderef) : $token; my $varname = $dname . sprintf('%.2d', $ds_couter++); my $defstring = $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ); if( not defined($defstring) ) { $ok = 0; } else { if( defined($step) ) { $defstring .= ':step=' . $step; } push( @args, $defstring ); } return $varname; }; $expr = $rpn->translate( $expr, $callback ); return() unless $ok; 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; } # determine if MAX line should be drawn sub rrd_if_showmax { my $self = shift; my $config_tree = shift; my $token = shift; my $view = shift; my $disable = $config_tree->getNodeParam($token, 'graph-disable-maxline'); if( defined( $disable ) and $disable eq 'yes' ) { return 0; } if( $self->{'options'}->{'variables'}->{'Gmaxline'} ) { return 1; } my $enable = $config_tree->getParam($view, 'draw-maxline'); if( defined($enable) and $enable eq 'yes' ) { return 1; } return 0; } # determine the aggregation step for MAX line sub rrd_maxline_step { my $self = shift; my $config_tree = shift; my $view = shift; my $step = $config_tree->getParam($view, 'maxline-step'); if( not defined($step) ) { $step = 86400; } my $var = $self->{'options'}->{'variables'}->{'Gmaxlinestep'}; if( defined($var) ) { $step = $var; } return $step; } 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 ) ) { foreach my $gprintVal ( split(',', $gprintValues ) ) { my $format = $config_tree->getParam($view, 'gprint-format-' . $gprintVal); push( @args, 'GPRINT:' . $vname . ':' . $format ); } } push( @{$obj->{'args'}{'line'}}, @args ); return; } 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 ) ) { my $gprintHeader = $config_tree->getParam($view, 'gprint-header'); if( defined( $gprintHeader ) ) { push( @{$obj->{'args'}{'line'}}, 'COMMENT:' . $gprintHeader . '\l' ); } } return; } sub mkcolor { my $self = shift; my $color = shift; my $alpha; my $recursionLimit = 10; 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'; } my $new_alpha = $Torrus::Renderer::graphStyles{$colorName}{'alpha'}; if( defined($new_alpha) ) { $alpha = $new_alpha; } } } $alpha = '' unless defined($alpha); return ($color . $alpha); } 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; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/Renderer/AdmInfo.pm0000644000175000017500000001732212661116101016273 00000000000000# 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. # Stanislav Sinyagin package Torrus::Renderer::AdmInfo; use strict; use warnings; use Torrus::ConfigTree; use Torrus::Log; use Torrus::ACL; use Template; use IO::File; 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 ) { if( not eval('require ' . $mod) or $@ ) { die( $@ ); } if( not eval('&' . $mod . '::initAdmInfo( \%leaf_params, \%param_categories ); 1;') or $@ ) { die($@); } } # 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 { my $fh = IO::File->new($outfile, 'w'); if( not defined($fh) ) { Error("Cannot open $outfile for writing: $!"); return undef; } else { $fh->print("Cannot display admin information\n"); $fh->close(); } return (300+time(), 'text/plain'); } return; } 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: torrus-2.09/perllib/Torrus/ConfigTree/0000755000175000017500000000000012661116101014752 500000000000000torrus-2.09/perllib/Torrus/ConfigTree/Validator.pm0000644000175000017500000010043412661116101017157 00000000000000# 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. # Stanislav Sinyagin package Torrus::ConfigTree::Validator; use strict; use warnings; use Torrus::ConfigTree; use Torrus::Log; use Torrus::RPN; use Torrus::SiteConfig; 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, 'rpc' => undef} ); # Load additional validation, configurable from # torrus-config.pl and torrus-siteconfig.pl foreach my $mod ( @Torrus::Validator::loadLeafValidators ) { if( not eval('require ' . $mod) or $@ ) { die($@); } if( not eval('&' . $mod . '::initValidatorLeafParams(\%leaf_params); 1;') or $@ ) { die($@); } } 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', 'escalate', 'clear', 'clear_escalation', 'forget') { if( $when eq $event ) { $matched = 1; } } if( not $matched ) { Error("Invalid value in parameter launch-when " . "in action $action: $when"); $ok = 0; } } } my $setenv_dataexpr = $config_tree->getParam( $action, 'setenv-dataexpr' ); if( defined( $setenv_dataexpr ) ) { # foreach my $pair ( split( ',', $setenv_dataexpr ) ) { my ($env, $param) = split( '=', $pair ); if( not $param ) { Error("Syntax error in setenv-dataexpr in action " . $action . ": \"" . $pair . "\""); $ok = 0; } elsif( $env =~ /\W/o ) { Error("Illegal characters in environment variable ". "name in setenv-dataexpr in action " . $action . ": \"" . $env . "\""); $ok = 0; } elsif( not defined ($config_tree->getParam( $action, $param ) ) ) { Error("Parameter referenced in setenv-dataexpr is " . "not defined in action " . $action . ": " . $param); $ok = 0; } } } } } foreach my $monitor ($config_tree->getMonitorNames()) { $ok = validateInstanceParams($config_tree, $monitor, 'monitor', \%monitor_params) ? $ok:0; my $alist = $config_tree->getParam( $monitor, 'action' ); foreach my $action ( split(',', $alist ) ) { if( not $config_tree->actionExists( $action ) ) { Error("Non-existent action: $action in monitor $monitor"); $ok = 0; } } my $esc = $config_tree->getParam($monitor, 'escalations'); if( defined($esc) ) { my @escalation_times = split(',', $esc); if( scalar(@escalation_times) == 0 ) { Error("\"escalations\" is empty in $monitor"); $ok = 0; } foreach my $esc_time (@escalation_times) { if( $esc_time !~ /^\d+$/ or $esc_time == 0 ) { Error("$esc_time is not a positive integer in " . "\"escalations\" in $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: torrus-2.09/perllib/Torrus/ConfigTree/XMLCompiler.pm0000644000175000017500000003234312661116101017370 00000000000000# 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. # Stanislav Sinyagin package Torrus::ConfigTree::XMLCompiler; use strict; use warnings; use base 'Torrus::ConfigTree::Writer'; use Torrus::ConfigTree; use Torrus::ConfigTree::Validator; use Torrus::SiteConfig; use Torrus::Log; use Torrus::TimeStamp; use XML::LibXML; 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; if( not eval {$doc = $parser->parse_file($filename)} or $@ ) { Error("Failed to parse $filename: $@"); return 0; } my $root = $doc->documentElement(); # Initialize the '/' element $self->initRoot(); # First of all process all pre-required files foreach my $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 my $node ( $root->getElementsByTagName('param-properties') ) { $ok = $self->compile_paramprops( $node ) ? $ok:0; } if( not $self->{'-NoDSRebuild'} ) { foreach my $node ( $root->getElementsByTagName('definitions') ) { $ok = $self->compile_definitions( $node ) ? $ok:0; } foreach my $node ( $root->getElementsByTagName('datasources') ) { $ok = $self->compile_ds( $node ) ? $ok:0; } } foreach my $node ( $root->getElementsByTagName('monitors') ) { $ok = $self->compile_monitors( $node ) ? $ok:0; } foreach my $node ( $root->getElementsByTagName('token-sets') ) { $ok = $self->compile_tokensets( $node ) ? $ok:0; } foreach my $node ( $root->getElementsByTagName('views') ) { $ok = $self->compile_views( $node ) ? $ok:0; } return $ok; } sub compile_definitions { my $self = shift; my $node = shift; my $ok = 1; foreach my $def ( $node->getChildrenByTagName('def') ) { &Torrus::DB::checkInterrupted(); my $name = $def->getAttribute('name'); my $value = $def->getAttribute('value'); if( not $name ) { Error("Definition without a name"); $ok = 0; } elsif( not $value ) { Error("Definition without value: $name"); $ok = 0; } elsif( defined $self->getDefinition($name) ) { Error("Duplicate definition: $name"); $ok = 0; } else { $self->addDefinition($name, $value); } } return $ok; } sub compile_paramprops { my $self = shift; my $node = shift; my $ok = 1; foreach my $def ( $node->getChildrenByTagName('prop') ) { &Torrus::DB::checkInterrupted(); my $param = $def->getAttribute('param'); my $prop = $def->getAttribute('prop'); my $value = $def->getAttribute('value'); if( not $param or not $prop or not defined($value) ) { Error("Property definition error"); $ok = 0; } else { $self->setParamProperty($param, $prop, $value); } } return $ok; } # Process and put them into DB. # Usage: $self->compile_params($node, $name); sub compile_params { my $self = shift; my $node = shift; my $name = shift; my $isDS = shift; &Torrus::DB::checkInterrupted(); my $ok = 1; foreach my $p_node ( $node->getChildrenByTagName('param') ) { my $param = $p_node->getAttribute('name'); my $value = $p_node->getAttribute('value'); if( not defined($value) ) { $value = $p_node->textContent(); } if( not $param ) { Error("Parameter without name in $name"); $ok = 0; } else { # Remove spaces in the head and tail. $value =~ s/^\s+//om; $value =~ s/\s+$//om; if( $isDS ) { $self->setNodeParam($name, $param, $value); } else { $self->setParam($name, $param, $value); } } } return $ok; } sub compile_ds { my $self = shift; my $ds_node = shift; my $ok = 1; # First, process templates. We expect them to be direct children of # foreach my $template ( $ds_node->getChildrenByTagName('template') ) { my $name = $template->getAttribute('name'); if( not $name ) { Error("Template without a name"); $ok = 0; } elsif( defined $self->{'Templates'}->{$name} ) { Error("Duplicate template names: $name"); $ok = 0; } else { $self->{'Templates'}->{$name} = $template; } } # Recursively traverse the tree $ok = $self->compile_subtrees( $ds_node, $self->token('/') ) ? $ok:0; return $ok; } sub validate_nodename { my $self = shift; my $name = shift; return ( $name =~ /^[0-9A-Za-z_\-\.\:]+$/o and $name !~ /\.\./o ); } sub compile_subtrees { my $self = shift; my $node = shift; my $token = shift; my $iamLeaf = shift; my $ok = 1; # setting of compile-time variables 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 ); } } # 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; } # applying 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 { $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; $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: torrus-2.09/perllib/Torrus/ConfigTree/Writer.pm0000644000175000017500000005360512661116101016515 00000000000000# 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. # Stanislav Sinyagin # # Write access for ConfigTree # package Torrus::ConfigTree::Writer; use strict; use warnings; use base 'Torrus::ConfigTree'; use Torrus::Log; use Torrus::TimeStamp; use Torrus::SiteConfig; use Torrus::ServiceID; use Digest::MD5 qw(md5); # needed as hash function use POSIX; # we use ceil() from here 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); return; } 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); return; } 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 ); return; } 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; $self->setNodeParam($token, 'tree-name', $self->treeName()); } return; } 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; } return; } sub addMonitor { my $self = shift; my $mname = shift; $self->{'db_otherconfig'}->addToList('M:', $mname); return; } sub addAction { my $self = shift; my $aname = shift; $self->{'db_otherconfig'}->addToList('A:', $aname); return; } sub addDefinition { my $self = shift; my $name = shift; my $value = shift; $self->{'db_dsconfig'}->put( 'd:'.$name, $value ); $self->{'db_dsconfig'}->addToList('D:', $name); return; } sub setVar { my $self = shift; my $token = shift; my $name = shift; my $value = shift; $self->{'setvar'}{$token}{$name} = $value; return; } 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(); } return; } 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 = ceil(($max-$min)/$step); $newOffset = $min + $step * ( unpack('N', md5($hashString)) % $bucketSize ) + $instance * ceil($step/$nInstances); } } } else { $newOffset += $instance * ceil($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; return; } 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: torrus-2.09/perllib/Torrus/Collector.pm0000644000175000017500000003746212661116101015145 00000000000000# Copyright (C) 2002-2011 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. # Stanislav Sinyagin package Torrus::Collector; use strict; use warnings; use base 'Torrus::Scheduler::PeriodicTask'; use Torrus::ConfigTree; use Torrus::Log; use Torrus::RPN; BEGIN { foreach my $mod ( @Torrus::Collector::loadModules ) { if( not eval('require ' . $mod) or $@ ) { die($@); } } } # 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}}(); } } return; } our %collectorTypes; ## 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"; } # Repeat so many cycles immediately at start if( $Torrus::Collector::fastCycles > 0 ) { $options{'-FastCycles'} = $Torrus::Collector::fastCycles; } my $class = ref($proto) || $proto; my $self = $class->SUPER::new( %options ); bless $self, $class; $self->{'types_sorted'} = []; foreach my $collector_type ( sort {$collectorTypes{$a} <=> $collectorTypes{$b}} keys %collectorTypes ) { $self->{'types'}{$collector_type} = {}; $self->{'types_in_use'}{$collector_type} = 0; push(@{$self->{'types_sorted'}}, $collector_type); } 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 $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} ) ) { $ok = &{$Torrus::Collector::initTarget{ $storage_string}}($self, $token) ? $ok:0; } } } if( not $ok ) { $self->deleteTarget( $token ); } return; } 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; } return; } 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; } } return; } sub param { my $self = shift; my $token = shift; my $param = shift; return $self->{'targets'}{$token}{'params'}{$param}; } # The following 3 methods get around undefined parameters and # make "use warnings" happy sub paramEnabled { my $self = shift; my $token = shift; my $param = shift; my $val = $self->param($token, $param); return (defined($val) and ($val eq 'yes')); } sub paramDisabled { my $self = shift; my $token = shift; my $param = shift; my $val = $self->param($token, $param); return (not defined($val) or ($val ne 'yes')); } sub paramString { my $self = shift; my $token = shift; my $param = shift; my $val = $self->param($token, $param); return (defined($val) ? $val:''); } sub setParam { my $self = shift; my $token = shift; my $param = shift; my $value = shift; $self->{'targets'}{$token}{'params'}{$param} = $value; return; } 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 ); return; } 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}; return; } # 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; foreach my $collector_type ( @{$self->{'types_sorted'}} ) { 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, $self->collectorData($collector_type) ); if( defined( $self->{'config_tree'} ) ) { delete $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'} ) ) { delete $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'} ) ) { delete $self->{'config_tree'}; } } } return; } # 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 = eval($code); if( not defined($value) or $@ ) { 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 ); } return; } sub configTree { my $self = shift; if( defined( $self->{'config_tree'} ) ) { return $self->{'config_tree'}; } else { Error('Cannot provide ConfigTree object'); return undef; } } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/0000755000175000017500000000000012661116101015142 500000000000000torrus-2.09/perllib/Torrus/DevDiscover/UcdSnmp.pm0000644000175000017500000002106712661116101016777 00000000000000# 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. # Shawn Ferry # Ucd Snmp Discovery package Torrus::DevDiscover::UcdSnmp; use strict; use warnings; 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' ); # Not all interfaces are normally needed to monitor. # You may override the interface filtering in devdiscover-siteconfig.pl: # redefine $Torrus::DevDiscover::UcdSnmp::interfaceFilter # or define $Torrus::DevDiscover::UcdSnmp::interfaceFilterOverlay our $interfaceFilter; our $interfaceFilterOverlay; my %ucdInterfaceFilter; if( not defined( $interfaceFilter ) ) { $interfaceFilter = \%ucdInterfaceFilter; } # 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 %ucdInterfaceFilter = ( 'Loopback' => { 'ifType' => 24, # softwareLoopback }, ); 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; } &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, $interfaceFilter); if( defined( $interfaceFilterOverlay ) ) { &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, $interfaceFilterOverlay); } 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->paramString ('RFC2790_HOST_RESOURCES::sysperf-subtree-name'); if( $subtreeName eq '' ) { $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 ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/BetterNetworks.pm0000644000175000017500000001526612661116101020414 00000000000000# 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. # Marc Haber # Redesigned by Stanislav Sinyagin # Better Networks Ethernet Box package Torrus::DevDiscover::BetterNetworks; use strict; use warnings; 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', 'legend' => 'Temperature', }, 2 => { 'comment' => 'Brightness sensor', 'label' => 'Lux', 'legend' => 'Brightness', }, 3 => { 'comment' => 'Humidity sensor', 'label' => 'Percent RH', 'legend' => 'Humidity', }, 4 => { 'comment' => 'Switch contact', 'legend' => 'On/Off', }, 5 => { 'comment' => 'Voltage meter', 'legend' => 'Voltage', }, 6 => { 'comment' => 'Smoke sensor', 'legend' => 'Smoke indicator', }, ); 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, 'graph-title' => $name, 'precedence' => sprintf('%d', 1000 - $INDEX) }; if( defined( $sensorTypes{$type} ) ) { $param->{'comment'} = sprintf('%s: %s', $sensorTypes{$type}{'comment'}, $name); $param->{'graph-legend'} = $sensorTypes{$type}{'legend'}; 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(keys %{$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'] ); } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm0000644000175000017500000002015612661116101021017 00000000000000# 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. # Marc Haber # Redesigned by Stanislav Sinyagin # Allied Telesyn 18-Slot Media Converter Chassis package Torrus::DevDiscover::AlliedTelesyn_PBC18; use strict; use warnings; 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 $base = $dd->oiddef('ATMCCommon-MIB::mcModuleType'); my $table = $session->get_table( -baseoid => $base ); if( not defined( $table ) ) { return 0; } $devdetails->storeSnmpVars( $table ); foreach my $INDEX ( $devdetails->getSnmpIndices($base) ) { my $moduleType = $devdetails->snmpVar( $base . '.' . $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( defined($name) and $name ne '' ) { $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 $modParam = { 'pbc-module-index' => $INDEX }; if( defined( $data->{'PBC18'}{$INDEX}{'moduleDesc'} ) ) { $modParam->{'legend'} = 'Module type: ' . $data->{'PBC18'}{$INDEX}{'moduleDesc'}; } if( defined( $data->{'PBC18'}{$INDEX}{'moduleName'} ) ) { $modParam->{'comment'} = $data->{'PBC18'}{$INDEX}{'moduleName'}; } my $modNode = $cb->addSubtree( $devNode, 'Module_' . $INDEX, $modParam ); 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 $portParam = { 'rrd-ds' => 'Port' . $portName, 'snmp-object' => $data->{'PBC18'}{$INDEX}{'portAvailable'}{$portName}, }; $cb->addLeaf( $modNode, 'Port_' . $portName, $portParam ); $n++; } $cb->addLeaf( $modNode, 'AllPorts', $mgParam ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/CiscoCatOS.pm0000644000175000017500000001244612661116101017361 00000000000000# 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. # Stanislav Sinyagin # Cisco CatOS devices discovery # To do: # Power supply and temperature monitoring # RAM monitoring package Torrus::DevDiscover::CiscoCatOS; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'CiscoCatOS'} = { 'sequence' => 510, '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->paramEnabled('CiscoCatOS::suppress-noname-ports') ) { my $nExcluded = 0; foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) { my $interface = $data->{'interfaces'}{$ifIndex}; if( not defined($interface->{'portName'}) or $interface->{'portName'} eq '' ) { $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; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Fortinet.pm0000644000175000017500000001613512661116101017220 00000000000000# Copyright (C) 2014 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. # Fortinet products package Torrus::DevDiscover::Fortinet; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'Fortinet'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # FORTINET-FORTIGATE-MIB 'fgModel' => '1.3.6.1.4.1.12356.101.1', 'fgVdEntName' => '1.3.6.1.4.1.12356.101.3.2.1.1.2', # FORTINET-FORTIMANAGER-FORTIANALYZER-MIB 'fmModel' => '1.3.6.1.4.1.12356.103.1', 'faModel' => '1.3.6.1.4.1.12356.103.3', # FORTINET-FORTIGATE-MIB 'fgSysDiskCapacity' => '1.3.6.1.4.1.12356.101.4.1.7.0', 'fgProcessorCount' => '1.3.6.1.4.1.12356.101.4.4.1.0', # FORTINET-FORTIMANAGER-FORTIANALYZER-MIB 'fmSysMemCapacity' => '1.3.6.1.4.1.12356.103.2.1.3.0', 'fmSysDiskCapacity' => '1.3.6.1.4.1.12356.103.2.1.5.0', ); our $fortigateInterfaceFilter; our $fortigateInterfaceFilterOverlay; if( not defined( $fortigateInterfaceFilter ) ) { $fortigateInterfaceFilter = { 'SSLRoot' => { 'ifType' => 131, # tunnel 'ifDescr' => '^ssl.root', }, 'MGMT' => { 'ifType' => 6, # ethernetCsmacd 'ifDescr' => '^mgmt', }, 'Modem' => { 'ifType' => 6, # ethernetCsmacd 'ifDescr' => '^modem', }, }; } sub checkdevtype { my $dd = shift; my $devdetails = shift; my $objID = $devdetails->snmpVar($dd->oiddef('sysObjectID')); if( $dd->oidBaseMatch('fgModel', $objID) ) { $devdetails->setCap('Fortinet_FG'); &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, $fortigateInterfaceFilter); if( defined( $fortigateInterfaceFilterOverlay ) ) { &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, $fortigateInterfaceFilterOverlay); } return 1; } elsif( $dd->oidBaseMatch('fmModel', $objID) ) { $devdetails->setCap('Fortinet_FM'); $devdetails->setCap('interfaceIndexingPersistent'); return 1; } elsif( $dd->oidBaseMatch('faModel', $objID) ) { $devdetails->setCap('Fortinet_FA'); $devdetails->setCap('interfaceIndexingPersistent'); return 1; } return 0; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); if( $devdetails->hasCap('Fortinet_FG') ) { my $result = $dd->retrieveSnmpOIDs('fgSysDiskCapacity', 'fgProcessorCount'); if( defined $result ) { $data->{'Fortigate'}{'disk'} = $result->{'fgSysDiskCapacity'}; if( $result->{'fgProcessorCount'} > 1 ) { $data->{'Fortigate'}{'cpucount'} = $result->{'fgProcessorCount'}; } } my $vdNames = $dd->walkSnmpTable('fgVdEntName'); if( defined($vdNames) and scalar(keys %{$vdNames}) > 0 ) { $data->{'Fortigate'}{'vdom'} = $vdNames; } } elsif( $devdetails->hasCap('Fortinet_FM') ) { my $result = $dd->retrieveSnmpOIDs('fmSysMemCapacity', 'fmSysDiskCapacity'); if( defined $result ) { $data->{'Fortimanager'}{'mem'} = $result->{'fmSysMemCapacity'}; $data->{'Fortimanager'}{'disk'} = $result->{'fmSysDiskCapacity'}; } } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); if( $devdetails->hasCap('Fortinet_FG') ) { my $param = { 'fortigate-disk-capacity' => 0+$data->{'Fortigate'}{'disk'}, }; $cb->addSubtree( $devNode, 'System', $param, [ 'Fortinet::fortigate-system-stats' ] ); if( $devdetails->paramEnabled('Fortinet::per-cpu-stats') and $data->{'Fortigate'}{'cpucount'} ) { my $node = $cb->addSubtree( $devNode, 'Per_CPU_Stats', {'node-display-name' => 'Per-CPU Stats'}); my $count = $data->{'Fortigate'}{'cpucount'}; for( my $i=1; $i <= $count; $i++ ) { my $param = { 'fortigate-cpu-index' => $i, 'node-display-name' => 'CPU ' . $i, 'graph-legend' => 'CPU ' . $i . ' usage', 'precedence' => sprintf('%d', 1000 - $i), }; $cb->addLeaf( $node, 'CPU_' . $i, $param, [ 'Fortinet::fortigate-cpu' ] ); } } if( defined($data->{'Fortigate'}{'vdom'}) ) { my $vdNode = $cb->addSubtree( $devNode, 'Virtual_Domains', { 'node-display-name' => 'Virtual Domains' }, [ 'Fortinet::fortigate-vdoms-subtree' ] ); foreach my $INDEX (sort {$a <=> $b} keys %{$data->{'Fortigate'}{'vdom'}}) { my $name = $data->{'Fortigate'}{'vdom'}{$INDEX}; my $vdSubtree = $name; $vdSubtree =~ s/\W/_/g; my $vdParams = { 'node-display-name' => $name, 'fortigate-vdom-index' => $INDEX, 'fortigate-vdom-name' => $name, }; $cb->addSubtree( $vdNode, $vdSubtree, $vdParams, [ 'Fortinet::fortigate-vdom' ] ); } } } elsif( $devdetails->hasCap('Fortinet_FM') ) { my $param = { 'fortimanager-mem-capacity' => 0+$data->{'Fortimanager'}{'mem'}, 'fortimanager-disk-capacity' => 0+$data->{'Fortimanager'}{'disk'}, }; $cb->addSubtree( $devNode, 'System', $param, [ 'Fortinet::fortimanager-system-stats' ] ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/MotorolaBSR.pm0000644000175000017500000001517612661116101017575 00000000000000# # 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. # # Cisco SCE devices discovery package Torrus::DevDiscover::MotorolaBSR; use strict; use warnings; 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 $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; } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/CCOM.pm0000644000175000017500000000533712661116101016151 00000000000000# Copyright (C) 2011 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. # C-COM CAPSPAN devices # We only set the fixed ifIndex mapping package Torrus::DevDiscover::CCOM; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'CCOM'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( 'ccomProducts' => '1.3.6.1.4.1.3278.1', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'ccomProducts', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) { return 0; } $devdetails->setCap('interfaceIndexingPersistent'); $devdetails->setCap('disable_ifXTable'); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); # for some devices, ifDescr is poisoned with non-ASSCII characters. # clean that up to get some meaningful names foreach my $ifIndex ( keys %{$data->{'interfaces'}} ) { my $interface = $data->{'interfaces'}{$ifIndex}; next if $interface->{'excluded'}; my $descr = $interface->{'ifDescr'}; if( $descr =~ /^0x/ ) { $descr =~ s/^0x//; $descr = pack('H*', $descr); $descr =~ /^([0-9a-zA-Z \/]+)/ and $descr = $1; } $interface->{'CCOM-ifDescr'} = $descr; $descr =~ s/\W/_/g; $interface->{'CCOM-ifDescrT'} = $descr; } $data->{'nameref'}{'ifSubtreeName'} = 'CCOM-ifDescrT'; $data->{'nameref'}{'ifReferenceName'} = 'CCOM-ifDescr'; $data->{'nameref'}{'ifNick'} = 'ifIndex'; $data->{'nameref'}{'ifNodeid'} = 'ifIndex'; $data->{'param'}{'snmp-oids-per-pdu'} = 10; return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Patton.pm0000644000175000017500000000354312661116101016672 00000000000000# Copyright (C) 2011 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. # Patton devices # Only interface indexing and naming is handled here. package Torrus::DevDiscover::Patton; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'Patton'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( 'patton_products' => '1.3.6.1.4.1.1768.100', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'patton_products', $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->{'param'}{'snmp-oids-per-pdu'} = 10; return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/JunOS.pm0000644000175000017500000005254112661116101016425 00000000000000# # 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. # Jon Nistor # 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 warnings; 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( not defined($data->{'param'}{'comment'}) ) { if( defined( $chassisSerial ) ) { $data->{'param'}{'comment'} = $chassisSerial->{'jnxBoxDescr'} . ', Hw Serial#: ' . $chassisSerial->{'jnxBoxSerialNo'}; } else { $data->{'param'}{'comment'} = "Juniper router"; } } # PROG: Class of Service # if( $devdetails->paramDisabled('JunOS::disable-cos') ) { # Poll table to translate the CoS Index to a Name my $jnxCosFcIdToFcName = $dd->walkSnmpTable('jnxCosFcIdToFcName'); if( scalar(keys %{$jnxCosFcIdToFcName}) ) { $devdetails->setCap('jnxCoS'); $data->{'jnxCos'}{'queue'} = $jnxCosFcIdToFcName; # We need to find out all the interfaces that have CoS enabled # on them. We will use jnxCosQstatQedPkts as our reference point. my $jnxCosQstatQedPkts = $dd->walkSnmpTable('jnxCosQstatQedPkts'); foreach my $INDEX ( keys %{$jnxCosQstatQedPkts} ) { my( $ifIndex, $cosQueueIndex ) = split( '\.', $INDEX ); $data->{'jnxCos'}{'ifIndex'}{$ifIndex} = 1; } } } # END JunOS::disable-cos # PROG: Grab and store description of parts # if( $devdetails->paramDisabled('JunOS::disable-operating') ) { my $jnxOperatingDescr = $dd->walkSnmpTable('jnxOperatingDescr'); if ( scalar(keys %{$jnxOperatingDescr}) ) { # PROG: Set Capability flag $devdetails->setCap('jnxOperating'); # PROG: Poll tables for more info to match and index on my $jnxOperatingCPU = $dd->walkSnmpTable('jnxOperatingCPU'); my $jnxOperatingISR = $dd->walkSnmpTable('jnxOperatingISR'); my $jnxOperatingMemory = $dd->walkSnmpTable('jnxOperatingMemory'); my $jnxOperatingTemp = $dd->walkSnmpTable('jnxOperatingTemp'); # PROG: Build tables for all the oids # We are using the Descr oid base for matching. (cheap hack) foreach my $opIndex ( keys %{$jnxOperatingDescr} ) { # Construct the data $data->{'jnxOperating'}{$opIndex}{'index'} = $opIndex; $data->{'jnxOperating'}{$opIndex}{'cpu'} = $jnxOperatingCPU->{$opIndex}; $data->{'jnxOperating'}{$opIndex}{'desc'} = $jnxOperatingDescr->{$opIndex}; $data->{'jnxOperating'}{$opIndex}{'isr'} = $jnxOperatingISR->{$opIndex}; $data->{'jnxOperating'}{$opIndex}{'mem'} = $jnxOperatingMemory->{$opIndex}; $data->{'jnxOperating'}{$opIndex}{'temp'} = $jnxOperatingTemp->{$opIndex}; } } # END: if $tableDesc } # END: JunOS::disable-operating # PROG: Firewall statistics if( $devdetails->paramDisabled('JunOS::disable-firewall') ) { my $jnxFWCounterDisplayFilterName = $dd->walkSnmpTable('jnxFWCounterDisplayFilterName'); if( scalar(keys %{$jnxFWCounterDisplayFilterName}) ) { # PROG: Set Capability flag $devdetails->setCap('jnxFirewall'); # PROG: Poll tables for more info to match and index on my $jnxFWCounterDisplayName = $dd->walkSnmpTable('jnxFWCounterDisplayName'); # Firewall Type (counter = 2, policer = 3) my $jnxFWCounterDisplayType = $dd->walkSnmpTable('jnxFWCounterDisplayType'); # PROG: Build tables for all the oids # We are using the FW Filter name as the Indexing foreach my $fwIndex ( keys %{$jnxFWCounterDisplayName} ) { my $fwFilter = $jnxFWCounterDisplayFilterName->{$fwIndex}; my $fwCounter = $jnxFWCounterDisplayName->{$fwIndex}; my $fwType = $jnxFWCounterDisplayType->{$fwIndex}; # 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->paramDisabled('JunOS::disable-rpf') ) { my $jnxRpfStatsPackets = $dd->walkSnmpTable('jnxRpfStatsPackets'); if( scalar(keys %{$jnxRpfStatsPackets}) ) { # PROG: Set capability flag $devdetails->setCap('jnxRPF'); # PROG: Find all the relevent interfaces foreach my $rpfIndex ( keys %{$jnxRpfStatsPackets} ) { my ($ifIndex,$addrFamily) = split('\.',$rpfIndex); my $interface = $data->{'interfaces'}{$ifIndex}; if( defined($interface) and not $interface->{'excluded'} ) { my $ifAddrFam = $addrFamily == 1 ? 'ipv4' : 'ipv6'; my $intName = $interface->{'ifName'}; my $intNameT = $interface->{'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') and scalar(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 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->paramDisabled('JunOS::disable-cos-tail') ) { $cb->addSubtree( $nodeIFCOS, "Tail_drop_stats", { 'comment' => 'Tail drop statistics' }, [ 'JunOS::junos-cos-tail' ]); } if( $devdetails->paramDisabled('JunOS::disable-cos-red') ) { $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 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 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 cmp $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; $jnxTag = 'main' if length($jnxTag) == 0; # 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, 'cpu-desc' => $jnxDesc }, [ '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, 'mem-desc' => $jnxDesc }, [ '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'}; # 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 return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm0000644000175000017500000000702212661116101020141 00000000000000# 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. # Stanislav Sinyagin # 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 warnings; 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(); return( $dd->checkSnmpTable('entPhysicalDescr') or $dd->checkSnmpTable('entPhysicalName') ); } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'entityPhysical'} = {}; my $chassisIndex = 0; my $entPhysicalDescr = $dd->walkSnmpTable('entPhysicalDescr'); my $entPhysicalContainedIn = $dd->walkSnmpTable('entPhysicalContainedIn'); my $entPhysicalName = $dd->walkSnmpTable('entPhysicalName'); foreach my $phyIndex ( sort {$a <=> $b} keys %{$entPhysicalDescr} ) { my $ref = {}; $data->{'entityPhysical'}{$phyIndex} = $ref; # Find the chassis. It is not contained in anything. if( not $chassisIndex ) { if( defined($entPhysicalContainedIn->{$phyIndex}) and $entPhysicalContainedIn->{$phyIndex} == 0 ) { $chassisIndex = $phyIndex; } } my $descr = $entPhysicalDescr->{$phyIndex}; if( defined($descr) and $descr ne '' ) { $ref->{'descr'} = $descr; } my $name = $entPhysicalName->{$phyIndex}; if( defined($name) and $name ne '' ) { $ref->{'name'} = $name; } } if( $chassisIndex > 0 ) { $data->{'entityChassisPhyIndex'} = $chassisIndex; my $chassisDescr = $data->{'entityPhysical'}{$chassisIndex}{'descr'}; if( defined($chassisDescr) and $chassisDescr ne '' 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; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/ATMEL.pm0000644000175000017500000001020112661116101016254 00000000000000# Copyright (C) 2004 Scott Brooks # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # Scott Brooks # ATMEL based access points/bridges package Torrus::DevDiscover::ATMEL; use strict; use warnings; 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 ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/AscendMax.pm0000644000175000017500000001345012661116101017266 00000000000000# 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. # Stanislav Sinyagin # Ascend (Lucent) MAX device discovery. # Tested with: # # MAX 4000, TAOS version 7.0.26 # NOTE: SNMP version 1 is only supported. Because of version 1 and numerous # WAN DS0 interfaces, the discovery process may take few minutes. package Torrus::DevDiscover::AscendMax; use strict; use warnings; 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']); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/CiscoWLC.pm0000644000175000017500000001033112661116101017024 00000000000000# # 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. # # Cisco wireless controller package Torrus::DevDiscover::CiscoWLC; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'CiscoWLC'} = { 'sequence' => 510, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # AIRESPACE-WIRELESS-MIB 'bsnDot11EssTable' => '1.3.6.1.4.1.14179.2.1.1', 'bsnDot11EssSsid' => '1.3.6.1.4.1.14179.2.1.1.1.2', 'bsnDot11EssInterfaceName' => '1.3.6.1.4.1.14179.2.1.1.1.42', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $devdetails->isDevType('CiscoGeneric') or not $dd->checkSnmpTable('bsnDot11EssTable') ) { return 0; } $devdetails->setCap('interfaceIndexingPersistent'); 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'; my $ssid_oid = $dd->oiddef('bsnDot11EssSsid'); my $prefixLen = length( $ssid_oid ) + 1; my $ssidTable = $session->get_table( -baseoid => $ssid_oid ); if( not defined( $ssidTable ) ) { return 1; } my $name_oid = $dd->oiddef('bsnDot11EssInterfaceName'); my $namesTable = $session->get_table( -baseoid => $name_oid ); if( not defined( $namesTable ) ) { return 1; } my $filter_ssid = 0; my %only_ssid; my $only_ssid_list = $devdetails->paramString('CiscoWLC::only-ssid'); if( $only_ssid_list ne '' ) { $filter_ssid = 1; foreach my $ssid (split(/\s*,\s*/, $only_ssid_list)) { $only_ssid{$ssid} = 1; } } while( my( $oid, $ssid ) = each %{$ssidTable} ) { if( $filter_ssid and not $only_ssid{$ssid} ) { next; } my $INDEX = substr( $oid, $prefixLen ); my $name = $namesTable->{$name_oid . '.' . $INDEX}; $data->{'CiscoWLC'}{$INDEX} = {'ssid' => $ssid, 'name' => $name}; } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); if( defined($data->{'CiscoWLC'}) and scalar(keys %{$data->{'CiscoWLC'}}) > 0 ) { my $nodeTop = $cb->addSubtree( $devNode, 'Wireless_Clients', undef, [ 'CiscoWLC::ciscowlc-clients-subtree'] ); foreach my $INDEX ( sort {$a <=> $b} keys %{$data->{'CiscoWLC'}} ) { my $ssid = $data->{'CiscoWLC'}{$INDEX}{'ssid'}; my $name = $data->{'CiscoWLC'}{$INDEX}{'name'}; my $leafName = $ssid; $leafName =~ s/\W/_/go; $leafName =~ s/_+/_/go; $cb->addLeaf( $nodeTop, $leafName, { 'node-display-name' => $ssid, 'ciscowlc-ssid' => $ssid, 'comment' => $name, 'ciscowlc-essindex' => $INDEX, 'precedence' => 200-$INDEX, }, [ 'CiscoWLC::ciscowlc-ess-leaf' ] ); } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Apple_AE.pm0000644000175000017500000001222412661116101017027 00000000000000# # 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. # Jon Nistor # Apple Airport Extreme Discovery Module # # NOTE: Options for this module: # Apple_AE::disable-clients package Torrus::DevDiscover::Apple_AE; use strict; use warnings; 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->paramDisabled('Apple_AE::disable-clients') ) { 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'); return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Jacarta.pm0000644000175000017500000001220012661116101016760 00000000000000# 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. # Sensor-MIBs of Jacarta iMeter-Products package Torrus::DevDiscover::Jacarta; use strict; use warnings; use Torrus::Log; $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'}] ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm0000644000175000017500000003044712661116101017774 00000000000000# 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. # Stanislav Sinyagin # 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 warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'RFC2662_ADSL_LINE'} = { 'sequence' => 100, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # ADSL-LINE-MIB 'adslAtucCurrSnrMgn' => '1.3.6.1.2.1.10.94.1.1.2.1.4', 'adslAtucCurrAtn' => '1.3.6.1.2.1.10.94.1.1.2.1.5', 'adslAtucCurrAttainableRate' => '1.3.6.1.2.1.10.94.1.1.2.1.8', 'adslAtucChanCurrTxRate' => '1.3.6.1.2.1.10.94.1.1.4.1.2', 'adslAturCurrSnrMgn' => '1.3.6.1.2.1.10.94.1.1.3.1.4', 'adslAturCurrAtn' => '1.3.6.1.2.1.10.94.1.1.3.1.5', 'adslAturCurrAttainableRate' => '1.3.6.1.2.1.10.94.1.1.3.1.8', 'adslAturChanCurrTxRate' => '1.3.6.1.2.1.10.94.1.1.5.1.2', 'adslAtucPerfCurr1DayLofs' => '1.3.6.1.2.1.10.94.1.1.6.1.17', 'adslAtucPerfCurr1DayLoss' => '1.3.6.1.2.1.10.94.1.1.6.1.18', 'adslAtucPerfCurr1DayLprs' => '1.3.6.1.2.1.10.94.1.1.6.1.20', 'adslAtucPerfCurr1DayESs' => '1.3.6.1.2.1.10.94.1.1.6.1.21', 'adslAtucPerfCurr1DayInits' => '1.3.6.1.2.1.10.94.1.1.6.1.22', 'adslAturPerfCurr1DayLofs' => '1.3.6.1.2.1.10.94.1.1.7.1.13', 'adslAturPerfCurr1DayLoss' => '1.3.6.1.2.1.10.94.1.1.7.1.14', 'adslAturPerfCurr1DayLprs' => '1.3.6.1.2.1.10.94.1.1.7.1.15', 'adslAturPerfCurr1DayESs' => '1.3.6.1.2.1.10.94.1.1.7.1.16', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); if( not $dd->checkSnmpTable('adslAtucCurrSnrMgn') ) { return 0; } return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'AdslLine'} = {}; foreach my $oidname ( 'adslAtucCurrSnrMgn', 'adslAtucCurrAtn', 'adslAtucCurrAttainableRate', 'adslAtucChanCurrTxRate', 'adslAturCurrSnrMgn', 'adslAturCurrAtn', 'adslAturCurrAttainableRate', 'adslAturChanCurrTxRate', 'adslAtucPerfCurr1DayLofs', 'adslAtucPerfCurr1DayLoss', 'adslAtucPerfCurr1DayLprs', 'adslAtucPerfCurr1DayESs', 'adslAtucPerfCurr1DayInits', 'adslAturPerfCurr1DayLofs', 'adslAturPerfCurr1DayLoss', 'adslAturPerfCurr1DayLprs', 'adslAturPerfCurr1DayESs', ) { my $base = $dd->oiddef($oidname); my $table = $session->get_table( -baseoid => $base ); my $prefixLen = length( $base ) + 1; if( defined($table) ) { while( my( $oid, $val ) = each %{$table} ) { my $ifIndex = substr( $oid, $prefixLen ); $data->{'AdslLine'}{$ifIndex}{$oidname} = 1; } } } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; # Build SNR subtree my $subtreeName = 'ADSL_Line_Stats'; my $subtreeParam = { 'precedence' => '-600', 'node-display-name' => 'ADSL line statistics', 'comment' => 'ADSL line signal quality and performance', }; my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $subtreeParam ); my $data = $devdetails->data(); my $precedence = 1000; foreach my $ifIndex ( sort {$a<=>$b} %{$data->{'AdslLine'}} ) { my $interface = $data->{'interfaces'}{$ifIndex}; next if not defined($interface); my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; my $ifParam = { 'collector-timeoffset-hashstring' =>'%system-id%:%interface-nick%', 'precedence' => $precedence, 'graph-title' => '%system-id%:%interface-name%', }; $ifParam->{'interface-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; $ifParam->{'interface-nick'} = $interface->{$data->{'nameref'}{'ifNick'}}; $ifParam->{'node-display-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; $ifParam->{'nodeid-interface'} = 'adsl-' . $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} . $interface->{$data->{'nameref'}{'ifNodeid'}}; if( defined($data->{'nameref'}{'ifComment'}) and defined($interface->{$data->{'nameref'}{'ifComment'}}) ) { $ifParam->{'comment'} = $interface->{$data->{'nameref'}{'ifComment'}}; } my $templates = []; my $childParams = {}; my $adslIntf = $data->{'AdslLine'}{$ifIndex}; my $applySelectors = sub { my $selectorSuffix = shift; my $leafSuffix = shift; foreach my $end ('Atuc', 'Atur') { my $arg = $adslIntf->{'selectorActions'}{ $end . $selectorSuffix}; if( defined($arg) ) { $childParams->{$end . '_' . $leafSuffix}{'monitor'} = $arg; } } }; if( $adslIntf->{'adslAtucCurrSnrMgn'} and $adslIntf->{'adslAturCurrSnrMgn'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-line-snr'); &{$applySelectors}('SnrMonitor', 'SnrMgn'); } if( $adslIntf->{'adslAtucCurrAtn'} and $adslIntf->{'adslAturCurrAtn'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-line-atn'); &{$applySelectors}('AtnMonitor', 'Atn'); } if( $adslIntf->{'adslAtucCurrAttainableRate'} and $adslIntf->{'adslAturCurrAttainableRate'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-line-attrate'); &{$applySelectors}('AttRateMonitor', 'AttainableRate'); } if( $adslIntf->{'adslAtucChanCurrTxRate'} and $adslIntf->{'adslAturChanCurrTxRate'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-channel-txrate'); &{$applySelectors}('TxRateMonitor', 'CurrTxRate'); } if( $adslIntf->{'adslAtucPerfCurr1DayLofs'} and $adslIntf->{'adslAturPerfCurr1DayLofs'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-perf-lofs'); &{$applySelectors}('LofsMonitor', 'Lofs'); } if( $adslIntf->{'adslAtucPerfCurr1DayLoss'} and $adslIntf->{'adslAturPerfCurr1DayLoss'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-perf-loss'); &{$applySelectors}('LossMonitor', 'Loss'); } if( $adslIntf->{'adslAtucPerfCurr1DayLprs'} and $adslIntf->{'adslAturPerfCurr1DayLprs'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-perf-lprs'); &{$applySelectors}('LprsMonitor', 'Lprs'); } if( $adslIntf->{'adslAtucPerfCurr1DayESs'} and $adslIntf->{'adslAturPerfCurr1DayESs'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-perf-ess'); &{$applySelectors}('ESsMonitor', 'ESs'); } if( $adslIntf->{'adslAtucPerfCurr1DayInits'} ) { push( @{$templates}, 'RFC2662_ADSL_LINE::adsl-perf-inits'); my $arg = $adslIntf->{'selectorActions'}{'AtucInitsMonitor'}; if( defined($arg) ) { $childParams->{'Atuc_Inits_Raw'}{'monitor'} = $arg; } } if( scalar(@{$templates}) > 0 ) { my $lineNode = $cb->addSubtree( $subtreeNode, $ifSubtreeName, $ifParam, $templates ); if( scalar(keys %{$childParams}) > 0 ) { foreach my $childName ( sort keys %{$childParams} ) { $cb->addLeaf ( $lineNode, $childName, $childParams->{$childName} ); } } } } return; } ####################################### # Selectors interface # $Torrus::DevDiscover::selectorsRegistry{'RFC2662_ADSL_LINE'} = { '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()->{'AdslLine'}}) ); } 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; } return 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 = ( 'AtucSnrMonitor' => 'RFC2662_ADSL_LINE', 'AturSnrMonitor' => 'RFC2662_ADSL_LINE', 'AtucAtnMonitor' => 'RFC2662_ADSL_LINE', 'AturAtnMonitor' => 'RFC2662_ADSL_LINE', 'AtucAttRateMonitor' => 'RFC2662_ADSL_LINE', 'AturAttRateMonitor' => 'RFC2662_ADSL_LINE', 'AtucTxRateMonitor' => 'RFC2662_ADSL_LINE', 'AturTxRateMonitor' => 'RFC2662_ADSL_LINE', 'AtucLofsMonitor' => 'RFC2662_ADSL_LINE', 'AturLofsMonitor' => 'RFC2662_ADSL_LINE', 'AtucLossMonitor' => 'RFC2662_ADSL_LINE', 'AturLossMonitor' => 'RFC2662_ADSL_LINE', 'AtucLprsMonitor' => 'RFC2662_ADSL_LINE', 'AturLprsMonitor' => 'RFC2662_ADSL_LINE', 'AtucESsMonitor' => 'RFC2662_ADSL_LINE', 'AturESsMonitor' => 'RFC2662_ADSL_LINE', 'AtucInitsMonitor' => 'RFC2662_ADSL_LINE', ); sub applySelectorAction { my $devdetails = shift; my $object = shift; my $objType = shift; my $action = shift; my $arg = shift; my $data = $devdetails->data(); my $adslIntf = $data->{'AdslLine'}{$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')); } $adslIntf->{'selectorActions'}{$action} = $arg; } else { Error('Unknown RFC2863_IF_MIB selector action: ' . $action); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm0000644000175000017500000002512212661116101017541 00000000000000# 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. # Stanislav Sinyagin # DOCSIS interface statistics package Torrus::DevDiscover::RFC2670_DOCS_IF; use strict; use warnings; 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 = $dd->walkSnmpTable('docsIfSigQSignalNoise'); $data->{'docsCableMaclayer'} = []; $data->{'docsCableDownstream'} = []; $data->{'docsCableUpstream'} = []; $data->{'docsCableUpstreamPhy'} = []; 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( defined($snrTable->{$ifIndex}) ) { push( @{$data->{'docsCableUpstream'}}, $ifIndex ); push( @{$interface->{'docsTemplates'}}, 'RFC2670_DOCS_IF::docsis-upstream-stats' ); } else { push( @{$data->{'docsCableUpstreamPhy'}}, $ifIndex ); } } } $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->paramEnabled ('RFC2670_DOCS_IF::suppress-all-cable-stats') ) { # Completely exclude all DOCSIS interfaces from any collection foreach my $category ( keys %{$data->{'docsConfig'}}, 'docsCableUpstreamPhy' ) { foreach my $ifIndex ( @{$data->{$category}} ) { my $interface = $data->{'interfaces'}{$ifIndex}; $interface->{'excluded'} = 1; } } } if( $devdetails->paramEnabled('RFC2670_DOCS_IF::upstreams-only') ) { $data->{'docsCableMaclayer'} = []; $data->{'docsCableDownstream'} = []; } if( $devdetails->paramEnabled('RFC2670_DOCS_IF::disable-downstreams') ) { $data->{'docsCableDownstream'} = []; } if( $devdetails->hasCap('docsDownstreamUtil') and scalar(@{$data->{'docsCableDownstream'}}) > 0 ) { 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 $ifParam = $interface->{'docsParams'}; $ifParam->{'searchable'} = 'yes'; # Copy some parameters from IF-MIB discovery results foreach my $p ('interface-name', 'interface-nick', 'node-display-name') { $ifParam->{$p} = $interface->{'param'}{$p}; } my $comment = $interface->{'param'}{'comment'}; if( defined($comment) and $comment ne '' ) { $ifParam->{'comment'} = $comment; } $ifParam->{'nodeid-docsif'} = $data->{'docsConfig'}{$category}{'nodeidCategory'} . '//%nodeid-device%//' . $interface->{$data->{'nameref'}{'ifNodeid'}}; $ifParam->{'nodeid'} = '%nodeid-docsif%'; my $intfNode = $cb->addSubtree ( $subtreeNode, $interface->{$data->{'nameref'}{'ifSubtreeName'}}, $ifParam, $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 } ); } } } } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/OracleDatabase.pm0000644000175000017500000002751212661116101020261 00000000000000# 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. # Shawn Ferry # Oracle Database MIB package Torrus::DevDiscover::OracleDatabase; use strict; use warnings; 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 $subtreeParam = { 'comment' => "Table space for $dbName", 'precedence' => "600", }; my $tsNode = $cb->addSubtree($dbNode, 'Table_Space', $subtreeParam ); 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 $subtreeParam = { 'comment' => "Data Files for $dbName", 'precedence' => "500", }; my $dfNode = $cb->addSubtree($dbNode, 'Data_Files', $subtreeParam ); 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 $subtreeParam = { 'comment' => "Library Cache for $dbName", 'precedence' => "400", }; my $lcNode = $cb->addSubtree($dbNode, 'Library_Cache', $subtreeParam ); 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"); } } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/NetBotz.pm0000644000175000017500000002646012661116101017015 00000000000000# 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. # NetBotz modular sensors package Torrus::DevDiscover::NetBotz; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'NetBotz'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # NETBOTZV2-MIB 'netBotzV2Products' => '1.3.6.1.4.1.5528.100.20', 'nb_enclosureId' => '1.3.6.1.4.1.5528.100.2.1.1.1', 'nb_enclosureLabel' => '1.3.6.1.4.1.5528.100.2.1.1.4', 'nb_tempSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.1.1.4', 'nb_tempSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.1.1.5', 'nb_humiSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.2.1.4', 'nb_humiSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.2.1.5', 'nb_dewPointSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.3.1.4', 'nb_dewPointSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.3.1.5', 'nb_audioSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.4.1.4', 'nb_audioSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.4.1.5', 'nb_airFlowSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.5.1.4', 'nb_airFlowSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.5.1.5', 'nb_ampDetectSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.6.1.4', 'nb_ampDetectSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.6.1.5', 'nb_otherNumericSensorLabel' => '1.3.6.1.4.1.5528.100.4.1.10.1.4', 'nb_otherNumericSensorEncId' => '1.3.6.1.4.1.5528.100.4.1.10.1.5', 'nb_dryContactSensorLabel' => '1.3.6.1.4.1.5528.100.4.2.1.1.4', 'nb_dryContactSensorEncId' => '1.3.6.1.4.1.5528.100.4.2.1.1.5', 'nb_doorSwitchSensorLabel' => '1.3.6.1.4.1.5528.100.4.2.2.1.4', 'nb_doorSwitchSensorEncId' => '1.3.6.1.4.1.5528.100.4.2.2.1.5', 'nb_cameraMotionSensorLabel' => '1.3.6.1.4.1.5528.100.4.2.3.1.4', 'nb_cameraMotionSensorEncId' => '1.3.6.1.4.1.5528.100.4.2.3.1.5', 'nb_otherStateSensorLabel' => '1.3.6.1.4.1.5528.100.4.2.10.1.4', 'nb_otherStateSensorEncId' => '1.3.6.1.4.1.5528.100.4.2.10.1.5', ); our %sensor_types = ('temp' => { 'oidname' => 'temp', 'template' => 'NetBotz::netbotz-temp-sensor', 'max' => 'NetBotz::temp-max', }, 'humi' => { 'oidname' => 'humi', 'template' => 'NetBotz::netbotz-humi-sensor', 'max' => 'NetBotz::humi-max', }, 'dew' => { 'oidname' => 'dewPoint', 'template' => 'NetBotz::netbotz-dew-sensor', 'max' => 'NetBotz::dew-max', }, 'audio' => { 'oidname' => 'audio', 'template' => 'NetBotz::netbotz-audio-sensor' }, 'air' => { 'oidname' => 'airFlow', 'template' => 'NetBotz::netbotz-air-sensor' }, 'door' => { 'oidname' => 'doorSwitch', '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(); # retrieve enclosure IDs and names; $data->{'NetBotz_encl'} = {}; $data->{'NetBotz_sens'} = {}; { my $id_table = $dd->walkSnmpTable('nb_enclosureId'); my $label_table = $dd->walkSnmpTable('nb_enclosureLabel'); while( my($INDEX, $id) = each %{$id_table} ) { my $label = $label_table->{$INDEX}; if( defined($label) ) { $data->{'NetBotz_encl'}{$id} = { 'encl_label' => $label, 'sensors' => {}}; } else { Error('Cannot retrieve NetBotz enclosure label for id=' . $id); } } } # store the sensor names to guarantee uniqueness my %sensorNames; foreach my $stype (sort keys %sensor_types) { my $oid_name_base = 'nb_' . $sensor_types{$stype}{'oidname'}; my $encl_table = $dd->walkSnmpTable($oid_name_base . 'SensorEncId'); my $label_table = $dd->walkSnmpTable($oid_name_base . 'SensorLabel'); foreach my $INDEX (sort {$a <=> $b} keys %{$encl_table}) { my $enclId = $encl_table->{$INDEX}; my $label = $label_table->{$INDEX}; next unless (defined($enclId) and defined($label)); if( not defined($data->{'NetBotz_encl'}{$enclId}) ) { Error('Cannot associate sensor ' . $label . ' with enclosure ID'); next; } 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; $leafName =~ s/_+$//g; my $param = { 'netbotz-sensor-index' => $INDEX, 'netbotz-enclosure-id' => $enclId, 'node-display-name' => $label, 'graph-title' => $label, 'precedence' => sprintf('%d', 0 - $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; } } my $ref = { 'param' => $param, 'label' => $label, 'leafName' => $leafName, 'template' => $sensor_types{$stype}{'template'}, 'enclosureId' => $enclId, }; $data->{'NetBotz_encl'}{$enclId}{'sensors'}{$INDEX} = $ref; $data->{'NetBotz_sens'}{$INDEX} = $ref; } } if( not defined($data->{'param'}{'comment'}) or $data->{'param'}{'comment'} eq '') { $data->{'param'}{'comment'} = 'NetBotz environment sensors'; } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); my $enclSubtree = $cb->addSubtree ( $devNode, 'Sensor_Enclosures', {'node-display-name' => 'Sensor Enclosures', 'comment' => 'NetBotz sensors arranged in enclosures', 'precedence' => 10000}); my $precedence = 1000; foreach my $enclId (sort keys %{$data->{'NetBotz_encl'}} ) { my $ref = $data->{'NetBotz_encl'}{$enclId}; next if scalar(keys %{$ref->{'sensors'}}) == 0; my $enclLabel = $ref->{'encl_label'}; my $subtreeName = $enclLabel; $subtreeName =~ s/\W+/_/g; $subtreeName =~ s/_+$//; my $enclNode = $cb->addSubtree( $enclSubtree, $subtreeName, {'node-display-name' => $enclLabel, 'precedence' => $precedence}); $precedence--; foreach my $INDEX ( sort {$a<=>$b} keys %{$ref->{'sensors'}} ) { my $sensor = $ref->{'sensors'}{$INDEX}; if( defined($sensor->{'selectorActions'}) ) { my $monitor = $sensor->{'selectorActions'}{'Monitor'}; if( defined($monitor) ) { $sensor->{'param'}{'monitor'} = $monitor; } my $tset = $sensor->{'selectorActions'}{'TokensetMember'}; if( defined( $tset ) ) { $sensor->{'param'}{'tokenset-member'} = $tset; } } $cb->addLeaf( $enclNode, $sensor->{'leafName'}, $sensor->{'param'}, [$sensor->{'template'}] ); } } return; } ####################################### # Selectors interface # $Torrus::DevDiscover::selectorsRegistry{'NetBotzSensor'} = { 'getObjects' => \&getSelectorObjects, 'getObjectName' => \&getSelectorObjectName, 'checkAttribute' => \&checkSelectorAttribute, 'applyAction' => \&applySelectorAction, }; sub getSelectorObjects { my $devdetails = shift; my $objType = shift; my $data = $devdetails->data(); return( sort {$a<=>$b} keys %{$data->{'NetBotz_sens'}} ); } 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 $sensor = $data->{'NetBotz_sens'}{$object}; if( $attr eq 'SensorLabel' ) { $value = $sensor->{'label'}; } elsif( $attr eq 'EnclosureLabel' ) { my $enclId = $sensor->{'enclosureId'}; $value = $data->{'NetBotz_encl'}{$enclId}{'encl_label'}; } elsif( $attr eq 'EnclosureID' ) { $value = $sensor->{'enclosureId'}; } else { Error('Unknown NetBotzSensor 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->{'NetBotz_sens'}{$object}{'label'}; } my %knownSelectorActions = ( 'Monitor' => 1, '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 = $data->{'NetBotz_sens'}{$object}; if( $knownSelectorActions{$action} ) { $objref->{'selectorActions'}{$action} = $arg; } else { Error('Unknown NetBotz selector action: ' . $action); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/F5BigIp.pm0000644000175000017500000004461412661116101016616 00000000000000# Copyright (C) 2012 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. # F5 BIG-IP versions 10.x and higher # Tested with LTM version 11.0 package Torrus::DevDiscover::F5BigIp; use strict; use warnings; use Digest::MD5 qw(md5_hex); use Torrus::Log; $Torrus::DevDiscover::registry{'F5BigIp'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # F5-BIGIP-COMMON-MIB 'f5_bigipTrafficMgmt' => '1.3.6.1.4.1.3375.2', # F5-BIGIP-SYSTEM-MIB 'f5_sysPlatformInfoMarketingName' => '1.3.6.1.4.1.3375.2.1.3.5.2.0', 'f5_sysProductVersion' => '1.3.6.1.4.1.3375.2.1.4.2.0', 'f5_sysProductBuild' => '1.3.6.1.4.1.3375.2.1.4.3.0', 'f5_sysGlobalHostMemTotal' => '1.3.6.1.4.1.3375.2.1.1.2.20.2.0', 'f5_sysMultiHostHostId' => '1.3.6.1.4.1.3375.2.1.7.4.2.1.1', 'f5_sysMultiHostTotal' => '1.3.6.1.4.1.3375.2.1.7.4.2.1.2', 'f5_sysMultiHostCpuId' => '1.3.6.1.4.1.3375.2.1.7.5.2.1.3', 'f5_sysInterfaceName' => '1.3.6.1.4.1.3375.2.1.2.4.1.2.1.1', 'f5_sysInterfaceEnabled' => '1.3.6.1.4.1.3375.2.1.2.4.1.2.1.8', 'f5_sysInterfaceStatus' => '1.3.6.1.4.1.3375.2.1.2.4.1.2.1.17', # F5-BIGIP-LOCAL-MIB -- LTM stats 'ltmNodeAddrNumber' => '1.3.6.1.4.1.3375.2.2.4.1.1.0', 'ltmNodeAddrStatNodeName' => '1.3.6.1.4.1.3375.2.2.4.2.3.1.20', 'ltmPoolNumber' => '1.3.6.1.4.1.3375.2.2.5.1.1.0', 'ltmPoolStatName' => '1.3.6.1.4.1.3375.2.2.5.2.3.1.1', 'ltmPoolMemberStatPoolName' => '1.3.6.1.4.1.3375.2.2.5.4.3.1.1', 'ltmPoolMemberStatNodeName' => '1.3.6.1.4.1.3375.2.2.5.4.3.1.28', 'ltmPoolMemberStatPort' => '1.3.6.1.4.1.3375.2.2.5.4.3.1.4', 'ltmVirtualServNumber' => '1.3.6.1.4.1.3375.2.2.10.1.1.0', 'ltmVirtualServStatName' => '1.3.6.1.4.1.3375.2.2.10.2.3.1.1', ); my @f5_sys_oidlist = ( 'f5_sysPlatformInfoMarketingName', 'f5_sysProductVersion', 'f5_sysProductBuild', ); my $f5InterfaceFilter = { 'LOOPBACK' => { 'ifType' => 24, # softwareLoopback }, }; my %ltm_category_templates = ( 'Nodes' => ['F5BigIp::ltm-node-statistics', 'F5BigIp::f5-object-statistics'], 'Pools' => ['F5BigIp::ltm-pool-statistics', 'F5BigIp::f5-object-statistics'], 'VServers' => ['F5BigIp::ltm-vserver-statistics', 'F5BigIp::f5-object-statistics'], ); my %ltm_category_comment = ( 'Nodes' => 'Per-node statistics', 'Pools' => 'Pool statistics', 'VServers' => 'Virtual server statistics', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'f5_bigipTrafficMgmt', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) { return 0; } $devdetails->setParam('RFC2863_IF_MIB::disable-all', 'yes'); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'param'}{'snmp-oids-per-pdu'} = 10; my $old_maxrepetitions = $dd->{'maxrepetitions'}; $dd->{'maxrepetitions'} = 3; # Common system information { my $result = $dd->retrieveSnmpOIDs(@f5_sys_oidlist); if( defined($result) ) { my $sysref = {}; foreach my $oidname ( @f5_sys_oidlist ) { my $val = $result->{$oidname}; if( defined($val) and length($val) > 0 ) { $sysref->{$oidname} = $val; } else { $sysref->{$oidname} = 'N/A'; } } $data->{'param'}{'comment'} = $sysref->{'f5_sysPlatformInfoMarketingName'} . ', Version ' . $sysref->{'f5_sysProductVersion'} . ', Build ' . $sysref->{'f5_sysProductBuild'}; } $result = $dd->retrieveSnmpOIDs('f5_sysGlobalHostMemTotal'); if( defined($result) and $result->{'f5_sysGlobalHostMemTotal'} > 0 ) { $data->{'param'}{'f5-global-host-memtotal'} = $result->{'f5_sysGlobalHostMemTotal'}; push( @{$data->{'templates'}}, 'F5BigIp::f5-global-host' ); } if( $devdetails->paramEnabled('F5BigIp::multi-host-stats') ) { my $hostID = $dd->walkSnmpTable('f5_sysMultiHostHostId'); my $hostMem = $dd->walkSnmpTable('f5_sysMultiHostTotal'); while( my( $hINDEX, $memsize ) = each %{$hostMem} ) { $data->{'f5_host'}{$hINDEX}{'memtotal'} = $memsize; $data->{'f5_host'}{$hINDEX}{'hostid'} = $hostID->{$hINDEX}; } foreach my $hINDEX (keys %{$data->{'f5_host'}}) { my $cpus = $dd->walkSnmpTable('f5_sysMultiHostCpuId'); while( my( $cINDEX, $id ) = each %{$cpus} ) { $cINDEX = substr($cINDEX, length($hINDEX)+1); $data->{'f5_host'}{$hINDEX}{'cpu'}{$cINDEX} = $id; } } } } # 64bit traffic counters for interfaces { $data->{'f5_ports'} = {}; my $ifNames = $dd->walkSnmpTable('f5_sysInterfaceName'); # sysInterfaceEnabled: # false(0), # true(1) # sysInterfaceStatus: # up(0), # down(1), # uninitialized(3), # unpopulated(5) my $ifEnabled = $dd->walkSnmpTable('f5_sysInterfaceEnabled'); my $ifStatus = $dd->walkSnmpTable('f5_sysInterfaceStatus'); foreach my $INDEX (keys %{$ifNames}) { if( $ifEnabled->{$INDEX} == 1 and $ifStatus->{$INDEX} <= 1 ) { my $name = $ifNames->{$INDEX}; my $sortIndex = 0; my $scale = 1; foreach my $part (reverse split(/\W/, $name)) { my $x = 0; if( $part =~ /^\d+$/ ) { $x = $part; } $sortIndex += $x * $scale; $scale *= 1000; } $data->{'f5_ports'}{$INDEX} = { 'name' => $name, 'order' => $sortIndex, }; } } } # Check LTM capabilities { my $result = $dd->retrieveSnmpOIDs( 'ltmNodeAddrNumber', 'ltmPoolNumber', 'ltmVirtualServNumber'); if( defined($result->{'ltmNodeAddrNumber'}) and $result->{'ltmNodeAddrNumber'} > 0 ) { $devdetails->setCap('F5_LTM_Nodes'); } if( defined($result->{'ltmPoolNumber'}) and $result->{'ltmPoolNumber'} > 0 ) { $devdetails->setCap('F5_LTM_Pools'); } if( defined($result->{'ltmVirtualServNumber'}) and $result->{'ltmVirtualServNumber'} > 0 ) { $devdetails->setCap('F5_LTM_VServers'); } } $data->{'ltm'} = {}; if( $devdetails->hasCap('F5_LTM_Nodes') ) { my $names = $dd->walkSnmpTable('ltmNodeAddrStatNodeName'); while( my( $INDEX, $fullname ) = each %{$names} ) { if( $fullname =~ /^\/([^\/]+)\/(.+)$/o ) { my $partition = $1; my $node = $2; $data->{'ltm'}{$partition}{'Nodes'}{$node} = { 'f5-object-fullname' => $fullname, 'f5-object-nameidx' => $INDEX, 'f5-object-shortname' => $node, }; } } } if( $devdetails->hasCap('F5_LTM_Pools') ) { my $names = $dd->walkSnmpTable('ltmPoolStatName'); while( my( $INDEX, $fullname ) = each %{$names} ) { if( $fullname =~ /^\/([^\/]+)\/(.+)$/o ) { my $partition = $1; # the full name may consist of 3 parts if it's generated # by application template. We drop the middle part # (template name) my $pool = $2; if( $pool =~ /^[^\/]+\/(.+)$/ ) { $pool = $1; } $data->{'ltm'}{$partition}{'Pools'}{$pool} = { 'f5-object-fullname' => $fullname, 'f5-object-nameidx' => $INDEX, 'f5-object-shortname' => $pool, }; } } # Get the pool members my $poolnames = $dd->walkSnmpTable('ltmPoolMemberStatPoolName'); my $nodenames = $dd->walkSnmpTable('ltmPoolMemberStatNodeName'); my $ports = $dd->walkSnmpTable('ltmPoolMemberStatPort'); while( my( $INDEX, $poolname ) = each %{$poolnames} ) { if( $poolname !~ /^\/([^\/]+)\/(.+)$/o ) { next; } my $partition = $1; # the full name may consist of 3 parts if it's generated # by application template. We drop the middle part # (template name) my $pool = $2; if( $pool =~ /^[^\/]+\/(.+)$/ ) { $pool = $1; } my $nodename = $nodenames->{$INDEX}; # Node name consists of /Partition/Name if( $nodename !~ /^\/([^\/]+)\/(.+)$/o ) { next; } my $node = $2; my $port = $ports->{$INDEX}; next unless (defined($port) and $port > 0 ); $data->{'ltm_poolmembers'}{$partition}{$pool}{$node}{$port} = { 'f5-object-fullname' => join(':', $partition, $pool,$node,$port), 'f5-object-nameidx' => $INDEX, 'f5-object-shortname' => $node . ':' . $port, }; } } if( $devdetails->hasCap('F5_LTM_VServers') ) { my $names = $dd->walkSnmpTable('ltmVirtualServStatName'); while( my( $INDEX, $fullname ) = each %{$names} ) { if( $fullname =~ /^\/([^\/]+)\/(.+)$/o ) { my $partition = $1; # the full name may consist of 3 parts if it's generated # by application template. We drop the middle part # (template name) my $srv = $2; if( $srv =~ /^[^\/]+\/(.+)$/ ) { $srv = $1; } $data->{'ltm'}{$partition}{'VServers'}{$srv} = { 'f5-object-fullname' => $fullname, 'f5-object-nameidx' => $INDEX, 'f5-object-shortname' => $srv, }; } } } $dd->{'maxrepetitions'} = $old_maxrepetitions; return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); if( defined($data->{'f5_host'}) ) { foreach my $hINDEX (keys %{$data->{'f5_host'}}) { my $hostSubtree = 'Host ' . $data->{'f5_host'}{$hINDEX}{'hostid'}; my $params = { 'node-display-name' => $hostSubtree, 'comment' => 'BigIP host', 'f5-host-index' => $hINDEX, 'f5-host-memtotal' => $data->{'f5_host'}{$hINDEX}{'memtotal'}, }; $hostSubtree =~ s/\W/_/g; my $hostNode = $cb->addSubtree ( $devNode, $hostSubtree, $params, ['F5BigIp::f5-multihost-host']); my $cpusNode = $cb->addSubtree ( $hostNode, 'CPU', {}, ['F5BigIp::f5-multihost-cpu-subtree']); foreach my $cINDEX (sort {$a<=>$b} keys %{$data->{'f5_host'}{$hINDEX}{'cpu'}}) { my $id = $data->{'f5_host'}{$hINDEX}{'cpu'}{$cINDEX}; my $params = { 'f5-cpu-index' => $cINDEX, 'f5-cpu-id' => $id, }; $cb->addSubtree ( $cpusNode, $id, $params, ['F5BigIp::f5-multihost-cpu']); } } } if( defined($data->{'f5_ports'}) ) { my $statsNode = $cb->addSubtree ( $devNode, 'Interface_Counters', {}, ['F5BigIp::f5-interface-counters-subtree']); foreach my $INDEX ( sort {$data->{'f5_ports'}{$a}{'order'} <=> $data->{'f5_ports'}{$b}{'order'}} keys %{$data->{'f5_ports'}} ) { my $name = $data->{'f5_ports'}{$INDEX}{'name'}; my $ifSubtree = $name; $ifSubtree =~ s/\W/_/g; my $order = $data->{'f5_ports'}{$INDEX}{'order'}; my $nodeid = 'f5-if//%nodeid-device%//' . $name; my $params = { 'node-display-name' => $name, 'f5-interface-index' => $INDEX, 'f5-interface-name' => $name, 'nodeid-interface' => $nodeid, 'nodeid' => $nodeid, 'precedence' => (0 - $order), }; $cb->addSubtree($statsNode, $ifSubtree, $params, ['F5BigIp::f5-interface']); } } my $p_precedence = 10000; foreach my $partition (sort keys %{$data->{'ltm'}}) { $p_precedence--; my $partParams = { 'node-display-name' => $partition, 'precedence' => $p_precedence, 'comment' => 'BigIP partition', }; my $partSubtree = $partition; $partSubtree =~ s/\W+/_/g; my $partitionNode = $cb->addSubtree( $devNode, $partSubtree, $partParams ); foreach my $category (sort keys %{$data->{'ltm'}{$partition}}) { my $catParams = { 'comment' => $ltm_category_comment{$category}, }; my $categoryNode = $cb->addSubtree( $partitionNode, $category, $catParams, ['F5BigIp::f5-category-subtree'] ); foreach my $object (sort keys %{$data->{'ltm'}{$partition}{$category}}) { my $objParam = { 'node-display-name' => $object, }; my $ref = $data->{'ltm'}{$partition}{$category}{$object}; while( my($p, $v) = each %{$ref} ) { $objParam->{$p} = $v; } $objParam->{'f5-object-md5'} = md5_hex($objParam->{'f5-object-fullname'}); my $objSubtree = $object; $objSubtree =~ s/\W/_/g; $cb->addSubtree( $categoryNode, $objSubtree, $objParam, $ltm_category_templates{$category}); } } # Pool members if( defined($data->{'ltm_poolmembers'}{$partition}) and scalar(keys %{$data->{'ltm_poolmembers'}{$partition}}) > 0 ) { my $m_precedence = 1000; my $membersNode = $cb->addSubtree( $partitionNode, 'Pool_Members', { 'node-display-name' => 'Pool Members', 'comment' => 'Pool member statistics', } ); foreach my $pool (sort keys %{$data->{'ltm_poolmembers'}{$partition}}) { my $ref1 = $data->{'ltm_poolmembers'}{$partition}{$pool}; my $poolSubtree = $pool; $poolSubtree =~ s/\W/_/g; my $poolNode = $cb->addSubtree( $membersNode, $poolSubtree, { 'node-display-name' => $pool, }, ['F5BigIp::f5-category-subtree'] ); foreach my $node (sort keys %{$ref1}) { foreach my $port (sort {$a <=> $b} keys %{$ref1->{$node}}) { $m_precedence--; my $objParam = { 'node-display-name' => $node . ':' . $port, 'precedence' => $m_precedence, }; my $ref = $ref1->{$node}{$port}; while( my($p, $v) = each %{$ref} ) { $objParam->{$p} = $v; } $objParam->{'f5-object-md5'} = md5_hex($objParam->{'f5-object-fullname'}); my $objSubtree = $node . ':' . $port; $objSubtree =~ s/\W/_/g; $cb->addSubtree( $poolNode, $objSubtree, $objParam, ['F5BigIp::ltm-poolmember-statistics', 'F5BigIp::f5-object-statistics']); } } } } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/CiscoGeneric.pm0000644000175000017500000005704612661116101017771 00000000000000# 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. # Stanislav Sinyagin # Common Cisco MIBs, supported by many IOS and CatOS devices package Torrus::DevDiscover::CiscoGeneric; use strict; use warnings; 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', 'cempMemPoolHCUsed' => '1.3.6.1.4.1.9.9.221.1.1.1.1.18', # CISCO-MEMORY-POOL-MIB 'ciscoMemoryPoolName' => '1.3.6.1.4.1.9.9.48.1.1.1.2', # CISCO-PROCESS-MIB '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', # OLD-CISCO-CPU-MIB 'avgBusy1' => '1.3.6.1.4.1.9.2.1.57.0', # CISCO-SYSTEM-EXT-MIB 'cseSysCPUUtilization' => '1.3.6.1.4.1.9.9.305.1.1.1.0', 'cseSysMemoryUtilization' => '1.3.6.1.4.1.9.9.305.1.1.2.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->paramDisabled('CiscoGeneric::disable-sensors') ) { # 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->paramDisabled('CiscoGeneric::disable-psupplies') ) { # 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->paramDisabled('CiscoGeneric::disable-memory-pools') ) { my $eMemPool = $dd->walkSnmpTable('cempMemPoolName'); my $eMemHC = $dd->walkSnmpTable('cempMemPoolHCUsed'); if( scalar(keys %{$eMemPool}) > 0 and $devdetails->isDevType('RFC2737_ENTITY_MIB') ) { $devdetails->setCap('cempMemPool'); $data->{'cempMemPool'} = {}; foreach my $INDEX (keys %{$eMemPool}) { # $INDEX is a pair entPhysicalIndex . cempMemPoolIndex my ( $phyIndex, $poolIndex ) = split('\.', $INDEX); my $poolName = $eMemPool->{$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 }; if( defined($eMemHC->{$INDEX}) ) { $data->{'cempMemPool'}{$INDEX}{'hc'} = 1; } } } else { my $MemoryPool = $dd->walkSnmpTable('ciscoMemoryPoolName'); if( scalar(keys %{$MemoryPool}) > 0 ) { $devdetails->setCap('ciscoMemoryPool'); $data->{'ciscoMemoryPool'} = {}; foreach my $memType (keys %{$MemoryPool}) { # 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 ) { $data->{'ciscoMemoryPool'}{$memType} = $MemoryPool->{$memType}; } } } } } if( $devdetails->paramDisabled('CiscoGeneric::disable-cpu-stats') ) { my $cpmCPUTotalPhysicalIndex = $dd->walkSnmpTable('cpmCPUTotalPhysicalIndex'); my $cpmCPUTotal1minRev = $dd->walkSnmpTable('cpmCPUTotal1minRev'); if( scalar(keys %{$cpmCPUTotalPhysicalIndex}) > 0 ) { $devdetails->setCap('ciscoCpuStats'); $data->{'ciscoCpuStats'} = {}; # Find multiple CPU entries pointing to the same Phy index my %phyReferers = (); foreach my $INDEX (keys %{$cpmCPUTotalPhysicalIndex}) { my $phyIndex = $cpmCPUTotalPhysicalIndex->{$INDEX}; $phyReferers{$phyIndex}++; } foreach my $INDEX (keys %{$cpmCPUTotalPhysicalIndex}) { $data->{'ciscoCpuStats'}{$INDEX} = {}; my $phyIndex = $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( defined($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' ); } } } if( $devdetails->paramDisabled('CiscoGeneric::disable-system-ext-mib') ) { my $result = $dd->retrieveSnmpOIDs('cseSysCPUUtilization', 'cseSysMemoryUtilization'); if( defined $result and $result->{'cseSysCPUUtilization'} ne '' and $result->{'cseSysMemoryUtilization'} ne '' ) { $devdetails->setCap('ciscoSysExtMib'); push( @{$data->{'templates'}}, 'CiscoGeneric::cisco-system-ext-mib' ); } } 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->paramEnabled('CiscoGeneric::use-fahrenheit'); my $subtreeParam = { 'node-display-name' => 'Temperature Sensors', }; my $filePerSensor = $devdetails->paramEnabled('CiscoGeneric::file-per-sensor'); $subtreeParam->{'data-file'} = '%snmp-host%_sensors' . ($filePerSensor ? '_%sensor-index%':'') . ($fahrenheit ? '_fahrenheit':'') . '.rrd'; my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $subtreeParam, [ 'CiscoGeneric::cisco-temperature-subtree' ] ); 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 $subtreeParam = { 'node-display-name' => 'Power Supplies', 'comment' => 'Power supplies status', 'precedence' => -600, }; $subtreeParam->{'data-file'} = '%system-id%_power.rrd'; my $monitor = $devdetails->paramString('CiscoGeneric::power-monitor'); if( $monitor ne '' ) { $subtreeParam->{'monitor'} = $monitor; } my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $subtreeParam ); foreach my $sIndex ( sort {$a<=>$b} @{$data->{'ciscoPowerSupplies'}} ) { my $leafName = sprintf( 'power_%.2d', $sIndex ); my $param = { 'power-index' => $sIndex }; $cb->addLeaf( $subtreeNode, $leafName, $param, ['CiscoGeneric::cisco-power-supply'] ); } } # Memory Pools if( $devdetails->hasCap('cempMemPool') or $devdetails->hasCap('ciscoMemoryPool') ) { my $subtreeName = 'Memory_Usage'; my $subtreeParam = { 'node-display-name' => 'Memory Usage', 'precedence' => '-100', 'comment' => 'Router memory utilization' }; my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $subtreeParam, ['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'}); $param->{'entity-phy-name'} = $pool->{'phyName'}; my $template = 'CiscoGeneric::cisco-enh-mempool'; if( $pool->{'hc'} ) { $template = 'CiscoGeneric::cisco-enh-mempool-hc'; } $cb->addSubtree( $subtreeNode, $poolSubtreeName, $param, [ $template ]); } } 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 $subtreeParam = { 'node-display-name' => 'CPU Usage', 'precedence' => '-500', 'comment' => 'Overall CPU busy percentage' }; my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $subtreeParam, ['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; $param->{'entity-phy-name'} = $cpu->{'phy-name'} . ' (' . $INDEX . ')'; } else { $param->{'entity-phy-index'} = $cpu->{'phy-index'}; $param->{'cisco-cpu-ref'} = '%entity-phy-index%'; $param->{'entity-phy-name'} = $cpu->{'phy-name'}; } my @templates; if( defined($cpu->{'stats-type'}) and $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 } ); } } } return; } ####################################### # 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, }; 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); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm0000644000175000017500000000342112661116101017620 00000000000000# 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. # Stanislav Sinyagin # 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 warnings; 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 = $dd->walkSnmpTable('bgpPeerRemoteAs'); if( scalar(keys %{$table}) > 0 ) { $devdetails->setCap('bgpPeerTable'); while( my ($ipAddr, $asNum) = each %{$table} ) { $data->{'bgpPeerAS'}{$ipAddr} = $asNum; } } return 1; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Actelis.pm0000644000175000017500000000603612661116101017011 00000000000000# Copyright (C) 2011 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. # Actelis Networks xDSL gateways # Only interface indexing and naming is handled here. package Torrus::DevDiscover::Actelis; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'Actelis'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( 'actelis_products' => '1.3.6.1.4.1.5468.1', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'actelis_products', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) { return 0; } $devdetails->setCap('interfaceIndexingPersistent'); # 64-bit counters are always zero, so we skip all of them $devdetails->setCap('suppressHCCounters'); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'param'}{'snmp-oids-per-pdu'} = 10; $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; $data->{'nameref'}{'ifReferenceName'} = 'ifName'; $data->{'nameref'}{'ifNick'} = 'ifName'; $data->{'nameref'}{'ifNodeid'} = 'ifName'; foreach my $ifIndex ( keys %{$data->{'interfaces'}}) { my $interface = $data->{'interfaces'}{$ifIndex}; next if $interface->{'excluded'}; # MLP interfaces never update ifIn/Out octet counters # We remove the counters, and keep the ports non-excluded. if( $interface->{'ifType'} == 169 ) # ifType: shdsl(169) { foreach my $prop ('hasOctets', 'hasUcastPkts', 'hasInDiscards', 'hasOutDiscards', 'hasInErrors', 'hasOutErrors', 'hasHCOctets', 'hasHCUcastPkts') { $interface->{$prop} = 0; } next; } if( ($ifIndex == 2001) or ($ifIndex == 2002) ) { $interface->{'ignoreHighSpeed'} = 1; $interface->{'ifSpeedMonitoring'} = 1; } } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm0000644000175000017500000000476512661116101017431 00000000000000# 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. # Stanislav Sinyagin # 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. The module queries # ipNetToMediaTable which is deprecated, but still supported in newer # RFC4293. Some Cisco routers still use the old table anyway. package Torrus::DevDiscover::RFC2011_IP_MIB; use strict; use warnings; 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 $map = $dd->walkSnmpTable('ipNetToMediaPhysAddress'); if( not defined($map) or scalar(keys %{$map}) == 0 ) { return 0; } foreach my $INDEX (keys %{$map}) { my( $ifIndex, @ipAddrOctets ) = split( '\.', $INDEX ); my $ipAddr = join('.', @ipAddrOctets); my $interface = $data->{'interfaces'}{$ifIndex}; next if not defined( $interface ); my $phyAddr = $map->{$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: torrus-2.09/perllib/Torrus/DevDiscover/RFC4319_HDSL2_SHDSL_LINE_MIB.pm0000644000175000017500000003024212661116101021503 00000000000000# Copyright (C) 2011 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. # Stanislav Sinyagin # HDSL/SHDSL Line statistics. package Torrus::DevDiscover::RFC4319_HDSL2_SHDSL_LINE_MIB; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'RFC4319_HDSL2_SHDSL_LINE_MIB'} = { 'sequence' => 100, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # HDSL2-SHDSL-LINE-MIB 'hdsl2ShdslStatusNumAvailRepeaters' => '1.3.6.1.2.1.10.48.1.2.1.1', 'hdsl2ShdslEndpointCurrSnrMgn' => '1.3.6.1.2.1.10.48.1.5.1.2', ); my %hdslUnitId = ( 1 => 'xtuC', 2 => 'xtuR', 3 => 'xru1', 4 => 'xru2', 5 => 'xru3', 6 => 'xru4', 7 => 'xru5', 8 => 'xru6', 9 => 'xru7', 10 => 'xru8', ); my %hdslUnitSide = ( 1 => 'Network Side', 2 => 'Customer Side', ); my %default_hdsl_oids = ( 'hdsl-curr-atn-oid' => 'hdsl2ShdslEndpointCurrAtn', 'hdsl-curr-snr-oid' => 'hdsl2ShdslEndpointCurrSnrMgn', 'hdsl-intvl-es-oid' => 'hdsl2Shdsl15MinIntervalES', 'hdsl-intvl-ses-oid' => 'hdsl2Shdsl15MinIntervalSES', 'hdsl-intvl-crc-oid' => 'hdsl2Shdsl15MinIntervalCRCanomalies', 'hdsl-intvl-losws-oid' => 'hdsl2Shdsl15MinIntervalLOSWS', 'hdsl-intvl-uas-oid' => 'hdsl2Shdsl15MinIntervalUAS', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); if( not $dd->checkSnmpTable('hdsl2ShdslStatusNumAvailRepeaters') ) { return 0; } return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); my $oidmapping = $data->{'RFC4319_HDSL2_SHDSL_LINE_MIB'}{'oidmapping'}; $data->{'HDSLLine'} = {}; $data->{'HDSLLineProps'} = {}; my %unit_instances; # Find all HDSL line ifIndex values and units { my $oidname = 'hdsl2ShdslStatusNumAvailRepeaters'; if( defined($oidmapping) and defined($oidmapping->{$oidname}) ) { $oidname = $oidmapping->{$oidname}; } my $table = $dd->walkSnmpTable($oidname); while( my( $ifIndex, $val ) = each %{$table} ) { # xtuC and xtuR are always present $unit_instances{$ifIndex}{1} = 1; $unit_instances{$ifIndex}{2} = 1; # check the repeaters my $unitId = 3; my $nRepeaters = int($val); $data->{'HDSLLineProps'}{$ifIndex}{'repeaters'} = $nRepeaters; $data->{'HDSLLineProps'}{$ifIndex}{'wirepairs'} = 0; while( $nRepeaters > 0 ) { $unit_instances{$ifIndex}{$unitId} = 1; $unitId++; $nRepeaters--; } } } # Discover the available line stats { my $oidname = 'hdsl2ShdslEndpointCurrSnrMgn'; if( defined($oidmapping) and defined($oidmapping->{$oidname}) ) { $oidname = $oidmapping->{$oidname}; } my $table = $dd->walkSnmpTable($oidname); while( my( $INDEX, $val ) = each %{$table} ) { my($ifIndex, $unitId, $side, $wirepair) = split(/\./, $INDEX); if( $unit_instances{$ifIndex}{$unitId} ) { $data->{'HDSLLine'}{$ifIndex}{$INDEX} = { 'hdsl-unit-id' => $unitId, 'hdsl-unit' => $hdslUnitId{$unitId}, 'hdsl-side' => $hdslUnitSide{$side}, 'hdsl-wirepair' => 'Wirepair ' . $wirepair, }; # find out how many wirepairs this line consists of if( $data->{'HDSLLineProps'}{$ifIndex}{'wirepairs'} < $wirepair ) { $data->{'HDSLLineProps'}{$ifIndex}{'wirepairs'} = $wirepair; } } } } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); if( scalar(keys %{$data->{'HDSLLine'}}) == 0 ) { return; } # Build SNR subtree my $subtreeName = 'SHDSL_Line_Stats'; my $subtreeParam = { 'node-display-name' => 'SHDSL line statistics', }; my $oidmapping = $data->{'RFC4319_HDSL2_SHDSL_LINE_MIB'}{'oidmapping'}; while(my ($oidparam, $oidname) = each %default_hdsl_oids) { if( defined($oidmapping) and defined($oidmapping->{$oidname}) ) { $oidname = $oidmapping->{$oidname}; } $subtreeParam->{$oidparam} = "\$" . $oidname; } my $subtreeNode = $cb->addSubtree($devNode, $subtreeName, $subtreeParam, ['RFC4319_HDSL2_SHDSL_LINE_MIB::hdsl-subtree']); my $precedence = 1000; foreach my $ifIndex ( sort {$a<=>$b} %{$data->{'HDSLLine'}} ) { my $interface = $data->{'interfaces'}{$ifIndex}; next if (not defined($interface) or $interface->{'excluded'}); my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}}; my $ifParam = { 'collector-timeoffset-hashstring' =>'%system-id%:%interface-nick%', 'precedence' => $precedence, }; if( defined($data->{'nameref'}{'ifComment'}) and defined($interface->{$data->{'nameref'}{'ifComment'}}) ) { $ifParam->{'comment'} = $interface->{$data->{'nameref'}{'ifComment'}}; } $ifParam->{'interface-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; $ifParam->{'interface-nick'} = $interface->{$data->{'nameref'}{'ifNick'}}; $ifParam->{'node-display-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; if( defined($data->{'nameref'}{'ifVendorSpecific'}) and defined($interface->{$data->{'nameref'}{'ifVendorSpecific'}}) ) { $ifParam->{'interface-vendor-specific'} = $interface->{$data->{'nameref'}{'ifVendorSpecific'}}; } $ifParam->{'nodeid-dslinterface'} = 'dsl//%nodeid-device%//' . $interface->{$data->{'nameref'}{'ifNodeid'}}; $ifParam->{'nodeid'} = '%nodeid-dslinterface%'; my $ifSubtree = $cb->addSubtree ( $subtreeNode, $ifSubtreeName, $ifParam , ['RFC4319_HDSL2_SHDSL_LINE_MIB::hdsl-interface']); $precedence--; my @snr_membernames; my $snr_mg_params = { 'node-display-name' => 'SNR Margins overview', 'comment' => 'Summary graph for all SNR values', 'precedence' => 10010, 'ds-type' => 'rrd-multigraph', 'vertical-label' => 'dB', 'graph-lower-limit' => 0, 'nodeid' => '%nodeid-dslinterface%//signal_ovw', }; my @err_membernames; my $err_mg_params = { 'node-display-name' => 'Line error seconds overview', 'comment' => 'Summary graph for all error seconds', 'precedence' => 10000, 'ds-type' => 'rrd-multigraph', 'vertical-label' => 'Seconds', 'graph-lower-limit' => 0, 'nodeid' => '%nodeid-dslinterface%//errors_ovw', }; my @crc_membernames; my $crc_mg_params = { 'node-display-name' => 'Line CRC errors overview', 'comment' => 'Summary graph for all CRC errors', 'precedence' => 10000, 'ds-type' => 'rrd-multigraph', 'vertical-label' => 'Errors', 'graph-lower-limit' => 0, 'nodeid' => '%nodeid-dslinterface%//crc_ovw', }; my $linenum = 1; foreach my $INDEX (sort {$a cmp $b} keys %{$data->{'HDSLLine'}{$ifIndex}}) { my $linedata = $data->{'HDSLLine'}{$ifIndex}{$INDEX}; my $endpoint = $linedata->{'hdsl-unit'}; if( $data->{'HDSLLineProps'}{$ifIndex}{'repeaters'} > 0 ) { $endpoint .= ', ' . $linedata->{'hdsl-side'}; } if( $data->{'HDSLLineProps'}{$ifIndex}{'wirepairs'} > 1 ) { $endpoint .= ', ' . $linedata->{'hdsl-wirepair'}; } my $epSubtreeName = $endpoint; $epSubtreeName =~ s/\W+/_/g; my $epNick = $INDEX; $epNick =~ s/\./_/g; my $param = { 'comment' => 'Detailed endpoint statistics', 'node-display-name' => $endpoint, 'hdsl-index' => $INDEX, 'hdsl-endpoint-nick' => $epNick, 'precedence' => $precedence, }; $param->{'descriptive-nickname'} = '%system-id%:%interface-name% ' . $endpoint; $param->{'nodeid-dslendpoint'} = '%nodeid-dslinterface%//' . $epSubtreeName; $param->{'nodeid'} = '%nodeid-dslendpoint%'; $precedence--; $cb->addSubtree( $ifSubtree, $epSubtreeName, $param, ['RFC4319_HDSL2_SHDSL_LINE_MIB::hdsl-endpoint'] ); push( @snr_membernames, $epNick ); $snr_mg_params->{'ds-expr-' . $epNick} = '{' . $epSubtreeName . '/SNR_Margin}'; $snr_mg_params->{'graph-legend-' . $epNick} = $endpoint . ' SNR'; $snr_mg_params->{'line-style-' . $epNick} = 'LINE2'; $snr_mg_params->{'line-color-' . $epNick} = '##clr' . $linenum; $snr_mg_params->{'line-order-' . $epNick} = $linenum; push( @err_membernames, $epNick ); $err_mg_params->{'ds-expr-' . $epNick} = '{' . $epSubtreeName . '/Prev_15min_ES},' . '{' . $epSubtreeName . '/Prev_15min_SES},+,' . '{' . $epSubtreeName . '/Prev_15min_LOSWS},+,' . '{' . $epSubtreeName . '/Prev_15min_UAS},+'; $err_mg_params->{'graph-legend-' . $epNick} = $endpoint . ' line errors'; $err_mg_params->{'line-style-' . $epNick} = 'LINE2'; $err_mg_params->{'line-color-' . $epNick} = '##clr' . $linenum; $err_mg_params->{'line-order-' . $epNick} = $linenum; push( @crc_membernames, $epNick ); $crc_mg_params->{'ds-expr-' . $epNick} = '{' . $epSubtreeName . '/Prev_15min_CRCA}'; $crc_mg_params->{'graph-legend-' . $epNick} = $endpoint . ' crc errors'; $crc_mg_params->{'line-style-' . $epNick} = 'LINE2'; $crc_mg_params->{'line-color-' . $epNick} = '##clr' . $linenum; $crc_mg_params->{'line-order-' . $epNick} = $linenum; $linenum++; } $snr_mg_params->{'ds-names'} = join(',', @snr_membernames); $cb->addLeaf( $ifSubtree, 'SNR_Summary', $snr_mg_params ); $err_mg_params->{'ds-names'} = join(',', @err_membernames); $cb->addLeaf( $ifSubtree, 'Error_Summary', $err_mg_params ); $crc_mg_params->{'ds-names'} = join(',', @crc_membernames); $cb->addLeaf( $ifSubtree, 'CRCA_Summary', $crc_mg_params ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Thomson_xDSL.pm0000644000175000017500000000453412661116101017747 00000000000000# Copyright (C) 2011 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. # Technicolor Thomson xDSL gateways # Only interface indexing and naming is handled here. package Torrus::DevDiscover::Thomson_xDSL; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'Thomson_xDSL'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( 'thomson_xDSL_products' => '1.3.6.1.4.1.2863.405', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'thomson_xDSL_products', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) { return 0; } $devdetails->setCap('interfaceIndexingPersistent'); &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, { 'BRG' => { 'ifType' => 6, # ethernetCsmacd 'ifDescr' => '^BRG:' } }); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT'; $data->{'nameref'}{'ifReferenceName'} = 'ifName'; $data->{'nameref'}{'ifNick'} = 'ifIndex'; $data->{'nameref'}{'ifNodeid'} = 'ifIndex'; $data->{'nameref'}{'ifComment'} = undef; $data->{'param'}{'snmp-oids-per-pdu'} = 10; return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/ALU_Timetra.pm0000644000175000017500000003562712661116101017543 00000000000000# # 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. # Stanislav Sinyagin # # Currently tested with following Alcatel-Lucent devices: # * ESS 7450 package Torrus::DevDiscover::ALU_Timetra; use strict; use warnings; 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); 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 $table = $dd->walkSnmpTable('tmnxPortDescription'); while( my( $ifIndex, $descr ) = each %{$table} ) { 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 $table = $dd->walkSnmpTable('custDescription'); while( my( $custId, $descr ) = each %{$table} ) { $data->{'timetraCustDescr'}{$custId} = $descr; } } # Get Service Descriptions { my $table = $dd->walkSnmpTable('svcDescription'); while( my( $svcId, $descr ) = each %{$table} ) { $data->{'timetraSvc'}{$svcId} = { 'description' => $descr, 'sap' => [], }; } } # Get mapping of Services to Customers { my $table = $dd->walkSnmpTable('svcCustId'); while( my( $svcId, $custId ) = each %{$table} ) { $data->{'timetraCustSvc'}{$custId}{$svcId} = 1; $data->{'timetraSvcCust'}{$svcId} = $custId; } } # Get port encapsulations { my $table = $dd->walkSnmpTable('tmnxPortEncapType'); while( my( $ifIndex, $encap ) = each %{$table} ) { if( defined( $data->{'interfaces'}{$ifIndex} ) ) { $data->{'interfaces'}{$ifIndex}{'tmnxPortEncapType'} = $encap; } } } # Get SAP information { my $table = $dd->walkSnmpTable('sapDescription'); while( my( $sapFullID, $descr ) = each %{$table} ) { 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 $custParam = { 'precedence' => 100000 - $custId, 'comment' => $data->{'timetraCustDescr'}{$custId}, 'timetra-customer-id' => $custId, }; my $custNode = $cb->addSubtree( $customersNode, $custId, $custParam, ['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( not defined($sapDescr) or $sapDescr eq '' ) { $sapDescr = $data->{'timetraSvc'}{$svcId}->{'description'}; } my $subtreeName = $sap->{'name'}; $subtreeName =~ s/\W/_/go; my $comment = ''; if( defined($sapDescr) and $sapDescr ne '' ) { $comment = $sapDescr; } my $legend = ''; my $custDescr = $data->{'timetraCustDescr'}{$custId}; if( defined($custDescr) and $custDescr ne '' ) { $legend .= 'Customer:' . $devdetails->screenSpecialChars( $custDescr ) . ';'; } my $svcDescr = $data->{'timetraSvc'}{$svcId}->{'description'}; if( defined($svcDescr) and $svcDescr ne '' ) { $legend .= 'Service:' . $devdetails->screenSpecialChars( $svcDescr ) . ';'; } $legend .= 'SAP: ' . $devdetails->screenSpecialChars( $sap->{'name'} ); my $sapParam = { 'comment' => $comment, 'timetra-sap-id' => $sapID, 'timetra-sap-name' => $sap->{'name'}, 'node-display-name' => $sap->{'name'}, 'precedence' => $precedence--, 'legend' => $legend, }; $cb->addSubtree( $custNode, $subtreeName, $sapParam, ['ALU_Timetra::alu-timetra-sap']); } } } } } return; } 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 @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(); if( not $knownSelectorActions{$action} ) { Error('Unknown ALU_SAP selector action: ' . $action); return; } if( $action eq 'RemoveSAP' ) { $data->{'timetraSap'}{$object}{'excluded'} = 1; } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/ComtechEFData.pm0000644000175000017500000001017312661116101020011 00000000000000# Copyright (C) 2012 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. # Comtech EF Data satellite modems package Torrus::DevDiscover::ComtechEFData; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'ComtechEFData'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( 'ComtechEFData' => '1.3.6.1.4.1.6247', 'cdm570' => '1.3.6.1.4.1.6247.24', 'cdm570TxFrequency' => '1.3.6.1.4.1.6247.24.1.2.2.1.0', 'cdm570TxDataRate' => '1.3.6.1.4.1.6247.24.1.2.2.2.0', 'cdm570RxFrequency' => '1.3.6.1.4.1.6247.24.1.2.3.1.0', 'cdm570RxDataRate' => '1.3.6.1.4.1.6247.24.1.2.3.2.0', 'cdmipWanFpgaRxPayLoadCount' => '1.3.6.1.4.1.6247.4.8.5.6.0', ); my %cdm570_OID = ( 'cdm570TxFrequency' => 'cdm-wan-tx-freq', 'cdm570TxDataRate' => 'cdm-wan-tx-rate', 'cdm570RxFrequency' => 'cdm-wan-rx-freq', 'cdm570RxDataRate' => 'cdm-wan-rx-rate', ); sub checkdevtype { my $dd = shift; my $devdetails = shift; my $sysObjectID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') ); if( not $dd->oidBaseMatch( 'ComtechEFData', $sysObjectID ) ) { return 0; } if( $dd->oidBaseMatch( 'cdm570', $sysObjectID ) ) { $devdetails->setCap('cdm570'); } $devdetails->setCap('interfaceIndexingPersistent'); &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, { 'loopback' => { 'ifType' => 24, # softwareLoopback 'ifDescr' => 'loopback' } }); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); $data->{'param'}{'snmp-oids-per-pdu'} = 10; # Get TX/RX frequency and data rate if( $devdetails->hasCap('cdm570') ) { my @oids = (); foreach my $var ( sort keys %cdm570_OID ) { push( @oids, $dd->oiddef($var) ); } my $result = $session->get_request( -varbindlist => \@oids ); if( not defined $result ) { Error('Failed to get CDM570 radio parameters'); return 0; } foreach my $var ( keys %cdm570_OID ) { my $val = $result->{$dd->oiddef($var)}; if( not defined($val) ) { $val = 0; } $data->{'cdm570'}{$var} = $val; $data->{'param'}{$cdm570_OID{$var}} = $val; } } # Check if IP cotroller is present { my $oid = $dd->oiddef('cdmipWanFpgaRxPayLoadCount'); my $result = $session->get_request( -varbindlist => [$oid] ); if( $session->error_status() == 0 and defined( $result ) and defined($result->{$oid}) ) { $devdetails->setCap('CDMIPController'); } } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; if( $devdetails->hasCap('cdm570') ) { $cb->addTemplateApplication($devNode, 'ComtechEFData::cdm570'); } if( $devdetails->hasCap('CDMIPController') ) { $cb->addTemplateApplication($devNode, 'ComtechEFData::cdmip'); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Symmetricom.pm0000644000175000017500000000516612661116101017740 00000000000000# # 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. # Jon Nistor # # Symmetricom package Torrus::DevDiscover::Symmetricom; use strict; use warnings; 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'); return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/CiscoVDSL.pm0000644000175000017500000000670412661116101017160 00000000000000# 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. # Stanislav Sinyagin # Cisco VDSL Line statistics. # Tested with Catalyst 2950 LRE package Torrus::DevDiscover::CiscoVDSL; use strict; use warnings; 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 $ifParam = {}; $ifParam->{'interface-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; $ifParam->{'interface-nick'} = $interface->{$data->{'nameref'}{'ifNick'}}; $ifParam->{'node-display-name'} = $interface->{$data->{'nameref'}{'ifReferenceName'}}; if( defined($data->{'nameref'}{'ifComment'}) and defined($interface->{$data->{'nameref'}{'ifComment'}}) ) { $ifParam->{'comment'} = $interface->{$data->{'nameref'}{'ifComment'}}; } $cb->addSubtree( $subtreeNode, $ifSubtreeName, $ifParam, $templates ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/APC_PowerNet.pm0000644000175000017500000005330012661116101017647 00000000000000# Copyright (C) 2011 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. # APC PowerNet SNMP-managed power distribution products # MIB location: # ftp://ftp.apc.com/apc/public/software/pnetmib/mib/404/powernet404.mib # # Currently supported: # PDU firmware 5.x (tested with: AP8853 firmware v5.1.1) # NB200 environment sensors (tested with NBRK0200) package Torrus::DevDiscover::APC_PowerNet; use strict; use warnings; use Torrus::Log; $Torrus::DevDiscover::registry{'APC_PowerNet'} = { 'sequence' => 500, 'checkdevtype' => \&checkdevtype, 'discover' => \&discover, 'buildConfig' => \&buildConfig }; our %oiddef = ( # PowerNet-MIB 'apc_products' => '1.3.6.1.4.1.318.1', # rPDU2, the newer hardware and firmware 'rPDU2IdentFirmwareRev' => '1.3.6.1.4.1.318.1.1.26.2.1.6', 'rPDU2IdentModelNumber' => '1.3.6.1.4.1.318.1.1.26.2.1.8', 'rPDU2IdentSerialNumber' => '1.3.6.1.4.1.318.1.1.26.2.1.9', 'rPDU2DeviceConfigNearOverloadPowerThreshold' => '1.3.6.1.4.1.318.1.1.26.4.1.1.8', 'rPDU2DeviceConfigOverloadPowerThreshold' => '1.3.6.1.4.1.318.1.1.26.4.1.1.9', 'rPDU2DevicePropertiesNumOutlets' => '1.3.6.1.4.1.318.1.1.26.4.2.1.4', 'rPDU2DevicePropertiesNumPhases' => '1.3.6.1.4.1.318.1.1.26.4.2.1.7', 'rPDU2DevicePropertiesNumMeteredBanks' => '1.3.6.1.4.1.318.1.1.26.4.2.1.8', 'rPDU2DevicePropertiesMaxCurrentRating' => '1.3.6.1.4.1.318.1.1.26.4.2.1.9', 'rPDU2PhaseConfigNumber' => '1.3.6.1.4.1.318.1.1.26.6.1.1.3', 'rPDU2PhaseConfigNearOverloadCurrentThreshold' => '1.3.6.1.4.1.318.1.1.26.6.1.1.6', 'rPDU2PhaseConfigOverloadCurrentThreshold' => '1.3.6.1.4.1.318.1.1.26.6.1.1.7', 'rPDU2BankConfigNumber' => '1.3.6.1.4.1.318.1.1.26.8.1.1.3', 'rPDU2BankConfigNearOverloadCurrentThreshold' => '1.3.6.1.4.1.318.1.1.26.8.1.1.6', 'rPDU2BankConfigOverloadCurrentThreshold' => '1.3.6.1.4.1.318.1.1.26.8.1.1.7', # rPDU, the older hardware and firmware 'sPDUIdentFirmwareRev' => '1.3.6.1.4.1.318.1.1.4.1.2.0', 'sPDUIdentModelNumber' => '1.3.6.1.4.1.318.1.1.4.1.4.0', 'sPDUIdentSerialNumber' => '1.3.6.1.4.1.318.1.1.4.1.5.0', 'rPDUIdentDeviceRating' => '1.3.6.1.4.1.318.1.1.12.1.7.0', 'rPDUIdentDeviceNumOutlets' => '1.3.6.1.4.1.318.1.1.12.1.8.0', 'rPDUIdentDeviceNumPhases' => '1.3.6.1.4.1.318.1.1.12.1.9.0', 'rPDULoadStatusPhaseNumber' => '1.3.6.1.4.1.318.1.1.12.2.3.1.1.4', 'rPDULoadStatusBankNumber' => '1.3.6.1.4.1.318.1.1.12.2.3.1.1.5', 'rPDULoadPhaseConfigNearOverloadThreshold' => '1.3.6.1.4.1.318.1.1.12.2.2.1.1.3', 'rPDULoadPhaseConfigOverloadThreshold' => '1.3.6.1.4.1.318.1.1.12.2.2.1.1.4', 'rPDULoadBankConfigNearOverloadThreshold' => '1.3.6.1.4.1.318.1.1.12.2.4.1.1.3', 'rPDULoadBankConfigOverloadThreshold' => '1.3.6.1.4.1.318.1.1.12.2.4.1.1.4', # Modular Environmental Manager (MEM) 'memModulesStatusModuleName' => '1.3.6.1.4.1.318.1.1.10.4.1.2.1.2', 'memModulesStatusModuleLocation' => '1.3.6.1.4.1.318.1.1.10.4.1.2.1.3', 'memModulesStatusModelNumber' => '1.3.6.1.4.1.318.1.1.10.4.1.2.1.4', 'memModulesStatusSerialNumber' => '1.3.6.1.4.1.318.1.1.10.4.1.2.1.5', 'memModulesStatusFirmwareRev' => '1.3.6.1.4.1.318.1.1.10.4.1.2.1.6', 'memSensorsStatusSysTempUnits' => '1.3.6.1.4.1.318.1.1.10.4.2.1.0', 'memSensorsStatusSensorName' => '1.3.6.1.4.1.318.1.1.10.4.2.3.1.3', 'memSensorsStatusSensorLocation' => '1.3.6.1.4.1.318.1.1.10.4.2.3.1.4', 'memSensorsTempHighThresh' => '1.3.6.1.4.1.318.1.1.10.4.2.5.1.7', 'memSensorsTempLowThresh' => '1.3.6.1.4.1.318.1.1.10.4.2.5.1.8', 'memSensorsHumidityHighThresh' => '1.3.6.1.4.1.318.1.1.10.4.2.5.1.20', 'memSensorsHumidityLowThresh' => '1.3.6.1.4.1.318.1.1.10.4.2.5.1.21', ); my %rpdu2_system_oid; foreach my $name ('rPDU2IdentFirmwareRev', 'rPDU2IdentModelNumber', 'rPDU2IdentSerialNumber', 'rPDU2DeviceConfigNearOverloadPowerThreshold', 'rPDU2DeviceConfigOverloadPowerThreshold', 'rPDU2DevicePropertiesNumOutlets', 'rPDU2DevicePropertiesNumPhases', 'rPDU2DevicePropertiesNumMeteredBanks', 'rPDU2DevicePropertiesMaxCurrentRating', ) { $rpdu2_system_oid{$name} = $oiddef{$name} . '.1'; } my @rpdu_system_oid = ('sPDUIdentFirmwareRev', 'sPDUIdentModelNumber', 'sPDUIdentSerialNumber', 'rPDUIdentDeviceRating', 'rPDUIdentDeviceNumOutlets', 'rPDUIdentDeviceNumPhases'); my $apcInterfaceFilter = { 'LOOPBACK' => { 'ifType' => 24, # softwareLoopback }, }; sub checkdevtype { my $dd = shift; my $devdetails = shift; if( not $dd->oidBaseMatch ( 'apc_products', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) ) { return 0; } $devdetails->setCap('interfaceIndexingPersistent'); &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter ($devdetails, $apcInterfaceFilter); return 1; } sub discover { my $dd = shift; my $devdetails = shift; my $data = $devdetails->data(); my $session = $dd->session(); # check if rPDU2 is supported and retrieve system information { my $result = $session->get_request ( -varbindlist => [values %rpdu2_system_oid] ); my $oid = $rpdu2_system_oid{'rPDU2IdentFirmwareRev'}; if( defined($result) and defined($result->{$oid}) and length($result->{$oid}) > 0 ) { $devdetails->setCap('apc_rPDU2'); my $sysref = {}; while( my($name, $oid) = each %rpdu2_system_oid ) { $sysref->{$name} = $result->{$oid}; } $data->{'param'}{'comment'} = 'APC PDU ' . $sysref->{'rPDU2IdentModelNumber'} . ', Firmware ' . $sysref->{'rPDU2IdentFirmwareRev'} . ', S/N ' . $sysref->{'rPDU2IdentSerialNumber'}; $data->{'param'}{'rpdu2-warn-pwr'} = $sysref->{'rPDU2DeviceConfigNearOverloadPowerThreshold'}; $data->{'param'}{'rpdu2-crit-pwr'} = $sysref->{'rPDU2DeviceConfigOverloadPowerThreshold'}; if( $devdetails->paramDisabled('suppress-legend') ) { my $legend = $data->{'param'}{'legend'}; $legend = '' unless defined($legend); $legend .= 'Phases:' . $sysref->{'rPDU2DevicePropertiesNumPhases'} . ';'; $legend .= 'Banks:' . $sysref->{'rPDU2DevicePropertiesNumMeteredBanks'} . ';'; $legend .= 'Outlets:' . $sysref->{'rPDU2DevicePropertiesNumOutlets'} . ';'; $legend .= 'Max current:' . $sysref->{'rPDU2DevicePropertiesMaxCurrentRating'} . 'A;'; $data->{'param'}{'legend'} = $legend; } } } if( $devdetails->hasCap('apc_rPDU2') ) { # Discover PDU phases { my $cfnum = $dd->walkSnmpTable('rPDU2PhaseConfigNumber'); my $warn_thr = $dd->walkSnmpTable ('rPDU2PhaseConfigNearOverloadCurrentThreshold'); my $crit_thr = $dd->walkSnmpTable ('rPDU2PhaseConfigOverloadCurrentThreshold'); while( my( $INDEX, $val ) = each %{$cfnum} ) { $data->{'apc_rPDU2'}{'phases'}{$INDEX} = { 'rpdu2-phasenum' => $val, 'rpdu2-warn-currnt' => $warn_thr->{$INDEX}, 'rpdu2-crit-currnt' => $crit_thr->{$INDEX}, }; } } # Discover PDU banks { my $cfnum = $dd->walkSnmpTable('rPDU2BankConfigNumber'); my $warn_thr = $dd->walkSnmpTable ('rPDU2BankConfigNearOverloadCurrentThreshold'); my $crit_thr = $dd->walkSnmpTable ('rPDU2BankConfigOverloadCurrentThreshold'); while( my( $INDEX, $val ) = each %{$cfnum} ) { $data->{'apc_rPDU2'}{'banks'}{$INDEX} = { 'rpdu2-banknum' => $val, 'rpdu2-warn-currnt' => $warn_thr->{$INDEX}, 'rpdu2-crit-currnt' => $crit_thr->{$INDEX}, }; } } } else { # This is an old firmware, fall back to rPDU MIB my @oids; foreach my $oidname ( @rpdu_system_oid ) { push( @oids, $dd->oiddef($oidname) ); } my $result = $session->get_request( -varbindlist => \@oids ); my $model_oid = $dd->oiddef('sPDUIdentModelNumber'); if( defined($result) and defined($result->{$model_oid}) and length($result->{$model_oid}) > 0 ) { $devdetails->setCap('apc_rPDU'); my $sysref = {}; foreach my $oidname ( @rpdu_system_oid ) { my $oid = $dd->oiddef($oidname); my $val = $result->{$oid}; if( defined($val) and length($val) > 0 ) { $sysref->{$oidname} = $val; } else { $sysref->{$oidname} = 'N/A'; } } $data->{'param'}{'comment'} = 'APC PDU ' . $sysref->{'sPDUIdentModelNumber'} . ', Firmware ' . $sysref->{'sPDUIdentFirmwareRev'} . ', S/N ' . $sysref->{'sPDUIdentSerialNumber'}; if( $devdetails->paramDisabled('suppress-legend') ) { my $legend = $data->{'param'}{'legend'}; $legend = '' unless defined($legend); $legend .= 'Phases:' . $sysref->{'rPDUIdentDeviceNumPhases'} . ';'; $legend .= 'Outlets:' . $sysref->{'rPDUIdentDeviceNumOutlets'} . ';'; $legend .= 'Max current:' . $sysref->{'rPDUIdentDeviceRating'} . 'A;'; $data->{'param'}{'legend'} = $legend; } # Discover PDU phases my $phases = $dd->walkSnmpTable('rPDULoadStatusPhaseNumber'); my $banks = $dd->walkSnmpTable('rPDULoadStatusBankNumber'); my $phase_warn_thr = $dd->walkSnmpTable ('rPDULoadPhaseConfigNearOverloadThreshold'); my $phase_crit_thr = $dd->walkSnmpTable ('rPDULoadPhaseConfigOverloadThreshold'); my $bank_warn_thr = $dd->walkSnmpTable ('rPDULoadBankConfigNearOverloadThreshold'); my $bank_crit_thr = $dd->walkSnmpTable ('rPDULoadBankConfigOverloadThreshold'); $data->{'apc_rPDU'} = []; foreach my $INDEX ( keys %{$phases} ) { my $phasenum = $phases->{$INDEX}; my $banknum = $banks->{$INDEX}; my $param = {'rpdu-statusidx' => $INDEX}; my $name; if( $banknum > 0 ) { $name = 'Bank ' . $banknum; $param->{'nodeid-rpdu-ref'} = 'bank' . $banknum; if( defined($bank_warn_thr->{$banknum}) and $bank_warn_thr->{$banknum} > 0 ) { $param->{'rpdu-warn-currnt'} = $bank_warn_thr->{$banknum}; $param->{'rpdu-crit-currnt'} = $bank_crit_thr->{$banknum}; } } else { $name = 'Phase ' . $phasenum; $param->{'nodeid-rpdu-ref'} = 'phase' . $phasenum; if( defined($phase_warn_thr->{$phasenum}) and $phase_warn_thr->{$phasenum} > 0 ) { $param->{'rpdu-warn-currnt'} = $phase_warn_thr->{$phasenum}; $param->{'rpdu-crit-currnt'} = $phase_crit_thr->{$phasenum}; } } push( @{$data->{'apc_rPDU'}}, {'param' => $param, 'name' => $name} ); } } } if( $devdetails->hasCap('apc_rPDU2') or $devdetails->hasCap('apc_rPDU') ) { $data->{'param'}{'nodeid-pdu'} = 'pdu//%nodeid-device%'; } # Modular Environmental Manager (MEM) my $mod_names = $dd->walkSnmpTable('memModulesStatusModuleName'); if( scalar(keys %{$mod_names}) > 0 ) { $devdetails->setCap('apc_MEM'); my $temp_units; { my $oid = $dd->oiddef('memSensorsStatusSysTempUnits'); my $result = $session->get_request( -varbindlist => [$oid] ); $temp_units = (defined($result->{$oid}) and $result->{$oid} == 2) ? 'Fahrenheit':'Celsius'; } my $mod_locations = $dd->walkSnmpTable('memModulesStatusModuleLocation'); my $mod_models = $dd->walkSnmpTable('memModulesStatusModelNumber'); my $mod_serials = $dd->walkSnmpTable('memModulesStatusSerialNumber'); my $mod_firmware = $dd->walkSnmpTable('memModulesStatusFirmwareRev'); my $modules = {}; foreach my $INDEX (keys %{$mod_names}) { my $ref = {}; $ref->{'name'} = $mod_names->{$INDEX}; $ref->{'location'} = $mod_locations->{$INDEX}; $ref->{'model'} = $mod_models->{$INDEX}; $ref->{'serial'} = $mod_serials->{$INDEX}; $ref->{'firmware'} = $mod_firmware->{$INDEX}; $ref->{'temp-units'} = $temp_units; $modules->{$INDEX}{'sys'} = $ref; } my $s_names = $dd->walkSnmpTable('memSensorsStatusSensorName'); my $s_locations = $dd->walkSnmpTable('memSensorsStatusSensorLocation'); my $s_temp_hi = $dd->walkSnmpTable('memSensorsTempHighThresh'); my $s_temp_lo = $dd->walkSnmpTable('memSensorsTempLowThresh'); my $s_hum_hi = $dd->walkSnmpTable('memSensorsHumidityHighThresh'); my $s_hum_lo = $dd->walkSnmpTable('memSensorsHumidityLowThresh'); foreach my $INDEX (keys %{$s_names}) { my ($mod_idx, $sens_idx) = split(/\./o, $INDEX); my $ref = {}; $ref->{'sensor-name'} = $s_names->{$INDEX}; $ref->{'sensor-location'} = $s_locations->{$INDEX}; $ref->{'sensor-temp-hi'} = $s_temp_hi->{$INDEX}; $ref->{'sensor-temp-lo'} = $s_temp_lo->{$INDEX}; $ref->{'sensor-hum-hi'} = $s_hum_hi->{$INDEX}; $ref->{'sensor-hum-lo'} = $s_hum_lo->{$INDEX}; $ref->{'sensor-num'} = $sens_idx; $modules->{$mod_idx}{'sensors'}{$INDEX} = $ref; } $data->{'apc_MEM'} = $modules; $data->{'param'}{'comment'} = 'APC ' . $mod_models->{0}; $data->{'param'}{'nodeid-sensor'} = 'sensor//%nodeid-device%'; } return 1; } sub buildConfig { my $devdetails = shift; my $cb = shift; my $devNode = shift; my $data = $devdetails->data(); if( $devdetails->hasCap('apc_rPDU2') ) { my $pduParam = { 'node-display-name' => 'PDU Statistics', 'comment' => 'PDU current and power load', 'precedence' => 10000, }; my $pduSubtree = $cb->addSubtree( $devNode, 'PDU_Stats', $pduParam, ['APC_PowerNet::apc-pdu2-subtree'] ); my $precedence = 1000; # phases foreach my $INDEX ( sort {$a <=> $b} keys %{$data->{'apc_rPDU2'}{'phases'}} ) { my $ref = $data->{'apc_rPDU2'}{'phases'}{$INDEX}; my $param = { 'rpdu2-phase-index' => $INDEX, 'node-display-name' => 'Phase ' . $ref->{'rpdu2-phasenum'}, 'precedence' => $precedence, }; while (my($key, $val) = each %{$ref}) { $param->{$key} = $val; } $cb->addSubtree ( $pduSubtree, 'Phase_' . $ref->{'rpdu2-phasenum'}, $param, ['APC_PowerNet::apc-pdu2-phase'] ); $precedence--; } # banks foreach my $INDEX ( sort {$a <=> $b} keys %{$data->{'apc_rPDU2'}{'banks'}} ) { my $ref = $data->{'apc_rPDU2'}{'banks'}{$INDEX}; my $param = { 'rpdu2-bank-index' => $INDEX, 'node-display-name' => 'Bank ' . $ref->{'rpdu2-banknum'}, 'precedence' => $precedence, }; while (my($key, $val) = each %{$ref}) { $param->{$key} = $val; } $cb->addSubtree ( $pduSubtree, 'Bank_' . $ref->{'rpdu2-banknum'}, $param, ['APC_PowerNet::apc-pdu2-bank'] ); $precedence--; } } elsif( $devdetails->hasCap('apc_rPDU') ) { # Old rPDU MIB my $pduParam = { 'node-display-name' => 'PDU Statistics', 'comment' => 'PDU current and power load', 'precedence' => 10000, }; my $pduSubtree = $cb->addSubtree( $devNode, 'PDU_Stats', $pduParam, ['APC_PowerNet::apc-pdu-subtree'] ); foreach my $ref (@{$data->{'apc_rPDU'}}) { my $param = {}; while (my($key, $val) = each %{$ref->{'param'}}) { $param->{$key} = $val; } $param->{'precedence'} = 1000 - $param->{'rpdu-statusidx'}; $param->{'node-display-name'} = $ref->{'name'}; $param->{'graph-title'} = '%system-id% ' . $ref->{'name'}; if( defined($param->{'rpdu-crit-currnt'}) ) { $param->{'upper-limit'} = $param->{'rpdu-crit-currnt'}; $param->{'graph-upper-limit'} = $param->{'rpdu-crit-currnt'}; } if( defined($param->{'rpdu-warn-currnt'}) ) { $param->{'normal-level'} = $param->{'rpdu-warn-currnt'}; } my $subtreeName = $ref->{'name'}; $subtreeName =~ s/\W/_/go; $cb->addSubtree ( $pduSubtree, $subtreeName, $param, ['APC_PowerNet::apc-pdu-stat'] ); } } if( $devdetails->hasCap('apc_MEM') ) { # Modular Environmental Manager (MEM) my $mod_precedence = 5000; foreach my $mod_idx (sort {$a <=>$b} keys %{$data->{'apc_MEM'}}) { my $mod_data = $data->{'apc_MEM'}{$mod_idx}; $mod_precedence--; my $modSubtreeName = $mod_data->{'sys'}{'name'}; $modSubtreeName =~ s/\W/_/go; my $modParam = { 'node-display-name' => $mod_data->{'sys'}{'name'}, 'precedence' => $mod_precedence, 'sensor-temp-units' => $mod_data->{'sys'}{'temp-units'}, }; $modParam->{'comment'} = 'Environment sensors, Location: ' . $mod_data->{'sys'}{'location'} . ', Model: ' . $mod_data->{'sys'}{'model'} . ', Serial: ' . $mod_data->{'sys'}{'serial'} . ', Firmware: ' . $mod_data->{'sys'}{'firmware'}; my $modSubtree = $cb->addSubtree( $devNode, $modSubtreeName, $modParam, ['APC_PowerNet::apc-mem-subtree'] ); foreach my $INDEX (sort keys %{$mod_data->{'sensors'}}) { my $sens_data = $mod_data->{'sensors'}{$INDEX}; my $senSubtreeName = $sens_data->{'sensor-name'}; $senSubtreeName =~ s/\W/_/go; my $sensParam = {}; foreach my $p ('sensor-temp-hi', 'sensor-temp-lo', 'sensor-hum-hi', 'sensor-hum-lo', 'sensor-name') { $sensParam->{$p} = $sens_data->{$p}; } $sensParam->{'node-display-name'} = $sens_data->{'sensor-name'}; $sensParam->{'comment'} = 'Location: ' . $sens_data->{'sensor-location'}; $sensParam->{'precedence'} = 1000 - $sens_data->{'sensor-num'}; $sensParam->{'sensor-index'} = $INDEX; $cb->addSubtree( $modSubtree, $senSubtreeName, $sensParam, ['APC_PowerNet::apc-mem-sensor'] ); } } } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/Alteon.pm0000644000175000017500000001255112661116101016646 00000000000000# # 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. # Jon Nistor # package Torrus::DevDiscover::Alteon; use strict; use warnings; 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'] ); } return; } 1; # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: torrus-2.09/perllib/Torrus/DevDiscover/EmpireSystemedge.pm0000644000175000017500000010530312661116101020675 00000000000000# Copyright (C) 2003-2012 Shawn Ferry, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # Shawn Ferry # Roman Hochuli package Torrus::DevDiscover::EmpireSystemedge; use strict; use Torrus::Log; use Data::Dumper; $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', # Empire Service Response Extension 'empireSvcTable' => '1.3.6.1.4.1.546.16.6.10.1', 'empireSvcIndex' => '1.3.6.1.4.1.546.16.6.10.1.1', 'empireSvcDescr' => '1.3.6.1.4.1.546.16.6.10.1.2', 'empireSvcType' => '1.3.6.1.4.1.546.16.6.10.1.3', 'empireSvcTotRespTime' => '1.3.6.1.4.1.546.16.6.10.1.12', 'empireSvcAvailability' => '1.3.6.1.4.1.546.16.6.10.1.17', 'empireSvcConnTime' => '1.3.6.1.4.1.546.16.6.10.1.23', 'empireSvcTransTime' => '1.3.6.1.4.1.546.16.6.10.1.28', 'empireSvcThroughput' => '1.3.6.1.4.1.546.16.6.10.1.37', 'empireSvcDestination' => '1.3.6.1.4.1.546.16.6.10.1.45', ); 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: #